From 1f2d641c7fe22d6e3214bb307b6b674c76f0e70e Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sat, 7 Dec 2024 16:40:17 +0100 Subject: [PATCH 01/82] Initial syntactic expressiveness experiments This is the first definition has come to my mind. It works at least for ADT < CCC intuitively. --- src/Vatras/Framework/Variants.agda | 10 +- src/Vatras/Lang/CCC/Util.agda | 9 +- src/Vatras/Test.agda | 424 +++++++++++++++++++++++++++++ 3 files changed, 438 insertions(+), 5 deletions(-) create mode 100644 src/Vatras/Test.agda diff --git a/src/Vatras/Framework/Variants.agda b/src/Vatras/Framework/Variants.agda index b1c2780b..29d957bd 100644 --- a/src/Vatras/Framework/Variants.agda +++ b/src/Vatras/Framework/Variants.agda @@ -7,7 +7,7 @@ module Vatras.Framework.Variants where open import Data.List using (List; []; _∷_; map) open import Data.Maybe using (nothing; just) -open import Data.Product using (_,_; proj₁; proj₂) +open import Data.Product using (_×_; _,_; proj₁; proj₂) open import Data.String using (String; _++_; intersperse) open import Data.Unit using (⊤; tt) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≗_; refl) @@ -77,11 +77,17 @@ GrulerVL = Variant-is-VL GrulerVariant RoseVL : VariabilityLanguage (Rose ∞) RoseVL = Variant-is-VL (Rose ∞) +{-| +Lemma to conclude that the child lists of two equal rose trees must be equal as well. +-} +Rose-injective : ∀ {A : 𝔸} {a₁ a₂ : atoms A} {cs₁ cs₂ : List (Rose ∞ A)} → a₁ -< cs₁ >- ≡ a₂ -< cs₂ >- → (a₁ ≡ a₂) × (cs₁ ≡ cs₂) +Rose-injective refl = refl , refl + {-| Lemma to conclude that the child lists of two equal rose trees must be equal as well. -} children-equality : ∀ {A : 𝔸} {a₁ a₂ : atoms A} {cs₁ cs₂ : List (Rose ∞ A)} → a₁ -< cs₁ >- ≡ a₂ -< cs₂ >- → cs₁ ≡ cs₂ -children-equality refl = refl +children-equality = proj₂ ∘ Rose-injective {-| Show function for rose trees. diff --git a/src/Vatras/Lang/CCC/Util.agda b/src/Vatras/Lang/CCC/Util.agda index 501d5db1..3f635084 100644 --- a/src/Vatras/Lang/CCC/Util.agda +++ b/src/Vatras/Lang/CCC/Util.agda @@ -1,8 +1,8 @@ -open import Vatras.Framework.Definitions using (𝔽; 𝔸) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) module Vatras.Lang.CCC.Util {Dimension : 𝔽} where -open import Size using (Size) -open import Data.List as List using (List; _∷_) +open import Size using (Size; ∞) +open import Data.List as List using (List; []; _∷_) import Data.List.NonEmpty as List⁺ open import Vatras.Lang.CCC Dimension using (CCC; _-<_>-; _⟨_⟩) @@ -11,3 +11,6 @@ open import Vatras.Lang.CCC Dimension using (CCC; _-<_>-; _⟨_⟩) dims : ∀ {i : Size} {A : 𝔸} → CCC i A → List Dimension dims (_ -< es >-) = List.concatMap dims es dims (D ⟨ es ⟩) = D ∷ List.concatMap dims (List⁺.toList es) + +leaf : {A : 𝔸} → atoms A → CCC ∞ A +leaf a = a -< [] >- diff --git a/src/Vatras/Test.agda b/src/Vatras/Test.agda new file mode 100644 index 00000000..497d3505 --- /dev/null +++ b/src/Vatras/Test.agda @@ -0,0 +1,424 @@ + +open import Vatras.Framework.Definitions using (𝔸; atoms) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_; refl) +module Vatras.Test (A : 𝔸) (a₁ a₂ : atoms A) (a₁≢a₂ : a₁ ≢ a₂) where + +open import Data.Bool using (Bool; true; false) +open import Data.Empty using (⊥-elim) +open import Data.Nat as ℕ using (ℕ; suc; zero; _≤_; z≤n; s≤s; _<_; _≮_; _-) = suc (List.sum (List.map sizeCCC cs)) +sizeCCC (D CCC.CCC.⟨ cs ⟩) = suc (List⁺.foldr₁ _+_ (List⁺.map sizeCCC cs)) + +SizedCCC : SizedLang +SizedCCC = record + { Lang = CCC.CCCL + ; size = sizeCCC + } + +sizeADT : ADT.ADT A → ℕ +sizeADT (ADT.ADT.leaf v) = suc zero -- TODO also count the variant +sizeADT (D ADT.ADT.⟨ l , r ⟩) = suc (sizeADT l + sizeADT r) + +SizedADT : SizedLang +SizedADT = record + { Lang = ADT.ADTL + ; size = sizeADT + } + +_≤Size_ : SizedLang → SizedLang → Set₁ +L₁ ≤Size L₂ = + Σ[ n ∈ ℕ ] + ∀ (e₂ : Expression (Lang L₂) A) → + Σ[ e₁ ∈ Expression (Lang L₁) A ] + Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ + × size L₁ e₁ ≤ n * size L₂ e₂ + +_≥Expressive_ : SizedLang → SizedLang → Set₁ +L₁ ≥Expressive L₂ = L₁ ≤Size L₂ + +_>Expressive_ : SizedLang → SizedLang → Set₁ +L₁ >Expressive L₂ = ¬ (L₂ ≥Expressive L₁) + + +e₁-cs : ℕ → ℕ → List (CCC.CCC ∞ A) +e₁-cs zero D = [] +e₁-cs (suc n) D = D CCC.CCC.⟨ leaf a₁ ∷ leaf a₂ ∷ [] ⟩ ∷ e₁-cs n (suc D) + +e₁ : ℕ → CCC.CCC ∞ A +e₁ n = a₁ CCC.CCC.-< e₁-cs n zero >- + +size-e₁-cs : ∀ n D → List.sum (List.map sizeCCC (e₁-cs n D)) ≡ n * 3 +size-e₁-cs zero D = refl +size-e₁-cs (suc n) D = Eq.cong (3 +_) (size-e₁-cs n (suc D)) + +size-e₁ : ∀ n → sizeCCC (e₁ n) ≡ 1 + n * 3 +size-e₁ n = Eq.cong suc (size-e₁-cs n zero) + +variants-cs : ∀ n → Fin (2 ^ n) → List (Rose ∞ A) +variants-cs zero zero = [] +variants-cs (suc n) i with Fin.toℕ i - ∷ variants-cs n (Fin.fromℕ< i<2^n) +... | no i≮2^n = a₂ Rose.-< [] >- ∷ variants-cs n (Eq.subst Fin (ℕ.+-identityʳ (2 ^ n)) (Fin.reduce≥ i (ℕ.≮⇒≥ i≮2^n))) + +variants : ∀ n → VariantGenerator (pred (2 ^ n)) +variants n i = a₁ Rose.-< variants-cs n (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i) >- + +lemma1 : ∀ n → variants n ⊆ CCC.⟦ e₁ n ⟧ +lemma1 n i = config n i' , Eq.cong (a₁ Rose.-<_>-) (go n i' zero λ o → Eq.cong (config n i') (ℕ.+-identityʳ o)) + where + i' = Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i + + config : ∀ n → Fin (2 ^ n) → ℕ → ℕ + config zero zero k = 0 + config (suc n) i k with Fin.toℕ i - ∷ variants-cs m (Fin.fromℕ< k<2^m) + ≡⟨ Eq.cong (a₁ Rose.-< [] >- ∷_) (go m (Fin.fromℕ< k<2^m) (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-<2^m m j o k<2^m))) ⟩ + a₁ Rose.-< [] >- ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨⟩ + CCC.⟦ find-or-last 0 (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨ Eq.cong (λ x → CCC.⟦ find-or-last x (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ + CCC.⟦ find-or-last (config n i' D) (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨⟩ + CCC.⟦ D CCC.CCC.⟨ leaf a₁ ∷ leaf a₂ ∷ [] ⟩ ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ∎ + ... | no k≮2^m | p' = + begin + a₂ Rose.-< [] >- ∷ variants-cs m j' + ≡⟨ Eq.cong (a₂ Rose.-< [] >- ∷_) (go m j' (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-≮2^m m j o k≮2^m))) ⟩ + a₂ Rose.-< [] >- ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨⟩ + CCC.⟦ find-or-last 1 (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨ Eq.cong (λ x → CCC.⟦ find-or-last x (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ + CCC.⟦ find-or-last (config n i' D) (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨⟩ + CCC.⟦ D CCC.CCC.⟨ leaf a₁ ∷ leaf a₂ ∷ [] ⟩ ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ∎ + where + j' = Eq.subst Fin (ℕ.+-identityʳ (2 ^ m)) (Fin.reduce≥ j (ℕ.≮⇒≥ k≮2^m)) + +ADT-leafs : ADT.ADT A → List⁺ (Rose ∞ A) +ADT-leafs (ADT.ADT.leaf v) = v ∷ [] +ADT-leafs (D ADT.ADT.⟨ l , r ⟩) = ADT-leafs l List⁺.⁺++⁺ ADT-leafs r + +ADT-leaf-count : ADT.ADT A → ℕ +ADT-leaf-count e₂ = List⁺.length (ADT-leafs e₂) + +ADT-leaf-count-lemma : ∀ D → (l r : ADT.ADT A) → ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) ≡ ADT-leaf-count l + ADT-leaf-count r +ADT-leaf-count-lemma D l r = + begin + ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) + ≡⟨⟩ + List⁺.length (ADT-leafs l List⁺.⁺++⁺ ADT-leafs r) + ≡⟨ Eq.cong List.length (List⁺.toList-⁺++⁺ (ADT-leafs l) (ADT-leafs r)) ⟨ + List.length (List⁺.toList (ADT-leafs l) List.++ List⁺.toList (ADT-leafs r)) + ≡⟨ List.length-++ (List⁺.toList (ADT-leafs l)) ⟩ + ADT-leaf-count l + ADT-leaf-count r + ∎ + where + open Eq.≡-Reasoning + +leafs-≤-size : (e₂ : ADT.ADT A) → ADT-leaf-count e₂ ≤ sizeADT e₂ +leafs-≤-size (ADT.ADT.leaf v) = ℕ.≤-refl +leafs-≤-size (D ADT.ADT.⟨ l , r ⟩) = + begin + ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) + ≡⟨ ADT-leaf-count-lemma D l r ⟩ + ADT-leaf-count l + ADT-leaf-count r + ≤⟨ ℕ.+-monoʳ-≤ (ADT-leaf-count l) (leafs-≤-size r) ⟩ + ADT-leaf-count l + sizeADT r + ≤⟨ ℕ.+-monoˡ-≤ (sizeADT r) (leafs-≤-size l) ⟩ + sizeADT l + sizeADT r + <⟨ ℕ.n<1+n (sizeADT l + sizeADT r) ⟩ + suc (sizeADT l + sizeADT r) + ∎ + where + open ℕ.≤-Reasoning + +listToIndexedSet : (vs : List⁺ (Rose ∞ A)) → VariantGenerator (pred (List⁺.length vs)) +listToIndexedSet vs i = List.lookup (List⁺.toList vs) (Eq.subst Fin (ℕ.suc-pred (List⁺.length vs)) i) + +_≟ᵥ_ : ∀ {i} → (v₁ v₂ : Rose i A) → Dec (v₁ ≡ v₂) +(a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) with proj₂ A a₁ a₂ | List.≡-dec _≟ᵥ_ cs₁ cs₂ +(a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | no a₁≢a₂ | _ = no λ where refl → a₁≢a₂ refl +(a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | yes a₁≡a₂ | no cs₁≢cs₂ = no (λ where refl → cs₁≢cs₂ refl) +(a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | yes refl | yes refl = yes refl + +ADT-leaf-count≤ₗ : ∀ D l r → ADT-leaf-count l ≤ ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) +ADT-leaf-count≤ₗ D l r = + begin + ADT-leaf-count l + ≤⟨ ℕ.m≤m+n (ADT-leaf-count l) (ADT-leaf-count r) ⟩ + ADT-leaf-count l + ADT-leaf-count r + ≡⟨ ADT-leaf-count-lemma D l r ⟨ + ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning + +length-++-≤ₗ : ∀ {ℓ} {A : Set ℓ} (xs ys : List A) → List.length xs ≤ List.length (xs List.++ ys) +length-++-≤ₗ xs ys = Eq.subst (_ ≤_) (Eq.sym (List.length-++ xs)) (ℕ.m≤m+n (List.length xs) (List.length ys)) + +lookup-++ᵣ : ∀ {ℓ} {A : Set ℓ} (xs ys : List A) i → List.lookup xs i ≡ List.lookup (xs List.++ ys) (Fin.inject≤ i (length-++-≤ₗ xs ys)) +lookup-++ᵣ (x ∷ xs) ys zero = refl +lookup-++ᵣ (x ∷ xs) ys (suc i) = lookup-++ᵣ xs ys i + +lookup-++ₗ : ∀ {ℓ} {A : Set ℓ} (xs ys : List A) i → List.lookup ys i ≡ List.lookup (xs List.++ ys) (Fin.cast (Eq.sym (List.length-++ xs)) (List.length xs Fin.↑ʳ i)) +lookup-++ₗ [] ys i = Eq.cong (List.lookup ys) (Eq.sym (Fin.cast-is-id refl i)) +lookup-++ₗ (x ∷ xs) ys i = lookup-++ₗ xs ys i + +ADT-leaf∈⟦⟧ : ∀ v e₂ → v ∈ ADT.⟦ e₂ ⟧ → v ∈ listToIndexedSet (ADT-leafs e₂) +ADT-leaf∈⟦⟧ v (ADT.ADT.leaf .v) (c , refl) = zero , refl +ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) with c D +ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | true with ADT-leaf∈⟦⟧ v l (c , p) +ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | true | (i , p') = Fin.inject≤ i (ADT-leaf-count≤ₗ D l r) , Eq.trans p' (lookup-++ᵣ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) +ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | false with ADT-leaf∈⟦⟧ v r (c , p) +ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | false | (i , p') = (Fin.cast (Eq.sym (ADT-leaf-count-lemma D l r)) (ADT-leaf-count l Fin.↑ʳ i)) , Eq.trans p' (lookup-++ₗ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) + +ADT-leaf⊆⟦⟧ : ∀ e₂ → ADT.⟦ e₂ ⟧ ⊆ listToIndexedSet (ADT-leafs e₂) +ADT-leaf⊆⟦⟧ e₂ i = ADT-leaf∈⟦⟧ (ADT.⟦ e₂ ⟧ i) e₂ (i , refl) + +open import Data.List.Relation.Unary.AllPairs using (AllPairs; []; _∷_) +import Data.List.Relation.Unary.AllPairs.Properties as AllPairs +open import Data.List.Relation.Unary.Any using (here; there) +open import Data.List.Relation.Unary.All using (All; []; _∷_) +import Data.List.Relation.Binary.Subset.Propositional as List + +Unique : ∀ {ℓ} {A : Set ℓ} → List A → Set ℓ +Unique xs = AllPairs _≢_ xs + +Fin-reduce≥-injective : ∀ {m n} (i : Fin (m + n)) (j : Fin (m + n)) (m≤i : m ≤ Fin.toℕ i) (m≤j : m ≤ Fin.toℕ j) → Fin.reduce≥ i m≤i ≡ Fin.reduce≥ j m≤j → i ≡ j +Fin-reduce≥-injective {zero} {.(suc _)} zero j m≤i m≤j i≡j = i≡j +Fin-reduce≥-injective {zero} {.(suc _)} (suc i) j m≤i m≤j i≡j = i≡j +Fin-reduce≥-injective {suc m} {zero} (suc i) (suc j) m≤i m≤j i≡j = Eq.cong suc (Fin-reduce≥-injective i j (ℕ.≤-pred m≤i) (ℕ.≤-pred m≤j) i≡j) +Fin-reduce≥-injective {suc m} {suc n} (suc i) (suc j) m≤i m≤j i≡j = Eq.cong suc (Fin-reduce≥-injective i j (ℕ.≤-pred m≤i) (ℕ.≤-pred m≤j) i≡j) + +variants-cs-unique : ∀ n i j → i ≢ j → variants-cs n i ≢ variants-cs n j +variants-cs-unique zero zero zero i≢j = ⊥-elim (i≢j refl) +variants-cs-unique (suc n) i j i≢j cs-i≡cs-j with Fin.toℕ i -nonZero (ℕ.m^n>0 2 n)}}) i) (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) j) (i≢j ∘ Eq.subst-injective (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}})) (proj₂ (Rose-injective vs-i≡vs-j)) + +IndexedSet-⊆⇒List-⊆ : ∀ {n} (gen : VariantGenerator n) (l : List⁺ (Rose ∞ A)) → gen ⊆ listToIndexedSet l → List.tabulate gen List.⊆ List⁺.toList l +IndexedSet-⊆⇒List-⊆ gen l gen⊆l {x} (here refl) with gen⊆l zero +... | i , x∈l = Eq.subst (List._∈ (List⁺.toList l)) (Eq.sym x∈l) (List.∈-lookup {xs = List⁺.toList l} i) +IndexedSet-⊆⇒List-⊆ {suc n} gen l gen⊆l {x} (there x∈gen) = IndexedSet-⊆⇒List-⊆ {n} (gen ∘ suc) l (gen⊆l ∘ suc) x∈gen + +lemma5 : ∀ {ℓ} {A : Set ℓ} (u v : A) (xs ys : List A) → u ≢ v → u List.∈ (xs List.++ List.[ v ] List.++ ys) → u List.∈ (xs List.++ ys) +lemma5 u v [] ys u≢v (here u≡v) = ⊥-elim (u≢v u≡v) +lemma5 u v [] ys u≢v (there u∈ys) = u∈ys +lemma5 u v (x ∷ xs) ys u≢v (here u≡x) = here u≡x +lemma5 u v (x ∷ xs) ys u≢v (there u∈xs++v∷ys) = there (lemma5 u v xs ys u≢v u∈xs++v∷ys) + +∈∧∉⇒≢ : ∀ {ℓ} {A : Set ℓ} {y z : A} (xs : List A) → y List.∈ xs → All (z ≢_) xs → y ≢ z +∈∧∉⇒≢ (x ∷ xs) (here y≡x) (y≢x ∷ z∉xs) y≡z = y≢x (Eq.trans (Eq.sym y≡z) y≡x) +∈∧∉⇒≢ (x ∷ xs) (there y∈xs) (y≢x ∷ z∉xs) y≡z = ∈∧∉⇒≢ xs y∈xs z∉xs y≡z + +length≤ : ∀ {ℓ} {A : Set ℓ} (xs ys : List A) → Unique xs → xs List.⊆ ys → List.length xs ≤ List.length ys +length≤ [] ys unique-xs xs⊆ys = z≤n +length≤ (x ∷ xs) ys unique-xs xs⊆ys with List.∈-∃++ (xs⊆ys (here refl)) +length≤ (x ∷ xs) ys (x∉xs ∷ unique-xs) xs⊆ys | l , r , ys≡l++x∷r = + begin + List.length (x ∷ xs) + ≡⟨⟩ + suc (List.length xs) + ≤⟨ s≤s (length≤ xs (l List.++ r) unique-xs λ {y} y∈xs → lemma5 y x l r (∈∧∉⇒≢ xs y∈xs x∉xs) (Eq.subst (y List.∈_) ys≡l++x∷r (xs⊆ys (there y∈xs)))) ⟩ + suc (List.length (l List.++ r)) + ≡⟨ Eq.cong suc (List.length-++ l) ⟩ + suc (List.length l + List.length r) + ≡⟨ ℕ.+-suc (List.length l) (List.length r) ⟨ + List.length l + suc (List.length r) + ≡⟨⟩ + List.length l + List.length (x ∷ r) + ≡⟨ List.length-++ l ⟨ + List.length (l List.++ (x ∷ r)) + ≡⟨ Eq.cong List.length ys≡l++x∷r ⟨ + List.length ys + ∎ + where + open ℕ.≤-Reasoning + +lemma3 : ∀ n l → variants n ⊆ listToIndexedSet l → 2 ^ n ≤ List⁺.length l +lemma3 n l variants⊆l = + begin + 2 ^ n + ≡⟨ ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}} ⟨ + suc (pred (2 ^ n)) + ≡⟨ List.length-tabulate (variants n) ⟨ + List.length (List.tabulate (variants n)) + ≤⟨ length≤ (List.tabulate (variants n)) (List⁺.toList l) (variants-unique n) (IndexedSet-⊆⇒List-⊆ (variants n) l variants⊆l) ⟩ + List⁺.length l + ∎ + where + open ℕ.≤-Reasoning + +lemma2 : ∀ n e₂ → variants n ⊆ ADT.⟦ e₂ ⟧ → 2 ^ n ≤ sizeADT e₂ +lemma2 n e₂ variants⊆e₂ = + begin + 2 ^ n + ≤⟨ lemma3 n (ADT-leafs e₂) (⊆-trans variants⊆e₂ (ADT-leaf⊆⟦⟧ e₂)) ⟩ + ADT-leaf-count e₂ + ≤⟨ leafs-≤-size e₂ ⟩ + sizeADT e₂ + ∎ + where + open ℕ.≤-Reasoning + +lemma4 : ∀ n → 13 * (n * n) < 16 ^ n +lemma4 zero = s≤s z≤n +lemma4 (suc zero) = ℕ.+-monoʳ-≤ 14 z≤n +lemma4 (suc (suc n)) = go (suc n) + where + open ℕ.≤-Reasoning + + go : ∀ n → {{ℕ.NonZero n}} → 13 * ((1 + n) * (1 + n)) < 16 ^ (1 + n) + go n = + begin-strict + 13 * ((1 + n) * (1 + n)) + ≤⟨ ℕ.*-monoʳ-≤ 13 ( + begin + (1 + n) * (1 + n) + ≡⟨⟩ + 1 + n + n * (1 + n) + ≡⟨ Eq.cong (λ x → 1 + n + x) (ℕ.*-distribˡ-+ n 1 n) ⟩ + 1 + n + (n * 1 + n * n) + ≡⟨ Eq.cong (λ x → 1 + n + (x + n * n)) (ℕ.*-identityʳ n) ⟩ + 1 + n + (n + n * n) + ≡⟨ Eq.cong (λ x → 1 + x) (ℕ.+-assoc n n (n * n)) ⟨ + 1 + (n + n + n * n) + ≤⟨ ℕ.+-monoˡ-≤ (n + n + n * n) (ℕ.m≤n*m 1 n) ⟩ + (n * 1) + (n + n + n * n) + ≡⟨ Eq.cong (_+ (n + n + n * n)) (ℕ.*-identityʳ n) ⟩ + n + (n + n + n * n) + ≡⟨ ℕ.+-assoc n (n + n) (n * n) ⟨ + n + (n + n) + n * n + ≡⟨ Eq.cong (λ x → n + (n + x) + n * n) (ℕ.+-identityʳ n) ⟨ + n + (n + (n + 0)) + n * n + ≡⟨⟩ + 3 * n + n * n + ≤⟨ ℕ.+-monoˡ-≤ (n * n) (ℕ.*-monoʳ-≤ 3 (ℕ.m≤m*n n n)) ⟩ + 3 * (n * n) + n * n + ≡⟨ ℕ.+-comm (3 * (n * n)) (n * n) ⟩ + n * n + 3 * (n * n) + ≡⟨⟩ + 4 * (n * n) + ∎ + )⟩ + 13 * (4 * (n * n)) + ≤⟨ ℕ.*-monoˡ-≤ (4 * (n * n)) (ℕ.+-monoʳ-≤ 13 (z≤n {3})) ⟩ + 16 * (4 * (n * n)) + ≤⟨ ℕ.*-monoʳ-≤ 16 (ℕ.*-monoˡ-≤ (n * n) (ℕ.+-monoʳ-≤ 4 (z≤n {9}))) ⟩ + 16 * (13 * (n * n)) + <⟨ ℕ.*-monoʳ-< 16 (lemma4 n) ⟩ + 16 * 16 ^ n + ≡⟨⟩ + 16 ^ (1 + n) + ∎ + +lemma : ∀ n e₂ → CCC.CCCL , ADT.ADTL ⊢ e₁ (4 * n) ≣ e₂ → n * sizeCCC (e₁ (4 * n)) < sizeADT e₂ +lemma zero (ADT.ADT.leaf v) (e₁⊆e₂ , e₂⊆e₁) = s≤s z≤n +lemma zero (D ADT.ADT.⟨ l , r ⟩) (e₁⊆e₂ , e₂⊆e₁) = s≤s z≤n +lemma (suc m) e₂ (e₁⊆e₂ , e₂⊆e₁) = + begin-strict + n * sizeCCC (e₁ (4 * n)) + ≡⟨ Eq.cong (n *_) (size-e₁ (4 * n)) ⟩ + n * (1 + (4 * n) * 3) + ≡⟨ ℕ.*-distribˡ-+ n 1 (4 * n * 3) ⟩ + n * 1 + n * (4 * n * 3) + ≡⟨ Eq.cong (_+ n * (4 * n * 3)) (ℕ.*-identityʳ n) ⟩ + n + n * (4 * n * 3) + ≡⟨ Eq.cong (λ x → n + n * (x * 3)) (ℕ.*-comm 4 n) ⟩ + n + n * (n * 4 * 3) + ≡⟨ Eq.cong (λ x → n + n * x) (ℕ.*-assoc n 4 3) ⟩ + n + n * (n * (4 * 3)) + ≡⟨⟩ + n + n * (n * 12) + ≡⟨ Eq.cong (n +_) (ℕ.*-assoc n n 12) ⟨ + n + n * n * 12 + ≤⟨ ℕ.+-monoˡ-≤ (n * n * 12) (ℕ.m≤m*n n n) ⟩ + n * n + n * n * 12 + ≡⟨ Eq.cong (n * n +_) (ℕ.*-comm (n * n) 12) ⟩ + n * n + 12 * (n * n) + ≡⟨⟩ + 13 * (n * n) + <⟨ lemma4 n ⟩ + 16 ^ n + ≡⟨ ℕ.^-*-assoc 2 4 n ⟩ + 2 ^ (4 * n) + ≤⟨ lemma2 (4 * n) e₂ (⊆-trans (lemma1 (4 * n)) e₁⊆e₂) ⟩ + sizeADT e₂ + ∎ + where + open ℕ.≤-Reasoning + n = suc m + +ADTExpressive SizedADT +ADT Date: Sat, 7 Dec 2024 16:41:37 +0100 Subject: [PATCH 02/82] Factor out the syntactic expressiveness definitions --- src/Vatras/SyntacticExpressiveness.agda | 36 +++++++++++++++++++++++++ src/Vatras/Test.agda | 30 +++------------------ 2 files changed, 39 insertions(+), 27 deletions(-) create mode 100644 src/Vatras/SyntacticExpressiveness.agda diff --git a/src/Vatras/SyntacticExpressiveness.agda b/src/Vatras/SyntacticExpressiveness.agda new file mode 100644 index 00000000..97ee061c --- /dev/null +++ b/src/Vatras/SyntacticExpressiveness.agda @@ -0,0 +1,36 @@ +open import Vatras.Framework.Definitions using (𝔸) +module Vatras.SyntacticExpressiveness (A : 𝔸) where + +open import Data.Nat as ℕ using (ℕ; _≤_; _*_) +open import Data.Product using (_×_; Σ-syntax) +open import Relation.Nullary.Negation using (¬_) +open import Size using (∞) + +open import Vatras.Framework.Variants using (Rose) +open import Vatras.Framework.Relation.Expression (Rose ∞) using (_,_⊢_≣_) +open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) +open import Vatras.Lang.All.Fixed ℕ (Rose ∞) + +record SizedLang : Set₂ where + field + Lang : VariabilityLanguage (Rose ∞) + size : Expression Lang A → ℕ +open SizedLang + +_≤Size_ : SizedLang → SizedLang → Set₁ +L₁ ≤Size L₂ = + Σ[ n ∈ ℕ ] + ∀ (e₂ : Expression (Lang L₂) A) → + Σ[ e₁ ∈ Expression (Lang L₁) A ] + Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ + × size L₁ e₁ ≤ n * size L₂ e₂ + +_≥Expressive_ : SizedLang → SizedLang → Set₁ +L₁ ≥Expressive L₂ = L₁ ≤Size L₂ + +_>Expressive_ : SizedLang → SizedLang → Set₁ +L₁ >Expressive L₂ = ¬ (L₂ ≥Expressive L₁) + +-- TODO reflexivity +-- TODO transitivity +-- TODO antisymmetrie diff --git a/src/Vatras/Test.agda b/src/Vatras/Test.agda index 497d3505..3f058690 100644 --- a/src/Vatras/Test.agda +++ b/src/Vatras/Test.agda @@ -1,4 +1,3 @@ - open import Vatras.Framework.Definitions using (𝔸; atoms) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_; refl) module Vatras.Test (A : 𝔸) (a₁ a₂ : atoms A) (a₁≢a₂ : a₁ ≢ a₂) where @@ -15,10 +14,9 @@ import Data.List.Membership.Propositional as List import Data.List.Membership.Propositional.Properties as List open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_) import Data.List.NonEmpty.Properties as List⁺ -open import Data.Product using (_×_; _,_; Σ-syntax; proj₁; proj₂) +open import Data.Product using (_,_; proj₁; proj₂) open import Function using (_∘_) -open import Relation.Binary.Definitions using (DecidableEquality) -open import Relation.Nullary.Decidable using (Dec; does; yes; no) +open import Relation.Nullary.Decidable using (Dec; yes; no) open import Relation.Nullary.Negation using (¬_) open import Size using (Size; ∞) @@ -26,18 +24,11 @@ open import Vatras.Data.EqIndexedSet using (_≅_; ≅-trans; ≅-sym; _⊆_; open import Vatras.Framework.Variants using (Rose; Rose-injective) open import Vatras.Framework.VariantGenerator (Rose ∞) A using (VariantGenerator) open import Vatras.Framework.Relation.Expression (Rose ∞) using (_,_⊢_≣_) -open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) -open import Vatras.Framework.Properties.Soundness (Rose ∞) using (Sound) open import Vatras.Util.List using (find-or-last) open import Vatras.Lang.All.Fixed ℕ (Rose ∞) open import Vatras.Lang.CCC.Util using (leaf) -open import Vatras.Translation.LanguageMap -record SizedLang : Set₂ where - field - Lang : VariabilityLanguage (Rose ∞) - size : Expression Lang A → ℕ -open SizedLang +open import Vatras.SyntacticExpressiveness A using (SizedLang; _>Expressive_) sizeCCC : ∀ {i} → CCC.CCC i A → ℕ sizeCCC (a CCC.CCC.-< cs >-) = suc (List.sum (List.map sizeCCC cs)) @@ -59,21 +50,6 @@ SizedADT = record ; size = sizeADT } -_≤Size_ : SizedLang → SizedLang → Set₁ -L₁ ≤Size L₂ = - Σ[ n ∈ ℕ ] - ∀ (e₂ : Expression (Lang L₂) A) → - Σ[ e₁ ∈ Expression (Lang L₁) A ] - Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ - × size L₁ e₁ ≤ n * size L₂ e₂ - -_≥Expressive_ : SizedLang → SizedLang → Set₁ -L₁ ≥Expressive L₂ = L₁ ≤Size L₂ - -_>Expressive_ : SizedLang → SizedLang → Set₁ -L₁ >Expressive L₂ = ¬ (L₂ ≥Expressive L₁) - - e₁-cs : ℕ → ℕ → List (CCC.CCC ∞ A) e₁-cs zero D = [] e₁-cs (suc n) D = D CCC.CCC.⟨ leaf a₁ ∷ leaf a₂ ∷ [] ⟩ ∷ e₁-cs n (suc D) From a1215d87e4d1c57e96752e8202e807b0c468337a Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sat, 7 Dec 2024 16:53:33 +0100 Subject: [PATCH 03/82] Proof the expressiveness theorem for CCC instead of 2CC I expect `2CC < CCC` so `ADT < CCC` should follow using transitivity. --- src/Vatras/Test.agda | 73 +++++++++++++++++++++----------------------- 1 file changed, 34 insertions(+), 39 deletions(-) diff --git a/src/Vatras/Test.agda b/src/Vatras/Test.agda index 3f058690..0f0547b7 100644 --- a/src/Vatras/Test.agda +++ b/src/Vatras/Test.agda @@ -2,7 +2,7 @@ open import Vatras.Framework.Definitions using (𝔸; atoms) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_; refl) module Vatras.Test (A : 𝔸) (a₁ a₂ : atoms A) (a₁≢a₂ : a₁ ≢ a₂) where -open import Data.Bool using (Bool; true; false) +open import Data.Bool using (Bool; true; false; if_then_else_) open import Data.Empty using (⊥-elim) open import Data.Nat as ℕ using (ℕ; suc; zero; _≤_; z≤n; s≤s; _<_; _≮_; _Expressive_) -sizeCCC : ∀ {i} → CCC.CCC i A → ℕ -sizeCCC (a CCC.CCC.-< cs >-) = suc (List.sum (List.map sizeCCC cs)) -sizeCCC (D CCC.CCC.⟨ cs ⟩) = suc (List⁺.foldr₁ _+_ (List⁺.map sizeCCC cs)) +size2CC : ∀ {i} → 2CC.2CC i A → ℕ +size2CC (a 2CC.2CC.-< cs >-) = suc (List.sum (List.map size2CC cs)) +size2CC (D 2CC.2CC.⟨ l , r ⟩) = suc (size2CC l + size2CC r) -SizedCCC : SizedLang -SizedCCC = record - { Lang = CCC.CCCL - ; size = sizeCCC +Sized2CC : SizedLang +Sized2CC = record + { Lang = 2CC.2CCL + ; size = size2CC } sizeADT : ADT.ADT A → ℕ @@ -50,18 +49,18 @@ SizedADT = record ; size = sizeADT } -e₁-cs : ℕ → ℕ → List (CCC.CCC ∞ A) +e₁-cs : ℕ → ℕ → List (2CC.2CC ∞ A) e₁-cs zero D = [] -e₁-cs (suc n) D = D CCC.CCC.⟨ leaf a₁ ∷ leaf a₂ ∷ [] ⟩ ∷ e₁-cs n (suc D) +e₁-cs (suc n) D = D 2CC.2CC.⟨ a₁ 2CC.2CC.-< [] >- , a₂ 2CC.2CC.-< [] >- ⟩ ∷ e₁-cs n (suc D) -e₁ : ℕ → CCC.CCC ∞ A -e₁ n = a₁ CCC.CCC.-< e₁-cs n zero >- +e₁ : ℕ → 2CC.2CC ∞ A +e₁ n = a₁ 2CC.2CC.-< e₁-cs n zero >- -size-e₁-cs : ∀ n D → List.sum (List.map sizeCCC (e₁-cs n D)) ≡ n * 3 +size-e₁-cs : ∀ n D → List.sum (List.map size2CC (e₁-cs n D)) ≡ n * 3 size-e₁-cs zero D = refl size-e₁-cs (suc n) D = Eq.cong (3 +_) (size-e₁-cs n (suc D)) -size-e₁ : ∀ n → sizeCCC (e₁ n) ≡ 1 + n * 3 +size-e₁ : ∀ n → size2CC (e₁ n) ≡ 1 + n * 3 size-e₁ n = Eq.cong suc (size-e₁-cs n zero) variants-cs : ∀ n → Fin (2 ^ n) → List (Rose ∞ A) @@ -73,25 +72,21 @@ variants-cs (suc n) i with Fin.toℕ i -nonZero (ℕ.m^n>0 2 n)}}) i) >- -lemma1 : ∀ n → variants n ⊆ CCC.⟦ e₁ n ⟧ +lemma1 : ∀ n → variants n ⊆ 2CC.⟦ e₁ n ⟧ lemma1 n i = config n i' , Eq.cong (a₁ Rose.-<_>-) (go n i' zero λ o → Eq.cong (config n i') (ℕ.+-identityʳ o)) where i' = Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i - config : ∀ n → Fin (2 ^ n) → ℕ → ℕ - config zero zero k = 0 + config : ∀ n → Fin (2 ^ n) → ℕ → Bool + config zero zero k = true config (suc n) i k with Fin.toℕ i -) (go n i' zero λ o → Eq.c ... | yes j<2^m = ⊥-elim (j≮2^m j<2^m) ... | no _ = refl - go : ∀ m j D → (∀ o → config n i' (o + D) ≡ config m j o) → variants-cs m j ≡ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m D) + go : ∀ m j D → (∀ o → config n i' (o + D) ≡ config m j o) → variants-cs m j ≡ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m D) go zero zero D p = refl go (suc m) j D p with Fin.toℕ j - ∷ variants-cs m (Fin.fromℕ< k<2^m) ≡⟨ Eq.cong (a₁ Rose.-< [] >- ∷_) (go m (Fin.fromℕ< k<2^m) (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-<2^m m j o k<2^m))) ⟩ - a₁ Rose.-< [] >- ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + a₁ Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - CCC.⟦ find-or-last 0 (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) - ≡⟨ Eq.cong (λ x → CCC.⟦ find-or-last x (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ - CCC.⟦ find-or-last (config n i' D) (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + (if true then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ + (if config n i' D then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - CCC.⟦ D CCC.CCC.⟨ leaf a₁ ∷ leaf a₂ ∷ [] ⟩ ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + 2CC.⟦ D 2CC.2CC.⟨ a₁ 2CC.2CC.-< [] >- , a₂ 2CC.2CC.-< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ∎ ... | no k≮2^m | p' = begin a₂ Rose.-< [] >- ∷ variants-cs m j' ≡⟨ Eq.cong (a₂ Rose.-< [] >- ∷_) (go m j' (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-≮2^m m j o k≮2^m))) ⟩ - a₂ Rose.-< [] >- ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + a₂ Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - CCC.⟦ find-or-last 1 (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) - ≡⟨ Eq.cong (λ x → CCC.⟦ find-or-last x (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ - CCC.⟦ find-or-last (config n i' D) (leaf a₁ ∷ leaf a₂ ∷ []) ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + (if false then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ + (if config n i' D then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - CCC.⟦ D CCC.CCC.⟨ leaf a₁ ∷ leaf a₂ ∷ [] ⟩ ⟧ (config n i') ∷ List.map (λ e → CCC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + 2CC.⟦ D 2CC.2CC.⟨ a₁ 2CC.2CC.-< [] >- , a₂ 2CC.2CC.-< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ∎ where j' = Eq.subst Fin (ℕ.+-identityʳ (2 ^ m)) (Fin.reduce≥ j (ℕ.≮⇒≥ k≮2^m)) @@ -358,12 +353,12 @@ lemma4 (suc (suc n)) = go (suc n) 16 ^ (1 + n) ∎ -lemma : ∀ n e₂ → CCC.CCCL , ADT.ADTL ⊢ e₁ (4 * n) ≣ e₂ → n * sizeCCC (e₁ (4 * n)) < sizeADT e₂ +lemma : ∀ n e₂ → 2CC.2CCL , ADT.ADTL ⊢ e₁ (4 * n) ≣ e₂ → n * size2CC (e₁ (4 * n)) < sizeADT e₂ lemma zero (ADT.ADT.leaf v) (e₁⊆e₂ , e₂⊆e₁) = s≤s z≤n lemma zero (D ADT.ADT.⟨ l , r ⟩) (e₁⊆e₂ , e₂⊆e₁) = s≤s z≤n lemma (suc m) e₂ (e₁⊆e₂ , e₂⊆e₁) = begin-strict - n * sizeCCC (e₁ (4 * n)) + n * size2CC (e₁ (4 * n)) ≡⟨ Eq.cong (n *_) (size-e₁ (4 * n)) ⟩ n * (1 + (4 * n) * 3) ≡⟨ ℕ.*-distribˡ-+ n 1 (4 * n * 3) ⟩ @@ -395,6 +390,6 @@ lemma (suc m) e₂ (e₁⊆e₂ , e₂⊆e₁) = open ℕ.≤-Reasoning n = suc m -ADTExpressive SizedADT -ADTExpressive SizedADT +ADT<2CC (n , 2CC→ADT) with 2CC→ADT (e₁ (4 * n)) ... | e₂ , e₂≣e₁ , size-e₂≤size-e₁ = ℕ.≤⇒≯ size-e₂≤size-e₁ (lemma n e₂ (≅-sym e₂≣e₁)) From bee95189074aec0b7c0ceeda9152e6dcc5dd3c0d Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sun, 8 Dec 2024 13:51:27 +0100 Subject: [PATCH 04/82] =?UTF-8?q?Require=20=E2=89=A4Size=20for=20_; _*_) open import Data.Product using (_×_; Σ-syntax) open import Relation.Nullary.Negation using (¬_) open import Size using (∞) @@ -9,7 +9,6 @@ open import Size using (∞) open import Vatras.Framework.Variants using (Rose) open import Vatras.Framework.Relation.Expression (Rose ∞) using (_,_⊢_≣_) open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) -open import Vatras.Lang.All.Fixed ℕ (Rose ∞) record SizedLang : Set₂ where field @@ -25,11 +24,19 @@ L₁ ≤Size L₂ = Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ × size L₁ e₁ ≤ n * size L₂ e₂ -_≥Expressive_ : SizedLang → SizedLang → Set₁ -L₁ ≥Expressive L₂ = L₁ ≤Size L₂ +_=Size_ : SizedLang → SizedLang → Set₁ +L₁ =Size L₂ = L₁ ≤Size L₂ × L₂ ≤Size L₁ -_>Expressive_ : SizedLang → SizedLang → Set₁ -L₁ >Expressive L₂ = ¬ (L₂ ≥Expressive L₁) +_≱Size_ : SizedLang → SizedLang → Set₁ +L₁ ≱Size L₂ = + ∀ (n : ℕ) → + Σ[ e₁ ∈ Expression (Lang L₁) A ] + ∀ (e₂ : Expression (Lang L₂) A ) + → Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ + → size L₂ e₂ > n * size L₁ e₁ + +_Expressive_) +open import Vatras.SyntacticExpressiveness A using (SizedLang; _≱Size_) size2CC : ∀ {i} → 2CC.2CC i A → ℕ size2CC (a 2CC.2CC.-< cs >-) = suc (List.sum (List.map size2CC cs)) @@ -390,6 +390,5 @@ lemma (suc m) e₂ (e₁⊆e₂ , e₂⊆e₁) = open ℕ.≤-Reasoning n = suc m -ADT<2CC : Sized2CC >Expressive SizedADT -ADT<2CC (n , 2CC→ADT) with 2CC→ADT (e₁ (4 * n)) -... | e₂ , e₂≣e₁ , size-e₂≤size-e₁ = ℕ.≤⇒≯ size-e₂≤size-e₁ (lemma n e₂ (≅-sym e₂≣e₁)) +ADT<2CC : Sized2CC ≱Size SizedADT +ADT<2CC n = e₁ (4 * n) , λ e₂ e₁≣e₂ → lemma n e₂ e₁≣e₂ From 228612024467c328711269164c172da1293b5420 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sun, 8 Dec 2024 14:06:56 +0100 Subject: [PATCH 05/82] =?UTF-8?q?Prove=20that=20=3DSize,=20=E2=89=A4Size?= =?UTF-8?q?=20and=20_; _*_) -open import Data.Product using (_×_; Σ-syntax) +open import Data.Nat as ℕ using (ℕ; _≤_; _>_; _<_; _*_) +import Data.Nat.Properties as ℕ +open import Data.Product using (_×_; _,_; Σ-syntax; proj₁; proj₂) open import Relation.Nullary.Negation using (¬_) +import Relation.Binary.PropositionalEquality as Eq +open import Relation.Binary.Structures using (IsEquivalence; IsPreorder; IsPartialOrder; IsStrictPartialOrder) open import Size using (∞) +open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans) open import Vatras.Framework.Variants using (Rose) open import Vatras.Framework.Relation.Expression (Rose ∞) using (_,_⊢_≣_) open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) @@ -38,6 +42,186 @@ L₁ ≱Size L₂ = _ n * size L₁ (proj₁ (L₁≱L₂ (m * n))) + go n e₃ e₁≣e₃ = + begin-strict + n * size L₁ e₁ + <⟨ ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) + (begin + ℕ.suc (m * (n * size L₁ e₁)) + ≡⟨ Eq.cong ℕ.suc (ℕ.*-assoc m n (size L₁ e₁)) ⟨ + ℕ.suc (m * n * size L₁ e₁) + ≤⟨ ℕ.≤-trans e₂ n * size L₁ (proj₁ (L₁≱L₂ (m * n))) + go n e₃ e₁≣e₃ = ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) + (begin + ℕ.suc (m * (n * size L₁ e₁)) + ≡⟨ Eq.cong ℕ.suc (ℕ.*-assoc m n (size L₁ e₁)) ⟨ + ℕ.suc (m * n * size L₁ e₁) + ≤⟨ ℕ.≤-trans e₁ n * size L₃ (proj₁ (L₂→L₃ (proj₁ (L₂≱L₁ (m * n))))) + go n e₁ e₃≣e₁ = + begin-strict + n * size L₃ e₃ + ≤⟨ ℕ.*-monoʳ-≤ n e₃≤e₂ ⟩ + n * (m * size L₂ e₂) + ≡⟨ ℕ.*-assoc n m (size L₂ e₂) ⟨ + n * m * size L₂ e₂ + ≡⟨ Eq.cong (_* size L₂ e₂) (ℕ.*-comm n m) ⟩ + m * n * size L₂ e₂ + <⟨ e₂ Date: Sun, 8 Dec 2024 14:17:07 +0100 Subject: [PATCH 06/82] Rename temporary files to have proper names --- src/Vatras/{Test.agda => SyntacticExpressiveness/2CC SyntacticExpressiveness/2CC Date: Sun, 8 Dec 2024 14:24:37 +0100 Subject: [PATCH 07/82] Move the size definitions into a separate file --- .../SyntacticExpressiveness/2CC-) = suc (List.sum (List.map size2CC cs)) -size2CC (D 2CC.2CC.⟨ l , r ⟩) = suc (size2CC l + size2CC r) - -Sized2CC : SizedLang -Sized2CC = record - { Lang = 2CC.2CCL - ; size = size2CC - } - -sizeADT : ADT.ADT A → ℕ -sizeADT (ADT.ADT.leaf v) = suc zero -- TODO also count the variant -sizeADT (D ADT.ADT.⟨ l , r ⟩) = suc (sizeADT l + sizeADT r) - -SizedADT : SizedLang -SizedADT = record - { Lang = ADT.ADTL - ; size = sizeADT - } +open import Vatras.SyntacticExpressiveness A using (_≱Size_) +open import Vatras.SyntacticExpressiveness.Sizes ℕ A using (Sized2CC; size2CC; SizedADT; sizeADT) e₁-cs : ℕ → ℕ → List (2CC.2CC ∞ A) e₁-cs zero D = [] diff --git a/src/Vatras/SyntacticExpressiveness/Sizes.agda b/src/Vatras/SyntacticExpressiveness/Sizes.agda new file mode 100644 index 00000000..7c53c03a --- /dev/null +++ b/src/Vatras/SyntacticExpressiveness/Sizes.agda @@ -0,0 +1,30 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) +module Vatras.SyntacticExpressiveness.Sizes (F : 𝔽) (A : 𝔸) where + +open import Data.Nat using (ℕ; suc; zero; _+_) +import Data.List as List +open import Size using (∞) + +open import Vatras.Framework.Variants using (Rose) +open import Vatras.Lang.All.Fixed F (Rose ∞) +open import Vatras.SyntacticExpressiveness A using (SizedLang) + +size2CC : ∀ {i} → 2CC.2CC i A → ℕ +size2CC (a 2CC.2CC.-< cs >-) = suc (List.sum (List.map size2CC cs)) +size2CC (D 2CC.2CC.⟨ l , r ⟩) = suc (size2CC l + size2CC r) + +Sized2CC : SizedLang +Sized2CC = record + { Lang = 2CC.2CCL + ; size = size2CC + } + +sizeADT : ADT.ADT A → ℕ +sizeADT (ADT.ADT.leaf v) = suc zero -- TODO also count the variant +sizeADT (D ADT.ADT.⟨ l , r ⟩) = suc (sizeADT l + sizeADT r) + +SizedADT : SizedLang +SizedADT = record + { Lang = ADT.ADTL + ; size = sizeADT + } From c6a9a0e4da14d21a9c23f03151d10ad4d3b9d04f Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sun, 8 Dec 2024 22:19:57 +0100 Subject: [PATCH 08/82] =?UTF-8?q?Prove=202CC=20=E2=89=A4=20ADT=20to=20conc?= =?UTF-8?q?lude=202CC=20<=20ADT?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Vatras/Lang/2CC/Encode.agda | 58 ++++++++++++ .../SyntacticExpressiveness/2CC-) = a -< List.map encode cs >- + +confs : ⊤ ⇔ Config 2CCL +confs = record + { to = λ where tt _ → false + ; from = λ _ → tt + } + +2cc-encode-idemp : ∀ {A} (v : Rose ∞ A) → (c : Configuration) → ⟦ encode v ⟧ c ≡ v +2cc-encode-idemp {A} v@(a V.-< cs >-) c = + begin + ⟦ encode v ⟧ c + ≡⟨⟩ + a V.-< List.map (λ x → ⟦ x ⟧ c) (List.map encode cs) >- + ≡⟨ Eq.cong (a V.-<_>-) (map-∘ cs) ⟨ + a V.-< List.map (λ x → ⟦ encode x ⟧ c) cs >- + ≡⟨ Eq.cong (a V.-<_>-) (go cs) ⟩ + v + ∎ + where + open Eq.≡-Reasoning + + go : (cs' : List (Rose ∞ A)) → List.map (λ c' → ⟦ encode c' ⟧ c) cs' ≡ cs' + go [] = refl + go (c' ∷ cs') = Eq.cong₂ _∷_ (2cc-encode-idemp c' c) (go cs') + +preserves : ∀ {A} → (v : Rose ∞ A) + → Semantics (Variant-is-VL (Rose ∞)) v ≅[ to confs ][ from confs ] ⟦ encode v ⟧ +preserves {A} v = irrelevant-index-≅ v + (λ { tt → refl }) + (2cc-encode-idemp v) + (to confs) + (from confs) + +encoder : VariantEncoder (Rose ∞) 2CCL +encoder = record + { compile = encode + ; config-compiler = λ _ → confs + ; preserves = preserves + } diff --git a/src/Vatras/SyntacticExpressiveness/2CC-) = + begin + size2CC (encode (a Rose.-< cs >-)) + ≡⟨⟩ + size2CC (a 2CC.2CC.-< List.map encode cs >-) + ≡⟨⟩ + suc (List.sum (List.map size2CC (List.map encode cs))) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ + suc (List.sum (List.map (size2CC ∘ encode) cs)) + ≤⟨ s≤s (lemma3 (size2CC ∘ encode) sizeRose cs lemma2) ⟩ + suc (List.sum (List.map sizeRose cs)) + ≡⟨⟩ + sizeRose (a Rose.-< cs >-) + ∎ + where + open ℕ.≤-Reasoning + +lemma : ∀ (adt : ADT.ADT A) → size2CC (LanguageCompiler.compile ADT→2CC' adt) ≤ sizeADT adt +lemma (ADT.ADT.leaf v) = ℕ.m≤n⇒m≤1+n (lemma2 v) +lemma (D ADT.ADT.⟨ l , r ⟩) = + begin + size2CC (LanguageCompiler.compile ADT→2CC' (D ADT.ADT.⟨ l , r ⟩)) + ≡⟨⟩ + size2CC (D 2CC.2CC.⟨ LanguageCompiler.compile ADT→2CC' l , LanguageCompiler.compile ADT→2CC' r ⟩) + ≡⟨⟩ + suc (size2CC (LanguageCompiler.compile ADT→2CC' l) + size2CC (LanguageCompiler.compile ADT→2CC' r)) + ≤⟨ s≤s (ℕ.+-monoˡ-≤ (size2CC (LanguageCompiler.compile ADT→2CC' r)) (lemma l)) ⟩ + suc (sizeADT l + size2CC (LanguageCompiler.compile ADT→2CC' r)) + ≤⟨ s≤s (ℕ.+-monoʳ-≤ (sizeADT l) (lemma r)) ⟩ + suc (sizeADT l + sizeADT r) + ∎ + where + open ℕ.≤-Reasoning + +2CC≤ADT : Sized2CC ≤Size SizedADT +2CC≤ADT = 1 , λ adt → LanguageCompiler.compile ADT→2CC' adt , ≅-sym (≅[]→≅ (LanguageCompiler.preserves ADT→2CC' adt)) , Eq.subst (size2CC (LanguageCompiler.compile ADT→2CC' adt )≤_) (Eq.sym (ℕ.+-identityʳ (sizeADT adt))) (lemma adt) diff --git a/src/Vatras/SyntacticExpressiveness/Sizes.agda b/src/Vatras/SyntacticExpressiveness/Sizes.agda index 7c53c03a..04d95d58 100644 --- a/src/Vatras/SyntacticExpressiveness/Sizes.agda +++ b/src/Vatras/SyntacticExpressiveness/Sizes.agda @@ -9,6 +9,9 @@ open import Vatras.Framework.Variants using (Rose) open import Vatras.Lang.All.Fixed F (Rose ∞) open import Vatras.SyntacticExpressiveness A using (SizedLang) +sizeRose : ∀ {i} → Rose i A → ℕ +sizeRose (a Rose.-< cs >-) = suc (List.sum (List.map sizeRose cs)) + size2CC : ∀ {i} → 2CC.2CC i A → ℕ size2CC (a 2CC.2CC.-< cs >-) = suc (List.sum (List.map size2CC cs)) size2CC (D 2CC.2CC.⟨ l , r ⟩) = suc (size2CC l + size2CC r) @@ -20,7 +23,7 @@ Sized2CC = record } sizeADT : ADT.ADT A → ℕ -sizeADT (ADT.ADT.leaf v) = suc zero -- TODO also count the variant +sizeADT (ADT.ADT.leaf v) = suc (sizeRose v) sizeADT (D ADT.ADT.⟨ l , r ⟩) = suc (sizeADT l + sizeADT r) SizedADT : SizedLang From 49f019323cbcea29cb699d7136d846b6924f509d Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 9 Dec 2024 10:08:54 +0100 Subject: [PATCH 09/82] =?UTF-8?q?Prove=20that=20L=E2=82=81=20=E2=89=A4Size?= =?UTF-8?q?=20L=E2=82=82=20and=20L=E2=82=82=20=E2=89=B1Size=20L=E2=82=81?= =?UTF-8?q?=20cannot=20both=20be=20true?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Vatras/SyntacticExpressiveness.agda | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Vatras/SyntacticExpressiveness.agda b/src/Vatras/SyntacticExpressiveness.agda index 5a329967..ca4a46d5 100644 --- a/src/Vatras/SyntacticExpressiveness.agda +++ b/src/Vatras/SyntacticExpressiveness.agda @@ -225,3 +225,8 @@ L₁ Date: Mon, 9 Dec 2024 10:12:39 +0100 Subject: [PATCH 10/82] Use more representative variable names --- src/Vatras/SyntacticExpressiveness.agda | 42 ++++++++++++------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/Vatras/SyntacticExpressiveness.agda b/src/Vatras/SyntacticExpressiveness.agda index ca4a46d5..472fe6d5 100644 --- a/src/Vatras/SyntacticExpressiveness.agda +++ b/src/Vatras/SyntacticExpressiveness.agda @@ -56,8 +56,8 @@ L₁ n * size L₁ (proj₁ (L₁≱L₂ (m * n))) - go n e₃ e₁≣e₃ = + go : (n : ℕ) → (e₃ : Expression (Lang L₃) A) → Lang L₁ , Lang L₃ ⊢ proj₁ (L₁≱L₂ (m * n)) ≣ e₃ → size L₃ e₃ > n * size L₁ (proj₁ (L₁≱L₂ (m * n))) + go n e₃ e₁≅e₃ = begin-strict n * size L₁ e₁ <⟨ ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) @@ -111,25 +111,25 @@ L₁ n * size L₁ (proj₁ (L₁≱L₂ (m * n))) - go n e₃ e₁≣e₃ = ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) + go n e₃ e₁≅e₃ = ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) (begin ℕ.suc (m * (n * size L₁ e₁)) ≡⟨ Eq.cong ℕ.suc (ℕ.*-assoc m n (size L₁ e₁)) ⟨ @@ -145,19 +145,19 @@ L₁ n * size L₃ (proj₁ (L₂→L₃ (proj₁ (L₂≱L₁ (m * n))))) - go n e₁ e₃≣e₁ = + go n e₁ e₃≅e₁ = begin-strict n * size L₃ e₃ ≤⟨ ℕ.*-monoʳ-≤ n e₃≤e₂ ⟩ @@ -177,11 +177,11 @@ L₁ Date: Mon, 9 Dec 2024 10:37:36 +0100 Subject: [PATCH 11/82] Use shorter and more explicit notation for proofs --- src/Vatras/SyntacticExpressiveness.agda | 91 ++++++++----------------- 1 file changed, 27 insertions(+), 64 deletions(-) diff --git a/src/Vatras/SyntacticExpressiveness.agda b/src/Vatras/SyntacticExpressiveness.agda index 472fe6d5..76d7d1ac 100644 --- a/src/Vatras/SyntacticExpressiveness.agda +++ b/src/Vatras/SyntacticExpressiveness.agda @@ -50,14 +50,10 @@ L₁ n * size L₁ (proj₁ (L₁≱L₂ (m * n))) - go n e₃ e₁≅e₃ = + go : (e₃ : Expression (Lang L₃) A) → Lang L₁ , Lang L₃ ⊢ e₁ ≣ e₃ → size L₃ e₃ > n * size L₁ e₁ + go e₃ e₁≅e₃ with L₃→L₂ e₃ + go e₃ e₁≅e₃ | e₂ , e₂≅e₃ , e₂≤e₃ = begin-strict n * size L₁ e₁ <⟨ ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) @@ -97,7 +94,7 @@ L₁ n * size L₁ (proj₁ (L₁≱L₂ (m * n))) - go n e₃ e₁≅e₃ = ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) + go : (e₃ : Expression (Lang L₃) A) → Lang L₁ , Lang L₃ ⊢ e₁ ≣ e₃ → size L₃ e₃ > n * size L₁ e₁ + go e₃ e₁≅e₃ with L₃→L₂ e₃ + go e₃ e₁≅e₃ | e₂ , e₂≅e₃ , e₂≤e₃ = ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) (begin ℕ.suc (m * (n * size L₁ e₁)) ≡⟨ Eq.cong ℕ.suc (ℕ.*-assoc m n (size L₁ e₁)) ⟨ ℕ.suc (m * n * size L₁ e₁) - ≤⟨ ℕ.≤-trans e₁ n * size L₃ (proj₁ (L₂→L₃ (proj₁ (L₂≱L₁ (m * n))))) - go n e₁ e₃≅e₁ = + go : (e₁ : Expression (Lang L₁) A) → Lang L₃ , Lang L₁ ⊢ e₃ ≣ e₁ → size L₁ e₁ > n * size L₃ e₃ + go e₁ e₃≅e₁ = begin-strict n * size L₃ e₃ ≤⟨ ℕ.*-monoʳ-≤ n e₃≤e₂ ⟩ @@ -166,25 +142,12 @@ L₁ Date: Mon, 9 Dec 2024 11:44:10 +0100 Subject: [PATCH 12/82] =?UTF-8?q?Prove=20CCC=20=E2=89=A4=20NCC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../2CC\342\211\244ADT.agda" | 21 +----- .../CCC\342\211\244NCC.agda" | 70 +++++++++++++++++++ src/Vatras/SyntacticExpressiveness/Sizes.agda | 23 ++++++ src/Vatras/Util/List.agda | 24 ++++++- src/Vatras/Util/Vec.agda | 6 +- 5 files changed, 122 insertions(+), 22 deletions(-) create mode 100644 "src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" diff --git "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" index 39ff1b11..4105adaa 100644 --- "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" +++ "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" @@ -24,7 +24,7 @@ open import Vatras.Data.EqIndexedSet using (_≅_; ≅-trans; ≅-sym; ≅[]→ open import Vatras.Framework.Variants using (Rose; Rose-injective) open import Vatras.Framework.VariantGenerator (Rose ∞) A using (VariantGenerator) open import Vatras.Framework.Relation.Expression (Rose ∞) using (_,_⊢_≣_) -open import Vatras.Util.List using (find-or-last) +open import Vatras.Util.List using (find-or-last; sum-map-≤) open import Vatras.Lang.All.Fixed F (Rose ∞) open import Vatras.Translation.Lang.2CC.Rename using (2CC-rename) open import Vatras.Framework.Compiler using (LanguageCompiler) @@ -37,23 +37,6 @@ open import Vatras.Framework.Compiler using (_⊕_) ADT→2CC' : LanguageCompiler ADT.ADTL 2CC.2CCL ADT→2CC' = ADT→2CC encoder -lemma3 : ∀ {ℓ} {A : Set ℓ} (f g : A → ℕ) (xs : List A) → (∀ x → f x ≤ g x) → List.sum (List.map f xs) ≤ List.sum (List.map g xs) -lemma3 f g [] f≤g = z≤n -lemma3 f g (x ∷ xs) f≤g = - begin - List.sum (List.map f (x ∷ xs)) - ≡⟨⟩ - f x + List.sum (List.map f xs) - ≤⟨ ℕ.+-monoˡ-≤ (List.sum (List.map f xs)) (f≤g x) ⟩ - g x + List.sum (List.map f xs) - ≤⟨ ℕ.+-monoʳ-≤ (g x) (lemma3 f g xs f≤g) ⟩ - g x + List.sum (List.map g xs) - ≡⟨⟩ - List.sum (List.map g (x ∷ xs)) - ∎ - where - open ℕ.≤-Reasoning - lemma2 : ∀ {i} (v : Rose i A) → size2CC (encode v) ≤ sizeRose v lemma2 (a Rose.-< cs >-) = begin @@ -64,7 +47,7 @@ lemma2 (a Rose.-< cs >-) = suc (List.sum (List.map size2CC (List.map encode cs))) ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ suc (List.sum (List.map (size2CC ∘ encode) cs)) - ≤⟨ s≤s (lemma3 (size2CC ∘ encode) sizeRose cs lemma2) ⟩ + ≤⟨ s≤s (sum-map-≤ (size2CC ∘ encode) sizeRose cs lemma2) ⟩ suc (List.sum (List.map sizeRose cs)) ≡⟨⟩ sizeRose (a Rose.-< cs >-) diff --git "a/src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" "b/src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" new file mode 100644 index 00000000..e44aee95 --- /dev/null +++ "b/src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" @@ -0,0 +1,70 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸) +module Vatras.SyntacticExpressiveness.CCC≤NCC (F : 𝔽) (A : 𝔸) where + +open import Data.Nat as ℕ using (suc; _≤_; s≤s) +import Data.Nat.Properties as ℕ +import Data.List as List +open import Data.Vec as Vec using (_∷_) +import Data.Vec.Properties as Vec +import Data.List.Properties as List +import Data.List.NonEmpty as List⁺ +open import Data.Product using (_,_) +open import Function using (_∘_) +import Relation.Binary.PropositionalEquality as Eq +open import Size using (Size; ∞) + +open import Vatras.Data.EqIndexedSet using (≅-sym; ≅[]→≅) +open import Vatras.Framework.Variants using (Rose) +import Vatras.Util.List as List +open import Vatras.Util.Nat.AtLeast using (ℕ≥; sucs) +import Vatras.Util.Vec as Vec +open import Vatras.Lang.All.Fixed F (Rose ∞) +open import Vatras.Framework.Compiler using (LanguageCompiler) +open import Vatras.Translation.LanguageMap using (NCC→CCC) +open import Vatras.SyntacticExpressiveness A using (_≤Size_) +open import Vatras.SyntacticExpressiveness.Sizes F A using (SizedNCC; sizeNCC; SizedCCC; sizeCCC) + +lemma : ∀ {i} (n : ℕ≥ 2) (ncc : NCC.NCC n i A) → sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc) ≤ sizeNCC n ncc +lemma (sucs n) (a NCC.NCC.-< cs >-) = + begin + sizeCCC (LanguageCompiler.compile (NCC→CCC (sucs n)) (a NCC.NCC.-< cs >-)) + ≡⟨⟩ + sizeCCC (a CCC.CCC.-< List.map (LanguageCompiler.compile (NCC→CCC (sucs n))) cs >-) + ≡⟨⟩ + suc (List.sum (List.map sizeCCC (List.map (LanguageCompiler.compile (NCC→CCC (sucs n))) cs))) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ + suc (List.sum (List.map (sizeCCC ∘ LanguageCompiler.compile (NCC→CCC (sucs n))) cs)) + ≤⟨ s≤s (List.sum-map-≤ (sizeCCC ∘ LanguageCompiler.compile (NCC→CCC (sucs n))) (sizeNCC (sucs n)) cs (lemma (sucs n))) ⟩ + suc (List.sum (List.map (sizeNCC (sucs n)) cs)) + ≡⟨⟩ + sizeNCC (sucs n) (a NCC.NCC.-< cs >-) + ∎ + where + open ℕ.≤-Reasoning +lemma (sucs n) (D NCC.NCC.⟨ c ∷ cs ⟩) = + begin + sizeCCC (LanguageCompiler.compile (NCC→CCC (sucs n)) (D NCC.NCC.⟨ c ∷ cs ⟩)) + ≡⟨⟩ + sizeCCC (D CCC.⟨ List⁺.fromVec (Vec.map (LanguageCompiler.compile (NCC→CCC (sucs n))) (c ∷ cs)) ⟩) + ≡⟨⟩ + suc (List.sum (List.map sizeCCC (List⁺.toList (List⁺.fromVec (Vec.map (LanguageCompiler.compile (NCC→CCC (sucs n))) (c ∷ cs)))))) + ≡⟨⟩ + suc (List.sum (List.map sizeCCC (Vec.toList (Vec.map (LanguageCompiler.compile (NCC→CCC (sucs n))) (c ∷ cs))))) + ≡⟨ Eq.cong (λ x → suc (List.sum (List.map sizeCCC x))) (Vec.toList-map (LanguageCompiler.compile (NCC→CCC (sucs n))) (c ∷ cs)) ⟩ + suc (List.sum (List.map sizeCCC (List.map (LanguageCompiler.compile (NCC→CCC (sucs n))) (Vec.toList (c ∷ cs))))) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ (Vec.toList (c ∷ cs))) ⟨ + suc (List.sum (List.map (sizeCCC ∘ LanguageCompiler.compile (NCC→CCC (sucs n))) (Vec.toList (c ∷ cs)))) + ≤⟨ s≤s (List.sum-map-≤ (sizeCCC ∘ LanguageCompiler.compile (NCC→CCC (sucs n))) (sizeNCC (sucs n)) (Vec.toList (c ∷ cs)) (lemma (sucs n))) ⟩ + suc (List.sum (List.map (sizeNCC (sucs n)) (Vec.toList (c ∷ cs)))) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (Vec.toList-map (sizeNCC (sucs n)) (c ∷ cs)) ⟨ + suc (List.sum (Vec.toList (Vec.map (sizeNCC (sucs n)) (c ∷ cs)))) + ≡⟨ Eq.cong suc (Vec.sum-toList (Vec.map (sizeNCC (sucs n)) (c ∷ cs))) ⟩ + suc (Vec.sum (Vec.map (sizeNCC (sucs n)) (c ∷ cs))) + ≡⟨⟩ + sizeNCC (sucs n) (D NCC.NCC.⟨ c ∷ cs ⟩) + ∎ + where + open ℕ.≤-Reasoning + +CCC≤NCC : (n : ℕ≥ 2) → SizedCCC ≤Size SizedNCC n +CCC≤NCC n = 1 , λ ncc → LanguageCompiler.compile (NCC→CCC n) ncc , ≅-sym (≅[]→≅ (LanguageCompiler.preserves (NCC→CCC n) ncc)) , Eq.subst (sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc )≤_) (Eq.sym (ℕ.+-identityʳ (sizeNCC n ncc))) (lemma n ncc) diff --git a/src/Vatras/SyntacticExpressiveness/Sizes.agda b/src/Vatras/SyntacticExpressiveness/Sizes.agda index 04d95d58..b97a8563 100644 --- a/src/Vatras/SyntacticExpressiveness/Sizes.agda +++ b/src/Vatras/SyntacticExpressiveness/Sizes.agda @@ -3,8 +3,11 @@ module Vatras.SyntacticExpressiveness.Sizes (F : 𝔽) (A : 𝔸) where open import Data.Nat using (ℕ; suc; zero; _+_) import Data.List as List +import Data.List.NonEmpty as List⁺ +import Data.Vec as Vec open import Size using (∞) +open import Vatras.Util.Nat.AtLeast using (ℕ≥) open import Vatras.Framework.Variants using (Rose) open import Vatras.Lang.All.Fixed F (Rose ∞) open import Vatras.SyntacticExpressiveness A using (SizedLang) @@ -22,6 +25,26 @@ Sized2CC = record ; size = size2CC } +sizeNCC : ∀ {i} n → NCC.NCC n i A → ℕ +sizeNCC n (a NCC.NCC.-< cs >-) = suc (List.sum (List.map (sizeNCC n) cs)) +sizeNCC n (D NCC.NCC.⟨ cs ⟩) = suc (Vec.sum (Vec.map (sizeNCC n) cs)) + +SizedNCC : ℕ≥ 2 → SizedLang +SizedNCC n = record + { Lang = NCC.NCCL n + ; size = sizeNCC n + } + +sizeCCC : ∀ {i} → CCC.CCC i A → ℕ +sizeCCC (a CCC.CCC.-< cs >-) = suc (List.sum (List.map sizeCCC cs)) +sizeCCC (D CCC.CCC.⟨ cs ⟩) = suc (List.sum (List.map sizeCCC (List⁺.toList cs))) + +SizedCCC : SizedLang +SizedCCC = record + { Lang = CCC.CCCL + ; size = sizeCCC + } + sizeADT : ADT.ADT A → ℕ sizeADT (ADT.ADT.leaf v) = suc (sizeRose v) sizeADT (D ADT.ADT.⟨ l , r ⟩) = suc (sizeADT l + sizeADT r) diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index bcc5981e..3e889a0d 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -6,7 +6,7 @@ module Vatras.Util.List where open import Data.Bool using (Bool; true; false) open import Data.Fin using (Fin) open import Data.Nat using (ℕ; suc; zero; NonZero; _+_; _∸_; _⊔_; _≤_; _<_; s≤s; z≤n) -open import Data.Nat.Properties using (m≤m+n) +open import Data.Nat.Properties as ℕ using (m≤m+n) open import Data.List as List using (List; []; _∷_; lookup; foldr; _++_) open import Data.List.Properties using (map-id; length-++) open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_; toList; _⁺++⁺_) renaming (map to map⁺) @@ -15,7 +15,6 @@ open import Vatras.Util.Nat.AtLeast as ℕ≥ using (ℕ≥; sucs) open import Function using (id; _∘_; flip) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≗_; refl) -open Eq.≡-Reasoning -- true iff the given list is empty empty? : ∀ {A : Set} → List A → Bool @@ -69,6 +68,8 @@ map-find-or-last f (suc i) (x ∷ y ∷ zs) = ≡⟨⟩ (find-or-last (suc i) ∘ map⁺ f) (x ∷ y ∷ zs) ∎ + where + open Eq.≡-Reasoning find-or-last⇒lookup : ∀ {ℓ} {A : Set ℓ} {i : ℕ} → (x : A) @@ -128,7 +129,26 @@ find-or-last-prepend-∸ {n = suc n} (x ∷ z ∷ zs) ys (s≤s smol) = ≡⟨⟩ find-or-last (suc n ∸ List⁺.length (x ∷ z ∷ zs)) ys ∎ + where + open Eq.≡-Reasoning -- Todo: Contribute this to Agda stdlib map⁺-id : ∀ {ℓ} {A : Set ℓ} → map⁺ id ≗ id {A = List⁺ A} map⁺-id (head ∷ tail) = Eq.cong (head ∷_) (map-id tail) + +sum-map-≤ : ∀ {ℓ} {A : Set ℓ} (f g : A → ℕ) (xs : List A) → (∀ x → f x ≤ g x) → List.sum (List.map f xs) ≤ List.sum (List.map g xs) +sum-map-≤ f g [] f≤g = z≤n +sum-map-≤ f g (x ∷ xs) f≤g = + begin + List.sum (List.map f (x ∷ xs)) + ≡⟨⟩ + f x + List.sum (List.map f xs) + ≤⟨ ℕ.+-monoˡ-≤ (List.sum (List.map f xs)) (f≤g x) ⟩ + g x + List.sum (List.map f xs) + ≤⟨ ℕ.+-monoʳ-≤ (g x) (sum-map-≤ f g xs f≤g) ⟩ + g x + List.sum (List.map g xs) + ≡⟨⟩ + List.sum (List.map g (x ∷ xs)) + ∎ + where + open ℕ.≤-Reasoning diff --git a/src/Vatras/Util/Vec.agda b/src/Vatras/Util/Vec.agda index d573888a..4cab8cec 100644 --- a/src/Vatras/Util/Vec.agda +++ b/src/Vatras/Util/Vec.agda @@ -4,7 +4,7 @@ open import Data.Fin as Fin using (Fin; zero; suc) open import Data.List as List using (List; []; _∷_) open import Data.List.NonEmpty as List⁺ using (_∷_) import Data.List.Properties as List -open import Data.Nat as ℕ using (ℕ; zero; suc; _≤_; s≤s; z≤n) +open import Data.Nat as ℕ using (ℕ; zero; suc; _≤_; s≤s; z≤n; _+_) open import Data.Vec as Vec using (Vec; []; _∷_) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl) import Vatras.Util.List as List @@ -67,3 +67,7 @@ zipWith₂ : ∀ {ℓA ℓB ℓC} {A : Set ℓA} {B : Set ℓB} {C : Set ℓC} { → Vec.zipWith (λ x y → f y) xs ys ≡ Vec.map f ys zipWith₂ f [] [] = refl zipWith₂ f (x ∷ xs) (y ∷ ys) = Eq.cong (f y ∷_) (zipWith₂ f xs ys) + +sum-toList : ∀ {n : ℕ} → (xs : Vec ℕ n) → List.sum (Vec.toList xs) ≡ Vec.sum xs +sum-toList [] = refl +sum-toList (x ∷ xs) = Eq.cong (x +_) (sum-toList xs) From d1c80b296d78748b4ef26479031854bfc17ee264 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Thu, 12 Dec 2024 14:42:13 +0100 Subject: [PATCH 13/82] Prove 2CC < CCC --- .../2CC\342\211\244CCC.agda" | 464 ++++++++++++++++++ src/Vatras/Util/List.agda | 91 +++- 2 files changed, 552 insertions(+), 3 deletions(-) create mode 100644 "src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" diff --git "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" new file mode 100644 index 00000000..d4573ea5 --- /dev/null +++ "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" @@ -0,0 +1,464 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) +open import Vatras.Util.Nat.AtLeast as ℕ≥ using (ℕ≥; sucs) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl; _≢_) +open import Data.Nat as ℕ using (ℕ; zero; suc; pred; _≤_; z≤n; s≤s; _<_; _>_; _+_; _∸_; _*_; _⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ≤ᵇ n)) +>⇒¬≤ᵇ (s≤s z≤n) = tt +>⇒¬≤ᵇ (s≤s (s≤s m>n)) = >⇒¬≤ᵇ (s≤s m>n) + +conf : CCC.Configuration F → 2CC.Configuration (F × ℕ) +conf config (f , n) = config f ≤ᵇ n + +fnoc-rec : ℕ → ℕ → 2CC.Configuration (F × ℕ) → CCC.Configuration F +fnoc-rec zero n config f = n +fnoc-rec (suc limit) n config f with config (f , n) +fnoc-rec (suc limit) n config f | true = n +fnoc-rec (suc limit) n config f | false = fnoc-rec limit (suc n) config f + +fnoc : ℕ → 2CC.Configuration (F × ℕ) → CCC.Configuration F +fnoc limit config f = fnoc-rec limit zero config f + +fnoc-rec-false : + ∀ (config : 2CC.Configuration (F × ℕ)) (D : F) + → (limit n k : ℕ) + → k < fnoc-rec limit n config D + → (∀ (k' : ℕ) → k' < n → config (D , k') ≡ false) + → config (D , k) ≡ false +fnoc-rec-false config D zero n k k-) = s≤s z≤n + 1≤sizeCCC (D CCC.CCC.⟨ cs ⟩) = s≤s z≤n + + max-dimension : ∀ {i} → CCC.CCC F i A → ℕ + max-dimension (a CCC.CCC.-< cs >-) = List.max (List.map max-dimension cs) + max-dimension (D CCC.CCC.⟨ cs ⟩) = List⁺.length cs ⊔ List.max (List.map max-dimension (List⁺.toList cs)) + + choice-list : F → ℕ → 2CC.2CC (F × ℕ) ∞ A → List (2CC.2CC (F × ℕ) ∞ A) → 2CC.2CC (F × ℕ) ∞ A + choice-list D n c₁ [] = c₁ + choice-list D n c₁ (c₂ ∷ []) = (D , n) 2CC.2CC.⟨ c₁ , c₂ ⟩ + choice-list D n c₁ (c₂ ∷ c₃ ∷ cs) = (D , n) 2CC.2CC.⟨ c₁ , choice-list D (suc n) c₂ (c₃ ∷ cs) ⟩ + + choice-list-size : + ∀ (D : F) (n : ℕ) + → (c : 2CC.2CC (F × ℕ) ∞ A) + → (cs : List (2CC.2CC (F × ℕ) ∞ A)) + → size2CC (F × ℕ) A (choice-list D n c cs) ≡ List.length cs + List.sum (List.map (size2CC (F × ℕ) A) (c ∷ cs)) + choice-list-size D n c₁ [] = Eq.sym (ℕ.+-identityʳ (size2CC (F × ℕ) A c₁)) + choice-list-size D n c₁ (c₂ ∷ []) = + begin + size2CC (F × ℕ) A (choice-list D n c₁ (c₂ ∷ [])) + ≡⟨⟩ + size2CC (F × ℕ) A ((D , n) 2CC.2CC.⟨ c₁ , c₂ ⟩) + ≡⟨⟩ + suc (size2CC (F × ℕ) A c₁ + size2CC (F × ℕ) A c₂) + ≡⟨ Eq.cong (λ x → suc (size2CC (F × ℕ) A c₁ + x)) (ℕ.+-identityʳ (size2CC (F × ℕ) A c₂)) ⟨ + suc (size2CC (F × ℕ) A c₁ + (size2CC (F × ℕ) A c₂ + 0)) + ≡⟨⟩ + List.length (c₂ ∷ []) + List.sum (List.map (size2CC (F × ℕ) A) (c₁ ∷ c₂ ∷ [])) + ∎ + where + open Eq.≡-Reasoning + choice-list-size D n c₁ (c₂ ∷ c₃ ∷ cs) = + begin + size2CC (F × ℕ) A (choice-list D n c₁ (c₂ ∷ c₃ ∷ cs)) + ≡⟨⟩ + size2CC (F × ℕ) A ((D , n) 2CC.2CC.⟨ c₁ , choice-list D (suc n) c₂ (c₃ ∷ cs) ⟩) + ≡⟨⟩ + suc (size2CC (F × ℕ) A c₁ + size2CC (F × ℕ) A (choice-list D (suc n) c₂ (c₃ ∷ cs))) + ≡⟨ Eq.cong (λ x → suc (size2CC (F × ℕ) A c₁ + x)) (choice-list-size D (suc n) c₂ (c₃ ∷ cs)) ⟩ + suc (size2CC (F × ℕ) A c₁ + (List.length (c₃ ∷ cs) + List.sum (List.map (size2CC (F × ℕ) A) (c₂ ∷ c₃ ∷ cs)))) + ≡⟨ Eq.cong suc (ℕ.+-assoc (size2CC (F × ℕ) A c₁) (List.length (c₃ ∷ cs)) (List.sum (List.map (size2CC (F × ℕ) A) (c₂ ∷ c₃ ∷ cs)))) ⟨ + suc (size2CC (F × ℕ) A c₁ + List.length (c₃ ∷ cs) + List.sum (List.map (size2CC (F × ℕ) A) (c₂ ∷ c₃ ∷ cs))) + ≡⟨ Eq.cong (λ x → suc (x + List.sum (List.map (size2CC (F × ℕ) A) (c₂ ∷ c₃ ∷ cs)))) (ℕ.+-comm (size2CC (F × ℕ) A c₁) (List.length (c₃ ∷ cs))) ⟩ + suc (List.length (c₃ ∷ cs) + size2CC (F × ℕ) A c₁ + List.sum (List.map (size2CC (F × ℕ) A) (c₂ ∷ c₃ ∷ cs))) + ≡⟨ Eq.cong suc (ℕ.+-assoc (List.length (c₃ ∷ cs)) (size2CC (F × ℕ) A c₁) (List.sum (List.map (size2CC (F × ℕ) A) (c₂ ∷ c₃ ∷ cs)))) ⟩ + suc (List.length (c₃ ∷ cs) + (size2CC (F × ℕ) A c₁ + List.sum (List.map (size2CC (F × ℕ) A) (c₂ ∷ c₃ ∷ cs)))) + ≡⟨⟩ + List.length (c₂ ∷ c₃ ∷ cs) + List.sum (List.map (size2CC (F × ℕ) A) (c₁ ∷ c₂ ∷ c₃ ∷ cs)) + ∎ + where + open Eq.≡-Reasoning + + translate : ∀ {i} + → CCC.CCC F i A + → 2CC.2CC (F × ℕ) ∞ A + translate (a CCC.CCC.-< cs >-) = a 2CC.2CC.-< List.map translate cs >- + translate (D CCC.CCC.⟨ c ∷ cs ⟩) = choice-list D zero (translate c) (List.map translate cs) + + translate-size : ∀ {i} + → (ccc : CCC.CCC F i A) + → size2CC (F × ℕ) A (translate ccc) < 2 * sizeCCC F A ccc + translate-size (a CCC.CCC.-< cs >-) = + begin-strict + size2CC (F × ℕ) A (translate (a CCC.CCC.-< cs >-)) + ≡⟨⟩ + size2CC (F × ℕ) A (a 2CC.2CC.-< List.map translate cs >-) + ≡⟨⟩ + suc (List.sum (List.map (size2CC (F × ℕ) A) (List.map translate cs))) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ + suc (List.sum (List.map (size2CC (F × ℕ) A ∘ translate) cs)) + ≤⟨ s≤s (List.sum-map-≤ (size2CC (F × ℕ) A ∘ translate) (λ c → 2 * sizeCCC F A c) cs (ℕ.<⇒≤ ∘ translate-size)) ⟩ + suc (List.sum (List.map (λ c → 2 * sizeCCC F A c) cs)) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟩ + suc (List.sum (List.map (2 *_) (List.map (sizeCCC F A) cs))) + ≡⟨ Eq.cong suc (List.sum-* 2 (List.map (sizeCCC F A) cs)) ⟩ + suc (2 * (List.sum (List.map (sizeCCC F A) cs))) + ≡⟨⟩ + 1 + 2 * (List.sum (List.map (sizeCCC F A) cs)) + <⟨ ℕ.+-monoˡ-< (2 * (List.sum (List.map (sizeCCC F A) cs))) {x = 1} {y = 2} (ℕ.n<1+n 1) ⟩ + 2 + 2 * (List.sum (List.map (sizeCCC F A) cs)) + ≡⟨ ℕ.*-suc 2 (List.sum (List.map (sizeCCC F A) cs)) ⟨ + 2 * (suc (List.sum (List.map (sizeCCC F A) cs))) + ≡⟨⟩ + 2 * sizeCCC F A (a CCC.CCC.-< cs >-) + ∎ + where + open ℕ.≤-Reasoning + translate-size (D CCC.CCC.⟨ c ∷ cs ⟩) = + begin-strict + size2CC (F × ℕ) A (translate (D CCC.CCC.⟨ c ∷ cs ⟩)) + ≡⟨⟩ + size2CC (F × ℕ) A (choice-list D zero (translate c) (List.map translate cs)) + ≡⟨ choice-list-size D zero (translate c) (List.map translate cs) ⟩ + List.length (List.map translate cs) + List.sum (List.map (size2CC (F × ℕ) A) (List.map translate (c ∷ cs))) + ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + List.sum x) (List.map-∘ (c ∷ cs)) ⟨ + List.length (List.map translate cs) + List.sum (List.map (size2CC (F × ℕ) A ∘ translate) (c ∷ cs)) + ≤⟨ ℕ.+-monoʳ-≤ (List.length (List.map translate cs)) (List.sum-map-< (size2CC (F × ℕ) A ∘ translate) (λ c → 2 * sizeCCC F A c) (c ∷ cs) translate-size) ⟩ + List.length (List.map translate cs) + (List.sum (List.map (λ c → 2 * sizeCCC F A c) (c ∷ cs)) ∸ List.length (c ∷ cs)) + ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + (List.sum x ∸ List.length (c ∷ cs))) (List.map-∘ {g = 2 *_} {f = sizeCCC F A} (c ∷ cs)) ⟩ + List.length (List.map translate cs) + (List.sum (List.map (2 *_) (List.map (sizeCCC F A) (c ∷ cs))) ∸ List.length (c ∷ cs)) + ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + (x ∸ List.length (c ∷ cs))) (List.sum-* 2 (List.map (sizeCCC F A) (c ∷ cs))) ⟩ + List.length (List.map translate cs) + (2 * List.sum (List.map (sizeCCC F A) (c ∷ cs)) ∸ List.length (c ∷ cs)) + ≡⟨ Eq.cong (_+ (2 * List.sum (List.map (sizeCCC F A) (c ∷ cs)) ∸ List.length (c ∷ cs))) (List.length-map translate cs) ⟩ + List.length cs + (2 * List.sum (List.map (sizeCCC F A) (c ∷ cs)) ∸ List.length (c ∷ cs)) + ≡⟨ ℕ.+-∸-assoc (List.length cs) ( + begin + List.length (c ∷ cs) + ≡⟨ ℕ.*-identityʳ (List.length (c ∷ cs)) ⟨ + List.length (c ∷ cs) * 1 + ≡⟨ List.sum-replicate (List.length (c ∷ cs)) 1 ⟨ + List.sum (List.replicate (List.length (c ∷ cs)) 1) + ≡⟨ Eq.cong List.sum (List.map-const 1 (c ∷ cs)) ⟨ + List.sum (List.map (const 1) (c ∷ cs)) + ≤⟨ List.sum-map-≤ (const 1) (sizeCCC F A) (c ∷ cs) 1≤sizeCCC ⟩ + List.sum (List.map (sizeCCC F A) (c ∷ cs)) + ≤⟨ ℕ.m≤n*m (List.sum (List.map (sizeCCC F A) (c ∷ cs))) 2 ⟩ + 2 * List.sum (List.map (sizeCCC F A) (c ∷ cs)) + ∎) + ⟨ + (List.length cs + 2 * List.sum (List.map (sizeCCC F A) (c ∷ cs))) ∸ List.length (c ∷ cs) + ≤⟨ ℕ.∸-monoʳ-≤ (List.length cs + 2 * List.sum (List.map (sizeCCC F A) (c ∷ cs))) (ℕ.n≤1+n (List.length cs)) ⟩ + (List.length cs + 2 * List.sum (List.map (sizeCCC F A) (c ∷ cs))) ∸ List.length cs + ≡⟨ ℕ.m+n∸m≡n (List.length cs) (2 * List.sum (List.map (sizeCCC F A) (c ∷ cs))) ⟩ + 2 * List.sum (List.map (sizeCCC F A) (c ∷ cs)) + <⟨ ℕ.*-monoʳ-< 2 (ℕ.n<1+n (List.sum (List.map (sizeCCC F A) (c ∷ cs)))) ⟩ + 2 * suc (List.sum (List.map (sizeCCC F A) (c ∷ cs))) + ≡⟨⟩ + 2 * sizeCCC F A (D CCC.CCC.⟨ c ∷ cs ⟩) + ∎ + where + open ℕ.≤-Reasoning + + translate-preserves-⊆ : ∀ {i} + → (e : CCC.CCC F i A) + → (limit : ℕ) + → max-dimension e ≤ limit + → 2CC.⟦ translate e ⟧ ⊆[ fnoc limit ] CCC.⟦ e ⟧ + translate-preserves-⊆ e@(a CCC.CCC.-< cs >-) limit max-dim≤limit config = + begin + 2CC.⟦ translate (a CCC.CCC.-< cs >-) ⟧ config + ≡⟨⟩ + 2CC.⟦ a 2CC.2CC.-< List.map translate cs >- ⟧ config + ≡⟨⟩ + a Rose.-< List.map (λ c → 2CC.⟦ c ⟧ config) (List.map translate cs) >- + ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-∘ cs) ⟨ + a Rose.-< List.map (λ c → 2CC.⟦ translate c ⟧ config) cs >- + ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-cong-with∈ cs (λ c' c'∈cs → translate-preserves-⊆ c' limit (ℕ.≤-trans (List.max-≤ (max-dimension c') (List.map max-dimension cs) (List.∈-map⁺ max-dimension c'∈cs)) max-dim≤limit) config)) ⟩ + a Rose.-< List.map (λ c → CCC.⟦ c ⟧ (fnoc limit config)) cs >- + ≡⟨⟩ + CCC.⟦ a CCC.CCC.-< cs >- ⟧ (fnoc limit config) + ∎ + where + open Eq.≡-Reasoning + translate-preserves-⊆ (D CCC.CCC.⟨ c ∷ cs ⟩) limit max-dim≤limit config = + begin + 2CC.⟦ translate (D CCC.CCC.⟨ c ∷ cs ⟩) ⟧ config + ≡⟨⟩ + 2CC.⟦ choice-list D zero (translate c) (List.map translate cs) ⟧ config + ≡⟨ lemma (fnoc limit config D) zero c cs (ℕ.≤-trans (ℕ.m≤m⊔n (List⁺.length (c ∷ cs)) (List.max (List.map max-dimension (c ∷ cs)))) max-dim≤limit) (λ k' k'-) config = + begin + CCC.⟦ a CCC.CCC.-< cs >- ⟧ config + ≡⟨⟩ + a Rose.-< List.map (λ c → CCC.⟦ c ⟧ config) cs >- + ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-cong (λ c → translate-preserves-⊇ c config) cs) ⟩ + a Rose.-< List.map (λ c → 2CC.⟦ translate c ⟧ (conf config)) cs >- + ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-∘ cs) ⟩ + a Rose.-< List.map (λ c → 2CC.⟦ c ⟧ (conf config)) (List.map translate cs) >- + ≡⟨⟩ + 2CC.⟦ a 2CC.2CC.-< List.map translate cs >- ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ translate (a CCC.CCC.-< cs >-) ⟧ (conf config) + ∎ + where + open Eq.≡-Reasoning + translate-preserves-⊇ (D CCC.CCC.⟨ c ∷ cs ⟩) config = + begin + CCC.⟦ D CCC.CCC.⟨ c ∷ cs ⟩ ⟧ config + ≡⟨⟩ + CCC.⟦ List.find-or-last (config D) (c ∷ cs) ⟧ config + ≡⟨ List.map-find-or-last (λ c → CCC.⟦ c ⟧ config) (config D) (c ∷ cs) ⟩ + List.find-or-last (config D) (List⁺.map (λ c → CCC.⟦ c ⟧ config) (c ∷ cs)) + ≡⟨ Eq.cong (λ x → List.find-or-last (config D) x) (List⁺.map-cong (λ c → translate-preserves-⊇ c config) (c ∷ cs)) ⟩ + List.find-or-last (config D) (List⁺.map (λ c → 2CC.⟦ translate c ⟧ (conf config)) (c ∷ cs)) + ≡⟨ Eq.cong (λ x → List.find-or-last (config D) x) (List⁺.map-∘ (c ∷ cs)) ⟩ + List.find-or-last (config D) (List⁺.map (λ c → 2CC.⟦ c ⟧ (conf config)) (List⁺.map translate (c ∷ cs))) + ≡⟨ List.map-find-or-last (λ c → 2CC.⟦ c ⟧ (conf config)) (config D) (List⁺.map translate (c ∷ cs)) ⟨ + 2CC.⟦ List.find-or-last (config D) (List⁺.map translate (c ∷ cs)) ⟧ (conf config) + ≡⟨ lemma (config D) zero (Eq.sym (ℕ.+-identityʳ (config D))) c cs ⟩ + 2CC.⟦ choice-list D zero (translate c) (List.map translate cs) ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ translate (D CCC.CCC.⟨ c ∷ cs ⟩) ⟧ (conf config) + ∎ + where + open Eq.≡-Reasoning + + lemma : ∀ {i} + → (m k : ℕ) + → config D ≡ m + k + → (c : CCC.CCC F i A) + → (cs : List (CCC.CCC F i A)) + → 2CC.⟦ List.find-or-last m (List⁺.map translate (c ∷ cs)) ⟧ (conf config) ≡ 2CC.⟦ choice-list D k (translate c) (List.map translate cs) ⟧ (conf config) + lemma zero k config-D≡m+k c₁ [] = refl + lemma zero k config-D≡m+k c₁ (c₂ ∷ []) = + begin + 2CC.⟦ List.find-or-last zero (List⁺.map translate (c₁ ∷ c₂ ∷ [])) ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ translate c₁ ⟧ (conf config) + ≡⟨⟩ + (if true then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) + ≡⟨ Eq.cong (λ x → if x then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) (Equivalence.to Bool.T-≡ (ℕ.≤⇒≤ᵇ (ℕ.≤-refl {k}))) ⟨ + (if zero + k ≤ᵇ k then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) + ≡⟨ Eq.cong (λ x → if x ≤ᵇ k then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) config-D≡m+k ⟨ + (if config D ≤ᵇ k then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) + ≡⟨⟩ + (if conf config (D , k) then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) + ≡⟨⟩ + 2CC.⟦ (D , k) 2CC.⟨ translate c₁ , translate c₂ ⟩ ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ choice-list D k (translate c₁) (List.map translate (c₂ ∷ [])) ⟧ (conf config) + ∎ + lemma zero k config-D≡m+k c₁ (c₂ ∷ c₃ ∷ cs) = + begin + 2CC.⟦ List.find-or-last zero (List⁺.map translate (c₁ ∷ c₂ ∷ c₃ ∷ cs)) ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ translate c₁ ⟧ (conf config) + ≡⟨⟩ + (if true then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ choice-list D (suc k) (translate c₂) (List.map translate (c₃ ∷ cs)) ⟧ (conf config)) + ≡⟨ Eq.cong (λ x → if x then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ choice-list D (suc k) (translate c₂) (List.map translate (c₃ ∷ cs)) ⟧ (conf config)) (Equivalence.to Bool.T-≡ (ℕ.≤⇒≤ᵇ (ℕ.≤-refl {k}))) ⟨ + (if zero + k ≤ᵇ k then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ choice-list D (suc k) (translate c₂) (List.map translate (c₃ ∷ cs)) ⟧ (conf config)) + ≡⟨ Eq.cong (λ x → if x ≤ᵇ k then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ choice-list D (suc k) (translate c₂) (List.map translate (c₃ ∷ cs)) ⟧ (conf config)) config-D≡m+k ⟨ + (if config D ≤ᵇ k then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ choice-list D (suc k) (translate c₂) (List.map translate (c₃ ∷ cs)) ⟧ (conf config)) + ≡⟨⟩ + (if conf config (D , k) then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ choice-list D (suc k) (translate c₂) (List.map translate (c₃ ∷ cs)) ⟧ (conf config)) + ≡⟨⟩ + 2CC.⟦ (D , k) 2CC.⟨ translate c₁ , choice-list D (suc k) (translate c₂) (List.map translate (c₃ ∷ cs)) ⟩ ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ choice-list D k (translate c₁) (List.map translate (c₂ ∷ c₃ ∷ cs)) ⟧ (conf config) + ∎ + lemma (suc m) k config-D≡m+k c₁ [] = refl + lemma (suc m) k config-D≡m+k c₁ (c₂ ∷ []) = + begin + 2CC.⟦ List.find-or-last (suc m) (List⁺.map translate (c₁ ∷ c₂ ∷ [])) ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ translate c₂ ⟧ (conf config) + ≡⟨⟩ + (if false then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) + ≡⟨ Eq.cong (λ x → if x then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) (Equivalence.to Bool.T-not-≡ (>⇒¬≤ᵇ (ℕ.m⇒¬≤ᵇ (ℕ.m Date: Thu, 12 Dec 2024 19:52:58 +0100 Subject: [PATCH 14/82] =?UTF-8?q?Quantify=20=E2=89=A4Size=20over=20the=20a?= =?UTF-8?q?rtifact=20type?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This makes it easier to use because the artifact type doesn't need to be applied when invoking `≤Size`. Furthermore, this enables proofs of `≱Size` to fix a single artifact type, for example the natural numbers, and automatically have the inhabitants it needs. The order between the quantifier over `n` and `A` doesn't have a big impact. On the one hand, the chosen order allows `≱Size` to use different artifact types for each `n`. However, it doesn't change the relation inhabitants if they are swapped because there exists a type with enough elements (i.e., union of all `A` ranging all `n`s) that can be fixed and then only a subset of the artifacts can be used for a specific `n`. On the other hand, `≤Size` is a `Set` and, thus, can't be inspected if the order is changed. This specific order is chosen purely as it's more convenient for pattern matching (e.g., one less `with` clause in case of `≤Size`). --- src/Vatras/SyntacticExpressiveness.agda | 40 +- .../SyntacticExpressiveness/2CC_; _<_; _*_) import Data.Nat.Properties as ℕ @@ -10,6 +9,7 @@ open import Relation.Binary.Structures using (IsEquivalence; IsPreorder; IsParti open import Size using (∞) open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans) +open import Vatras.Framework.Definitions using (𝔸) open import Vatras.Framework.Variants using (Rose) open import Vatras.Framework.Relation.Expression (Rose ∞) using (_,_⊢_≣_) open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) @@ -17,12 +17,13 @@ open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Exp record SizedLang : Set₂ where field Lang : VariabilityLanguage (Rose ∞) - size : Expression Lang A → ℕ + size : {A : 𝔸} → Expression Lang A → ℕ open SizedLang _≤Size_ : SizedLang → SizedLang → Set₁ L₁ ≤Size L₂ = Σ[ n ∈ ℕ ] + ∀ (A : 𝔸) → ∀ (e₂ : Expression (Lang L₂) A) → Σ[ e₁ ∈ Expression (Lang L₁) A ] Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ @@ -34,6 +35,7 @@ L₁ =Size L₂ = L₁ ≤Size L₂ × L₂ ≤Size L₁ _≱Size_ : SizedLang → SizedLang → Set₁ L₁ ≱Size L₂ = ∀ (n : ℕ) → + Σ[ A ∈ 𝔸 ] Σ[ e₁ ∈ Expression (Lang L₁) A ] ∀ (e₂ : Expression (Lang L₂) A ) → Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ @@ -44,16 +46,16 @@ L₁ n * size L₁ e₁ - go e₃ e₁≅e₃ with L₃→L₂ e₃ + go e₃ e₁≅e₃ with L₃→L₂ A e₃ go e₃ e₁≅e₃ | e₂ , e₂≅e₃ , e₂≤e₃ = begin-strict n * size L₁ e₁ @@ -105,16 +107,16 @@ L₁ n * size L₁ e₁ - go e₃ e₁≅e₃ with L₃→L₂ e₃ + go e₃ e₁≅e₃ with L₃→L₂ A e₃ go e₃ e₁≅e₃ | e₂ , e₂≅e₃ , e₂≤e₃ = ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) (begin ℕ.suc (m * (n * size L₁ e₁)) @@ -129,8 +131,8 @@ L₁ n * size L₃ e₃ go e₁ e₃≅e₁ = @@ -183,13 +185,13 @@ L₁ - , a₂ 2CC.2CC.-< [] >- ⟩ ∷ e₁-cs n (suc D) +e₁-cs (suc n) D = D 2CC.2CC.⟨ 0 2CC.2CC.-< [] >- , 1 2CC.2CC.-< [] >- ⟩ ∷ e₁-cs n (suc D) -e₁ : ℕ → 2CC.2CC ∞ A -e₁ n = a₁ 2CC.2CC.-< e₁-cs n zero >- +e₁ : ℕ → 2CC.2CC ∞ NAT +e₁ n = 0 2CC.2CC.-< e₁-cs n zero >- size-e₁-cs : ∀ n D → List.sum (List.map size2CC (e₁-cs n D)) ≡ n * 3 size-e₁-cs zero D = refl @@ -44,17 +44,17 @@ size-e₁-cs (suc n) D = Eq.cong (3 +_) (size-e₁-cs n (suc D)) size-e₁ : ∀ n → size2CC (e₁ n) ≡ 1 + n * 3 size-e₁ n = Eq.cong suc (size-e₁-cs n zero) -variants-cs : ∀ n → Fin (2 ^ n) → List (Rose ∞ A) +variants-cs : ∀ n → Fin (2 ^ n) → List (Rose ∞ NAT) variants-cs zero zero = [] variants-cs (suc n) i with Fin.toℕ i - ∷ variants-cs n (Fin.fromℕ< i<2^n) -... | no i≮2^n = a₂ Rose.-< [] >- ∷ variants-cs n (Eq.subst Fin (ℕ.+-identityʳ (2 ^ n)) (Fin.reduce≥ i (ℕ.≮⇒≥ i≮2^n))) +... | yes i<2^n = 0 Rose.-< [] >- ∷ variants-cs n (Fin.fromℕ< i<2^n) +... | no i≮2^n = 1 Rose.-< [] >- ∷ variants-cs n (Eq.subst Fin (ℕ.+-identityʳ (2 ^ n)) (Fin.reduce≥ i (ℕ.≮⇒≥ i≮2^n))) variants : ∀ n → VariantGenerator (pred (2 ^ n)) -variants n i = a₁ Rose.-< variants-cs n (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i) >- +variants n i = 0 Rose.-< variants-cs n (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i) >- lemma1 : ∀ n → variants n ⊆ 2CC.⟦ e₁ n ⟧ -lemma1 n i = config n i' , Eq.cong (a₁ Rose.-<_>-) (go n i' zero λ o → Eq.cong (config n i') (ℕ.+-identityʳ o)) +lemma1 n i = config n i' , Eq.cong (0 Rose.-<_>-) (go n i' zero λ o → Eq.cong (config n i') (ℕ.+-identityʳ o)) where i' = Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i @@ -83,39 +83,39 @@ lemma1 n i = config n i' , Eq.cong (a₁ Rose.-<_>-) (go n i' zero λ o → Eq.c go (suc m) j D p with Fin.toℕ j - ∷ variants-cs m (Fin.fromℕ< k<2^m) - ≡⟨ Eq.cong (a₁ Rose.-< [] >- ∷_) (go m (Fin.fromℕ< k<2^m) (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-<2^m m j o k<2^m))) ⟩ - a₁ Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + 0 Rose.-< [] >- ∷ variants-cs m (Fin.fromℕ< k<2^m) + ≡⟨ Eq.cong (0 Rose.-< [] >- ∷_) (go m (Fin.fromℕ< k<2^m) (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-<2^m m j o k<2^m))) ⟩ + 0 Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - (if true then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) - ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ - (if config n i' D then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + (if true then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ + (if config n i' D then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - 2CC.⟦ D 2CC.2CC.⟨ a₁ 2CC.2CC.-< [] >- , a₂ 2CC.2CC.-< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + 2CC.⟦ D 2CC.2CC.⟨ 0 2CC.2CC.-< [] >- , 1 2CC.2CC.-< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ∎ ... | no k≮2^m | p' = begin - a₂ Rose.-< [] >- ∷ variants-cs m j' - ≡⟨ Eq.cong (a₂ Rose.-< [] >- ∷_) (go m j' (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-≮2^m m j o k≮2^m))) ⟩ - a₂ Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + 1 Rose.-< [] >- ∷ variants-cs m j' + ≡⟨ Eq.cong (1 Rose.-< [] >- ∷_) (go m j' (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-≮2^m m j o k≮2^m))) ⟩ + 1 Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - (if false then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) - ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ - (if config n i' D then 2CC.⟦ a₁ 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ a₂ 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + (if false then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ + (if config n i' D then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - 2CC.⟦ D 2CC.2CC.⟨ a₁ 2CC.2CC.-< [] >- , a₂ 2CC.2CC.-< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + 2CC.⟦ D 2CC.2CC.⟨ 0 2CC.2CC.-< [] >- , 1 2CC.2CC.-< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ∎ where j' = Eq.subst Fin (ℕ.+-identityʳ (2 ^ m)) (Fin.reduce≥ j (ℕ.≮⇒≥ k≮2^m)) -ADT-leafs : ADT.ADT A → List⁺ (Rose ∞ A) +ADT-leafs : ADT.ADT NAT → List⁺ (Rose ∞ NAT) ADT-leafs (ADT.ADT.leaf v) = v ∷ [] ADT-leafs (D ADT.ADT.⟨ l , r ⟩) = ADT-leafs l List⁺.⁺++⁺ ADT-leafs r -ADT-leaf-count : ADT.ADT A → ℕ +ADT-leaf-count : ADT.ADT NAT → ℕ ADT-leaf-count e₂ = List⁺.length (ADT-leafs e₂) -ADT-leaf-count-lemma : ∀ D → (l r : ADT.ADT A) → ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) ≡ ADT-leaf-count l + ADT-leaf-count r +ADT-leaf-count-lemma : ∀ D → (l r : ADT.ADT NAT) → ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) ≡ ADT-leaf-count l + ADT-leaf-count r ADT-leaf-count-lemma D l r = begin ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) @@ -129,7 +129,7 @@ ADT-leaf-count-lemma D l r = where open Eq.≡-Reasoning -leafs-≤-size : (e₂ : ADT.ADT A) → ADT-leaf-count e₂ ≤ sizeADT e₂ +leafs-≤-size : (e₂ : ADT.ADT NAT) → ADT-leaf-count e₂ ≤ sizeADT e₂ leafs-≤-size (ADT.ADT.leaf v) = s≤s z≤n leafs-≤-size (D ADT.ADT.⟨ l , r ⟩) = begin @@ -146,11 +146,11 @@ leafs-≤-size (D ADT.ADT.⟨ l , r ⟩) = where open ℕ.≤-Reasoning -listToIndexedSet : (vs : List⁺ (Rose ∞ A)) → VariantGenerator (pred (List⁺.length vs)) +listToIndexedSet : (vs : List⁺ (Rose ∞ NAT)) → VariantGenerator (pred (List⁺.length vs)) listToIndexedSet vs i = List.lookup (List⁺.toList vs) (Eq.subst Fin (ℕ.suc-pred (List⁺.length vs)) i) -_≟ᵥ_ : ∀ {i} → (v₁ v₂ : Rose i A) → Dec (v₁ ≡ v₂) -(a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) with proj₂ A a₁ a₂ | List.≡-dec _≟ᵥ_ cs₁ cs₂ +_≟ᵥ_ : ∀ {i} → (v₁ v₂ : Rose i NAT) → Dec (v₁ ≡ v₂) +(a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) with a₁ ℕ.≟ a₂ | List.≡-dec _≟ᵥ_ cs₁ cs₂ (a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | no a₁≢a₂ | _ = no λ where refl → a₁≢a₂ refl (a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | yes a₁≡a₂ | no cs₁≢cs₂ = no (λ where refl → cs₁≢cs₂ refl) (a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | yes refl | yes refl = yes refl @@ -208,8 +208,8 @@ variants-cs-unique : ∀ n i j → i ≢ j → variants-cs n i ≢ variants-cs n variants-cs-unique zero zero zero i≢j = ⊥-elim (i≢j refl) variants-cs-unique (suc n) i j i≢j cs-i≡cs-j with Fin.toℕ i -nonZero (ℕ.m^n>0 2 n)}}) i) (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) j) (i≢j ∘ Eq.subst-injective (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}})) (proj₂ (Rose-injective vs-i≡vs-j)) -IndexedSet-⊆⇒List-⊆ : ∀ {n} (gen : VariantGenerator n) (l : List⁺ (Rose ∞ A)) → gen ⊆ listToIndexedSet l → List.tabulate gen List.⊆ List⁺.toList l +IndexedSet-⊆⇒List-⊆ : ∀ {n} (gen : VariantGenerator n) (l : List⁺ (Rose ∞ NAT)) → gen ⊆ listToIndexedSet l → List.tabulate gen List.⊆ List⁺.toList l IndexedSet-⊆⇒List-⊆ gen l gen⊆l {x} (here refl) with gen⊆l zero ... | i , x∈l = Eq.subst (List._∈ (List⁺.toList l)) (Eq.sym x∈l) (List.∈-lookup {xs = List⁺.toList l} i) IndexedSet-⊆⇒List-⊆ {suc n} gen l gen⊆l {x} (there x∈gen) = IndexedSet-⊆⇒List-⊆ {n} (gen ∘ suc) l (gen⊆l ∘ suc) x∈gen @@ -372,7 +372,7 @@ lemma (suc m) e₂ (e₁⊆e₂ , e₂⊆e₁) = n = suc m 2CC≱ADT : Sized2CC ≱Size SizedADT -2CC≱ADT n = e₁ (4 * n) , λ e₂ e₁≣e₂ → lemma n e₂ e₁≣e₂ +2CC≱ADT n = (ℕ , ℕ._≟_) , e₁ (4 * n) , lemma n 2CC-) = begin size2CC (encode (a Rose.-< cs >-)) @@ -55,7 +53,7 @@ lemma2 (a Rose.-< cs >-) = where open ℕ.≤-Reasoning -lemma : ∀ (adt : ADT.ADT A) → size2CC (LanguageCompiler.compile ADT→2CC' adt) ≤ sizeADT adt +lemma : ∀ {A : 𝔸} → (adt : ADT.ADT A) → size2CC (LanguageCompiler.compile ADT→2CC' adt) ≤ sizeADT adt lemma (ADT.ADT.leaf v) = ℕ.m≤n⇒m≤1+n (lemma2 v) lemma (D ADT.ADT.⟨ l , r ⟩) = begin @@ -73,4 +71,4 @@ lemma (D ADT.ADT.⟨ l , r ⟩) = open ℕ.≤-Reasoning 2CC≤ADT : Sized2CC ≤Size SizedADT -2CC≤ADT = 1 , λ adt → LanguageCompiler.compile ADT→2CC' adt , ≅-sym (≅[]→≅ (LanguageCompiler.preserves ADT→2CC' adt)) , Eq.subst (size2CC (LanguageCompiler.compile ADT→2CC' adt )≤_) (Eq.sym (ℕ.+-identityʳ (sizeADT adt))) (lemma adt) +2CC≤ADT = 1 , λ A adt → LanguageCompiler.compile ADT→2CC' adt , ≅-sym (≅[]→≅ (LanguageCompiler.preserves ADT→2CC' adt)) , Eq.subst (size2CC (LanguageCompiler.compile ADT→2CC' adt )≤_) (Eq.sym (ℕ.+-identityʳ (sizeADT adt))) (lemma adt) diff --git "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" index d4573ea5..9eaa9f0e 100644 --- "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" @@ -18,7 +18,7 @@ open import Data.Unit using (tt) open import Function using (_∘_; const) open import Function.Bundles using (Equivalence) open import Relation.Nullary.Decidable using (yes; no) -open import Size using (∞) +open import Size using (Size; ∞) open import Vatras.Data.EqIndexedSet using (_≅_; _≅[_][_]_; ≅[]-sym; ≅[]→≅; _⊆[_]_) open import Vatras.Framework.Relation.Function using (to; from) @@ -26,6 +26,7 @@ open import Vatras.Framework.Variants using (Rose) import Vatras.Util.List as List open import Vatras.Lang.All open import Vatras.Framework.Compiler using (LanguageCompiler) +open import Vatras.SyntacticExpressiveness using (_≤Size_) open import Vatras.SyntacticExpressiveness.Sizes using (sizeRose; Sized2CC; size2CC; SizedCCC; sizeCCC) >⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ≤ᵇ n)) @@ -73,389 +74,386 @@ fnoc-rec-true config D (suc limit) n fnoc-) = s≤s z≤n - 1≤sizeCCC (D CCC.CCC.⟨ cs ⟩) = s≤s z≤n +1≤sizeCCC : ∀ {i : Size} {A : 𝔸} → (e : CCC.CCC F i A) → 1 ≤ sizeCCC F e +1≤sizeCCC (a CCC.CCC.-< cs >-) = s≤s z≤n +1≤sizeCCC (D CCC.CCC.⟨ cs ⟩) = s≤s z≤n - max-dimension : ∀ {i} → CCC.CCC F i A → ℕ - max-dimension (a CCC.CCC.-< cs >-) = List.max (List.map max-dimension cs) - max-dimension (D CCC.CCC.⟨ cs ⟩) = List⁺.length cs ⊔ List.max (List.map max-dimension (List⁺.toList cs)) +max-dimension : ∀ {i : Size} {A : 𝔸} → CCC.CCC F i A → ℕ +max-dimension (a CCC.CCC.-< cs >-) = List.max (List.map max-dimension cs) +max-dimension (D CCC.CCC.⟨ cs ⟩) = List⁺.length cs ⊔ List.max (List.map max-dimension (List⁺.toList cs)) - choice-list : F → ℕ → 2CC.2CC (F × ℕ) ∞ A → List (2CC.2CC (F × ℕ) ∞ A) → 2CC.2CC (F × ℕ) ∞ A - choice-list D n c₁ [] = c₁ - choice-list D n c₁ (c₂ ∷ []) = (D , n) 2CC.2CC.⟨ c₁ , c₂ ⟩ - choice-list D n c₁ (c₂ ∷ c₃ ∷ cs) = (D , n) 2CC.2CC.⟨ c₁ , choice-list D (suc n) c₂ (c₃ ∷ cs) ⟩ +choice-list : ∀ {A : 𝔸} → F → ℕ → 2CC.2CC (F × ℕ) ∞ A → List (2CC.2CC (F × ℕ) ∞ A) → 2CC.2CC (F × ℕ) ∞ A +choice-list D n c₁ [] = c₁ +choice-list D n c₁ (c₂ ∷ []) = (D , n) 2CC.2CC.⟨ c₁ , c₂ ⟩ +choice-list D n c₁ (c₂ ∷ c₃ ∷ cs) = (D , n) 2CC.2CC.⟨ c₁ , choice-list D (suc n) c₂ (c₃ ∷ cs) ⟩ - choice-list-size : - ∀ (D : F) (n : ℕ) - → (c : 2CC.2CC (F × ℕ) ∞ A) - → (cs : List (2CC.2CC (F × ℕ) ∞ A)) - → size2CC (F × ℕ) A (choice-list D n c cs) ≡ List.length cs + List.sum (List.map (size2CC (F × ℕ) A) (c ∷ cs)) - choice-list-size D n c₁ [] = Eq.sym (ℕ.+-identityʳ (size2CC (F × ℕ) A c₁)) - choice-list-size D n c₁ (c₂ ∷ []) = +choice-list-size : + ∀ {A : 𝔸} (D : F) (n : ℕ) + → (c : 2CC.2CC (F × ℕ) ∞ A) + → (cs : List (2CC.2CC (F × ℕ) ∞ A)) + → size2CC (F × ℕ) (choice-list D n c cs) ≡ List.length cs + List.sum (List.map (size2CC (F × ℕ)) (c ∷ cs)) +choice-list-size D n c₁ [] = Eq.sym (ℕ.+-identityʳ (size2CC (F × ℕ) c₁)) +choice-list-size D n c₁ (c₂ ∷ []) = + begin + size2CC (F × ℕ) (choice-list D n c₁ (c₂ ∷ [])) + ≡⟨⟩ + size2CC (F × ℕ) ((D , n) 2CC.2CC.⟨ c₁ , c₂ ⟩) + ≡⟨⟩ + suc (size2CC (F × ℕ) c₁ + size2CC (F × ℕ) c₂) + ≡⟨ Eq.cong (λ x → suc (size2CC (F × ℕ) c₁ + x)) (ℕ.+-identityʳ (size2CC (F × ℕ) c₂)) ⟨ + suc (size2CC (F × ℕ) c₁ + (size2CC (F × ℕ) c₂ + 0)) + ≡⟨⟩ + List.length (c₂ ∷ []) + List.sum (List.map (size2CC (F × ℕ)) (c₁ ∷ c₂ ∷ [])) + ∎ + where + open Eq.≡-Reasoning +choice-list-size D n c₁ (c₂ ∷ c₃ ∷ cs) = + begin + size2CC (F × ℕ) (choice-list D n c₁ (c₂ ∷ c₃ ∷ cs)) + ≡⟨⟩ + size2CC (F × ℕ) ((D , n) 2CC.2CC.⟨ c₁ , choice-list D (suc n) c₂ (c₃ ∷ cs) ⟩) + ≡⟨⟩ + suc (size2CC (F × ℕ) c₁ + size2CC (F × ℕ) (choice-list D (suc n) c₂ (c₃ ∷ cs))) + ≡⟨ Eq.cong (λ x → suc (size2CC (F × ℕ) c₁ + x)) (choice-list-size D (suc n) c₂ (c₃ ∷ cs)) ⟩ + suc (size2CC (F × ℕ) c₁ + (List.length (c₃ ∷ cs) + List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs)))) + ≡⟨ Eq.cong suc (ℕ.+-assoc (size2CC (F × ℕ) c₁) (List.length (c₃ ∷ cs)) (List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs)))) ⟨ + suc (size2CC (F × ℕ) c₁ + List.length (c₃ ∷ cs) + List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs))) + ≡⟨ Eq.cong (λ x → suc (x + List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs)))) (ℕ.+-comm (size2CC (F × ℕ) c₁) (List.length (c₃ ∷ cs))) ⟩ + suc (List.length (c₃ ∷ cs) + size2CC (F × ℕ) c₁ + List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs))) + ≡⟨ Eq.cong suc (ℕ.+-assoc (List.length (c₃ ∷ cs)) (size2CC (F × ℕ) c₁) (List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs)))) ⟩ + suc (List.length (c₃ ∷ cs) + (size2CC (F × ℕ) c₁ + List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs)))) + ≡⟨⟩ + List.length (c₂ ∷ c₃ ∷ cs) + List.sum (List.map (size2CC (F × ℕ)) (c₁ ∷ c₂ ∷ c₃ ∷ cs)) + ∎ + where + open Eq.≡-Reasoning + +translate : ∀ {i : Size} {A : 𝔸} + → CCC.CCC F i A + → 2CC.2CC (F × ℕ) ∞ A +translate (a CCC.CCC.-< cs >-) = a 2CC.2CC.-< List.map translate cs >- +translate (D CCC.CCC.⟨ c ∷ cs ⟩) = choice-list D zero (translate c) (List.map translate cs) + +translate-size : ∀ {i : Size} {A : 𝔸} + → (ccc : CCC.CCC F i A) + → size2CC (F × ℕ) (translate ccc) < 2 * sizeCCC F ccc +translate-size (a CCC.CCC.-< cs >-) = + begin-strict + size2CC (F × ℕ) (translate (a CCC.CCC.-< cs >-)) + ≡⟨⟩ + size2CC (F × ℕ) (a 2CC.2CC.-< List.map translate cs >-) + ≡⟨⟩ + suc (List.sum (List.map (size2CC (F × ℕ)) (List.map translate cs))) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ + suc (List.sum (List.map (size2CC (F × ℕ) ∘ translate) cs)) + ≤⟨ s≤s (List.sum-map-≤ (size2CC (F × ℕ) ∘ translate) (λ c → 2 * sizeCCC F c) cs (ℕ.<⇒≤ ∘ translate-size)) ⟩ + suc (List.sum (List.map (λ c → 2 * sizeCCC F c) cs)) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟩ + suc (List.sum (List.map (2 *_) (List.map (sizeCCC F) cs))) + ≡⟨ Eq.cong suc (List.sum-* 2 (List.map (sizeCCC F) cs)) ⟩ + suc (2 * (List.sum (List.map (sizeCCC F) cs))) + ≡⟨⟩ + 1 + 2 * (List.sum (List.map (sizeCCC F) cs)) + <⟨ ℕ.+-monoˡ-< (2 * (List.sum (List.map (sizeCCC F) cs))) {x = 1} {y = 2} (ℕ.n<1+n 1) ⟩ + 2 + 2 * (List.sum (List.map (sizeCCC F) cs)) + ≡⟨ ℕ.*-suc 2 (List.sum (List.map (sizeCCC F) cs)) ⟨ + 2 * (suc (List.sum (List.map (sizeCCC F) cs))) + ≡⟨⟩ + 2 * sizeCCC F (a CCC.CCC.-< cs >-) + ∎ + where + open ℕ.≤-Reasoning +translate-size (D CCC.CCC.⟨ c ∷ cs ⟩) = + begin-strict + size2CC (F × ℕ) (translate (D CCC.CCC.⟨ c ∷ cs ⟩)) + ≡⟨⟩ + size2CC (F × ℕ) (choice-list D zero (translate c) (List.map translate cs)) + ≡⟨ choice-list-size D zero (translate c) (List.map translate cs) ⟩ + List.length (List.map translate cs) + List.sum (List.map (size2CC (F × ℕ)) (List.map translate (c ∷ cs))) + ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + List.sum x) (List.map-∘ (c ∷ cs)) ⟨ + List.length (List.map translate cs) + List.sum (List.map (size2CC (F × ℕ) ∘ translate) (c ∷ cs)) + ≤⟨ ℕ.+-monoʳ-≤ (List.length (List.map translate cs)) (List.sum-map-< (size2CC (F × ℕ) ∘ translate) (λ c → 2 * sizeCCC F c) (c ∷ cs) translate-size) ⟩ + List.length (List.map translate cs) + (List.sum (List.map (λ c → 2 * sizeCCC F c) (c ∷ cs)) ∸ List.length (c ∷ cs)) + ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + (List.sum x ∸ List.length (c ∷ cs))) (List.map-∘ {g = 2 *_} {f = sizeCCC F} (c ∷ cs)) ⟩ + List.length (List.map translate cs) + (List.sum (List.map (2 *_) (List.map (sizeCCC F) (c ∷ cs))) ∸ List.length (c ∷ cs)) + ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + (x ∸ List.length (c ∷ cs))) (List.sum-* 2 (List.map (sizeCCC F) (c ∷ cs))) ⟩ + List.length (List.map translate cs) + (2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) ∸ List.length (c ∷ cs)) + ≡⟨ Eq.cong (_+ (2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) ∸ List.length (c ∷ cs))) (List.length-map translate cs) ⟩ + List.length cs + (2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) ∸ List.length (c ∷ cs)) + ≡⟨ ℕ.+-∸-assoc (List.length cs) ( + begin + List.length (c ∷ cs) + ≡⟨ ℕ.*-identityʳ (List.length (c ∷ cs)) ⟨ + List.length (c ∷ cs) * 1 + ≡⟨ List.sum-replicate (List.length (c ∷ cs)) 1 ⟨ + List.sum (List.replicate (List.length (c ∷ cs)) 1) + ≡⟨ Eq.cong List.sum (List.map-const 1 (c ∷ cs)) ⟨ + List.sum (List.map (const 1) (c ∷ cs)) + ≤⟨ List.sum-map-≤ (const 1) (sizeCCC F) (c ∷ cs) 1≤sizeCCC ⟩ + List.sum (List.map (sizeCCC F) (c ∷ cs)) + ≤⟨ ℕ.m≤n*m (List.sum (List.map (sizeCCC F) (c ∷ cs))) 2 ⟩ + 2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) + ∎) + ⟨ + (List.length cs + 2 * List.sum (List.map (sizeCCC F) (c ∷ cs))) ∸ List.length (c ∷ cs) + ≤⟨ ℕ.∸-monoʳ-≤ (List.length cs + 2 * List.sum (List.map (sizeCCC F) (c ∷ cs))) (ℕ.n≤1+n (List.length cs)) ⟩ + (List.length cs + 2 * List.sum (List.map (sizeCCC F) (c ∷ cs))) ∸ List.length cs + ≡⟨ ℕ.m+n∸m≡n (List.length cs) (2 * List.sum (List.map (sizeCCC F) (c ∷ cs))) ⟩ + 2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) + <⟨ ℕ.*-monoʳ-< 2 (ℕ.n<1+n (List.sum (List.map (sizeCCC F) (c ∷ cs)))) ⟩ + 2 * suc (List.sum (List.map (sizeCCC F) (c ∷ cs))) + ≡⟨⟩ + 2 * sizeCCC F (D CCC.CCC.⟨ c ∷ cs ⟩) + ∎ + where + open ℕ.≤-Reasoning + +translate-preserves-⊆ : ∀ {i : Size} {A : 𝔸} + → (e : CCC.CCC F i A) + → (limit : ℕ) + → max-dimension e ≤ limit + → 2CC.⟦ translate e ⟧ ⊆[ fnoc limit ] CCC.⟦ e ⟧ +translate-preserves-⊆ e@(a CCC.CCC.-< cs >-) limit max-dim≤limit config = + begin + 2CC.⟦ translate (a CCC.CCC.-< cs >-) ⟧ config + ≡⟨⟩ + 2CC.⟦ a 2CC.2CC.-< List.map translate cs >- ⟧ config + ≡⟨⟩ + a Rose.-< List.map (λ c → 2CC.⟦ c ⟧ config) (List.map translate cs) >- + ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-∘ cs) ⟨ + a Rose.-< List.map (λ c → 2CC.⟦ translate c ⟧ config) cs >- + ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-cong-with∈ cs (λ c' c'∈cs → translate-preserves-⊆ c' limit (ℕ.≤-trans (List.max-≤ (max-dimension c') (List.map max-dimension cs) (List.∈-map⁺ max-dimension c'∈cs)) max-dim≤limit) config)) ⟩ + a Rose.-< List.map (λ c → CCC.⟦ c ⟧ (fnoc limit config)) cs >- + ≡⟨⟩ + CCC.⟦ a CCC.CCC.-< cs >- ⟧ (fnoc limit config) + ∎ + where + open Eq.≡-Reasoning +translate-preserves-⊆ (D CCC.CCC.⟨ c ∷ cs ⟩) limit max-dim≤limit config = + begin + 2CC.⟦ translate (D CCC.CCC.⟨ c ∷ cs ⟩) ⟧ config + ≡⟨⟩ + 2CC.⟦ choice-list D zero (translate c) (List.map translate cs) ⟧ config + ≡⟨ lemma (fnoc limit config D) zero c cs (ℕ.≤-trans (ℕ.m≤m⊔n (List⁺.length (c ∷ cs)) (List.max (List.map max-dimension (c ∷ cs)))) max-dim≤limit) (λ k' k'-) = a 2CC.2CC.-< List.map translate cs >- - translate (D CCC.CCC.⟨ c ∷ cs ⟩) = choice-list D zero (translate c) (List.map translate cs) - - translate-size : ∀ {i} - → (ccc : CCC.CCC F i A) - → size2CC (F × ℕ) A (translate ccc) < 2 * sizeCCC F A ccc - translate-size (a CCC.CCC.-< cs >-) = - begin-strict - size2CC (F × ℕ) A (translate (a CCC.CCC.-< cs >-)) - ≡⟨⟩ - size2CC (F × ℕ) A (a 2CC.2CC.-< List.map translate cs >-) - ≡⟨⟩ - suc (List.sum (List.map (size2CC (F × ℕ) A) (List.map translate cs))) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ - suc (List.sum (List.map (size2CC (F × ℕ) A ∘ translate) cs)) - ≤⟨ s≤s (List.sum-map-≤ (size2CC (F × ℕ) A ∘ translate) (λ c → 2 * sizeCCC F A c) cs (ℕ.<⇒≤ ∘ translate-size)) ⟩ - suc (List.sum (List.map (λ c → 2 * sizeCCC F A c) cs)) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟩ - suc (List.sum (List.map (2 *_) (List.map (sizeCCC F A) cs))) - ≡⟨ Eq.cong suc (List.sum-* 2 (List.map (sizeCCC F A) cs)) ⟩ - suc (2 * (List.sum (List.map (sizeCCC F A) cs))) - ≡⟨⟩ - 1 + 2 * (List.sum (List.map (sizeCCC F A) cs)) - <⟨ ℕ.+-monoˡ-< (2 * (List.sum (List.map (sizeCCC F A) cs))) {x = 1} {y = 2} (ℕ.n<1+n 1) ⟩ - 2 + 2 * (List.sum (List.map (sizeCCC F A) cs)) - ≡⟨ ℕ.*-suc 2 (List.sum (List.map (sizeCCC F A) cs)) ⟨ - 2 * (suc (List.sum (List.map (sizeCCC F A) cs))) - ≡⟨⟩ - 2 * sizeCCC F A (a CCC.CCC.-< cs >-) + lemma (suc m) k c₁ [] k+cs-) limit max-dim≤limit config = +translate-preserves-⊇ : ∀ {i : Size} {A : 𝔸} + → (e : CCC.CCC F i A) + → CCC.⟦ e ⟧ ⊆[ conf ] 2CC.⟦ translate e ⟧ +translate-preserves-⊇ (a CCC.CCC.-< cs >-) config = + begin + CCC.⟦ a CCC.CCC.-< cs >- ⟧ config + ≡⟨⟩ + a Rose.-< List.map (λ c → CCC.⟦ c ⟧ config) cs >- + ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-cong (λ c → translate-preserves-⊇ c config) cs) ⟩ + a Rose.-< List.map (λ c → 2CC.⟦ translate c ⟧ (conf config)) cs >- + ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-∘ cs) ⟩ + a Rose.-< List.map (λ c → 2CC.⟦ c ⟧ (conf config)) (List.map translate cs) >- + ≡⟨⟩ + 2CC.⟦ a 2CC.2CC.-< List.map translate cs >- ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ translate (a CCC.CCC.-< cs >-) ⟧ (conf config) + ∎ + where + open Eq.≡-Reasoning +translate-preserves-⊇ (D CCC.CCC.⟨ c ∷ cs ⟩) config = + begin + CCC.⟦ D CCC.CCC.⟨ c ∷ cs ⟩ ⟧ config + ≡⟨⟩ + CCC.⟦ List.find-or-last (config D) (c ∷ cs) ⟧ config + ≡⟨ List.map-find-or-last (λ c → CCC.⟦ c ⟧ config) (config D) (c ∷ cs) ⟩ + List.find-or-last (config D) (List⁺.map (λ c → CCC.⟦ c ⟧ config) (c ∷ cs)) + ≡⟨ Eq.cong (λ x → List.find-or-last (config D) x) (List⁺.map-cong (λ c → translate-preserves-⊇ c config) (c ∷ cs)) ⟩ + List.find-or-last (config D) (List⁺.map (λ c → 2CC.⟦ translate c ⟧ (conf config)) (c ∷ cs)) + ≡⟨ Eq.cong (λ x → List.find-or-last (config D) x) (List⁺.map-∘ (c ∷ cs)) ⟩ + List.find-or-last (config D) (List⁺.map (λ c → 2CC.⟦ c ⟧ (conf config)) (List⁺.map translate (c ∷ cs))) + ≡⟨ List.map-find-or-last (λ c → 2CC.⟦ c ⟧ (conf config)) (config D) (List⁺.map translate (c ∷ cs)) ⟨ + 2CC.⟦ List.find-or-last (config D) (List⁺.map translate (c ∷ cs)) ⟧ (conf config) + ≡⟨ lemma (config D) zero (Eq.sym (ℕ.+-identityʳ (config D))) c cs ⟩ + 2CC.⟦ choice-list D zero (translate c) (List.map translate cs) ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ translate (D CCC.CCC.⟨ c ∷ cs ⟩) ⟧ (conf config) + ∎ + where + open Eq.≡-Reasoning + + lemma : ∀ {i : Size} {A : 𝔸} + → (m k : ℕ) + → config D ≡ m + k + → (c : CCC.CCC F i A) + → (cs : List (CCC.CCC F i A)) + → 2CC.⟦ List.find-or-last m (List⁺.map translate (c ∷ cs)) ⟧ (conf config) ≡ 2CC.⟦ choice-list D k (translate c) (List.map translate cs) ⟧ (conf config) + lemma zero k config-D≡m+k c₁ [] = refl + lemma zero k config-D≡m+k c₁ (c₂ ∷ []) = begin - 2CC.⟦ translate (a CCC.CCC.-< cs >-) ⟧ config + 2CC.⟦ List.find-or-last zero (List⁺.map translate (c₁ ∷ c₂ ∷ [])) ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ translate c₁ ⟧ (conf config) ≡⟨⟩ - 2CC.⟦ a 2CC.2CC.-< List.map translate cs >- ⟧ config + (if true then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) + ≡⟨ Eq.cong (λ x → if x then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) (Equivalence.to Bool.T-≡ (ℕ.≤⇒≤ᵇ (ℕ.≤-refl {k}))) ⟨ + (if zero + k ≤ᵇ k then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) + ≡⟨ Eq.cong (λ x → if x ≤ᵇ k then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) config-D≡m+k ⟨ + (if config D ≤ᵇ k then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) ≡⟨⟩ - a Rose.-< List.map (λ c → 2CC.⟦ c ⟧ config) (List.map translate cs) >- - ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-∘ cs) ⟨ - a Rose.-< List.map (λ c → 2CC.⟦ translate c ⟧ config) cs >- - ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-cong-with∈ cs (λ c' c'∈cs → translate-preserves-⊆ c' limit (ℕ.≤-trans (List.max-≤ (max-dimension c') (List.map max-dimension cs) (List.∈-map⁺ max-dimension c'∈cs)) max-dim≤limit) config)) ⟩ - a Rose.-< List.map (λ c → CCC.⟦ c ⟧ (fnoc limit config)) cs >- + (if conf config (D , k) then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) ≡⟨⟩ - CCC.⟦ a CCC.CCC.-< cs >- ⟧ (fnoc limit config) + 2CC.⟦ (D , k) 2CC.⟨ translate c₁ , translate c₂ ⟩ ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ choice-list D k (translate c₁) (List.map translate (c₂ ∷ [])) ⟧ (conf config) ∎ - where - open Eq.≡-Reasoning - translate-preserves-⊆ (D CCC.CCC.⟨ c ∷ cs ⟩) limit max-dim≤limit config = + lemma zero k config-D≡m+k c₁ (c₂ ∷ c₃ ∷ cs) = begin - 2CC.⟦ translate (D CCC.CCC.⟨ c ∷ cs ⟩) ⟧ config - ≡⟨⟩ - 2CC.⟦ choice-list D zero (translate c) (List.map translate cs) ⟧ config - ≡⟨ lemma (fnoc limit config D) zero c cs (ℕ.≤-trans (ℕ.m≤m⊔n (List⁺.length (c ∷ cs)) (List.max (List.map max-dimension (c ∷ cs)))) max-dim≤limit) (λ k' k'-) config = + lemma (suc m) k config-D≡m+k c₁ [] = refl + lemma (suc m) k config-D≡m+k c₁ (c₂ ∷ []) = begin - CCC.⟦ a CCC.CCC.-< cs >- ⟧ config + 2CC.⟦ List.find-or-last (suc m) (List⁺.map translate (c₁ ∷ c₂ ∷ [])) ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ translate c₂ ⟧ (conf config) ≡⟨⟩ - a Rose.-< List.map (λ c → CCC.⟦ c ⟧ config) cs >- - ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-cong (λ c → translate-preserves-⊇ c config) cs) ⟩ - a Rose.-< List.map (λ c → 2CC.⟦ translate c ⟧ (conf config)) cs >- - ≡⟨ Eq.cong (a Rose.-<_>-) (List.map-∘ cs) ⟩ - a Rose.-< List.map (λ c → 2CC.⟦ c ⟧ (conf config)) (List.map translate cs) >- + (if false then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) + ≡⟨ Eq.cong (λ x → if x then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) (Equivalence.to Bool.T-not-≡ (>⇒¬≤ᵇ (ℕ.m- ⟧ (conf config) + (if conf config (D , k) then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ translate c₂ ⟧ (conf config)) ≡⟨⟩ - 2CC.⟦ translate (a CCC.CCC.-< cs >-) ⟧ (conf config) + 2CC.⟦ (D , k) 2CC.⟨ translate c₁ , translate c₂ ⟩ ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ choice-list D k (translate c₁) (List.map translate (c₂ ∷ [])) ⟧ (conf config) ∎ - where - open Eq.≡-Reasoning - translate-preserves-⊇ (D CCC.CCC.⟨ c ∷ cs ⟩) config = + lemma (suc m) k config-D≡m+k c₁ (c₂ ∷ c₃ ∷ cs) = begin - CCC.⟦ D CCC.CCC.⟨ c ∷ cs ⟩ ⟧ config - ≡⟨⟩ - CCC.⟦ List.find-or-last (config D) (c ∷ cs) ⟧ config - ≡⟨ List.map-find-or-last (λ c → CCC.⟦ c ⟧ config) (config D) (c ∷ cs) ⟩ - List.find-or-last (config D) (List⁺.map (λ c → CCC.⟦ c ⟧ config) (c ∷ cs)) - ≡⟨ Eq.cong (λ x → List.find-or-last (config D) x) (List⁺.map-cong (λ c → translate-preserves-⊇ c config) (c ∷ cs)) ⟩ - List.find-or-last (config D) (List⁺.map (λ c → 2CC.⟦ translate c ⟧ (conf config)) (c ∷ cs)) - ≡⟨ Eq.cong (λ x → List.find-or-last (config D) x) (List⁺.map-∘ (c ∷ cs)) ⟩ - List.find-or-last (config D) (List⁺.map (λ c → 2CC.⟦ c ⟧ (conf config)) (List⁺.map translate (c ∷ cs))) - ≡⟨ List.map-find-or-last (λ c → 2CC.⟦ c ⟧ (conf config)) (config D) (List⁺.map translate (c ∷ cs)) ⟨ - 2CC.⟦ List.find-or-last (config D) (List⁺.map translate (c ∷ cs)) ⟧ (conf config) - ≡⟨ lemma (config D) zero (Eq.sym (ℕ.+-identityʳ (config D))) c cs ⟩ - 2CC.⟦ choice-list D zero (translate c) (List.map translate cs) ⟧ (conf config) - ≡⟨⟩ - 2CC.⟦ translate (D CCC.CCC.⟨ c ∷ cs ⟩) ⟧ (conf config) + 2CC.⟦ List.find-or-last (suc m) (List⁺.map translate (c₁ ∷ c₂ ∷ c₃ ∷ cs)) ⟧ (conf config) + ≡⟨⟩ + 2CC.⟦ List.find-or-last m (List⁺.map translate (c₂ ∷ c₃ ∷ cs)) ⟧ (conf config) + ≡⟨ lemma m (suc k) (Eq.trans config-D≡m+k (Eq.sym (ℕ.+-suc m k))) c₂ (c₃ ∷ cs) ⟩ + 2CC.⟦ choice-list D (suc k) (translate c₂) (List.map translate (c₃ ∷ cs)) ⟧ (conf config) + ≡⟨⟩ + (if false then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ choice-list D (suc k) (translate c₂) (List.map translate (c₃ ∷ cs)) ⟧ (conf config)) + ≡⟨ Eq.cong (λ x → if x then 2CC.⟦ translate c₁ ⟧ (conf config) else 2CC.⟦ choice-list D (suc k) (translate c₂) (List.map translate (c₃ ∷ cs)) ⟧ (conf config)) (Equivalence.to Bool.T-not-≡ (>⇒¬≤ᵇ (ℕ.m⇒¬≤ᵇ (ℕ.m⇒¬≤ᵇ (ℕ.m-) = begin sizeCCC (LanguageCompiler.compile (NCC→CCC (sucs n)) (a NCC.NCC.-< cs >-)) @@ -67,4 +67,4 @@ lemma (sucs n) (D NCC.NCC.⟨ c ∷ cs ⟩) = open ℕ.≤-Reasoning CCC≤NCC : (n : ℕ≥ 2) → SizedCCC ≤Size SizedNCC n -CCC≤NCC n = 1 , λ ncc → LanguageCompiler.compile (NCC→CCC n) ncc , ≅-sym (≅[]→≅ (LanguageCompiler.preserves (NCC→CCC n) ncc)) , Eq.subst (sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc )≤_) (Eq.sym (ℕ.+-identityʳ (sizeNCC n ncc))) (lemma n ncc) +CCC≤NCC n = 1 , λ A ncc → LanguageCompiler.compile (NCC→CCC n) ncc , ≅-sym (≅[]→≅ (LanguageCompiler.preserves (NCC→CCC n) ncc)) , Eq.subst (sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc )≤_) (Eq.sym (ℕ.+-identityʳ (sizeNCC n ncc))) (lemma n ncc) diff --git a/src/Vatras/SyntacticExpressiveness/Sizes.agda b/src/Vatras/SyntacticExpressiveness/Sizes.agda index b97a8563..933165b0 100644 --- a/src/Vatras/SyntacticExpressiveness/Sizes.agda +++ b/src/Vatras/SyntacticExpressiveness/Sizes.agda @@ -1,21 +1,21 @@ open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) -module Vatras.SyntacticExpressiveness.Sizes (F : 𝔽) (A : 𝔸) where +module Vatras.SyntacticExpressiveness.Sizes (F : 𝔽) where open import Data.Nat using (ℕ; suc; zero; _+_) import Data.List as List import Data.List.NonEmpty as List⁺ import Data.Vec as Vec -open import Size using (∞) +open import Size using (Size; ∞) open import Vatras.Util.Nat.AtLeast using (ℕ≥) open import Vatras.Framework.Variants using (Rose) open import Vatras.Lang.All.Fixed F (Rose ∞) -open import Vatras.SyntacticExpressiveness A using (SizedLang) +open import Vatras.SyntacticExpressiveness using (SizedLang) -sizeRose : ∀ {i} → Rose i A → ℕ +sizeRose : ∀ {i : Size} {A : 𝔸} → Rose i A → ℕ sizeRose (a Rose.-< cs >-) = suc (List.sum (List.map sizeRose cs)) -size2CC : ∀ {i} → 2CC.2CC i A → ℕ +size2CC : ∀ {i : Size} {A : 𝔸} → 2CC.2CC i A → ℕ size2CC (a 2CC.2CC.-< cs >-) = suc (List.sum (List.map size2CC cs)) size2CC (D 2CC.2CC.⟨ l , r ⟩) = suc (size2CC l + size2CC r) @@ -25,7 +25,7 @@ Sized2CC = record ; size = size2CC } -sizeNCC : ∀ {i} n → NCC.NCC n i A → ℕ +sizeNCC : ∀ {i : Size} {A : 𝔸} (n : ℕ≥ 2) → NCC.NCC n i A → ℕ sizeNCC n (a NCC.NCC.-< cs >-) = suc (List.sum (List.map (sizeNCC n) cs)) sizeNCC n (D NCC.NCC.⟨ cs ⟩) = suc (Vec.sum (Vec.map (sizeNCC n) cs)) @@ -35,7 +35,7 @@ SizedNCC n = record ; size = sizeNCC n } -sizeCCC : ∀ {i} → CCC.CCC i A → ℕ +sizeCCC : ∀ {i : Size} {A : 𝔸} → CCC.CCC i A → ℕ sizeCCC (a CCC.CCC.-< cs >-) = suc (List.sum (List.map sizeCCC cs)) sizeCCC (D CCC.CCC.⟨ cs ⟩) = suc (List.sum (List.map sizeCCC (List⁺.toList cs))) @@ -45,7 +45,7 @@ SizedCCC = record ; size = sizeCCC } -sizeADT : ADT.ADT A → ℕ +sizeADT : {A : 𝔸} → ADT.ADT A → ℕ sizeADT (ADT.ADT.leaf v) = suc (sizeRose v) sizeADT (D ADT.ADT.⟨ l , r ⟩) = suc (sizeADT l + sizeADT r) From 284df1ee6eefa726760083cfd5a38b23b312ffe4 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Thu, 12 Dec 2024 21:16:31 +0100 Subject: [PATCH 15/82] Remove unused imports --- .../2CC\342\211\244ADT.agda" | 27 ++++++------------- 1 file changed, 8 insertions(+), 19 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" index e1ae53b6..a178b026 100644 --- "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" +++ "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" @@ -1,28 +1,18 @@ open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) -open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_; refl) module Vatras.SyntacticExpressiveness.2CC≤ADT (F : 𝔽) where -open import Data.Bool using (Bool; true; false; if_then_else_) -open import Data.Empty using (⊥-elim) -open import Data.Nat as ℕ using (ℕ; suc; zero; _≤_; z≤n; s≤s; _<_; _≮_; _-) = suc (List.sum (List.map size2CC (List.map encode cs))) ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ suc (List.sum (List.map (size2CC ∘ encode) cs)) - ≤⟨ s≤s (sum-map-≤ (size2CC ∘ encode) sizeRose cs lemma2) ⟩ + ≤⟨ s≤s (List.sum-map-≤ (size2CC ∘ encode) sizeRose cs lemma2) ⟩ suc (List.sum (List.map sizeRose cs)) ≡⟨⟩ sizeRose (a Rose.-< cs >-) From 1caa068acaf49b41766f5d1dd856abdfe1bc6b5d Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Thu, 12 Dec 2024 22:02:12 +0100 Subject: [PATCH 16/82] Cleanup the 2CC-nonZero (ℕ.m^n>0 2 n)}}) i) >- -lemma1 : ∀ n → variants n ⊆ 2CC.⟦ e₁ n ⟧ -lemma1 n i = config n i' , Eq.cong (0 Rose.-<_>-) (go n i' zero λ o → Eq.cong (config n i') (ℕ.+-identityʳ o)) +variants⊆e₁ : ∀ n → variants n ⊆ 2CC.⟦ e₁ n ⟧ +variants⊆e₁ n i = config n i' , Eq.cong (0 Rose.-<_>-) (go n i' zero λ o → Eq.cong (config n i') (ℕ.+-identityʳ o)) where i' = Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i @@ -167,37 +171,17 @@ ADT-leaf-count≤ₗ D l r = where open ℕ.≤-Reasoning -length-++-≤ₗ : ∀ {ℓ} {A : Set ℓ} (xs ys : List A) → List.length xs ≤ List.length (xs List.++ ys) -length-++-≤ₗ xs ys = Eq.subst (_ ≤_) (Eq.sym (List.length-++ xs)) (ℕ.m≤m+n (List.length xs) (List.length ys)) - -lookup-++ᵣ : ∀ {ℓ} {A : Set ℓ} (xs ys : List A) i → List.lookup xs i ≡ List.lookup (xs List.++ ys) (Fin.inject≤ i (length-++-≤ₗ xs ys)) -lookup-++ᵣ (x ∷ xs) ys zero = refl -lookup-++ᵣ (x ∷ xs) ys (suc i) = lookup-++ᵣ xs ys i - -lookup-++ₗ : ∀ {ℓ} {A : Set ℓ} (xs ys : List A) i → List.lookup ys i ≡ List.lookup (xs List.++ ys) (Fin.cast (Eq.sym (List.length-++ xs)) (List.length xs Fin.↑ʳ i)) -lookup-++ₗ [] ys i = Eq.cong (List.lookup ys) (Eq.sym (Fin.cast-is-id refl i)) -lookup-++ₗ (x ∷ xs) ys i = lookup-++ₗ xs ys i - ADT-leaf∈⟦⟧ : ∀ v e₂ → v ∈ ADT.⟦ e₂ ⟧ → v ∈ listToIndexedSet (ADT-leafs e₂) ADT-leaf∈⟦⟧ v (ADT.ADT.leaf .v) (c , refl) = zero , refl ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) with c D ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | true with ADT-leaf∈⟦⟧ v l (c , p) -ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | true | (i , p') = Fin.inject≤ i (ADT-leaf-count≤ₗ D l r) , Eq.trans p' (lookup-++ᵣ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) +ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | true | (i , p') = Fin.inject≤ i (ADT-leaf-count≤ₗ D l r) , Eq.trans p' (List.lookup-++ᵣ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | false with ADT-leaf∈⟦⟧ v r (c , p) -ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | false | (i , p') = (Fin.cast (Eq.sym (ADT-leaf-count-lemma D l r)) (ADT-leaf-count l Fin.↑ʳ i)) , Eq.trans p' (lookup-++ₗ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) +ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | false | (i , p') = (Fin.cast (Eq.sym (ADT-leaf-count-lemma D l r)) (ADT-leaf-count l Fin.↑ʳ i)) , Eq.trans p' (List.lookup-++ₗ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) ADT-leaf⊆⟦⟧ : ∀ e₂ → ADT.⟦ e₂ ⟧ ⊆ listToIndexedSet (ADT-leafs e₂) ADT-leaf⊆⟦⟧ e₂ i = ADT-leaf∈⟦⟧ (ADT.⟦ e₂ ⟧ i) e₂ (i , refl) -open import Data.List.Relation.Unary.AllPairs using (AllPairs; []; _∷_) -import Data.List.Relation.Unary.AllPairs.Properties as AllPairs -open import Data.List.Relation.Unary.Any using (here; there) -open import Data.List.Relation.Unary.All using (All; []; _∷_) -import Data.List.Relation.Binary.Subset.Propositional as List - -Unique : ∀ {ℓ} {A : Set ℓ} → List A → Set ℓ -Unique xs = AllPairs _≢_ xs - Fin-reduce≥-injective : ∀ {m n} (i : Fin (m + n)) (j : Fin (m + n)) (m≤i : m ≤ Fin.toℕ i) (m≤j : m ≤ Fin.toℕ j) → Fin.reduce≥ i m≤i ≡ Fin.reduce≥ j m≤j → i ≡ j Fin-reduce≥-injective {zero} {.(suc _)} zero j m≤i m≤j i≡j = i≡j Fin-reduce≥-injective {zero} {.(suc _)} (suc i) j m≤i m≤j i≡j = i≡j @@ -223,59 +207,25 @@ IndexedSet-⊆⇒List-⊆ gen l gen⊆l {x} (here refl) with gen⊆l zero ... | i , x∈l = Eq.subst (List._∈ (List⁺.toList l)) (Eq.sym x∈l) (List.∈-lookup {xs = List⁺.toList l} i) IndexedSet-⊆⇒List-⊆ {suc n} gen l gen⊆l {x} (there x∈gen) = IndexedSet-⊆⇒List-⊆ {n} (gen ∘ suc) l (gen⊆l ∘ suc) x∈gen -lemma5 : ∀ {ℓ} {A : Set ℓ} (u v : A) (xs ys : List A) → u ≢ v → u List.∈ (xs List.++ List.[ v ] List.++ ys) → u List.∈ (xs List.++ ys) -lemma5 u v [] ys u≢v (here u≡v) = ⊥-elim (u≢v u≡v) -lemma5 u v [] ys u≢v (there u∈ys) = u∈ys -lemma5 u v (x ∷ xs) ys u≢v (here u≡x) = here u≡x -lemma5 u v (x ∷ xs) ys u≢v (there u∈xs++v∷ys) = there (lemma5 u v xs ys u≢v u∈xs++v∷ys) - -∈∧∉⇒≢ : ∀ {ℓ} {A : Set ℓ} {y z : A} (xs : List A) → y List.∈ xs → All (z ≢_) xs → y ≢ z -∈∧∉⇒≢ (x ∷ xs) (here y≡x) (y≢x ∷ z∉xs) y≡z = y≢x (Eq.trans (Eq.sym y≡z) y≡x) -∈∧∉⇒≢ (x ∷ xs) (there y∈xs) (y≢x ∷ z∉xs) y≡z = ∈∧∉⇒≢ xs y∈xs z∉xs y≡z - -length≤ : ∀ {ℓ} {A : Set ℓ} (xs ys : List A) → Unique xs → xs List.⊆ ys → List.length xs ≤ List.length ys -length≤ [] ys unique-xs xs⊆ys = z≤n -length≤ (x ∷ xs) ys unique-xs xs⊆ys with List.∈-∃++ (xs⊆ys (here refl)) -length≤ (x ∷ xs) ys (x∉xs ∷ unique-xs) xs⊆ys | l , r , ys≡l++x∷r = - begin - List.length (x ∷ xs) - ≡⟨⟩ - suc (List.length xs) - ≤⟨ s≤s (length≤ xs (l List.++ r) unique-xs λ {y} y∈xs → lemma5 y x l r (∈∧∉⇒≢ xs y∈xs x∉xs) (Eq.subst (y List.∈_) ys≡l++x∷r (xs⊆ys (there y∈xs)))) ⟩ - suc (List.length (l List.++ r)) - ≡⟨ Eq.cong suc (List.length-++ l) ⟩ - suc (List.length l + List.length r) - ≡⟨ ℕ.+-suc (List.length l) (List.length r) ⟨ - List.length l + suc (List.length r) - ≡⟨⟩ - List.length l + List.length (x ∷ r) - ≡⟨ List.length-++ l ⟨ - List.length (l List.++ (x ∷ r)) - ≡⟨ Eq.cong List.length ys≡l++x∷r ⟨ - List.length ys - ∎ - where - open ℕ.≤-Reasoning - -lemma3 : ∀ n l → variants n ⊆ listToIndexedSet l → 2 ^ n ≤ List⁺.length l -lemma3 n l variants⊆l = +variants⊆⇒2^n≤ : ∀ n l → variants n ⊆ listToIndexedSet l → 2 ^ n ≤ List⁺.length l +variants⊆⇒2^n≤ n l variants⊆l = begin 2 ^ n ≡⟨ ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}} ⟨ suc (pred (2 ^ n)) ≡⟨ List.length-tabulate (variants n) ⟨ List.length (List.tabulate (variants n)) - ≤⟨ length≤ (List.tabulate (variants n)) (List⁺.toList l) (variants-unique n) (IndexedSet-⊆⇒List-⊆ (variants n) l variants⊆l) ⟩ + ≤⟨ List.length≤ (List.tabulate (variants n)) (List⁺.toList l) (variants-unique n) (IndexedSet-⊆⇒List-⊆ (variants n) l variants⊆l) ⟩ List⁺.length l ∎ where open ℕ.≤-Reasoning -lemma2 : ∀ n e₂ → variants n ⊆ ADT.⟦ e₂ ⟧ → 2 ^ n ≤ sizeADT e₂ -lemma2 n e₂ variants⊆e₂ = +variants⊆e₂⇒2^n≤e₂ : ∀ n e₂ → variants n ⊆ ADT.⟦ e₂ ⟧ → 2 ^ n ≤ sizeADT e₂ +variants⊆e₂⇒2^n≤e₂ n e₂ variants⊆e₂ = begin 2 ^ n - ≤⟨ lemma3 n (ADT-leafs e₂) (⊆-trans variants⊆e₂ (ADT-leaf⊆⟦⟧ e₂)) ⟩ + ≤⟨ variants⊆⇒2^n≤ n (ADT-leafs e₂) (⊆-trans variants⊆e₂ (ADT-leaf⊆⟦⟧ e₂)) ⟩ ADT-leaf-count e₂ ≤⟨ leafs-≤-size e₂ ⟩ sizeADT e₂ @@ -283,10 +233,10 @@ lemma2 n e₂ variants⊆e₂ = where open ℕ.≤-Reasoning -lemma4 : ∀ n → 13 * (n * n) < 16 ^ n -lemma4 zero = s≤s z≤n -lemma4 (suc zero) = ℕ.+-monoʳ-≤ 14 z≤n -lemma4 (suc (suc n)) = go (suc n) +13*n^2<16^n : ∀ n → 13 * (n * n) < 16 ^ n +13*n^2<16^n zero = s≤s z≤n +13*n^2<16^n (suc zero) = ℕ.+-monoʳ-≤ 14 z≤n +13*n^2<16^n (suc (suc n)) = go (suc n) where open ℕ.≤-Reasoning @@ -328,7 +278,7 @@ lemma4 (suc (suc n)) = go (suc n) 16 * (4 * (n * n)) ≤⟨ ℕ.*-monoʳ-≤ 16 (ℕ.*-monoˡ-≤ (n * n) (ℕ.+-monoʳ-≤ 4 (z≤n {9}))) ⟩ 16 * (13 * (n * n)) - <⟨ ℕ.*-monoʳ-< 16 (lemma4 n) ⟩ + <⟨ ℕ.*-monoʳ-< 16 (13*n^2<16^n n) ⟩ 16 * 16 ^ n ≡⟨⟩ 16 ^ (1 + n) @@ -360,11 +310,11 @@ lemma (suc m) e₂ (e₁⊆e₂ , e₂⊆e₁) = n * n + 12 * (n * n) ≡⟨⟩ 13 * (n * n) - <⟨ lemma4 n ⟩ + <⟨ 13*n^2<16^n n ⟩ 16 ^ n ≡⟨ ℕ.^-*-assoc 2 4 n ⟩ 2 ^ (4 * n) - ≤⟨ lemma2 (4 * n) e₂ (⊆-trans (lemma1 (4 * n)) e₁⊆e₂) ⟩ + ≤⟨ variants⊆e₂⇒2^n≤e₂ (4 * n) e₂ (⊆-trans (variants⊆e₁ (4 * n)) e₁⊆e₂) ⟩ sizeADT e₂ ∎ where diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index 9d4e533e..c4510862 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -4,19 +4,26 @@ Utilities for lists. module Vatras.Util.List where open import Data.Bool using (Bool; true; false) -open import Data.Fin using (Fin) +open import Data.Empty using (⊥-elim) +open import Data.Fin as Fin using (Fin; zero; suc) +import Data.Fin.Properties as Fin open import Data.Nat using (ℕ; suc; zero; NonZero; _+_; _∸_; _*_; _⊔_; _≤_; _<_; s≤s; z≤n) open import Data.Nat.Properties as ℕ using (m≤m+n) open import Data.List as List using (List; []; _∷_; lookup; foldr; _++_) open import Data.List.Properties using (map-id; length-++) open import Data.List.Membership.Propositional using (_∈_) +import Data.List.Membership.Propositional.Properties as List open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_; toList; _⁺++⁺_) renaming (map to map⁺) +open import Data.List.Relation.Binary.Subset.Propositional using (_⊆_) +open import Data.List.Relation.Unary.All using (All; _∷_) open import Data.List.Relation.Unary.Any using (here; there) +open import Data.List.Relation.Unary.Unique.Propositional using (Unique; _∷_) +open import Data.Product using (_,_) open import Data.Vec as Vec using (Vec; []; _∷_) open import Vatras.Util.Nat.AtLeast as ℕ≥ using (ℕ≥; sucs) open import Function using (id; _∘_; flip; const) -open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≗_; refl) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≗_; _≢_; refl) -- true iff the given list is empty empty? : ∀ {A : Set} → List A → Bool @@ -39,11 +46,77 @@ max-≤ n (x ∷ xs) (there x∈xs) = ℕ.≤-trans (max-≤ n xs x∈xs) (ℕ.m ⁺++⁺-length-≤ : ∀ {ℓ} {A : Set ℓ} (xs ys : List⁺ A) → List⁺.length xs ≤ List⁺.length (xs ⁺++⁺ ys) ⁺++⁺-length-≤ xs ys rewrite ⁺++⁺-length xs ys = m≤m+n (List⁺.length xs) (List⁺.length ys) +length-++-≤ₗ : ∀ {ℓ} {A : Set ℓ} + → (xs ys : List A) + → List.length xs ≤ List.length (xs List.++ ys) +length-++-≤ₗ xs ys = Eq.subst (_ ≤_) (Eq.sym (length-++ xs)) (ℕ.m≤m+n (List.length xs) (List.length ys)) + +lookup-++ᵣ : ∀ {ℓ} {A : Set ℓ} + → (xs ys : List A) + → (i : Fin (List.length xs)) + → List.lookup xs i ≡ List.lookup (xs List.++ ys) (Fin.inject≤ i (length-++-≤ₗ xs ys)) +lookup-++ᵣ (x ∷ xs) ys zero = refl +lookup-++ᵣ (x ∷ xs) ys (suc i) = lookup-++ᵣ xs ys i + +lookup-++ₗ : ∀ {ℓ} {A : Set ℓ} + → (xs ys : List A) + → (i : Fin (List.length ys)) + → List.lookup ys i ≡ List.lookup (xs List.++ ys) (Fin.cast (Eq.sym (length-++ xs)) (List.length xs Fin.↑ʳ i)) +lookup-++ₗ [] ys i = Eq.cong (List.lookup ys) (Eq.sym (Fin.cast-is-id refl i)) +lookup-++ₗ (x ∷ xs) ys i = lookup-++ₗ xs ys i + ++-tail : ∀ {ℓ} {A : Set ℓ} (y : A) (ys xs : List A) → (xs ++ y ∷ []) ++ ys ≡ xs ++ y ∷ ys ++-tail y ys [] = refl ++-tail y ys (x ∷ xs) = Eq.cong (x ∷_) (++-tail y ys xs) +∈xs++v∷ys⇒∈xs++ys : ∀ {ℓ} {A : Set ℓ} + → (u v : A) + → (xs ys : List A) + → u ≢ v + → u ∈ (xs List.++ List.[ v ] List.++ ys) + → u ∈ (xs List.++ ys) +∈xs++v∷ys⇒∈xs++ys u v [] ys u≢v (here u≡v) = ⊥-elim (u≢v u≡v) +∈xs++v∷ys⇒∈xs++ys u v [] ys u≢v (there u∈ys) = u∈ys +∈xs++v∷ys⇒∈xs++ys u v (x ∷ xs) ys u≢v (here u≡x) = here u≡x +∈xs++v∷ys⇒∈xs++ys u v (x ∷ xs) ys u≢v (there u∈xs++v∷ys) = there (∈xs++v∷ys⇒∈xs++ys u v xs ys u≢v u∈xs++v∷ys) + +∈∧∉⇒≢ : ∀ {ℓ} {A : Set ℓ} {y z : A} + → (xs : List A) + → y ∈ xs + → All (z ≢_) xs + → y ≢ z +∈∧∉⇒≢ (x ∷ xs) (here y≡x) (y≢x ∷ z∉xs) y≡z = y≢x (Eq.trans (Eq.sym y≡z) y≡x) +∈∧∉⇒≢ (x ∷ xs) (there y∈xs) (y≢x ∷ z∉xs) y≡z = ∈∧∉⇒≢ xs y∈xs z∉xs y≡z + +length≤ : ∀ {ℓ} {A : Set ℓ} + → (xs ys : List A) + → Unique xs + → xs ⊆ ys + → List.length xs ≤ List.length ys +length≤ [] ys unique-xs xs⊆ys = z≤n +length≤ (x ∷ xs) ys unique-xs xs⊆ys with List.∈-∃++ (xs⊆ys (here refl)) +length≤ (x ∷ xs) ys (x∉xs ∷ unique-xs) xs⊆ys | l , r , ys≡l++x∷r = + begin + List.length (x ∷ xs) + ≡⟨⟩ + suc (List.length xs) + ≤⟨ s≤s (length≤ xs (l List.++ r) unique-xs λ {y} y∈xs → ∈xs++v∷ys⇒∈xs++ys y x l r (∈∧∉⇒≢ xs y∈xs x∉xs) (Eq.subst (y ∈_) ys≡l++x∷r (xs⊆ys (there y∈xs)))) ⟩ + suc (List.length (l List.++ r)) + ≡⟨ Eq.cong suc (length-++ l) ⟩ + suc (List.length l + List.length r) + ≡⟨ ℕ.+-suc (List.length l) (List.length r) ⟨ + List.length l + suc (List.length r) + ≡⟨⟩ + List.length l + List.length (x ∷ r) + ≡⟨ length-++ l ⟨ + List.length (l List.++ (x ∷ r)) + ≡⟨ Eq.cong List.length ys≡l++x∷r ⟨ + List.length ys + ∎ + where + open ℕ.≤-Reasoning + -- Do not touch this function. its definition is very fragile and just refactoring it can break proofs. find-or-last : ∀ {ℓ} {A : Set ℓ} → ℕ → List⁺ A → A find-or-last _ (x ∷ []) = x From 762fe1a9e12847dbdf4432a9d068b6a6b4982952 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Thu, 12 Dec 2024 22:20:15 +0100 Subject: [PATCH 17/82] Make language arguments implicit MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previously, these where not inferred correctly, but now it works™. --- src/Vatras/SyntacticExpressiveness.agda | 110 ++++++++++++------------ 1 file changed, 55 insertions(+), 55 deletions(-) diff --git a/src/Vatras/SyntacticExpressiveness.agda b/src/Vatras/SyntacticExpressiveness.agda index 7cc907c1..e57460d6 100644 --- a/src/Vatras/SyntacticExpressiveness.agda +++ b/src/Vatras/SyntacticExpressiveness.agda @@ -45,17 +45,17 @@ _ n * size L₁ e₁ go e₃ e₁≅e₃ with L₃→L₂ A e₃ @@ -105,15 +105,15 @@ L₁ n * size L₁ e₁ go e₃ e₁≅e₃ with L₃→L₂ A e₃ @@ -128,11 +128,11 @@ L₁ n * size L₃ e₃ go e₁ e₃≅e₁ = @@ -153,45 +153,45 @@ L₁ Date: Thu, 12 Dec 2024 23:53:52 +0100 Subject: [PATCH 18/82] Prove 2CC=2CC, NCC=2CC (for N=2) and conclude 2CC=CCC --- .../SyntacticExpressiveness/2CC=2CC.agda | 152 ++++++++++++++++++ .../SyntacticExpressiveness/2CC=CCC.agda | 27 ++++ 2 files changed, 179 insertions(+) create mode 100644 src/Vatras/SyntacticExpressiveness/2CC=2CC.agda create mode 100644 src/Vatras/SyntacticExpressiveness/2CC=CCC.agda diff --git a/src/Vatras/SyntacticExpressiveness/2CC=2CC.agda b/src/Vatras/SyntacticExpressiveness/2CC=2CC.agda new file mode 100644 index 00000000..1888ecc5 --- /dev/null +++ b/src/Vatras/SyntacticExpressiveness/2CC=2CC.agda @@ -0,0 +1,152 @@ +module Vatras.SyntacticExpressiveness.2CC=2CC where + +open import Data.Nat as ℕ using (zero; suc; _+_) +import Data.Nat.Properties as ℕ +import Data.List as List +import Data.List.Properties as List +open import Data.Product using (_,_) +open import Data.Vec as Vec using ([]; _∷_) +open import Function using (_∘_; id) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≗_) +open import Size using (Size) + +open import Vatras.Util.Nat.AtLeast using (sucs) +open import Vatras.Data.EqIndexedSet using (≅[]→≅) +open import Vatras.Framework.Definitions using (𝔽; 𝔸) +open import Vatras.Lang.All +open import Vatras.Translation.Lang.2CC.Rename using (rename) renaming (preserves to rename-preserves) +import Vatras.Translation.Lang.2CC-to-NCC +open Vatras.Translation.Lang.2CC-to-NCC.2Ary using () renaming (translate to 2CC→NCC; preserves to 2CC→NCC-preserves) +import Vatras.Translation.Lang.NCC-to-2CC +open Vatras.Translation.Lang.NCC-to-2CC.2Ary using () renaming (translate to NCC→2CC; preserves to NCC→2CC-preserves) +open import Vatras.SyntacticExpressiveness using (_≤Size_; _=Size_) +open import Vatras.SyntacticExpressiveness.Sizes using (Sized2CC; size2CC; SizedNCC; sizeNCC) + +module _ {F₁ F₂ : 𝔽} (f : F₂ → F₁) (f⁻¹ : F₁ → F₂) (f⁻¹∘f≗id : f⁻¹ ∘ f ≗ id) where + rename-preserves-size2CC : ∀ {i : Size} {A : 𝔸} + → (e : 2CC.2CC F₂ i A) + → size2CC F₁ (rename f e) ≡ size2CC F₂ e + rename-preserves-size2CC (a 2CC.2CC.-< cs >-) = + begin + size2CC F₁ (rename f (a 2CC.2CC.-< cs >-)) + ≡⟨⟩ + size2CC F₁ (a 2CC.2CC.-< List.map (rename f) cs >-) + ≡⟨⟩ + suc (List.sum (List.map (size2CC F₁) (List.map (rename f) cs))) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ + suc (List.sum (List.map (size2CC F₁ ∘ rename f) cs)) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-cong rename-preserves-size2CC cs) ⟩ + suc (List.sum (List.map (size2CC F₂) cs)) + ≡⟨⟩ + size2CC F₂ (a 2CC.2CC.-< cs >-) + ∎ + where + open Eq.≡-Reasoning + rename-preserves-size2CC (D 2CC.2CC.⟨ l , r ⟩) = + begin + size2CC F₁ (rename f (D 2CC.2CC.⟨ l , r ⟩)) + ≡⟨⟩ + suc (size2CC F₁ (rename f l) + size2CC F₁ (rename f r)) + ≡⟨ Eq.cong suc (Eq.cong₂ _+_ (rename-preserves-size2CC l) (rename-preserves-size2CC r)) ⟩ + suc (size2CC F₂ l + size2CC F₂ r) + ≡⟨⟩ + size2CC F₂ (D 2CC.2CC.⟨ l , r ⟩) + ∎ + where + open Eq.≡-Reasoning + + 2CC≤2CC : Sized2CC F₁ ≤Size Sized2CC F₂ + 2CC≤2CC = 1 , λ A e → + rename f e + , ≅[]→≅ (rename-preserves f f⁻¹ f⁻¹∘f≗id e) + , ℕ.≤-reflexive (Eq.trans (rename-preserves-size2CC e) (Eq.sym (ℕ.+-identityʳ (size2CC F₂ e)))) + +2CC=2CC : ∀ {F₁ F₂ : 𝔽} + → (f : F₂ → F₁) + → (f⁻¹ : F₁ → F₂) + → f⁻¹ ∘ f ≗ id + → f ∘ f⁻¹ ≗ id + → Sized2CC F₁ =Size Sized2CC F₂ +2CC=2CC f f⁻¹ f⁻¹∘f≗id f∘f⁻¹≗id = 2CC≤2CC f f⁻¹ f⁻¹∘f≗id , 2CC≤2CC f⁻¹ f f∘f⁻¹≗id + +2CC→NCC-preserves-size : ∀ {i : Size} {A : 𝔸} {F : 𝔽} + → (e : 2CC.2CC F i A) + → sizeNCC F (sucs zero) (2CC→NCC e) ≡ size2CC F e +2CC→NCC-preserves-size {F = F} (a 2CC.2CC.-< cs >-) = + begin + sizeNCC F (sucs zero) (2CC→NCC (a 2CC.2CC.-< cs >-)) + ≡⟨⟩ + sizeNCC F (sucs zero) (a NCC.NCC.-< List.map 2CC→NCC cs >-) + ≡⟨⟩ + suc (List.sum (List.map (sizeNCC F (sucs zero)) (List.map 2CC→NCC cs))) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ + suc (List.sum (List.map (sizeNCC F (sucs zero) ∘ 2CC→NCC) cs)) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-cong 2CC→NCC-preserves-size cs) ⟩ + suc (List.sum (List.map (size2CC F) cs)) + ≡⟨⟩ + size2CC F (a 2CC.2CC.-< cs >-) + ∎ + where + open Eq.≡-Reasoning +2CC→NCC-preserves-size {F = F} (D 2CC.2CC.⟨ l , r ⟩) = + begin + sizeNCC F (sucs zero) (2CC→NCC (D 2CC.2CC.⟨ l , r ⟩)) + ≡⟨⟩ + sizeNCC F (sucs zero) (D NCC.NCC.⟨ 2CC→NCC l ∷ 2CC→NCC r ∷ [] ⟩) + ≡⟨⟩ + suc (Vec.sum (Vec.map (sizeNCC F (sucs zero)) (2CC→NCC l ∷ 2CC→NCC r ∷ []))) + ≡⟨⟩ + suc (sizeNCC F (sucs zero) (2CC→NCC l) + (sizeNCC F (sucs zero) (2CC→NCC r) + 0)) + ≡⟨ Eq.cong (λ x → suc (sizeNCC F (sucs zero) (2CC→NCC l) + x)) (ℕ.+-identityʳ (sizeNCC F (sucs zero) (2CC→NCC r))) ⟩ + suc (sizeNCC F (sucs zero) (2CC→NCC l) + sizeNCC F (sucs zero) (2CC→NCC r)) + ≡⟨ Eq.cong suc (Eq.cong₂ _+_ (2CC→NCC-preserves-size l) (2CC→NCC-preserves-size r)) ⟩ + suc (size2CC F l + size2CC F r) + ≡⟨⟩ + size2CC F (D 2CC.2CC.⟨ l , r ⟩) + ∎ + where + open Eq.≡-Reasoning + +NCC→2CC-preserves-size : ∀ {i : Size} {A : 𝔸} {F : 𝔽} + → (e : NCC.NCC F (sucs zero) i A) + → size2CC F (NCC→2CC e) ≡ sizeNCC F (sucs zero) e +NCC→2CC-preserves-size {F = F} (a NCC.NCC.-< cs >-) = + begin + size2CC F (NCC→2CC (a NCC.NCC.-< cs >-)) + ≡⟨⟩ + size2CC F (a 2CC.2CC.-< List.map NCC→2CC cs >-) + ≡⟨⟩ + suc (List.sum (List.map (size2CC F) (List.map NCC→2CC cs))) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ + suc (List.sum (List.map (size2CC F ∘ NCC→2CC) cs)) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-cong NCC→2CC-preserves-size cs) ⟩ + suc (List.sum (List.map (sizeNCC F (sucs zero)) cs)) + ≡⟨⟩ + sizeNCC F (sucs zero) (a NCC.NCC.-< cs >-) + ∎ + where + open Eq.≡-Reasoning +NCC→2CC-preserves-size {F = F} (D NCC.NCC.⟨ c₁ ∷ c₂ ∷ [] ⟩) = + begin + size2CC F (NCC→2CC (D NCC.NCC.⟨ c₁ ∷ c₂ ∷ [] ⟩)) + ≡⟨⟩ + size2CC F (D 2CC.2CC.⟨ NCC→2CC c₁ , NCC→2CC c₂ ⟩) + ≡⟨⟩ + suc (size2CC F (NCC→2CC c₁) + size2CC F (NCC→2CC c₂)) + ≡⟨ Eq.cong suc (Eq.cong₂ _+_ (NCC→2CC-preserves-size c₁) (NCC→2CC-preserves-size c₂)) ⟩ + suc (sizeNCC F (sucs zero) c₁ + sizeNCC F (sucs zero) c₂) + ≡⟨ Eq.cong (λ x → suc (sizeNCC F (sucs zero) c₁) + x) (ℕ.+-identityʳ (sizeNCC F (sucs zero) c₂)) ⟨ + suc (sizeNCC F (sucs zero) c₁ + (sizeNCC F (sucs zero) c₂ + 0)) + ≡⟨⟩ + suc (Vec.sum (Vec.map (sizeNCC F (sucs zero)) (c₁ ∷ c₂ ∷ []))) + ≡⟨⟩ + sizeNCC F (sucs zero) (D NCC.NCC.⟨ c₁ ∷ c₂ ∷ [] ⟩) + ∎ + where + open Eq.≡-Reasoning + +NCC=2CC : ∀ {F : 𝔽} + → SizedNCC F (sucs zero) =Size Sized2CC F +NCC=2CC {F} = + (1 , λ A e → 2CC→NCC e , ≅[]→≅ (2CC→NCC-preserves e) , ℕ.≤-reflexive (Eq.trans (2CC→NCC-preserves-size e) (Eq.sym (ℕ.+-identityʳ (size2CC F e))))) + , (1 , λ A e → NCC→2CC e , ≅[]→≅ (NCC→2CC-preserves e) , ℕ.≤-reflexive (Eq.trans (NCC→2CC-preserves-size e) (Eq.sym (ℕ.+-identityʳ (sizeNCC F (sucs zero) e))))) diff --git a/src/Vatras/SyntacticExpressiveness/2CC=CCC.agda b/src/Vatras/SyntacticExpressiveness/2CC=CCC.agda new file mode 100644 index 00000000..4e9e4c3e --- /dev/null +++ b/src/Vatras/SyntacticExpressiveness/2CC=CCC.agda @@ -0,0 +1,27 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸) +module Vatras.SyntacticExpressiveness.2CC=CCC (F : 𝔽) where + +open import Data.Nat using (ℕ; zero) +open import Data.Product using (_×_; _,_; proj₁) +open import Function using (_∘_; id) +open import Relation.Binary.PropositionalEquality using (_≗_) +open import Size using (∞) + +open import Vatras.Util.Nat.AtLeast using (sucs) +open import Vatras.Framework.Variants using (Rose) +open import Vatras.Lang.All.Fixed F (Rose ∞) +open import Vatras.SyntacticExpressiveness using (_=Size_; ≤Size-transitive) +open import Vatras.SyntacticExpressiveness.Sizes F using (Sized2CC; SizedCCC) +open import Vatras.SyntacticExpressiveness.2CC=2CC using (2CC=2CC; NCC=2CC) +open import Vatras.SyntacticExpressiveness.2CC≤CCC F using (2CC≤CCC) +open import Vatras.SyntacticExpressiveness.CCC≤NCC F using (CCC≤NCC) + +2CC=CCC : + ∀ (f : F × ℕ → F) + → (f⁻¹ : F → F × ℕ) + → f⁻¹ ∘ f ≗ id + → f ∘ f⁻¹ ≗ id + → Sized2CC =Size SizedCCC +2CC=CCC f f⁻¹ f⁻¹∘f≗id f∘f⁻¹≗id = + ≤Size-transitive (proj₁ (2CC=2CC f f⁻¹ f⁻¹∘f≗id f∘f⁻¹≗id)) 2CC≤CCC + , ≤Size-transitive (CCC≤NCC (sucs zero)) (proj₁ NCC=2CC) From 4ef38a3389d7fdba0a7718181d341d1f0a7a5671 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Fri, 20 Dec 2024 21:45:27 +0100 Subject: [PATCH 19/82] =?UTF-8?q?Prove=20FST=20=E2=89=B1=202CC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../FST\342\211\2612CC.agda" | 765 ++++++++++++++++++ src/Vatras/SyntacticExpressiveness/Sizes.agda | 10 + src/Vatras/Util/List.agda | 111 ++- 3 files changed, 851 insertions(+), 35 deletions(-) create mode 100644 "src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" new file mode 100644 index 00000000..023c83ed --- /dev/null +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -0,0 +1,765 @@ +module Vatras.SyntacticExpressiveness.FST≱2CC where + +open import Data.Bool as Bool using (Bool; true; false; if_then_else_) +import Data.Bool.Properties as Bool +open import Data.Empty using (⊥-elim) +open import Data.Nat as ℕ using (ℕ; suc; zero; _≤_; z≤n; s≤s; _>_; _+_; _∸_; _*_; _^_) +import Data.Nat.Properties as ℕ +open import Data.Fin as Fin using (Fin; zero; suc) +import Data.Fin.Properties as Fin +open import Data.List as List using (List; []; _∷_) +import Data.List.Properties as List +import Data.List.Membership.Propositional as List +open import Data.List.Relation.Binary.Sublist.Propositional as Sublist using ([]; _∷_; _∷ʳ_) +open import Data.List.Relation.Unary.Any using (here; there) +open import Data.List.Relation.Unary.All using ([]; _∷_) +open import Data.List.Relation.Unary.AllPairs using ([]; _∷_) +open import Data.List.Relation.Unary.Unique.Propositional using (Unique) +import Data.List.Relation.Unary.Unique.Propositional.Properties as Unique +open import Data.Product as Prod using (_×_; _,_; proj₁; proj₂; Σ-syntax) +open import Data.Unit using (tt) +open import Function using (_∘_; _∘′_; const) +open import Function.Bundles using (Equivalence) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_; refl) +open import Relation.Nullary.Decidable using (yes; no) +open import Relation.Nullary.Negation using (¬_) +open import Size using (Size; ∞) + +open import Vatras.Data.EqIndexedSet using (_⊆_; ⊆-trans; _∈_) +open import Vatras.Framework.Definitions using (𝔸; NAT) +open import Vatras.Framework.Variants using (Rose; Rose-injective) +import Vatras.Util.List as List +open import Vatras.Lang.All.Fixed ℕ (Rose ∞) +open import Vatras.SyntacticExpressiveness using (_≱Size_) +open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST) + +open FST.Impose NAT hiding (Unique; _∈_) + +-- TODO duplicated from 2CC≤CCC +>⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ℕ.≤ᵇ n)) +>⇒¬≤ᵇ (s≤s z≤n) = tt +>⇒¬≤ᵇ (s≤s (s≤s m>n)) = >⇒¬≤ᵇ (s≤s m>n) + +big-artifact : ℕ → ℕ → FSTA ∞ +big-artifact zero i = i Rose.-< [] >- +big-artifact (suc n) i = i Rose.-< big-artifact n i ∷ big-artifact n (i + 2 ^ n) ∷ [] >- + +artifact : ℕ → ℕ → FSTA ∞ +artifact n zero = 0 Rose.-< big-artifact n zero ∷ [] >- +artifact n (suc i) = suc i Rose.-< [] >- + +big-artifact-≉ : (n i : ℕ) → big-artifact n i ≉ big-artifact n (i + 2 ^ n) +big-artifact-≉ zero i i≡i+2^n = ℕ.1+n≢n (Eq.sym (Eq.trans i≡i+2^n (ℕ.+-comm i 1))) +big-artifact-≉ (suc n) i i≡i+2^n = ℕ.1+n≰n ( + begin-strict + i + <⟨ ℕ.n<1+n i ⟩ + 1 + i + ≡⟨ ℕ.+-comm 1 i ⟩ + i + 1 + ≤⟨ ℕ.+-monoʳ-≤ i (ℕ.m^n>0 2 (suc n)) ⟩ + i + 2 ^ suc n + ≡⟨ i≡i+2^n ⟨ + i + ∎) + where + open ℕ.≤-Reasoning + +big-artifact-wf : (n i : ℕ) → WellFormed (big-artifact n i) +big-artifact-wf zero i = [] , [] +big-artifact-wf (suc n) i = (big-artifact-≉ n i ∷ []) ∷ [] ∷ [] , big-artifact-wf n i ∷ big-artifact-wf n (i + 2 ^ n) ∷ [] + +artifact-wf : (n i : ℕ) → WellFormed (artifact n i) +artifact-wf n zero = [] ∷ [] , big-artifact-wf n zero ∷ [] +artifact-wf n (suc i) = [] , [] + +feature : ℕ → ℕ → FSF +feature n i = (artifact n i ∷ []) ⊚ ([] ∷ [] , artifact-wf n i ∷ []) + +e₁ : ℕ → SPL +e₁ n = 0 ◀ List.applyUpTo (λ i → i :: feature n i) (suc n) + +size-big-artifact : + ∀ (n i : ℕ) + → sizeRose (big-artifact n i) ≡ 2 ^ suc n ∸ 1 +size-big-artifact zero i = refl +size-big-artifact (suc n) i = + begin + sizeRose (big-artifact (suc n) i) + ≡⟨⟩ + sizeRose (i Rose.-< big-artifact n i ∷ big-artifact n (i + 2 ^ n) ∷ [] >-) + ≡⟨⟩ + suc (sizeRose (big-artifact n i) + (sizeRose (big-artifact n (i + 2 ^ n)) + 0)) + ≡⟨ Eq.cong (λ x → suc (sizeRose (big-artifact n i) + x)) (ℕ.+-identityʳ (sizeRose (big-artifact n (i + 2 ^ n)))) ⟩ + suc (sizeRose (big-artifact n i) + (sizeRose (big-artifact n (i + 2 ^ n)))) + ≡⟨ Eq.cong₂ (λ x y → suc (x + y)) (size-big-artifact n i) (size-big-artifact n (i + 2 ^ n)) ⟩ + suc ((2 ^ suc n ∸ 1) + (2 ^ suc n ∸ 1)) + ≡⟨ Eq.cong (_+ (2 ^ suc n ∸ 1)) (ℕ.+-∸-assoc 1 {2 ^ suc n} {1} (ℕ.m^n>0 2 (suc n))) ⟨ + 2 ^ suc n + (2 ^ suc n ∸ 1) + ≡⟨ ℕ.+-∸-assoc (2 ^ suc n) {2 ^ suc n} {1} (ℕ.m^n>0 2 (suc n)) ⟨ + (2 ^ suc n + 2 ^ suc n) ∸ 1 + ≡⟨ Eq.cong (λ x → (2 ^ suc n + x) ∸ 1) (ℕ.+-identityʳ (2 ^ suc n)) ⟨ + (2 ^ suc n + (2 ^ suc n + 0)) ∸ 1 + ≡⟨⟩ + 2 * 2 ^ suc n ∸ 1 + ≡⟨⟩ + 2 ^ suc (suc n) ∸ 1 + ∎ + where + open Eq.≡-Reasoning + +size-e₁ : + ∀ (n : ℕ) + → sizeFST (e₁ n) ≡ 2 + 2 ^ suc n + 2 * n +size-e₁ n = + begin + sizeFST (e₁ n) + ≡⟨⟩ + suc (List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → i :: feature n i) (suc n)))) + ≡⟨⟩ + suc (suc (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → suc i :: feature n (suc i)) n))) + ≡⟨ Eq.cong (λ x → suc (suc (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) x))) (List.map-upTo (λ i → suc i :: feature n (suc i)) n) ⟨ + suc (suc (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.map (λ i → suc i :: feature n (suc i)) (List.upTo n)))) + ≡⟨ Eq.cong (λ x → suc (suc (sizeRose (artifact n zero) + 0) + List.sum x)) (List.map-∘ (List.upTo n)) ⟨ + 3 + sizeRose (big-artifact n zero) + 0 + 0 + List.sum (List.map (λ i → suc (sizeRose (artifact n (suc i)) + 0)) (List.upTo n)) + ≡⟨ Eq.cong₂ (λ x y → x + 0 + List.sum y) (ℕ.+-identityʳ (3 + sizeRose (big-artifact n zero))) (List.map-cong (λ i → Eq.cong suc (ℕ.+-identityʳ (sizeRose (artifact n (suc i))))) (List.upTo n)) ⟩ + 3 + sizeRose (big-artifact n zero) + 0 + List.sum (List.map (λ i → suc (sizeRose (artifact n (suc i)))) (List.upTo n)) + ≡⟨ Eq.cong (λ x → x + List.sum (List.map (λ i → suc (sizeRose (artifact n (suc i)))) (List.upTo n))) (ℕ.+-identityʳ (3 + sizeRose (big-artifact n zero))) ⟩ + 3 + sizeRose (big-artifact n zero) + List.sum (List.map (const 2) (List.upTo n)) + ≡⟨ Eq.cong (λ x → 3 + x + List.sum (List.map (const 2) (List.upTo n))) (size-big-artifact n zero) ⟩ + 3 + (2 ^ suc n ∸ 1) + List.sum (List.map (const 2) (List.upTo n)) + ≡⟨ Eq.cong (λ x → 3 + (2 ^ suc n ∸ 1) + List.sum x) (List.map-const 2 (List.upTo n)) ⟩ + 3 + (2 ^ suc n ∸ 1) + List.sum (List.replicate (List.length (List.upTo n)) 2) + ≡⟨ Eq.cong (λ x → 3 + (2 ^ suc n ∸ 1) + List.sum (List.replicate x 2)) (List.length-upTo n) ⟩ + 3 + (2 ^ suc n ∸ 1) + List.sum (List.replicate n 2) + ≡⟨ Eq.cong (λ x → 3 + (2 ^ suc n ∸ 1) + x) (List.sum-replicate n 2) ⟩ + 3 + (2 ^ suc n ∸ 1) + n * 2 + ≡⟨ Eq.cong (λ x → 2 + (x + n * 2)) (ℕ.+-∸-assoc 1 {2 ^ suc n} {1} (ℕ.m^n>0 2 (suc n))) ⟨ + 2 + 2 ^ suc n + n * 2 + ≡⟨ Eq.cong (λ x → 2 + 2 ^ suc n + x) (ℕ.*-comm n 2) ⟩ + 2 + 2 ^ suc n + 2 * n + ∎ + where + open Eq.≡-Reasoning + +variant : ℕ → ℕ → FSTA ∞ +variant n i = 0 Rose.-< List.applyUpTo (artifact n) i >- + +1≤size2CC : ∀ {i : Size} {A : 𝔸} → (e : 2CC.2CC i A) → 1 ≤ size2CC e +1≤size2CC (a 2CC.2CC.-< cs >-) = s≤s z≤n +1≤size2CC (D 2CC.2CC.⟨ l , r ⟩) = s≤s z≤n + +∈-children : ∀ {i : Size} + → (n j : ℕ) + → {a₁ a₂ : ℕ} + → (cs₁ : List (FSTA ∞)) + → (cs₂ : List (2CC.2CC i NAT)) + → (a₁ Rose.-< cs₁ >-) ∈ 2CC.⟦ a₂ 2CC.2CC.-< cs₂ >- ⟧ + → cs₁ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs₂) +∈-children n j cs₁ cs₂ (conf , cs₁≡cs₂) = conf , proj₂ (Rose-injective cs₁≡cs₂) + +artifact-child-count : ∀ {i : Size} + → (n j : ℕ) + → (a : ℕ) + → (cs : List (2CC.2CC i NAT)) + → big-artifact (suc n) j ∈ 2CC.⟦ a 2CC.2CC.-< cs >- ⟧ + → List.length cs ≡ 2 +artifact-child-count n j a (c₁ ∷ c₂ ∷ []) artifact∈cs = refl + +big-artifact-children : ∀ {i : Size} + → (n j : ℕ) + → (a : ℕ) + → (cs : List (2CC.2CC i NAT)) + → (c : 2CC.2CC i NAT) + → c List.∈ cs + → big-artifact (suc n) j ∈ 2CC.⟦ a 2CC.2CC.-< cs >- ⟧ + → Σ[ j' ∈ ℕ ] big-artifact n j' ∈ 2CC.⟦ c ⟧ +big-artifact-children n j a (x₂ ∷ x₃ ∷ []) .x₂ (here refl) (conf , artifact≡cs) = j , conf , proj₁ (List.∷-injective (proj₂ (Rose-injective artifact≡cs))) +big-artifact-children n j a (x₂ ∷ x₃ ∷ []) .x₃ (there (here refl)) (conf , artifact≡cs) = j + 2 ^ n , conf , proj₁ (List.∷-injective (proj₂ (List.∷-injective (proj₂ (Rose-injective artifact≡cs))))) + +big-artifact∈e₂⇒2^n≤e₂ : ∀ {i : Size} + → (n j : ℕ) + → (e₂ : 2CC.2CC i NAT) + → big-artifact n j ∈ 2CC.⟦ e₂ ⟧ + → 2 ^ suc n ∸ 1 ≤ size2CC e₂ +big-artifact∈e₂⇒2^n≤e₂ zero j e₂ artifact∈e₂ = 1≤size2CC e₂ +big-artifact∈e₂⇒2^n≤e₂ (suc n) j (a 2CC.2CC.-< cs >-) artifact∈e₂ = + begin + 2 ^ suc (suc n) ∸ 1 + ≡⟨ ℕ.+-∸-assoc 1 {2 ^ suc (suc n)} {2} (ℕ.m≤m*n 2 (2 ^ suc n) {{ℕ.>-nonZero (ℕ.m^n>0 2 (suc n))}}) ⟩ + suc (2 ^ suc (suc n) ∸ 2) + ≡⟨⟩ + suc (2 * 2 ^ suc n ∸ 2) + ≡⟨ Eq.cong suc (ℕ.*-distribˡ-∸ 2 (2 ^ suc n) 1) ⟨ + suc (2 * (2 ^ suc n ∸ 1)) + ≡⟨ Eq.cong (λ x → suc (x * (2 ^ suc n ∸ 1))) (artifact-child-count n j a cs artifact∈e₂) ⟨ + suc (List.length cs * (2 ^ suc n ∸ 1)) + ≡⟨ Eq.cong suc (List.sum-replicate (List.length cs) (2 ^ suc n ∸ 1)) ⟨ + suc (List.sum (List.replicate (List.length cs) (2 ^ suc n ∸ 1))) + ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-const (2 ^ suc n ∸ 1) cs) ⟨ + suc (List.sum (List.map (const (2 ^ suc n ∸ 1)) cs)) + ≤⟨ s≤s (List.sum-map-≤-with∈ cs (λ c c∈cs → big-artifact∈e₂⇒2^n≤e₂ n (proj₁ (big-artifact-children n j a cs c c∈cs artifact∈e₂)) c (proj₂ (big-artifact-children n j a cs c c∈cs artifact∈e₂)))) ⟩ + suc (List.sum (List.map size2CC cs)) + ≡⟨⟩ + size2CC (a 2CC.2CC.-< cs >-) + ∎ + where + open ℕ.≤-Reasoning +big-artifact∈e₂⇒2^n≤e₂ (suc n) j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) with conf D +big-artifact∈e₂⇒2^n≤e₂ (suc n) j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) | true = + begin + 2 ^ suc (suc n) ∸ 1 + <⟨ s≤s ℕ.≤-refl ⟩ + suc (2 ^ suc (suc n) ∸ 1) + ≤⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ (suc n) j l (conf , artifact≡e₂)) ⟩ + suc (size2CC l) + ≤⟨ s≤s (ℕ.m≤m+n (size2CC l) (size2CC r)) ⟩ + suc (size2CC l + size2CC r) + ≡⟨⟩ + size2CC (D 2CC.2CC.⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning +big-artifact∈e₂⇒2^n≤e₂ (suc n) j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) | false = + begin + 2 ^ suc (suc n) ∸ 1 + <⟨ s≤s ℕ.≤-refl ⟩ + suc (2 ^ suc (suc n) ∸ 1) + ≤⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ (suc n) j r (conf , artifact≡e₂)) ⟩ + suc (size2CC r) + ≤⟨ s≤s (ℕ.m≤n+m (size2CC r) (size2CC l)) ⟩ + suc (size2CC l + size2CC r) + ≡⟨⟩ + size2CC (D 2CC.2CC.⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning + +artifact-0∈e₂⇒2^n≤e₂ : ∀ {i : Size} + → (n : ℕ) + → (e₂ : 2CC.2CC i NAT) + → artifact n zero ∈ 2CC.⟦ e₂ ⟧ + → 2 ^ suc n ≤ size2CC e₂ +artifact-0∈e₂⇒2^n≤e₂ n (a 2CC.2CC.-< c ∷ [] >-) (conf , artifact≡cs) = + begin + 2 ^ suc n + ≡⟨ ℕ.+-∸-assoc 1 {2 ^ suc n} {1} (ℕ.m^n>0 2 (suc n)) ⟩ + suc (2 ^ suc n ∸ 1) + ≤⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ n zero c (conf , proj₁ (List.∷-injective (proj₂ (Rose-injective artifact≡cs))))) ⟩ + suc (size2CC c) + ≡⟨ Eq.cong suc (ℕ.+-identityʳ (size2CC c)) ⟨ + suc (size2CC c + 0) + ≡⟨⟩ + size2CC (a 2CC.2CC.-< c ∷ [] >-) + ∎ + where + open ℕ.≤-Reasoning +artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) with conf D +artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) | true = + begin + 2 ^ suc n + <⟨ s≤s ℕ.≤-refl ⟩ + suc (2 ^ suc n) + ≤⟨ s≤s (artifact-0∈e₂⇒2^n≤e₂ n l (conf , artifact≡cs)) ⟩ + suc (size2CC l) + ≤⟨ s≤s (ℕ.m≤m+n (size2CC l) (size2CC r)) ⟩ + suc (size2CC l + size2CC r) + ≡⟨⟩ + size2CC (D 2CC.2CC.⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning +artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) | false = + begin + 2 ^ suc n + <⟨ s≤s ℕ.≤-refl ⟩ + suc (2 ^ suc n) + ≤⟨ s≤s (artifact-0∈e₂⇒2^n≤e₂ n r (conf , artifact≡cs)) ⟩ + suc (size2CC r) + ≤⟨ s≤s (ℕ.m≤n+m (size2CC r) (size2CC l)) ⟩ + suc (size2CC l + size2CC r) + ≡⟨⟩ + size2CC (D 2CC.2CC.⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning + +2^n≤size2CC-artifact : ∀ {i : Size} + → (n j : ℕ) + → (a : ℕ) + → (cs : List (2CC.2CC i NAT)) + → variant n (suc j) ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ + → 2 ^ suc n ≤ size2CC (a 2CC.-< cs >-) +2^n≤size2CC-artifact n j a (c ∷ cs) (conf , artifact≡cs) = + begin + 2 ^ suc n + ≤⟨ artifact-0∈e₂⇒2^n≤e₂ n c (conf , proj₁ (List.∷-injective (proj₂ (Rose-injective artifact≡cs)))) ⟩ + size2CC c + ≤⟨ ℕ.m≤m+n (size2CC c) (List.sum (List.map size2CC cs)) ⟩ + size2CC c + List.sum (List.map size2CC cs) + ≡⟨⟩ + List.sum (List.map size2CC (c ∷ cs)) + <⟨ s≤s ℕ.≤-refl ⟩ + suc (List.sum (List.map size2CC (c ∷ cs))) + ≡⟨⟩ + size2CC (a 2CC.-< c ∷ cs >-) + ∎ + where + open ℕ.≤-Reasoning + +impossible-artifact-sizes : ∀ {i : Size} + → (n : ℕ) + → (cs : List (2CC.2CC i NAT)) + → (cs₁ cs₂ : List (FSTA ∞)) + → List.length cs₁ ≢ List.length cs₂ + → cs₁ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs) + → ¬ cs₂ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs) +impossible-artifact-sizes n cs [] [] cs₁≢cs₂ (i , cs₁≡cs) (j , cs₂≡cs) = cs₁≢cs₂ refl +impossible-artifact-sizes n [] [] (c₂ ∷ cs₂) cs₁≢cs₂ (i , cs₁≡cs) (j , ()) +impossible-artifact-sizes n (c ∷ cs) [] (c₂ ∷ cs₂) cs₁≢cs₂ (i , ()) (j , cs₂≡cs) +impossible-artifact-sizes n [] (c₁ ∷ cs₁) [] cs₁≢cs₂ (i , ()) (j , cs₂≡cs) +impossible-artifact-sizes n (c ∷ cs) (c₁ ∷ cs₁) [] cs₁≢cs₂ (i , cs₁≡cs) (j , ()) +impossible-artifact-sizes n (c ∷ cs) (c₁ ∷ cs₁) (c₂ ∷ cs₂) cs₁≢cs₂ (i , cs₁≡cs) (j , cs₂≡cs) = + impossible-artifact-sizes n cs cs₁ cs₂ (cs₁≢cs₂ ∘ Eq.cong suc) (i , proj₂ (List.∷-injective cs₁≡cs)) (j , proj₂ (List.∷-injective cs₂≡cs)) + +split-sizes : ∀ {i : Size} + → (n : ℕ) + → (D : ℕ) + → (l r : 2CC.2CC i NAT) + → (sizes : List ℕ) + → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧ + → List ℕ × List ℕ +split-sizes n D l r [] artifact∈l,r = [] , [] +split-sizes n D l r (size ∷ sizes) artifact⊆l,r with artifact⊆l,r zero +split-sizes n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r with conf D +split-sizes n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r | true = Prod.map₁ (size ∷_) (split-sizes n D l r sizes (artifact⊆l,r ∘ suc)) +split-sizes n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r | false = Prod.map₂ (size ∷_) (split-sizes n D l r sizes (artifact⊆l,r ∘ suc)) + +split-sizes⊆ : ∀ {i : Size} + → (n : ℕ) + → (D : ℕ) + → (l r : 2CC.2CC i NAT) + → (sizes : List ℕ) + → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧) + → ((variant n ∘′ suc ∘′ List.lookup (proj₁ (split-sizes n D l r sizes artifact∈l,r))) ⊆ 2CC.⟦ l ⟧) + × ((variant n ∘′ suc ∘′ List.lookup (proj₂ (split-sizes n D l r sizes artifact∈l,r))) ⊆ 2CC.⟦ r ⟧) +split-sizes⊆ n D l r [] artifact∈l,r = (λ where ()) , (λ where ()) +split-sizes⊆ n D l r (size ∷ sizes) artifact⊆l,r with artifact⊆l,r zero +split-sizes⊆ n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r with conf D +split-sizes⊆ n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r | true = Prod.map₁ go (split-sizes⊆ n D l r sizes (artifact⊆l,r ∘ suc)) + where + go : ∀ {sizes : List ℕ} + → ((variant n ∘′ suc ∘′ List.lookup sizes) ⊆ 2CC.⟦ l ⟧) + → (variant n ∘′ suc ∘′ List.lookup (size ∷ sizes)) ⊆ 2CC.⟦ l ⟧ + go artifact⊆l zero = conf , artifact≡l,r + go artifact⊆l (suc i) = artifact⊆l i +split-sizes⊆ n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r | false = Prod.map₂ go (split-sizes⊆ n D l r sizes (artifact⊆l,r ∘ suc)) + where + go : ∀ {sizes : List ℕ} + → ((variant n ∘′ suc ∘′ List.lookup sizes) ⊆ 2CC.⟦ r ⟧) + → (variant n ∘′ suc ∘′ List.lookup (size ∷ sizes)) ⊆ 2CC.⟦ r ⟧ + go artifact⊆r zero = conf , artifact≡l,r + go artifact⊆r (suc i) = artifact⊆r i + +split-sizes-length : ∀ {i : Size} + → (n : ℕ) + → (D : ℕ) + → (l r : 2CC.2CC i NAT) + → (sizes : List ℕ) + → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧) + → List.length sizes ≤ List.length (proj₁ (split-sizes n D l r sizes artifact∈l,r)) + List.length (proj₂ (split-sizes n D l r sizes artifact∈l,r)) +split-sizes-length n D l r [] artifact∈l,r = z≤n +split-sizes-length n D l r (size ∷ sizes) artifact⊆l,r with artifact⊆l,r zero +split-sizes-length n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r with conf D +split-sizes-length n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡l,r | true = s≤s (split-sizes-length n D l r sizes (artifact∈l,r ∘ suc)) +split-sizes-length n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡l,r | false = + begin + List.length (size ∷ sizes) + ≡⟨⟩ + suc (List.length sizes) + ≤⟨ s≤s (split-sizes-length n D l r sizes (artifact∈l,r ∘ suc)) ⟩ + suc (List.length (proj₁ (split-sizes n D l r sizes (artifact∈l,r ∘ suc))) + List.length (proj₂ (split-sizes n D l r sizes (artifact∈l,r ∘ suc)))) + ≡⟨ ℕ.+-suc (List.length (proj₁ (split-sizes n D l r sizes (artifact∈l,r ∘ suc)))) (List.length (proj₂ (split-sizes n D l r sizes (artifact∈l,r ∘ suc)))) ⟨ + List.length (proj₁ (split-sizes n D l r sizes (artifact∈l,r ∘ suc))) + suc (List.length (proj₂ (split-sizes n D l r sizes (artifact∈l,r ∘ suc)))) + ∎ + where + open ℕ.≤-Reasoning + +split-sizes-sublist : ∀ {i : Size} + → (n : ℕ) + → (D : ℕ) + → (l r : 2CC.2CC i NAT) + → (sizes : List ℕ) + → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧) + → proj₁ (split-sizes n D l r sizes artifact∈l,r) Sublist.⊆ sizes + × proj₂ (split-sizes n D l r sizes artifact∈l,r) Sublist.⊆ sizes +split-sizes-sublist n D l r [] artifact∈l,r = [] , [] +split-sizes-sublist n D l r (size ∷ sizes) artifact⊆l,r with artifact⊆l,r zero +split-sizes-sublist n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r with conf D +split-sizes-sublist n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡l,r | true = Prod.map (refl ∷_) (size ∷ʳ_) (split-sizes-sublist n D l r sizes (artifact∈l,r ∘ suc)) +split-sizes-sublist n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡l,r | false = Prod.map (size ∷ʳ_) (refl ∷_) (split-sizes-sublist n D l r sizes (artifact∈l,r ∘ suc)) + +n*2^n≤size2CC : ∀ {i : Size} + → (n : ℕ) + → (e₂ : 2CC.2CC i NAT) + → (sizes : List ℕ) + → Unique sizes + → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ e₂ ⟧ + → List.length sizes * 2 ^ n ≤ size2CC e₂ +n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) [] unique-sizes sizes⊆e₂ = z≤n +n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ []) unique-sizes sizes⊆e₂ = ℕ.≤-trans (ℕ.≤-reflexive (ℕ.+-comm (2 ^ n) 0)) (ℕ.≤-trans (ℕ.^-monoʳ-≤ 2 (ℕ.n≤1+n n)) (2^n≤size2CC-artifact n s₁ a cs (sizes⊆e₂ zero))) +n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ s₂ ∷ sizes) ((s₁≢s₂ ∷ s₁∉sizes) ∷ unique-sizes) sizes⊆e₂ = ⊥-elim + (impossible-artifact-sizes + n + cs + (List.applyUpTo (artifact n) (suc s₁)) + (List.applyUpTo (artifact n) (suc s₂)) + (λ length-s₁≡length-s₂ → s₁≢s₂ (ℕ.suc-injective (begin + suc s₁ + ≡⟨ List.length-applyUpTo (artifact n) (suc s₁) ⟨ + List.length (List.applyUpTo (artifact n) (suc s₁)) + ≡⟨ length-s₁≡length-s₂ ⟩ + List.length (List.applyUpTo (artifact n) (suc s₂)) + ≡⟨ List.length-applyUpTo (artifact n) (suc s₂) ⟩ + suc s₂ + ∎))) + (∈-children n (suc s₁) (List.applyUpTo (artifact n) (suc s₁)) cs (sizes⊆e₂ zero)) + (∈-children n (suc s₂) (List.applyUpTo (artifact n) (suc s₂)) cs (sizes⊆e₂ (suc zero))) + ) + where open Eq.≡-Reasoning +n*2^n≤size2CC n (D 2CC.2CC.⟨ l , r ⟩) sizes unique-sizes sizes⊆e₂ = + begin + List.length sizes * 2 ^ n + ≤⟨ ℕ.*-monoˡ-≤ (2 ^ n) (split-sizes-length n D l r sizes sizes⊆e₂) ⟩ + (List.length (proj₁ (split-sizes n D l r sizes sizes⊆e₂)) + List.length (proj₂ (split-sizes n D l r sizes sizes⊆e₂))) * 2 ^ n + ≡⟨ ℕ.*-distribʳ-+ (2 ^ n) (List.length (proj₁ (split-sizes n D l r sizes sizes⊆e₂))) (List.length (proj₂ (split-sizes n D l r sizes sizes⊆e₂))) ⟩ + List.length (proj₁ (split-sizes n D l r sizes sizes⊆e₂)) * 2 ^ n + List.length (proj₂ (split-sizes n D l r sizes sizes⊆e₂)) * 2 ^ n + ≤⟨ ℕ.+-monoʳ-≤ (List.length (proj₁ (split-sizes n D l r sizes sizes⊆e₂)) * 2 ^ n) (n*2^n≤size2CC n r (proj₂ (split-sizes n D l r sizes sizes⊆e₂)) (List.AllPairs-resp-⊆ (proj₂ (split-sizes-sublist n D l r sizes sizes⊆e₂)) unique-sizes) (proj₂ (split-sizes⊆ n D l r sizes sizes⊆e₂))) ⟩ + List.length (proj₁ (split-sizes n D l r sizes sizes⊆e₂)) * 2 ^ n + size2CC r + ≤⟨ ℕ.+-monoˡ-≤ (size2CC r) (n*2^n≤size2CC n l (proj₁ (split-sizes n D l r sizes sizes⊆e₂)) (List.AllPairs-resp-⊆ (proj₁ (split-sizes-sublist n D l r sizes sizes⊆e₂)) unique-sizes) (proj₁ (split-sizes⊆ n D l r sizes sizes⊆e₂))) ⟩ + size2CC l + size2CC r + <⟨ s≤s ℕ.≤-refl ⟩ + suc (size2CC l + size2CC r) + ≡⟨⟩ + size2CC (D 2CC.2CC.⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning + +1+n≤2^n : ∀ (n : ℕ) → suc n ≤ 2 ^ n +1+n≤2^n zero = ℕ.≤-refl +1+n≤2^n (suc n) = + begin + suc (suc n) + ≡⟨⟩ + 1 + suc n + ≤⟨ ℕ.+-monoʳ-≤ 1 (1+n≤2^n n) ⟩ + 1 + 2 ^ n + ≤⟨ ℕ.+-monoˡ-≤ (2 ^ n) (ℕ.m^n>0 2 n) ⟩ + 2 ^ n + 2 ^ n + ≡⟨ Eq.cong (2 ^ n +_) (ℕ.+-identityʳ (2 ^ n)) ⟨ + 2 ^ n + (2 ^ n + 0) + ≡⟨⟩ + 2 ^ suc n + ∎ + where + open ℕ.≤-Reasoning + +e₁-config : ℕ → ℕ → Bool +e₁-config i f = f ℕ.≤ᵇ i + +select-applyUpTo-feature : + ∀ (k n i : ℕ) + → i ≤ n + → select (e₁-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) + ≡ List.applyUpTo (λ m → feature k m) (suc i) +select-applyUpTo-feature k n i i≤n = + begin + select (e₁-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) + ≡⟨ Eq.cong (λ x → select (e₁-config i) (List.applyUpTo (λ m → m :: feature k m) (suc x))) (ℕ.m+[n∸m]≡n i≤n) ⟨ + select (e₁-config i) (List.applyUpTo (λ m → m :: feature k m) (suc (i + (n ∸ i)))) + ≡⟨⟩ + select (e₁-config i) (List.applyUpTo (λ m → m :: feature k m) (suc i + offset)) + ≡⟨ selects-init (suc i) zero refl ⟩ + List.applyUpTo (λ m → feature k m) (suc i) + ∎ + where + e₁-config≡true : ∀ (j i' : ℕ) → j + suc i' ≡ suc i → e₁-config i (j + zero) ≡ true + e₁-config≡true j i' j+i'≡i = Equivalence.to Bool.T-≡ (ℕ.≤⇒≤ᵇ (ℕ.≤-pred ( + begin + suc j + zero + ≤⟨ ℕ.+-monoʳ-≤ (suc j) z≤n ⟩ + suc j + i' + ≡⟨ ℕ.+-suc j i' ⟨ + j + suc i' + ≡⟨ j+i'≡i ⟩ + suc i + ∎))) + where + open ℕ.≤-Reasoning + + open Eq.≡-Reasoning + + offset : ℕ + offset = n ∸ i + + deselects-tail : ∀ (i' j : ℕ) + → select (e₁-config i) (List.applyUpTo (λ m → j + m + suc i :: feature k (j + m + suc i)) i') + ≡ [] + deselects-tail zero j = refl + deselects-tail (suc i') j = + begin + select (e₁-config i) (List.applyUpTo (λ m → j + m + suc i :: feature k (j + m + suc i)) (suc i')) + ≡⟨⟩ + (if e₁-config i (j + zero + suc i) + then feature k (j + zero + suc i) ∷ select (e₁-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') + else select (e₁-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i')) + ≡⟨ Eq.cong (if_then feature k (j + zero + suc i) ∷ select (e₁-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') else select (e₁-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i')) (Equivalence.to Bool.T-not-≡ (>⇒¬≤ᵇ (ℕ.m≤n⇒m≤o+n (j + zero) (ℕ.n<1+n i)))) ⟩ + select (e₁-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') + ≡⟨ Eq.cong (λ x → select (e₁-config i) x) (List.applyUpTo-cong (λ m → Eq.cong (λ x → x + suc i :: feature k (x + suc i)) (ℕ.+-suc j m)) i') ⟩ + select (e₁-config i) (List.applyUpTo (λ m → suc j + m + suc i :: feature k (suc j + m + suc i)) i') + ≡⟨ deselects-tail i' (suc j) ⟩ + [] + ∎ + + selects-init : ∀ (i' j : ℕ) + → j + i' ≡ suc i + → select (e₁-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) (i' + offset)) + ≡ List.applyUpTo (λ m → feature k (j + m)) i' + selects-init zero j j+i'≡i = + begin + select (e₁-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) offset) + ≡⟨ Eq.cong (select (e₁-config i)) (List.applyUpTo-cong (λ m → Eq.cong (λ x → x :: feature k x) (ℕ.+-comm j m)) offset) ⟩ + select (e₁-config i) (List.applyUpTo (λ m → m + j :: feature k (m + j)) offset) + ≡⟨ Eq.cong (select (e₁-config i)) (List.applyUpTo-cong (λ m → Eq.cong (λ x → m + x :: feature k (m + x)) (Eq.trans (Eq.sym (ℕ.+-identityʳ j)) j+i'≡i)) offset) ⟩ + select (e₁-config i) (List.applyUpTo (λ m → m + suc i :: feature k (m + suc i)) offset) + ≡⟨ deselects-tail offset zero ⟩ + [] + ≡⟨⟩ + List.applyUpTo (λ m → feature k (j + m)) zero + ∎ + selects-init (suc i') j j+i'≡i = + begin + select (e₁-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) (suc i' + offset)) + ≡⟨⟩ + select (e₁-config i) ((j + zero :: feature k (j + zero)) ∷ List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) + ≡⟨⟩ + (if e₁-config i (j + zero) + then feature k (j + zero) ∷ select (e₁-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) + else select (e₁-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset))) + ≡⟨ Eq.cong (if_then feature k (j + zero) ∷ select (e₁-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) else select (e₁-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset))) (e₁-config≡true j i' j+i'≡i) ⟩ + feature k (j + zero) ∷ select (e₁-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) + ≡⟨ Eq.cong (λ x → feature k (j + zero) ∷ select (e₁-config i) x) (List.applyUpTo-cong (λ m → Eq.cong₂ _::_ (ℕ.+-suc j m) (Eq.cong (feature k) (ℕ.+-suc j m))) (i' + offset)) ⟩ + feature k (j + zero) ∷ select (e₁-config i) (List.applyUpTo (λ m → suc j + m :: feature k (suc j + m)) (i' + offset)) + ≡⟨ Eq.cong (feature k (j + zero) ∷_) (selects-init i' (suc j) (Eq.trans (Eq.sym (ℕ.+-suc j i')) j+i'≡i)) ⟩ + feature k (j + zero) ∷ List.applyUpTo (λ m → feature k (suc j + m)) i' + ≡⟨ Eq.cong (feature k (j + zero) ∷_) (List.applyUpTo-cong (λ m → Eq.cong (feature k) (Eq.sym (ℕ.+-suc j m))) i') ⟩ + feature k (j + zero) ∷ List.applyUpTo (λ m → feature k (j + suc m)) i' + ≡⟨⟩ + List.applyUpTo (λ m → feature k (j + m)) (suc i') + ∎ + +forget-uniqueness-⊛-all : + ∀ (as : List FSF) + → forget-uniqueness (⊛-all as) ≡ List.foldr _⊕_ [] (List.map forget-uniqueness as) +forget-uniqueness-⊛-all [] = refl +forget-uniqueness-⊛-all (a ∷ as) = + begin + forget-uniqueness (⊛-all (a ∷ as)) + ≡⟨⟩ + forget-uniqueness (a ⊛ (⊛-all as)) + ≡⟨⟩ + forget-uniqueness a ⊕ forget-uniqueness (⊛-all as) + ≡⟨ Eq.cong (λ x → forget-uniqueness a ⊕ x) (forget-uniqueness-⊛-all as) ⟩ + forget-uniqueness a ⊕ List.foldr _⊕_ [] (List.map forget-uniqueness as) + ≡⟨⟩ + List.foldr _⊕_ [] (forget-uniqueness a ∷ List.map forget-uniqueness as) + ≡⟨⟩ + List.foldr _⊕_ [] (List.map forget-uniqueness (a ∷ as)) + ∎ + where + open Eq.≡-Reasoning + +artifacts⊙artifact : + ∀ (n i k : ℕ) + → List.applyUpTo (λ m → artifact n (m + k)) i ⊙ artifact n (i + k) + ≡ List.applyUpTo (λ m → artifact n (m + k)) (suc i) +artifacts⊙artifact n zero k = refl +artifacts⊙artifact n (suc i) k with artifact n (suc i + k) == artifact n k +artifacts⊙artifact n (suc i) k | no _ = + begin + artifact n k ∷ (List.applyUpTo (λ m → artifact n (suc m + k)) i ⊙ artifact n (suc i + k)) + ≡⟨ Eq.cong (λ x → artifact n k ∷ (x ⊙ artifact n (suc i + k))) (List.applyUpTo-cong (λ m → Eq.cong (artifact n) (ℕ.+-suc m k)) i) ⟨ + artifact n k ∷ (List.applyUpTo (λ m → artifact n (m + suc k)) i ⊙ artifact n (suc i + k)) + ≡⟨ Eq.cong (λ x → artifact n k ∷ (List.applyUpTo (λ m → artifact n (m + suc k)) i ⊙ artifact n x)) (ℕ.+-suc i k) ⟨ + artifact n k ∷ (List.applyUpTo (λ m → artifact n (m + suc k)) i ⊙ artifact n (i + suc k)) + ≡⟨ Eq.cong (artifact n k ∷_) (artifacts⊙artifact n i (suc k)) ⟩ + artifact n k ∷ List.applyUpTo (λ m → artifact n (m + suc k)) (suc i) + ≡⟨ Eq.cong (artifact n k ∷_) (List.applyUpTo-cong (λ m → Eq.cong (artifact n) (ℕ.+-suc m k)) (suc i)) ⟩ + artifact n k ∷ List.applyUpTo (λ m → artifact n (suc m + k)) (suc i) + ≡⟨⟩ + List.applyUpTo (λ m → artifact n (m + k)) (suc (suc i)) + ∎ + where + open Eq.≡-Reasoning +artifacts⊙artifact n (suc i) (suc k) | yes artifact-1+i+k≈artifact-k = ⊥-elim (ℕ.1+n≰n (ℕ.≤-trans (ℕ.m≤n+m (suc k) i) (ℕ.≤-reflexive (ℕ.suc-injective artifact-1+i+k≈artifact-k)))) + +artifact⊕artifacts : + ∀ (n i k : ℕ) + → (artifact n k ∷ []) ⊕ List.applyUpTo (λ m → artifact n (suc m + k)) i + ≡ List.applyUpTo (λ m → artifact n (m + k)) (suc i) +artifact⊕artifacts n i k = go 1 i k + where + go : ∀ (i j k : ℕ) + → List.applyUpTo (λ m → artifact n (m + k)) i ⊕ List.applyUpTo (λ m → artifact n (i + m + k)) j + ≡ List.applyUpTo (λ m → artifact n (m + k)) (i + j) + go i zero k = Eq.cong (List.applyUpTo (λ m → artifact n (m + k))) (Eq.sym (ℕ.+-identityʳ i)) + go i (suc j) k = + begin + List.applyUpTo (λ m → artifact n (m + k)) i ⊕ List.applyUpTo (λ m → artifact n (i + m + k)) (suc j) + ≡⟨⟩ + List.applyUpTo (λ m → artifact n (m + k)) i ⊕ (artifact n (i + zero + k) ∷ List.applyUpTo (λ m → artifact n (i + suc m + k)) j) + ≡⟨ Eq.cong (λ x → List.applyUpTo (λ m → artifact n (m + k)) i ⊕ (artifact n (x + k) ∷ List.applyUpTo (λ m → artifact n (i + suc m + k)) j)) (ℕ.+-identityʳ i) ⟩ + List.applyUpTo (λ m → artifact n (m + k)) i ⊕ (artifact n (i + k) ∷ List.applyUpTo (λ m → artifact n (i + suc m + k)) j) + ≡⟨⟩ + (List.applyUpTo (λ m → artifact n (m + k)) i ⊙ artifact n (i + k)) ⊕ List.applyUpTo (λ m → artifact n (i + suc m + k)) j + ≡⟨ Eq.cong (_⊕ List.applyUpTo (λ m → artifact n (i + suc m + k)) j) (artifacts⊙artifact n i k) ⟩ + List.applyUpTo (λ m → artifact n (m + k)) (suc i) ⊕ List.applyUpTo (λ m → artifact n (i + suc m + k)) j + ≡⟨ Eq.cong (λ x → List.applyUpTo (λ m → artifact n (m + k)) (suc i) ⊕ x) (List.applyUpTo-cong (λ m → Eq.cong (λ x → artifact n (x + k)) (ℕ.+-suc i m)) j) ⟩ + List.applyUpTo (λ m → artifact n (m + k)) (suc i) ⊕ List.applyUpTo (λ m → artifact n (suc i + m + k)) j + ≡⟨ go (suc i) j k ⟩ + List.applyUpTo (λ m → artifact n (m + k)) (suc i + j) + ≡⟨ Eq.cong (List.applyUpTo (λ m → artifact n (m + k))) (ℕ.+-suc i j) ⟨ + List.applyUpTo (λ m → artifact n (m + k)) (i + suc j) + ∎ + where + open Eq.≡-Reasoning + +foldr-⊕-artifacts : + ∀ (n i : ℕ) + → List.applyUpTo (artifact n) i + ≡ List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n m ∷ []) i) +foldr-⊕-artifacts n i = go i zero + where + open Eq.≡-Reasoning + + go : + ∀ (i j : ℕ) + → List.applyUpTo (λ m → artifact n (j + m)) i + ≡ List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n (j + m) ∷ []) i) + go zero j = refl + go (suc i) j = + begin + List.applyUpTo (λ m → artifact n (j + m)) (suc i) + ≡⟨ List.applyUpTo-cong (λ m → Eq.cong (artifact n) (ℕ.+-comm j m)) (suc i) ⟩ + List.applyUpTo (λ m → artifact n (m + j)) (suc i) + ≡⟨ artifact⊕artifacts n i j ⟨ + (artifact n j ∷ []) ⊕ List.applyUpTo (λ m → artifact n (suc m + j)) i + ≡⟨ Eq.cong ((artifact n j ∷ []) ⊕_) (List.applyUpTo-cong (λ m → Eq.cong (λ x → artifact n (suc x)) (ℕ.+-comm m j)) i) ⟩ + (artifact n j ∷ []) ⊕ List.applyUpTo (λ m → artifact n (suc j + m)) i + ≡⟨ Eq.cong ((artifact n j ∷ []) ⊕_) (go i (suc j)) ⟩ + (artifact n j ∷ []) ⊕ List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n (suc j + m) ∷ []) i) + ≡⟨ Eq.cong (λ x → (artifact n j ∷ []) ⊕ List.foldr _⊕_ [] x) (List.applyUpTo-cong (λ m → Eq.cong (λ x → artifact n x ∷ []) (ℕ.+-suc j m)) i) ⟨ + (artifact n j ∷ []) ⊕ List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n (j + suc m) ∷ []) i) + ≡⟨⟩ + List.foldr _⊕_ [] ((artifact n j ∷ []) ∷ List.applyUpTo (λ m → artifact n (j + suc m) ∷ []) i) + ≡⟨ Eq.cong (λ x → List.foldr _⊕_ [] ((artifact n x ∷ []) ∷ List.applyUpTo (λ m → artifact n (j + suc m) ∷ []) i)) (ℕ.+-identityʳ j) ⟨ + List.foldr _⊕_ [] ((artifact n (j + zero) ∷ []) ∷ List.applyUpTo (λ m → artifact n (j + suc m) ∷ []) i) + ≡⟨⟩ + List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n (j + m) ∷ []) (suc i)) + ∎ + +variant∈e₁ : + ∀ (n i : ℕ) + → i ≤ n + → variant n (suc i) ∈ FST.⟦ e₁ n ⟧ +variant∈e₁ n i i≤n = e₁-config i , Eq.cong (0 Rose.-<_>-) ( + begin + List.applyUpTo (artifact n) (suc i) + ≡⟨ foldr-⊕-artifacts n (suc i) ⟩ + List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n m ∷ []) (suc i)) + ≡⟨⟩ + List.foldr _⊕_ [] (List.applyUpTo (forget-uniqueness ∘ feature n) (suc i)) + ≡⟨ Eq.cong (λ x → List.foldr _⊕_ [] x) (List.map-applyUpTo forget-uniqueness (feature n) (suc i)) ⟨ + List.foldr _⊕_ [] (List.map forget-uniqueness (List.applyUpTo (feature n) (suc i))) + ≡⟨ forget-uniqueness-⊛-all (List.applyUpTo (feature n) (suc i)) ⟨ + forget-uniqueness (⊛-all (List.applyUpTo (feature n) (suc i))) + ≡⟨ Eq.cong (λ x → forget-uniqueness (⊛-all x)) (select-applyUpTo-feature n n i i≤n) ⟨ + forget-uniqueness (⊛-all (select (e₁-config i) (List.applyUpTo (λ m → m :: feature n m) (suc n)))) + ∎) + where + open Eq.≡-Reasoning + +variants⊆e₁ : ∀ (m : ℕ) → (variant m ∘ suc ∘ List.lookup (List.upTo m)) ⊆ FST.⟦ e₁ m ⟧ +variants⊆e₁ m size = Prod.map₂ (Eq.trans (Eq.cong (variant m ∘ suc) (List.lookup-upTo m size))) (variant∈e₁ m (Fin.toℕ size) (ℕ.≤-trans (Fin.toℕ≤n size) (ℕ.≤-reflexive (List.length-upTo m)))) + +FST≱2CC : SizedFST ≱Size Sized2CC +FST≱2CC zero = NAT , e₁ zero , λ e₂ e₁≅e₂ → 1≤size2CC e₂ +FST≱2CC (suc n) = NAT , e₁ m , λ e₂ e₁≅e₂ → + begin-strict + suc n * sizeFST (e₁ m) + ≡⟨ Eq.cong (suc n *_) (size-e₁ m) ⟩ + suc n * (2 + 2 ^ suc m + 2 * m) + ≡⟨⟩ + suc n * (2 + 2 ^ suc (8 * suc n) + 2 * (8 * suc n)) + ≤⟨ ℕ.*-monoʳ-≤ (suc n) (ℕ.+-monoʳ-≤ 2 (ℕ.+-monoʳ-≤ (2 ^ suc (8 * suc n)) (ℕ.*-monoʳ-≤ 2 (ℕ.*-monoʳ-≤ 8 (1+n≤2^n n))))) ⟩ + suc n * (2 + 2 ^ suc (8 * suc n) + 2 * (8 * 2 ^ n)) + ≤⟨ ℕ.*-monoʳ-≤ (suc n) (ℕ.+-monoʳ-≤ 2 (ℕ.+-monoʳ-≤ (2 ^ suc (8 * suc n)) (ℕ.*-monoʳ-≤ 2 (ℕ.*-monoʳ-≤ 8 (ℕ.^-monoʳ-≤ 2 (ℕ.m≤n*m n 8)))))) ⟩ + suc n * (2 + 2 ^ suc (8 * suc n) + 2 * (8 * 2 ^ (8 * n))) + ≤⟨ ℕ.*-monoʳ-≤ (suc n) (ℕ.+-monoʳ-≤ 2 (ℕ.+-monoʳ-≤ (2 ^ suc (8 * suc n)) (ℕ.*-monoʳ-≤ 2 (ℕ.*-monoʳ-≤ 8 (ℕ.^-monoʳ-≤ 2 (ℕ.m≤n+m (8 * n) 6)))))) ⟩ + suc n * (2 + 2 ^ suc (8 * suc n) + 2 * (8 * 2 ^ (6 + 8 * n))) + ≡⟨⟩ + suc n * (2 + 2 ^ suc (8 * suc n) + 2 * (2 ^ 3 * 2 ^ (6 + 8 * n))) + ≡⟨ Eq.cong (λ x → suc n * (2 + 2 ^ suc (8 * suc n) + 2 * x)) (ℕ.^-distribˡ-+-* 2 3 (6 + 8 * n)) ⟨ + suc n * (2 + 2 ^ suc (8 * suc n) + 2 * 2 ^ (3 + (6 + 8 * n))) + ≡⟨⟩ + suc n * (2 + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 + 8 * n)) + ≡⟨ Eq.cong (λ x → suc n * (2 + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc x)) (ℕ.*-suc 8 n) ⟨ + suc n * (2 + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 * suc n)) + <⟨ ℕ.*-monoʳ-< (suc n) (ℕ.+-monoˡ-< (2 * 2 ^ suc (8 * suc n)) (ℕ.+-monoˡ-< (2 ^ suc (8 * suc n)) (ℕ.*-monoʳ-< 2 (ℕ.≤-trans (ℕ.n<1+n 1) ( + begin + 2 + ≡⟨⟩ + 1 + 1 + ≤⟨ ℕ.+-monoʳ-≤ 1 (ℕ.m^n>0 2 (n + 7 * suc n)) ⟩ + 1 + 2 ^ (n + 7 * suc n) + ≤⟨ ℕ.+-monoˡ-≤ (2 ^ (n + 7 * suc n)) (ℕ.m^n>0 2 (n + 7 * suc n)) ⟩ + 2 ^ (n + 7 * suc n) + 2 ^ (n + 7 * suc n) + ≡⟨ Eq.cong (2 ^ (n + 7 * suc n) +_) (ℕ.+-identityʳ (2 ^ (n + 7 * suc n))) ⟨ + 2 ^ (n + 7 * suc n) + (2 ^ (n + 7 * suc n) + 0) + ≡⟨⟩ + 2 * 2 ^ (n + 7 * suc n) + ∎))))) ⟩ + suc n * (2 * (2 * (2 ^ (n + 7 * suc n))) + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 * suc n)) + ≡⟨⟩ + suc n * (2 ^ suc (suc n + 7 * suc n) + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 * suc n)) + ≡⟨⟩ + suc n * (2 ^ suc (8 * suc n) + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 * suc n)) + ≡⟨ Eq.cong (suc n *_) (ℕ.+-assoc (2 ^ suc (8 * suc n)) (2 ^ suc (8 * suc n)) (2 * 2 ^ suc (8 * suc n))) ⟩ + suc n * (2 ^ suc (8 * suc n) + (2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 * suc n))) + ≡⟨⟩ + suc n * (4 * (2 ^ suc (8 * suc n))) + ≡⟨ ℕ.*-assoc (suc n) 4 (2 ^ suc (8 * suc n)) ⟨ + suc n * 4 * (2 ^ suc (8 * suc n)) + ≡⟨ Eq.cong (_* 2 ^ suc (8 * suc n)) (ℕ.*-comm (suc n) 4) ⟩ + 4 * suc n * (2 ^ suc (8 * suc n)) + ≡⟨⟩ + 4 * suc n * (2 * 2 ^ (8 * suc n)) + ≡⟨ ℕ.*-assoc (4 * suc n) 2 (2 ^ (8 * suc n)) ⟨ + 4 * suc n * 2 * 2 ^ (8 * suc n) + ≡⟨ Eq.cong (_* 2 ^ (8 * suc n)) (ℕ.*-comm (4 * suc n) 2) ⟩ + (2 * (4 * suc n)) * 2 ^ (8 * suc n) + ≡⟨ Eq.cong (_* 2 ^ (8 * suc n)) (ℕ.*-assoc 2 4 (suc n)) ⟨ + 2 * 4 * suc n * 2 ^ (8 * suc n) + ≡⟨⟩ + 8 * suc n * 2 ^ (8 * suc n) + ≡⟨⟩ + m * 2 ^ m + ≡⟨ Eq.cong (_* 2 ^ m) (List.length-upTo m) ⟨ + List.length (List.upTo m) * 2 ^ m + ≤⟨ n*2^n≤size2CC m e₂ (List.upTo m) (Unique.upTo⁺ m) (⊆-trans (variants⊆e₁ m) (proj₁ e₁≅e₂)) ⟩ + size2CC e₂ + ∎ + where + open ℕ.≤-Reasoning + m = 8 * (suc n) diff --git a/src/Vatras/SyntacticExpressiveness/Sizes.agda b/src/Vatras/SyntacticExpressiveness/Sizes.agda index 933165b0..c2ccea26 100644 --- a/src/Vatras/SyntacticExpressiveness/Sizes.agda +++ b/src/Vatras/SyntacticExpressiveness/Sizes.agda @@ -5,6 +5,7 @@ open import Data.Nat using (ℕ; suc; zero; _+_) import Data.List as List import Data.List.NonEmpty as List⁺ import Data.Vec as Vec +open import Function using (_∘_) open import Size using (Size; ∞) open import Vatras.Util.Nat.AtLeast using (ℕ≥) @@ -54,3 +55,12 @@ SizedADT = record { Lang = ADT.ADTL ; size = sizeADT } + +sizeFST : {A : 𝔸} → FST.Impose.SPL A → ℕ +sizeFST (root FST.Impose.◀ features) = 1 + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) features) + +SizedFST : SizedLang +SizedFST = record + { Lang = FST.FSTL + ; size = sizeFST + } diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index c4510862..2746e354 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -17,7 +17,6 @@ open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_; toList; _⁺++ open import Data.List.Relation.Binary.Subset.Propositional using (_⊆_) open import Data.List.Relation.Unary.All using (All; _∷_) open import Data.List.Relation.Unary.Any using (here; there) -open import Data.List.Relation.Unary.Unique.Propositional using (Unique; _∷_) open import Data.Product using (_,_) open import Data.Vec as Vec using (Vec; []; _∷_) open import Vatras.Util.Nat.AtLeast as ℕ≥ using (ℕ≥; sucs) @@ -89,33 +88,36 @@ lookup-++ₗ (x ∷ xs) ys i = lookup-++ₗ xs ys i ∈∧∉⇒≢ (x ∷ xs) (here y≡x) (y≢x ∷ z∉xs) y≡z = y≢x (Eq.trans (Eq.sym y≡z) y≡x) ∈∧∉⇒≢ (x ∷ xs) (there y∈xs) (y≢x ∷ z∉xs) y≡z = ∈∧∉⇒≢ xs y∈xs z∉xs y≡z -length≤ : ∀ {ℓ} {A : Set ℓ} - → (xs ys : List A) - → Unique xs - → xs ⊆ ys - → List.length xs ≤ List.length ys -length≤ [] ys unique-xs xs⊆ys = z≤n -length≤ (x ∷ xs) ys unique-xs xs⊆ys with List.∈-∃++ (xs⊆ys (here refl)) -length≤ (x ∷ xs) ys (x∉xs ∷ unique-xs) xs⊆ys | l , r , ys≡l++x∷r = - begin - List.length (x ∷ xs) - ≡⟨⟩ - suc (List.length xs) - ≤⟨ s≤s (length≤ xs (l List.++ r) unique-xs λ {y} y∈xs → ∈xs++v∷ys⇒∈xs++ys y x l r (∈∧∉⇒≢ xs y∈xs x∉xs) (Eq.subst (y ∈_) ys≡l++x∷r (xs⊆ys (there y∈xs)))) ⟩ - suc (List.length (l List.++ r)) - ≡⟨ Eq.cong suc (length-++ l) ⟩ - suc (List.length l + List.length r) - ≡⟨ ℕ.+-suc (List.length l) (List.length r) ⟨ - List.length l + suc (List.length r) - ≡⟨⟩ - List.length l + List.length (x ∷ r) - ≡⟨ length-++ l ⟨ - List.length (l List.++ (x ∷ r)) - ≡⟨ Eq.cong List.length ys≡l++x∷r ⟨ - List.length ys - ∎ - where - open ℕ.≤-Reasoning +module _ where + open import Data.List.Relation.Unary.Unique.Propositional using (Unique; _∷_) + + length≤ : ∀ {ℓ} {A : Set ℓ} + → (xs ys : List A) + → Unique xs + → xs ⊆ ys + → List.length xs ≤ List.length ys + length≤ [] ys unique-xs xs⊆ys = z≤n + length≤ (x ∷ xs) ys unique-xs xs⊆ys with List.∈-∃++ (xs⊆ys (here refl)) + length≤ (x ∷ xs) ys (x∉xs ∷ unique-xs) xs⊆ys | l , r , ys≡l++x∷r = + begin + List.length (x ∷ xs) + ≡⟨⟩ + suc (List.length xs) + ≤⟨ s≤s (length≤ xs (l List.++ r) unique-xs λ {y} y∈xs → ∈xs++v∷ys⇒∈xs++ys y x l r (∈∧∉⇒≢ xs y∈xs x∉xs) (Eq.subst (y ∈_) ys≡l++x∷r (xs⊆ys (there y∈xs)))) ⟩ + suc (List.length (l List.++ r)) + ≡⟨ Eq.cong suc (length-++ l) ⟩ + suc (List.length l + List.length r) + ≡⟨ ℕ.+-suc (List.length l) (List.length r) ⟨ + List.length l + suc (List.length r) + ≡⟨⟩ + List.length l + List.length (x ∷ r) + ≡⟨ length-++ l ⟨ + List.length (l List.++ (x ∷ r)) + ≡⟨ Eq.cong List.length ys≡l++x∷r ⟨ + List.length ys + ∎ + where + open ℕ.≤-Reasoning -- Do not touch this function. its definition is very fragile and just refactoring it can break proofs. find-or-last : ∀ {ℓ} {A : Set ℓ} → ℕ → List⁺ A → A @@ -235,20 +237,20 @@ sum-replicate : (n m : ℕ) → List.sum (List.replicate n m) ≡ n * m sum-replicate zero m = refl sum-replicate (suc n) m = Eq.cong (m +_) (sum-replicate n m) -sum-map-≤ : ∀ {ℓ} {A : Set ℓ} - → (f g : A → ℕ) +sum-map-≤-with∈ : ∀ {ℓ} {A : Set ℓ} + → {f g : A → ℕ} → (xs : List A) - → (∀ x → f x ≤ g x) + → (∀ (x : A) → x ∈ xs → f x ≤ g x) → List.sum (List.map f xs) ≤ List.sum (List.map g xs) -sum-map-≤ f g [] f≤g = z≤n -sum-map-≤ f g (x ∷ xs) f≤g = +sum-map-≤-with∈ {f = f} {g = g} [] f≤g = ℕ.≤-refl +sum-map-≤-with∈ {f = f} {g = g} (x ∷ xs) f≤g = begin List.sum (List.map f (x ∷ xs)) ≡⟨⟩ f x + List.sum (List.map f xs) - ≤⟨ ℕ.+-monoˡ-≤ (List.sum (List.map f xs)) (f≤g x) ⟩ + ≤⟨ ℕ.+-monoˡ-≤ (List.sum (List.map f xs)) (f≤g x (here refl)) ⟩ g x + List.sum (List.map f xs) - ≤⟨ ℕ.+-monoʳ-≤ (g x) (sum-map-≤ f g xs f≤g) ⟩ + ≤⟨ ℕ.+-monoʳ-≤ (g x) (sum-map-≤-with∈ xs (λ y y∈ys → f≤g y (there y∈ys))) ⟩ g x + List.sum (List.map g xs) ≡⟨⟩ List.sum (List.map g (x ∷ xs)) @@ -256,6 +258,13 @@ sum-map-≤ f g (x ∷ xs) f≤g = where open ℕ.≤-Reasoning +sum-map-≤ : ∀ {ℓ} {A : Set ℓ} + → (f g : A → ℕ) + → (xs : List A) + → (∀ x → f x ≤ g x) + → List.sum (List.map f xs) ≤ List.sum (List.map g xs) +sum-map-≤ f g xs f≤g = sum-map-≤-with∈ xs λ x x∈xs → f≤g x + sum-map-< : ∀ {ℓ} {A : Set ℓ} → (f g : A → ℕ) @@ -310,3 +319,35 @@ sum-* n (x ∷ xs) = ∎ where open Eq.≡-Reasoning + +module _ where + open import Data.List.Relation.Binary.Sublist.Propositional using (_⊇_; []; _∷_; _∷ʳ_) + import Data.List.Relation.Binary.Sublist.Propositional.Properties as Sublist + open import Data.List.Relation.Unary.AllPairs using (AllPairs; []; _∷_) + open import Relation.Binary using (Rel; _Respects_) + + AllPairs-resp-⊆ : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} → {R : Rel A ℓ₂} → (AllPairs R) Respects _⊇_ + AllPairs-resp-⊆ [] [] = [] + AllPairs-resp-⊆ (y ∷ʳ xs⊇ys) (All-x ∷ AllPairs-xs) = AllPairs-resp-⊆ xs⊇ys AllPairs-xs + AllPairs-resp-⊆ {x = .(_ ∷ _)} {.(_ ∷ _)} (refl ∷ xs⊇ys) (All-x ∷ AllPairs-xs) = Sublist.All-resp-⊆ xs⊇ys All-x ∷ AllPairs-resp-⊆ xs⊇ys AllPairs-xs + +map-applyUpTo : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {B : Set ℓ₂} + → (f : A → B) + → (g : ℕ → A) + → (n : ℕ) + → List.map f (List.applyUpTo g n) ≡ List.applyUpTo (f ∘ g) n +map-applyUpTo f g zero = refl +map-applyUpTo f g (suc n) = Eq.cong (f (g zero) ∷_) (map-applyUpTo f (g ∘ suc) n) + +map-upTo : ∀ {ℓ₁} {A : Set ℓ₁} + → (f : ℕ → A) + → (n : ℕ) + → List.map f (List.upTo n) ≡ List.applyUpTo f n +map-upTo f n = map-applyUpTo f id n + +applyUpTo-cong : ∀ {ℓ₁} {A : Set ℓ₁} + → {f g : ℕ → A} + → f ≗ g + → List.applyUpTo f ≗ List.applyUpTo g +applyUpTo-cong f≗g zero = refl +applyUpTo-cong f≗g (suc n) = Eq.cong₂ _∷_ (f≗g zero) (applyUpTo-cong (f≗g ∘ suc) n) From 4d9da19ca16a1b67f5bd4ac324a04897ac81c779 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Fri, 20 Dec 2024 21:46:31 +0100 Subject: [PATCH 20/82] =?UTF-8?q?Investigate=20the=20relationship=20betwee?= =?UTF-8?q?n=20=E2=89=A4Size=20and=20compilers?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Vatras/SyntacticExpressiveness.agda | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/src/Vatras/SyntacticExpressiveness.agda b/src/Vatras/SyntacticExpressiveness.agda index e57460d6..14ec0153 100644 --- a/src/Vatras/SyntacticExpressiveness.agda +++ b/src/Vatras/SyntacticExpressiveness.agda @@ -1,5 +1,6 @@ module Vatras.SyntacticExpressiveness where +open import Data.Empty using (⊥-elim) open import Data.Nat as ℕ using (ℕ; _≤_; _>_; _<_; _*_) import Data.Nat.Properties as ℕ open import Data.Product using (_×_; _,_; Σ-syntax; proj₁; proj₂) @@ -8,11 +9,12 @@ import Relation.Binary.PropositionalEquality as Eq open import Relation.Binary.Structures using (IsEquivalence; IsPreorder; IsPartialOrder; IsStrictPartialOrder) open import Size using (∞) -open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans) +open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans; ≅→≅[]; ⊆-index) open import Vatras.Framework.Definitions using (𝔸) open import Vatras.Framework.Variants using (Rose) open import Vatras.Framework.Relation.Expression (Rose ∞) using (_,_⊢_≣_) open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) +open import Vatras.Framework.Compiler using (LanguageCompiler) record SizedLang : Set₂ where field @@ -195,3 +197,19 @@ L₁ Date: Sat, 21 Dec 2024 19:46:15 +0100 Subject: [PATCH 21/82] Prove our FST formalization misses a base feature --- src/Vatras/Lang/FST/NoBaseArtifacts.agda | 51 ++++++++++++++++++++++++ 1 file changed, 51 insertions(+) create mode 100644 src/Vatras/Lang/FST/NoBaseArtifacts.agda diff --git a/src/Vatras/Lang/FST/NoBaseArtifacts.agda b/src/Vatras/Lang/FST/NoBaseArtifacts.agda new file mode 100644 index 00000000..d4e58d88 --- /dev/null +++ b/src/Vatras/Lang/FST/NoBaseArtifacts.agda @@ -0,0 +1,51 @@ +open import Vatras.Framework.Definitions using (𝔽; NAT) +module Vatras.Lang.FST.NoBaseArtifacts {F : 𝔽} where + +open import Data.Bool using (true; false) +open import Data.Fin using (zero) +open import Data.List using ([]; _∷_) +open import Data.Nat as ℕ using (ℕ) +open import Data.Product as Prod using (_,_; proj₂; Σ-syntax) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl) +open import Relation.Nullary.Negation using (¬_) +open import Size using (∞) + +open import Vatras.Data.EqIndexedSet using (_≅_; ≅-sym) +open import Vatras.Framework.Variants using (Rose; Rose-injective) +open import Vatras.Framework.VariantGenerator using (VariantGenerator) +open import Vatras.Framework.Properties.Completeness using (Incomplete) +import Vatras.Lang.FST as FST + +open FST.Impose F NAT + +variant : Rose ∞ NAT +variant = 0 Rose.-< 0 Rose.-< [] >- ∷ [] >- + +variantGenerator : VariantGenerator (Rose ∞) NAT 0 +variantGenerator zero = variant + +select-false : ∀ features → select (λ f → false) features ≡ [] +select-false [] = refl +select-false (feature ∷ features) = select-false features + +lemma : ∀ (e : SPL) → Σ[ a ∈ ℕ ] ⟦ e ⟧ (λ f → false) ≡ a Rose.-< [] >- +lemma (a ◀ features) = a , ( + begin + ⟦ a ◀ features ⟧ (λ f → false) + ≡⟨⟩ + a Rose.-< forget-uniqueness (⊛-all (select (λ f → false) features)) >- + ≡⟨ Eq.cong (λ x → a Rose.-< forget-uniqueness (⊛-all x) >-) (select-false features) ⟩ + a Rose.-< forget-uniqueness (⊛-all []) >- + ≡⟨⟩ + a Rose.-< [] >- + ∎) + where + open Eq.≡-Reasoning + +does-not-describe-variant : ¬ (Σ[ e ∈ SPL ] (⟦ e ⟧ ≅ variantGenerator)) +does-not-describe-variant (e , variant⊆e , e⊆variant) with variant⊆e (λ f → false) | lemma e +does-not-describe-variant (e , variant⊆e , e⊆variant) | zero , e≡variant | a , e≡empty with Eq.trans (Eq.sym (proj₂ (Rose-injective e≡variant))) (proj₂ (Rose-injective e≡empty)) +does-not-describe-variant (e , variant⊆e , e⊆variant) | zero , e≡variant | a , e≡empty | () + +FST-is-incomplete : Incomplete (Rose ∞) (FST.FSTL F) +FST-is-incomplete complete = does-not-describe-variant (Prod.map₂ (≅-sym) (complete variantGenerator)) From edc40007cd1a5b97028fb826a0d629a02de99588 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sat, 21 Dec 2024 19:48:16 +0100 Subject: [PATCH 22/82] =?UTF-8?q?Use=20more=20specialized=20versions=20of?= =?UTF-8?q?=20=E2=88=B7-injective?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Vatras/SyntacticExpressiveness/2CC- ⟧ → Σ[ j' ∈ ℕ ] big-artifact n j' ∈ 2CC.⟦ c ⟧ -big-artifact-children n j a (x₂ ∷ x₃ ∷ []) .x₂ (here refl) (conf , artifact≡cs) = j , conf , proj₁ (List.∷-injective (proj₂ (Rose-injective artifact≡cs))) -big-artifact-children n j a (x₂ ∷ x₃ ∷ []) .x₃ (there (here refl)) (conf , artifact≡cs) = j + 2 ^ n , conf , proj₁ (List.∷-injective (proj₂ (List.∷-injective (proj₂ (Rose-injective artifact≡cs))))) +big-artifact-children n j a (x₂ ∷ x₃ ∷ []) .x₂ (here refl) (conf , artifact≡cs) = j , conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs)) +big-artifact-children n j a (x₂ ∷ x₃ ∷ []) .x₃ (there (here refl)) (conf , artifact≡cs) = j + 2 ^ n , conf , List.∷-injectiveˡ (List.∷-injectiveʳ (proj₂ (Rose-injective artifact≡cs))) big-artifact∈e₂⇒2^n≤e₂ : ∀ {i : Size} → (n j : ℕ) @@ -245,7 +245,7 @@ artifact-0∈e₂⇒2^n≤e₂ n (a 2CC.2CC.-< c ∷ [] >-) (conf , artifact≡c 2 ^ suc n ≡⟨ ℕ.+-∸-assoc 1 {2 ^ suc n} {1} (ℕ.m^n>0 2 (suc n)) ⟩ suc (2 ^ suc n ∸ 1) - ≤⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ n zero c (conf , proj₁ (List.∷-injective (proj₂ (Rose-injective artifact≡cs))))) ⟩ + ≤⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ n zero c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs)))) ⟩ suc (size2CC c) ≡⟨ Eq.cong suc (ℕ.+-identityʳ (size2CC c)) ⟨ suc (size2CC c + 0) @@ -293,7 +293,7 @@ artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs 2^n≤size2CC-artifact n j a (c ∷ cs) (conf , artifact≡cs) = begin 2 ^ suc n - ≤⟨ artifact-0∈e₂⇒2^n≤e₂ n c (conf , proj₁ (List.∷-injective (proj₂ (Rose-injective artifact≡cs)))) ⟩ + ≤⟨ artifact-0∈e₂⇒2^n≤e₂ n c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs))) ⟩ size2CC c ≤⟨ ℕ.m≤m+n (size2CC c) (List.sum (List.map size2CC cs)) ⟩ size2CC c + List.sum (List.map size2CC cs) @@ -320,7 +320,7 @@ impossible-artifact-sizes n (c ∷ cs) [] (c₂ ∷ cs₂) cs₁≢cs₂ impossible-artifact-sizes n [] (c₁ ∷ cs₁) [] cs₁≢cs₂ (i , ()) (j , cs₂≡cs) impossible-artifact-sizes n (c ∷ cs) (c₁ ∷ cs₁) [] cs₁≢cs₂ (i , cs₁≡cs) (j , ()) impossible-artifact-sizes n (c ∷ cs) (c₁ ∷ cs₁) (c₂ ∷ cs₂) cs₁≢cs₂ (i , cs₁≡cs) (j , cs₂≡cs) = - impossible-artifact-sizes n cs cs₁ cs₂ (cs₁≢cs₂ ∘ Eq.cong suc) (i , proj₂ (List.∷-injective cs₁≡cs)) (j , proj₂ (List.∷-injective cs₂≡cs)) + impossible-artifact-sizes n cs cs₁ cs₂ (cs₁≢cs₂ ∘ Eq.cong suc) (i , List.∷-injectiveʳ cs₁≡cs) (j , List.∷-injectiveʳ cs₂≡cs) split-sizes : ∀ {i : Size} → (n : ℕ) From 0bbea43ce540955f9b85161503c9bc9ff4c49b7f Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Thu, 26 Jun 2025 22:22:18 +0200 Subject: [PATCH 23/82] =?UTF-8?q?Prove=20OC=20=E2=89=B1=202CC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../OC\342\211\2612CC.agda" | 389 ++++++++++++++++++ src/Vatras/SyntacticExpressiveness/Sizes.agda | 13 + src/Vatras/Util/List.agda | 4 + 3 files changed, 406 insertions(+) create mode 100644 "src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" diff --git "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" new file mode 100644 index 00000000..07428af3 --- /dev/null +++ "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" @@ -0,0 +1,389 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT) +-- TODO abstract over (F : 𝔽) using a map (ℕ → 𝔽) +module Vatras.SyntacticExpressiveness.OC≱2CC where + +open import Data.Bool using (true; false) +open import Data.Empty using (⊥-elim) +open import Data.Nat as ℕ using (ℕ; zero; suc; _≤_; _<_; s≤s; z≤n; _<ᵇ_; _+_; _*_; _^_; _∸_) +import Data.Nat.Properties as ℕ +open import Data.List as List using (List; []; _∷_) +import Data.List.Properties as List +import Data.List.Relation.Binary.Subset.Propositional as Subset +import Data.List.Relation.Binary.Subset.Propositional.Properties as Subset +open import Data.List.Relation.Unary.All as All using (All; []; _∷_) +import Data.List.Relation.Unary.All.Properties as All +open import Data.List.Relation.Unary.Any using (here; there) +open import Data.List.Relation.Unary.Unique.DecPropositional ℕ._≟_ using (Unique; []; _∷_) +import Data.List.Relation.Unary.Unique.DecPropositional.Properties as Unique +open import Data.Maybe using (just) +open import Data.Product using (_×_; _,_; proj₁; proj₂; ∃-syntax) + +open import Function using (_∘_; id) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_) +open import Relation.Nullary.Decidable using (yes; no) +open import Relation.Nullary.Reflects using (ofʸ; ofⁿ) +open import Size using (Size; ∞) + +import Vatras.Util.List as List +open import Vatras.Data.EqIndexedSet using (_≅_; _∈_; _⊆_) +open import Vatras.Framework.Variants using (Rose; Rose-injective) +open import Vatras.Framework.Compiler using (LanguageCompiler) +open import Vatras.Lang.All.Fixed ℕ (Rose ∞) +open import Vatras.SyntacticExpressiveness using (_≱Size_) +open import Vatras.SyntacticExpressiveness.Sizes ℕ using (SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC) + +options : ℕ → List (OC.OC ∞ NAT) +options zero = [] +options (suc n) = n OC.❲ suc n OC.-< [] >- ❳ ∷ options n + +exponential-oc : ℕ → OC.OC ∞ NAT +exponential-oc zero = 0 OC.-< [] >- +exponential-oc (suc n) = 0 OC.-< exponential-oc n ∷ exponential-oc n ∷ [] >- + +oc : ℕ → OC.WFOC ∞ NAT +oc n = OC.Root zero (exponential-oc n ∷ options n) + +size-options : ∀ n → List.sum (List.map sizeOC (options n)) ≡ 2 * n +size-options zero = Eq.refl +size-options (suc n) = + List.sum (List.map sizeOC (options (suc n))) + ≡⟨⟩ + suc (suc (List.sum (List.map sizeOC (options n)))) + ≡⟨ Eq.cong (λ x → suc (suc x)) (size-options n) ⟩ + suc (suc (2 * n)) + ≡⟨ ℕ.*-suc 2 n ⟨ + 2 * (suc n) + ∎ + where + open Eq.≡-Reasoning + +size-exponential-artifact : ∀ (n : ℕ) → sizeOC (exponential-oc n) ≡ 2 ^ (suc n) ∸ 1 +size-exponential-artifact zero = Eq.refl +size-exponential-artifact (suc n) = + sizeOC (exponential-oc (suc n)) + ≡⟨⟩ + sizeOC (0 OC.-< exponential-oc n ∷ exponential-oc n ∷ [] >-) + ≡⟨⟩ + suc (sizeOC (exponential-oc n) + (sizeOC (exponential-oc n) + 0)) + ≡⟨ Eq.cong (λ x → suc (x + (x + 0))) (size-exponential-artifact n) ⟩ + suc (2 ^ (suc n) ∸ 1 + (2 ^ (suc n) ∸ 1 + 0)) + ≡⟨⟩ + suc (2 ^ (suc n) ∸ 1) + (2 ^ (suc n) ∸ 1 + 0) + ≡⟨ Eq.cong (λ x → suc (2 ^ (suc n) ∸ 1) + x) (ℕ.+-identityʳ (2 ^ (suc n) ∸ 1)) ⟩ + suc (2 ^ (suc n) ∸ 1) + (2 ^ (suc n) ∸ 1) + ≡⟨ Eq.cong (_+ (2 ^ (suc n) ∸ 1)) (ℕ.+-∸-assoc 1 (ℕ.m^n>0 2 (suc n))) ⟨ + 2 ^ (suc n) + (2 ^ (suc n) ∸ 1) + ≡⟨ ℕ.+-∸-assoc (2 ^ (suc n)) {2 ^ (suc n)} {1} (ℕ.m^n>0 2 (suc n)) ⟨ + (2 ^ (suc n) + 2 ^ (suc n)) ∸ 1 + ≡⟨ Eq.cong (λ x → 2 ^ (suc n) + x ∸ 1) (ℕ.+-identityʳ (2 ^ (suc n))) ⟨ + 2 ^ (suc (suc n)) ∸ 1 + ∎ + where + open Eq.≡-Reasoning + +size-oc : ∀ (n : ℕ) → sizeWFOC (oc n) ≡ 2 ^ (suc n) + 2 * n +size-oc n = + sizeWFOC (oc n) + ≡⟨⟩ + suc (sizeOC (exponential-oc n) + List.sum (List.map sizeOC (options n))) + ≡⟨ Eq.cong₂ (λ x y → suc (x + y)) (size-exponential-artifact n) (size-options n) ⟩ + suc (2 ^ (suc n) ∸ 1 + 2 * n) + ≡⟨ Eq.cong (_+ 2 * n) (ℕ.+-∸-assoc 1 (ℕ.m^n>0 2 (suc n))) ⟨ + 2 ^ (suc n) + 2 * n + ∎ + where + open Eq.≡-Reasoning + +exponential-artifact : ℕ → Rose ∞ NAT +exponential-artifact zero = 0 Rose.-< [] >- +exponential-artifact (suc n) = 0 Rose.-< exponential-artifact n ∷ exponential-artifact n ∷ [] >- + +variant-cs : ℕ → List (Rose ∞ NAT) +variant-cs zero = [] +variant-cs (suc i) = suc i Rose.-< [] >- ∷ variant-cs i + +variant : ℕ → ℕ → Rose ∞ NAT +variant n i = 0 Rose.-< exponential-artifact n ∷ variant-cs i >- + +length-variants-cs : ∀ n → List.length (variant-cs n) ≡ n +length-variants-cs zero = Eq.refl +length-variants-cs (suc n) = Eq.cong suc (length-variants-cs n) + +variant∈e⇒length-cs + : ∀ {i} (n l : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT)) + → variant n l ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ + → List.length cs ≡ suc l +variant∈e⇒length-cs n l a cs (c , v≡e) = + List.length cs + ≡⟨ List.length-map (λ e → 2CC.⟦ e ⟧ c) cs ⟨ + List.length (List.map (λ e → 2CC.⟦ e ⟧ c) cs) + ≡⟨ Eq.cong List.length (proj₂ (Rose-injective v≡e)) ⟨ + List.length (exponential-artifact n ∷ variant-cs l) + ≡⟨ Eq.cong suc (length-variants-cs l) ⟩ + suc l + ∎ + where + open Eq.≡-Reasoning + +exponential-artifact∈e⇒length-cs + : ∀ {i} (n : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT)) + → exponential-artifact (suc n) ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ + → List.length cs ≡ 2 +exponential-artifact∈e⇒length-cs n a cs (c , v≡e) = + List.length cs + ≡⟨ List.length-map (λ e → 2CC.⟦ e ⟧ c) cs ⟨ + List.length (List.map (λ e → 2CC.⟦ e ⟧ c) cs) + ≡⟨ Eq.cong List.length (proj₂ (Rose-injective v≡e)) ⟨ + List.length (exponential-artifact n ∷ exponential-artifact n ∷ []) + ≡⟨⟩ + 2 + ∎ + where + open Eq.≡-Reasoning + +exponential-big + : ∀ {i : Size} (n l : ℕ) + → (2cc : 2CC.2CC i NAT) + → exponential-artifact n ∈ 2CC.⟦ 2cc ⟧ + → 2 ^ (suc n) ∸ 1 ≤ size2CC 2cc +exponential-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) with c D +exponential-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) | true = ℕ.≤-trans (exponential-big n l c₁ (c , v≡2cc)) (ℕ.≤-trans (ℕ.m≤m+n (size2CC c₁) (size2CC c₂)) (ℕ.m≤n+m (size2CC c₁ + size2CC c₂) 1)) +exponential-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) | false = ℕ.≤-trans (exponential-big n l c₂ (c , v≡2cc)) (ℕ.m≤n+m (size2CC c₂) (suc (size2CC c₁))) +exponential-big zero l (a 2CC.-< cs >-) (c , v≡2cc) = s≤s z≤n +exponential-big (suc n) l (a 2CC.-< cs >-) (c , v≡2cc) with exponential-artifact∈e⇒length-cs n a cs (c , v≡2cc) +exponential-big (suc n) l (a 2CC.-< c₁ ∷ c₂ ∷ [] >-) (c , v≡2cc) | Eq.refl = + begin + 2 ^ (suc (suc n)) ∸ 1 + ≡⟨ Eq.cong (λ x → (2 ^ (suc n) + x) ∸ 1) (ℕ.+-identityʳ (2 ^ (suc n))) ⟩ + (2 ^ (suc n) + 2 ^ (suc n)) ∸ 1 + ≡⟨ ℕ.+-∸-assoc (2 ^ (suc n)) (ℕ.m^n>0 2 (suc n)) ⟩ + 2 ^ (suc n) + (2 ^ (suc n) ∸ 1) + ≡⟨ ℕ.+-∸-assoc 1 (ℕ.≤-trans (ℕ.m^n>0 2 (suc n)) (ℕ.m≤m+n (2 ^ (suc n)) (2 ^ (suc n) ∸ 1))) ⟩ + 1 + ((2 ^ (suc n) + (2 ^ (suc n) ∸ 1)) ∸ 1) + ≡⟨ Eq.cong suc (ℕ.+-∸-comm (2 ^ suc n ∸ 1) (ℕ.m^n>0 2 (suc n))) ⟩ + suc ((2 ^ (suc n) ∸ 1) + (2 ^ (suc n) ∸ 1)) + ≤⟨ s≤s (ℕ.+-mono-≤ (exponential-big n l c₁ (c , proj₁ (List.∷-injective (proj₂ (Rose-injective v≡2cc))))) (exponential-big n l c₂ (c , proj₁ (List.∷-injective (proj₂ (List.∷-injective (proj₂ (Rose-injective v≡2cc)))))))) ⟩ + suc (size2CC c₁ + size2CC c₂) + ≡⟨ Eq.cong (λ x → suc (size2CC c₁ + x)) (ℕ.+-identityʳ (size2CC c₂)) ⟨ + suc (size2CC c₁ + (size2CC c₂ + 0)) + ≡⟨⟩ + size2CC (a 2CC.-< c₁ ∷ c₂ ∷ [] >-) + ∎ + where + open ℕ.≤-Reasoning + +exponentially-big + : ∀ {i : Size} (n l : ℕ) + → (2cc : 2CC.2CC i NAT) + → variant n l ∈ 2CC.⟦ 2cc ⟧ + → 2 ^ n < size2CC 2cc +exponentially-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) with c D +exponentially-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) | true = ℕ.≤-trans (exponentially-big n l c₁ (c , v≡2cc)) (ℕ.≤-trans (ℕ.m≤m+n (size2CC c₁) (size2CC c₂)) (ℕ.m≤n+m (size2CC c₁ + size2CC c₂) 1)) +exponentially-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) | false = ℕ.≤-trans (exponentially-big n l c₂ (c , v≡2cc)) (ℕ.m≤n+m (size2CC c₂) (suc (size2CC c₁))) +exponentially-big n l (a 2CC.-< cs >-) (c , v≡2cc) with variant∈e⇒length-cs n l a cs (c , v≡2cc) +exponentially-big n l (a 2CC.-< c₁ ∷ cs >-) (c , v≡2cc) | Eq.refl = + begin-strict + 2 ^ n + <⟨ ℕ.m0 2 n) ⟩ + 2 ^ n + 2 ^ n + ≡⟨ Eq.cong (2 ^ n +_) (ℕ.+-identityʳ (2 ^ n)) ⟨ + 2 ^ n + (2 ^ n + 0) + ≡⟨⟩ + 2 ^ (suc n) + ≡⟨ ℕ.+-∸-assoc 1 (ℕ.m^n>0 2 (suc n)) ⟩ + suc (2 ^ (suc n) ∸ 1) + ≤⟨ s≤s (exponential-big n l c₁ (c , proj₁ (List.∷-injective (proj₂ (Rose-injective v≡2cc))))) ⟩ + suc (size2CC c₁) + ≤⟨ ℕ.m≤m+n (suc (size2CC c₁)) (List.sum (List.map size2CC cs)) ⟩ + suc (size2CC c₁ + List.sum (List.map size2CC cs)) + ≡⟨⟩ + size2CC (a 2CC.2CC.-< c₁ ∷ cs >-) + ∎ + where + open ℕ.≤-Reasoning + +partition : ∀ {i : Size} (n D : ℕ) + → (c₁ c₂ : 2CC.2CC i NAT) + → (ls : List ℕ) + → Unique ls + → All (λ l → variant n l ∈ 2CC.⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) ls + → ∃[ ls₁ ] ∃[ ls₂ ] + ls₁ Subset.⊆ ls × ls₂ Subset.⊆ ls + × List.length ls₁ + List.length ls₂ ≡ List.length ls + × Unique ls₁ × All (λ l → variant n l ∈ 2CC.⟦ c₁ ⟧) ls₁ + × Unique ls₂ × All (λ l → variant n l ∈ 2CC.⟦ c₂ ⟧) ls₂ +partition n D c₁ c₂ [] unique-ls ls⊆2cc = [] , [] , Subset.⊆-refl , Subset.⊆-refl , Eq.refl , [] , [] , [] , [] +partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls⊆2cc) with c D | partition n D c₁ c₂ ls unique-ls ls⊆2cc +partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls⊆2cc) | true | ls₁ , ls₂ , ls₁⊆ls , ls₂⊆ls , ls₁+ls₂≡ls , unique-ls₁ , ls₁∈l , unique-ls₂ , ls₂∈r = + l ∷ ls₁ , ls₂ , Subset.∷⁺ʳ l ls₁⊆ls , there ∘ ls₂⊆ls , Eq.cong suc ls₁+ls₂≡ls , All.anti-mono ls₁⊆ls l∉ls ∷ unique-ls₁ , (c , l≡2cc) ∷ ls₁∈l , unique-ls₂ , ls₂∈r +partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls⊆2cc) | false | ls₁ , ls₂ , ls₁⊆ls , ls₂⊆ls , ls₁+ls₂≡ls , unique-ls₁ , ls₁∈l , unique-ls₂ , ls₂∈r = + ls₁ , l ∷ ls₂ , there ∘ ls₁⊆ls , Subset.∷⁺ʳ l ls₂⊆ls , Eq.trans (ℕ.+-suc (List.length ls₁) (List.length ls₂)) (Eq.cong suc ls₁+ls₂≡ls) , unique-ls₁ , ls₁∈l , All.anti-mono ls₂⊆ls l∉ls ∷ unique-ls₂ , (c , l≡2cc) ∷ ls₂∈r + +big : ∀ {i : Size} (n : ℕ) + → (2cc : 2CC.2CC i NAT) + → (ls : List ℕ) + → Unique ls + → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) ls + → List.length ls * 2 ^ n < size2CC 2cc +big n (a 2CC.-< cs >-) [] unique-ls all-∈ = s≤s z≤n +big n (a 2CC.-< cs >-) (l₁ ∷ []) unique-ls all-∈ = Eq.subst (_< size2CC (a 2CC.-< cs >-)) (Eq.sym (ℕ.+-identityʳ (2 ^ n))) (exponentially-big n l₁ (a 2CC.-< cs >-) (All.lookup all-∈ (here Eq.refl))) +big n (a 2CC.-< cs >-) (l₁ ∷ l₂ ∷ ls) ((l₁≢l₂ ∷ l₁∉ls) ∷ unique-ls) all-∈ = ⊥-elim (l₁≢l₂ (ℕ.suc-injective (Eq.trans (Eq.sym (variant∈e⇒length-cs n l₁ a cs (All.lookup all-∈ (here Eq.refl)))) (variant∈e⇒length-cs n l₂ a cs (All.lookup all-∈ (there (here Eq.refl))))))) +big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ with partition n D l r ls unique-ls all-∈ +big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ | ls₁ , ls₂ , _ , _ , ls₁+ls₂≡ls , unique-ls₁ , ls₁∈l , unique-ls₂ , ls₂∈r = + begin-strict + List.length ls * 2 ^ n + <⟨ ℕ.n<1+n (List.length ls * 2 ^ n) ⟩ + suc (List.length ls * 2 ^ n) + ≡⟨ Eq.cong (λ x → suc (x * 2 ^ n)) ls₁+ls₂≡ls ⟨ + suc ((List.length ls₁ + List.length ls₂) * 2 ^ n) + ≡⟨ Eq.cong suc (ℕ.*-distribʳ-+ (2 ^ n) (List.length ls₁) (List.length ls₂)) ⟩ + suc (List.length ls₁ * 2 ^ n + List.length ls₂ * 2 ^ n) + <⟨ s≤s (ℕ.+-mono-< (big n l ls₁ unique-ls₁ ls₁∈l) (big n r ls₂ unique-ls₂ ls₂∈r)) ⟩ + suc (size2CC l + size2CC r) + ≡⟨⟩ + size2CC (D 2CC.⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning + +conf : ℕ → OC.Configuration +conf n i = i <ᵇ n + +⟦exponential-artifact⟧ : ∀ n c → OC.⟦ exponential-oc n ⟧ₒ c ≡ just (exponential-artifact n) +⟦exponential-artifact⟧ zero c = Eq.refl +⟦exponential-artifact⟧ (suc n) c = + OC.⟦ exponential-oc (suc n) ⟧ₒ c + ≡⟨⟩ + OC.⟦ 0 OC.-< exponential-oc n ∷ exponential-oc n ∷ [] >- ⟧ₒ c + ≡⟨⟩ + just (0 Rose.-< List.catMaybes (List.map (λ x → OC.⟦ x ⟧ₒ c) (exponential-oc n ∷ exponential-oc n ∷ [])) >-) + ≡⟨⟩ + just (0 Rose.-< List.catMaybes (OC.⟦ exponential-oc n ⟧ₒ c ∷ OC.⟦ exponential-oc n ⟧ₒ c ∷ []) >-) + ≡⟨ Eq.cong (λ x → just (0 Rose.-< List.catMaybes (x ∷ x ∷ []) >-)) (⟦exponential-artifact⟧ n c) ⟩ + just (0 Rose.-< exponential-artifact n ∷ exponential-artifact n ∷ [] >-) + ≡⟨⟩ + just (exponential-artifact (suc n)) + ∎ + where + open Eq.≡-Reasoning + +⟦options⟧ : ∀ n l + → l ≤ n + → List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) + ≡ variant-cs l +⟦options⟧ zero .zero z≤n = Eq.refl +⟦options⟧ (suc n) l l≤n with n ℕ.- ∷_) (go n l (ℕ.<⇒≤ n- + ≡⟨⟩ + 0 Rose.-< List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (exponential-oc n ∷ options n)) >- + ≡⟨⟩ + 0 Rose.-< List.catMaybes (OC.⟦ exponential-oc n ⟧ₒ (conf l) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) >- + ≡⟨ Eq.cong (λ x → 0 Rose.-< List.catMaybes (x ∷ List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) >-) (⟦exponential-artifact⟧ n (conf l)) ⟩ + 0 Rose.-< List.catMaybes (just (exponential-artifact n) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) >- + ≡⟨⟩ + 0 Rose.-< exponential-artifact n ∷ List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) >- + ≡⟨ Eq.cong (λ x → 0 Rose.-< exponential-artifact n ∷ x >-) (⟦options⟧ n l l≤n) ⟩ + 0 Rose.-< exponential-artifact n ∷ variant-cs l >- + ≡⟨⟩ + variant n l + ∎ + where + open Eq.≡-Reasoning + +⊆⇒All∈ : ∀ {i} n l + → l ≤ suc n + → (2cc : 2CC.2CC i NAT) + → OC.⟦ oc n ⟧ ⊆ 2CC.⟦ 2cc ⟧ + → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) (List.upTo l) +⊆⇒All∈ n zero l≤m 2cc oc⊆2cc = [] +⊆⇒All∈ n (suc l) (s≤s l≤m) 2cc oc⊆2cc = Eq.subst (All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧)) (List.applyUpTo-∷ʳ⁺ id l) (All.∷ʳ⁺ (⊆⇒All∈ n l (ℕ.<⇒≤ (s≤s l≤m)) 2cc oc⊆2cc) (Eq.subst (_∈ 2CC.⟦ 2cc ⟧) (⟦oc⟧ n l l≤m) (oc⊆2cc (conf l)))) + +4*n<16^n : ∀ n → 4 * n < 16 ^ n +4*n<16^n zero = s≤s z≤n +4*n<16^n (suc n) = + begin-strict + 4 * suc n + ≡⟨ ℕ.*-suc 4 n ⟩ + 4 + 4 * n + <⟨ ℕ.+-mono-< (s≤s (s≤s (s≤s (s≤s (s≤s z≤n))))) (4*n<16^n n) ⟩ + 15 + 16 ^ n + ≤⟨ ℕ.+-monoˡ-≤ (16 ^ n) (ℕ.*-monoʳ-≤ 15 (ℕ.m^n>0 16 n)) ⟩ + 15 * 16 ^ n + 16 ^ n + ≡⟨ Eq.cong (15 * 16 ^ n +_) (ℕ.+-identityʳ (16 ^ n)) ⟨ + 15 * 16 ^ n + (16 ^ n + 0) + ≡⟨ ℕ.*-distribʳ-+ (16 ^ n) 15 1 ⟨ + 16 * 16 ^ n + ≡⟨⟩ + 16 ^ suc n + ∎ + where + open ℕ.≤-Reasoning + +size2CC>0 : ∀ {i} (2cc : 2CC.2CC i NAT) → 0 < size2CC 2cc +size2CC>0 (a 2CC.-< cs >-) = s≤s z≤n +size2CC>0 (D 2CC.⟨ l , r ⟩) = s≤s z≤n + +goal : ∀ {i} (n : ℕ) (2cc : 2CC.2CC i NAT) + → OC.⟦ oc (4 * n) ⟧ ≅ 2CC.⟦ 2cc ⟧ + → n * sizeWFOC (oc (4 * n)) < size2CC 2cc +goal zero 2cc 2cc≅oc = size2CC>0 2cc +goal n@(suc _) 2cc (oc⊆2cc , 2cc⊆oc) = + begin-strict + n * sizeWFOC (oc (4 * n)) + ≡⟨ Eq.cong (n *_) (size-oc (4 * n)) ⟩ + n * (2 ^ (suc (4 * n)) + 2 * (4 * n)) + ≡⟨⟩ + n * (2 * 2 ^ (4 * n) + 2 * (4 * n)) + ≡⟨ Eq.cong (n *_) (ℕ.*-distribˡ-+ 2 (2 ^ (4 * n)) (4 * n)) ⟨ + n * (2 * (2 ^ (4 * n) + 4 * n)) + ≡⟨ ℕ.*-assoc n 2 (2 ^ (4 * n) + 4 * n) ⟨ + n * 2 * (2 ^ (4 * n) + 4 * n) + <⟨ ℕ.*-monoʳ-< (n * 2) (ℕ.+-monoʳ-< (2 ^ (4 * n)) (4*n<16^n n)) ⟩ + n * 2 * (2 ^ (4 * n) + 16 ^ n) + ≡⟨ Eq.cong (λ x → n * 2 * (2 ^ (4 * n) + x)) (ℕ.^-*-assoc 2 4 n) ⟩ + n * 2 * (2 ^ (4 * n) + 2 ^ (4 * n)) + ≡⟨ Eq.cong (_* (2 ^ (4 * n) + 2 ^ (4 * n))) (ℕ.*-comm n 2) ⟩ + 2 * n * (2 ^ (4 * n) + 2 ^ (4 * n)) + ≡⟨ Eq.cong (λ x → 2 * n * (2 ^ (4 * n) + x)) (ℕ.+-identityʳ (2 ^ (4 * n))) ⟨ + 2 * n * (2 ^ (4 * n) + (2 ^ (4 * n) + 0)) + ≡⟨⟩ + 2 * n * (2 * 2 ^ (4 * n)) + ≡⟨ ℕ.*-assoc (2 * n) 2 (2 ^ (4 * n)) ⟨ + 2 * n * 2 * 2 ^ (4 * n) + ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (ℕ.*-comm (2 * n) 2) ⟩ + 2 * (2 * n) * 2 ^ (4 * n) + ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (ℕ.*-assoc 2 2 n) ⟨ + (2 * 2) * n * 2 ^ (4 * n) + ≡⟨⟩ + 4 * n * 2 ^ (4 * n) + ≤⟨ ℕ.*-monoˡ-≤ (2 ^ (4 * n)) (ℕ.m≤n+m (4 * n) 1) ⟩ + suc (4 * n) * 2 ^ (4 * n) + ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (List.length-upTo (suc (4 * n))) ⟨ + List.length (List.upTo (suc (4 * n))) * 2 ^ (4 * n) + <⟨ big (4 * n) 2cc (List.upTo (suc (4 * n))) (Unique.applyUpTo⁺₁ id (suc (4 * n)) (λ i-) = suc (List.sum (List.map sizeOC cs)) +sizeOC (D OC.❲ c ❳) = suc (sizeOC c) + +sizeWFOC : ∀ {i : Size} {A : 𝔸} → OC.WFOC i A → ℕ +sizeWFOC (OC.Root a cs) = suc (List.sum (List.map sizeOC cs)) + +SizedWFOC : SizedLang +SizedWFOC = record + { Lang = OC.WFOCL + ; size = sizeWFOC + } + sizeFST : {A : 𝔸} → FST.Impose.SPL A → ℕ sizeFST (root FST.Impose.◀ features) = 1 + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) features) diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index 2746e354..31485422 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -351,3 +351,7 @@ applyUpTo-cong : ∀ {ℓ₁} {A : Set ℓ₁} → List.applyUpTo f ≗ List.applyUpTo g applyUpTo-cong f≗g zero = refl applyUpTo-cong f≗g (suc n) = Eq.cong₂ _∷_ (f≗g zero) (applyUpTo-cong (f≗g ∘ suc) n) + +applyUpTo-∷ʳ⁺ : ∀ {ℓ} {A : Set ℓ} (f : ℕ → A) (n : ℕ) → List.applyUpTo f n List.∷ʳ f n ≡ List.applyUpTo f (suc n) +applyUpTo-∷ʳ⁺ f zero = refl +applyUpTo-∷ʳ⁺ f (suc n) = Eq.cong (f 0 ∷_) (applyUpTo-∷ʳ⁺ (f ∘ suc) n) From 4789f75b64aad776e8feb5d3856d808c4155bbd8 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sun, 13 Jul 2025 12:00:20 +0200 Subject: [PATCH 24/82] Use the artifact example definitions where possible MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This reduces duplication and allows refactoring of 𝔸. --- src/Vatras/Lang/2CC/Show.agda | 4 ++-- src/Vatras/Lang/CCC/Show.agda | 6 ++--- src/Vatras/Lang/FST/IncompleteOnRose.lagda.md | 10 ++++---- src/Vatras/Lang/NCC/Show.agda | 6 ++--- src/Vatras/Lang/OC/Alternative.agda | 11 ++++----- src/Vatras/Lang/OC/IncompleteOnRose.lagda.md | 10 ++++---- src/Vatras/Lang/OC/Show.agda | 10 ++++---- .../SyntacticExpressiveness/2CC-) -show : ∀ {i} → 2CC i (String , String._≟_) → String +show : ∀ {i} → 2CC i STRING → String show (a -< [] >-) = a show (a -< es@(_ ∷ _) >-) = a ++ "-<" ++ (String.intersperse ", " (List.map show es)) ++ ">-" show (D ⟨ l , r ⟩) = show-D D ++ "⟨" ++ (show l) ++ ", " ++ (show r) ++ "⟩" -pretty : ∀ {i : Size} → 2CC i (String , String._≟_) → Lines +pretty : ∀ {i : Size} → 2CC i STRING → Lines pretty (a -< [] >-) = > a pretty (a -< es@(_ ∷ _) >-) = do > a ++ "-<" diff --git a/src/Vatras/Lang/CCC/Show.agda b/src/Vatras/Lang/CCC/Show.agda index dd3c1d75..475b07a7 100644 --- a/src/Vatras/Lang/CCC/Show.agda +++ b/src/Vatras/Lang/CCC/Show.agda @@ -1,4 +1,4 @@ -open import Vatras.Framework.Definitions using (𝔽) +open import Vatras.Framework.Definitions using (𝔽; STRING) module Vatras.Lang.CCC.Show {Dimension : 𝔽} where open import Size using (Size) @@ -10,12 +10,12 @@ open import Data.String as String using (String; _++_) open import Vatras.Show.Lines hiding (map) open import Vatras.Lang.CCC Dimension using (CCC; _-<_>-; _⟨_⟩) -show : ∀ {i} → (Dimension → String) → CCC i (String , String._≟_) → String +show : ∀ {i} → (Dimension → String) → CCC i STRING → String show _ (a -< [] >-) = a show show-D (a -< es@(_ ∷ _) >- ) = a ++ "-<" ++ (List.foldl _++_ "" (List.map (show show-D) es)) ++ ">-" show show-D (D ⟨ es ⟩) = show-D D ++ "⟨" ++ (String.intersperse ", " (List⁺.toList (List⁺.map (show show-D) es))) ++ "⟩" -pretty : ∀ {i : Size} → (Dimension → String) → CCC i (String , String._≟_) → Lines +pretty : ∀ {i : Size} → (Dimension → String) → CCC i STRING → Lines pretty show-D (a -< [] >-) = > a pretty show-D (a -< es@(_ ∷ _) >-) = do > a ++ "-<" diff --git a/src/Vatras/Lang/FST/IncompleteOnRose.lagda.md b/src/Vatras/Lang/FST/IncompleteOnRose.lagda.md index 6d818946..4e3bfc70 100644 --- a/src/Vatras/Lang/FST/IncompleteOnRose.lagda.md +++ b/src/Vatras/Lang/FST/IncompleteOnRose.lagda.md @@ -1,5 +1,5 @@ ``` -open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT) module Vatras.Lang.FST.IncompleteOnRose {F : 𝔽} where open import Size using (Size; ∞) @@ -24,16 +24,16 @@ open import Data.Nat as ℕ using (ℕ; zero; suc) open import Vatras.Framework.VariantGenerator using (VariantGenerator) open import Vatras.Framework.Properties.Completeness using (Incomplete) -variant-0 = rose-leaf {A = (ℕ , ℕ._≟_)} 0 -variant-1 = rose-leaf {A = (ℕ , ℕ._≟_)} 1 +variant-0 = rose-leaf {A = NAT} 0 +variant-1 = rose-leaf {A = NAT} 1 -variants-0-and-1 : VariantGenerator (Rose ∞) (ℕ , ℕ._≟_) 1 +variants-0-and-1 : VariantGenerator (Rose ∞) NAT 1 variants-0-and-1 zero = variant-0 variants-0-and-1 (suc zero) = variant-1 does-not-describe-variants-0-and-1 : ∀ {i : Size} - → (e : Impose.SPL (ℕ , ℕ._≟_)) + → (e : Impose.SPL NAT) → ∃[ c ] (variant-0 ≡ ⟦ e ⟧ c) → ∄[ c ] (variant-1 ≡ ⟦ e ⟧ c) does-not-describe-variants-0-and-1 (zero Impose.◀ features) _ () diff --git a/src/Vatras/Lang/NCC/Show.agda b/src/Vatras/Lang/NCC/Show.agda index 7b0a1c22..30d9ca3d 100644 --- a/src/Vatras/Lang/NCC/Show.agda +++ b/src/Vatras/Lang/NCC/Show.agda @@ -1,5 +1,5 @@ open import Data.String as String using (String; _++_) -open import Vatras.Framework.Definitions using (𝔽) +open import Vatras.Framework.Definitions using (𝔽; STRING) open import Vatras.Util.Nat.AtLeast using (ℕ≥) module Vatras.Lang.NCC.Show {Dimension : 𝔽} {n : ℕ≥ 2} (show-D : Dimension → String) where @@ -11,13 +11,13 @@ open import Data.Product using (_,_) open import Vatras.Show.Lines open import Vatras.Lang.NCC Dimension n using (NCC; _⟨_⟩; _-<_>-) -show : ∀ {i} → NCC i (String , String._≟_) → String +show : ∀ {i} → NCC i STRING → String show (a -< [] >-) = a show (a -< es@(_ ∷ _) >-) = a ++ "-<" ++ (String.intersperse ", " (List.map show es)) ++ ">-" show (D ⟨ cs ⟩) = show-D D ++ "⟨" ++ (String.intersperse ", " (List.map show (Vec.toList cs))) ++ "⟩" -pretty : ∀ {i : Size} → NCC i (String , String._≟_) → Lines +pretty : ∀ {i : Size} → NCC i STRING → Lines pretty (a -< [] >-) = > a pretty (a -< es@(_ ∷ _) >-) = do > a ++ "-<" diff --git a/src/Vatras/Lang/OC/Alternative.agda b/src/Vatras/Lang/OC/Alternative.agda index e0745192..dde71360 100644 --- a/src/Vatras/Lang/OC/Alternative.agda +++ b/src/Vatras/Lang/OC/Alternative.agda @@ -3,7 +3,7 @@ This module proves that option calculus cannot encode alternatives, at the example of natural numbers as the atom set. The proof is restricted to variants with alternatives at their root. -} -open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) +open import Vatras.Framework.Definitions using (𝔽; NAT) module Vatras.Lang.OC.Alternative {F : 𝔽} where open import Data.List using (List; []; _∷_) @@ -20,11 +20,8 @@ open import Vatras.Lang.OC F as OC using (WFOC; Root) open import Vatras.Lang.OC.Util using (all-oc) open import Vatras.Lang.OC.Subtree using (Subtree; subtrees; subtreeₒ-recurse) -A : 𝔸 -A = ℕ , _≟_ - cannotEncodeAlternative : - (e : WFOC ∞ A) + (e : WFOC ∞ NAT) → (∃[ c ] zero -< rose-leaf zero ∷ [] >- ≡ OC.⟦ e ⟧ c) → (∃[ c ] zero -< rose-leaf (suc zero) ∷ [] >- ≡ OC.⟦ e ⟧ c) → (zero -< [] >- ≡ OC.⟦ e ⟧ (all-oc false)) @@ -32,14 +29,14 @@ cannotEncodeAlternative : ⊎ Subtree (zero -< rose-leaf (suc zero) ∷ rose-leaf zero ∷ [] >-) (OC.⟦ e ⟧ (all-oc true)) cannotEncodeAlternative e@(Root zero cs) p₁ p₂ p₃ = Sum.map subtrees subtrees (mergeSubtrees' (sublist p₁) (sublist p₂)) where - sublist : ∀ {a : atoms A} {v : Rose ∞ A} → (∃[ c ] a -< v ∷ [] >- ≡ OC.⟦ e ⟧ c) → Sublist Subtree (v ∷ []) (OC.⟦ cs ⟧ₒ-recurse (all-oc true)) + sublist : ∀ {a : ℕ} {v : Rose ∞ NAT} → (∃[ c ] a -< v ∷ [] >- ≡ OC.⟦ e ⟧ c) → Sublist Subtree (v ∷ []) (OC.⟦ cs ⟧ₒ-recurse (all-oc true)) sublist (c₁ , p₁) = Eq.subst (λ cs' → Sublist Subtree cs' (OC.⟦ cs ⟧ₒ-recurse (all-oc true))) (children-equality (Eq.sym p₁)) (subtreeₒ-recurse cs c₁ (all-oc true) (λ f p → refl)) - mergeSubtrees' : ∀ {cs : List (Rose ∞ A)} + mergeSubtrees' : ∀ {cs : List (Rose ∞ NAT)} → Sublist Subtree (rose-leaf zero ∷ []) cs → Sublist Subtree (rose-leaf (suc zero) ∷ []) cs → Sublist Subtree (rose-leaf zero ∷ rose-leaf (suc zero) ∷ []) cs diff --git a/src/Vatras/Lang/OC/IncompleteOnRose.lagda.md b/src/Vatras/Lang/OC/IncompleteOnRose.lagda.md index 83068f57..ce45f3f2 100644 --- a/src/Vatras/Lang/OC/IncompleteOnRose.lagda.md +++ b/src/Vatras/Lang/OC/IncompleteOnRose.lagda.md @@ -1,5 +1,5 @@ ```agda -open import Vatras.Framework.Definitions using (𝔽) +open import Vatras.Framework.Definitions using (𝔽; NAT) module Vatras.Lang.OC.IncompleteOnRose {Option : 𝔽} where open import Size using (Size; ∞) @@ -9,7 +9,7 @@ open import Data.Product using (_,_; ∃-syntax; ∄-syntax) open import Relation.Binary.PropositionalEquality using (_≡_) open import Vatras.Framework.Variants using (Rose; rose-leaf) -open import Vatras.Framework.VariantGenerator (Rose ∞) (ℕ , ℕ._≟_) using (VariantGenerator) +open import Vatras.Framework.VariantGenerator (Rose ∞) NAT open import Vatras.Framework.Properties.Completeness (Rose ∞) using (Incomplete) open import Vatras.Lang.OC Option using (WFOC; Root; ⟦_⟧; WFOCL) ``` @@ -18,8 +18,8 @@ We prove incompleteness by showing that there exists at least one set of variant In particular, any set of variants that includes two entirely distinct variants cannot be expressed because options cannot encode constraints such as alternatives in choice calculus. As our counter example, we use the set `{0, 1}` as our variants: ```agda -variant-0 = rose-leaf {A = (ℕ , ℕ._≟_)} 0 -variant-1 = rose-leaf {A = (ℕ , ℕ._≟_)} 1 +variant-0 = rose-leaf {A = NAT} 0 +variant-1 = rose-leaf {A = NAT} 1 variants-0-and-1 : VariantGenerator 1 variants-0-and-1 zero = variant-0 @@ -34,7 +34,7 @@ So we show that given an expression `e`, a proof that `e` can be configured to ` ```agda does-not-describe-variants-0-and-1 : ∀ {i : Size} - → (e : WFOC i (ℕ , ℕ._≟_)) + → (e : WFOC i NAT) → ∃[ c ] (variant-0 ≡ ⟦ e ⟧ c) → ∄[ c ] (variant-1 ≡ ⟦ e ⟧ c) -- If e has 0 as root, it may be configured to 0 but never to 1. diff --git a/src/Vatras/Lang/OC/Show.agda b/src/Vatras/Lang/OC/Show.agda index b53dea98..491348ec 100644 --- a/src/Vatras/Lang/OC/Show.agda +++ b/src/Vatras/Lang/OC/Show.agda @@ -1,4 +1,4 @@ -open import Vatras.Framework.Definitions using (𝔽) +open import Vatras.Framework.Definitions using (𝔽; STRING) open import Data.String as String using (String; _++_) module Vatras.Lang.OC.Show {Option : 𝔽} (print-opt : Option → String) where @@ -10,15 +10,15 @@ open import Data.List as List using ([]; _∷_) open import Vatras.Show.Lines hiding (map) open import Vatras.Lang.OC Option using (OC; _❲_❳; _-<_>-; WFOC; forgetWF) -show-oc : ∀ {i : Size} → OC i (String , String._≟_) → String +show-oc : ∀ {i : Size} → OC i STRING → String show-oc (s -< [] >-) = s show-oc (s -< es@(_ ∷ _) >-) = s ++ "-<" ++ (String.intersperse ", " (List.map show-oc es)) ++ ">-" show-oc (O ❲ e ❳) = print-opt O ++ "❲" ++ show-oc e ++ "❳" -show-wfoc : ∀ {i : Size} → WFOC i (String , String._≟_) → String +show-wfoc : ∀ {i : Size} → WFOC i STRING → String show-wfoc = show-oc ∘ forgetWF -pretty-oc : ∀ {i : Size} → OC i (String , String._≟_) → Lines +pretty-oc : ∀ {i : Size} → OC i STRING → Lines pretty-oc (s -< [] >-) = > s pretty-oc (s -< es@(_ ∷ _) >-) = do > s ++ "-<" @@ -30,5 +30,5 @@ pretty-oc (O ❲ e ❳) = do indent 2 (pretty-oc e) > "❳" -pretty-wfoc : ∀ {i : Size} → WFOC i (String , String._≟_) → Lines +pretty-wfoc : ∀ {i : Size} → WFOC i STRING → Lines pretty-wfoc = pretty-oc ∘ forgetWF diff --git a/src/Vatras/SyntacticExpressiveness/2CC-) = > "[" ++ pretty-atom a ++ "]" diff --git a/src/Vatras/Test/Experiments/OC-to-2CC.agda b/src/Vatras/Test/Experiments/OC-to-2CC.agda index fab1cbb3..8d6a6e23 100644 --- a/src/Vatras/Test/Experiments/OC-to-2CC.agda +++ b/src/Vatras/Test/Experiments/OC-to-2CC.agda @@ -13,7 +13,7 @@ open import Level using (0ℓ) import Relation.Binary.PropositionalEquality as Eq open Eq using (_≡_; refl) -open import Vatras.Framework.Definitions using (ℂ) +open import Vatras.Framework.Definitions using (ℂ; STRING) open import Vatras.Framework.Variants using (Rose; show-rose) Feature = String @@ -60,7 +60,7 @@ OC→2CC-Test-conffnoc-allno = refl ∷ refl ∷ refl ∷ refl ∷ [] -- Translate an option calculus expression. -- Then configure it with an all-yes and an all-no config and print the resulting variants. -exp-oc-to-bcc : Experiment (WFOC Feature ∞ (String , String._≟_)) +exp-oc-to-bcc : Experiment (WFOC Feature ∞ STRING) getName exp-oc-to-bcc = "Translate OC to 2CC" get exp-oc-to-bcc ex@(name ≔ oc) = do let --trans-result = translate oc diff --git a/src/Vatras/Test/Experiments/RoundTrip.agda b/src/Vatras/Test/Experiments/RoundTrip.agda index 32c35619..1531e20c 100644 --- a/src/Vatras/Test/Experiments/RoundTrip.agda +++ b/src/Vatras/Test/Experiments/RoundTrip.agda @@ -17,7 +17,7 @@ import Relation.Binary.PropositionalEquality as Eq open Eq using (_≡_; refl) open import Vatras.Framework.Compiler using (LanguageCompiler) -open import Vatras.Framework.Definitions using (ℂ; 𝔸) +open import Vatras.Framework.Definitions using (ℂ; STRING) open import Vatras.Framework.Variants using (Rose; show-rose) open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) open import Vatras.Util.AuxProofs using (decidableEquality-×) @@ -50,12 +50,10 @@ open import Vatras.Test.Example open import Vatras.Test.Examples.OC Feature = String -Artifact : 𝔸 -Artifact = String , String._≟_ open CCC-to-NCC using (⌈_⌉; numberOfAlternatives≤⌈_⌉) -CCC→NCC-Exact : (e : CCC Feature ∞ Artifact) → NCC Feature ⌈ e ⌉ ∞ Artifact +CCC→NCC-Exact : (e : CCC Feature ∞ STRING) → NCC Feature ⌈ e ⌉ ∞ STRING CCC→NCC-Exact e = CCC-to-NCC.translate ⌈ e ⌉ e (numberOfAlternatives≤⌈_⌉ e) @@ -75,14 +73,14 @@ translate e E₂-name translator show = return-level e' do pretty-e' = show e' compile : ∀ {VL₁ VL₂ : VariabilityLanguage Variant} - → Expression VL₁ Artifact + → Expression VL₁ STRING → String → LanguageCompiler VL₁ VL₂ - → (Expression VL₂ Artifact → Lines) - → Lines' (Expression VL₂ Artifact) + → (Expression VL₂ STRING → Lines) + → Lines' (Expression VL₂ STRING) compile e VL₂-name compiler show = translate e VL₂-name (LanguageCompiler.compile compiler) show -round-trip : Experiment (CCC Feature ∞ (String , String._≟_)) +round-trip : Experiment (CCC Feature ∞ STRING) getName round-trip = "Translate CCC in one round-trip into equally expressive variability languages" get round-trip ex@(name ≔ ccc) = do [ Center ]> "CCC, original expression" @@ -102,10 +100,10 @@ get round-trip ex@(name ≔ ccc) = do linebreak -ex-trivial : Example (CCC Feature ∞ Artifact) +ex-trivial : Example (CCC Feature ∞ STRING) ex-trivial = "trivial" ≔ "D" ⟨ "l" -< [] >- ∷ "r" -< [] >- ∷ [] ⟩ -ex-sandwich : Example (CCC Feature ∞ Artifact) +ex-sandwich : Example (CCC Feature ∞ STRING) ex-sandwich = "Sandwich Recipe" ≔ "🍞" -< "Salad?" @@ -129,5 +127,5 @@ ex-sandwich = "Sandwich Recipe" ≔ ∷ [] >- -examples : List (Example (CCC Feature ∞ Artifact)) +examples : List (Example (CCC Feature ∞ STRING)) examples = ex-trivial ∷ ex-sandwich ∷ [] diff --git a/src/Vatras/Translation/Lang/FST-to-OC.lagda.md b/src/Vatras/Translation/Lang/FST-to-OC.lagda.md index 9a960eba..8c14af20 100644 --- a/src/Vatras/Translation/Lang/FST-to-OC.lagda.md +++ b/src/Vatras/Translation/Lang/FST-to-OC.lagda.md @@ -1,7 +1,7 @@ # Option calculus is not as expressive as feature structure trees ```agda -open import Vatras.Framework.Definitions using (𝔽; 𝔸) +open import Vatras.Framework.Definitions using (𝔽; NAT) open import Relation.Binary using (DecidableEquality) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_; refl) @@ -25,7 +25,7 @@ open import Data.List.Relation.Binary.Sublist.Heterogeneous using ([]; _∷_; _ open import Data.List.Relation.Unary.All using ([]; _∷_) open import Data.List.Relation.Unary.AllPairs using ([]; _∷_) open import Data.Maybe using (nothing; just) -open import Data.Nat using (_≟_; ℕ; _+_; _≤_; z≤n; s≤s) +open import Data.Nat using (_+_; _≤_; z≤n; s≤s) import Data.Nat.Properties as ℕ open import Data.Product using (_,_; ∃-syntax) open import Data.Sum as Sum using (_⊎_; inj₁; inj₂) @@ -45,9 +45,6 @@ open FST.Impose using (SPL; _◀_; _::_; _⊚_) V = Rose ∞ open import Vatras.Framework.Relation.Expressiveness V using (_⋡_) - -A : 𝔸 -A = ℕ , _≟_ ``` ## Counter-Example @@ -72,7 +69,7 @@ Hence, at least one inner child is required for a valid variant of this counter-example SPL (or no children in which case there is only the root). As FSTs require a fixed root artifact, the outermost artifact is always set to 0. ```agda -counter-example : SPL A +counter-example : SPL NAT counter-example = 0 ◀ ( (f₁ :: ((0 -< 0 -< [] >- ∷ [] >- ∷ []) ⊚ ([] ∷ [] , (([] ∷ []) , (([] , []) ∷ [])) ∷ []))) ∷ (f₂ :: ((0 -< 1 -< [] >- ∷ [] >- ∷ []) ⊚ ([] ∷ [] , (([] ∷ []) , (([] , []) ∷ [])) ∷ []))) @@ -132,13 +129,13 @@ from `counter-example`. Agda can't compute with `==ꟳ` so we need the following two lemmas to sort out invalid definitions of `==ꟳ`. Then Agda can actually compute the semantics of `counter-example`. ```agda -compute-counter-example-c₁ : {v : Rose ∞ A} → FST.⟦ counter-example ⟧ c₁ ≡ v → 0 -< 0 -< 0 -< [] >- ∷ [] >- ∷ [] >- ≡ v +compute-counter-example-c₁ : {v : Rose ∞ NAT} → FST.⟦ counter-example ⟧ c₁ ≡ v → 0 -< 0 -< 0 -< [] >- ∷ [] >- ∷ [] >- ≡ v compute-counter-example-c₁ p with f₁ ==ꟳ f₁ | f₂ ==ꟳ f₁ | c₁ f₁ in c₁-f₁ | c₁ f₂ in c₁-f₂ compute-counter-example-c₁ p | yes f₁≡f₁ | yes f₂≡f₁ | _ | _ = ⊥-elim (f₁≢f₂ (Eq.sym f₂≡f₁)) compute-counter-example-c₁ p | yes f₁≡f₁ | no f₂≢f₁ | true | false = p compute-counter-example-c₁ p | no f₁≢f₁ | _ | _ | _ = ⊥-elim (f₁≢f₁ refl) -compute-counter-example-c₂ : {v : Rose ∞ A} → FST.⟦ counter-example ⟧ c₂ ≡ v → 0 -< 0 -< 1 -< [] >- ∷ [] >- ∷ [] >- ≡ v +compute-counter-example-c₂ : {v : Rose ∞ NAT} → FST.⟦ counter-example ⟧ c₂ ≡ v → 0 -< 0 -< 1 -< [] >- ∷ [] >- ∷ [] >- ≡ v compute-counter-example-c₂ p with f₁ ==ꟳ f₂ | f₂ ==ꟳ f₂ | c₂ f₁ in c₂-f₁ | c₂ f₂ in c₂-f₂ compute-counter-example-c₂ p | yes f₁≡f₂ | _ | _ | _ = ⊥-elim (f₁≢f₂ f₁≡f₂) compute-counter-example-c₂ p | no f₁≢f₂ | yes f₂≡f₂ | false | true = p @@ -178,7 +175,7 @@ they must be included in both variants. Simultaneously, this excludes the artifacts themselves because each configuration excludes one of them. ```agda shared-artifact : ∀ {F' : 𝔽} - → (e : OC F' ∞ A) + → (e : OC F' ∞ NAT) → (c₁ c₂ : OC.Configuration F') → just (0 -< rose-leaf 0 ∷ [] >-) ≡ OC.⟦ e ⟧ₒ c₁ → just (0 -< rose-leaf 1 ∷ [] >-) ≡ OC.⟦ e ⟧ₒ c₂ @@ -210,9 +207,9 @@ only prove that there is at least one more artifact. ```agda more-artifacts : ∀ {F' : 𝔽} - → (cs : List (OC F' ∞ A)) + → (cs : List (OC F' ∞ NAT)) → (cₙ : OC.Configuration F') - → (v : Rose ∞ A) + → (v : Rose ∞ NAT) → 0 -< v ∷ [] >- ∷ [] ≡ OC.⟦ cs ⟧ₒ-recurse cₙ → 1 ≤ length (OC.⟦ cs ⟧ₒ-recurse (all-oc true)) more-artifacts (a -< cs' >- ∷ cs) cₙ v p = s≤s z≤n @@ -255,7 +252,7 @@ variants forcing it to have exactly one shape. In this case, called under the intersection of `c₁` and `c₂`. ```agda induction : ∀ {F' : 𝔽} - → (cs : List (OC F' ∞ A)) + → (cs : List (OC F' ∞ NAT)) → (c₁ c₂ c₃ : OC.Configuration F') → 0 -< rose-leaf 0 ∷ [] >- ∷ [] ≡ OC.⟦ cs ⟧ₒ-recurse c₁ → 0 -< rose-leaf 1 ∷ [] >- ∷ [] ≡ OC.⟦ cs ⟧ₒ-recurse c₂ @@ -297,7 +294,7 @@ expression. The proof evaluates the FST expression on all relevant configurations which results in contradictions in every case. ```agda impossible : ∀ {F' : 𝔽} - → (cs : List (OC F' ∞ A)) + → (cs : List (OC F' ∞ NAT)) → (c₁ c₂ : OC.Configuration F') → ((c : OC.Configuration F') → ∃[ c' ] OC.⟦ Root 0 cs ⟧ c ≡ FST.⟦ counter-example ⟧ c') → 2 ≤ length (OC.⟦ cs ⟧ₒ-recurse (all-oc true)) diff --git a/src/Vatras/Translation/Lang/OC-to-FST.agda b/src/Vatras/Translation/Lang/OC-to-FST.agda index 3ff32227..879c1061 100644 --- a/src/Vatras/Translation/Lang/OC-to-FST.agda +++ b/src/Vatras/Translation/Lang/OC-to-FST.agda @@ -3,7 +3,7 @@ This module provides an example of neighboring artifacts with equal atoms and uses the `cannotEncodeNeighbors` lemma from `FST` to show that there are expressions in `WFOC` that cannot be encoded in `FST`. -} -open import Vatras.Framework.Definitions using (𝔽; 𝔸) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT) module Vatras.Translation.Lang.OC-to-FST (F : 𝔽) where @@ -23,10 +23,7 @@ open import Vatras.Lang.FST.Properties using (cannotEncodeNeighbors) V = Rose ∞ open import Vatras.Framework.Relation.Expressiveness V using (_⋡_) -A : 𝔸 -A = ℕ , _≟_ - -neighbors : WFOC F ∞ A +neighbors : WFOC F ∞ NAT neighbors = Root zero (zero -< [] >- ∷ zero -< [] >- ∷ []) FST⋡WFOC : FSTL F ⋡ WFOCL F From 26efb57877242ef0bbdd1cb54da7d4f66b865d4f Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sun, 13 Jul 2025 12:05:23 +0200 Subject: [PATCH 25/82] =?UTF-8?q?Redefine=20=F0=9D=94=B8=20as=20a=20record?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This allows to easily add more fields. --- src/Vatras/Framework/Definitions.agda | 34 ++++++++++--------- src/Vatras/Framework/Variants.agda | 4 +-- src/Vatras/Lang/FST.lagda.md | 2 +- .../Test/Experiments/FST-Experiments.agda | 11 ++++-- .../Translation/Lang/2CC/Idempotence.agda | 4 +-- 5 files changed, 31 insertions(+), 24 deletions(-) diff --git a/src/Vatras/Framework/Definitions.agda b/src/Vatras/Framework/Definitions.agda index c54dfa09..77cdf4f2 100644 --- a/src/Vatras/Framework/Definitions.agda +++ b/src/Vatras/Framework/Definitions.agda @@ -1,7 +1,9 @@ module Vatras.Framework.Definitions where open import Data.Maybe using (Maybe; just) +open import Data.Nat as ℕ using (ℕ) open import Data.Product using (_×_; Σ; Σ-syntax; proj₁; proj₂) renaming (_,_ to _and_) +open import Data.String as String using (String) open import Data.Unit using (⊤; tt) public open import Function using (id; _∘_) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≗_; refl) @@ -20,12 +22,12 @@ the core definitions because it is quite reasonable. Any actual data we can think of to plug in here (e.g., strings, tokens or nodes of an abstract syntax tree) can be checked for equality. -} -𝔸 : Set₁ -𝔸 = Σ Set DecidableEquality - --- retrieve the set of atoms from an atom type 𝔸 -atoms : 𝔸 → Set -atoms = proj₁ +record 𝔸 : Set₁ where + no-eta-equality + field + atoms : Set + atomsEqual? : DecidableEquality atoms +open 𝔸 public {-| Variant Language. @@ -63,14 +65,14 @@ and hence expressions are parameterized in the type of this atomic data. 𝔼 = 𝔸 → Set₁ -- some default atoms -module _ where - open import Data.String using (String; _≟_) - - STRING : 𝔸 - STRING = String and _≟_ - -module _ where - open import Data.Nat using (ℕ; _≟_) +STRING : 𝔸 +STRING = record + { atoms = String + ; atomsEqual? = String._≟_ + } - NAT : 𝔸 - NAT = ℕ and _≟_ +NAT : 𝔸 +NAT = record + { atoms = ℕ + ; atomsEqual? = ℕ._≟_ + } diff --git a/src/Vatras/Framework/Variants.agda b/src/Vatras/Framework/Variants.agda index 29d957bd..8b6994c8 100644 --- a/src/Vatras/Framework/Variants.agda +++ b/src/Vatras/Framework/Variants.agda @@ -16,7 +16,7 @@ open Eq.≡-Reasoning open import Function using (id; _∘_; flip) open import Size using (Size; ↑_; ∞) -open import Vatras.Framework.Definitions using (𝕍; 𝔸; atoms) +open import Vatras.Framework.Definitions using (𝕍; 𝔸; atoms; atomsEqual?) open import Vatras.Framework.VariabilityLanguage open import Vatras.Framework.Compiler using (LanguageCompiler) open LanguageCompiler @@ -155,6 +155,6 @@ open import Data.Bool using (Bool; true) open import Data.List using (or) has-atom : ∀ {A i} → atoms A → Rose i A → Bool -has-atom {A , _≟_} a (b -< cs >-) with a ≟ b +has-atom {A} a (b -< cs >-) with atomsEqual? A a b ... | yes refl = true ... | no x = or (map (has-atom b) cs) diff --git a/src/Vatras/Lang/FST.lagda.md b/src/Vatras/Lang/FST.lagda.md index aec5a8b1..7dad7b24 100644 --- a/src/Vatras/Lang/FST.lagda.md +++ b/src/Vatras/Lang/FST.lagda.md @@ -56,7 +56,7 @@ module Impose (AtomSet : 𝔸) where private A = atoms AtomSet - _≟_ = proj₂ AtomSet + _≟_ = atomsEqual? AtomSet fst-leaf : A → FSTA ∞ fst-leaf = rose-leaf diff --git a/src/Vatras/Test/Experiments/FST-Experiments.agda b/src/Vatras/Test/Experiments/FST-Experiments.agda index 9aadf628..d96d1f9c 100644 --- a/src/Vatras/Test/Experiments/FST-Experiments.agda +++ b/src/Vatras/Test/Experiments/FST-Experiments.agda @@ -16,7 +16,7 @@ open import Vatras.Test.Example open import Vatras.Test.Experiment open import Vatras.Show.Lines hiding (map) open import Vatras.Util.ShowHelpers -open import Data.String using (String; _<+>_; _++_) renaming (_≟_ to _≟ˢ_) +open import Data.String as String using (String; _<+>_; _++_) renaming (_≟_ to _≟ˢ_) open import Vatras.Framework.Variants using (show-rose) @@ -66,7 +66,12 @@ module Java where _≟-ast_ : DecidableEquality ASTNode _≟-ast_ = _≟ˢ_ - open FST.Impose {String} (ASTNode , _≟-ast_) + A : 𝔸 + A = record + { atoms = ASTNode + ; atomsEqual? = _≟-ast_ + } + open FST.Impose {String} A module Calculator where fname-Add = "Add" @@ -120,4 +125,4 @@ module Java where toy-calculator-experiment = let eq = _≟-ast_ in - exp String (ASTNode , eq) id id (pick-all ∷ pick-only eq fname-Add ∷ []) + exp String A id id (pick-all ∷ pick-only eq fname-Add ∷ []) diff --git a/src/Vatras/Translation/Lang/2CC/Idempotence.agda b/src/Vatras/Translation/Lang/2CC/Idempotence.agda index de305e44..812b5e6e 100644 --- a/src/Vatras/Translation/Lang/2CC/Idempotence.agda +++ b/src/Vatras/Translation/Lang/2CC/Idempotence.agda @@ -1,4 +1,4 @@ -open import Vatras.Framework.Definitions using (𝔸; 𝔽) +open import Vatras.Framework.Definitions using (𝔸; 𝔽; atomsEqual?) open import Relation.Binary.Definitions using (DecidableEquality) module Vatras.Translation.Lang.2CC.Idempotence (Dimension : 𝔽) (_==_ : DecidableEquality Dimension) where @@ -22,7 +22,7 @@ open import Vatras.Lang.All open 2CC _≟_ : ∀ {i : Size} {A : 𝔸} → DecidableEquality (2CC Dimension i A) -_≟_ {A = _ , _≟ₐ_} (a₁ -< cs₁ >-) (a₂ -< cs₂ >-) with a₁ ≟ₐ a₂ | List.≡-dec _≟_ cs₁ cs₂ +_≟_ {A = A} (a₁ -< cs₁ >-) (a₂ -< cs₂ >-) with atomsEqual? A a₁ a₂ | List.≡-dec _≟_ cs₁ cs₂ (a₁ -< cs₁ >-) ≟ (a₂ -< cs₂ >-) | yes a₁≡a₂ | yes cs₁≡cs₂ = yes (Eq.cong₂ _-<_>- a₁≡a₂ cs₁≡cs₂) (a₁ -< cs₁ >-) ≟ (a₂ -< cs₂ >-) | yes a₁≡a₂ | no cs₁≢cs₂ = no λ where refl → cs₁≢cs₂ refl (a₁ -< cs₁ >-) ≟ (a₂ -< cs₂ >-) | no a₁≢a₂ | _ = no λ where refl → a₁≢a₂ refl From a70486c46b8e812e2605400687652905a90ad5ac Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sun, 13 Jul 2025 14:14:59 +0200 Subject: [PATCH 26/82] Implement atom sizes --- src/Vatras/Framework/Definitions.agda | 10 +++++ .../SyntacticExpressiveness/2CC- , 1 2CC.2CC.-< [] >- ⟩ ∷ e₁-cs n (suc D) -e₁ : ℕ → 2CC.2CC ∞ NAT +e₁ : ℕ → 2CC.2CC ∞ NAT' e₁ n = 0 2CC.2CC.-< e₁-cs n zero >- size-e₁-cs : ∀ n D → List.sum (List.map size2CC (e₁-cs n D)) ≡ n * 3 @@ -48,7 +48,7 @@ size-e₁-cs (suc n) D = Eq.cong (3 +_) (size-e₁-cs n (suc D)) size-e₁ : ∀ n → size2CC (e₁ n) ≡ 1 + n * 3 size-e₁ n = Eq.cong suc (size-e₁-cs n zero) -variants-cs : ∀ n → Fin (2 ^ n) → List (Rose ∞ NAT) +variants-cs : ∀ n → Fin (2 ^ n) → List (Rose ∞ NAT') variants-cs zero zero = [] variants-cs (suc n) i with Fin.toℕ i - ∷ variants-cs n (Fin.fromℕ< i<2^n) @@ -112,14 +112,14 @@ variants⊆e₁ n i = config n i' , Eq.cong (0 Rose.-<_>-) (go n i' zero λ o where j' = Eq.subst Fin (ℕ.+-identityʳ (2 ^ m)) (Fin.reduce≥ j (ℕ.≮⇒≥ k≮2^m)) -ADT-leafs : ADT.ADT NAT → List⁺ (Rose ∞ NAT) +ADT-leafs : ADT.ADT NAT' → List⁺ (Rose ∞ NAT') ADT-leafs (ADT.ADT.leaf v) = v ∷ [] ADT-leafs (D ADT.ADT.⟨ l , r ⟩) = ADT-leafs l List⁺.⁺++⁺ ADT-leafs r -ADT-leaf-count : ADT.ADT NAT → ℕ +ADT-leaf-count : ADT.ADT NAT' → ℕ ADT-leaf-count e₂ = List⁺.length (ADT-leafs e₂) -ADT-leaf-count-lemma : ∀ D → (l r : ADT.ADT NAT) → ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) ≡ ADT-leaf-count l + ADT-leaf-count r +ADT-leaf-count-lemma : ∀ D → (l r : ADT.ADT NAT') → ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) ≡ ADT-leaf-count l + ADT-leaf-count r ADT-leaf-count-lemma D l r = begin ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) @@ -133,7 +133,7 @@ ADT-leaf-count-lemma D l r = where open Eq.≡-Reasoning -leafs-≤-size : (e₂ : ADT.ADT NAT) → ADT-leaf-count e₂ ≤ sizeADT e₂ +leafs-≤-size : (e₂ : ADT.ADT NAT') → ADT-leaf-count e₂ ≤ sizeADT e₂ leafs-≤-size (ADT.ADT.leaf v) = s≤s z≤n leafs-≤-size (D ADT.ADT.⟨ l , r ⟩) = begin @@ -150,10 +150,10 @@ leafs-≤-size (D ADT.ADT.⟨ l , r ⟩) = where open ℕ.≤-Reasoning -listToIndexedSet : (vs : List⁺ (Rose ∞ NAT)) → VariantGenerator (pred (List⁺.length vs)) +listToIndexedSet : (vs : List⁺ (Rose ∞ NAT')) → VariantGenerator (pred (List⁺.length vs)) listToIndexedSet vs i = List.lookup (List⁺.toList vs) (Eq.subst Fin (ℕ.suc-pred (List⁺.length vs)) i) -_≟ᵥ_ : ∀ {i} → (v₁ v₂ : Rose i NAT) → Dec (v₁ ≡ v₂) +_≟ᵥ_ : ∀ {i} → (v₁ v₂ : Rose i NAT') → Dec (v₁ ≡ v₂) (a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) with a₁ ℕ.≟ a₂ | List.≡-dec _≟ᵥ_ cs₁ cs₂ (a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | no a₁≢a₂ | _ = no λ where refl → a₁≢a₂ refl (a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | yes a₁≡a₂ | no cs₁≢cs₂ = no (λ where refl → cs₁≢cs₂ refl) @@ -202,7 +202,7 @@ variants-unique n = AllPairs.tabulate⁺ {f = variants n} go go : {i j : Fin (suc (pred (2 ^ n)))} → i ≢ j → variants n i ≢ variants n j go {i} {j} i≢j vs-i≡vs-j = variants-cs-unique n (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i) (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) j) (i≢j ∘ Eq.subst-injective (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}})) (proj₂ (Rose-injective vs-i≡vs-j)) -IndexedSet-⊆⇒List-⊆ : ∀ {n} (gen : VariantGenerator n) (l : List⁺ (Rose ∞ NAT)) → gen ⊆ listToIndexedSet l → List.tabulate gen List.⊆ List⁺.toList l +IndexedSet-⊆⇒List-⊆ : ∀ {n} (gen : VariantGenerator n) (l : List⁺ (Rose ∞ NAT')) → gen ⊆ listToIndexedSet l → List.tabulate gen List.⊆ List⁺.toList l IndexedSet-⊆⇒List-⊆ gen l gen⊆l {x} (here refl) with gen⊆l zero ... | i , x∈l = Eq.subst (List._∈ (List⁺.toList l)) (Eq.sym x∈l) (List.∈-lookup {xs = List⁺.toList l} i) IndexedSet-⊆⇒List-⊆ {suc n} gen l gen⊆l {x} (there x∈gen) = IndexedSet-⊆⇒List-⊆ {n} (gen ∘ suc) l (gen⊆l ∘ suc) x∈gen @@ -322,7 +322,7 @@ lemma (suc m) e₂ (e₁⊆e₂ , e₂⊆e₁) = n = suc m 2CC≱ADT : Sized2CC ≱Size SizedADT -2CC≱ADT n = NAT , e₁ (4 * n) , lemma n +2CC≱ADT n = NAT' , e₁ (4 * n) , lemma n 2CC-) = + rename-preserves-size2CC {A = A} (a 2CC.2CC.-< cs >-) = begin size2CC F₁ (rename f (a 2CC.2CC.-< cs >-)) ≡⟨⟩ size2CC F₁ (a 2CC.2CC.-< List.map (rename f) cs >-) ≡⟨⟩ - suc (List.sum (List.map (size2CC F₁) (List.map (rename f) cs))) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ - suc (List.sum (List.map (size2CC F₁ ∘ rename f) cs)) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-cong rename-preserves-size2CC cs) ⟩ - suc (List.sum (List.map (size2CC F₂) cs)) + suc (atomSize A a + List.sum (List.map (size2CC F₁) (List.map (rename f) cs))) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ + suc (atomSize A a + List.sum (List.map (size2CC F₁ ∘ rename f) cs)) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-cong rename-preserves-size2CC cs) ⟩ + suc (atomSize A a + List.sum (List.map (size2CC F₂) cs)) ≡⟨⟩ size2CC F₂ (a 2CC.2CC.-< cs >-) ∎ @@ -72,17 +72,17 @@ module _ {F₁ F₂ : 𝔽} (f : F₂ → F₁) (f⁻¹ : F₁ → F₂) (f⁻¹ 2CC→NCC-preserves-size : ∀ {i : Size} {A : 𝔸} {F : 𝔽} → (e : 2CC.2CC F i A) → sizeNCC F (sucs zero) (2CC→NCC e) ≡ size2CC F e -2CC→NCC-preserves-size {F = F} (a 2CC.2CC.-< cs >-) = +2CC→NCC-preserves-size {A = A} {F = F} (a 2CC.2CC.-< cs >-) = begin sizeNCC F (sucs zero) (2CC→NCC (a 2CC.2CC.-< cs >-)) ≡⟨⟩ sizeNCC F (sucs zero) (a NCC.NCC.-< List.map 2CC→NCC cs >-) ≡⟨⟩ - suc (List.sum (List.map (sizeNCC F (sucs zero)) (List.map 2CC→NCC cs))) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ - suc (List.sum (List.map (sizeNCC F (sucs zero) ∘ 2CC→NCC) cs)) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-cong 2CC→NCC-preserves-size cs) ⟩ - suc (List.sum (List.map (size2CC F) cs)) + suc (atomSize A a + List.sum (List.map (sizeNCC F (sucs zero)) (List.map 2CC→NCC cs))) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ + suc (atomSize A a + List.sum (List.map (sizeNCC F (sucs zero) ∘ 2CC→NCC) cs)) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-cong 2CC→NCC-preserves-size cs) ⟩ + suc (atomSize A a + List.sum (List.map (size2CC F) cs)) ≡⟨⟩ size2CC F (a 2CC.2CC.-< cs >-) ∎ @@ -110,17 +110,17 @@ module _ {F₁ F₂ : 𝔽} (f : F₂ → F₁) (f⁻¹ : F₁ → F₂) (f⁻¹ NCC→2CC-preserves-size : ∀ {i : Size} {A : 𝔸} {F : 𝔽} → (e : NCC.NCC F (sucs zero) i A) → size2CC F (NCC→2CC e) ≡ sizeNCC F (sucs zero) e -NCC→2CC-preserves-size {F = F} (a NCC.NCC.-< cs >-) = +NCC→2CC-preserves-size {A = A} {F = F} (a NCC.NCC.-< cs >-) = begin size2CC F (NCC→2CC (a NCC.NCC.-< cs >-)) ≡⟨⟩ size2CC F (a 2CC.2CC.-< List.map NCC→2CC cs >-) ≡⟨⟩ - suc (List.sum (List.map (size2CC F) (List.map NCC→2CC cs))) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ - suc (List.sum (List.map (size2CC F ∘ NCC→2CC) cs)) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-cong NCC→2CC-preserves-size cs) ⟩ - suc (List.sum (List.map (sizeNCC F (sucs zero)) cs)) + suc (atomSize A a + List.sum (List.map (size2CC F) (List.map NCC→2CC cs))) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ + suc (atomSize A a + List.sum (List.map (size2CC F ∘ NCC→2CC) cs)) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-cong NCC→2CC-preserves-size cs) ⟩ + suc (atomSize A a + List.sum (List.map (sizeNCC F (sucs zero)) cs)) ≡⟨⟩ sizeNCC F (sucs zero) (a NCC.NCC.-< cs >-) ∎ diff --git "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" index a178b026..6a5049e5 100644 --- "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" +++ "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" @@ -1,4 +1,4 @@ -open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms; atomSize) module Vatras.SyntacticExpressiveness.2CC≤ADT (F : 𝔽) where open import Data.Nat using (suc; _≤_; s≤s; _+_) @@ -25,17 +25,17 @@ ADT→2CC' : LanguageCompiler ADT.ADTL 2CC.2CCL ADT→2CC' = ADT→2CC encoder lemma2 : ∀ {i : Size} {A : 𝔸} (v : Rose i A) → size2CC (encode v) ≤ sizeRose v -lemma2 (a Rose.-< cs >-) = +lemma2 {A = A} (a Rose.-< cs >-) = begin size2CC (encode (a Rose.-< cs >-)) ≡⟨⟩ size2CC (a 2CC.2CC.-< List.map encode cs >-) ≡⟨⟩ - suc (List.sum (List.map size2CC (List.map encode cs))) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ - suc (List.sum (List.map (size2CC ∘ encode) cs)) - ≤⟨ s≤s (List.sum-map-≤ (size2CC ∘ encode) sizeRose cs lemma2) ⟩ - suc (List.sum (List.map sizeRose cs)) + suc (atomSize A a + List.sum (List.map size2CC (List.map encode cs))) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ + suc (atomSize A a + List.sum (List.map (size2CC ∘ encode) cs)) + ≤⟨ s≤s (ℕ.+-monoʳ-≤ (atomSize A a) (List.sum-map-≤ (size2CC ∘ encode) sizeRose cs lemma2)) ⟩ + suc (atomSize A a + List.sum (List.map sizeRose cs)) ≡⟨⟩ sizeRose (a Rose.-< cs >-) ∎ diff --git "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" index 9eaa9f0e..19a1b251 100644 --- "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" @@ -1,4 +1,4 @@ -open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms; atomSize) open import Vatras.Util.Nat.AtLeast as ℕ≥ using (ℕ≥; sucs) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl; _≢_) open import Data.Nat as ℕ using (ℕ; zero; suc; pred; _≤_; z≤n; s≤s; _<_; _>_; _+_; _∸_; _*_; _-) = +translate-size {A = A} (a CCC.CCC.-< cs >-) = begin-strict size2CC (F × ℕ) (translate (a CCC.CCC.-< cs >-)) ≡⟨⟩ size2CC (F × ℕ) (a 2CC.2CC.-< List.map translate cs >-) ≡⟨⟩ - suc (List.sum (List.map (size2CC (F × ℕ)) (List.map translate cs))) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ - suc (List.sum (List.map (size2CC (F × ℕ) ∘ translate) cs)) - ≤⟨ s≤s (List.sum-map-≤ (size2CC (F × ℕ) ∘ translate) (λ c → 2 * sizeCCC F c) cs (ℕ.<⇒≤ ∘ translate-size)) ⟩ - suc (List.sum (List.map (λ c → 2 * sizeCCC F c) cs)) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟩ - suc (List.sum (List.map (2 *_) (List.map (sizeCCC F) cs))) - ≡⟨ Eq.cong suc (List.sum-* 2 (List.map (sizeCCC F) cs)) ⟩ - suc (2 * (List.sum (List.map (sizeCCC F) cs))) + suc (atomSize A a + List.sum (List.map (size2CC (F × ℕ)) (List.map translate cs))) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ + suc (atomSize A a + List.sum (List.map (size2CC (F × ℕ) ∘ translate) cs)) + ≤⟨ s≤s (ℕ.+-monoʳ-≤ (atomSize A a) (List.sum-map-≤ (size2CC (F × ℕ) ∘ translate) (λ c → 2 * sizeCCC F c) cs (ℕ.<⇒≤ ∘ translate-size))) ⟩ + suc (atomSize A a + List.sum (List.map (λ c → 2 * sizeCCC F c) cs)) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟩ + suc (atomSize A a + List.sum (List.map (2 *_) (List.map (sizeCCC F) cs))) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + x)) (List.sum-* 2 (List.map (sizeCCC F) cs)) ⟩ + suc (atomSize A a + 2 * List.sum (List.map (sizeCCC F) cs)) + ≤⟨ s≤s (ℕ.+-monoˡ-≤ (2 * List.sum (List.map (sizeCCC F) cs)) (ℕ.m≤m+n (atomSize A a) (1 * atomSize A a))) ⟩ + suc (atomSize A a + 1 * atomSize A a + 2 * List.sum (List.map (sizeCCC F) cs)) ≡⟨⟩ - 1 + 2 * (List.sum (List.map (sizeCCC F) cs)) - <⟨ ℕ.+-monoˡ-< (2 * (List.sum (List.map (sizeCCC F) cs))) {x = 1} {y = 2} (ℕ.n<1+n 1) ⟩ - 2 + 2 * (List.sum (List.map (sizeCCC F) cs)) - ≡⟨ ℕ.*-suc 2 (List.sum (List.map (sizeCCC F) cs)) ⟨ - 2 * (suc (List.sum (List.map (sizeCCC F) cs))) + suc (2 * atomSize A a + 2 * List.sum (List.map (sizeCCC F) cs)) + ≡⟨ Eq.cong suc (ℕ.*-distribˡ-+ 2 (atomSize A a) (List.sum (List.map (sizeCCC F) cs))) ⟨ + 1 + 2 * (atomSize A a + List.sum (List.map (sizeCCC F) cs)) + <⟨ ℕ.+-monoˡ-< (2 * (atomSize A a + List.sum (List.map (sizeCCC F) cs))) {x = 1} {y = 2} (ℕ.n<1+n 1) ⟩ + 2 + 2 * (atomSize A a + List.sum (List.map (sizeCCC F) cs)) + ≡⟨ ℕ.*-suc 2 (atomSize A a + List.sum (List.map (sizeCCC F) cs)) ⟨ + 2 * (suc (atomSize A a + List.sum (List.map (sizeCCC F) cs))) ≡⟨⟩ 2 * sizeCCC F (a CCC.CCC.-< cs >-) ∎ diff --git "a/src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" "b/src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" index ad8d83dd..ac20d16f 100644 --- "a/src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" @@ -1,7 +1,7 @@ -open import Vatras.Framework.Definitions using (𝔽; 𝔸) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atomSize) module Vatras.SyntacticExpressiveness.CCC≤NCC (F : 𝔽) where -open import Data.Nat as ℕ using (suc; _≤_; s≤s) +open import Data.Nat as ℕ using (suc; _≤_; s≤s; _+_) import Data.Nat.Properties as ℕ import Data.List as List open import Data.Vec as Vec using (_∷_) @@ -25,17 +25,17 @@ open import Vatras.SyntacticExpressiveness using (_≤Size_) open import Vatras.SyntacticExpressiveness.Sizes F using (SizedNCC; sizeNCC; SizedCCC; sizeCCC) lemma : ∀ {i : Size} {A : 𝔸} (n : ℕ≥ 2) (ncc : NCC.NCC n i A) → sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc) ≤ sizeNCC n ncc -lemma (sucs n) (a NCC.NCC.-< cs >-) = +lemma {A = A} (sucs n) (a NCC.NCC.-< cs >-) = begin sizeCCC (LanguageCompiler.compile (NCC→CCC (sucs n)) (a NCC.NCC.-< cs >-)) ≡⟨⟩ sizeCCC (a CCC.CCC.-< List.map (LanguageCompiler.compile (NCC→CCC (sucs n))) cs >-) ≡⟨⟩ - suc (List.sum (List.map sizeCCC (List.map (LanguageCompiler.compile (NCC→CCC (sucs n))) cs))) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-∘ cs) ⟨ - suc (List.sum (List.map (sizeCCC ∘ LanguageCompiler.compile (NCC→CCC (sucs n))) cs)) - ≤⟨ s≤s (List.sum-map-≤ (sizeCCC ∘ LanguageCompiler.compile (NCC→CCC (sucs n))) (sizeNCC (sucs n)) cs (lemma (sucs n))) ⟩ - suc (List.sum (List.map (sizeNCC (sucs n)) cs)) + suc (atomSize A a + List.sum (List.map sizeCCC (List.map (LanguageCompiler.compile (NCC→CCC (sucs n))) cs))) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ + suc (atomSize A a + List.sum (List.map (sizeCCC ∘ LanguageCompiler.compile (NCC→CCC (sucs n))) cs)) + ≤⟨ s≤s (ℕ.+-monoʳ-≤ (atomSize A a) (List.sum-map-≤ (sizeCCC ∘ LanguageCompiler.compile (NCC→CCC (sucs n))) (sizeNCC (sucs n)) cs (lemma (sucs n)))) ⟩ + suc (atomSize A a + List.sum (List.map (sizeNCC (sucs n)) cs)) ≡⟨⟩ sizeNCC (sucs n) (a NCC.NCC.-< cs >-) ∎ diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index fbcbd6fe..7cec7923 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -26,14 +26,14 @@ open import Relation.Nullary.Negation using (¬_) open import Size using (Size; ∞) open import Vatras.Data.EqIndexedSet using (_⊆_; ⊆-trans; _∈_) -open import Vatras.Framework.Definitions using (𝔸; NAT) +open import Vatras.Framework.Definitions using (𝔸; NAT') open import Vatras.Framework.Variants using (Rose; Rose-injective) import Vatras.Util.List as List open import Vatras.Lang.All.Fixed ℕ (Rose ∞) open import Vatras.SyntacticExpressiveness using (_≱Size_) open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST) -open FST.Impose NAT hiding (Unique; _∈_) +open FST.Impose NAT' hiding (Unique; _∈_) -- TODO duplicated from 2CC≤CCC >⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ℕ.≤ᵇ n)) @@ -153,7 +153,7 @@ variant n i = 0 Rose.-< List.applyUpTo (artifact n) i >- → (n j : ℕ) → {a₁ a₂ : ℕ} → (cs₁ : List (FSTA ∞)) - → (cs₂ : List (2CC.2CC i NAT)) + → (cs₂ : List (2CC.2CC i NAT')) → (a₁ Rose.-< cs₁ >-) ∈ 2CC.⟦ a₂ 2CC.2CC.-< cs₂ >- ⟧ → cs₁ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs₂) ∈-children n j cs₁ cs₂ (conf , cs₁≡cs₂) = conf , proj₂ (Rose-injective cs₁≡cs₂) @@ -161,7 +161,7 @@ variant n i = 0 Rose.-< List.applyUpTo (artifact n) i >- artifact-child-count : ∀ {i : Size} → (n j : ℕ) → (a : ℕ) - → (cs : List (2CC.2CC i NAT)) + → (cs : List (2CC.2CC i NAT')) → big-artifact (suc n) j ∈ 2CC.⟦ a 2CC.2CC.-< cs >- ⟧ → List.length cs ≡ 2 artifact-child-count n j a (c₁ ∷ c₂ ∷ []) artifact∈cs = refl @@ -169,8 +169,8 @@ artifact-child-count n j a (c₁ ∷ c₂ ∷ []) artifact∈cs = refl big-artifact-children : ∀ {i : Size} → (n j : ℕ) → (a : ℕ) - → (cs : List (2CC.2CC i NAT)) - → (c : 2CC.2CC i NAT) + → (cs : List (2CC.2CC i NAT')) + → (c : 2CC.2CC i NAT') → c List.∈ cs → big-artifact (suc n) j ∈ 2CC.⟦ a 2CC.2CC.-< cs >- ⟧ → Σ[ j' ∈ ℕ ] big-artifact n j' ∈ 2CC.⟦ c ⟧ @@ -179,7 +179,7 @@ big-artifact-children n j a (x₂ ∷ x₃ ∷ []) .x₃ (there (here refl)) (co big-artifact∈e₂⇒2^n≤e₂ : ∀ {i : Size} → (n j : ℕ) - → (e₂ : 2CC.2CC i NAT) + → (e₂ : 2CC.2CC i NAT') → big-artifact n j ∈ 2CC.⟦ e₂ ⟧ → 2 ^ suc n ∸ 1 ≤ size2CC e₂ big-artifact∈e₂⇒2^n≤e₂ zero j e₂ artifact∈e₂ = 1≤size2CC e₂ @@ -237,7 +237,7 @@ big-artifact∈e₂⇒2^n≤e₂ (suc n) j (D 2CC.2CC.⟨ l , r ⟩) (conf , art artifact-0∈e₂⇒2^n≤e₂ : ∀ {i : Size} → (n : ℕ) - → (e₂ : 2CC.2CC i NAT) + → (e₂ : 2CC.2CC i NAT') → artifact n zero ∈ 2CC.⟦ e₂ ⟧ → 2 ^ suc n ≤ size2CC e₂ artifact-0∈e₂⇒2^n≤e₂ n (a 2CC.2CC.-< c ∷ [] >-) (conf , artifact≡cs) = @@ -287,7 +287,7 @@ artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs 2^n≤size2CC-artifact : ∀ {i : Size} → (n j : ℕ) → (a : ℕ) - → (cs : List (2CC.2CC i NAT)) + → (cs : List (2CC.2CC i NAT')) → variant n (suc j) ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ → 2 ^ suc n ≤ size2CC (a 2CC.-< cs >-) 2^n≤size2CC-artifact n j a (c ∷ cs) (conf , artifact≡cs) = @@ -309,7 +309,7 @@ artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs impossible-artifact-sizes : ∀ {i : Size} → (n : ℕ) - → (cs : List (2CC.2CC i NAT)) + → (cs : List (2CC.2CC i NAT')) → (cs₁ cs₂ : List (FSTA ∞)) → List.length cs₁ ≢ List.length cs₂ → cs₁ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs) @@ -325,7 +325,7 @@ impossible-artifact-sizes n (c ∷ cs) (c₁ ∷ cs₁) (c₂ ∷ cs₂) cs₁ split-sizes : ∀ {i : Size} → (n : ℕ) → (D : ℕ) - → (l r : 2CC.2CC i NAT) + → (l r : 2CC.2CC i NAT') → (sizes : List ℕ) → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧ → List ℕ × List ℕ @@ -338,7 +338,7 @@ split-sizes n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r | fa split-sizes⊆ : ∀ {i : Size} → (n : ℕ) → (D : ℕ) - → (l r : 2CC.2CC i NAT) + → (l r : 2CC.2CC i NAT') → (sizes : List ℕ) → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧) → ((variant n ∘′ suc ∘′ List.lookup (proj₁ (split-sizes n D l r sizes artifact∈l,r))) ⊆ 2CC.⟦ l ⟧) @@ -364,7 +364,7 @@ split-sizes⊆ n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r | split-sizes-length : ∀ {i : Size} → (n : ℕ) → (D : ℕ) - → (l r : 2CC.2CC i NAT) + → (l r : 2CC.2CC i NAT') → (sizes : List ℕ) → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧) → List.length sizes ≤ List.length (proj₁ (split-sizes n D l r sizes artifact∈l,r)) + List.length (proj₂ (split-sizes n D l r sizes artifact∈l,r)) @@ -388,7 +388,7 @@ split-sizes-length n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡l split-sizes-sublist : ∀ {i : Size} → (n : ℕ) → (D : ℕ) - → (l r : 2CC.2CC i NAT) + → (l r : 2CC.2CC i NAT') → (sizes : List ℕ) → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧) → proj₁ (split-sizes n D l r sizes artifact∈l,r) Sublist.⊆ sizes @@ -401,7 +401,7 @@ split-sizes-sublist n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡ n*2^n≤size2CC : ∀ {i : Size} → (n : ℕ) - → (e₂ : 2CC.2CC i NAT) + → (e₂ : 2CC.2CC i NAT') → (sizes : List ℕ) → Unique sizes → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ e₂ ⟧ @@ -694,8 +694,8 @@ variants⊆e₁ : ∀ (m : ℕ) → (variant m ∘ suc ∘ List.lookup (List.upT variants⊆e₁ m size = Prod.map₂ (Eq.trans (Eq.cong (variant m ∘ suc) (List.lookup-upTo m size))) (variant∈e₁ m (Fin.toℕ size) (ℕ.≤-trans (Fin.toℕ≤n size) (ℕ.≤-reflexive (List.length-upTo m)))) FST≱2CC : SizedFST ≱Size Sized2CC -FST≱2CC zero = NAT , e₁ zero , λ e₂ e₁≅e₂ → 1≤size2CC e₂ -FST≱2CC (suc n) = NAT , e₁ m , λ e₂ e₁≅e₂ → +FST≱2CC zero = NAT' , e₁ zero , λ e₂ e₁≅e₂ → 1≤size2CC e₂ +FST≱2CC (suc n) = NAT' , e₁ m , λ e₂ e₁≅e₂ → begin-strict suc n * sizeFST (e₁ m) ≡⟨ Eq.cong (suc n *_) (size-e₁ m) ⟩ diff --git "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" index 07428af3..0954a458 100644 --- "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" @@ -1,4 +1,4 @@ -open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT') -- TODO abstract over (F : 𝔽) using a map (ℕ → 𝔽) module Vatras.SyntacticExpressiveness.OC≱2CC where @@ -32,15 +32,15 @@ open import Vatras.Lang.All.Fixed ℕ (Rose ∞) open import Vatras.SyntacticExpressiveness using (_≱Size_) open import Vatras.SyntacticExpressiveness.Sizes ℕ using (SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC) -options : ℕ → List (OC.OC ∞ NAT) +options : ℕ → List (OC.OC ∞ NAT') options zero = [] options (suc n) = n OC.❲ suc n OC.-< [] >- ❳ ∷ options n -exponential-oc : ℕ → OC.OC ∞ NAT +exponential-oc : ℕ → OC.OC ∞ NAT' exponential-oc zero = 0 OC.-< [] >- exponential-oc (suc n) = 0 OC.-< exponential-oc n ∷ exponential-oc n ∷ [] >- -oc : ℕ → OC.WFOC ∞ NAT +oc : ℕ → OC.WFOC ∞ NAT' oc n = OC.Root zero (exponential-oc n ∷ options n) size-options : ∀ n → List.sum (List.map sizeOC (options n)) ≡ 2 * n @@ -94,15 +94,15 @@ size-oc n = where open Eq.≡-Reasoning -exponential-artifact : ℕ → Rose ∞ NAT +exponential-artifact : ℕ → Rose ∞ NAT' exponential-artifact zero = 0 Rose.-< [] >- exponential-artifact (suc n) = 0 Rose.-< exponential-artifact n ∷ exponential-artifact n ∷ [] >- -variant-cs : ℕ → List (Rose ∞ NAT) +variant-cs : ℕ → List (Rose ∞ NAT') variant-cs zero = [] variant-cs (suc i) = suc i Rose.-< [] >- ∷ variant-cs i -variant : ℕ → ℕ → Rose ∞ NAT +variant : ℕ → ℕ → Rose ∞ NAT' variant n i = 0 Rose.-< exponential-artifact n ∷ variant-cs i >- length-variants-cs : ∀ n → List.length (variant-cs n) ≡ n @@ -110,7 +110,7 @@ length-variants-cs zero = Eq.refl length-variants-cs (suc n) = Eq.cong suc (length-variants-cs n) variant∈e⇒length-cs - : ∀ {i} (n l : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT)) + : ∀ {i} (n l : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT')) → variant n l ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ → List.length cs ≡ suc l variant∈e⇒length-cs n l a cs (c , v≡e) = @@ -126,7 +126,7 @@ variant∈e⇒length-cs n l a cs (c , v≡e) = open Eq.≡-Reasoning exponential-artifact∈e⇒length-cs - : ∀ {i} (n : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT)) + : ∀ {i} (n : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT')) → exponential-artifact (suc n) ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ → List.length cs ≡ 2 exponential-artifact∈e⇒length-cs n a cs (c , v≡e) = @@ -143,7 +143,7 @@ exponential-artifact∈e⇒length-cs n a cs (c , v≡e) = exponential-big : ∀ {i : Size} (n l : ℕ) - → (2cc : 2CC.2CC i NAT) + → (2cc : 2CC.2CC i NAT') → exponential-artifact n ∈ 2CC.⟦ 2cc ⟧ → 2 ^ (suc n) ∸ 1 ≤ size2CC 2cc exponential-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) with c D @@ -174,7 +174,7 @@ exponential-big (suc n) l (a 2CC.-< c₁ ∷ c₂ ∷ [] >-) (c , v≡2cc) | Eq. exponentially-big : ∀ {i : Size} (n l : ℕ) - → (2cc : 2CC.2CC i NAT) + → (2cc : 2CC.2CC i NAT') → variant n l ∈ 2CC.⟦ 2cc ⟧ → 2 ^ n < size2CC 2cc exponentially-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) with c D @@ -203,7 +203,7 @@ exponentially-big n l (a 2CC.-< c₁ ∷ cs >-) (c , v≡2cc) | Eq.refl = open ℕ.≤-Reasoning partition : ∀ {i : Size} (n D : ℕ) - → (c₁ c₂ : 2CC.2CC i NAT) + → (c₁ c₂ : 2CC.2CC i NAT') → (ls : List ℕ) → Unique ls → All (λ l → variant n l ∈ 2CC.⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) ls @@ -220,7 +220,7 @@ partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls ls₁ , l ∷ ls₂ , there ∘ ls₁⊆ls , Subset.∷⁺ʳ l ls₂⊆ls , Eq.trans (ℕ.+-suc (List.length ls₁) (List.length ls₂)) (Eq.cong suc ls₁+ls₂≡ls) , unique-ls₁ , ls₁∈l , All.anti-mono ls₂⊆ls l∉ls ∷ unique-ls₂ , (c , l≡2cc) ∷ ls₂∈r big : ∀ {i : Size} (n : ℕ) - → (2cc : 2CC.2CC i NAT) + → (2cc : 2CC.2CC i NAT') → (ls : List ℕ) → Unique ls → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) ls @@ -311,7 +311,7 @@ conf n i = i <ᵇ n ⊆⇒All∈ : ∀ {i} n l → l ≤ suc n - → (2cc : 2CC.2CC i NAT) + → (2cc : 2CC.2CC i NAT') → OC.⟦ oc n ⟧ ⊆ 2CC.⟦ 2cc ⟧ → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) (List.upTo l) ⊆⇒All∈ n zero l≤m 2cc oc⊆2cc = [] @@ -338,11 +338,11 @@ conf n i = i <ᵇ n where open ℕ.≤-Reasoning -size2CC>0 : ∀ {i} (2cc : 2CC.2CC i NAT) → 0 < size2CC 2cc +size2CC>0 : ∀ {i} (2cc : 2CC.2CC i NAT') → 0 < size2CC 2cc size2CC>0 (a 2CC.-< cs >-) = s≤s z≤n size2CC>0 (D 2CC.⟨ l , r ⟩) = s≤s z≤n -goal : ∀ {i} (n : ℕ) (2cc : 2CC.2CC i NAT) +goal : ∀ {i} (n : ℕ) (2cc : 2CC.2CC i NAT') → OC.⟦ oc (4 * n) ⟧ ≅ 2CC.⟦ 2cc ⟧ → n * sizeWFOC (oc (4 * n)) < size2CC 2cc goal zero 2cc 2cc≅oc = size2CC>0 2cc @@ -386,4 +386,4 @@ goal n@(suc _) 2cc (oc⊆2cc , 2cc⊆oc) = open ℕ.≤-Reasoning OC≱2CC : SizedWFOC ≱Size Sized2CC -OC≱2CC n = NAT , oc (4 * n) , λ 2cc oc≅2cc → goal n 2cc oc≅2cc +OC≱2CC n = NAT' , oc (4 * n) , λ 2cc oc≅2cc → goal n 2cc oc≅2cc diff --git a/src/Vatras/SyntacticExpressiveness/Sizes.agda b/src/Vatras/SyntacticExpressiveness/Sizes.agda index 20e3ea60..b442ad89 100644 --- a/src/Vatras/SyntacticExpressiveness/Sizes.agda +++ b/src/Vatras/SyntacticExpressiveness/Sizes.agda @@ -1,4 +1,4 @@ -open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms; atomSize) module Vatras.SyntacticExpressiveness.Sizes (F : 𝔽) where open import Data.Nat using (ℕ; suc; zero; _+_) @@ -14,10 +14,10 @@ open import Vatras.Lang.All.Fixed F (Rose ∞) open import Vatras.SyntacticExpressiveness using (SizedLang) sizeRose : ∀ {i : Size} {A : 𝔸} → Rose i A → ℕ -sizeRose (a Rose.-< cs >-) = suc (List.sum (List.map sizeRose cs)) +sizeRose {A = A} (a Rose.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeRose cs)) size2CC : ∀ {i : Size} {A : 𝔸} → 2CC.2CC i A → ℕ -size2CC (a 2CC.2CC.-< cs >-) = suc (List.sum (List.map size2CC cs)) +size2CC {A = A} (a 2CC.2CC.-< cs >-) = suc (atomSize A a + List.sum (List.map size2CC cs)) size2CC (D 2CC.2CC.⟨ l , r ⟩) = suc (size2CC l + size2CC r) Sized2CC : SizedLang @@ -27,7 +27,7 @@ Sized2CC = record } sizeNCC : ∀ {i : Size} {A : 𝔸} (n : ℕ≥ 2) → NCC.NCC n i A → ℕ -sizeNCC n (a NCC.NCC.-< cs >-) = suc (List.sum (List.map (sizeNCC n) cs)) +sizeNCC {A = A} n (a NCC.NCC.-< cs >-) = suc (atomSize A a + List.sum (List.map (sizeNCC n) cs)) sizeNCC n (D NCC.NCC.⟨ cs ⟩) = suc (Vec.sum (Vec.map (sizeNCC n) cs)) SizedNCC : ℕ≥ 2 → SizedLang @@ -37,7 +37,7 @@ SizedNCC n = record } sizeCCC : ∀ {i : Size} {A : 𝔸} → CCC.CCC i A → ℕ -sizeCCC (a CCC.CCC.-< cs >-) = suc (List.sum (List.map sizeCCC cs)) +sizeCCC {A = A} (a CCC.CCC.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeCCC cs)) sizeCCC (D CCC.CCC.⟨ cs ⟩) = suc (List.sum (List.map sizeCCC (List⁺.toList cs))) SizedCCC : SizedLang @@ -57,7 +57,7 @@ SizedADT = record } sizeOC : ∀ {i : Size} {A : 𝔸} → OC.OC i A → ℕ -sizeOC (a OC.-< cs >-) = suc (List.sum (List.map sizeOC cs)) +sizeOC {A = A} (a OC.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeOC cs)) sizeOC (D OC.❲ c ❳) = suc (sizeOC c) sizeWFOC : ∀ {i : Size} {A : 𝔸} → OC.WFOC i A → ℕ diff --git a/src/Vatras/Test/Experiments/FST-Experiments.agda b/src/Vatras/Test/Experiments/FST-Experiments.agda index d96d1f9c..667bdbfe 100644 --- a/src/Vatras/Test/Experiments/FST-Experiments.agda +++ b/src/Vatras/Test/Experiments/FST-Experiments.agda @@ -70,6 +70,7 @@ module Java where A = record { atoms = ASTNode ; atomsEqual? = _≟-ast_ + ; atomSize = String.length } open FST.Impose {String} A From e5d7ed4e2440dd5cb030ff320415119357c87199 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 14 Jul 2025 09:01:02 +0200 Subject: [PATCH 27/82] Take advantage of artifact sizes --- .../SyntacticExpressiveness/2CC_; _+_; _∸_; _*_; _^_) +open import Data.Nat as ℕ using (ℕ; suc; zero; _≤_; _<_; z≤n; s≤s; _>_; _+_; _∸_; _*_; _^_) import Data.Nat.Properties as ℕ open import Data.Fin as Fin using (Fin; zero; suc) import Data.Fin.Properties as Fin @@ -17,6 +17,7 @@ open import Data.List.Relation.Unary.AllPairs using ([]; _∷_) open import Data.List.Relation.Unary.Unique.Propositional using (Unique) import Data.List.Relation.Unary.Unique.Propositional.Properties as Unique open import Data.Product as Prod using (_×_; _,_; proj₁; proj₂; Σ-syntax) +import Data.Product.Properties as Prod open import Data.Unit using (tt) open import Function using (_∘_; _∘′_; const) open import Function.Bundles using (Equivalence) @@ -26,13 +27,20 @@ open import Relation.Nullary.Negation using (¬_) open import Size using (Size; ∞) open import Vatras.Data.EqIndexedSet using (_⊆_; ⊆-trans; _∈_) -open import Vatras.Framework.Definitions using (𝔸; NAT') +open import Vatras.Framework.Definitions using (𝔸; NAT; atomSize) open import Vatras.Framework.Variants using (Rose; Rose-injective) import Vatras.Util.List as List open import Vatras.Lang.All.Fixed ℕ (Rose ∞) open import Vatras.SyntacticExpressiveness using (_≱Size_) open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST) +NAT' : 𝔸 +NAT' = record + { atoms = ℕ × ℕ + ; atomsEqual? = Prod.≡-dec ℕ._≟_ ℕ._≟_ + ; atomSize = proj₂ + } + open FST.Impose NAT' hiding (Unique; _∈_) -- TODO duplicated from 2CC≤CCC @@ -41,33 +49,14 @@ open FST.Impose NAT' hiding (Unique; _∈_) >⇒¬≤ᵇ (s≤s (s≤s m>n)) = >⇒¬≤ᵇ (s≤s m>n) big-artifact : ℕ → ℕ → FSTA ∞ -big-artifact zero i = i Rose.-< [] >- -big-artifact (suc n) i = i Rose.-< big-artifact n i ∷ big-artifact n (i + 2 ^ n) ∷ [] >- +big-artifact n i = (i , 2 ^ n) Rose.-< [] >- artifact : ℕ → ℕ → FSTA ∞ -artifact n zero = 0 Rose.-< big-artifact n zero ∷ [] >- -artifact n (suc i) = suc i Rose.-< [] >- - -big-artifact-≉ : (n i : ℕ) → big-artifact n i ≉ big-artifact n (i + 2 ^ n) -big-artifact-≉ zero i i≡i+2^n = ℕ.1+n≢n (Eq.sym (Eq.trans i≡i+2^n (ℕ.+-comm i 1))) -big-artifact-≉ (suc n) i i≡i+2^n = ℕ.1+n≰n ( - begin-strict - i - <⟨ ℕ.n<1+n i ⟩ - 1 + i - ≡⟨ ℕ.+-comm 1 i ⟩ - i + 1 - ≤⟨ ℕ.+-monoʳ-≤ i (ℕ.m^n>0 2 (suc n)) ⟩ - i + 2 ^ suc n - ≡⟨ i≡i+2^n ⟨ - i - ∎) - where - open ℕ.≤-Reasoning +artifact n zero = (0 , 0) Rose.-< big-artifact n zero ∷ [] >- +artifact n (suc i) = (suc i , 0) Rose.-< [] >- big-artifact-wf : (n i : ℕ) → WellFormed (big-artifact n i) -big-artifact-wf zero i = [] , [] -big-artifact-wf (suc n) i = (big-artifact-≉ n i ∷ []) ∷ [] ∷ [] , big-artifact-wf n i ∷ big-artifact-wf n (i + 2 ^ n) ∷ [] +big-artifact-wf n i = [] , [] artifact-wf : (n i : ℕ) → WellFormed (artifact n i) artifact-wf n zero = [] ∷ [] , big-artifact-wf n zero ∷ [] @@ -77,40 +66,25 @@ feature : ℕ → ℕ → FSF feature n i = (artifact n i ∷ []) ⊚ ([] ∷ [] , artifact-wf n i ∷ []) e₁ : ℕ → SPL -e₁ n = 0 ◀ List.applyUpTo (λ i → i :: feature n i) (suc n) +e₁ n = (0 , 0) ◀ List.applyUpTo (λ i → i :: feature n i) (suc n) size-big-artifact : ∀ (n i : ℕ) - → sizeRose (big-artifact n i) ≡ 2 ^ suc n ∸ 1 -size-big-artifact zero i = refl -size-big-artifact (suc n) i = + → sizeRose (big-artifact n i) ≡ suc (2 ^ n) +size-big-artifact n i = begin - sizeRose (big-artifact (suc n) i) - ≡⟨⟩ - sizeRose (i Rose.-< big-artifact n i ∷ big-artifact n (i + 2 ^ n) ∷ [] >-) + sizeRose (big-artifact n i) ≡⟨⟩ - suc (sizeRose (big-artifact n i) + (sizeRose (big-artifact n (i + 2 ^ n)) + 0)) - ≡⟨ Eq.cong (λ x → suc (sizeRose (big-artifact n i) + x)) (ℕ.+-identityʳ (sizeRose (big-artifact n (i + 2 ^ n)))) ⟩ - suc (sizeRose (big-artifact n i) + (sizeRose (big-artifact n (i + 2 ^ n)))) - ≡⟨ Eq.cong₂ (λ x y → suc (x + y)) (size-big-artifact n i) (size-big-artifact n (i + 2 ^ n)) ⟩ - suc ((2 ^ suc n ∸ 1) + (2 ^ suc n ∸ 1)) - ≡⟨ Eq.cong (_+ (2 ^ suc n ∸ 1)) (ℕ.+-∸-assoc 1 {2 ^ suc n} {1} (ℕ.m^n>0 2 (suc n))) ⟨ - 2 ^ suc n + (2 ^ suc n ∸ 1) - ≡⟨ ℕ.+-∸-assoc (2 ^ suc n) {2 ^ suc n} {1} (ℕ.m^n>0 2 (suc n)) ⟨ - (2 ^ suc n + 2 ^ suc n) ∸ 1 - ≡⟨ Eq.cong (λ x → (2 ^ suc n + x) ∸ 1) (ℕ.+-identityʳ (2 ^ suc n)) ⟨ - (2 ^ suc n + (2 ^ suc n + 0)) ∸ 1 - ≡⟨⟩ - 2 * 2 ^ suc n ∸ 1 - ≡⟨⟩ - 2 ^ suc (suc n) ∸ 1 + suc (2 ^ n) + 0 + ≡⟨ ℕ.+-identityʳ (suc (2 ^ n)) ⟩ + suc (2 ^ n) ∎ where open Eq.≡-Reasoning size-e₁ : ∀ (n : ℕ) - → sizeFST (e₁ n) ≡ 2 + 2 ^ suc n + 2 * n + → sizeFST (e₁ n) ≡ 4 + 2 ^ n + 2 * n size-e₁ n = begin sizeFST (e₁ n) @@ -127,23 +101,21 @@ size-e₁ n = ≡⟨ Eq.cong (λ x → x + List.sum (List.map (λ i → suc (sizeRose (artifact n (suc i)))) (List.upTo n))) (ℕ.+-identityʳ (3 + sizeRose (big-artifact n zero))) ⟩ 3 + sizeRose (big-artifact n zero) + List.sum (List.map (const 2) (List.upTo n)) ≡⟨ Eq.cong (λ x → 3 + x + List.sum (List.map (const 2) (List.upTo n))) (size-big-artifact n zero) ⟩ - 3 + (2 ^ suc n ∸ 1) + List.sum (List.map (const 2) (List.upTo n)) - ≡⟨ Eq.cong (λ x → 3 + (2 ^ suc n ∸ 1) + List.sum x) (List.map-const 2 (List.upTo n)) ⟩ - 3 + (2 ^ suc n ∸ 1) + List.sum (List.replicate (List.length (List.upTo n)) 2) - ≡⟨ Eq.cong (λ x → 3 + (2 ^ suc n ∸ 1) + List.sum (List.replicate x 2)) (List.length-upTo n) ⟩ - 3 + (2 ^ suc n ∸ 1) + List.sum (List.replicate n 2) - ≡⟨ Eq.cong (λ x → 3 + (2 ^ suc n ∸ 1) + x) (List.sum-replicate n 2) ⟩ - 3 + (2 ^ suc n ∸ 1) + n * 2 - ≡⟨ Eq.cong (λ x → 2 + (x + n * 2)) (ℕ.+-∸-assoc 1 {2 ^ suc n} {1} (ℕ.m^n>0 2 (suc n))) ⟨ - 2 + 2 ^ suc n + n * 2 - ≡⟨ Eq.cong (λ x → 2 + 2 ^ suc n + x) (ℕ.*-comm n 2) ⟩ - 2 + 2 ^ suc n + 2 * n + 4 + 2 ^ n + List.sum (List.map (const 2) (List.upTo n)) + ≡⟨ Eq.cong (λ x → 4 + 2 ^ n + List.sum x) (List.map-const 2 (List.upTo n)) ⟩ + 4 + 2 ^ n + List.sum (List.replicate (List.length (List.upTo n)) 2) + ≡⟨ Eq.cong (λ x → 4 + 2 ^ n + List.sum (List.replicate x 2)) (List.length-upTo n) ⟩ + 4 + 2 ^ n + List.sum (List.replicate n 2) + ≡⟨ Eq.cong (λ x → 4 + 2 ^ n + x) (List.sum-replicate n 2) ⟩ + 4 + 2 ^ n + n * 2 + ≡⟨ Eq.cong (4 + 2 ^ n +_) (ℕ.*-comm n 2) ⟩ + 4 + 2 ^ n + 2 * n ∎ where open Eq.≡-Reasoning variant : ℕ → ℕ → FSTA ∞ -variant n i = 0 Rose.-< List.applyUpTo (artifact n) i >- +variant n i = (0 , 0) Rose.-< List.applyUpTo (artifact n) i >- 1≤size2CC : ∀ {i : Size} {A : 𝔸} → (e : 2CC.2CC i A) → 1 ≤ size2CC e 1≤size2CC (a 2CC.2CC.-< cs >-) = s≤s z≤n @@ -151,67 +123,38 @@ variant n i = 0 Rose.-< List.applyUpTo (artifact n) i >- ∈-children : ∀ {i : Size} → (n j : ℕ) - → {a₁ a₂ : ℕ} + → {a₁ a₂ : ℕ × ℕ} → (cs₁ : List (FSTA ∞)) → (cs₂ : List (2CC.2CC i NAT')) → (a₁ Rose.-< cs₁ >-) ∈ 2CC.⟦ a₂ 2CC.2CC.-< cs₂ >- ⟧ → cs₁ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs₂) ∈-children n j cs₁ cs₂ (conf , cs₁≡cs₂) = conf , proj₂ (Rose-injective cs₁≡cs₂) -artifact-child-count : ∀ {i : Size} - → (n j : ℕ) - → (a : ℕ) - → (cs : List (2CC.2CC i NAT')) - → big-artifact (suc n) j ∈ 2CC.⟦ a 2CC.2CC.-< cs >- ⟧ - → List.length cs ≡ 2 -artifact-child-count n j a (c₁ ∷ c₂ ∷ []) artifact∈cs = refl - -big-artifact-children : ∀ {i : Size} - → (n j : ℕ) - → (a : ℕ) - → (cs : List (2CC.2CC i NAT')) - → (c : 2CC.2CC i NAT') - → c List.∈ cs - → big-artifact (suc n) j ∈ 2CC.⟦ a 2CC.2CC.-< cs >- ⟧ - → Σ[ j' ∈ ℕ ] big-artifact n j' ∈ 2CC.⟦ c ⟧ -big-artifact-children n j a (x₂ ∷ x₃ ∷ []) .x₂ (here refl) (conf , artifact≡cs) = j , conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs)) -big-artifact-children n j a (x₂ ∷ x₃ ∷ []) .x₃ (there (here refl)) (conf , artifact≡cs) = j + 2 ^ n , conf , List.∷-injectiveˡ (List.∷-injectiveʳ (proj₂ (Rose-injective artifact≡cs))) - big-artifact∈e₂⇒2^n≤e₂ : ∀ {i : Size} → (n j : ℕ) → (e₂ : 2CC.2CC i NAT') → big-artifact n j ∈ 2CC.⟦ e₂ ⟧ - → 2 ^ suc n ∸ 1 ≤ size2CC e₂ -big-artifact∈e₂⇒2^n≤e₂ zero j e₂ artifact∈e₂ = 1≤size2CC e₂ -big-artifact∈e₂⇒2^n≤e₂ (suc n) j (a 2CC.2CC.-< cs >-) artifact∈e₂ = - begin - 2 ^ suc (suc n) ∸ 1 - ≡⟨ ℕ.+-∸-assoc 1 {2 ^ suc (suc n)} {2} (ℕ.m≤m*n 2 (2 ^ suc n) {{ℕ.>-nonZero (ℕ.m^n>0 2 (suc n))}}) ⟩ - suc (2 ^ suc (suc n) ∸ 2) - ≡⟨⟩ - suc (2 * 2 ^ suc n ∸ 2) - ≡⟨ Eq.cong suc (ℕ.*-distribˡ-∸ 2 (2 ^ suc n) 1) ⟨ - suc (2 * (2 ^ suc n ∸ 1)) - ≡⟨ Eq.cong (λ x → suc (x * (2 ^ suc n ∸ 1))) (artifact-child-count n j a cs artifact∈e₂) ⟨ - suc (List.length cs * (2 ^ suc n ∸ 1)) - ≡⟨ Eq.cong suc (List.sum-replicate (List.length cs) (2 ^ suc n ∸ 1)) ⟨ - suc (List.sum (List.replicate (List.length cs) (2 ^ suc n ∸ 1))) - ≡⟨ Eq.cong (λ x → suc (List.sum x)) (List.map-const (2 ^ suc n ∸ 1) cs) ⟨ - suc (List.sum (List.map (const (2 ^ suc n ∸ 1)) cs)) - ≤⟨ s≤s (List.sum-map-≤-with∈ cs (λ c c∈cs → big-artifact∈e₂⇒2^n≤e₂ n (proj₁ (big-artifact-children n j a cs c c∈cs artifact∈e₂)) c (proj₂ (big-artifact-children n j a cs c c∈cs artifact∈e₂)))) ⟩ - suc (List.sum (List.map size2CC cs)) + → 2 ^ n < size2CC e₂ +big-artifact∈e₂⇒2^n≤e₂ n j (a 2CC.2CC.-< cs >-) (conf , artifact≡e₂) with proj₁ (Rose-injective artifact≡e₂) +big-artifact∈e₂⇒2^n≤e₂ n j (.(j , 2 ^ n) 2CC.-< cs >-) (conf , artifact≡e₂) | refl = + begin-strict + 2 ^ n + <⟨ ℕ.n<1+n (2 ^ n) ⟩ + suc (2 ^ n) + ≤⟨ s≤s (ℕ.m≤m+n (2 ^ n) (List.sum (List.map size2CC cs))) ⟩ + suc (2 ^ n + List.sum (List.map size2CC cs)) ≡⟨⟩ - size2CC (a 2CC.2CC.-< cs >-) + size2CC ((j , 2 ^ n) 2CC.2CC.-< cs >-) ∎ where open ℕ.≤-Reasoning -big-artifact∈e₂⇒2^n≤e₂ (suc n) j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) with conf D -big-artifact∈e₂⇒2^n≤e₂ (suc n) j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) | true = - begin - 2 ^ suc (suc n) ∸ 1 +big-artifact∈e₂⇒2^n≤e₂ n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) with conf D +big-artifact∈e₂⇒2^n≤e₂ n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) | true = + begin-strict + 2 ^ n <⟨ s≤s ℕ.≤-refl ⟩ - suc (2 ^ suc (suc n) ∸ 1) - ≤⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ (suc n) j l (conf , artifact≡e₂)) ⟩ + suc (2 ^ n) + <⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ n j l (conf , artifact≡e₂)) ⟩ suc (size2CC l) ≤⟨ s≤s (ℕ.m≤m+n (size2CC l) (size2CC r)) ⟩ suc (size2CC l + size2CC r) @@ -220,12 +163,12 @@ big-artifact∈e₂⇒2^n≤e₂ (suc n) j (D 2CC.2CC.⟨ l , r ⟩) (conf , art ∎ where open ℕ.≤-Reasoning -big-artifact∈e₂⇒2^n≤e₂ (suc n) j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) | false = - begin - 2 ^ suc (suc n) ∸ 1 - <⟨ s≤s ℕ.≤-refl ⟩ - suc (2 ^ suc (suc n) ∸ 1) - ≤⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ (suc n) j r (conf , artifact≡e₂)) ⟩ +big-artifact∈e₂⇒2^n≤e₂ n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) | false = + begin-strict + 2 ^ n + <⟨ ℕ.n<1+n (2 ^ n) ⟩ + suc (2 ^ n) + <⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ n j r (conf , artifact≡e₂)) ⟩ suc (size2CC r) ≤⟨ s≤s (ℕ.m≤n+m (size2CC r) (size2CC l)) ⟩ suc (size2CC l + size2CC r) @@ -239,16 +182,18 @@ artifact-0∈e₂⇒2^n≤e₂ : ∀ {i : Size} → (n : ℕ) → (e₂ : 2CC.2CC i NAT') → artifact n zero ∈ 2CC.⟦ e₂ ⟧ - → 2 ^ suc n ≤ size2CC e₂ + → 2 ^ n ≤ size2CC e₂ artifact-0∈e₂⇒2^n≤e₂ n (a 2CC.2CC.-< c ∷ [] >-) (conf , artifact≡cs) = begin - 2 ^ suc n - ≡⟨ ℕ.+-∸-assoc 1 {2 ^ suc n} {1} (ℕ.m^n>0 2 (suc n)) ⟩ - suc (2 ^ suc n ∸ 1) - ≤⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ n zero c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs)))) ⟩ + 2 ^ n + <⟨ ℕ.n<1+n (2 ^ n) ⟩ + suc (2 ^ n) + <⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ n zero c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs)))) ⟩ suc (size2CC c) ≡⟨ Eq.cong suc (ℕ.+-identityʳ (size2CC c)) ⟨ suc (size2CC c + 0) + ≤⟨ s≤s (ℕ.m≤n+m (size2CC c + 0) (atomSize NAT' a)) ⟩ + suc (atomSize NAT' a + (size2CC c + 0)) ≡⟨⟩ size2CC (a 2CC.2CC.-< c ∷ [] >-) ∎ @@ -257,9 +202,9 @@ artifact-0∈e₂⇒2^n≤e₂ n (a 2CC.2CC.-< c ∷ [] >-) (conf , artifact≡c artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) with conf D artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) | true = begin - 2 ^ suc n - <⟨ s≤s ℕ.≤-refl ⟩ - suc (2 ^ suc n) + 2 ^ n + <⟨ ℕ.n<1+n (2 ^ n) ⟩ + suc (2 ^ n) ≤⟨ s≤s (artifact-0∈e₂⇒2^n≤e₂ n l (conf , artifact≡cs)) ⟩ suc (size2CC l) ≤⟨ s≤s (ℕ.m≤m+n (size2CC l) (size2CC r)) ⟩ @@ -271,9 +216,9 @@ artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs open ℕ.≤-Reasoning artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) | false = begin - 2 ^ suc n - <⟨ s≤s ℕ.≤-refl ⟩ - suc (2 ^ suc n) + 2 ^ n + <⟨ ℕ.n<1+n (2 ^ n) ⟩ + suc (2 ^ n) ≤⟨ s≤s (artifact-0∈e₂⇒2^n≤e₂ n r (conf , artifact≡cs)) ⟩ suc (size2CC r) ≤⟨ s≤s (ℕ.m≤n+m (size2CC r) (size2CC l)) ⟩ @@ -286,13 +231,13 @@ artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs 2^n≤size2CC-artifact : ∀ {i : Size} → (n j : ℕ) - → (a : ℕ) + → (a : ℕ × ℕ) → (cs : List (2CC.2CC i NAT')) → variant n (suc j) ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ - → 2 ^ suc n ≤ size2CC (a 2CC.-< cs >-) + → 2 ^ n ≤ size2CC (a 2CC.-< cs >-) 2^n≤size2CC-artifact n j a (c ∷ cs) (conf , artifact≡cs) = begin - 2 ^ suc n + 2 ^ n ≤⟨ artifact-0∈e₂⇒2^n≤e₂ n c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs))) ⟩ size2CC c ≤⟨ ℕ.m≤m+n (size2CC c) (List.sum (List.map size2CC cs)) ⟩ @@ -301,6 +246,8 @@ artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs List.sum (List.map size2CC (c ∷ cs)) <⟨ s≤s ℕ.≤-refl ⟩ suc (List.sum (List.map size2CC (c ∷ cs))) + ≤⟨ s≤s (ℕ.m≤n+m (List.sum (List.map size2CC (c ∷ cs))) (atomSize NAT' a)) ⟩ + suc (atomSize NAT' a + List.sum (List.map size2CC (c ∷ cs))) ≡⟨⟩ size2CC (a 2CC.-< c ∷ cs >-) ∎ @@ -407,7 +354,7 @@ n*2^n≤size2CC : ∀ {i : Size} → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ e₂ ⟧ → List.length sizes * 2 ^ n ≤ size2CC e₂ n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) [] unique-sizes sizes⊆e₂ = z≤n -n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ []) unique-sizes sizes⊆e₂ = ℕ.≤-trans (ℕ.≤-reflexive (ℕ.+-comm (2 ^ n) 0)) (ℕ.≤-trans (ℕ.^-monoʳ-≤ 2 (ℕ.n≤1+n n)) (2^n≤size2CC-artifact n s₁ a cs (sizes⊆e₂ zero))) +n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ []) unique-sizes sizes⊆e₂ = ℕ.≤-trans (ℕ.≤-reflexive (ℕ.+-comm (2 ^ n) 0)) (2^n≤size2CC-artifact n s₁ a cs (sizes⊆e₂ zero)) n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ s₂ ∷ sizes) ((s₁≢s₂ ∷ s₁∉sizes) ∷ unique-sizes) sizes⊆e₂ = ⊥-elim (impossible-artifact-sizes n @@ -446,25 +393,6 @@ n*2^n≤size2CC n (D 2CC.2CC.⟨ l , r ⟩) sizes unique-sizes sizes⊆e₂ = where open ℕ.≤-Reasoning -1+n≤2^n : ∀ (n : ℕ) → suc n ≤ 2 ^ n -1+n≤2^n zero = ℕ.≤-refl -1+n≤2^n (suc n) = - begin - suc (suc n) - ≡⟨⟩ - 1 + suc n - ≤⟨ ℕ.+-monoʳ-≤ 1 (1+n≤2^n n) ⟩ - 1 + 2 ^ n - ≤⟨ ℕ.+-monoˡ-≤ (2 ^ n) (ℕ.m^n>0 2 n) ⟩ - 2 ^ n + 2 ^ n - ≡⟨ Eq.cong (2 ^ n +_) (ℕ.+-identityʳ (2 ^ n)) ⟨ - 2 ^ n + (2 ^ n + 0) - ≡⟨⟩ - 2 ^ suc n - ∎ - where - open ℕ.≤-Reasoning - e₁-config : ℕ → ℕ → Bool e₁-config i f = f ℕ.≤ᵇ i @@ -602,7 +530,7 @@ artifacts⊙artifact n (suc i) k | no _ = ∎ where open Eq.≡-Reasoning -artifacts⊙artifact n (suc i) (suc k) | yes artifact-1+i+k≈artifact-k = ⊥-elim (ℕ.1+n≰n (ℕ.≤-trans (ℕ.m≤n+m (suc k) i) (ℕ.≤-reflexive (ℕ.suc-injective artifact-1+i+k≈artifact-k)))) +artifacts⊙artifact n (suc i) (suc k) | yes artifact-1+i+k≈artifact-k = ⊥-elim (ℕ.1+n≰n (ℕ.≤-trans (ℕ.m≤n+m (suc k) i) (ℕ.≤-reflexive (ℕ.suc-injective (Prod.,-injectiveˡ artifact-1+i+k≈artifact-k))))) artifact⊕artifacts : ∀ (n i k : ℕ) @@ -673,7 +601,7 @@ variant∈e₁ : ∀ (n i : ℕ) → i ≤ n → variant n (suc i) ∈ FST.⟦ e₁ n ⟧ -variant∈e₁ n i i≤n = e₁-config i , Eq.cong (0 Rose.-<_>-) ( +variant∈e₁ n i i≤n = e₁-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( begin List.applyUpTo (artifact n) (suc i) ≡⟨ foldr-⊕-artifacts n (suc i) ⟩ @@ -693,66 +621,57 @@ variant∈e₁ n i i≤n = e₁-config i , Eq.cong (0 Rose.-<_>-) ( variants⊆e₁ : ∀ (m : ℕ) → (variant m ∘ suc ∘ List.lookup (List.upTo m)) ⊆ FST.⟦ e₁ m ⟧ variants⊆e₁ m size = Prod.map₂ (Eq.trans (Eq.cong (variant m ∘ suc) (List.lookup-upTo m size))) (variant∈e₁ m (Fin.toℕ size) (ℕ.≤-trans (Fin.toℕ≤n size) (ℕ.≤-reflexive (List.length-upTo m)))) +2*n≤2^n : (n : ℕ) → 2 * n ≤ 2 ^ n +2*n≤2^n zero = ℕ.n≤1+n zero +2*n≤2^n (suc zero) = ℕ.≤-refl +2*n≤2^n (suc n@(suc _)) = + begin + 2 * suc n + ≡⟨ ℕ.*-suc 2 n ⟩ + 2 + 2 * n + ≤⟨ ℕ.+-monoˡ-≤ (2 * n) (ℕ.m≤m*n 2 n) ⟩ + 2 * n + 2 * n + ≡⟨ Eq.cong (2 * n +_) (ℕ.+-identityʳ (2 * n)) ⟨ + 2 * n + (2 * n + 0) + ≡⟨⟩ + 2 * (2 * n) + ≤⟨ ℕ.*-monoʳ-≤ 2 (2*n≤2^n n) ⟩ + 2 * 2 ^ n + ≡⟨ ℕ.^-distribˡ-+-* 2 1 n ⟩ + 2 ^ suc n + ∎ + where + open ℕ.≤-Reasoning + FST≱2CC : SizedFST ≱Size Sized2CC FST≱2CC zero = NAT' , e₁ zero , λ e₂ e₁≅e₂ → 1≤size2CC e₂ FST≱2CC (suc n) = NAT' , e₁ m , λ e₂ e₁≅e₂ → begin-strict suc n * sizeFST (e₁ m) - ≡⟨ Eq.cong (suc n *_) (size-e₁ m) ⟩ - suc n * (2 + 2 ^ suc m + 2 * m) - ≡⟨⟩ - suc n * (2 + 2 ^ suc (8 * suc n) + 2 * (8 * suc n)) - ≤⟨ ℕ.*-monoʳ-≤ (suc n) (ℕ.+-monoʳ-≤ 2 (ℕ.+-monoʳ-≤ (2 ^ suc (8 * suc n)) (ℕ.*-monoʳ-≤ 2 (ℕ.*-monoʳ-≤ 8 (1+n≤2^n n))))) ⟩ - suc n * (2 + 2 ^ suc (8 * suc n) + 2 * (8 * 2 ^ n)) - ≤⟨ ℕ.*-monoʳ-≤ (suc n) (ℕ.+-monoʳ-≤ 2 (ℕ.+-monoʳ-≤ (2 ^ suc (8 * suc n)) (ℕ.*-monoʳ-≤ 2 (ℕ.*-monoʳ-≤ 8 (ℕ.^-monoʳ-≤ 2 (ℕ.m≤n*m n 8)))))) ⟩ - suc n * (2 + 2 ^ suc (8 * suc n) + 2 * (8 * 2 ^ (8 * n))) - ≤⟨ ℕ.*-monoʳ-≤ (suc n) (ℕ.+-monoʳ-≤ 2 (ℕ.+-monoʳ-≤ (2 ^ suc (8 * suc n)) (ℕ.*-monoʳ-≤ 2 (ℕ.*-monoʳ-≤ 8 (ℕ.^-monoʳ-≤ 2 (ℕ.m≤n+m (8 * n) 6)))))) ⟩ - suc n * (2 + 2 ^ suc (8 * suc n) + 2 * (8 * 2 ^ (6 + 8 * n))) - ≡⟨⟩ - suc n * (2 + 2 ^ suc (8 * suc n) + 2 * (2 ^ 3 * 2 ^ (6 + 8 * n))) - ≡⟨ Eq.cong (λ x → suc n * (2 + 2 ^ suc (8 * suc n) + 2 * x)) (ℕ.^-distribˡ-+-* 2 3 (6 + 8 * n)) ⟨ - suc n * (2 + 2 ^ suc (8 * suc n) + 2 * 2 ^ (3 + (6 + 8 * n))) - ≡⟨⟩ - suc n * (2 + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 + 8 * n)) - ≡⟨ Eq.cong (λ x → suc n * (2 + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc x)) (ℕ.*-suc 8 n) ⟨ - suc n * (2 + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 * suc n)) - <⟨ ℕ.*-monoʳ-< (suc n) (ℕ.+-monoˡ-< (2 * 2 ^ suc (8 * suc n)) (ℕ.+-monoˡ-< (2 ^ suc (8 * suc n)) (ℕ.*-monoʳ-< 2 (ℕ.≤-trans (ℕ.n<1+n 1) ( - begin - 2 - ≡⟨⟩ - 1 + 1 - ≤⟨ ℕ.+-monoʳ-≤ 1 (ℕ.m^n>0 2 (n + 7 * suc n)) ⟩ - 1 + 2 ^ (n + 7 * suc n) - ≤⟨ ℕ.+-monoˡ-≤ (2 ^ (n + 7 * suc n)) (ℕ.m^n>0 2 (n + 7 * suc n)) ⟩ - 2 ^ (n + 7 * suc n) + 2 ^ (n + 7 * suc n) - ≡⟨ Eq.cong (2 ^ (n + 7 * suc n) +_) (ℕ.+-identityʳ (2 ^ (n + 7 * suc n))) ⟨ - 2 ^ (n + 7 * suc n) + (2 ^ (n + 7 * suc n) + 0) - ≡⟨⟩ - 2 * 2 ^ (n + 7 * suc n) - ∎))))) ⟩ - suc n * (2 * (2 * (2 ^ (n + 7 * suc n))) + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 * suc n)) - ≡⟨⟩ - suc n * (2 ^ suc (suc n + 7 * suc n) + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 * suc n)) - ≡⟨⟩ - suc n * (2 ^ suc (8 * suc n) + 2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 * suc n)) - ≡⟨ Eq.cong (suc n *_) (ℕ.+-assoc (2 ^ suc (8 * suc n)) (2 ^ suc (8 * suc n)) (2 * 2 ^ suc (8 * suc n))) ⟩ - suc n * (2 ^ suc (8 * suc n) + (2 ^ suc (8 * suc n) + 2 * 2 ^ suc (8 * suc n))) - ≡⟨⟩ - suc n * (4 * (2 ^ suc (8 * suc n))) - ≡⟨ ℕ.*-assoc (suc n) 4 (2 ^ suc (8 * suc n)) ⟨ - suc n * 4 * (2 ^ suc (8 * suc n)) - ≡⟨ Eq.cong (_* 2 ^ suc (8 * suc n)) (ℕ.*-comm (suc n) 4) ⟩ - 4 * suc n * (2 ^ suc (8 * suc n)) - ≡⟨⟩ - 4 * suc n * (2 * 2 ^ (8 * suc n)) - ≡⟨ ℕ.*-assoc (4 * suc n) 2 (2 ^ (8 * suc n)) ⟨ - 4 * suc n * 2 * 2 ^ (8 * suc n) - ≡⟨ Eq.cong (_* 2 ^ (8 * suc n)) (ℕ.*-comm (4 * suc n) 2) ⟩ - (2 * (4 * suc n)) * 2 ^ (8 * suc n) - ≡⟨ Eq.cong (_* 2 ^ (8 * suc n)) (ℕ.*-assoc 2 4 (suc n)) ⟨ - 2 * 4 * suc n * 2 ^ (8 * suc n) - ≡⟨⟩ - 8 * suc n * 2 ^ (8 * suc n) + <⟨ ℕ.*-monoʳ-< (suc n) ( + begin-strict + sizeFST (e₁ m) + ≡⟨ size-e₁ m ⟩ + 4 + 2 ^ m + 2 * m + ≤⟨ ℕ.+-monoʳ-≤ (4 + 2 ^ m) (2*n≤2^n m) ⟩ + 4 + 2 ^ m + 2 ^ m + ≤⟨ ℕ.+-monoˡ-≤ (2 ^ m) (ℕ.+-monoˡ-≤ (2 ^ m) (ℕ.m≤m*n 4 (2 ^ m) {{ℕ.>-nonZero (ℕ.m^n>0 2 m)}})) ⟩ + 4 * 2 ^ m + 2 ^ m + 2 ^ m + ≡⟨ Eq.cong (λ x → 4 * 2 ^ m + x + x) (ℕ.*-identityˡ (2 ^ m)) ⟨ + 4 * 2 ^ m + 1 * 2 ^ m + 1 * 2 ^ m + ≡⟨ Eq.cong (_+ 1 * 2 ^ m) (ℕ.*-distribʳ-+ (2 ^ m) 4 1) ⟨ + 5 * 2 ^ m + 1 * 2 ^ m + ≡⟨ ℕ.*-distribʳ-+ (2 ^ m) 5 1 ⟨ + 6 * 2 ^ m + <⟨ ℕ.*-monoˡ-< (2 ^ m) ⦃ ℕ.>-nonZero (ℕ.m^n>0 2 m) ⦄ (ℕ.n<1+n 6) ⟩ + 7 * 2 ^ m + ∎) + ⟩ + suc n * (7 * 2 ^ m) + ≡⟨ ℕ.*-assoc (suc n) 7 (2 ^ m) ⟨ + suc n * 7 * 2 ^ m + ≡⟨ Eq.cong (_* 2 ^ m) (ℕ.*-comm (suc n) 7) ⟩ + 7 * suc n * 2 ^ m ≡⟨⟩ m * 2 ^ m ≡⟨ Eq.cong (_* 2 ^ m) (List.length-upTo m) ⟨ @@ -762,4 +681,4 @@ FST≱2CC (suc n) = NAT' , e₁ m , λ e₂ e₁≅e₂ → ∎ where open ℕ.≤-Reasoning - m = 8 * (suc n) + m = 7 * suc n diff --git "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" index 0954a458..dcdf2dcf 100644 --- "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" @@ -1,4 +1,4 @@ -open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT') +open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT; atomSize) -- TODO abstract over (F : 𝔽) using a map (ℕ → 𝔽) module Vatras.SyntacticExpressiveness.OC≱2CC where @@ -32,16 +32,12 @@ open import Vatras.Lang.All.Fixed ℕ (Rose ∞) open import Vatras.SyntacticExpressiveness using (_≱Size_) open import Vatras.SyntacticExpressiveness.Sizes ℕ using (SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC) -options : ℕ → List (OC.OC ∞ NAT') +options : ℕ → List (OC.OC ∞ NAT) options zero = [] -options (suc n) = n OC.❲ suc n OC.-< [] >- ❳ ∷ options n +options (suc n) = n OC.❲ 0 OC.-< [] >- ❳ ∷ options n -exponential-oc : ℕ → OC.OC ∞ NAT' -exponential-oc zero = 0 OC.-< [] >- -exponential-oc (suc n) = 0 OC.-< exponential-oc n ∷ exponential-oc n ∷ [] >- - -oc : ℕ → OC.WFOC ∞ NAT' -oc n = OC.Root zero (exponential-oc n ∷ options n) +oc : ℕ → OC.WFOC ∞ NAT +oc n = OC.Root zero ((2 ^ n) OC.-< [] >- ∷ options n) size-options : ∀ n → List.sum (List.map sizeOC (options n)) ≡ 2 * n size-options zero = Eq.refl @@ -57,52 +53,45 @@ size-options (suc n) = where open Eq.≡-Reasoning -size-exponential-artifact : ∀ (n : ℕ) → sizeOC (exponential-oc n) ≡ 2 ^ (suc n) ∸ 1 -size-exponential-artifact zero = Eq.refl -size-exponential-artifact (suc n) = - sizeOC (exponential-oc (suc n)) +size-oc : ∀ (n : ℕ) → sizeWFOC (oc n) ≡ 2 ^ n + 2 * suc n +size-oc n = + sizeWFOC (oc n) ≡⟨⟩ - sizeOC (0 OC.-< exponential-oc n ∷ exponential-oc n ∷ [] >-) + suc (atomSize NAT 0 + (List.sum (List.map sizeOC ((2 ^ n) OC.-< [] >- ∷ options n)))) ≡⟨⟩ - suc (sizeOC (exponential-oc n) + (sizeOC (exponential-oc n) + 0)) - ≡⟨ Eq.cong (λ x → suc (x + (x + 0))) (size-exponential-artifact n) ⟩ - suc (2 ^ (suc n) ∸ 1 + (2 ^ (suc n) ∸ 1 + 0)) + suc (List.sum (List.map sizeOC ((2 ^ n) OC.-< [] >- ∷ options n))) ≡⟨⟩ - suc (2 ^ (suc n) ∸ 1) + (2 ^ (suc n) ∸ 1 + 0) - ≡⟨ Eq.cong (λ x → suc (2 ^ (suc n) ∸ 1) + x) (ℕ.+-identityʳ (2 ^ (suc n) ∸ 1)) ⟩ - suc (2 ^ (suc n) ∸ 1) + (2 ^ (suc n) ∸ 1) - ≡⟨ Eq.cong (_+ (2 ^ (suc n) ∸ 1)) (ℕ.+-∸-assoc 1 (ℕ.m^n>0 2 (suc n))) ⟨ - 2 ^ (suc n) + (2 ^ (suc n) ∸ 1) - ≡⟨ ℕ.+-∸-assoc (2 ^ (suc n)) {2 ^ (suc n)} {1} (ℕ.m^n>0 2 (suc n)) ⟨ - (2 ^ (suc n) + 2 ^ (suc n)) ∸ 1 - ≡⟨ Eq.cong (λ x → 2 ^ (suc n) + x ∸ 1) (ℕ.+-identityʳ (2 ^ (suc n))) ⟨ - 2 ^ (suc (suc n)) ∸ 1 - ∎ - where - open Eq.≡-Reasoning - -size-oc : ∀ (n : ℕ) → sizeWFOC (oc n) ≡ 2 ^ (suc n) + 2 * n -size-oc n = - sizeWFOC (oc n) + suc (sizeOC {A = NAT} ((2 ^ n) OC.-< [] >-) + List.sum (List.map sizeOC (options n))) ≡⟨⟩ - suc (sizeOC (exponential-oc n) + List.sum (List.map sizeOC (options n))) - ≡⟨ Eq.cong₂ (λ x y → suc (x + y)) (size-exponential-artifact n) (size-options n) ⟩ - suc (2 ^ (suc n) ∸ 1 + 2 * n) - ≡⟨ Eq.cong (_+ 2 * n) (ℕ.+-∸-assoc 1 (ℕ.m^n>0 2 (suc n))) ⟨ - 2 ^ (suc n) + 2 * n + suc (suc (atomSize NAT (2 ^ n) + List.sum (List.map (sizeOC {A = NAT}) [])) + List.sum (List.map sizeOC (options n))) + ≡⟨⟩ + 2 + (atomSize NAT (2 ^ n) + List.sum (List.map (sizeOC {A = NAT}) []) + List.sum (List.map sizeOC (options n))) + ≡⟨⟩ + 2 + ((2 ^ n + 0) + List.sum (List.map sizeOC (options n))) + ≡⟨ Eq.cong (λ x → 2 + (x + List.sum (List.map sizeOC (options n)))) (ℕ.+-identityʳ (2 ^ n)) ⟩ + 2 + (2 ^ n + List.sum (List.map sizeOC (options n))) + ≡⟨ Eq.cong (λ x → 2 + (2 ^ n + x)) (size-options n) ⟩ + 2 + (2 ^ n + 2 * n) + ≡⟨ ℕ.+-assoc 2 (2 ^ n) (2 * n) ⟩ + 2 + 2 ^ n + 2 * n + ≡⟨ Eq.cong (_+ 2 * n) (ℕ.+-comm 2 (2 ^ n)) ⟩ + 2 ^ n + 2 + 2 * n + ≡⟨ ℕ.+-assoc (2 ^ n) 2 (2 * n) ⟩ + 2 ^ n + (2 + 2 * n) + ≡⟨ Eq.cong (2 ^ n +_) (ℕ.*-suc 2 n) ⟨ + 2 ^ n + 2 * suc n ∎ where open Eq.≡-Reasoning -exponential-artifact : ℕ → Rose ∞ NAT' -exponential-artifact zero = 0 Rose.-< [] >- -exponential-artifact (suc n) = 0 Rose.-< exponential-artifact n ∷ exponential-artifact n ∷ [] >- +exponential-artifact : ℕ → Rose ∞ NAT +exponential-artifact n = (2 ^ n) Rose.-< [] >- -variant-cs : ℕ → List (Rose ∞ NAT') +variant-cs : ℕ → List (Rose ∞ NAT) variant-cs zero = [] -variant-cs (suc i) = suc i Rose.-< [] >- ∷ variant-cs i +variant-cs (suc i) = 0 Rose.-< [] >- ∷ variant-cs i -variant : ℕ → ℕ → Rose ∞ NAT' +variant : ℕ → ℕ → Rose ∞ NAT variant n i = 0 Rose.-< exponential-artifact n ∷ variant-cs i >- length-variants-cs : ∀ n → List.length (variant-cs n) ≡ n @@ -110,7 +99,7 @@ length-variants-cs zero = Eq.refl length-variants-cs (suc n) = Eq.cong suc (length-variants-cs n) variant∈e⇒length-cs - : ∀ {i} (n l : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT')) + : ∀ {i} (n l : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT)) → variant n l ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ → List.length cs ≡ suc l variant∈e⇒length-cs n l a cs (c , v≡e) = @@ -125,56 +114,19 @@ variant∈e⇒length-cs n l a cs (c , v≡e) = where open Eq.≡-Reasoning -exponential-artifact∈e⇒length-cs - : ∀ {i} (n : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT')) - → exponential-artifact (suc n) ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ - → List.length cs ≡ 2 -exponential-artifact∈e⇒length-cs n a cs (c , v≡e) = - List.length cs - ≡⟨ List.length-map (λ e → 2CC.⟦ e ⟧ c) cs ⟨ - List.length (List.map (λ e → 2CC.⟦ e ⟧ c) cs) - ≡⟨ Eq.cong List.length (proj₂ (Rose-injective v≡e)) ⟨ - List.length (exponential-artifact n ∷ exponential-artifact n ∷ []) - ≡⟨⟩ - 2 - ∎ - where - open Eq.≡-Reasoning - exponential-big : ∀ {i : Size} (n l : ℕ) - → (2cc : 2CC.2CC i NAT') + → (2cc : 2CC.2CC i NAT) → exponential-artifact n ∈ 2CC.⟦ 2cc ⟧ - → 2 ^ (suc n) ∸ 1 ≤ size2CC 2cc + → suc (2 ^ n) ≤ size2CC 2cc exponential-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) with c D exponential-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) | true = ℕ.≤-trans (exponential-big n l c₁ (c , v≡2cc)) (ℕ.≤-trans (ℕ.m≤m+n (size2CC c₁) (size2CC c₂)) (ℕ.m≤n+m (size2CC c₁ + size2CC c₂) 1)) exponential-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) | false = ℕ.≤-trans (exponential-big n l c₂ (c , v≡2cc)) (ℕ.m≤n+m (size2CC c₂) (suc (size2CC c₁))) -exponential-big zero l (a 2CC.-< cs >-) (c , v≡2cc) = s≤s z≤n -exponential-big (suc n) l (a 2CC.-< cs >-) (c , v≡2cc) with exponential-artifact∈e⇒length-cs n a cs (c , v≡2cc) -exponential-big (suc n) l (a 2CC.-< c₁ ∷ c₂ ∷ [] >-) (c , v≡2cc) | Eq.refl = - begin - 2 ^ (suc (suc n)) ∸ 1 - ≡⟨ Eq.cong (λ x → (2 ^ (suc n) + x) ∸ 1) (ℕ.+-identityʳ (2 ^ (suc n))) ⟩ - (2 ^ (suc n) + 2 ^ (suc n)) ∸ 1 - ≡⟨ ℕ.+-∸-assoc (2 ^ (suc n)) (ℕ.m^n>0 2 (suc n)) ⟩ - 2 ^ (suc n) + (2 ^ (suc n) ∸ 1) - ≡⟨ ℕ.+-∸-assoc 1 (ℕ.≤-trans (ℕ.m^n>0 2 (suc n)) (ℕ.m≤m+n (2 ^ (suc n)) (2 ^ (suc n) ∸ 1))) ⟩ - 1 + ((2 ^ (suc n) + (2 ^ (suc n) ∸ 1)) ∸ 1) - ≡⟨ Eq.cong suc (ℕ.+-∸-comm (2 ^ suc n ∸ 1) (ℕ.m^n>0 2 (suc n))) ⟩ - suc ((2 ^ (suc n) ∸ 1) + (2 ^ (suc n) ∸ 1)) - ≤⟨ s≤s (ℕ.+-mono-≤ (exponential-big n l c₁ (c , proj₁ (List.∷-injective (proj₂ (Rose-injective v≡2cc))))) (exponential-big n l c₂ (c , proj₁ (List.∷-injective (proj₂ (List.∷-injective (proj₂ (Rose-injective v≡2cc)))))))) ⟩ - suc (size2CC c₁ + size2CC c₂) - ≡⟨ Eq.cong (λ x → suc (size2CC c₁ + x)) (ℕ.+-identityʳ (size2CC c₂)) ⟨ - suc (size2CC c₁ + (size2CC c₂ + 0)) - ≡⟨⟩ - size2CC (a 2CC.-< c₁ ∷ c₂ ∷ [] >-) - ∎ - where - open ℕ.≤-Reasoning +exponential-big n l (.(2 ^ n) 2CC.-< [] >-) (c , Eq.refl) = ℕ.≤-reflexive (Eq.cong suc (Eq.sym (ℕ.+-identityʳ (2 ^ n)))) exponentially-big : ∀ {i : Size} (n l : ℕ) - → (2cc : 2CC.2CC i NAT') + → (2cc : 2CC.2CC i NAT) → variant n l ∈ 2CC.⟦ 2cc ⟧ → 2 ^ n < size2CC 2cc exponentially-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) with c D @@ -184,18 +136,14 @@ exponentially-big n l (a 2CC.-< cs >-) (c , v≡2cc) with variant∈e⇒length-c exponentially-big n l (a 2CC.-< c₁ ∷ cs >-) (c , v≡2cc) | Eq.refl = begin-strict 2 ^ n - <⟨ ℕ.m0 2 n) ⟩ - 2 ^ n + 2 ^ n - ≡⟨ Eq.cong (2 ^ n +_) (ℕ.+-identityʳ (2 ^ n)) ⟨ - 2 ^ n + (2 ^ n + 0) - ≡⟨⟩ - 2 ^ (suc n) - ≡⟨ ℕ.+-∸-assoc 1 (ℕ.m^n>0 2 (suc n)) ⟩ - suc (2 ^ (suc n) ∸ 1) - ≤⟨ s≤s (exponential-big n l c₁ (c , proj₁ (List.∷-injective (proj₂ (Rose-injective v≡2cc))))) ⟩ - suc (size2CC c₁) - ≤⟨ ℕ.m≤m+n (suc (size2CC c₁)) (List.sum (List.map size2CC cs)) ⟩ - suc (size2CC c₁ + List.sum (List.map size2CC cs)) + <⟨ ℕ.m-) ∎ @@ -203,7 +151,7 @@ exponentially-big n l (a 2CC.-< c₁ ∷ cs >-) (c , v≡2cc) | Eq.refl = open ℕ.≤-Reasoning partition : ∀ {i : Size} (n D : ℕ) - → (c₁ c₂ : 2CC.2CC i NAT') + → (c₁ c₂ : 2CC.2CC i NAT) → (ls : List ℕ) → Unique ls → All (λ l → variant n l ∈ 2CC.⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) ls @@ -220,7 +168,7 @@ partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls ls₁ , l ∷ ls₂ , there ∘ ls₁⊆ls , Subset.∷⁺ʳ l ls₂⊆ls , Eq.trans (ℕ.+-suc (List.length ls₁) (List.length ls₂)) (Eq.cong suc ls₁+ls₂≡ls) , unique-ls₁ , ls₁∈l , All.anti-mono ls₂⊆ls l∉ls ∷ unique-ls₂ , (c , l≡2cc) ∷ ls₂∈r big : ∀ {i : Size} (n : ℕ) - → (2cc : 2CC.2CC i NAT') + → (2cc : 2CC.2CC i NAT) → (ls : List ℕ) → Unique ls → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) ls @@ -249,24 +197,6 @@ big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ | ls₁ , ls₂ , _ , _ , ls₁ conf : ℕ → OC.Configuration conf n i = i <ᵇ n -⟦exponential-artifact⟧ : ∀ n c → OC.⟦ exponential-oc n ⟧ₒ c ≡ just (exponential-artifact n) -⟦exponential-artifact⟧ zero c = Eq.refl -⟦exponential-artifact⟧ (suc n) c = - OC.⟦ exponential-oc (suc n) ⟧ₒ c - ≡⟨⟩ - OC.⟦ 0 OC.-< exponential-oc n ∷ exponential-oc n ∷ [] >- ⟧ₒ c - ≡⟨⟩ - just (0 Rose.-< List.catMaybes (List.map (λ x → OC.⟦ x ⟧ₒ c) (exponential-oc n ∷ exponential-oc n ∷ [])) >-) - ≡⟨⟩ - just (0 Rose.-< List.catMaybes (OC.⟦ exponential-oc n ⟧ₒ c ∷ OC.⟦ exponential-oc n ⟧ₒ c ∷ []) >-) - ≡⟨ Eq.cong (λ x → just (0 Rose.-< List.catMaybes (x ∷ x ∷ []) >-)) (⟦exponential-artifact⟧ n c) ⟩ - just (0 Rose.-< exponential-artifact n ∷ exponential-artifact n ∷ [] >-) - ≡⟨⟩ - just (exponential-artifact (suc n)) - ∎ - where - open Eq.≡-Reasoning - ⟦options⟧ : ∀ n l → l ≤ n → List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) @@ -285,19 +215,17 @@ conf n i = i <ᵇ n go zero l n≤l = Eq.refl go (suc n) l n- ∷_) (go n l (ℕ.<⇒≤ n- ∷_) (go n l (ℕ.<⇒≤ n- + 0 Rose.-< OC.⟦ (2 ^ n) OC.-< [] >- ∷ options n ⟧ₒ-recurse (conf l) >- ≡⟨⟩ - 0 Rose.-< List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (exponential-oc n ∷ options n)) >- + 0 Rose.-< List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) ((2 ^ n) OC.-< [] >- ∷ options n)) >- ≡⟨⟩ - 0 Rose.-< List.catMaybes (OC.⟦ exponential-oc n ⟧ₒ (conf l) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) >- - ≡⟨ Eq.cong (λ x → 0 Rose.-< List.catMaybes (x ∷ List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) >-) (⟦exponential-artifact⟧ n (conf l)) ⟩ 0 Rose.-< List.catMaybes (just (exponential-artifact n) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) >- ≡⟨⟩ 0 Rose.-< exponential-artifact n ∷ List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) >- @@ -311,7 +239,7 @@ conf n i = i <ᵇ n ⊆⇒All∈ : ∀ {i} n l → l ≤ suc n - → (2cc : 2CC.2CC i NAT') + → (2cc : 2CC.2CC i NAT) → OC.⟦ oc n ⟧ ⊆ 2CC.⟦ 2cc ⟧ → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) (List.upTo l) ⊆⇒All∈ n zero l≤m 2cc oc⊆2cc = [] @@ -338,44 +266,32 @@ conf n i = i <ᵇ n where open ℕ.≤-Reasoning -size2CC>0 : ∀ {i} (2cc : 2CC.2CC i NAT') → 0 < size2CC 2cc +size2CC>0 : ∀ {i} (2cc : 2CC.2CC i NAT) → 0 < size2CC 2cc size2CC>0 (a 2CC.-< cs >-) = s≤s z≤n size2CC>0 (D 2CC.⟨ l , r ⟩) = s≤s z≤n -goal : ∀ {i} (n : ℕ) (2cc : 2CC.2CC i NAT') +goal : ∀ {i} (n : ℕ) (2cc : 2CC.2CC i NAT) → OC.⟦ oc (4 * n) ⟧ ≅ 2CC.⟦ 2cc ⟧ → n * sizeWFOC (oc (4 * n)) < size2CC 2cc goal zero 2cc 2cc≅oc = size2CC>0 2cc -goal n@(suc _) 2cc (oc⊆2cc , 2cc⊆oc) = +goal n@(suc n-1) 2cc (oc⊆2cc , 2cc⊆oc) = begin-strict n * sizeWFOC (oc (4 * n)) ≡⟨ Eq.cong (n *_) (size-oc (4 * n)) ⟩ - n * (2 ^ (suc (4 * n)) + 2 * (4 * n)) - ≡⟨⟩ - n * (2 * 2 ^ (4 * n) + 2 * (4 * n)) - ≡⟨ Eq.cong (n *_) (ℕ.*-distribˡ-+ 2 (2 ^ (4 * n)) (4 * n)) ⟨ - n * (2 * (2 ^ (4 * n) + 4 * n)) - ≡⟨ ℕ.*-assoc n 2 (2 ^ (4 * n) + 4 * n) ⟨ - n * 2 * (2 ^ (4 * n) + 4 * n) - <⟨ ℕ.*-monoʳ-< (n * 2) (ℕ.+-monoʳ-< (2 ^ (4 * n)) (4*n<16^n n)) ⟩ - n * 2 * (2 ^ (4 * n) + 16 ^ n) - ≡⟨ Eq.cong (λ x → n * 2 * (2 ^ (4 * n) + x)) (ℕ.^-*-assoc 2 4 n) ⟩ - n * 2 * (2 ^ (4 * n) + 2 ^ (4 * n)) - ≡⟨ Eq.cong (_* (2 ^ (4 * n) + 2 ^ (4 * n))) (ℕ.*-comm n 2) ⟩ - 2 * n * (2 ^ (4 * n) + 2 ^ (4 * n)) - ≡⟨ Eq.cong (λ x → 2 * n * (2 ^ (4 * n) + x)) (ℕ.+-identityʳ (2 ^ (4 * n))) ⟨ - 2 * n * (2 ^ (4 * n) + (2 ^ (4 * n) + 0)) - ≡⟨⟩ - 2 * n * (2 * 2 ^ (4 * n)) - ≡⟨ ℕ.*-assoc (2 * n) 2 (2 ^ (4 * n)) ⟨ - 2 * n * 2 * 2 ^ (4 * n) - ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (ℕ.*-comm (2 * n) 2) ⟩ - 2 * (2 * n) * 2 ^ (4 * n) - ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (ℕ.*-assoc 2 2 n) ⟨ - (2 * 2) * n * 2 ^ (4 * n) + n * (2 ^ (4 * n) + 2 * suc (4 * n)) + ≤⟨ ℕ.*-monoʳ-≤ n (ℕ.+-monoʳ-≤ (2 ^ (4 * n)) (ℕ.*-monoʳ-≤ 2 (4*n<16^n n))) ⟩ + n * (2 ^ (4 * n) + 2 * 16 ^ n) + ≡⟨ Eq.cong (λ x → n * (2 ^ (4 * n) + 2 * x)) (ℕ.^-*-assoc 2 4 n) ⟩ + n * (2 ^ (4 * n) + 2 * 2 ^ (4 * n)) ≡⟨⟩ + n * (3 * 2 ^ (4 * n)) + <⟨ ℕ.*-monoʳ-< n (ℕ.*-monoˡ-< (2 ^ (4 * n)) {{ℕ.>-nonZero (ℕ.m^n>0 2 (4 * n))}} (ℕ.n<1+n 3)) ⟩ + n * (4 * 2 ^ (4 * n)) + ≡⟨ ℕ.*-assoc n 4 (2 ^ (4 * n)) ⟨ + n * 4 * 2 ^ (4 * n) + ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (ℕ.*-comm n 4) ⟩ 4 * n * 2 ^ (4 * n) - ≤⟨ ℕ.*-monoˡ-≤ (2 ^ (4 * n)) (ℕ.m≤n+m (4 * n) 1) ⟩ + <⟨ ℕ.*-monoˡ-< (2 ^ (4 * n)) {{ℕ.>-nonZero (ℕ.m^n>0 2 (4 * n))}} (ℕ.n<1+n (4 * n)) ⟩ suc (4 * n) * 2 ^ (4 * n) ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (List.length-upTo (suc (4 * n))) ⟨ List.length (List.upTo (suc (4 * n))) * 2 ^ (4 * n) @@ -386,4 +302,4 @@ goal n@(suc _) 2cc (oc⊆2cc , 2cc⊆oc) = open ℕ.≤-Reasoning OC≱2CC : SizedWFOC ≱Size Sized2CC -OC≱2CC n = NAT' , oc (4 * n) , λ 2cc oc≅2cc → goal n 2cc oc≅2cc +OC≱2CC n = NAT , oc (4 * n) , λ 2cc oc≅2cc → goal n 2cc oc≅2cc diff --git a/src/Vatras/SyntacticExpressiveness/Sizes.agda b/src/Vatras/SyntacticExpressiveness/Sizes.agda index b442ad89..776f1d8d 100644 --- a/src/Vatras/SyntacticExpressiveness/Sizes.agda +++ b/src/Vatras/SyntacticExpressiveness/Sizes.agda @@ -61,7 +61,7 @@ sizeOC {A = A} (a OC.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeOC c sizeOC (D OC.❲ c ❳) = suc (sizeOC c) sizeWFOC : ∀ {i : Size} {A : 𝔸} → OC.WFOC i A → ℕ -sizeWFOC (OC.Root a cs) = suc (List.sum (List.map sizeOC cs)) +sizeWFOC {A = A} (OC.Root a cs) = suc (atomSize A a + List.sum (List.map sizeOC cs)) SizedWFOC : SizedLang SizedWFOC = record From 546d66301b3da64ab2f17b842021c7b56e2ee170 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 14 Jul 2025 09:06:21 +0200 Subject: [PATCH 28/82] =?UTF-8?q?Rename=20`e=E2=82=81`=20to=20`fst`=20and?= =?UTF-8?q?=20`e=E2=82=82`=20to=20`2cc`?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../FST\342\211\2612CC.agda" | 182 +++++++++--------- 1 file changed, 91 insertions(+), 91 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index 73d097fc..c25106d7 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -65,8 +65,8 @@ artifact-wf n (suc i) = [] , [] feature : ℕ → ℕ → FSF feature n i = (artifact n i ∷ []) ⊚ ([] ∷ [] , artifact-wf n i ∷ []) -e₁ : ℕ → SPL -e₁ n = (0 , 0) ◀ List.applyUpTo (λ i → i :: feature n i) (suc n) +fst : ℕ → SPL +fst n = (0 , 0) ◀ List.applyUpTo (λ i → i :: feature n i) (suc n) size-big-artifact : ∀ (n i : ℕ) @@ -82,12 +82,12 @@ size-big-artifact n i = where open Eq.≡-Reasoning -size-e₁ : +size-fst : ∀ (n : ℕ) - → sizeFST (e₁ n) ≡ 4 + 2 ^ n + 2 * n -size-e₁ n = + → sizeFST (fst n) ≡ 4 + 2 ^ n + 2 * n +size-fst n = begin - sizeFST (e₁ n) + sizeFST (fst n) ≡⟨⟩ suc (List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → i :: feature n i) (suc n)))) ≡⟨⟩ @@ -130,13 +130,13 @@ variant n i = (0 , 0) Rose.-< List.applyUpTo (artifact n) i >- → cs₁ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs₂) ∈-children n j cs₁ cs₂ (conf , cs₁≡cs₂) = conf , proj₂ (Rose-injective cs₁≡cs₂) -big-artifact∈e₂⇒2^n≤e₂ : ∀ {i : Size} +big-artifact∈2cc⇒2^n≤2cc : ∀ {i : Size} → (n j : ℕ) - → (e₂ : 2CC.2CC i NAT') - → big-artifact n j ∈ 2CC.⟦ e₂ ⟧ - → 2 ^ n < size2CC e₂ -big-artifact∈e₂⇒2^n≤e₂ n j (a 2CC.2CC.-< cs >-) (conf , artifact≡e₂) with proj₁ (Rose-injective artifact≡e₂) -big-artifact∈e₂⇒2^n≤e₂ n j (.(j , 2 ^ n) 2CC.-< cs >-) (conf , artifact≡e₂) | refl = + → (2cc : 2CC.2CC i NAT') + → big-artifact n j ∈ 2CC.⟦ 2cc ⟧ + → 2 ^ n < size2CC 2cc +big-artifact∈2cc⇒2^n≤2cc n j (a 2CC.2CC.-< cs >-) (conf , artifact≡2cc) with proj₁ (Rose-injective artifact≡2cc) +big-artifact∈2cc⇒2^n≤2cc n j (.(j , 2 ^ n) 2CC.-< cs >-) (conf , artifact≡2cc) | refl = begin-strict 2 ^ n <⟨ ℕ.n<1+n (2 ^ n) ⟩ @@ -148,13 +148,13 @@ big-artifact∈e₂⇒2^n≤e₂ n j (.(j , 2 ^ n) 2CC.-< cs >-) (conf , artifac ∎ where open ℕ.≤-Reasoning -big-artifact∈e₂⇒2^n≤e₂ n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) with conf D -big-artifact∈e₂⇒2^n≤e₂ n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) | true = +big-artifact∈2cc⇒2^n≤2cc n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡2cc) with conf D +big-artifact∈2cc⇒2^n≤2cc n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡2cc) | true = begin-strict 2 ^ n <⟨ s≤s ℕ.≤-refl ⟩ suc (2 ^ n) - <⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ n j l (conf , artifact≡e₂)) ⟩ + <⟨ s≤s (big-artifact∈2cc⇒2^n≤2cc n j l (conf , artifact≡2cc)) ⟩ suc (size2CC l) ≤⟨ s≤s (ℕ.m≤m+n (size2CC l) (size2CC r)) ⟩ suc (size2CC l + size2CC r) @@ -163,12 +163,12 @@ big-artifact∈e₂⇒2^n≤e₂ n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact ∎ where open ℕ.≤-Reasoning -big-artifact∈e₂⇒2^n≤e₂ n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡e₂) | false = +big-artifact∈2cc⇒2^n≤2cc n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡2cc) | false = begin-strict 2 ^ n <⟨ ℕ.n<1+n (2 ^ n) ⟩ suc (2 ^ n) - <⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ n j r (conf , artifact≡e₂)) ⟩ + <⟨ s≤s (big-artifact∈2cc⇒2^n≤2cc n j r (conf , artifact≡2cc)) ⟩ suc (size2CC r) ≤⟨ s≤s (ℕ.m≤n+m (size2CC r) (size2CC l)) ⟩ suc (size2CC l + size2CC r) @@ -178,17 +178,17 @@ big-artifact∈e₂⇒2^n≤e₂ n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact where open ℕ.≤-Reasoning -artifact-0∈e₂⇒2^n≤e₂ : ∀ {i : Size} +artifact-0∈2cc⇒2^n≤2cc : ∀ {i : Size} → (n : ℕ) - → (e₂ : 2CC.2CC i NAT') - → artifact n zero ∈ 2CC.⟦ e₂ ⟧ - → 2 ^ n ≤ size2CC e₂ -artifact-0∈e₂⇒2^n≤e₂ n (a 2CC.2CC.-< c ∷ [] >-) (conf , artifact≡cs) = + → (2cc : 2CC.2CC i NAT') + → artifact n zero ∈ 2CC.⟦ 2cc ⟧ + → 2 ^ n ≤ size2CC 2cc +artifact-0∈2cc⇒2^n≤2cc n (a 2CC.2CC.-< c ∷ [] >-) (conf , artifact≡cs) = begin 2 ^ n <⟨ ℕ.n<1+n (2 ^ n) ⟩ suc (2 ^ n) - <⟨ s≤s (big-artifact∈e₂⇒2^n≤e₂ n zero c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs)))) ⟩ + <⟨ s≤s (big-artifact∈2cc⇒2^n≤2cc n zero c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs)))) ⟩ suc (size2CC c) ≡⟨ Eq.cong suc (ℕ.+-identityʳ (size2CC c)) ⟨ suc (size2CC c + 0) @@ -199,13 +199,13 @@ artifact-0∈e₂⇒2^n≤e₂ n (a 2CC.2CC.-< c ∷ [] >-) (conf , artifact≡c ∎ where open ℕ.≤-Reasoning -artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) with conf D -artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) | true = +artifact-0∈2cc⇒2^n≤2cc n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) with conf D +artifact-0∈2cc⇒2^n≤2cc n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) | true = begin 2 ^ n <⟨ ℕ.n<1+n (2 ^ n) ⟩ suc (2 ^ n) - ≤⟨ s≤s (artifact-0∈e₂⇒2^n≤e₂ n l (conf , artifact≡cs)) ⟩ + ≤⟨ s≤s (artifact-0∈2cc⇒2^n≤2cc n l (conf , artifact≡cs)) ⟩ suc (size2CC l) ≤⟨ s≤s (ℕ.m≤m+n (size2CC l) (size2CC r)) ⟩ suc (size2CC l + size2CC r) @@ -214,12 +214,12 @@ artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs ∎ where open ℕ.≤-Reasoning -artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) | false = +artifact-0∈2cc⇒2^n≤2cc n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) | false = begin 2 ^ n <⟨ ℕ.n<1+n (2 ^ n) ⟩ suc (2 ^ n) - ≤⟨ s≤s (artifact-0∈e₂⇒2^n≤e₂ n r (conf , artifact≡cs)) ⟩ + ≤⟨ s≤s (artifact-0∈2cc⇒2^n≤2cc n r (conf , artifact≡cs)) ⟩ suc (size2CC r) ≤⟨ s≤s (ℕ.m≤n+m (size2CC r) (size2CC l)) ⟩ suc (size2CC l + size2CC r) @@ -238,7 +238,7 @@ artifact-0∈e₂⇒2^n≤e₂ n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs 2^n≤size2CC-artifact n j a (c ∷ cs) (conf , artifact≡cs) = begin 2 ^ n - ≤⟨ artifact-0∈e₂⇒2^n≤e₂ n c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs))) ⟩ + ≤⟨ artifact-0∈2cc⇒2^n≤2cc n c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs))) ⟩ size2CC c ≤⟨ ℕ.m≤m+n (size2CC c) (List.sum (List.map size2CC cs)) ⟩ size2CC c + List.sum (List.map size2CC cs) @@ -348,14 +348,14 @@ split-sizes-sublist n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡ n*2^n≤size2CC : ∀ {i : Size} → (n : ℕ) - → (e₂ : 2CC.2CC i NAT') + → (2cc : 2CC.2CC i NAT') → (sizes : List ℕ) → Unique sizes - → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ e₂ ⟧ - → List.length sizes * 2 ^ n ≤ size2CC e₂ -n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) [] unique-sizes sizes⊆e₂ = z≤n -n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ []) unique-sizes sizes⊆e₂ = ℕ.≤-trans (ℕ.≤-reflexive (ℕ.+-comm (2 ^ n) 0)) (2^n≤size2CC-artifact n s₁ a cs (sizes⊆e₂ zero)) -n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ s₂ ∷ sizes) ((s₁≢s₂ ∷ s₁∉sizes) ∷ unique-sizes) sizes⊆e₂ = ⊥-elim + → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ 2cc ⟧ + → List.length sizes * 2 ^ n ≤ size2CC 2cc +n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) [] unique-sizes sizes⊆2cc = z≤n +n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ []) unique-sizes sizes⊆2cc = ℕ.≤-trans (ℕ.≤-reflexive (ℕ.+-comm (2 ^ n) 0)) (2^n≤size2CC-artifact n s₁ a cs (sizes⊆2cc zero)) +n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ s₂ ∷ sizes) ((s₁≢s₂ ∷ s₁∉sizes) ∷ unique-sizes) sizes⊆2cc = ⊥-elim (impossible-artifact-sizes n cs @@ -370,20 +370,20 @@ n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ s₂ ∷ sizes) ((s₁≢s₂ ≡⟨ List.length-applyUpTo (artifact n) (suc s₂) ⟩ suc s₂ ∎))) - (∈-children n (suc s₁) (List.applyUpTo (artifact n) (suc s₁)) cs (sizes⊆e₂ zero)) - (∈-children n (suc s₂) (List.applyUpTo (artifact n) (suc s₂)) cs (sizes⊆e₂ (suc zero))) + (∈-children n (suc s₁) (List.applyUpTo (artifact n) (suc s₁)) cs (sizes⊆2cc zero)) + (∈-children n (suc s₂) (List.applyUpTo (artifact n) (suc s₂)) cs (sizes⊆2cc (suc zero))) ) where open Eq.≡-Reasoning -n*2^n≤size2CC n (D 2CC.2CC.⟨ l , r ⟩) sizes unique-sizes sizes⊆e₂ = +n*2^n≤size2CC n (D 2CC.2CC.⟨ l , r ⟩) sizes unique-sizes sizes⊆2cc = begin List.length sizes * 2 ^ n - ≤⟨ ℕ.*-monoˡ-≤ (2 ^ n) (split-sizes-length n D l r sizes sizes⊆e₂) ⟩ - (List.length (proj₁ (split-sizes n D l r sizes sizes⊆e₂)) + List.length (proj₂ (split-sizes n D l r sizes sizes⊆e₂))) * 2 ^ n - ≡⟨ ℕ.*-distribʳ-+ (2 ^ n) (List.length (proj₁ (split-sizes n D l r sizes sizes⊆e₂))) (List.length (proj₂ (split-sizes n D l r sizes sizes⊆e₂))) ⟩ - List.length (proj₁ (split-sizes n D l r sizes sizes⊆e₂)) * 2 ^ n + List.length (proj₂ (split-sizes n D l r sizes sizes⊆e₂)) * 2 ^ n - ≤⟨ ℕ.+-monoʳ-≤ (List.length (proj₁ (split-sizes n D l r sizes sizes⊆e₂)) * 2 ^ n) (n*2^n≤size2CC n r (proj₂ (split-sizes n D l r sizes sizes⊆e₂)) (List.AllPairs-resp-⊆ (proj₂ (split-sizes-sublist n D l r sizes sizes⊆e₂)) unique-sizes) (proj₂ (split-sizes⊆ n D l r sizes sizes⊆e₂))) ⟩ - List.length (proj₁ (split-sizes n D l r sizes sizes⊆e₂)) * 2 ^ n + size2CC r - ≤⟨ ℕ.+-monoˡ-≤ (size2CC r) (n*2^n≤size2CC n l (proj₁ (split-sizes n D l r sizes sizes⊆e₂)) (List.AllPairs-resp-⊆ (proj₁ (split-sizes-sublist n D l r sizes sizes⊆e₂)) unique-sizes) (proj₁ (split-sizes⊆ n D l r sizes sizes⊆e₂))) ⟩ + ≤⟨ ℕ.*-monoˡ-≤ (2 ^ n) (split-sizes-length n D l r sizes sizes⊆2cc) ⟩ + (List.length (proj₁ (split-sizes n D l r sizes sizes⊆2cc)) + List.length (proj₂ (split-sizes n D l r sizes sizes⊆2cc))) * 2 ^ n + ≡⟨ ℕ.*-distribʳ-+ (2 ^ n) (List.length (proj₁ (split-sizes n D l r sizes sizes⊆2cc))) (List.length (proj₂ (split-sizes n D l r sizes sizes⊆2cc))) ⟩ + List.length (proj₁ (split-sizes n D l r sizes sizes⊆2cc)) * 2 ^ n + List.length (proj₂ (split-sizes n D l r sizes sizes⊆2cc)) * 2 ^ n + ≤⟨ ℕ.+-monoʳ-≤ (List.length (proj₁ (split-sizes n D l r sizes sizes⊆2cc)) * 2 ^ n) (n*2^n≤size2CC n r (proj₂ (split-sizes n D l r sizes sizes⊆2cc)) (List.AllPairs-resp-⊆ (proj₂ (split-sizes-sublist n D l r sizes sizes⊆2cc)) unique-sizes) (proj₂ (split-sizes⊆ n D l r sizes sizes⊆2cc))) ⟩ + List.length (proj₁ (split-sizes n D l r sizes sizes⊆2cc)) * 2 ^ n + size2CC r + ≤⟨ ℕ.+-monoˡ-≤ (size2CC r) (n*2^n≤size2CC n l (proj₁ (split-sizes n D l r sizes sizes⊆2cc)) (List.AllPairs-resp-⊆ (proj₁ (split-sizes-sublist n D l r sizes sizes⊆2cc)) unique-sizes) (proj₁ (split-sizes⊆ n D l r sizes sizes⊆2cc))) ⟩ size2CC l + size2CC r <⟨ s≤s ℕ.≤-refl ⟩ suc (size2CC l + size2CC r) @@ -393,27 +393,27 @@ n*2^n≤size2CC n (D 2CC.2CC.⟨ l , r ⟩) sizes unique-sizes sizes⊆e₂ = where open ℕ.≤-Reasoning -e₁-config : ℕ → ℕ → Bool -e₁-config i f = f ℕ.≤ᵇ i +fst-config : ℕ → ℕ → Bool +fst-config i f = f ℕ.≤ᵇ i select-applyUpTo-feature : ∀ (k n i : ℕ) → i ≤ n - → select (e₁-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) + → select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) ≡ List.applyUpTo (λ m → feature k m) (suc i) select-applyUpTo-feature k n i i≤n = begin - select (e₁-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) - ≡⟨ Eq.cong (λ x → select (e₁-config i) (List.applyUpTo (λ m → m :: feature k m) (suc x))) (ℕ.m+[n∸m]≡n i≤n) ⟨ - select (e₁-config i) (List.applyUpTo (λ m → m :: feature k m) (suc (i + (n ∸ i)))) + select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) + ≡⟨ Eq.cong (λ x → select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc x))) (ℕ.m+[n∸m]≡n i≤n) ⟨ + select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc (i + (n ∸ i)))) ≡⟨⟩ - select (e₁-config i) (List.applyUpTo (λ m → m :: feature k m) (suc i + offset)) + select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc i + offset)) ≡⟨ selects-init (suc i) zero refl ⟩ List.applyUpTo (λ m → feature k m) (suc i) ∎ where - e₁-config≡true : ∀ (j i' : ℕ) → j + suc i' ≡ suc i → e₁-config i (j + zero) ≡ true - e₁-config≡true j i' j+i'≡i = Equivalence.to Bool.T-≡ (ℕ.≤⇒≤ᵇ (ℕ.≤-pred ( + fst-config≡true : ∀ (j i' : ℕ) → j + suc i' ≡ suc i → fst-config i (j + zero) ≡ true + fst-config≡true j i' j+i'≡i = Equivalence.to Bool.T-≡ (ℕ.≤⇒≤ᵇ (ℕ.≤-pred ( begin suc j + zero ≤⟨ ℕ.+-monoʳ-≤ (suc j) z≤n ⟩ @@ -432,35 +432,35 @@ select-applyUpTo-feature k n i i≤n = offset = n ∸ i deselects-tail : ∀ (i' j : ℕ) - → select (e₁-config i) (List.applyUpTo (λ m → j + m + suc i :: feature k (j + m + suc i)) i') + → select (fst-config i) (List.applyUpTo (λ m → j + m + suc i :: feature k (j + m + suc i)) i') ≡ [] deselects-tail zero j = refl deselects-tail (suc i') j = begin - select (e₁-config i) (List.applyUpTo (λ m → j + m + suc i :: feature k (j + m + suc i)) (suc i')) + select (fst-config i) (List.applyUpTo (λ m → j + m + suc i :: feature k (j + m + suc i)) (suc i')) ≡⟨⟩ - (if e₁-config i (j + zero + suc i) - then feature k (j + zero + suc i) ∷ select (e₁-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') - else select (e₁-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i')) - ≡⟨ Eq.cong (if_then feature k (j + zero + suc i) ∷ select (e₁-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') else select (e₁-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i')) (Equivalence.to Bool.T-not-≡ (>⇒¬≤ᵇ (ℕ.m≤n⇒m≤o+n (j + zero) (ℕ.n<1+n i)))) ⟩ - select (e₁-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') - ≡⟨ Eq.cong (λ x → select (e₁-config i) x) (List.applyUpTo-cong (λ m → Eq.cong (λ x → x + suc i :: feature k (x + suc i)) (ℕ.+-suc j m)) i') ⟩ - select (e₁-config i) (List.applyUpTo (λ m → suc j + m + suc i :: feature k (suc j + m + suc i)) i') + (if fst-config i (j + zero + suc i) + then feature k (j + zero + suc i) ∷ select (fst-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') + else select (fst-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i')) + ≡⟨ Eq.cong (if_then feature k (j + zero + suc i) ∷ select (fst-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') else select (fst-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i')) (Equivalence.to Bool.T-not-≡ (>⇒¬≤ᵇ (ℕ.m≤n⇒m≤o+n (j + zero) (ℕ.n<1+n i)))) ⟩ + select (fst-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') + ≡⟨ Eq.cong (λ x → select (fst-config i) x) (List.applyUpTo-cong (λ m → Eq.cong (λ x → x + suc i :: feature k (x + suc i)) (ℕ.+-suc j m)) i') ⟩ + select (fst-config i) (List.applyUpTo (λ m → suc j + m + suc i :: feature k (suc j + m + suc i)) i') ≡⟨ deselects-tail i' (suc j) ⟩ [] ∎ selects-init : ∀ (i' j : ℕ) → j + i' ≡ suc i - → select (e₁-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) (i' + offset)) + → select (fst-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) (i' + offset)) ≡ List.applyUpTo (λ m → feature k (j + m)) i' selects-init zero j j+i'≡i = begin - select (e₁-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) offset) - ≡⟨ Eq.cong (select (e₁-config i)) (List.applyUpTo-cong (λ m → Eq.cong (λ x → x :: feature k x) (ℕ.+-comm j m)) offset) ⟩ - select (e₁-config i) (List.applyUpTo (λ m → m + j :: feature k (m + j)) offset) - ≡⟨ Eq.cong (select (e₁-config i)) (List.applyUpTo-cong (λ m → Eq.cong (λ x → m + x :: feature k (m + x)) (Eq.trans (Eq.sym (ℕ.+-identityʳ j)) j+i'≡i)) offset) ⟩ - select (e₁-config i) (List.applyUpTo (λ m → m + suc i :: feature k (m + suc i)) offset) + select (fst-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) offset) + ≡⟨ Eq.cong (select (fst-config i)) (List.applyUpTo-cong (λ m → Eq.cong (λ x → x :: feature k x) (ℕ.+-comm j m)) offset) ⟩ + select (fst-config i) (List.applyUpTo (λ m → m + j :: feature k (m + j)) offset) + ≡⟨ Eq.cong (select (fst-config i)) (List.applyUpTo-cong (λ m → Eq.cong (λ x → m + x :: feature k (m + x)) (Eq.trans (Eq.sym (ℕ.+-identityʳ j)) j+i'≡i)) offset) ⟩ + select (fst-config i) (List.applyUpTo (λ m → m + suc i :: feature k (m + suc i)) offset) ≡⟨ deselects-tail offset zero ⟩ [] ≡⟨⟩ @@ -468,17 +468,17 @@ select-applyUpTo-feature k n i i≤n = ∎ selects-init (suc i') j j+i'≡i = begin - select (e₁-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) (suc i' + offset)) + select (fst-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) (suc i' + offset)) ≡⟨⟩ - select (e₁-config i) ((j + zero :: feature k (j + zero)) ∷ List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) + select (fst-config i) ((j + zero :: feature k (j + zero)) ∷ List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) ≡⟨⟩ - (if e₁-config i (j + zero) - then feature k (j + zero) ∷ select (e₁-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) - else select (e₁-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset))) - ≡⟨ Eq.cong (if_then feature k (j + zero) ∷ select (e₁-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) else select (e₁-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset))) (e₁-config≡true j i' j+i'≡i) ⟩ - feature k (j + zero) ∷ select (e₁-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) - ≡⟨ Eq.cong (λ x → feature k (j + zero) ∷ select (e₁-config i) x) (List.applyUpTo-cong (λ m → Eq.cong₂ _::_ (ℕ.+-suc j m) (Eq.cong (feature k) (ℕ.+-suc j m))) (i' + offset)) ⟩ - feature k (j + zero) ∷ select (e₁-config i) (List.applyUpTo (λ m → suc j + m :: feature k (suc j + m)) (i' + offset)) + (if fst-config i (j + zero) + then feature k (j + zero) ∷ select (fst-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) + else select (fst-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset))) + ≡⟨ Eq.cong (if_then feature k (j + zero) ∷ select (fst-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) else select (fst-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset))) (fst-config≡true j i' j+i'≡i) ⟩ + feature k (j + zero) ∷ select (fst-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) + ≡⟨ Eq.cong (λ x → feature k (j + zero) ∷ select (fst-config i) x) (List.applyUpTo-cong (λ m → Eq.cong₂ _::_ (ℕ.+-suc j m) (Eq.cong (feature k) (ℕ.+-suc j m))) (i' + offset)) ⟩ + feature k (j + zero) ∷ select (fst-config i) (List.applyUpTo (λ m → suc j + m :: feature k (suc j + m)) (i' + offset)) ≡⟨ Eq.cong (feature k (j + zero) ∷_) (selects-init i' (suc j) (Eq.trans (Eq.sym (ℕ.+-suc j i')) j+i'≡i)) ⟩ feature k (j + zero) ∷ List.applyUpTo (λ m → feature k (suc j + m)) i' ≡⟨ Eq.cong (feature k (j + zero) ∷_) (List.applyUpTo-cong (λ m → Eq.cong (feature k) (Eq.sym (ℕ.+-suc j m))) i') ⟩ @@ -597,11 +597,11 @@ foldr-⊕-artifacts n i = go i zero List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n (j + m) ∷ []) (suc i)) ∎ -variant∈e₁ : +variant∈fst : ∀ (n i : ℕ) → i ≤ n - → variant n (suc i) ∈ FST.⟦ e₁ n ⟧ -variant∈e₁ n i i≤n = e₁-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( + → variant n (suc i) ∈ FST.⟦ fst n ⟧ +variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( begin List.applyUpTo (artifact n) (suc i) ≡⟨ foldr-⊕-artifacts n (suc i) ⟩ @@ -613,13 +613,13 @@ variant∈e₁ n i i≤n = e₁-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( ≡⟨ forget-uniqueness-⊛-all (List.applyUpTo (feature n) (suc i)) ⟨ forget-uniqueness (⊛-all (List.applyUpTo (feature n) (suc i))) ≡⟨ Eq.cong (λ x → forget-uniqueness (⊛-all x)) (select-applyUpTo-feature n n i i≤n) ⟨ - forget-uniqueness (⊛-all (select (e₁-config i) (List.applyUpTo (λ m → m :: feature n m) (suc n)))) + forget-uniqueness (⊛-all (select (fst-config i) (List.applyUpTo (λ m → m :: feature n m) (suc n)))) ∎) where open Eq.≡-Reasoning -variants⊆e₁ : ∀ (m : ℕ) → (variant m ∘ suc ∘ List.lookup (List.upTo m)) ⊆ FST.⟦ e₁ m ⟧ -variants⊆e₁ m size = Prod.map₂ (Eq.trans (Eq.cong (variant m ∘ suc) (List.lookup-upTo m size))) (variant∈e₁ m (Fin.toℕ size) (ℕ.≤-trans (Fin.toℕ≤n size) (ℕ.≤-reflexive (List.length-upTo m)))) +variants⊆fst : ∀ (m : ℕ) → (variant m ∘ suc ∘ List.lookup (List.upTo m)) ⊆ FST.⟦ fst m ⟧ +variants⊆fst m size = Prod.map₂ (Eq.trans (Eq.cong (variant m ∘ suc) (List.lookup-upTo m size))) (variant∈fst m (Fin.toℕ size) (ℕ.≤-trans (Fin.toℕ≤n size) (ℕ.≤-reflexive (List.length-upTo m)))) 2*n≤2^n : (n : ℕ) → 2 * n ≤ 2 ^ n 2*n≤2^n zero = ℕ.n≤1+n zero @@ -644,14 +644,14 @@ variants⊆e₁ m size = Prod.map₂ (Eq.trans (Eq.cong (variant m ∘ suc) (Lis open ℕ.≤-Reasoning FST≱2CC : SizedFST ≱Size Sized2CC -FST≱2CC zero = NAT' , e₁ zero , λ e₂ e₁≅e₂ → 1≤size2CC e₂ -FST≱2CC (suc n) = NAT' , e₁ m , λ e₂ e₁≅e₂ → +FST≱2CC zero = NAT' , fst zero , λ 2cc fst≅2cc → 1≤size2CC 2cc +FST≱2CC (suc n) = NAT' , fst m , λ 2cc fst≅2cc → begin-strict - suc n * sizeFST (e₁ m) + suc n * sizeFST (fst m) <⟨ ℕ.*-monoʳ-< (suc n) ( begin-strict - sizeFST (e₁ m) - ≡⟨ size-e₁ m ⟩ + sizeFST (fst m) + ≡⟨ size-fst m ⟩ 4 + 2 ^ m + 2 * m ≤⟨ ℕ.+-monoʳ-≤ (4 + 2 ^ m) (2*n≤2^n m) ⟩ 4 + 2 ^ m + 2 ^ m @@ -676,8 +676,8 @@ FST≱2CC (suc n) = NAT' , e₁ m , λ e₂ e₁≅e₂ → m * 2 ^ m ≡⟨ Eq.cong (_* 2 ^ m) (List.length-upTo m) ⟨ List.length (List.upTo m) * 2 ^ m - ≤⟨ n*2^n≤size2CC m e₂ (List.upTo m) (Unique.upTo⁺ m) (⊆-trans (variants⊆e₁ m) (proj₁ e₁≅e₂)) ⟩ - size2CC e₂ + ≤⟨ n*2^n≤size2CC m 2cc (List.upTo m) (Unique.upTo⁺ m) (⊆-trans (variants⊆fst m) (proj₁ fst≅2cc)) ⟩ + size2CC 2cc ∎ where open ℕ.≤-Reasoning From 944d13710ac450b40968217f249e49e397e5333a Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 15 Jul 2025 12:43:06 +0200 Subject: [PATCH 29/82] Factor out 2CC.reflectsVariantSize --- src/Vatras/Lang/2CC/ReflectsVariantSize.agda | 75 ++++++++ .../FST\342\211\2612CC.agda" | 160 ++++-------------- .../OC\342\211\2612CC.agda" | 63 ++++--- 3 files changed, 141 insertions(+), 157 deletions(-) create mode 100644 src/Vatras/Lang/2CC/ReflectsVariantSize.agda diff --git a/src/Vatras/Lang/2CC/ReflectsVariantSize.agda b/src/Vatras/Lang/2CC/ReflectsVariantSize.agda new file mode 100644 index 00000000..22d94768 --- /dev/null +++ b/src/Vatras/Lang/2CC/ReflectsVariantSize.agda @@ -0,0 +1,75 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atomSize) +module Vatras.Lang.2CC.ReflectsVariantSize {Dimension : 𝔽} {A : 𝔸} where + +open import Data.Bool using (true; false) +open import Data.List as List using (List; []; _∷_) +import Data.List.Properties as List +open import Data.Nat using (suc; _+_; _≤_; s≤s) +import Data.Nat.Properties as ℕ +open import Data.Product using (_,_; proj₁; proj₂) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_) +open import Size using (Size; ∞) + +open import Vatras.Data.EqIndexedSet using (_∈_) +open import Vatras.Framework.Variants using (Rose; Rose-injective) +open import Vatras.Lang.2CC Dimension using (2CC; _⟨_,_⟩; _-<_>-; ⟦_⟧) +open import Vatras.SyntacticExpressiveness.Sizes Dimension using (sizeRose; size2CC) + +reflectsVariantSize : ∀ {i : Size} + → (v : Rose ∞ A) + → (e : 2CC i A) + → v ∈ ⟦ e ⟧ + → sizeRose v ≤ size2CC e +reflectsVariantSize v (D ⟨ l , r ⟩) (config , v≡e) with config D +reflectsVariantSize v (D ⟨ l , r ⟩) (config , v≡e) | true = + begin + sizeRose v + ≤⟨ reflectsVariantSize v l (config , v≡e) ⟩ + size2CC l + <⟨ ℕ.n<1+n (size2CC l) ⟩ + suc (size2CC l) + ≤⟨ s≤s (ℕ.m≤m+n (size2CC l) (size2CC r)) ⟩ + suc (size2CC l + size2CC r) + ≡⟨⟩ + size2CC (D ⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning +reflectsVariantSize v (D ⟨ l , r ⟩) (config , v≡e) | false = + begin + sizeRose v + ≤⟨ reflectsVariantSize v r (config , v≡e) ⟩ + size2CC r + <⟨ ℕ.n<1+n (size2CC r) ⟩ + suc (size2CC r) + ≤⟨ s≤s (ℕ.m≤n+m (size2CC r) (size2CC l)) ⟩ + suc (size2CC l + size2CC r) + ≡⟨⟩ + size2CC (D ⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning +reflectsVariantSize (a Rose.-< cs >-) (a' -< cs' >-) (config , v≡e) = + begin + sizeRose (a Rose.-< cs >-) + ≡⟨⟩ + suc (atomSize A a + List.sum (List.map sizeRose cs)) + ≤⟨ s≤s (ℕ.+-monoʳ-≤ (atomSize A a) (go cs cs' (proj₂ (Rose-injective v≡e)))) ⟩ + suc (atomSize A a + List.sum (List.map size2CC cs')) + ≡⟨⟩ + size2CC (a -< cs' >-) + ≡⟨ Eq.cong (λ x → size2CC (x -< cs' >-)) (proj₁ (Rose-injective v≡e)) ⟩ + size2CC (a' -< cs' >-) + ∎ + where + open ℕ.≤-Reasoning + + go : ∀ {i : Size} + → (cs : List (Rose ∞ A)) (cs' : List (2CC i A)) + → cs ≡ List.map (λ c → ⟦ c ⟧ config) cs' + → List.sum (List.map sizeRose cs) ≤ List.sum (List.map size2CC cs') + go [] [] cs≡cs' = ℕ.≤-refl + go (c ∷ cs) (c' ∷ cs') cs≡cs' = + ℕ.+-mono-≤ + (reflectsVariantSize c c' (config , List.∷-injectiveˡ cs≡cs')) + (go cs cs' (List.∷-injectiveʳ cs≡cs')) diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index c25106d7..7e119dc5 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -31,6 +31,7 @@ open import Vatras.Framework.Definitions using (𝔸; NAT; atomSize) open import Vatras.Framework.Variants using (Rose; Rose-injective) import Vatras.Util.List as List open import Vatras.Lang.All.Fixed ℕ (Rose ∞) +import Vatras.Lang.2CC.ReflectsVariantSize as 2CC open import Vatras.SyntacticExpressiveness using (_≱Size_) open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST) @@ -117,6 +118,28 @@ size-fst n = variant : ℕ → ℕ → FSTA ∞ variant n i = (0 , 0) Rose.-< List.applyUpTo (artifact n) i >- +size-variant + : (n i : ℕ) + → 2 ^ n ≤ sizeRose (variant n (suc i)) +size-variant n i = + begin + 2 ^ n + ≡⟨ ℕ.+-identityʳ (2 ^ n) ⟨ + 2 ^ n + 0 + ≡⟨ ℕ.+-identityʳ (2 ^ n + 0) ⟨ + 2 ^ n + 0 + 0 + <⟨ ℕ.m-) = s≤s z≤n 1≤size2CC (D 2CC.2CC.⟨ l , r ⟩) = s≤s z≤n @@ -130,130 +153,6 @@ variant n i = (0 , 0) Rose.-< List.applyUpTo (artifact n) i >- → cs₁ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs₂) ∈-children n j cs₁ cs₂ (conf , cs₁≡cs₂) = conf , proj₂ (Rose-injective cs₁≡cs₂) -big-artifact∈2cc⇒2^n≤2cc : ∀ {i : Size} - → (n j : ℕ) - → (2cc : 2CC.2CC i NAT') - → big-artifact n j ∈ 2CC.⟦ 2cc ⟧ - → 2 ^ n < size2CC 2cc -big-artifact∈2cc⇒2^n≤2cc n j (a 2CC.2CC.-< cs >-) (conf , artifact≡2cc) with proj₁ (Rose-injective artifact≡2cc) -big-artifact∈2cc⇒2^n≤2cc n j (.(j , 2 ^ n) 2CC.-< cs >-) (conf , artifact≡2cc) | refl = - begin-strict - 2 ^ n - <⟨ ℕ.n<1+n (2 ^ n) ⟩ - suc (2 ^ n) - ≤⟨ s≤s (ℕ.m≤m+n (2 ^ n) (List.sum (List.map size2CC cs))) ⟩ - suc (2 ^ n + List.sum (List.map size2CC cs)) - ≡⟨⟩ - size2CC ((j , 2 ^ n) 2CC.2CC.-< cs >-) - ∎ - where - open ℕ.≤-Reasoning -big-artifact∈2cc⇒2^n≤2cc n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡2cc) with conf D -big-artifact∈2cc⇒2^n≤2cc n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡2cc) | true = - begin-strict - 2 ^ n - <⟨ s≤s ℕ.≤-refl ⟩ - suc (2 ^ n) - <⟨ s≤s (big-artifact∈2cc⇒2^n≤2cc n j l (conf , artifact≡2cc)) ⟩ - suc (size2CC l) - ≤⟨ s≤s (ℕ.m≤m+n (size2CC l) (size2CC r)) ⟩ - suc (size2CC l + size2CC r) - ≡⟨⟩ - size2CC (D 2CC.2CC.⟨ l , r ⟩) - ∎ - where - open ℕ.≤-Reasoning -big-artifact∈2cc⇒2^n≤2cc n j (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡2cc) | false = - begin-strict - 2 ^ n - <⟨ ℕ.n<1+n (2 ^ n) ⟩ - suc (2 ^ n) - <⟨ s≤s (big-artifact∈2cc⇒2^n≤2cc n j r (conf , artifact≡2cc)) ⟩ - suc (size2CC r) - ≤⟨ s≤s (ℕ.m≤n+m (size2CC r) (size2CC l)) ⟩ - suc (size2CC l + size2CC r) - ≡⟨⟩ - size2CC (D 2CC.2CC.⟨ l , r ⟩) - ∎ - where - open ℕ.≤-Reasoning - -artifact-0∈2cc⇒2^n≤2cc : ∀ {i : Size} - → (n : ℕ) - → (2cc : 2CC.2CC i NAT') - → artifact n zero ∈ 2CC.⟦ 2cc ⟧ - → 2 ^ n ≤ size2CC 2cc -artifact-0∈2cc⇒2^n≤2cc n (a 2CC.2CC.-< c ∷ [] >-) (conf , artifact≡cs) = - begin - 2 ^ n - <⟨ ℕ.n<1+n (2 ^ n) ⟩ - suc (2 ^ n) - <⟨ s≤s (big-artifact∈2cc⇒2^n≤2cc n zero c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs)))) ⟩ - suc (size2CC c) - ≡⟨ Eq.cong suc (ℕ.+-identityʳ (size2CC c)) ⟨ - suc (size2CC c + 0) - ≤⟨ s≤s (ℕ.m≤n+m (size2CC c + 0) (atomSize NAT' a)) ⟩ - suc (atomSize NAT' a + (size2CC c + 0)) - ≡⟨⟩ - size2CC (a 2CC.2CC.-< c ∷ [] >-) - ∎ - where - open ℕ.≤-Reasoning -artifact-0∈2cc⇒2^n≤2cc n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) with conf D -artifact-0∈2cc⇒2^n≤2cc n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) | true = - begin - 2 ^ n - <⟨ ℕ.n<1+n (2 ^ n) ⟩ - suc (2 ^ n) - ≤⟨ s≤s (artifact-0∈2cc⇒2^n≤2cc n l (conf , artifact≡cs)) ⟩ - suc (size2CC l) - ≤⟨ s≤s (ℕ.m≤m+n (size2CC l) (size2CC r)) ⟩ - suc (size2CC l + size2CC r) - ≡⟨⟩ - size2CC (D 2CC.2CC.⟨ l , r ⟩) - ∎ - where - open ℕ.≤-Reasoning -artifact-0∈2cc⇒2^n≤2cc n (D 2CC.2CC.⟨ l , r ⟩) (conf , artifact≡cs) | false = - begin - 2 ^ n - <⟨ ℕ.n<1+n (2 ^ n) ⟩ - suc (2 ^ n) - ≤⟨ s≤s (artifact-0∈2cc⇒2^n≤2cc n r (conf , artifact≡cs)) ⟩ - suc (size2CC r) - ≤⟨ s≤s (ℕ.m≤n+m (size2CC r) (size2CC l)) ⟩ - suc (size2CC l + size2CC r) - ≡⟨⟩ - size2CC (D 2CC.2CC.⟨ l , r ⟩) - ∎ - where - open ℕ.≤-Reasoning - -2^n≤size2CC-artifact : ∀ {i : Size} - → (n j : ℕ) - → (a : ℕ × ℕ) - → (cs : List (2CC.2CC i NAT')) - → variant n (suc j) ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ - → 2 ^ n ≤ size2CC (a 2CC.-< cs >-) -2^n≤size2CC-artifact n j a (c ∷ cs) (conf , artifact≡cs) = - begin - 2 ^ n - ≤⟨ artifact-0∈2cc⇒2^n≤2cc n c (conf , List.∷-injectiveˡ (proj₂ (Rose-injective artifact≡cs))) ⟩ - size2CC c - ≤⟨ ℕ.m≤m+n (size2CC c) (List.sum (List.map size2CC cs)) ⟩ - size2CC c + List.sum (List.map size2CC cs) - ≡⟨⟩ - List.sum (List.map size2CC (c ∷ cs)) - <⟨ s≤s ℕ.≤-refl ⟩ - suc (List.sum (List.map size2CC (c ∷ cs))) - ≤⟨ s≤s (ℕ.m≤n+m (List.sum (List.map size2CC (c ∷ cs))) (atomSize NAT' a)) ⟩ - suc (atomSize NAT' a + List.sum (List.map size2CC (c ∷ cs))) - ≡⟨⟩ - size2CC (a 2CC.-< c ∷ cs >-) - ∎ - where - open ℕ.≤-Reasoning - impossible-artifact-sizes : ∀ {i : Size} → (n : ℕ) → (cs : List (2CC.2CC i NAT')) @@ -354,7 +253,18 @@ n*2^n≤size2CC : ∀ {i : Size} → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ 2cc ⟧ → List.length sizes * 2 ^ n ≤ size2CC 2cc n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) [] unique-sizes sizes⊆2cc = z≤n -n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ []) unique-sizes sizes⊆2cc = ℕ.≤-trans (ℕ.≤-reflexive (ℕ.+-comm (2 ^ n) 0)) (2^n≤size2CC-artifact n s₁ a cs (sizes⊆2cc zero)) +n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ []) unique-sizes sizes⊆2cc = + begin + 1 * 2 ^ n + ≡⟨ ℕ.*-identityˡ (2 ^ n) ⟩ + 2 ^ n + ≤⟨ size-variant n s₁ ⟩ + sizeRose (variant n (suc s₁)) + ≤⟨ 2CC.reflectsVariantSize (variant n (suc s₁)) (a 2CC.2CC.-< cs >-) (sizes⊆2cc zero) ⟩ + size2CC (a 2CC.-< cs >-) + ∎ + where + open ℕ.≤-Reasoning n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ s₂ ∷ sizes) ((s₁≢s₂ ∷ s₁∉sizes) ∷ unique-sizes) sizes⊆2cc = ⊥-elim (impossible-artifact-sizes n diff --git "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" index dcdf2dcf..95334c32 100644 --- "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" @@ -29,8 +29,9 @@ open import Vatras.Data.EqIndexedSet using (_≅_; _∈_; _⊆_) open import Vatras.Framework.Variants using (Rose; Rose-injective) open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Lang.All.Fixed ℕ (Rose ∞) +import Vatras.Lang.2CC.ReflectsVariantSize as 2CC open import Vatras.SyntacticExpressiveness using (_≱Size_) -open import Vatras.SyntacticExpressiveness.Sizes ℕ using (SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC) +open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC) options : ℕ → List (OC.OC ∞ NAT) options zero = [] @@ -114,38 +115,22 @@ variant∈e⇒length-cs n l a cs (c , v≡e) = where open Eq.≡-Reasoning -exponential-big - : ∀ {i : Size} (n l : ℕ) - → (2cc : 2CC.2CC i NAT) - → exponential-artifact n ∈ 2CC.⟦ 2cc ⟧ - → suc (2 ^ n) ≤ size2CC 2cc -exponential-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) with c D -exponential-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) | true = ℕ.≤-trans (exponential-big n l c₁ (c , v≡2cc)) (ℕ.≤-trans (ℕ.m≤m+n (size2CC c₁) (size2CC c₂)) (ℕ.m≤n+m (size2CC c₁ + size2CC c₂) 1)) -exponential-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) | false = ℕ.≤-trans (exponential-big n l c₂ (c , v≡2cc)) (ℕ.m≤n+m (size2CC c₂) (suc (size2CC c₁))) -exponential-big n l (.(2 ^ n) 2CC.-< [] >-) (c , Eq.refl) = ℕ.≤-reflexive (Eq.cong suc (Eq.sym (ℕ.+-identityʳ (2 ^ n)))) - -exponentially-big - : ∀ {i : Size} (n l : ℕ) - → (2cc : 2CC.2CC i NAT) - → variant n l ∈ 2CC.⟦ 2cc ⟧ - → 2 ^ n < size2CC 2cc -exponentially-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) with c D -exponentially-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) | true = ℕ.≤-trans (exponentially-big n l c₁ (c , v≡2cc)) (ℕ.≤-trans (ℕ.m≤m+n (size2CC c₁) (size2CC c₂)) (ℕ.m≤n+m (size2CC c₁ + size2CC c₂) 1)) -exponentially-big n l (D 2CC.⟨ c₁ , c₂ ⟩) (c , v≡2cc) | false = ℕ.≤-trans (exponentially-big n l c₂ (c , v≡2cc)) (ℕ.m≤n+m (size2CC c₂) (suc (size2CC c₁))) -exponentially-big n l (a 2CC.-< cs >-) (c , v≡2cc) with variant∈e⇒length-cs n l a cs (c , v≡2cc) -exponentially-big n l (a 2CC.-< c₁ ∷ cs >-) (c , v≡2cc) | Eq.refl = +variant-size + : (n l : ℕ) + → 2 ^ n < sizeRose (variant n l) +variant-size n l = begin-strict 2 ^ n - <⟨ ℕ.m-) + 1 + (sizeRose (exponential-artifact n) + List.sum (List.map sizeRose (variant-cs l))) + ≡⟨⟩ + sizeRose (variant n l) ∎ where open ℕ.≤-Reasoning @@ -174,8 +159,22 @@ big : ∀ {i : Size} (n : ℕ) → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) ls → List.length ls * 2 ^ n < size2CC 2cc big n (a 2CC.-< cs >-) [] unique-ls all-∈ = s≤s z≤n -big n (a 2CC.-< cs >-) (l₁ ∷ []) unique-ls all-∈ = Eq.subst (_< size2CC (a 2CC.-< cs >-)) (Eq.sym (ℕ.+-identityʳ (2 ^ n))) (exponentially-big n l₁ (a 2CC.-< cs >-) (All.lookup all-∈ (here Eq.refl))) -big n (a 2CC.-< cs >-) (l₁ ∷ l₂ ∷ ls) ((l₁≢l₂ ∷ l₁∉ls) ∷ unique-ls) all-∈ = ⊥-elim (l₁≢l₂ (ℕ.suc-injective (Eq.trans (Eq.sym (variant∈e⇒length-cs n l₁ a cs (All.lookup all-∈ (here Eq.refl)))) (variant∈e⇒length-cs n l₂ a cs (All.lookup all-∈ (there (here Eq.refl))))))) +big n (a 2CC.-< cs >-) (l₁ ∷ []) unique-ls all-∈ = + begin-strict + 1 * 2 ^ n + ≡⟨ ℕ.*-identityˡ (2 ^ n) ⟩ + 2 ^ n + <⟨ variant-size n l₁ ⟩ + sizeRose (variant n l₁) + ≤⟨ 2CC.reflectsVariantSize (variant n l₁) (a 2CC.-< cs >-) (All.lookup all-∈ (here Eq.refl)) ⟩ + size2CC (a 2CC.2CC.-< cs >-) + ∎ + where + open ℕ.≤-Reasoning +big n (a 2CC.-< cs >-) (l₁ ∷ l₂ ∷ ls) ((l₁≢l₂ ∷ l₁∉ls) ∷ unique-ls) all-∈ = + ⊥-elim (l₁≢l₂ (ℕ.suc-injective (Eq.trans + (Eq.sym (variant∈e⇒length-cs n l₁ a cs (All.lookup all-∈ (here Eq.refl)))) + (variant∈e⇒length-cs n l₂ a cs (All.lookup all-∈ (there (here Eq.refl))))))) big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ with partition n D l r ls unique-ls all-∈ big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ | ls₁ , ls₂ , _ , _ , ls₁+ls₂≡ls , unique-ls₁ , ls₁∈l , unique-ls₂ , ls₂∈r = begin-strict From 71fd1874ccd9127ea8d338dcb71c4b18a4385b70 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 15 Jul 2025 14:00:30 +0200 Subject: [PATCH 30/82] =?UTF-8?q?Reuse=20List.replicate=20in=20OC=E2=89=B1?= =?UTF-8?q?2CC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../SyntacticExpressiveness/OC\342\211\2612CC.agda" | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" index 95334c32..b0a85b33 100644 --- "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" @@ -89,16 +89,11 @@ exponential-artifact : ℕ → Rose ∞ NAT exponential-artifact n = (2 ^ n) Rose.-< [] >- variant-cs : ℕ → List (Rose ∞ NAT) -variant-cs zero = [] -variant-cs (suc i) = 0 Rose.-< [] >- ∷ variant-cs i +variant-cs i = List.replicate i (0 Rose.-< [] >-) variant : ℕ → ℕ → Rose ∞ NAT variant n i = 0 Rose.-< exponential-artifact n ∷ variant-cs i >- -length-variants-cs : ∀ n → List.length (variant-cs n) ≡ n -length-variants-cs zero = Eq.refl -length-variants-cs (suc n) = Eq.cong suc (length-variants-cs n) - variant∈e⇒length-cs : ∀ {i} (n l : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT)) → variant n l ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ @@ -109,7 +104,9 @@ variant∈e⇒length-cs n l a cs (c , v≡e) = List.length (List.map (λ e → 2CC.⟦ e ⟧ c) cs) ≡⟨ Eq.cong List.length (proj₂ (Rose-injective v≡e)) ⟨ List.length (exponential-artifact n ∷ variant-cs l) - ≡⟨ Eq.cong suc (length-variants-cs l) ⟩ + ≡⟨⟩ + suc (List.length (variant-cs l)) + ≡⟨ Eq.cong suc (List.length-replicate l) ⟩ suc l ∎ where From 7dbfc9568c2c75661fe5c5a600a3a97c6cee20f7 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 15 Jul 2025 14:39:20 +0200 Subject: [PATCH 31/82] =?UTF-8?q?Make=20OC=E2=89=B12CC=20easier=20to=20rea?= =?UTF-8?q?d?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../OC\342\211\2612CC.agda" | 121 ++++++++++++------ 1 file changed, 81 insertions(+), 40 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" index b0a85b33..20be8ef2 100644 --- "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" @@ -26,7 +26,7 @@ open import Size using (Size; ∞) import Vatras.Util.List as List open import Vatras.Data.EqIndexedSet using (_≅_; _∈_; _⊆_) -open import Vatras.Framework.Variants using (Rose; Rose-injective) +open import Vatras.Framework.Variants using (Rose; children-equality) open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Lang.All.Fixed ℕ (Rose ∞) import Vatras.Lang.2CC.ReflectsVariantSize as 2CC @@ -58,22 +58,16 @@ size-oc : ∀ (n : ℕ) → sizeWFOC (oc n) ≡ 2 ^ n + 2 * suc n size-oc n = sizeWFOC (oc n) ≡⟨⟩ - suc (atomSize NAT 0 + (List.sum (List.map sizeOC ((2 ^ n) OC.-< [] >- ∷ options n)))) + 1 + List.sum (List.map sizeOC ((2 ^ n) OC.-< [] >- ∷ options n)) ≡⟨⟩ - suc (List.sum (List.map sizeOC ((2 ^ n) OC.-< [] >- ∷ options n))) + 1 + sizeOC {A = NAT} ((2 ^ n) OC.-< [] >-) + List.sum (List.map sizeOC (options n)) ≡⟨⟩ - suc (sizeOC {A = NAT} ((2 ^ n) OC.-< [] >-) + List.sum (List.map sizeOC (options n))) + 2 + atomSize NAT (2 ^ n) + 0 + List.sum (List.map sizeOC (options n)) ≡⟨⟩ - suc (suc (atomSize NAT (2 ^ n) + List.sum (List.map (sizeOC {A = NAT}) [])) + List.sum (List.map sizeOC (options n))) - ≡⟨⟩ - 2 + (atomSize NAT (2 ^ n) + List.sum (List.map (sizeOC {A = NAT}) []) + List.sum (List.map sizeOC (options n))) - ≡⟨⟩ - 2 + ((2 ^ n + 0) + List.sum (List.map sizeOC (options n))) - ≡⟨ Eq.cong (λ x → 2 + (x + List.sum (List.map sizeOC (options n)))) (ℕ.+-identityʳ (2 ^ n)) ⟩ - 2 + (2 ^ n + List.sum (List.map sizeOC (options n))) - ≡⟨ Eq.cong (λ x → 2 + (2 ^ n + x)) (size-options n) ⟩ - 2 + (2 ^ n + 2 * n) - ≡⟨ ℕ.+-assoc 2 (2 ^ n) (2 * n) ⟩ + 2 + (2 ^ n + 0) + List.sum (List.map sizeOC (options n)) + ≡⟨ Eq.cong (λ x → 2 + (2 ^ n + 0) + x) (size-options n) ⟩ + 2 + (2 ^ n + 0) + 2 * n + ≡⟨ Eq.cong (λ x → 2 + x + 2 * n) (ℕ.+-identityʳ (2 ^ n)) ⟩ 2 + 2 ^ n + 2 * n ≡⟨ Eq.cong (_+ 2 * n) (ℕ.+-comm 2 (2 ^ n)) ⟩ 2 ^ n + 2 + 2 * n @@ -102,7 +96,7 @@ variant∈e⇒length-cs n l a cs (c , v≡e) = List.length cs ≡⟨ List.length-map (λ e → 2CC.⟦ e ⟧ c) cs ⟨ List.length (List.map (λ e → 2CC.⟦ e ⟧ c) cs) - ≡⟨ Eq.cong List.length (proj₂ (Rose-injective v≡e)) ⟨ + ≡⟨ Eq.cong List.length (children-equality v≡e) ⟨ List.length (exponential-artifact n ∷ variant-cs l) ≡⟨⟩ suc (List.length (variant-cs l)) @@ -142,12 +136,34 @@ partition : ∀ {i : Size} (n D : ℕ) × List.length ls₁ + List.length ls₂ ≡ List.length ls × Unique ls₁ × All (λ l → variant n l ∈ 2CC.⟦ c₁ ⟧) ls₁ × Unique ls₂ × All (λ l → variant n l ∈ 2CC.⟦ c₂ ⟧) ls₂ -partition n D c₁ c₂ [] unique-ls ls⊆2cc = [] , [] , Subset.⊆-refl , Subset.⊆-refl , Eq.refl , [] , [] , [] , [] -partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls⊆2cc) with c D | partition n D c₁ c₂ ls unique-ls ls⊆2cc -partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls⊆2cc) | true | ls₁ , ls₂ , ls₁⊆ls , ls₂⊆ls , ls₁+ls₂≡ls , unique-ls₁ , ls₁∈l , unique-ls₂ , ls₂∈r = - l ∷ ls₁ , ls₂ , Subset.∷⁺ʳ l ls₁⊆ls , there ∘ ls₂⊆ls , Eq.cong suc ls₁+ls₂≡ls , All.anti-mono ls₁⊆ls l∉ls ∷ unique-ls₁ , (c , l≡2cc) ∷ ls₁∈l , unique-ls₂ , ls₂∈r -partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls⊆2cc) | false | ls₁ , ls₂ , ls₁⊆ls , ls₂⊆ls , ls₁+ls₂≡ls , unique-ls₁ , ls₁∈l , unique-ls₂ , ls₂∈r = - ls₁ , l ∷ ls₂ , there ∘ ls₁⊆ls , Subset.∷⁺ʳ l ls₂⊆ls , Eq.trans (ℕ.+-suc (List.length ls₁) (List.length ls₂)) (Eq.cong suc ls₁+ls₂≡ls) , unique-ls₁ , ls₁∈l , All.anti-mono ls₂⊆ls l∉ls ∷ unique-ls₂ , (c , l≡2cc) ∷ ls₂∈r +partition n D c₁ c₂ [] unique-ls ls⊆2cc = + [] , [] , + Subset.⊆-refl , Subset.⊆-refl , + Eq.refl , + [] , [] , + [] , [] +partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls⊆2cc) + with partition n D c₁ c₂ ls unique-ls ls⊆2cc +... | ls₁ , ls₂ , + ls₁⊆ls , ls₂⊆ls , + ls₁+ls₂≡ls , + unique-ls₁ , ls₁∈l , + unique-ls₂ , ls₂∈r + with c D +... | true = + l ∷ ls₁ , ls₂ , + Subset.∷⁺ʳ l ls₁⊆ls , there ∘ ls₂⊆ls , + Eq.cong suc ls₁+ls₂≡ls , + All.anti-mono ls₁⊆ls l∉ls ∷ unique-ls₁ , (c , l≡2cc) ∷ ls₁∈l , + unique-ls₂ , ls₂∈r +... | false = + ls₁ , l ∷ ls₂ , + there ∘ ls₁⊆ls , Subset.∷⁺ʳ l ls₂⊆ls , + Eq.trans + (ℕ.+-suc (List.length ls₁) (List.length ls₂)) + (Eq.cong suc ls₁+ls₂≡ls) , + unique-ls₁ , ls₁∈l , + All.anti-mono ls₂⊆ls l∉ls ∷ unique-ls₂ , (c , l≡2cc) ∷ ls₂∈r big : ∀ {i : Size} (n : ℕ) → (2cc : 2CC.2CC i NAT) @@ -173,7 +189,12 @@ big n (a 2CC.-< cs >-) (l₁ ∷ l₂ ∷ ls) ((l₁≢l₂ ∷ l₁∉ls) ∷ u (Eq.sym (variant∈e⇒length-cs n l₁ a cs (All.lookup all-∈ (here Eq.refl)))) (variant∈e⇒length-cs n l₂ a cs (All.lookup all-∈ (there (here Eq.refl))))))) big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ with partition n D l r ls unique-ls all-∈ -big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ | ls₁ , ls₂ , _ , _ , ls₁+ls₂≡ls , unique-ls₁ , ls₁∈l , unique-ls₂ , ls₂∈r = +big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ + | ls₁ , ls₂ , + _ , _ , + ls₁+ls₂≡ls , + unique-ls₁ , ls₁∈l , + unique-ls₂ , ls₂∈r = begin-strict List.length ls * 2 ^ n <⟨ ℕ.n<1+n (List.length ls * 2 ^ n) ⟩ @@ -193,6 +214,17 @@ big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ | ls₁ , ls₂ , _ , _ , ls₁ conf : ℕ → OC.Configuration conf n i = i <ᵇ n +⟦options⟧-tail : ∀ n l + → n ≤ l + → List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) + ≡ variant-cs n +⟦options⟧-tail zero l n≤l = Eq.refl +⟦options⟧-tail (suc n) l n- ∷_) (⟦options⟧-tail n l (ℕ.<⇒≤ n- ∷_) (go n l (ℕ.<⇒≤ n- ∷ options n ⟧ₒ-recurse (conf l) >- ≡⟨⟩ - 0 Rose.-< List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) ((2 ^ n) OC.-< [] >- ∷ options n)) >- - ≡⟨⟩ - 0 Rose.-< List.catMaybes (just (exponential-artifact n) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) >- - ≡⟨⟩ - 0 Rose.-< exponential-artifact n ∷ List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) >- + 0 Rose.-< exponential-artifact n ∷ OC.⟦ options n ⟧ₒ-recurse (conf l) >- ≡⟨ Eq.cong (λ x → 0 Rose.-< exponential-artifact n ∷ x >-) (⟦options⟧ n l l≤n) ⟩ 0 Rose.-< exponential-artifact n ∷ variant-cs l >- ≡⟨⟩ @@ -238,8 +264,17 @@ conf n i = i <ᵇ n → (2cc : 2CC.2CC i NAT) → OC.⟦ oc n ⟧ ⊆ 2CC.⟦ 2cc ⟧ → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) (List.upTo l) -⊆⇒All∈ n zero l≤m 2cc oc⊆2cc = [] -⊆⇒All∈ n (suc l) (s≤s l≤m) 2cc oc⊆2cc = Eq.subst (All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧)) (List.applyUpTo-∷ʳ⁺ id l) (All.∷ʳ⁺ (⊆⇒All∈ n l (ℕ.<⇒≤ (s≤s l≤m)) 2cc oc⊆2cc) (Eq.subst (_∈ 2CC.⟦ 2cc ⟧) (⟦oc⟧ n l l≤m) (oc⊆2cc (conf l)))) +⊆⇒All∈ n zero l≤n 2cc oc⊆2cc = [] +⊆⇒All∈ n (suc l) (s≤s l≤n) 2cc oc⊆2cc = + Eq.subst + (All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧)) + (List.applyUpTo-∷ʳ⁺ id l) + (All.∷ʳ⁺ + (⊆⇒All∈ n l (ℕ.<⇒≤ (s≤s l≤n)) 2cc oc⊆2cc) + (Eq.subst + (_∈ 2CC.⟦ 2cc ⟧) + (⟦oc⟧ n l l≤n) + (oc⊆2cc (conf l)))) 4*n<16^n : ∀ n → 4 * n < 16 ^ n 4*n<16^n zero = s≤s z≤n @@ -291,7 +326,13 @@ goal n@(suc n-1) 2cc (oc⊆2cc , 2cc⊆oc) = suc (4 * n) * 2 ^ (4 * n) ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (List.length-upTo (suc (4 * n))) ⟨ List.length (List.upTo (suc (4 * n))) * 2 ^ (4 * n) - <⟨ big (4 * n) 2cc (List.upTo (suc (4 * n))) (Unique.applyUpTo⁺₁ id (suc (4 * n)) (λ i Date: Tue, 15 Jul 2025 15:03:44 +0200 Subject: [PATCH 32/82] =?UTF-8?q?Write=202CC=20instead=20of=202CC.2CC=20in?= =?UTF-8?q?=20FST=E2=89=B12CC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../FST\342\211\2612CC.agda" | 26 +++++++++---------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index 7e119dc5..6d7aff1d 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -141,15 +141,15 @@ size-variant n i = open ℕ.≤-Reasoning 1≤size2CC : ∀ {i : Size} {A : 𝔸} → (e : 2CC.2CC i A) → 1 ≤ size2CC e -1≤size2CC (a 2CC.2CC.-< cs >-) = s≤s z≤n -1≤size2CC (D 2CC.2CC.⟨ l , r ⟩) = s≤s z≤n +1≤size2CC (a 2CC.-< cs >-) = s≤s z≤n +1≤size2CC (D 2CC.⟨ l , r ⟩) = s≤s z≤n ∈-children : ∀ {i : Size} → (n j : ℕ) → {a₁ a₂ : ℕ × ℕ} → (cs₁ : List (FSTA ∞)) → (cs₂ : List (2CC.2CC i NAT')) - → (a₁ Rose.-< cs₁ >-) ∈ 2CC.⟦ a₂ 2CC.2CC.-< cs₂ >- ⟧ + → (a₁ Rose.-< cs₁ >-) ∈ 2CC.⟦ a₂ 2CC.-< cs₂ >- ⟧ → cs₁ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs₂) ∈-children n j cs₁ cs₂ (conf , cs₁≡cs₂) = conf , proj₂ (Rose-injective cs₁≡cs₂) @@ -173,7 +173,7 @@ split-sizes : ∀ {i : Size} → (D : ℕ) → (l r : 2CC.2CC i NAT') → (sizes : List ℕ) - → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧ + → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.⟨ l , r ⟩ ⟧ → List ℕ × List ℕ split-sizes n D l r [] artifact∈l,r = [] , [] split-sizes n D l r (size ∷ sizes) artifact⊆l,r with artifact⊆l,r zero @@ -186,7 +186,7 @@ split-sizes⊆ : ∀ {i : Size} → (D : ℕ) → (l r : 2CC.2CC i NAT') → (sizes : List ℕ) - → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧) + → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.⟨ l , r ⟩ ⟧) → ((variant n ∘′ suc ∘′ List.lookup (proj₁ (split-sizes n D l r sizes artifact∈l,r))) ⊆ 2CC.⟦ l ⟧) × ((variant n ∘′ suc ∘′ List.lookup (proj₂ (split-sizes n D l r sizes artifact∈l,r))) ⊆ 2CC.⟦ r ⟧) split-sizes⊆ n D l r [] artifact∈l,r = (λ where ()) , (λ where ()) @@ -212,7 +212,7 @@ split-sizes-length : ∀ {i : Size} → (D : ℕ) → (l r : 2CC.2CC i NAT') → (sizes : List ℕ) - → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧) + → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.⟨ l , r ⟩ ⟧) → List.length sizes ≤ List.length (proj₁ (split-sizes n D l r sizes artifact∈l,r)) + List.length (proj₂ (split-sizes n D l r sizes artifact∈l,r)) split-sizes-length n D l r [] artifact∈l,r = z≤n split-sizes-length n D l r (size ∷ sizes) artifact⊆l,r with artifact⊆l,r zero @@ -236,7 +236,7 @@ split-sizes-sublist : ∀ {i : Size} → (D : ℕ) → (l r : 2CC.2CC i NAT') → (sizes : List ℕ) - → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.2CC.⟨ l , r ⟩ ⟧) + → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.⟨ l , r ⟩ ⟧) → proj₁ (split-sizes n D l r sizes artifact∈l,r) Sublist.⊆ sizes × proj₂ (split-sizes n D l r sizes artifact∈l,r) Sublist.⊆ sizes split-sizes-sublist n D l r [] artifact∈l,r = [] , [] @@ -252,20 +252,20 @@ n*2^n≤size2CC : ∀ {i : Size} → Unique sizes → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ 2cc ⟧ → List.length sizes * 2 ^ n ≤ size2CC 2cc -n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) [] unique-sizes sizes⊆2cc = z≤n -n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ []) unique-sizes sizes⊆2cc = +n*2^n≤size2CC n (a 2CC.-< cs >-) [] unique-sizes sizes⊆2cc = z≤n +n*2^n≤size2CC n (a 2CC.-< cs >-) (s₁ ∷ []) unique-sizes sizes⊆2cc = begin 1 * 2 ^ n ≡⟨ ℕ.*-identityˡ (2 ^ n) ⟩ 2 ^ n ≤⟨ size-variant n s₁ ⟩ sizeRose (variant n (suc s₁)) - ≤⟨ 2CC.reflectsVariantSize (variant n (suc s₁)) (a 2CC.2CC.-< cs >-) (sizes⊆2cc zero) ⟩ + ≤⟨ 2CC.reflectsVariantSize (variant n (suc s₁)) (a 2CC.-< cs >-) (sizes⊆2cc zero) ⟩ size2CC (a 2CC.-< cs >-) ∎ where open ℕ.≤-Reasoning -n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ s₂ ∷ sizes) ((s₁≢s₂ ∷ s₁∉sizes) ∷ unique-sizes) sizes⊆2cc = ⊥-elim +n*2^n≤size2CC n (a 2CC.-< cs >-) (s₁ ∷ s₂ ∷ sizes) ((s₁≢s₂ ∷ s₁∉sizes) ∷ unique-sizes) sizes⊆2cc = ⊥-elim (impossible-artifact-sizes n cs @@ -284,7 +284,7 @@ n*2^n≤size2CC n (a 2CC.2CC.-< cs >-) (s₁ ∷ s₂ ∷ sizes) ((s₁≢s₂ (∈-children n (suc s₂) (List.applyUpTo (artifact n) (suc s₂)) cs (sizes⊆2cc (suc zero))) ) where open Eq.≡-Reasoning -n*2^n≤size2CC n (D 2CC.2CC.⟨ l , r ⟩) sizes unique-sizes sizes⊆2cc = +n*2^n≤size2CC n (D 2CC.⟨ l , r ⟩) sizes unique-sizes sizes⊆2cc = begin List.length sizes * 2 ^ n ≤⟨ ℕ.*-monoˡ-≤ (2 ^ n) (split-sizes-length n D l r sizes sizes⊆2cc) ⟩ @@ -298,7 +298,7 @@ n*2^n≤size2CC n (D 2CC.2CC.⟨ l , r ⟩) sizes unique-sizes sizes⊆2cc = <⟨ s≤s ℕ.≤-refl ⟩ suc (size2CC l + size2CC r) ≡⟨⟩ - size2CC (D 2CC.2CC.⟨ l , r ⟩) + size2CC (D 2CC.⟨ l , r ⟩) ∎ where open ℕ.≤-Reasoning From 85b1ae624719386fe4cb2fd6bc03b96ba6adb889 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 15 Jul 2025 15:18:56 +0200 Subject: [PATCH 33/82] =?UTF-8?q?Inline=20big-artifact=20in=20FST=E2=89=B1?= =?UTF-8?q?2CC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../FST\342\211\2612CC.agda" | 112 +++++++----------- 1 file changed, 45 insertions(+), 67 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index 6d7aff1d..1935e8f7 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -49,18 +49,12 @@ open FST.Impose NAT' hiding (Unique; _∈_) >⇒¬≤ᵇ (s≤s z≤n) = tt >⇒¬≤ᵇ (s≤s (s≤s m>n)) = >⇒¬≤ᵇ (s≤s m>n) -big-artifact : ℕ → ℕ → FSTA ∞ -big-artifact n i = (i , 2 ^ n) Rose.-< [] >- - artifact : ℕ → ℕ → FSTA ∞ -artifact n zero = (0 , 0) Rose.-< big-artifact n zero ∷ [] >- +artifact n zero = (0 , 2 ^ n) Rose.-< [] >- artifact n (suc i) = (suc i , 0) Rose.-< [] >- -big-artifact-wf : (n i : ℕ) → WellFormed (big-artifact n i) -big-artifact-wf n i = [] , [] - artifact-wf : (n i : ℕ) → WellFormed (artifact n i) -artifact-wf n zero = [] ∷ [] , big-artifact-wf n zero ∷ [] +artifact-wf n zero = [] , [] artifact-wf n (suc i) = [] , [] feature : ℕ → ℕ → FSF @@ -69,48 +63,34 @@ feature n i = (artifact n i ∷ []) ⊚ ([] ∷ [] , artifact-wf n i ∷ []) fst : ℕ → SPL fst n = (0 , 0) ◀ List.applyUpTo (λ i → i :: feature n i) (suc n) -size-big-artifact : - ∀ (n i : ℕ) - → sizeRose (big-artifact n i) ≡ suc (2 ^ n) -size-big-artifact n i = - begin - sizeRose (big-artifact n i) - ≡⟨⟩ - suc (2 ^ n) + 0 - ≡⟨ ℕ.+-identityʳ (suc (2 ^ n)) ⟩ - suc (2 ^ n) - ∎ - where - open Eq.≡-Reasoning - size-fst : ∀ (n : ℕ) - → sizeFST (fst n) ≡ 4 + 2 ^ n + 2 * n + → sizeFST (fst n) ≡ 3 + 2 ^ n + 2 * n size-fst n = begin sizeFST (fst n) ≡⟨⟩ - suc (List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → i :: feature n i) (suc n)))) + 1 + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → i :: feature n i) (suc n))) + ≡⟨⟩ + 2 + (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → suc i :: feature n (suc i)) n)) + ≡⟨ Eq.cong (λ x → 2 + (sizeRose (artifact n zero) + 0 + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) x))) (List.map-upTo (λ i → suc i :: feature n (suc i)) n) ⟨ + 2 + (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.map (λ i → suc i :: feature n (suc i)) (List.upTo n))) + ≡⟨ Eq.cong (λ x → 2 + (sizeRose (artifact n zero) + 0) + List.sum x) (List.map-∘ (List.upTo n)) ⟨ + 2 + (sizeRose (artifact n zero) + 0) + List.sum (List.map (λ i → suc (sizeRose (artifact n (suc i)) + 0)) (List.upTo n)) ≡⟨⟩ - suc (suc (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → suc i :: feature n (suc i)) n))) - ≡⟨ Eq.cong (λ x → suc (suc (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) x))) (List.map-upTo (λ i → suc i :: feature n (suc i)) n) ⟨ - suc (suc (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.map (λ i → suc i :: feature n (suc i)) (List.upTo n)))) - ≡⟨ Eq.cong (λ x → suc (suc (sizeRose (artifact n zero) + 0) + List.sum x)) (List.map-∘ (List.upTo n)) ⟨ - 3 + sizeRose (big-artifact n zero) + 0 + 0 + List.sum (List.map (λ i → suc (sizeRose (artifact n (suc i)) + 0)) (List.upTo n)) - ≡⟨ Eq.cong₂ (λ x y → x + 0 + List.sum y) (ℕ.+-identityʳ (3 + sizeRose (big-artifact n zero))) (List.map-cong (λ i → Eq.cong suc (ℕ.+-identityʳ (sizeRose (artifact n (suc i))))) (List.upTo n)) ⟩ - 3 + sizeRose (big-artifact n zero) + 0 + List.sum (List.map (λ i → suc (sizeRose (artifact n (suc i)))) (List.upTo n)) - ≡⟨ Eq.cong (λ x → x + List.sum (List.map (λ i → suc (sizeRose (artifact n (suc i)))) (List.upTo n))) (ℕ.+-identityʳ (3 + sizeRose (big-artifact n zero))) ⟩ - 3 + sizeRose (big-artifact n zero) + List.sum (List.map (const 2) (List.upTo n)) - ≡⟨ Eq.cong (λ x → 3 + x + List.sum (List.map (const 2) (List.upTo n))) (size-big-artifact n zero) ⟩ - 4 + 2 ^ n + List.sum (List.map (const 2) (List.upTo n)) - ≡⟨ Eq.cong (λ x → 4 + 2 ^ n + List.sum x) (List.map-const 2 (List.upTo n)) ⟩ - 4 + 2 ^ n + List.sum (List.replicate (List.length (List.upTo n)) 2) - ≡⟨ Eq.cong (λ x → 4 + 2 ^ n + List.sum (List.replicate x 2)) (List.length-upTo n) ⟩ - 4 + 2 ^ n + List.sum (List.replicate n 2) - ≡⟨ Eq.cong (λ x → 4 + 2 ^ n + x) (List.sum-replicate n 2) ⟩ - 4 + 2 ^ n + n * 2 - ≡⟨ Eq.cong (4 + 2 ^ n +_) (ℕ.*-comm n 2) ⟩ - 4 + 2 ^ n + 2 * n + 3 + (2 ^ n + 0 + 0) + List.sum (List.map (const 2) (List.upTo n)) + ≡⟨ Eq.cong (λ x → 3 + x + List.sum (List.map (const 2) (List.upTo n))) (ℕ.+-identityʳ (2 ^ n + 0)) ⟩ + 3 + (2 ^ n + 0) + List.sum (List.map (const 2) (List.upTo n)) + ≡⟨ Eq.cong (λ x → 3 + x + List.sum (List.map (const 2) (List.upTo n))) (ℕ.+-identityʳ (2 ^ n)) ⟩ + 3 + 2 ^ n + List.sum (List.map (const 2) (List.upTo n)) + ≡⟨ Eq.cong (λ x → 3 + 2 ^ n + List.sum x) (List.map-const 2 (List.upTo n)) ⟩ + 3 + 2 ^ n + List.sum (List.replicate (List.length (List.upTo n)) 2) + ≡⟨ Eq.cong (λ x → 3 + 2 ^ n + List.sum (List.replicate x 2)) (List.length-upTo n) ⟩ + 3 + 2 ^ n + List.sum (List.replicate n 2) + ≡⟨ Eq.cong (λ x → 3 + 2 ^ n + x) (List.sum-replicate n 2) ⟩ + 3 + 2 ^ n + n * 2 + ≡⟨ Eq.cong (3 + 2 ^ n +_) (ℕ.*-comm n 2) ⟩ + 3 + 2 ^ n + 2 * n ∎ where open Eq.≡-Reasoning @@ -126,12 +106,10 @@ size-variant n i = 2 ^ n ≡⟨ ℕ.+-identityʳ (2 ^ n) ⟨ 2 ^ n + 0 - ≡⟨ ℕ.+-identityʳ (2 ^ n + 0) ⟨ - 2 ^ n + 0 + 0 - <⟨ ℕ.m-nonZero (ℕ.m^n>0 2 m)}})) ⟩ - 4 * 2 ^ m + 2 ^ m + 2 ^ m - ≡⟨ Eq.cong (λ x → 4 * 2 ^ m + x + x) (ℕ.*-identityˡ (2 ^ m)) ⟨ - 4 * 2 ^ m + 1 * 2 ^ m + 1 * 2 ^ m - ≡⟨ Eq.cong (_+ 1 * 2 ^ m) (ℕ.*-distribʳ-+ (2 ^ m) 4 1) ⟨ - 5 * 2 ^ m + 1 * 2 ^ m - ≡⟨ ℕ.*-distribʳ-+ (2 ^ m) 5 1 ⟨ + 3 + 2 ^ m + 2 * m + ≤⟨ ℕ.+-monoʳ-≤ (3 + 2 ^ m) (2*n≤2^n m) ⟩ + 3 + 2 ^ m + 2 ^ m + ≤⟨ ℕ.+-monoˡ-≤ (2 ^ m) (ℕ.+-monoˡ-≤ (2 ^ m) (ℕ.m≤m*n 3 (2 ^ m) {{ℕ.>-nonZero (ℕ.m^n>0 2 m)}})) ⟩ + 3 * 2 ^ m + 2 ^ m + 2 ^ m + ≡⟨ Eq.cong (λ x → 3 * 2 ^ m + x + x) (ℕ.*-identityˡ (2 ^ m)) ⟨ + 3 * 2 ^ m + 1 * 2 ^ m + 1 * 2 ^ m + ≡⟨ Eq.cong (_+ 1 * 2 ^ m) (ℕ.*-distribʳ-+ (2 ^ m) 3 1) ⟨ + 4 * 2 ^ m + 1 * 2 ^ m + ≡⟨ ℕ.*-distribʳ-+ (2 ^ m) 4 1 ⟨ + 5 * 2 ^ m + <⟨ ℕ.*-monoˡ-< (2 ^ m) ⦃ ℕ.>-nonZero (ℕ.m^n>0 2 m) ⦄ (ℕ.n<1+n 5) ⟩ 6 * 2 ^ m - <⟨ ℕ.*-monoˡ-< (2 ^ m) ⦃ ℕ.>-nonZero (ℕ.m^n>0 2 m) ⦄ (ℕ.n<1+n 6) ⟩ - 7 * 2 ^ m ∎) ⟩ - suc n * (7 * 2 ^ m) - ≡⟨ ℕ.*-assoc (suc n) 7 (2 ^ m) ⟨ - suc n * 7 * 2 ^ m - ≡⟨ Eq.cong (_* 2 ^ m) (ℕ.*-comm (suc n) 7) ⟩ - 7 * suc n * 2 ^ m + suc n * (6 * 2 ^ m) + ≡⟨ ℕ.*-assoc (suc n) 6 (2 ^ m) ⟨ + suc n * 6 * 2 ^ m + ≡⟨ Eq.cong (_* 2 ^ m) (ℕ.*-comm (suc n) 6) ⟩ + 6 * suc n * 2 ^ m ≡⟨⟩ m * 2 ^ m ≡⟨ Eq.cong (_* 2 ^ m) (List.length-upTo m) ⟨ @@ -591,4 +569,4 @@ FST≱2CC (suc n) = NAT' , fst m , λ 2cc fst≅2cc → ∎ where open ℕ.≤-Reasoning - m = 7 * suc n + m = 6 * suc n From ae7f6ab85f84e9d11ae84fcd15e2e378e8f7edc1 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 15 Jul 2025 15:38:59 +0200 Subject: [PATCH 34/82] =?UTF-8?q?Use=20the=20same=20approach=20as=20OC?= =?UTF-8?q?=E2=89=B12CC=20in=20FST=E2=89=B12CC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Using subsets and uniqueness for partitioning is a little bit more complicated but much shorter and more general. In the future, `partition` will be factored into a separate module. --- .../FST\342\211\2612CC.agda" | 272 ++++++++---------- 1 file changed, 123 insertions(+), 149 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index 1935e8f7..d1ecc200 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -11,15 +11,18 @@ open import Data.List as List using (List; []; _∷_) import Data.List.Properties as List import Data.List.Membership.Propositional as List open import Data.List.Relation.Binary.Sublist.Propositional as Sublist using ([]; _∷_; _∷ʳ_) +import Data.List.Relation.Binary.Subset.Propositional as Subset +import Data.List.Relation.Binary.Subset.Propositional.Properties as Subset open import Data.List.Relation.Unary.Any using (here; there) -open import Data.List.Relation.Unary.All using ([]; _∷_) +open import Data.List.Relation.Unary.All as All using (All; []; _∷_) +import Data.List.Relation.Unary.All.Properties as All open import Data.List.Relation.Unary.AllPairs using ([]; _∷_) open import Data.List.Relation.Unary.Unique.Propositional using (Unique) import Data.List.Relation.Unary.Unique.Propositional.Properties as Unique -open import Data.Product as Prod using (_×_; _,_; proj₁; proj₂; Σ-syntax) +open import Data.Product as Prod using (_×_; _,_; proj₁; proj₂; Σ-syntax; ∃-syntax) import Data.Product.Properties as Prod open import Data.Unit using (tt) -open import Function using (_∘_; _∘′_; const) +open import Function using (_∘_; _∘′_; const; id) open import Function.Bundles using (Equivalence) open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_; refl) open import Relation.Nullary.Decidable using (yes; no) @@ -100,9 +103,9 @@ variant n i = (0 , 0) Rose.-< List.applyUpTo (artifact n) i >- size-variant : (n i : ℕ) - → 2 ^ n ≤ sizeRose (variant n (suc i)) + → 2 ^ n < sizeRose (variant n (suc i)) size-variant n i = - begin + begin-strict 2 ^ n ≡⟨ ℕ.+-identityʳ (2 ^ n) ⟨ 2 ^ n + 0 @@ -122,158 +125,103 @@ size-variant n i = 1≤size2CC (a 2CC.-< cs >-) = s≤s z≤n 1≤size2CC (D 2CC.⟨ l , r ⟩) = s≤s z≤n -∈-children : ∀ {i : Size} - → (n j : ℕ) - → {a₁ a₂ : ℕ × ℕ} - → (cs₁ : List (FSTA ∞)) - → (cs₂ : List (2CC.2CC i NAT')) - → (a₁ Rose.-< cs₁ >-) ∈ 2CC.⟦ a₂ 2CC.-< cs₂ >- ⟧ - → cs₁ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs₂) -∈-children n j cs₁ cs₂ (conf , cs₁≡cs₂) = conf , proj₂ (Rose-injective cs₁≡cs₂) - -impossible-artifact-sizes : ∀ {i : Size} - → (n : ℕ) - → (cs : List (2CC.2CC i NAT')) - → (cs₁ cs₂ : List (FSTA ∞)) - → List.length cs₁ ≢ List.length cs₂ - → cs₁ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs) - → ¬ cs₂ ∈ (λ conf → List.map (λ c → 2CC.⟦ c ⟧ conf) cs) -impossible-artifact-sizes n cs [] [] cs₁≢cs₂ (i , cs₁≡cs) (j , cs₂≡cs) = cs₁≢cs₂ refl -impossible-artifact-sizes n [] [] (c₂ ∷ cs₂) cs₁≢cs₂ (i , cs₁≡cs) (j , ()) -impossible-artifact-sizes n (c ∷ cs) [] (c₂ ∷ cs₂) cs₁≢cs₂ (i , ()) (j , cs₂≡cs) -impossible-artifact-sizes n [] (c₁ ∷ cs₁) [] cs₁≢cs₂ (i , ()) (j , cs₂≡cs) -impossible-artifact-sizes n (c ∷ cs) (c₁ ∷ cs₁) [] cs₁≢cs₂ (i , cs₁≡cs) (j , ()) -impossible-artifact-sizes n (c ∷ cs) (c₁ ∷ cs₁) (c₂ ∷ cs₂) cs₁≢cs₂ (i , cs₁≡cs) (j , cs₂≡cs) = - impossible-artifact-sizes n cs cs₁ cs₂ (cs₁≢cs₂ ∘ Eq.cong suc) (i , List.∷-injectiveʳ cs₁≡cs) (j , List.∷-injectiveʳ cs₂≡cs) - -split-sizes : ∀ {i : Size} - → (n : ℕ) - → (D : ℕ) - → (l r : 2CC.2CC i NAT') - → (sizes : List ℕ) - → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.⟨ l , r ⟩ ⟧ - → List ℕ × List ℕ -split-sizes n D l r [] artifact∈l,r = [] , [] -split-sizes n D l r (size ∷ sizes) artifact⊆l,r with artifact⊆l,r zero -split-sizes n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r with conf D -split-sizes n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r | true = Prod.map₁ (size ∷_) (split-sizes n D l r sizes (artifact⊆l,r ∘ suc)) -split-sizes n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r | false = Prod.map₂ (size ∷_) (split-sizes n D l r sizes (artifact⊆l,r ∘ suc)) - -split-sizes⊆ : ∀ {i : Size} - → (n : ℕ) - → (D : ℕ) - → (l r : 2CC.2CC i NAT') - → (sizes : List ℕ) - → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.⟨ l , r ⟩ ⟧) - → ((variant n ∘′ suc ∘′ List.lookup (proj₁ (split-sizes n D l r sizes artifact∈l,r))) ⊆ 2CC.⟦ l ⟧) - × ((variant n ∘′ suc ∘′ List.lookup (proj₂ (split-sizes n D l r sizes artifact∈l,r))) ⊆ 2CC.⟦ r ⟧) -split-sizes⊆ n D l r [] artifact∈l,r = (λ where ()) , (λ where ()) -split-sizes⊆ n D l r (size ∷ sizes) artifact⊆l,r with artifact⊆l,r zero -split-sizes⊆ n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r with conf D -split-sizes⊆ n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r | true = Prod.map₁ go (split-sizes⊆ n D l r sizes (artifact⊆l,r ∘ suc)) - where - go : ∀ {sizes : List ℕ} - → ((variant n ∘′ suc ∘′ List.lookup sizes) ⊆ 2CC.⟦ l ⟧) - → (variant n ∘′ suc ∘′ List.lookup (size ∷ sizes)) ⊆ 2CC.⟦ l ⟧ - go artifact⊆l zero = conf , artifact≡l,r - go artifact⊆l (suc i) = artifact⊆l i -split-sizes⊆ n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r | false = Prod.map₂ go (split-sizes⊆ n D l r sizes (artifact⊆l,r ∘ suc)) - where - go : ∀ {sizes : List ℕ} - → ((variant n ∘′ suc ∘′ List.lookup sizes) ⊆ 2CC.⟦ r ⟧) - → (variant n ∘′ suc ∘′ List.lookup (size ∷ sizes)) ⊆ 2CC.⟦ r ⟧ - go artifact⊆r zero = conf , artifact≡l,r - go artifact⊆r (suc i) = artifact⊆r i - -split-sizes-length : ∀ {i : Size} - → (n : ℕ) - → (D : ℕ) - → (l r : 2CC.2CC i NAT') - → (sizes : List ℕ) - → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.⟨ l , r ⟩ ⟧) - → List.length sizes ≤ List.length (proj₁ (split-sizes n D l r sizes artifact∈l,r)) + List.length (proj₂ (split-sizes n D l r sizes artifact∈l,r)) -split-sizes-length n D l r [] artifact∈l,r = z≤n -split-sizes-length n D l r (size ∷ sizes) artifact⊆l,r with artifact⊆l,r zero -split-sizes-length n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r with conf D -split-sizes-length n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡l,r | true = s≤s (split-sizes-length n D l r sizes (artifact∈l,r ∘ suc)) -split-sizes-length n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡l,r | false = - begin - List.length (size ∷ sizes) - ≡⟨⟩ - suc (List.length sizes) - ≤⟨ s≤s (split-sizes-length n D l r sizes (artifact∈l,r ∘ suc)) ⟩ - suc (List.length (proj₁ (split-sizes n D l r sizes (artifact∈l,r ∘ suc))) + List.length (proj₂ (split-sizes n D l r sizes (artifact∈l,r ∘ suc)))) - ≡⟨ ℕ.+-suc (List.length (proj₁ (split-sizes n D l r sizes (artifact∈l,r ∘ suc)))) (List.length (proj₂ (split-sizes n D l r sizes (artifact∈l,r ∘ suc)))) ⟨ - List.length (proj₁ (split-sizes n D l r sizes (artifact∈l,r ∘ suc))) + suc (List.length (proj₂ (split-sizes n D l r sizes (artifact∈l,r ∘ suc)))) +-- TODO duplicated in OC≱2CC +variant∈e⇒length-cs + : ∀ {i} (n l : ℕ) (a : ℕ × ℕ) (cs : List (2CC.2CC i NAT')) + → variant n (suc l) ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ + → List.length cs ≡ suc l +variant∈e⇒length-cs n l a cs (c , v≡e) = + List.length cs + ≡⟨ List.length-map (λ e → 2CC.⟦ e ⟧ c) cs ⟨ + List.length (List.map (λ e → 2CC.⟦ e ⟧ c) cs) + ≡⟨ Eq.cong List.length (proj₂ (Rose-injective v≡e)) ⟨ + List.length (List.applyUpTo (artifact n) (suc l)) + ≡⟨ List.length-applyUpTo (artifact n) (suc l) ⟩ + suc l ∎ where - open ℕ.≤-Reasoning - -split-sizes-sublist : ∀ {i : Size} - → (n : ℕ) - → (D : ℕ) - → (l r : 2CC.2CC i NAT') - → (sizes : List ℕ) - → (artifact∈l,r : (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ D 2CC.⟨ l , r ⟩ ⟧) - → proj₁ (split-sizes n D l r sizes artifact∈l,r) Sublist.⊆ sizes - × proj₂ (split-sizes n D l r sizes artifact∈l,r) Sublist.⊆ sizes -split-sizes-sublist n D l r [] artifact∈l,r = [] , [] -split-sizes-sublist n D l r (size ∷ sizes) artifact⊆l,r with artifact⊆l,r zero -split-sizes-sublist n D l r (size ∷ sizes) artifact⊆l,r | conf , artifact≡l,r with conf D -split-sizes-sublist n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡l,r | true = Prod.map (refl ∷_) (size ∷ʳ_) (split-sizes-sublist n D l r sizes (artifact∈l,r ∘ suc)) -split-sizes-sublist n D l r (size ∷ sizes) artifact∈l,r | conf , artifact≡l,r | false = Prod.map (size ∷ʳ_) (refl ∷_) (split-sizes-sublist n D l r sizes (artifact∈l,r ∘ suc)) + open Eq.≡-Reasoning -n*2^n≤size2CC : ∀ {i : Size} - → (n : ℕ) +-- TODO duplicated in OC≱2CC +partition : ∀ {i : Size} (n D : ℕ) + → (c₁ c₂ : 2CC.2CC i NAT') + → (ls : List ℕ) + → Unique ls + → All (λ l → variant n (suc l) ∈ 2CC.⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) ls + → ∃[ ls₁ ] ∃[ ls₂ ] + ls₁ Subset.⊆ ls × ls₂ Subset.⊆ ls + × List.length ls₁ + List.length ls₂ ≡ List.length ls + × Unique ls₁ × All (λ l → variant n (suc l) ∈ 2CC.⟦ c₁ ⟧) ls₁ + × Unique ls₂ × All (λ l → variant n (suc l) ∈ 2CC.⟦ c₂ ⟧) ls₂ +partition n D c₁ c₂ [] unique-ls ls⊆2cc = + [] , [] , + Subset.⊆-refl , Subset.⊆-refl , + Eq.refl , + [] , [] , + [] , [] +partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls⊆2cc) + with partition n D c₁ c₂ ls unique-ls ls⊆2cc +... | ls₁ , ls₂ , + ls₁⊆ls , ls₂⊆ls , + ls₁+ls₂≡ls , + unique-ls₁ , ls₁∈l , + unique-ls₂ , ls₂∈r + with c D +... | true = + l ∷ ls₁ , ls₂ , + Subset.∷⁺ʳ l ls₁⊆ls , there ∘ ls₂⊆ls , + Eq.cong suc ls₁+ls₂≡ls , + All.anti-mono ls₁⊆ls l∉ls ∷ unique-ls₁ , (c , l≡2cc) ∷ ls₁∈l , + unique-ls₂ , ls₂∈r +... | false = + ls₁ , l ∷ ls₂ , + there ∘ ls₁⊆ls , Subset.∷⁺ʳ l ls₂⊆ls , + Eq.trans + (ℕ.+-suc (List.length ls₁) (List.length ls₂)) + (Eq.cong suc ls₁+ls₂≡ls) , + unique-ls₁ , ls₁∈l , + All.anti-mono ls₂⊆ls l∉ls ∷ unique-ls₂ , (c , l≡2cc) ∷ ls₂∈r + +-- TODO duplicated in OC≱2CC +big : ∀ {i : Size} (n : ℕ) → (2cc : 2CC.2CC i NAT') - → (sizes : List ℕ) - → Unique sizes - → (variant n ∘ suc ∘ List.lookup sizes) ⊆ 2CC.⟦ 2cc ⟧ - → List.length sizes * 2 ^ n ≤ size2CC 2cc -n*2^n≤size2CC n (a 2CC.-< cs >-) [] unique-sizes sizes⊆2cc = z≤n -n*2^n≤size2CC n (a 2CC.-< cs >-) (s₁ ∷ []) unique-sizes sizes⊆2cc = - begin + → (ls : List ℕ) + → Unique ls + → All (λ l → variant n (suc l) ∈ 2CC.⟦ 2cc ⟧) ls + → List.length ls * 2 ^ n < size2CC 2cc +big n (a 2CC.-< cs >-) [] unique-ls all-∈ = s≤s z≤n +big n (a 2CC.-< cs >-) (l₁ ∷ []) unique-ls all-∈ = + begin-strict 1 * 2 ^ n ≡⟨ ℕ.*-identityˡ (2 ^ n) ⟩ 2 ^ n - ≤⟨ size-variant n s₁ ⟩ - sizeRose (variant n (suc s₁)) - ≤⟨ 2CC.reflectsVariantSize (variant n (suc s₁)) (a 2CC.-< cs >-) (sizes⊆2cc zero) ⟩ + <⟨ size-variant n l₁ ⟩ + sizeRose (variant n (suc l₁)) + ≤⟨ 2CC.reflectsVariantSize (variant n (suc l₁)) (a 2CC.-< cs >-) (All.lookup all-∈ (here Eq.refl)) ⟩ size2CC (a 2CC.-< cs >-) ∎ where open ℕ.≤-Reasoning -n*2^n≤size2CC n (a 2CC.-< cs >-) (s₁ ∷ s₂ ∷ sizes) ((s₁≢s₂ ∷ s₁∉sizes) ∷ unique-sizes) sizes⊆2cc = ⊥-elim - (impossible-artifact-sizes - n - cs - (List.applyUpTo (artifact n) (suc s₁)) - (List.applyUpTo (artifact n) (suc s₂)) - (λ length-s₁≡length-s₂ → s₁≢s₂ (ℕ.suc-injective (begin - suc s₁ - ≡⟨ List.length-applyUpTo (artifact n) (suc s₁) ⟨ - List.length (List.applyUpTo (artifact n) (suc s₁)) - ≡⟨ length-s₁≡length-s₂ ⟩ - List.length (List.applyUpTo (artifact n) (suc s₂)) - ≡⟨ List.length-applyUpTo (artifact n) (suc s₂) ⟩ - suc s₂ - ∎))) - (∈-children n (suc s₁) (List.applyUpTo (artifact n) (suc s₁)) cs (sizes⊆2cc zero)) - (∈-children n (suc s₂) (List.applyUpTo (artifact n) (suc s₂)) cs (sizes⊆2cc (suc zero))) - ) - where open Eq.≡-Reasoning -n*2^n≤size2CC n (D 2CC.⟨ l , r ⟩) sizes unique-sizes sizes⊆2cc = - begin - List.length sizes * 2 ^ n - ≤⟨ ℕ.*-monoˡ-≤ (2 ^ n) (split-sizes-length n D l r sizes sizes⊆2cc) ⟩ - (List.length (proj₁ (split-sizes n D l r sizes sizes⊆2cc)) + List.length (proj₂ (split-sizes n D l r sizes sizes⊆2cc))) * 2 ^ n - ≡⟨ ℕ.*-distribʳ-+ (2 ^ n) (List.length (proj₁ (split-sizes n D l r sizes sizes⊆2cc))) (List.length (proj₂ (split-sizes n D l r sizes sizes⊆2cc))) ⟩ - List.length (proj₁ (split-sizes n D l r sizes sizes⊆2cc)) * 2 ^ n + List.length (proj₂ (split-sizes n D l r sizes sizes⊆2cc)) * 2 ^ n - ≤⟨ ℕ.+-monoʳ-≤ (List.length (proj₁ (split-sizes n D l r sizes sizes⊆2cc)) * 2 ^ n) (n*2^n≤size2CC n r (proj₂ (split-sizes n D l r sizes sizes⊆2cc)) (List.AllPairs-resp-⊆ (proj₂ (split-sizes-sublist n D l r sizes sizes⊆2cc)) unique-sizes) (proj₂ (split-sizes⊆ n D l r sizes sizes⊆2cc))) ⟩ - List.length (proj₁ (split-sizes n D l r sizes sizes⊆2cc)) * 2 ^ n + size2CC r - ≤⟨ ℕ.+-monoˡ-≤ (size2CC r) (n*2^n≤size2CC n l (proj₁ (split-sizes n D l r sizes sizes⊆2cc)) (List.AllPairs-resp-⊆ (proj₁ (split-sizes-sublist n D l r sizes sizes⊆2cc)) unique-sizes) (proj₁ (split-sizes⊆ n D l r sizes sizes⊆2cc))) ⟩ - size2CC l + size2CC r - <⟨ s≤s ℕ.≤-refl ⟩ +big n (a 2CC.-< cs >-) (l₁ ∷ l₂ ∷ ls) ((l₁≢l₂ ∷ l₁∉ls) ∷ unique-ls) all-∈ = + ⊥-elim (l₁≢l₂ (ℕ.suc-injective (Eq.trans + (Eq.sym (variant∈e⇒length-cs n l₁ a cs (All.lookup all-∈ (here Eq.refl)))) + (variant∈e⇒length-cs n l₂ a cs (All.lookup all-∈ (there (here Eq.refl))))))) +big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ with partition n D l r ls unique-ls all-∈ +big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ + | ls₁ , ls₂ , + _ , _ , + ls₁+ls₂≡ls , + unique-ls₁ , ls₁∈l , + unique-ls₂ , ls₂∈r = + begin-strict + List.length ls * 2 ^ n + <⟨ ℕ.n<1+n (List.length ls * 2 ^ n) ⟩ + suc (List.length ls * 2 ^ n) + ≡⟨ Eq.cong (λ x → suc (x * 2 ^ n)) ls₁+ls₂≡ls ⟨ + suc ((List.length ls₁ + List.length ls₂) * 2 ^ n) + ≡⟨ Eq.cong suc (ℕ.*-distribʳ-+ (2 ^ n) (List.length ls₁) (List.length ls₂)) ⟩ + suc (List.length ls₁ * 2 ^ n + List.length ls₂ * 2 ^ n) + <⟨ s≤s (ℕ.+-mono-< (big n l ls₁ unique-ls₁ ls₁∈l) (big n r ls₂ unique-ls₂ ls₂∈r)) ⟩ suc (size2CC l + size2CC r) ≡⟨⟩ size2CC (D 2CC.⟨ l , r ⟩) @@ -506,8 +454,34 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( where open Eq.≡-Reasoning -variants⊆fst : ∀ (m : ℕ) → (variant m ∘ suc ∘ List.lookup (List.upTo m)) ⊆ FST.⟦ fst m ⟧ -variants⊆fst m size = Prod.map₂ (Eq.trans (Eq.cong (variant m ∘ suc) (List.lookup-upTo m size))) (variant∈fst m (Fin.toℕ size) (ℕ.≤-trans (Fin.toℕ≤n size) (ℕ.≤-reflexive (List.length-upTo m)))) +⊆⇒All∈ : ∀ {i} n l k + → k + l ≤ suc n + → (2cc : 2CC.2CC i NAT') + → FST.⟦ fst n ⟧ ⊆ 2CC.⟦ 2cc ⟧ + → All (λ l → variant n (suc l) ∈ 2CC.⟦ 2cc ⟧) (List.applyUpTo (k +_) l) +⊆⇒All∈ n zero k l≤n 2cc fst⊆2cc = [] +⊆⇒All∈ n (suc l) k l≤n 2cc fst⊆2cc with variant∈fst n k (ℕ.≤-pred ( + begin + suc k + ≤⟨ ℕ.m≤m+n (suc k) l ⟩ + suc k + l + ≡⟨ ℕ.+-suc k l ⟨ + k + suc l + ≤⟨ l≤n ⟩ + suc n + ∎)) + where + open ℕ.≤-Reasoning +⊆⇒All∈ n (suc l) k l≤n 2cc fst⊆2cc | fst-conf , variant≡fst with fst⊆2cc fst-conf +⊆⇒All∈ n (suc l) k l≤n 2cc fst⊆2cc | fst-conf , variant≡fst | 2cc-conf , fst≡2cc = + (2cc-conf , Eq.subst + (λ x → variant n (suc x) ≡ 2CC.⟦ 2cc ⟧ 2cc-conf) + (Eq.sym (ℕ.+-identityʳ k)) + (Eq.trans variant≡fst fst≡2cc)) + ∷ Eq.subst + (All (λ l → variant n (suc l) ∈ 2CC.⟦ 2cc ⟧)) + (List.applyUpTo-cong (λ l → Eq.sym (ℕ.+-suc k l)) l) + (⊆⇒All∈ n l (suc k) (ℕ.≤-trans (ℕ.≤-reflexive (Eq.sym (ℕ.+-suc k l))) l≤n) 2cc fst⊆2cc) 2*n≤2^n : (n : ℕ) → 2 * n ≤ 2 ^ n 2*n≤2^n zero = ℕ.n≤1+n zero @@ -564,7 +538,7 @@ FST≱2CC (suc n) = NAT' , fst m , λ 2cc fst≅2cc → m * 2 ^ m ≡⟨ Eq.cong (_* 2 ^ m) (List.length-upTo m) ⟨ List.length (List.upTo m) * 2 ^ m - ≤⟨ n*2^n≤size2CC m 2cc (List.upTo m) (Unique.upTo⁺ m) (⊆-trans (variants⊆fst m) (proj₁ fst≅2cc)) ⟩ + <⟨ big m 2cc (List.upTo m) (Unique.applyUpTo⁺₁ id m (λ i Date: Tue, 15 Jul 2025 16:24:05 +0200 Subject: [PATCH 35/82] =?UTF-8?q?Apply=20=CE=B7-conversion=20in=20FST?= =?UTF-8?q?=E2=89=B12CC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- "src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index d1ecc200..e0ac9b6d 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -236,7 +236,7 @@ select-applyUpTo-feature : ∀ (k n i : ℕ) → i ≤ n → select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) - ≡ List.applyUpTo (λ m → feature k m) (suc i) + ≡ List.applyUpTo (feature k) (suc i) select-applyUpTo-feature k n i i≤n = begin select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) @@ -245,7 +245,7 @@ select-applyUpTo-feature k n i i≤n = ≡⟨⟩ select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc i + offset)) ≡⟨ selects-init (suc i) zero refl ⟩ - List.applyUpTo (λ m → feature k m) (suc i) + List.applyUpTo (feature k) (suc i) ∎ where fst-config≡true : ∀ (j i' : ℕ) → j + suc i' ≡ suc i → fst-config i (j + zero) ≡ true From 875fc41297a8d23b2d3fa385a18e6754f4930b16 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 15 Jul 2025 15:55:20 +0200 Subject: [PATCH 36/82] =?UTF-8?q?Simplify=20FST=20evaluation=20in=20FST?= =?UTF-8?q?=E2=89=B12CC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Vatras/Lang/FST/Composition.agda | 37 ++++ .../FST\342\211\2612CC.agda" | 164 +++++------------- src/Vatras/Util/List.agda | 34 +++- 3 files changed, 113 insertions(+), 122 deletions(-) create mode 100644 src/Vatras/Lang/FST/Composition.agda diff --git a/src/Vatras/Lang/FST/Composition.agda b/src/Vatras/Lang/FST/Composition.agda new file mode 100644 index 00000000..4fc83406 --- /dev/null +++ b/src/Vatras/Lang/FST/Composition.agda @@ -0,0 +1,37 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸) +module Vatras.Lang.FST.Composition (F : 𝔽) (A : 𝔸) where + +open import Data.List as List using (List; []; _∷_; _++_) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl) + +import Vatras.Util.List as List +import Vatras.Lang.FST +open Vatras.Lang.FST.Impose F A + +⊛-all-unique + : (fs : List FSF) + → Unique (List.concatMap forget-uniqueness fs) + → forget-uniqueness (⊛-all fs) ≡ List.concatMap forget-uniqueness fs +⊛-all-unique [] unique-fs = refl +⊛-all-unique (f ∷ fs) unique-fs = + forget-uniqueness (⊛-all (f ∷ fs)) + ≡⟨⟩ + forget-uniqueness f ⊕ forget-uniqueness (⊛-all fs) + ≡⟨ Eq.cong (forget-uniqueness f ⊕_) (⊛-all-unique fs (List.AllPairs-++⁻ʳ (forget-uniqueness f) unique-fs)) ⟩ + forget-uniqueness f ⊕ List.concatMap forget-uniqueness fs + ≡⟨ ⊕-strangers + (forget-uniqueness f) + (List.concatMap forget-uniqueness fs) + (List.AllPairs-++⁻ʳ (forget-uniqueness f) unique-fs) + (List.AllAll-comm + (List.concatMap forget-uniqueness fs) + (forget-uniqueness f) + ≉-sym + (List.AllPairs⇒AllAll (forget-uniqueness f) (List.concatMap forget-uniqueness fs) unique-fs)) + ⟩ + forget-uniqueness f ++ List.concatMap forget-uniqueness fs + ≡⟨⟩ + List.concatMap forget-uniqueness (f ∷ fs) + ∎ + where + open Eq.≡-Reasoning diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index e0ac9b6d..4d2a9bcd 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -7,7 +7,7 @@ open import Data.Nat as ℕ using (ℕ; suc; zero; _≤_; _<_; z≤n; s≤s; _>_ import Data.Nat.Properties as ℕ open import Data.Fin as Fin using (Fin; zero; suc) import Data.Fin.Properties as Fin -open import Data.List as List using (List; []; _∷_) +open import Data.List as List using (List; []; _∷_; _++_) import Data.List.Properties as List import Data.List.Membership.Propositional as List open import Data.List.Relation.Binary.Sublist.Propositional as Sublist using ([]; _∷_; _∷ʳ_) @@ -16,8 +16,9 @@ import Data.List.Relation.Binary.Subset.Propositional.Properties as Subset open import Data.List.Relation.Unary.Any using (here; there) open import Data.List.Relation.Unary.All as All using (All; []; _∷_) import Data.List.Relation.Unary.All.Properties as All -open import Data.List.Relation.Unary.AllPairs using ([]; _∷_) -open import Data.List.Relation.Unary.Unique.Propositional using (Unique) +open import Data.List.Relation.Unary.AllPairs using (AllPairs; []; _∷_) +import Data.List.Relation.Unary.AllPairs.Properties as AllPairs +import Data.List.Relation.Unary.Unique.Propositional as List import Data.List.Relation.Unary.Unique.Propositional.Properties as Unique open import Data.Product as Prod using (_×_; _,_; proj₁; proj₂; Σ-syntax; ∃-syntax) import Data.Product.Properties as Prod @@ -45,7 +46,8 @@ NAT' = record ; atomSize = proj₂ } -open FST.Impose NAT' hiding (Unique; _∈_) +open FST.Impose NAT' hiding (_∈_) +open import Vatras.Lang.FST.Composition ℕ NAT' using (⊛-all-unique) -- TODO duplicated from 2CC≤CCC >⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ℕ.≤ᵇ n)) @@ -146,13 +148,13 @@ variant∈e⇒length-cs n l a cs (c , v≡e) = partition : ∀ {i : Size} (n D : ℕ) → (c₁ c₂ : 2CC.2CC i NAT') → (ls : List ℕ) - → Unique ls + → List.Unique ls → All (λ l → variant n (suc l) ∈ 2CC.⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) ls → ∃[ ls₁ ] ∃[ ls₂ ] ls₁ Subset.⊆ ls × ls₂ Subset.⊆ ls × List.length ls₁ + List.length ls₂ ≡ List.length ls - × Unique ls₁ × All (λ l → variant n (suc l) ∈ 2CC.⟦ c₁ ⟧) ls₁ - × Unique ls₂ × All (λ l → variant n (suc l) ∈ 2CC.⟦ c₂ ⟧) ls₂ + × List.Unique ls₁ × All (λ l → variant n (suc l) ∈ 2CC.⟦ c₁ ⟧) ls₁ + × List.Unique ls₂ × All (λ l → variant n (suc l) ∈ 2CC.⟦ c₂ ⟧) ls₂ partition n D c₁ c₂ [] unique-ls ls⊆2cc = [] , [] , Subset.⊆-refl , Subset.⊆-refl , @@ -186,7 +188,7 @@ partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls big : ∀ {i : Size} (n : ℕ) → (2cc : 2CC.2CC i NAT') → (ls : List ℕ) - → Unique ls + → List.Unique ls → All (λ l → variant n (suc l) ∈ 2CC.⟦ 2cc ⟧) ls → List.length ls * 2 ^ n < size2CC 2cc big n (a 2CC.-< cs >-) [] unique-ls all-∈ = s≤s z≤n @@ -323,115 +325,31 @@ select-applyUpTo-feature k n i i≤n = List.applyUpTo (λ m → feature k (j + m)) (suc i') ∎ -forget-uniqueness-⊛-all : - ∀ (as : List FSF) - → forget-uniqueness (⊛-all as) ≡ List.foldr _⊕_ [] (List.map forget-uniqueness as) -forget-uniqueness-⊛-all [] = refl -forget-uniqueness-⊛-all (a ∷ as) = - begin - forget-uniqueness (⊛-all (a ∷ as)) - ≡⟨⟩ - forget-uniqueness (a ⊛ (⊛-all as)) - ≡⟨⟩ - forget-uniqueness a ⊕ forget-uniqueness (⊛-all as) - ≡⟨ Eq.cong (λ x → forget-uniqueness a ⊕ x) (forget-uniqueness-⊛-all as) ⟩ - forget-uniqueness a ⊕ List.foldr _⊕_ [] (List.map forget-uniqueness as) - ≡⟨⟩ - List.foldr _⊕_ [] (forget-uniqueness a ∷ List.map forget-uniqueness as) - ≡⟨⟩ - List.foldr _⊕_ [] (List.map forget-uniqueness (a ∷ as)) - ∎ - where - open Eq.≡-Reasoning - -artifacts⊙artifact : - ∀ (n i k : ℕ) - → List.applyUpTo (λ m → artifact n (m + k)) i ⊙ artifact n (i + k) - ≡ List.applyUpTo (λ m → artifact n (m + k)) (suc i) -artifacts⊙artifact n zero k = refl -artifacts⊙artifact n (suc i) k with artifact n (suc i + k) == artifact n k -artifacts⊙artifact n (suc i) k | no _ = - begin - artifact n k ∷ (List.applyUpTo (λ m → artifact n (suc m + k)) i ⊙ artifact n (suc i + k)) - ≡⟨ Eq.cong (λ x → artifact n k ∷ (x ⊙ artifact n (suc i + k))) (List.applyUpTo-cong (λ m → Eq.cong (artifact n) (ℕ.+-suc m k)) i) ⟨ - artifact n k ∷ (List.applyUpTo (λ m → artifact n (m + suc k)) i ⊙ artifact n (suc i + k)) - ≡⟨ Eq.cong (λ x → artifact n k ∷ (List.applyUpTo (λ m → artifact n (m + suc k)) i ⊙ artifact n x)) (ℕ.+-suc i k) ⟨ - artifact n k ∷ (List.applyUpTo (λ m → artifact n (m + suc k)) i ⊙ artifact n (i + suc k)) - ≡⟨ Eq.cong (artifact n k ∷_) (artifacts⊙artifact n i (suc k)) ⟩ - artifact n k ∷ List.applyUpTo (λ m → artifact n (m + suc k)) (suc i) - ≡⟨ Eq.cong (artifact n k ∷_) (List.applyUpTo-cong (λ m → Eq.cong (artifact n) (ℕ.+-suc m k)) (suc i)) ⟩ - artifact n k ∷ List.applyUpTo (λ m → artifact n (suc m + k)) (suc i) - ≡⟨⟩ - List.applyUpTo (λ m → artifact n (m + k)) (suc (suc i)) - ∎ +unique-variant : ∀ n m i → Unique (List.concatMap forget-uniqueness (List.applyUpTo (λ k → feature n (m + k)) i)) +unique-variant n m zero = [] +unique-variant n m (suc i) = + go i m ℕ.≤-refl + ∷ Eq.subst + (λ x → Unique (List.concatMap forget-uniqueness x)) + (List.applyUpTo-cong (λ k → Eq.cong (feature n) (Eq.sym (ℕ.+-suc m k))) i) + (unique-variant n (suc m) i) where - open Eq.≡-Reasoning -artifacts⊙artifact n (suc i) (suc k) | yes artifact-1+i+k≈artifact-k = ⊥-elim (ℕ.1+n≰n (ℕ.≤-trans (ℕ.m≤n+m (suc k) i) (ℕ.≤-reflexive (ℕ.suc-injective (Prod.,-injectiveˡ artifact-1+i+k≈artifact-k))))) + artifacts-≉ : ∀ {i} {j} → i ≢ j → artifact n i ≉ artifact n j + artifacts-≉ {zero} {zero} i≢j refl = i≢j refl + artifacts-≉ {suc i} {suc j} i≢j refl = i≢j refl -artifact⊕artifacts : - ∀ (n i k : ℕ) - → (artifact n k ∷ []) ⊕ List.applyUpTo (λ m → artifact n (suc m + k)) i - ≡ List.applyUpTo (λ m → artifact n (m + k)) (suc i) -artifact⊕artifacts n i k = go 1 i k - where - go : ∀ (i j k : ℕ) - → List.applyUpTo (λ m → artifact n (m + k)) i ⊕ List.applyUpTo (λ m → artifact n (i + m + k)) j - ≡ List.applyUpTo (λ m → artifact n (m + k)) (i + j) - go i zero k = Eq.cong (List.applyUpTo (λ m → artifact n (m + k))) (Eq.sym (ℕ.+-identityʳ i)) - go i (suc j) k = - begin - List.applyUpTo (λ m → artifact n (m + k)) i ⊕ List.applyUpTo (λ m → artifact n (i + m + k)) (suc j) - ≡⟨⟩ - List.applyUpTo (λ m → artifact n (m + k)) i ⊕ (artifact n (i + zero + k) ∷ List.applyUpTo (λ m → artifact n (i + suc m + k)) j) - ≡⟨ Eq.cong (λ x → List.applyUpTo (λ m → artifact n (m + k)) i ⊕ (artifact n (x + k) ∷ List.applyUpTo (λ m → artifact n (i + suc m + k)) j)) (ℕ.+-identityʳ i) ⟩ - List.applyUpTo (λ m → artifact n (m + k)) i ⊕ (artifact n (i + k) ∷ List.applyUpTo (λ m → artifact n (i + suc m + k)) j) - ≡⟨⟩ - (List.applyUpTo (λ m → artifact n (m + k)) i ⊙ artifact n (i + k)) ⊕ List.applyUpTo (λ m → artifact n (i + suc m + k)) j - ≡⟨ Eq.cong (_⊕ List.applyUpTo (λ m → artifact n (i + suc m + k)) j) (artifacts⊙artifact n i k) ⟩ - List.applyUpTo (λ m → artifact n (m + k)) (suc i) ⊕ List.applyUpTo (λ m → artifact n (i + suc m + k)) j - ≡⟨ Eq.cong (λ x → List.applyUpTo (λ m → artifact n (m + k)) (suc i) ⊕ x) (List.applyUpTo-cong (λ m → Eq.cong (λ x → artifact n (x + k)) (ℕ.+-suc i m)) j) ⟩ - List.applyUpTo (λ m → artifact n (m + k)) (suc i) ⊕ List.applyUpTo (λ m → artifact n (suc i + m + k)) j - ≡⟨ go (suc i) j k ⟩ - List.applyUpTo (λ m → artifact n (m + k)) (suc i + j) - ≡⟨ Eq.cong (List.applyUpTo (λ m → artifact n (m + k))) (ℕ.+-suc i j) ⟨ - List.applyUpTo (λ m → artifact n (m + k)) (i + suc j) - ∎ + go : ∀ i' m' → m ≤ m' → All (_≉_ (artifact n (m + zero))) (List.concatMap forget-uniqueness (List.applyUpTo (λ k → feature n (m' + suc k)) i')) + go zero m' m≤m' = [] + go (suc i') m' m≤m' = artifacts-≉ (ℕ.<⇒≢ ( + begin-strict + m + 0 + <⟨ ℕ.+-monoʳ-< m (ℕ.n<1+n 0) ⟩ + m + 1 + ≤⟨ ℕ.+-monoˡ-≤ 1 m≤m' ⟩ + m' + 1 + ∎)) ∷ Eq.subst (λ x → All (_≉_ (artifact n (m + zero))) (List.concatMap forget-uniqueness x)) (List.applyUpTo-cong (λ k → Eq.cong (feature n) (Eq.sym (ℕ.+-suc m' (suc k)))) i') (go i' (suc m') (ℕ.≤-trans m≤m' (ℕ.n≤1+n m'))) where - open Eq.≡-Reasoning - -foldr-⊕-artifacts : - ∀ (n i : ℕ) - → List.applyUpTo (artifact n) i - ≡ List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n m ∷ []) i) -foldr-⊕-artifacts n i = go i zero - where - open Eq.≡-Reasoning - - go : - ∀ (i j : ℕ) - → List.applyUpTo (λ m → artifact n (j + m)) i - ≡ List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n (j + m) ∷ []) i) - go zero j = refl - go (suc i) j = - begin - List.applyUpTo (λ m → artifact n (j + m)) (suc i) - ≡⟨ List.applyUpTo-cong (λ m → Eq.cong (artifact n) (ℕ.+-comm j m)) (suc i) ⟩ - List.applyUpTo (λ m → artifact n (m + j)) (suc i) - ≡⟨ artifact⊕artifacts n i j ⟨ - (artifact n j ∷ []) ⊕ List.applyUpTo (λ m → artifact n (suc m + j)) i - ≡⟨ Eq.cong ((artifact n j ∷ []) ⊕_) (List.applyUpTo-cong (λ m → Eq.cong (λ x → artifact n (suc x)) (ℕ.+-comm m j)) i) ⟩ - (artifact n j ∷ []) ⊕ List.applyUpTo (λ m → artifact n (suc j + m)) i - ≡⟨ Eq.cong ((artifact n j ∷ []) ⊕_) (go i (suc j)) ⟩ - (artifact n j ∷ []) ⊕ List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n (suc j + m) ∷ []) i) - ≡⟨ Eq.cong (λ x → (artifact n j ∷ []) ⊕ List.foldr _⊕_ [] x) (List.applyUpTo-cong (λ m → Eq.cong (λ x → artifact n x ∷ []) (ℕ.+-suc j m)) i) ⟨ - (artifact n j ∷ []) ⊕ List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n (j + suc m) ∷ []) i) - ≡⟨⟩ - List.foldr _⊕_ [] ((artifact n j ∷ []) ∷ List.applyUpTo (λ m → artifact n (j + suc m) ∷ []) i) - ≡⟨ Eq.cong (λ x → List.foldr _⊕_ [] ((artifact n x ∷ []) ∷ List.applyUpTo (λ m → artifact n (j + suc m) ∷ []) i)) (ℕ.+-identityʳ j) ⟨ - List.foldr _⊕_ [] ((artifact n (j + zero) ∷ []) ∷ List.applyUpTo (λ m → artifact n (j + suc m) ∷ []) i) - ≡⟨⟩ - List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n (j + m) ∷ []) (suc i)) - ∎ + open ℕ.≤-Reasoning variant∈fst : ∀ (n i : ℕ) @@ -440,13 +358,19 @@ variant∈fst : variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( begin List.applyUpTo (artifact n) (suc i) - ≡⟨ foldr-⊕-artifacts n (suc i) ⟩ - List.foldr _⊕_ [] (List.applyUpTo (λ m → artifact n m ∷ []) (suc i)) + ≡⟨ List.map-applyUpTo (artifact n) id (suc i) ⟨ + List.map (artifact n) (List.upTo (suc i)) + ≡⟨ List.concat-[-] (List.map (artifact n) (List.upTo (suc i))) ⟨ + List.concat (List.map (_∷ []) (List.map (artifact n) (List.upTo (suc i)))) + ≡⟨ Eq.cong List.concat (List.map-∘ {g = (_∷ [])} (List.upTo (suc i))) ⟨ + List.concat (List.map (λ k → artifact n k ∷ []) (List.upTo (suc i))) ≡⟨⟩ - List.foldr _⊕_ [] (List.applyUpTo (forget-uniqueness ∘ feature n) (suc i)) - ≡⟨ Eq.cong (λ x → List.foldr _⊕_ [] x) (List.map-applyUpTo forget-uniqueness (feature n) (suc i)) ⟨ - List.foldr _⊕_ [] (List.map forget-uniqueness (List.applyUpTo (feature n) (suc i))) - ≡⟨ forget-uniqueness-⊛-all (List.applyUpTo (feature n) (suc i)) ⟨ + List.concat (List.map (λ k → forget-uniqueness (feature n k)) (List.upTo (suc i))) + ≡⟨ Eq.cong List.concat (List.map-∘ {g = forget-uniqueness} {f = feature n} (List.upTo (suc i))) ⟩ + List.concatMap forget-uniqueness (List.map (feature n) (List.upTo (suc i))) + ≡⟨ Eq.cong (List.concatMap forget-uniqueness) (List.map-applyUpTo (feature n) id (suc i)) ⟩ + List.concatMap forget-uniqueness (List.applyUpTo (feature n) (suc i)) + ≡⟨ ⊛-all-unique (List.applyUpTo (feature n) (suc i)) (unique-variant n zero (suc i)) ⟨ forget-uniqueness (⊛-all (List.applyUpTo (feature n) (suc i))) ≡⟨ Eq.cong (λ x → forget-uniqueness (⊛-all x)) (select-applyUpTo-feature n n i i≤n) ⟨ forget-uniqueness (⊛-all (select (fst-config i) (List.applyUpTo (λ m → m :: feature n m) (suc n)))) diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index 31485422..e38d32a7 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -15,7 +15,8 @@ open import Data.List.Membership.Propositional using (_∈_) import Data.List.Membership.Propositional.Properties as List open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_; toList; _⁺++⁺_) renaming (map to map⁺) open import Data.List.Relation.Binary.Subset.Propositional using (_⊆_) -open import Data.List.Relation.Unary.All using (All; _∷_) +open import Data.List.Relation.Unary.All as All using (All; []; _∷_) +import Data.List.Relation.Unary.All.Properties as All open import Data.List.Relation.Unary.Any using (here; there) open import Data.Product using (_,_) open import Data.Vec as Vec using (Vec; []; _∷_) @@ -323,7 +324,7 @@ sum-* n (x ∷ xs) = module _ where open import Data.List.Relation.Binary.Sublist.Propositional using (_⊇_; []; _∷_; _∷ʳ_) import Data.List.Relation.Binary.Sublist.Propositional.Properties as Sublist - open import Data.List.Relation.Unary.AllPairs using (AllPairs; []; _∷_) + open import Data.List.Relation.Unary.AllPairs as AllPairs using (AllPairs; []; _∷_) open import Relation.Binary using (Rel; _Respects_) AllPairs-resp-⊆ : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} → {R : Rel A ℓ₂} → (AllPairs R) Respects _⊇_ @@ -331,6 +332,35 @@ module _ where AllPairs-resp-⊆ (y ∷ʳ xs⊇ys) (All-x ∷ AllPairs-xs) = AllPairs-resp-⊆ xs⊇ys AllPairs-xs AllPairs-resp-⊆ {x = .(_ ∷ _)} {.(_ ∷ _)} (refl ∷ xs⊇ys) (All-x ∷ AllPairs-xs) = Sublist.All-resp-⊆ xs⊇ys All-x ∷ AllPairs-resp-⊆ xs⊇ys AllPairs-xs + AllPairs-++⁻ˡ : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {P : A → A → Set ℓ₂} + → (xs : List A) {ys : List A} + → AllPairs P (xs ++ ys) + → AllPairs P xs + AllPairs-++⁻ˡ [] allPairs = [] + AllPairs-++⁻ˡ (x ∷ xs) (P-x ∷ allPairs) = All.++⁻ˡ xs P-x ∷ AllPairs-++⁻ˡ xs allPairs + + AllPairs-++⁻ʳ : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {P : A → A → Set ℓ₂} + → (xs : List A) {ys : List A} + → AllPairs P (xs ++ ys) + → AllPairs P ys + AllPairs-++⁻ʳ [] allPairs = allPairs + AllPairs-++⁻ʳ (x ∷ xs) allPairs = AllPairs-++⁻ʳ xs (AllPairs.tail allPairs) + + AllPairs⇒AllAll : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {P : A → A → Set ℓ₂} + → (xs ys : List A) + → AllPairs P (xs ++ ys) + → All (λ y → All (P y) ys) xs + AllPairs⇒AllAll [] ys allPairs = [] + AllPairs⇒AllAll (x ∷ xs) ys (P-x ∷ allPairs) = All.++⁻ʳ xs P-x ∷ AllPairs⇒AllAll xs ys allPairs + + AllAll-comm : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {P : A → A → Set ℓ₂} + → (xs ys : List A) + → (∀ {x} {y} → P x y → P y x) + → All (λ y → All (P y) xs) ys + → All (λ y → All (P y) ys) xs + AllAll-comm [] ys sym all-all = [] + AllAll-comm (x ∷ xs) ys sym all-all = All.map (λ All-P-y-xs → sym (All.head All-P-y-xs)) all-all ∷ AllAll-comm xs ys sym (All.map All.tail all-all) + map-applyUpTo : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {B : Set ℓ₂} → (f : A → B) → (g : ℕ → A) From 865509df286d901dee8ce94848259958d6912d13 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 15 Jul 2025 17:42:40 +0200 Subject: [PATCH 37/82] =?UTF-8?q?FST=E2=89=B12CC:=20Only=20define=20varian?= =?UTF-8?q?ts=20that=20are=20needed?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../FST\342\211\2612CC.agda" | 28 +++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index 4d2a9bcd..cb607cde 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -101,11 +101,11 @@ size-fst n = open Eq.≡-Reasoning variant : ℕ → ℕ → FSTA ∞ -variant n i = (0 , 0) Rose.-< List.applyUpTo (artifact n) i >- +variant n i = (0 , 0) Rose.-< List.applyUpTo (artifact n) (suc i) >- size-variant : (n i : ℕ) - → 2 ^ n < sizeRose (variant n (suc i)) + → 2 ^ n < sizeRose (variant n i) size-variant n i = begin-strict 2 ^ n @@ -118,7 +118,7 @@ size-variant n i = ≡⟨⟩ 1 + sizeRose (artifact n zero) + List.sum (List.map sizeRose (List.applyUpTo (artifact n ∘ suc) i)) ≡⟨⟩ - sizeRose (variant n (suc i)) + sizeRose (variant n i) ∎ where open ℕ.≤-Reasoning @@ -130,7 +130,7 @@ size-variant n i = -- TODO duplicated in OC≱2CC variant∈e⇒length-cs : ∀ {i} (n l : ℕ) (a : ℕ × ℕ) (cs : List (2CC.2CC i NAT')) - → variant n (suc l) ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ + → variant n l ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ → List.length cs ≡ suc l variant∈e⇒length-cs n l a cs (c , v≡e) = List.length cs @@ -149,12 +149,12 @@ partition : ∀ {i : Size} (n D : ℕ) → (c₁ c₂ : 2CC.2CC i NAT') → (ls : List ℕ) → List.Unique ls - → All (λ l → variant n (suc l) ∈ 2CC.⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) ls + → All (λ l → variant n l ∈ 2CC.⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) ls → ∃[ ls₁ ] ∃[ ls₂ ] ls₁ Subset.⊆ ls × ls₂ Subset.⊆ ls × List.length ls₁ + List.length ls₂ ≡ List.length ls - × List.Unique ls₁ × All (λ l → variant n (suc l) ∈ 2CC.⟦ c₁ ⟧) ls₁ - × List.Unique ls₂ × All (λ l → variant n (suc l) ∈ 2CC.⟦ c₂ ⟧) ls₂ + × List.Unique ls₁ × All (λ l → variant n l ∈ 2CC.⟦ c₁ ⟧) ls₁ + × List.Unique ls₂ × All (λ l → variant n l ∈ 2CC.⟦ c₂ ⟧) ls₂ partition n D c₁ c₂ [] unique-ls ls⊆2cc = [] , [] , Subset.⊆-refl , Subset.⊆-refl , @@ -189,7 +189,7 @@ big : ∀ {i : Size} (n : ℕ) → (2cc : 2CC.2CC i NAT') → (ls : List ℕ) → List.Unique ls - → All (λ l → variant n (suc l) ∈ 2CC.⟦ 2cc ⟧) ls + → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) ls → List.length ls * 2 ^ n < size2CC 2cc big n (a 2CC.-< cs >-) [] unique-ls all-∈ = s≤s z≤n big n (a 2CC.-< cs >-) (l₁ ∷ []) unique-ls all-∈ = @@ -198,8 +198,8 @@ big n (a 2CC.-< cs >-) (l₁ ∷ []) unique-ls all-∈ = ≡⟨ ℕ.*-identityˡ (2 ^ n) ⟩ 2 ^ n <⟨ size-variant n l₁ ⟩ - sizeRose (variant n (suc l₁)) - ≤⟨ 2CC.reflectsVariantSize (variant n (suc l₁)) (a 2CC.-< cs >-) (All.lookup all-∈ (here Eq.refl)) ⟩ + sizeRose (variant n l₁) + ≤⟨ 2CC.reflectsVariantSize (variant n l₁) (a 2CC.-< cs >-) (All.lookup all-∈ (here Eq.refl)) ⟩ size2CC (a 2CC.-< cs >-) ∎ where @@ -354,7 +354,7 @@ unique-variant n m (suc i) = variant∈fst : ∀ (n i : ℕ) → i ≤ n - → variant n (suc i) ∈ FST.⟦ fst n ⟧ + → variant n i ∈ FST.⟦ fst n ⟧ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( begin List.applyUpTo (artifact n) (suc i) @@ -382,7 +382,7 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( → k + l ≤ suc n → (2cc : 2CC.2CC i NAT') → FST.⟦ fst n ⟧ ⊆ 2CC.⟦ 2cc ⟧ - → All (λ l → variant n (suc l) ∈ 2CC.⟦ 2cc ⟧) (List.applyUpTo (k +_) l) + → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) (List.applyUpTo (k +_) l) ⊆⇒All∈ n zero k l≤n 2cc fst⊆2cc = [] ⊆⇒All∈ n (suc l) k l≤n 2cc fst⊆2cc with variant∈fst n k (ℕ.≤-pred ( begin @@ -399,11 +399,11 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( ⊆⇒All∈ n (suc l) k l≤n 2cc fst⊆2cc | fst-conf , variant≡fst with fst⊆2cc fst-conf ⊆⇒All∈ n (suc l) k l≤n 2cc fst⊆2cc | fst-conf , variant≡fst | 2cc-conf , fst≡2cc = (2cc-conf , Eq.subst - (λ x → variant n (suc x) ≡ 2CC.⟦ 2cc ⟧ 2cc-conf) + (λ x → variant n x ≡ 2CC.⟦ 2cc ⟧ 2cc-conf) (Eq.sym (ℕ.+-identityʳ k)) (Eq.trans variant≡fst fst≡2cc)) ∷ Eq.subst - (All (λ l → variant n (suc l) ∈ 2CC.⟦ 2cc ⟧)) + (All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧)) (List.applyUpTo-cong (λ l → Eq.sym (ℕ.+-suc k l)) l) (⊆⇒All∈ n l (suc k) (ℕ.≤-trans (ℕ.≤-reflexive (Eq.sym (ℕ.+-suc k l))) l≤n) 2cc fst⊆2cc) From 15aeaee70a7760def9ebda324d1601d483c96fab Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 15 Jul 2025 18:26:14 +0200 Subject: [PATCH 38/82] =?UTF-8?q?Make=20FST=E2=89=B12CC=20more=20readable?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../FST\342\211\2612CC.agda" | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index cb607cde..0cc91d29 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -123,7 +123,9 @@ size-variant n i = where open ℕ.≤-Reasoning -1≤size2CC : ∀ {i : Size} {A : 𝔸} → (e : 2CC.2CC i A) → 1 ≤ size2CC e +1≤size2CC : ∀ {i : Size} {A : 𝔸} + → (e : 2CC.2CC i A) + → 1 ≤ size2CC e 1≤size2CC (a 2CC.-< cs >-) = s≤s z≤n 1≤size2CC (D 2CC.⟨ l , r ⟩) = s≤s z≤n @@ -347,7 +349,10 @@ unique-variant n m (suc i) = m + 1 ≤⟨ ℕ.+-monoˡ-≤ 1 m≤m' ⟩ m' + 1 - ∎)) ∷ Eq.subst (λ x → All (_≉_ (artifact n (m + zero))) (List.concatMap forget-uniqueness x)) (List.applyUpTo-cong (λ k → Eq.cong (feature n) (Eq.sym (ℕ.+-suc m' (suc k)))) i') (go i' (suc m') (ℕ.≤-trans m≤m' (ℕ.n≤1+n m'))) + ∎)) ∷ Eq.subst + (λ x → All (_≉_ (artifact n (m + zero))) (List.concatMap forget-uniqueness x)) + (List.applyUpTo-cong (λ k → Eq.cong (feature n) (Eq.sym (ℕ.+-suc m' (suc k)))) i') + (go i' (suc m') (ℕ.≤-trans m≤m' (ℕ.n≤1+n m'))) where open ℕ.≤-Reasoning @@ -462,7 +467,13 @@ FST≱2CC (suc n) = NAT' , fst m , λ 2cc fst≅2cc → m * 2 ^ m ≡⟨ Eq.cong (_* 2 ^ m) (List.length-upTo m) ⟨ List.length (List.upTo m) * 2 ^ m - <⟨ big m 2cc (List.upTo m) (Unique.applyUpTo⁺₁ id m (λ i Date: Tue, 15 Jul 2025 20:20:06 +0200 Subject: [PATCH 39/82] =?UTF-8?q?FST=E2=89=B12CC:=20Simplify=20`select-app?= =?UTF-8?q?lyUpTo-feature`?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This proof is much easier to digest as it mostly relies on reusable theorems. --- src/Vatras/Lang/FST/Util.agda | 19 +++ .../FST\342\211\2612CC.agda" | 121 ++++++------------ src/Vatras/Util/List.agda | 7 + 3 files changed, 64 insertions(+), 83 deletions(-) create mode 100644 src/Vatras/Lang/FST/Util.agda diff --git a/src/Vatras/Lang/FST/Util.agda b/src/Vatras/Lang/FST/Util.agda new file mode 100644 index 00000000..2667feb5 --- /dev/null +++ b/src/Vatras/Lang/FST/Util.agda @@ -0,0 +1,19 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) +module Vatras.Lang.FST.Util (F : 𝔽) (A : 𝔸) where + +open import Data.Bool using (true; false) +open import Data.List as List using ([]; _∷_) +open import Function using (_∘_) +open import Relation.Binary.PropositionalEquality as Eq using (_≗_; refl) + +import Vatras.Lang.FST +open Vatras.Lang.FST F using (Configuration) +open Vatras.Lang.FST.Impose F A using (select; impl; name; _::_) + +select≗filter + : (config : Configuration) + → select config ≗ List.map impl ∘ List.filterᵇ (config ∘ name) +select≗filter config [] = refl +select≗filter config ((name :: impl) ∷ fs) with config name +select≗filter config ((name :: impl) ∷ fs) | true = Eq.cong (impl ∷_) (select≗filter config fs) +select≗filter config ((name :: impl) ∷ fs) | false = select≗filter config fs diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index 0cc91d29..c6227dfb 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -25,9 +25,10 @@ import Data.Product.Properties as Prod open import Data.Unit using (tt) open import Function using (_∘_; _∘′_; const; id) open import Function.Bundles using (Equivalence) -open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_; refl) -open import Relation.Nullary.Decidable using (yes; no) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≗_; _≢_; refl) +open import Relation.Nullary.Decidable using (Dec; yes; no) open import Relation.Nullary.Negation using (¬_) +open import Relation.Unary using (Decidable) open import Size using (Size; ∞) open import Vatras.Data.EqIndexedSet using (_⊆_; ⊆-trans; _∈_) @@ -48,11 +49,7 @@ NAT' = record open FST.Impose NAT' hiding (_∈_) open import Vatras.Lang.FST.Composition ℕ NAT' using (⊛-all-unique) - --- TODO duplicated from 2CC≤CCC ->⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ℕ.≤ᵇ n)) ->⇒¬≤ᵇ (s≤s z≤n) = tt ->⇒¬≤ᵇ (s≤s (s≤s m>n)) = >⇒¬≤ᵇ (s≤s m>n) +open import Vatras.Lang.FST.Util ℕ NAT' using (select≗filter) artifact : ℕ → ℕ → FSTA ∞ artifact n zero = (0 , 2 ^ n) Rose.-< [] >- @@ -242,90 +239,48 @@ select-applyUpTo-feature : → select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) ≡ List.applyUpTo (feature k) (suc i) select-applyUpTo-feature k n i i≤n = - begin select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) - ≡⟨ Eq.cong (λ x → select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc x))) (ℕ.m+[n∸m]≡n i≤n) ⟨ - select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc (i + (n ∸ i)))) - ≡⟨⟩ - select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc i + offset)) - ≡⟨ selects-init (suc i) zero refl ⟩ + ≡⟨ select≗filter (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) ⟩ + List.map impl (List.filter P? (List.applyUpTo (λ m → m :: feature k m) (suc n))) + ≡⟨ Eq.cong (λ x → List.map impl (List.filterᵇ (fst-config i ∘ name) (List.applyUpTo (λ m → m :: feature k m) (suc x)))) (ℕ.m+[n∸m]≡n i≤n) ⟨ + List.map impl (List.filter P? (List.applyUpTo (λ m → m :: feature k m) (suc i + (n ∸ i)))) + ≡⟨ Eq.cong (λ x → List.map impl (List.filterᵇ (fst-config i ∘ name) x)) (List.applyUpTo-++⁺ (λ m → m :: feature k m) (suc i) (n ∸ i)) ⟩ + List.map impl (List.filter P? + ( List.applyUpTo (λ m → m :: feature k m) (suc i) + ++ List.applyUpTo (λ m → suc i + m :: feature k (suc i + m)) (n ∸ i))) + ≡⟨ Eq.cong (List.map impl) (List.filter-++ (Bool.T? ∘ fst-config i ∘ name) + (List.applyUpTo (λ m → m :: feature k m) (suc i)) + (List.applyUpTo (λ m → suc i + m :: feature k (suc i + m)) (n ∸ i)) ) + ⟩ + List.map impl + ( List.filter P? (List.applyUpTo (λ m → m :: feature k m) (suc i)) + ++ List.filter P? (List.applyUpTo (λ m → suc i + m :: feature k (suc i + m)) (n ∸ i))) + ≡⟨ Eq.cong (List.map impl) (Eq.cong₂ _++_ + (List.filter-all P? + (All.applyUpTo⁺₁ (λ m → m :: feature k m) (suc i) P-true)) + (List.filter-none P? + (All.applyUpTo⁺₂ (λ m → suc i + m :: feature k (suc i + m)) (n ∸ i) P-false))) + ⟩ + List.map impl (List.applyUpTo (λ m → m :: feature k m) (suc i) ++ []) + ≡⟨ Eq.cong (List.map impl) (List.++-identityʳ (List.applyUpTo (λ m → m :: feature k m) (suc i))) ⟩ + List.map impl (List.applyUpTo (λ m → m :: feature k m) (suc i)) + ≡⟨ List.map-applyUpTo impl (λ m → m :: feature k m) (suc i) ⟩ List.applyUpTo (feature k) (suc i) ∎ where - fst-config≡true : ∀ (j i' : ℕ) → j + suc i' ≡ suc i → fst-config i (j + zero) ≡ true - fst-config≡true j i' j+i'≡i = Equivalence.to Bool.T-≡ (ℕ.≤⇒≤ᵇ (ℕ.≤-pred ( - begin - suc j + zero - ≤⟨ ℕ.+-monoʳ-≤ (suc j) z≤n ⟩ - suc j + i' - ≡⟨ ℕ.+-suc j i' ⟨ - j + suc i' - ≡⟨ j+i'≡i ⟩ - suc i - ∎))) - where - open ℕ.≤-Reasoning - open Eq.≡-Reasoning - offset : ℕ - offset = n ∸ i + P : (f : Feature) → Set + P = Bool.T ∘ fst-config i ∘ name + + P? : Decidable P + P? = Bool.T? ∘ fst-config i ∘ name - deselects-tail : ∀ (i' j : ℕ) - → select (fst-config i) (List.applyUpTo (λ m → j + m + suc i :: feature k (j + m + suc i)) i') - ≡ [] - deselects-tail zero j = refl - deselects-tail (suc i') j = - begin - select (fst-config i) (List.applyUpTo (λ m → j + m + suc i :: feature k (j + m + suc i)) (suc i')) - ≡⟨⟩ - (if fst-config i (j + zero + suc i) - then feature k (j + zero + suc i) ∷ select (fst-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') - else select (fst-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i')) - ≡⟨ Eq.cong (if_then feature k (j + zero + suc i) ∷ select (fst-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') else select (fst-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i')) (Equivalence.to Bool.T-not-≡ (>⇒¬≤ᵇ (ℕ.m≤n⇒m≤o+n (j + zero) (ℕ.n<1+n i)))) ⟩ - select (fst-config i) (List.applyUpTo (λ m → j + suc m + suc i :: feature k (j + suc m + suc i)) i') - ≡⟨ Eq.cong (λ x → select (fst-config i) x) (List.applyUpTo-cong (λ m → Eq.cong (λ x → x + suc i :: feature k (x + suc i)) (ℕ.+-suc j m)) i') ⟩ - select (fst-config i) (List.applyUpTo (λ m → suc j + m + suc i :: feature k (suc j + m + suc i)) i') - ≡⟨ deselects-tail i' (suc j) ⟩ - [] - ∎ + P-true : {j : ℕ} → j < suc i → P (j :: feature k j) + P-true (s≤s j≤i) = ℕ.≤⇒≤ᵇ j≤i - selects-init : ∀ (i' j : ℕ) - → j + i' ≡ suc i - → select (fst-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) (i' + offset)) - ≡ List.applyUpTo (λ m → feature k (j + m)) i' - selects-init zero j j+i'≡i = - begin - select (fst-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) offset) - ≡⟨ Eq.cong (select (fst-config i)) (List.applyUpTo-cong (λ m → Eq.cong (λ x → x :: feature k x) (ℕ.+-comm j m)) offset) ⟩ - select (fst-config i) (List.applyUpTo (λ m → m + j :: feature k (m + j)) offset) - ≡⟨ Eq.cong (select (fst-config i)) (List.applyUpTo-cong (λ m → Eq.cong (λ x → m + x :: feature k (m + x)) (Eq.trans (Eq.sym (ℕ.+-identityʳ j)) j+i'≡i)) offset) ⟩ - select (fst-config i) (List.applyUpTo (λ m → m + suc i :: feature k (m + suc i)) offset) - ≡⟨ deselects-tail offset zero ⟩ - [] - ≡⟨⟩ - List.applyUpTo (λ m → feature k (j + m)) zero - ∎ - selects-init (suc i') j j+i'≡i = - begin - select (fst-config i) (List.applyUpTo (λ m → j + m :: feature k (j + m)) (suc i' + offset)) - ≡⟨⟩ - select (fst-config i) ((j + zero :: feature k (j + zero)) ∷ List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) - ≡⟨⟩ - (if fst-config i (j + zero) - then feature k (j + zero) ∷ select (fst-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) - else select (fst-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset))) - ≡⟨ Eq.cong (if_then feature k (j + zero) ∷ select (fst-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) else select (fst-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset))) (fst-config≡true j i' j+i'≡i) ⟩ - feature k (j + zero) ∷ select (fst-config i) (List.applyUpTo (λ m → j + suc m :: feature k (j + suc m)) (i' + offset)) - ≡⟨ Eq.cong (λ x → feature k (j + zero) ∷ select (fst-config i) x) (List.applyUpTo-cong (λ m → Eq.cong₂ _::_ (ℕ.+-suc j m) (Eq.cong (feature k) (ℕ.+-suc j m))) (i' + offset)) ⟩ - feature k (j + zero) ∷ select (fst-config i) (List.applyUpTo (λ m → suc j + m :: feature k (suc j + m)) (i' + offset)) - ≡⟨ Eq.cong (feature k (j + zero) ∷_) (selects-init i' (suc j) (Eq.trans (Eq.sym (ℕ.+-suc j i')) j+i'≡i)) ⟩ - feature k (j + zero) ∷ List.applyUpTo (λ m → feature k (suc j + m)) i' - ≡⟨ Eq.cong (feature k (j + zero) ∷_) (List.applyUpTo-cong (λ m → Eq.cong (feature k) (Eq.sym (ℕ.+-suc j m))) i') ⟩ - feature k (j + zero) ∷ List.applyUpTo (λ m → feature k (j + suc m)) i' - ≡⟨⟩ - List.applyUpTo (λ m → feature k (j + m)) (suc i') - ∎ + P-false : (j : ℕ) → ¬ P (suc i + j :: feature k (suc i + j)) + P-false j p = ℕ.<⇒≱ (ℕ.≤ᵇ⇒≤ (suc i + j) i p) (ℕ.m≤m+n i j) unique-variant : ∀ n m i → Unique (List.concatMap forget-uniqueness (List.applyUpTo (λ k → feature n (m + k)) i)) unique-variant n m zero = [] diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index e38d32a7..89dfabe8 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -385,3 +385,10 @@ applyUpTo-cong f≗g (suc n) = Eq.cong₂ _∷_ (f≗g zero) (applyUpTo-cong (f applyUpTo-∷ʳ⁺ : ∀ {ℓ} {A : Set ℓ} (f : ℕ → A) (n : ℕ) → List.applyUpTo f n List.∷ʳ f n ≡ List.applyUpTo f (suc n) applyUpTo-∷ʳ⁺ f zero = refl applyUpTo-∷ʳ⁺ f (suc n) = Eq.cong (f 0 ∷_) (applyUpTo-∷ʳ⁺ (f ∘ suc) n) + +applyUpTo-++⁺ : ∀ {ℓ} {A : Set ℓ} + → (f : ℕ → A) + → (n m : ℕ) + → List.applyUpTo f (n + m) ≡ List.applyUpTo f n ++ List.applyUpTo (λ i → f (n + i)) m +applyUpTo-++⁺ f zero m = refl +applyUpTo-++⁺ f (suc n) m = Eq.cong (f zero ∷_) (applyUpTo-++⁺ (f ∘ suc) n m) From c705abddb8ce28f1686704cd655f06501f1a3e5f Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 22 Jul 2025 12:56:54 +0200 Subject: [PATCH 40/82] Factor out findings about fixed artifact lengths of 2CC --- src/Vatras/Lang/2CC/FixedArtifactLength.agda | 121 +++++++++++++++ .../FST\342\211\2612CC.agda" | 142 ++++-------------- .../OC\342\211\2612CC.agda" | 138 ++++------------- src/Vatras/Util/AuxProofs.agda | 7 +- src/Vatras/Util/List.agda | 59 +++++++- 5 files changed, 240 insertions(+), 227 deletions(-) create mode 100644 src/Vatras/Lang/2CC/FixedArtifactLength.agda diff --git a/src/Vatras/Lang/2CC/FixedArtifactLength.agda b/src/Vatras/Lang/2CC/FixedArtifactLength.agda new file mode 100644 index 00000000..e53928f8 --- /dev/null +++ b/src/Vatras/Lang/2CC/FixedArtifactLength.agda @@ -0,0 +1,121 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) +module Vatras.Lang.2CC.FixedArtifactLength (Dimension : 𝔽) (A : 𝔸) where + +open import Data.Bool using (true; false) +open import Data.Empty using (⊥-elim) +open import Data.List as List using (List; []; _∷_; concatMap; _++_) +import Data.List.Properties as List +open import Data.List.Relation.Ternary.Interleaving.Propositional using (Interleaving; []; consˡ; consʳ) +open import Data.List.Relation.Unary.All using (All; []; _∷_) +import Data.List.Relation.Unary.All.Properties +open import Data.List.Relation.Unary.AllPairs as AllPairs using (AllPairs; []; _∷_) +open import Data.Nat as ℕ using (ℕ; suc; _+_; _∸_; _*_; _≤_; z≤n; s≤s) +import Data.Nat.Properties as ℕ +open import Data.Product using (_×_; _,_; proj₂; ∃-syntax) +open import Function using (_∘_; const) +open import Relation.Binary.PropositionalEquality as Eq using (refl; _≡_; _≢_) +open import Size using (Size; ∞) + +import Vatras.Util.List as List +open import Vatras.Data.EqIndexedSet using (_∈_) +open import Vatras.Framework.Variants using (Rose; children-equality) +open import Vatras.Lang.2CC Dimension using (2CC; _⟨_,_⟩; _-<_>-; ⟦_⟧) +open import Vatras.Lang.2CC.ReflectsVariantSize using (reflectsVariantSize) +open import Vatras.SyntacticExpressiveness.Sizes Dimension using (sizeRose; size2CC) + +_≉_ : Rose ∞ A → Rose ∞ A → Set +(a₁ Rose.-< cs₁ >-) ≉ (a₂ Rose.-< cs₂ >-) = List.length cs₁ ≢ List.length cs₂ + +fixedChildCount : ∀ {i} + → {a₁ : atoms A} {cs₁ : List (Rose ∞ A)} + → {a₂ : atoms A} {cs₂ : List (2CC i A)} + → (a₁ Rose.-< cs₁ >-) ∈ ⟦ a₂ -< cs₂ >- ⟧ + → List.length cs₁ ≡ List.length cs₂ +fixedChildCount {cs₁ = cs₁} {cs₂ = cs₂} (c , v≡e) = + List.length cs₁ + ≡⟨ Eq.cong List.length (children-equality v≡e) ⟩ + List.length (List.map (λ e → ⟦ e ⟧ c) cs₂) + ≡⟨ List.length-map (λ e → ⟦ e ⟧ c) cs₂ ⟩ + List.length cs₂ + ∎ + where + open Eq.≡-Reasoning + +partition : ∀ {i : Size} {ℓ} {I : Set ℓ} + → (D : Dimension) (c₁ c₂ : 2CC i A) + → (is : List I) + → (f : I → Rose ∞ A) + → AllPairs (λ i j → f i ≉ f j) is + → All (λ i → f i ∈ ⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) is + → ∃[ is₁ ] ∃[ is₂ ] + Interleaving is₁ is₂ is + × All (λ i → f i ∈ ⟦ c₁ ⟧) is₁ + × All (λ i → f i ∈ ⟦ c₂ ⟧) is₂ +partition D c₁ c₂ [] f unique-vs vs⊆e = [] , [] , [] , [] , [] +partition D c₁ c₂ (i ∷ is) f (v∉vs ∷ unique-vs) ((c , v≡e) ∷ vs⊆e) + with partition D c₁ c₂ is f unique-vs vs⊆e +... | is₁ , is₂ , partition , vs₁⊆e , vs₂⊆e + with c D +... | true = i ∷ is₁ , is₂ , consˡ partition , (c , v≡e) ∷ vs₁⊆e , vs₂⊆e +... | false = is₁ , i ∷ is₂ , consʳ partition , vs₁⊆e , (c , v≡e) ∷ vs₂⊆e + +sum≤size2CC : ∀ {i : Size} {ℓ} {I : Set ℓ} + → (e : 2CC i A) + → (is : List I) + → (f : I → Rose ∞ A) + → AllPairs (λ i j → f i ≉ f j) is + → All (λ i → f i ∈ ⟦ e ⟧) is + → List.sum (List.map (sizeRose ∘ f) is) ≤ size2CC e +sum≤size2CC (a -< cs >-) [] f unique-vs vs⊆e = z≤n +sum≤size2CC (a -< cs >-) (i₁ ∷ []) f unique-vs (v∈e ∷ []) = + begin + List.sum (List.map (sizeRose ∘ f) (i₁ ∷ [])) + ≡⟨⟩ + sizeRose (f i₁) + 0 + ≡⟨ ℕ.+-identityʳ (sizeRose (f i₁)) ⟩ + sizeRose (f i₁) + ≤⟨ reflectsVariantSize (f i₁) (a -< cs >-) v∈e ⟩ + size2CC (a -< cs >-) + ∎ + where + open ℕ.≤-Reasoning +sum≤size2CC (a -< cs >-) (i₁ ∷ i₂ ∷ is) f ((v₁≢v₂ ∷ v₁∉vs) ∷ unique-vs) (v₁∈e ∷ v₂∈e ∷ vs⊆e) with f i₁ | f i₂ +... | a₁ Rose.-< cs₁ >- | a₂ Rose.-< cs₂ >- = + ⊥-elim (v₁≢v₂ (Eq.trans (fixedChildCount v₁∈e) (Eq.sym (fixedChildCount v₂∈e)))) +sum≤size2CC (D ⟨ c₁ , c₂ ⟩) is f unique-vs vs⊆e with partition D c₁ c₂ is f unique-vs vs⊆e +... | is₁ , is₂ , partition , vs₁⊆c₁ , vs₂⊆c₂ = + begin + List.sum (List.map (sizeRose ∘ f) is) + ≡⟨ List.sum-Interleaving partition ⟨ + List.sum (List.map (sizeRose ∘ f) is₁) + List.sum (List.map (sizeRose ∘ f) is₂) + ≤⟨ ℕ.+-mono-≤ (sum≤size2CC c₁ is₁ f (List.AllPairs-resp-⊆ (List.Interleaving⇒Sublistˡ partition) unique-vs) vs₁⊆c₁) (sum≤size2CC c₂ is₂ f (List.AllPairs-resp-⊆ (List.Interleaving⇒Sublistʳ partition) unique-vs) vs₂⊆c₂) ⟩ + size2CC c₁ + size2CC c₂ + <⟨ ℕ.n<1+n (size2CC c₁ + size2CC c₂) ⟩ + size2CC (D ⟨ c₁ , c₂ ⟩) + ∎ + where + open ℕ.≤-Reasoning + +unique-lengths⇒m*sizeRose≤size2CC : ∀ {i : Size} (n : ℕ) + → (2cc : 2CC i A) + → (ls : List ℕ) + → (f : ℕ → Rose ∞ A) + → (∀ (l : ℕ) → n ≤ sizeRose (f l)) + → (∀ {l₁ l₂ : ℕ} → l₁ ≢ l₂ → f l₁ ≉ f l₂) + → AllPairs _≢_ ls + → All (λ l → f l ∈ ⟦ 2cc ⟧) ls + → List.length ls * n ≤ size2CC 2cc +unique-lengths⇒m*sizeRose≤size2CC n 2cc ls f f-size f-≉ unique-ls all-∈ = + begin + List.length ls * n + ≡⟨ List.sum-replicate (List.length ls) n ⟨ + List.sum (List.replicate (List.length ls) n) + ≡⟨ Eq.cong List.sum (List.map-const n ls) ⟨ + List.sum (List.map (const n) ls) + ≤⟨ List.sum-map-≤ (const n) (sizeRose ∘ f) ls f-size ⟩ + List.sum (List.map (sizeRose ∘ f) ls) + ≤⟨ sum≤size2CC 2cc ls f (AllPairs.map f-≉ unique-ls) all-∈ ⟩ + size2CC 2cc + ∎ + where + open ℕ.≤-Reasoning diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index c6227dfb..5267df5b 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -16,7 +16,7 @@ import Data.List.Relation.Binary.Subset.Propositional.Properties as Subset open import Data.List.Relation.Unary.Any using (here; there) open import Data.List.Relation.Unary.All as All using (All; []; _∷_) import Data.List.Relation.Unary.All.Properties as All -open import Data.List.Relation.Unary.AllPairs using (AllPairs; []; _∷_) +open import Data.List.Relation.Unary.AllPairs as AllPairs using (AllPairs; []; _∷_) import Data.List.Relation.Unary.AllPairs.Properties as AllPairs import Data.List.Relation.Unary.Unique.Propositional as List import Data.List.Relation.Unary.Unique.Propositional.Properties as Unique @@ -31,6 +31,7 @@ open import Relation.Nullary.Negation using (¬_) open import Relation.Unary using (Decidable) open import Size using (Size; ∞) +open import Vatras.Util.AuxProofs using (m∸n- @@ -100,11 +102,12 @@ size-fst n = variant : ℕ → ℕ → FSTA ∞ variant n i = (0 , 0) Rose.-< List.applyUpTo (artifact n) (suc i) >- +-- TODO called variant-size in OC≱2CC size-variant : (n i : ℕ) - → 2 ^ n < sizeRose (variant n i) + → 2 ^ n ≤ sizeRose (variant n i) size-variant n i = - begin-strict + begin 2 ^ n ≡⟨ ℕ.+-identityʳ (2 ^ n) ⟨ 2 ^ n + 0 @@ -120,116 +123,26 @@ size-variant n i = where open ℕ.≤-Reasoning +variant-≉ : ∀ n {l₁} {l₂} → l₁ ≢ l₂ → variant n l₁ ≉' variant n l₂ +variant-≉ n {l₁} {l₂} l₁≢l₂ v₁≡v₂ = l₁≢l₂ ( + l₁ + ≡⟨ List.length-applyUpTo (artifact n ∘ suc) l₁ ⟨ + List.length (List.applyUpTo (artifact n ∘ suc) l₁) + ≡⟨ ℕ.suc-injective v₁≡v₂ ⟩ + List.length (List.applyUpTo (artifact n ∘ suc) l₂) + ≡⟨ List.length-applyUpTo (artifact n ∘ suc) l₂ ⟩ + l₂ + ∎) + where + open Eq.≡-Reasoning + +-- duplicated in OC≱2CC as size2CC>0 1≤size2CC : ∀ {i : Size} {A : 𝔸} → (e : 2CC.2CC i A) → 1 ≤ size2CC e 1≤size2CC (a 2CC.-< cs >-) = s≤s z≤n 1≤size2CC (D 2CC.⟨ l , r ⟩) = s≤s z≤n --- TODO duplicated in OC≱2CC -variant∈e⇒length-cs - : ∀ {i} (n l : ℕ) (a : ℕ × ℕ) (cs : List (2CC.2CC i NAT')) - → variant n l ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ - → List.length cs ≡ suc l -variant∈e⇒length-cs n l a cs (c , v≡e) = - List.length cs - ≡⟨ List.length-map (λ e → 2CC.⟦ e ⟧ c) cs ⟨ - List.length (List.map (λ e → 2CC.⟦ e ⟧ c) cs) - ≡⟨ Eq.cong List.length (proj₂ (Rose-injective v≡e)) ⟨ - List.length (List.applyUpTo (artifact n) (suc l)) - ≡⟨ List.length-applyUpTo (artifact n) (suc l) ⟩ - suc l - ∎ - where - open Eq.≡-Reasoning - --- TODO duplicated in OC≱2CC -partition : ∀ {i : Size} (n D : ℕ) - → (c₁ c₂ : 2CC.2CC i NAT') - → (ls : List ℕ) - → List.Unique ls - → All (λ l → variant n l ∈ 2CC.⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) ls - → ∃[ ls₁ ] ∃[ ls₂ ] - ls₁ Subset.⊆ ls × ls₂ Subset.⊆ ls - × List.length ls₁ + List.length ls₂ ≡ List.length ls - × List.Unique ls₁ × All (λ l → variant n l ∈ 2CC.⟦ c₁ ⟧) ls₁ - × List.Unique ls₂ × All (λ l → variant n l ∈ 2CC.⟦ c₂ ⟧) ls₂ -partition n D c₁ c₂ [] unique-ls ls⊆2cc = - [] , [] , - Subset.⊆-refl , Subset.⊆-refl , - Eq.refl , - [] , [] , - [] , [] -partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls⊆2cc) - with partition n D c₁ c₂ ls unique-ls ls⊆2cc -... | ls₁ , ls₂ , - ls₁⊆ls , ls₂⊆ls , - ls₁+ls₂≡ls , - unique-ls₁ , ls₁∈l , - unique-ls₂ , ls₂∈r - with c D -... | true = - l ∷ ls₁ , ls₂ , - Subset.∷⁺ʳ l ls₁⊆ls , there ∘ ls₂⊆ls , - Eq.cong suc ls₁+ls₂≡ls , - All.anti-mono ls₁⊆ls l∉ls ∷ unique-ls₁ , (c , l≡2cc) ∷ ls₁∈l , - unique-ls₂ , ls₂∈r -... | false = - ls₁ , l ∷ ls₂ , - there ∘ ls₁⊆ls , Subset.∷⁺ʳ l ls₂⊆ls , - Eq.trans - (ℕ.+-suc (List.length ls₁) (List.length ls₂)) - (Eq.cong suc ls₁+ls₂≡ls) , - unique-ls₁ , ls₁∈l , - All.anti-mono ls₂⊆ls l∉ls ∷ unique-ls₂ , (c , l≡2cc) ∷ ls₂∈r - --- TODO duplicated in OC≱2CC -big : ∀ {i : Size} (n : ℕ) - → (2cc : 2CC.2CC i NAT') - → (ls : List ℕ) - → List.Unique ls - → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) ls - → List.length ls * 2 ^ n < size2CC 2cc -big n (a 2CC.-< cs >-) [] unique-ls all-∈ = s≤s z≤n -big n (a 2CC.-< cs >-) (l₁ ∷ []) unique-ls all-∈ = - begin-strict - 1 * 2 ^ n - ≡⟨ ℕ.*-identityˡ (2 ^ n) ⟩ - 2 ^ n - <⟨ size-variant n l₁ ⟩ - sizeRose (variant n l₁) - ≤⟨ 2CC.reflectsVariantSize (variant n l₁) (a 2CC.-< cs >-) (All.lookup all-∈ (here Eq.refl)) ⟩ - size2CC (a 2CC.-< cs >-) - ∎ - where - open ℕ.≤-Reasoning -big n (a 2CC.-< cs >-) (l₁ ∷ l₂ ∷ ls) ((l₁≢l₂ ∷ l₁∉ls) ∷ unique-ls) all-∈ = - ⊥-elim (l₁≢l₂ (ℕ.suc-injective (Eq.trans - (Eq.sym (variant∈e⇒length-cs n l₁ a cs (All.lookup all-∈ (here Eq.refl)))) - (variant∈e⇒length-cs n l₂ a cs (All.lookup all-∈ (there (here Eq.refl))))))) -big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ with partition n D l r ls unique-ls all-∈ -big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ - | ls₁ , ls₂ , - _ , _ , - ls₁+ls₂≡ls , - unique-ls₁ , ls₁∈l , - unique-ls₂ , ls₂∈r = - begin-strict - List.length ls * 2 ^ n - <⟨ ℕ.n<1+n (List.length ls * 2 ^ n) ⟩ - suc (List.length ls * 2 ^ n) - ≡⟨ Eq.cong (λ x → suc (x * 2 ^ n)) ls₁+ls₂≡ls ⟨ - suc ((List.length ls₁ + List.length ls₂) * 2 ^ n) - ≡⟨ Eq.cong suc (ℕ.*-distribʳ-+ (2 ^ n) (List.length ls₁) (List.length ls₂)) ⟩ - suc (List.length ls₁ * 2 ^ n + List.length ls₂ * 2 ^ n) - <⟨ s≤s (ℕ.+-mono-< (big n l ls₁ unique-ls₁ ls₁∈l) (big n r ls₂ unique-ls₂ ls₂∈r)) ⟩ - suc (size2CC l + size2CC r) - ≡⟨⟩ - size2CC (D 2CC.⟨ l , r ⟩) - ∎ - where - open ℕ.≤-Reasoning - fst-config : ℕ → ℕ → Bool fst-config i f = f ℕ.≤ᵇ i @@ -422,12 +335,15 @@ FST≱2CC (suc n) = NAT' , fst m , λ 2cc fst≅2cc → m * 2 ^ m ≡⟨ Eq.cong (_* 2 ^ m) (List.length-upTo m) ⟨ List.length (List.upTo m) * 2 ^ m - <⟨ big - m - 2cc - (List.upTo m) - (Unique.applyUpTo⁺₁ id m (λ i-) variant : ℕ → ℕ → Rose ∞ NAT variant n i = 0 Rose.-< exponential-artifact n ∷ variant-cs i >- -variant∈e⇒length-cs - : ∀ {i} (n l : ℕ) (a : ℕ) (cs : List (2CC.2CC i NAT)) - → variant n l ∈ 2CC.⟦ a 2CC.-< cs >- ⟧ - → List.length cs ≡ suc l -variant∈e⇒length-cs n l a cs (c , v≡e) = - List.length cs - ≡⟨ List.length-map (λ e → 2CC.⟦ e ⟧ c) cs ⟨ - List.length (List.map (λ e → 2CC.⟦ e ⟧ c) cs) - ≡⟨ Eq.cong List.length (children-equality v≡e) ⟨ - List.length (exponential-artifact n ∷ variant-cs l) - ≡⟨⟩ - suc (List.length (variant-cs l)) - ≡⟨ Eq.cong suc (List.length-replicate l) ⟩ - suc l - ∎ - where - open Eq.≡-Reasoning - variant-size : (n l : ℕ) - → 2 ^ n < sizeRose (variant n l) + → 2 ^ n ≤ sizeRose (variant n l) variant-size n l = - begin-strict + begin 2 ^ n ≡⟨ ℕ.+-identityʳ (2 ^ n) ⟨ 2 ^ n + 0 @@ -126,90 +111,18 @@ variant-size n l = where open ℕ.≤-Reasoning -partition : ∀ {i : Size} (n D : ℕ) - → (c₁ c₂ : 2CC.2CC i NAT) - → (ls : List ℕ) - → Unique ls - → All (λ l → variant n l ∈ 2CC.⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) ls - → ∃[ ls₁ ] ∃[ ls₂ ] - ls₁ Subset.⊆ ls × ls₂ Subset.⊆ ls - × List.length ls₁ + List.length ls₂ ≡ List.length ls - × Unique ls₁ × All (λ l → variant n l ∈ 2CC.⟦ c₁ ⟧) ls₁ - × Unique ls₂ × All (λ l → variant n l ∈ 2CC.⟦ c₂ ⟧) ls₂ -partition n D c₁ c₂ [] unique-ls ls⊆2cc = - [] , [] , - Subset.⊆-refl , Subset.⊆-refl , - Eq.refl , - [] , [] , - [] , [] -partition n D c₁ c₂ (l ∷ ls) (l∉ls ∷ unique-ls) ((c , l≡2cc) ∷ ls⊆2cc) - with partition n D c₁ c₂ ls unique-ls ls⊆2cc -... | ls₁ , ls₂ , - ls₁⊆ls , ls₂⊆ls , - ls₁+ls₂≡ls , - unique-ls₁ , ls₁∈l , - unique-ls₂ , ls₂∈r - with c D -... | true = - l ∷ ls₁ , ls₂ , - Subset.∷⁺ʳ l ls₁⊆ls , there ∘ ls₂⊆ls , - Eq.cong suc ls₁+ls₂≡ls , - All.anti-mono ls₁⊆ls l∉ls ∷ unique-ls₁ , (c , l≡2cc) ∷ ls₁∈l , - unique-ls₂ , ls₂∈r -... | false = - ls₁ , l ∷ ls₂ , - there ∘ ls₁⊆ls , Subset.∷⁺ʳ l ls₂⊆ls , - Eq.trans - (ℕ.+-suc (List.length ls₁) (List.length ls₂)) - (Eq.cong suc ls₁+ls₂≡ls) , - unique-ls₁ , ls₁∈l , - All.anti-mono ls₂⊆ls l∉ls ∷ unique-ls₂ , (c , l≡2cc) ∷ ls₂∈r - -big : ∀ {i : Size} (n : ℕ) - → (2cc : 2CC.2CC i NAT) - → (ls : List ℕ) - → Unique ls - → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) ls - → List.length ls * 2 ^ n < size2CC 2cc -big n (a 2CC.-< cs >-) [] unique-ls all-∈ = s≤s z≤n -big n (a 2CC.-< cs >-) (l₁ ∷ []) unique-ls all-∈ = - begin-strict - 1 * 2 ^ n - ≡⟨ ℕ.*-identityˡ (2 ^ n) ⟩ - 2 ^ n - <⟨ variant-size n l₁ ⟩ - sizeRose (variant n l₁) - ≤⟨ 2CC.reflectsVariantSize (variant n l₁) (a 2CC.-< cs >-) (All.lookup all-∈ (here Eq.refl)) ⟩ - size2CC (a 2CC.2CC.-< cs >-) - ∎ +variant-≉ : ∀ n {l₁} {l₂} → l₁ ≢ l₂ → variant n l₁ ≉ variant n l₂ +variant-≉ n {l₁} {l₂} l₁≢l₂ v₁≡v₂ = l₁≢l₂ ( + l₁ + ≡⟨ List.length-replicate l₁ ⟨ + List.length (variant-cs l₁) + ≡⟨ ℕ.suc-injective v₁≡v₂ ⟩ + List.length (variant-cs l₂) + ≡⟨ List.length-replicate l₂ ⟩ + l₂ + ∎) where - open ℕ.≤-Reasoning -big n (a 2CC.-< cs >-) (l₁ ∷ l₂ ∷ ls) ((l₁≢l₂ ∷ l₁∉ls) ∷ unique-ls) all-∈ = - ⊥-elim (l₁≢l₂ (ℕ.suc-injective (Eq.trans - (Eq.sym (variant∈e⇒length-cs n l₁ a cs (All.lookup all-∈ (here Eq.refl)))) - (variant∈e⇒length-cs n l₂ a cs (All.lookup all-∈ (there (here Eq.refl))))))) -big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ with partition n D l r ls unique-ls all-∈ -big n (D 2CC.⟨ l , r ⟩) ls unique-ls all-∈ - | ls₁ , ls₂ , - _ , _ , - ls₁+ls₂≡ls , - unique-ls₁ , ls₁∈l , - unique-ls₂ , ls₂∈r = - begin-strict - List.length ls * 2 ^ n - <⟨ ℕ.n<1+n (List.length ls * 2 ^ n) ⟩ - suc (List.length ls * 2 ^ n) - ≡⟨ Eq.cong (λ x → suc (x * 2 ^ n)) ls₁+ls₂≡ls ⟨ - suc ((List.length ls₁ + List.length ls₂) * 2 ^ n) - ≡⟨ Eq.cong suc (ℕ.*-distribʳ-+ (2 ^ n) (List.length ls₁) (List.length ls₂)) ⟩ - suc (List.length ls₁ * 2 ^ n + List.length ls₂ * 2 ^ n) - <⟨ s≤s (ℕ.+-mono-< (big n l ls₁ unique-ls₁ ls₁∈l) (big n r ls₂ unique-ls₂ ls₂∈r)) ⟩ - suc (size2CC l + size2CC r) - ≡⟨⟩ - size2CC (D 2CC.⟨ l , r ⟩) - ∎ - where - open ℕ.≤-Reasoning + open Eq.≡-Reasoning conf : ℕ → OC.Configuration conf n i = i <ᵇ n @@ -326,12 +239,15 @@ goal n@(suc n-1) 2cc (oc⊆2cc , 2cc⊆oc) = suc (4 * n) * 2 ^ (4 * n) ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (List.length-upTo (suc (4 * n))) ⟨ List.length (List.upTo (suc (4 * n))) * 2 ^ (4 * n) - <⟨ big - (4 * n) - 2cc - (List.upTo (suc (4 * n))) - (Unique.applyUpTo⁺₁ id (suc (4 * n)) (λ i_; _≤_; s≤s; z≤n) +open import Data.Nat.Properties using (n<1+n; m⊓n≤m; +-comm; +-∸-comm; n∸n≡0; m≤n+m; +-∸-assoc; ∸-monoʳ-≤) open import Data.Fin using (Fin; zero; suc; fromℕ<) open import Data.List.Properties using (length-++) open import Data.Product using (_×_; _,_) @@ -57,6 +57,9 @@ n∸1+m 0 → n > 0 → m ∸ n < m +m∸n0) (s≤s n>0) = s≤s (∸-monoʳ-≤ {zero} {n} m z≤n) + ----- Properties of if_then_else -- TODO: These are contributed to STL now. Update our STL dependency and replace these by their STL counterpart. diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index 89dfabe8..10321df6 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -14,7 +14,6 @@ open import Data.List.Properties using (map-id; length-++) open import Data.List.Membership.Propositional using (_∈_) import Data.List.Membership.Propositional.Properties as List open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_; toList; _⁺++⁺_) renaming (map to map⁺) -open import Data.List.Relation.Binary.Subset.Propositional using (_⊆_) open import Data.List.Relation.Unary.All as All using (All; []; _∷_) import Data.List.Relation.Unary.All.Properties as All open import Data.List.Relation.Unary.Any using (here; there) @@ -90,6 +89,7 @@ lookup-++ₗ (x ∷ xs) ys i = lookup-++ₗ xs ys i ∈∧∉⇒≢ (x ∷ xs) (there y∈xs) (y≢x ∷ z∉xs) y≡z = ∈∧∉⇒≢ xs y∈xs z∉xs y≡z module _ where + open import Data.List.Relation.Binary.Subset.Propositional using (_⊆_) open import Data.List.Relation.Unary.Unique.Propositional using (Unique; _∷_) length≤ : ∀ {ℓ} {A : Set ℓ} @@ -361,6 +361,63 @@ module _ where AllAll-comm [] ys sym all-all = [] AllAll-comm (x ∷ xs) ys sym all-all = All.map (λ All-P-y-xs → sym (All.head All-P-y-xs)) all-all ∷ AllAll-comm xs ys sym (All.map All.tail all-all) +module _ where + open import Data.List.Relation.Ternary.Interleaving.Propositional using (Interleaving; []; consˡ; consʳ) + open import Data.List.Relation.Binary.Sublist.Propositional using (_⊆_; []; _∷_; _∷ʳ_) + + Interleaving⇒Sublistˡ : ∀ {ℓ} {A : Set ℓ} + → {xs ys zs : List A} + → Interleaving xs ys zs + → xs ⊆ zs + Interleaving⇒Sublistˡ [] = [] + Interleaving⇒Sublistˡ (consˡ zs) = refl ∷ Interleaving⇒Sublistˡ zs + Interleaving⇒Sublistˡ (consʳ zs) = _ ∷ʳ Interleaving⇒Sublistˡ zs + + Interleaving⇒Sublistʳ : ∀ {ℓ} {A : Set ℓ} + → {xs ys zs : List A} + → Interleaving xs ys zs + → ys ⊆ zs + Interleaving⇒Sublistʳ [] = [] + Interleaving⇒Sublistʳ (consˡ zs) = _ ∷ʳ Interleaving⇒Sublistʳ zs + Interleaving⇒Sublistʳ (consʳ zs) = refl ∷ Interleaving⇒Sublistʳ zs + + sum-Interleaving : ∀ {ℓ} {A : Set ℓ} + → {f : A → ℕ} + → {xs ys zs : List A} + → Interleaving xs ys zs + → List.sum (List.map f xs) + List.sum (List.map f ys) ≡ List.sum (List.map f zs) + sum-Interleaving [] = refl + sum-Interleaving {f = f} {.z ∷ xs} {ys} {z ∷ zs} (consˡ partition) = + List.sum (List.map f (z ∷ xs)) + List.sum (List.map f ys) + ≡⟨⟩ + f z + List.sum (List.map f xs) + List.sum (List.map f ys) + ≡⟨ ℕ.+-assoc (f z) (List.sum (List.map f xs)) (List.sum (List.map f ys)) ⟩ + f z + (List.sum (List.map f xs) + List.sum (List.map f ys)) + ≡⟨ Eq.cong (f z +_) (sum-Interleaving partition) ⟩ + f z + List.sum (List.map f zs) + ≡⟨⟩ + List.sum (List.map f (z ∷ zs)) + ∎ + where + open Eq.≡-Reasoning + sum-Interleaving {f = f} {xs} {.z ∷ ys} {z ∷ zs} (consʳ partition) = + List.sum (List.map f xs) + List.sum (List.map f (z ∷ ys)) + ≡⟨⟩ + List.sum (List.map f xs) + (f z + List.sum (List.map f ys)) + ≡⟨ ℕ.+-assoc (List.sum (List.map f xs)) (f z) (List.sum (List.map f ys)) ⟨ + List.sum (List.map f xs) + f z + List.sum (List.map f ys) + ≡⟨ Eq.cong (_+ List.sum (List.map f ys)) (ℕ.+-comm (List.sum (List.map f xs)) (f z)) ⟩ + f z + List.sum (List.map f xs) + List.sum (List.map f ys) + ≡⟨ ℕ.+-assoc (f z) (List.sum (List.map f xs)) (List.sum (List.map f ys)) ⟩ + f z + (List.sum (List.map f xs) + List.sum (List.map f ys)) + ≡⟨ Eq.cong (f z +_) (sum-Interleaving partition) ⟩ + f z + List.sum (List.map f zs) + ≡⟨⟩ + List.sum (List.map f (z ∷ zs)) + ∎ + where + open Eq.≡-Reasoning + map-applyUpTo : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {B : Set ℓ₂} → (f : A → B) → (g : ℕ → A) From cc33f09a738c55382227123950bd87fc61da8570 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 22 Jul 2025 14:13:42 +0200 Subject: [PATCH 41/82] Move size>0 lemmas next to the size definitions --- .../SyntacticExpressiveness/2CC\342\211\244CCC.agda" | 8 ++------ .../SyntacticExpressiveness/FST\342\211\2612CC.agda" | 11 ++--------- .../SyntacticExpressiveness/OC\342\211\2612CC.agda" | 6 +----- src/Vatras/SyntacticExpressiveness/Sizes.agda | 10 +++++++++- 4 files changed, 14 insertions(+), 21 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" index 19a1b251..de3eb53e 100644 --- "a/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" @@ -27,7 +27,7 @@ import Vatras.Util.List as List open import Vatras.Lang.All open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.SyntacticExpressiveness using (_≤Size_) -open import Vatras.SyntacticExpressiveness.Sizes using (sizeRose; Sized2CC; size2CC; SizedCCC; sizeCCC) +open import Vatras.SyntacticExpressiveness.Sizes using (sizeRose; Sized2CC; size2CC; SizedCCC; sizeCCC; sizeCCC>0) >⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ≤ᵇ n)) >⇒¬≤ᵇ (s≤s z≤n) = tt @@ -74,10 +74,6 @@ fnoc-rec-true config D (suc limit) n fnoc-) = s≤s z≤n -1≤sizeCCC (D CCC.CCC.⟨ cs ⟩) = s≤s z≤n - max-dimension : ∀ {i : Size} {A : 𝔸} → CCC.CCC F i A → ℕ max-dimension (a CCC.CCC.-< cs >-) = List.max (List.map max-dimension cs) max-dimension (D CCC.CCC.⟨ cs ⟩) = List⁺.length cs ⊔ List.max (List.map max-dimension (List⁺.toList cs)) @@ -193,7 +189,7 @@ translate-size (D CCC.CCC.⟨ c ∷ cs ⟩) = List.sum (List.replicate (List.length (c ∷ cs)) 1) ≡⟨ Eq.cong List.sum (List.map-const 1 (c ∷ cs)) ⟨ List.sum (List.map (const 1) (c ∷ cs)) - ≤⟨ List.sum-map-≤ (const 1) (sizeCCC F) (c ∷ cs) 1≤sizeCCC ⟩ + ≤⟨ List.sum-map-≤ (const 1) (sizeCCC F) (c ∷ cs) (sizeCCC>0 F) ⟩ List.sum (List.map (sizeCCC F) (c ∷ cs)) ≤⟨ ℕ.m≤n*m (List.sum (List.map (sizeCCC F) (c ∷ cs))) 2 ⟩ 2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" index 5267df5b..1359632a 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" @@ -39,7 +39,7 @@ import Vatras.Util.List as List open import Vatras.Lang.All.Fixed ℕ (Rose ∞) import Vatras.Lang.2CC.ReflectsVariantSize as 2CC open import Vatras.SyntacticExpressiveness using (_≱Size_) -open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST) +open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST; size2CC>0) NAT' : 𝔸 NAT' = record @@ -136,13 +136,6 @@ variant-≉ n {l₁} {l₂} l₁≢l₂ v₁≡v₂ = l₁≢l₂ ( where open Eq.≡-Reasoning --- duplicated in OC≱2CC as size2CC>0 -1≤size2CC : ∀ {i : Size} {A : 𝔸} - → (e : 2CC.2CC i A) - → 1 ≤ size2CC e -1≤size2CC (a 2CC.-< cs >-) = s≤s z≤n -1≤size2CC (D 2CC.⟨ l , r ⟩) = s≤s z≤n - fst-config : ℕ → ℕ → Bool fst-config i f = f ℕ.≤ᵇ i @@ -303,7 +296,7 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( open ℕ.≤-Reasoning FST≱2CC : SizedFST ≱Size Sized2CC -FST≱2CC zero = NAT' , fst zero , λ 2cc fst≅2cc → 1≤size2CC 2cc +FST≱2CC zero = NAT' , fst zero , λ 2cc fst≅2cc → size2CC>0 2cc FST≱2CC (suc n) = NAT' , fst m , λ 2cc fst≅2cc → begin-strict suc n * sizeFST (fst m) diff --git "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" index b40df912..7256e72e 100644 --- "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" @@ -34,7 +34,7 @@ open import Vatras.Lang.All.Fixed ℕ (Rose ∞) import Vatras.Lang.2CC.ReflectsVariantSize as 2CC open import Vatras.Lang.2CC.FixedArtifactLength ℕ NAT using (_≉_; unique-lengths⇒m*sizeRose≤size2CC) open import Vatras.SyntacticExpressiveness using (_≱Size_) -open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC) +open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC; size2CC>0) options : ℕ → List (OC.OC ∞ NAT) options zero = [] @@ -210,10 +210,6 @@ conf n i = i <ᵇ n where open ℕ.≤-Reasoning -size2CC>0 : ∀ {i} (2cc : 2CC.2CC i NAT) → 0 < size2CC 2cc -size2CC>0 (a 2CC.-< cs >-) = s≤s z≤n -size2CC>0 (D 2CC.⟨ l , r ⟩) = s≤s z≤n - goal : ∀ {i} (n : ℕ) (2cc : 2CC.2CC i NAT) → OC.⟦ oc (4 * n) ⟧ ≅ 2CC.⟦ 2cc ⟧ → n * sizeWFOC (oc (4 * n)) < size2CC 2cc diff --git a/src/Vatras/SyntacticExpressiveness/Sizes.agda b/src/Vatras/SyntacticExpressiveness/Sizes.agda index 776f1d8d..e4d904f5 100644 --- a/src/Vatras/SyntacticExpressiveness/Sizes.agda +++ b/src/Vatras/SyntacticExpressiveness/Sizes.agda @@ -1,7 +1,7 @@ open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms; atomSize) module Vatras.SyntacticExpressiveness.Sizes (F : 𝔽) where -open import Data.Nat using (ℕ; suc; zero; _+_) +open import Data.Nat using (ℕ; suc; zero; _+_; _>_; s≤s; z≤n) import Data.List as List import Data.List.NonEmpty as List⁺ import Data.Vec as Vec @@ -20,6 +20,10 @@ size2CC : ∀ {i : Size} {A : 𝔸} → 2CC.2CC i A → ℕ size2CC {A = A} (a 2CC.2CC.-< cs >-) = suc (atomSize A a + List.sum (List.map size2CC cs)) size2CC (D 2CC.2CC.⟨ l , r ⟩) = suc (size2CC l + size2CC r) +size2CC>0 : ∀ {i : Size} {A : 𝔸} → (2cc : 2CC.2CC i A) → size2CC 2cc > 0 +size2CC>0 (a 2CC.-< cs >-) = s≤s z≤n +size2CC>0 (D 2CC.⟨ l , r ⟩) = s≤s z≤n + Sized2CC : SizedLang Sized2CC = record { Lang = 2CC.2CCL @@ -40,6 +44,10 @@ sizeCCC : ∀ {i : Size} {A : 𝔸} → CCC.CCC i A → ℕ sizeCCC {A = A} (a CCC.CCC.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeCCC cs)) sizeCCC (D CCC.CCC.⟨ cs ⟩) = suc (List.sum (List.map sizeCCC (List⁺.toList cs))) +sizeCCC>0 : ∀ {i : Size} {A : 𝔸} → (ccc : CCC.CCC i A) → sizeCCC ccc > 0 +sizeCCC>0 (a CCC.-< cs >-) = s≤s z≤n +sizeCCC>0 (D CCC.⟨ cs ⟩) = s≤s z≤n + SizedCCC : SizedLang SizedCCC = record { Lang = CCC.CCCL From 9e5b32f85cece8e8ea569e88f098cafe513e0ce5 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 22 Jul 2025 14:24:20 +0200 Subject: [PATCH 42/82] =?UTF-8?q?Factor=20out=20the=20inflation=20constant?= =?UTF-8?q?=20in=20OC=E2=89=B12CC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../OC\342\211\2612CC.agda" | 51 ++++++++++--------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" index 7256e72e..bfdf7526 100644 --- "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" @@ -216,39 +216,40 @@ goal : ∀ {i} (n : ℕ) (2cc : 2CC.2CC i NAT) goal zero 2cc 2cc≅oc = size2CC>0 2cc goal n@(suc n-1) 2cc (oc⊆2cc , 2cc⊆oc) = begin-strict - n * sizeWFOC (oc (4 * n)) - ≡⟨ Eq.cong (n *_) (size-oc (4 * n)) ⟩ - n * (2 ^ (4 * n) + 2 * suc (4 * n)) - ≤⟨ ℕ.*-monoʳ-≤ n (ℕ.+-monoʳ-≤ (2 ^ (4 * n)) (ℕ.*-monoʳ-≤ 2 (4*n<16^n n))) ⟩ - n * (2 ^ (4 * n) + 2 * 16 ^ n) - ≡⟨ Eq.cong (λ x → n * (2 ^ (4 * n) + 2 * x)) (ℕ.^-*-assoc 2 4 n) ⟩ - n * (2 ^ (4 * n) + 2 * 2 ^ (4 * n)) + n * sizeWFOC (oc m) + ≡⟨ Eq.cong (n *_) (size-oc m) ⟩ + n * (2 ^ m + 2 * suc m) + ≤⟨ ℕ.*-monoʳ-≤ n (ℕ.+-monoʳ-≤ (2 ^ m) (ℕ.*-monoʳ-≤ 2 (4*n<16^n n))) ⟩ + n * (2 ^ m + 2 * 16 ^ n) + ≡⟨ Eq.cong (λ x → n * (2 ^ m + 2 * x)) (ℕ.^-*-assoc 2 4 n) ⟩ + n * (2 ^ m + 2 * 2 ^ m) ≡⟨⟩ - n * (3 * 2 ^ (4 * n)) - <⟨ ℕ.*-monoʳ-< n (ℕ.*-monoˡ-< (2 ^ (4 * n)) {{ℕ.>-nonZero (ℕ.m^n>0 2 (4 * n))}} (ℕ.n<1+n 3)) ⟩ - n * (4 * 2 ^ (4 * n)) - ≡⟨ ℕ.*-assoc n 4 (2 ^ (4 * n)) ⟨ - n * 4 * 2 ^ (4 * n) - ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (ℕ.*-comm n 4) ⟩ - 4 * n * 2 ^ (4 * n) - <⟨ ℕ.*-monoˡ-< (2 ^ (4 * n)) {{ℕ.>-nonZero (ℕ.m^n>0 2 (4 * n))}} (ℕ.n<1+n (4 * n)) ⟩ - suc (4 * n) * 2 ^ (4 * n) - ≡⟨ Eq.cong (_* 2 ^ (4 * n)) (List.length-upTo (suc (4 * n))) ⟨ - List.length (List.upTo (suc (4 * n))) * 2 ^ (4 * n) + n * (3 * 2 ^ m) + <⟨ ℕ.*-monoʳ-< n (ℕ.*-monoˡ-< (2 ^ m) {{ℕ.>-nonZero (ℕ.m^n>0 2 m)}} (ℕ.n<1+n 3)) ⟩ + n * (4 * 2 ^ m) + ≡⟨ ℕ.*-assoc n 4 (2 ^ m) ⟨ + n * 4 * 2 ^ m + ≡⟨ Eq.cong (_* 2 ^ m) (ℕ.*-comm n 4) ⟩ + m * 2 ^ m + <⟨ ℕ.*-monoˡ-< (2 ^ m) {{ℕ.>-nonZero (ℕ.m^n>0 2 m)}} (ℕ.n<1+n m) ⟩ + suc m * 2 ^ m + ≡⟨ Eq.cong (_* 2 ^ m) (List.length-upTo (suc m)) ⟨ + List.length (List.upTo (suc m)) * 2 ^ m ≤⟨ unique-lengths⇒m*sizeRose≤size2CC - (2 ^ (4 * n)) + (2 ^ m) 2cc - (List.upTo (suc (4 * n))) - (variant (4 * n)) - (variant-size (4 * n)) - (variant-≉ (suc (4 * n))) - (Unique.applyUpTo⁺₁ id (suc (4 * n)) (λ i Date: Tue, 22 Jul 2025 15:43:20 +0200 Subject: [PATCH 43/82] Rename some things --- src/Vatras/Framework/Definitions.agda | 13 ++--- src/Vatras/Lang/FST/IncompleteOnRose.lagda.md | 10 ++-- src/Vatras/Lang/FST/NoBaseArtifacts.agda | 8 ++-- src/Vatras/Lang/OC/Alternative.agda | 8 ++-- src/Vatras/Lang/OC/IncompleteOnRose.lagda.md | 10 ++-- .../SyntacticExpressiveness/2CC- ∷ [] >- -variantGenerator : VariantGenerator (Rose ∞) NAT 0 +variantGenerator : VariantGenerator (Rose ∞) NAT' 0 variantGenerator zero = variant select-false : ∀ features → select (λ f → false) features ≡ [] diff --git a/src/Vatras/Lang/OC/Alternative.agda b/src/Vatras/Lang/OC/Alternative.agda index dde71360..8b202957 100644 --- a/src/Vatras/Lang/OC/Alternative.agda +++ b/src/Vatras/Lang/OC/Alternative.agda @@ -3,7 +3,7 @@ This module proves that option calculus cannot encode alternatives, at the example of natural numbers as the atom set. The proof is restricted to variants with alternatives at their root. -} -open import Vatras.Framework.Definitions using (𝔽; NAT) +open import Vatras.Framework.Definitions using (𝔽; NAT') module Vatras.Lang.OC.Alternative {F : 𝔽} where open import Data.List using (List; []; _∷_) @@ -21,7 +21,7 @@ open import Vatras.Lang.OC.Util using (all-oc) open import Vatras.Lang.OC.Subtree using (Subtree; subtrees; subtreeₒ-recurse) cannotEncodeAlternative : - (e : WFOC ∞ NAT) + (e : WFOC ∞ NAT') → (∃[ c ] zero -< rose-leaf zero ∷ [] >- ≡ OC.⟦ e ⟧ c) → (∃[ c ] zero -< rose-leaf (suc zero) ∷ [] >- ≡ OC.⟦ e ⟧ c) → (zero -< [] >- ≡ OC.⟦ e ⟧ (all-oc false)) @@ -29,14 +29,14 @@ cannotEncodeAlternative : ⊎ Subtree (zero -< rose-leaf (suc zero) ∷ rose-leaf zero ∷ [] >-) (OC.⟦ e ⟧ (all-oc true)) cannotEncodeAlternative e@(Root zero cs) p₁ p₂ p₃ = Sum.map subtrees subtrees (mergeSubtrees' (sublist p₁) (sublist p₂)) where - sublist : ∀ {a : ℕ} {v : Rose ∞ NAT} → (∃[ c ] a -< v ∷ [] >- ≡ OC.⟦ e ⟧ c) → Sublist Subtree (v ∷ []) (OC.⟦ cs ⟧ₒ-recurse (all-oc true)) + sublist : ∀ {a : ℕ} {v : Rose ∞ NAT'} → (∃[ c ] a -< v ∷ [] >- ≡ OC.⟦ e ⟧ c) → Sublist Subtree (v ∷ []) (OC.⟦ cs ⟧ₒ-recurse (all-oc true)) sublist (c₁ , p₁) = Eq.subst (λ cs' → Sublist Subtree cs' (OC.⟦ cs ⟧ₒ-recurse (all-oc true))) (children-equality (Eq.sym p₁)) (subtreeₒ-recurse cs c₁ (all-oc true) (λ f p → refl)) - mergeSubtrees' : ∀ {cs : List (Rose ∞ NAT)} + mergeSubtrees' : ∀ {cs : List (Rose ∞ NAT')} → Sublist Subtree (rose-leaf zero ∷ []) cs → Sublist Subtree (rose-leaf (suc zero) ∷ []) cs → Sublist Subtree (rose-leaf zero ∷ rose-leaf (suc zero) ∷ []) cs diff --git a/src/Vatras/Lang/OC/IncompleteOnRose.lagda.md b/src/Vatras/Lang/OC/IncompleteOnRose.lagda.md index ce45f3f2..3360fc58 100644 --- a/src/Vatras/Lang/OC/IncompleteOnRose.lagda.md +++ b/src/Vatras/Lang/OC/IncompleteOnRose.lagda.md @@ -1,5 +1,5 @@ ```agda -open import Vatras.Framework.Definitions using (𝔽; NAT) +open import Vatras.Framework.Definitions using (𝔽; NAT') module Vatras.Lang.OC.IncompleteOnRose {Option : 𝔽} where open import Size using (Size; ∞) @@ -9,7 +9,7 @@ open import Data.Product using (_,_; ∃-syntax; ∄-syntax) open import Relation.Binary.PropositionalEquality using (_≡_) open import Vatras.Framework.Variants using (Rose; rose-leaf) -open import Vatras.Framework.VariantGenerator (Rose ∞) NAT +open import Vatras.Framework.VariantGenerator (Rose ∞) NAT' open import Vatras.Framework.Properties.Completeness (Rose ∞) using (Incomplete) open import Vatras.Lang.OC Option using (WFOC; Root; ⟦_⟧; WFOCL) ``` @@ -18,8 +18,8 @@ We prove incompleteness by showing that there exists at least one set of variant In particular, any set of variants that includes two entirely distinct variants cannot be expressed because options cannot encode constraints such as alternatives in choice calculus. As our counter example, we use the set `{0, 1}` as our variants: ```agda -variant-0 = rose-leaf {A = NAT} 0 -variant-1 = rose-leaf {A = NAT} 1 +variant-0 = rose-leaf {A = NAT'} 0 +variant-1 = rose-leaf {A = NAT'} 1 variants-0-and-1 : VariantGenerator 1 variants-0-and-1 zero = variant-0 @@ -34,7 +34,7 @@ So we show that given an expression `e`, a proof that `e` can be configured to ` ```agda does-not-describe-variants-0-and-1 : ∀ {i : Size} - → (e : WFOC i NAT) + → (e : WFOC i NAT') → ∃[ c ] (variant-0 ≡ ⟦ e ⟧ c) → ∄[ c ] (variant-1 ≡ ⟦ e ⟧ c) -- If e has 0 as root, it may be configured to 0 but never to 1. diff --git a/src/Vatras/SyntacticExpressiveness/2CC0) -NAT' : 𝔸 -NAT' = record - { atoms = ℕ × ℕ - ; atomsEqual? = Prod.≡-dec ℕ._≟_ ℕ._≟_ - ; atomSize = proj₂ - } - -open FST.Impose NAT' hiding (_∈_) -open import Vatras.Lang.FST.Composition ℕ NAT' using (⊛-all-unique) -open import Vatras.Lang.FST.Util ℕ NAT' using (select≗filter) -open import Vatras.Lang.2CC.FixedArtifactLength ℕ NAT' using (unique-lengths⇒m*sizeRose≤size2CC) renaming (_≉_ to _≉'_) +open FST.Impose NAT hiding (_∈_) +open import Vatras.Lang.FST.Composition ℕ NAT using (⊛-all-unique) +open import Vatras.Lang.FST.Util ℕ NAT using (select≗filter) +open import Vatras.Lang.2CC.FixedArtifactLength ℕ NAT using (unique-lengths⇒m*sizeRose≤size2CC) renaming (_≉_ to _≉'_) artifact : ℕ → ℕ → FSTA ∞ artifact n zero = (0 , 2 ^ n) Rose.-< [] >- @@ -102,7 +95,6 @@ size-fst n = variant : ℕ → ℕ → FSTA ∞ variant n i = (0 , 0) Rose.-< List.applyUpTo (artifact n) (suc i) >- --- TODO called variant-size in OC≱2CC size-variant : (n i : ℕ) → 2 ^ n ≤ sizeRose (variant n i) @@ -246,7 +238,7 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( ⊆⇒All∈ : ∀ {i} n l k → k + l ≤ suc n - → (2cc : 2CC.2CC i NAT') + → (2cc : 2CC.2CC i NAT) → FST.⟦ fst n ⟧ ⊆ 2CC.⟦ 2cc ⟧ → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) (List.applyUpTo (k +_) l) ⊆⇒All∈ n zero k l≤n 2cc fst⊆2cc = [] @@ -296,8 +288,8 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( open ℕ.≤-Reasoning FST≱2CC : SizedFST ≱Size Sized2CC -FST≱2CC zero = NAT' , fst zero , λ 2cc fst≅2cc → size2CC>0 2cc -FST≱2CC (suc n) = NAT' , fst m , λ 2cc fst≅2cc → +FST≱2CC zero = NAT , fst zero , λ 2cc fst≅2cc → size2CC>0 2cc +FST≱2CC (suc n) = NAT , fst m , λ 2cc fst≅2cc → begin-strict suc n * sizeFST (fst m) <⟨ ℕ.*-monoʳ-< (suc n) ( diff --git "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" index bfdf7526..b2b5a2eb 100644 --- "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" +++ "b/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" @@ -38,10 +38,10 @@ open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; SizedWFOC; options : ℕ → List (OC.OC ∞ NAT) options zero = [] -options (suc n) = n OC.❲ 0 OC.-< [] >- ❳ ∷ options n +options (suc n) = n OC.❲ (0 , 0) OC.-< [] >- ❳ ∷ options n oc : ℕ → OC.WFOC ∞ NAT -oc n = OC.Root zero ((2 ^ n) OC.-< [] >- ∷ options n) +oc n = OC.Root (0 , 0) ((0 , 2 ^ n) OC.-< [] >- ∷ options n) size-options : ∀ n → List.sum (List.map sizeOC (options n)) ≡ 2 * n size-options zero = Eq.refl @@ -61,11 +61,11 @@ size-oc : ∀ (n : ℕ) → sizeWFOC (oc n) ≡ 2 ^ n + 2 * suc n size-oc n = sizeWFOC (oc n) ≡⟨⟩ - 1 + List.sum (List.map sizeOC ((2 ^ n) OC.-< [] >- ∷ options n)) + 1 + List.sum (List.map sizeOC ((0 , 2 ^ n) OC.-< [] >- ∷ options n)) ≡⟨⟩ - 1 + sizeOC {A = NAT} ((2 ^ n) OC.-< [] >-) + List.sum (List.map sizeOC (options n)) + 1 + sizeOC {A = NAT} ((0 , 2 ^ n) OC.-< [] >-) + List.sum (List.map sizeOC (options n)) ≡⟨⟩ - 2 + atomSize NAT (2 ^ n) + 0 + List.sum (List.map sizeOC (options n)) + 2 + atomSize NAT (0 , 2 ^ n) + 0 + List.sum (List.map sizeOC (options n)) ≡⟨⟩ 2 + (2 ^ n + 0) + List.sum (List.map sizeOC (options n)) ≡⟨ Eq.cong (λ x → 2 + (2 ^ n + 0) + x) (size-options n) ⟩ @@ -83,18 +83,18 @@ size-oc n = open Eq.≡-Reasoning exponential-artifact : ℕ → Rose ∞ NAT -exponential-artifact n = (2 ^ n) Rose.-< [] >- +exponential-artifact n = (0 , 2 ^ n) Rose.-< [] >- variant-cs : ℕ → List (Rose ∞ NAT) -variant-cs i = List.replicate i (0 Rose.-< [] >-) +variant-cs i = List.replicate i ((0 , 0) Rose.-< [] >-) variant : ℕ → ℕ → Rose ∞ NAT -variant n i = 0 Rose.-< exponential-artifact n ∷ variant-cs i >- +variant n i = (0 , 0) Rose.-< exponential-artifact n ∷ variant-cs i >- -variant-size +size-variant : (n l : ℕ) → 2 ^ n ≤ sizeRose (variant n l) -variant-size n l = +size-variant n l = begin 2 ^ n ≡⟨ ℕ.+-identityʳ (2 ^ n) ⟨ @@ -124,23 +124,23 @@ variant-≉ n {l₁} {l₂} l₁≢l₂ v₁≡v₂ = l₁≢l₂ ( where open Eq.≡-Reasoning -conf : ℕ → OC.Configuration -conf n i = i <ᵇ n +config : ℕ → OC.Configuration +config n i = i <ᵇ n ⟦options⟧-tail : ∀ n l → n ≤ l - → List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (conf l)) (options n)) + → List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n)) ≡ variant-cs n ⟦options⟧-tail zero l n≤l = Eq.refl ⟦options⟧-tail (suc n) l n- ∷_) (⟦options⟧-tail n l (ℕ.<⇒≤ n- ∷_) (⟦options⟧-tail n l (ℕ.<⇒≤ n- ∷ options n ⟧ₒ-recurse (conf l) >- + (0 , 0) Rose.-< OC.⟦ (0 , 2 ^ n) OC.-< [] >- ∷ options n ⟧ₒ-recurse (config l) >- ≡⟨⟩ - 0 Rose.-< exponential-artifact n ∷ OC.⟦ options n ⟧ₒ-recurse (conf l) >- - ≡⟨ Eq.cong (λ x → 0 Rose.-< exponential-artifact n ∷ x >-) (⟦options⟧ n l l≤n) ⟩ - 0 Rose.-< exponential-artifact n ∷ variant-cs l >- + (0 , 0) Rose.-< exponential-artifact n ∷ OC.⟦ options n ⟧ₒ-recurse (config l) >- + ≡⟨ Eq.cong (λ x → (0 , 0) Rose.-< exponential-artifact n ∷ x >-) (⟦options⟧ n l l≤n) ⟩ + (0 , 0) Rose.-< exponential-artifact n ∷ variant-cs l >- ≡⟨⟩ variant n l ∎ @@ -187,7 +187,7 @@ conf n i = i <ᵇ n (Eq.subst (_∈ 2CC.⟦ 2cc ⟧) (⟦oc⟧ n l l≤n) - (oc⊆2cc (conf l)))) + (oc⊆2cc (config l)))) 4*n<16^n : ∀ n → 4 * n < 16 ^ n 4*n<16^n zero = s≤s z≤n @@ -240,7 +240,7 @@ goal n@(suc n-1) 2cc (oc⊆2cc , 2cc⊆oc) = 2cc (List.upTo (suc m)) (variant m) - (variant-size m) + (size-variant m) (variant-≉ (suc m)) (Unique.applyUpTo⁺₁ id (suc m) (λ i- ∷ [] >- ∷ []) ⊚ ([] ∷ [] , (([] ∷ []) , (([] , []) ∷ [])) ∷ []))) ∷ (f₂ :: ((0 -< 1 -< [] >- ∷ [] >- ∷ []) ⊚ ([] ∷ [] , (([] ∷ []) , (([] , []) ∷ [])) ∷ []))) @@ -129,13 +129,13 @@ from `counter-example`. Agda can't compute with `==ꟳ` so we need the following two lemmas to sort out invalid definitions of `==ꟳ`. Then Agda can actually compute the semantics of `counter-example`. ```agda -compute-counter-example-c₁ : {v : Rose ∞ NAT} → FST.⟦ counter-example ⟧ c₁ ≡ v → 0 -< 0 -< 0 -< [] >- ∷ [] >- ∷ [] >- ≡ v +compute-counter-example-c₁ : {v : Rose ∞ NAT'} → FST.⟦ counter-example ⟧ c₁ ≡ v → 0 -< 0 -< 0 -< [] >- ∷ [] >- ∷ [] >- ≡ v compute-counter-example-c₁ p with f₁ ==ꟳ f₁ | f₂ ==ꟳ f₁ | c₁ f₁ in c₁-f₁ | c₁ f₂ in c₁-f₂ compute-counter-example-c₁ p | yes f₁≡f₁ | yes f₂≡f₁ | _ | _ = ⊥-elim (f₁≢f₂ (Eq.sym f₂≡f₁)) compute-counter-example-c₁ p | yes f₁≡f₁ | no f₂≢f₁ | true | false = p compute-counter-example-c₁ p | no f₁≢f₁ | _ | _ | _ = ⊥-elim (f₁≢f₁ refl) -compute-counter-example-c₂ : {v : Rose ∞ NAT} → FST.⟦ counter-example ⟧ c₂ ≡ v → 0 -< 0 -< 1 -< [] >- ∷ [] >- ∷ [] >- ≡ v +compute-counter-example-c₂ : {v : Rose ∞ NAT'} → FST.⟦ counter-example ⟧ c₂ ≡ v → 0 -< 0 -< 1 -< [] >- ∷ [] >- ∷ [] >- ≡ v compute-counter-example-c₂ p with f₁ ==ꟳ f₂ | f₂ ==ꟳ f₂ | c₂ f₁ in c₂-f₁ | c₂ f₂ in c₂-f₂ compute-counter-example-c₂ p | yes f₁≡f₂ | _ | _ | _ = ⊥-elim (f₁≢f₂ f₁≡f₂) compute-counter-example-c₂ p | no f₁≢f₂ | yes f₂≡f₂ | false | true = p @@ -175,7 +175,7 @@ they must be included in both variants. Simultaneously, this excludes the artifacts themselves because each configuration excludes one of them. ```agda shared-artifact : ∀ {F' : 𝔽} - → (e : OC F' ∞ NAT) + → (e : OC F' ∞ NAT') → (c₁ c₂ : OC.Configuration F') → just (0 -< rose-leaf 0 ∷ [] >-) ≡ OC.⟦ e ⟧ₒ c₁ → just (0 -< rose-leaf 1 ∷ [] >-) ≡ OC.⟦ e ⟧ₒ c₂ @@ -207,9 +207,9 @@ only prove that there is at least one more artifact. ```agda more-artifacts : ∀ {F' : 𝔽} - → (cs : List (OC F' ∞ NAT)) + → (cs : List (OC F' ∞ NAT')) → (cₙ : OC.Configuration F') - → (v : Rose ∞ NAT) + → (v : Rose ∞ NAT') → 0 -< v ∷ [] >- ∷ [] ≡ OC.⟦ cs ⟧ₒ-recurse cₙ → 1 ≤ length (OC.⟦ cs ⟧ₒ-recurse (all-oc true)) more-artifacts (a -< cs' >- ∷ cs) cₙ v p = s≤s z≤n @@ -252,7 +252,7 @@ variants forcing it to have exactly one shape. In this case, called under the intersection of `c₁` and `c₂`. ```agda induction : ∀ {F' : 𝔽} - → (cs : List (OC F' ∞ NAT)) + → (cs : List (OC F' ∞ NAT')) → (c₁ c₂ c₃ : OC.Configuration F') → 0 -< rose-leaf 0 ∷ [] >- ∷ [] ≡ OC.⟦ cs ⟧ₒ-recurse c₁ → 0 -< rose-leaf 1 ∷ [] >- ∷ [] ≡ OC.⟦ cs ⟧ₒ-recurse c₂ @@ -294,7 +294,7 @@ expression. The proof evaluates the FST expression on all relevant configurations which results in contradictions in every case. ```agda impossible : ∀ {F' : 𝔽} - → (cs : List (OC F' ∞ NAT)) + → (cs : List (OC F' ∞ NAT')) → (c₁ c₂ : OC.Configuration F') → ((c : OC.Configuration F') → ∃[ c' ] OC.⟦ Root 0 cs ⟧ c ≡ FST.⟦ counter-example ⟧ c') → 2 ≤ length (OC.⟦ cs ⟧ₒ-recurse (all-oc true)) diff --git a/src/Vatras/Translation/Lang/OC-to-FST.agda b/src/Vatras/Translation/Lang/OC-to-FST.agda index 879c1061..79285117 100644 --- a/src/Vatras/Translation/Lang/OC-to-FST.agda +++ b/src/Vatras/Translation/Lang/OC-to-FST.agda @@ -3,7 +3,7 @@ This module provides an example of neighboring artifacts with equal atoms and uses the `cannotEncodeNeighbors` lemma from `FST` to show that there are expressions in `WFOC` that cannot be encoded in `FST`. -} -open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT') module Vatras.Translation.Lang.OC-to-FST (F : 𝔽) where @@ -23,7 +23,7 @@ open import Vatras.Lang.FST.Properties using (cannotEncodeNeighbors) V = Rose ∞ open import Vatras.Framework.Relation.Expressiveness V using (_⋡_) -neighbors : WFOC F ∞ NAT +neighbors : WFOC F ∞ NAT' neighbors = Root zero (zero -< [] >- ∷ zero -< [] >- ∷ []) FST⋡WFOC : FSTL F ⋡ WFOCL F From 762ca7741bbcb32fcecb8a19bee8a87df607b79a Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 28 Jul 2025 09:01:38 +0200 Subject: [PATCH 44/82] Create size definitions using reflection MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Note that currently indirect recursion is handled by special casing `List` and `List⁺`. This will hopefully get fixed at some point. --- .../SyntacticExpressiveness/Reflection.agda | 239 ++++++++++++++++++ 1 file changed, 239 insertions(+) create mode 100644 src/Vatras/SyntacticExpressiveness/Reflection.agda diff --git a/src/Vatras/SyntacticExpressiveness/Reflection.agda b/src/Vatras/SyntacticExpressiveness/Reflection.agda new file mode 100644 index 00000000..333d8b6b --- /dev/null +++ b/src/Vatras/SyntacticExpressiveness/Reflection.agda @@ -0,0 +1,239 @@ +module Vatras.SyntacticExpressiveness.Reflection where + +open import Data.Product using (_×_; _,_; Σ-syntax; map₁; uncurry; proj₁; proj₂; map₂) +open import Data.Sum using (_⊎_) +open import Data.Nat as ℕ hiding (_≡ᵇ_) +import Data.Nat.Properties as ℕ +open import Level renaming (zero to lzero; suc to lsuc) +open import Data.Bool +open import Data.Unit +open import Data.Maybe as Maybe using (maybe; is-just) +open import Data.List +open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_) +import Data.List.Effectful +import Data.Nat.Show as ℕ +open import Data.String as S using (String) +import Effect.Monad.Identity +open import Function +open import Relation.Binary.PropositionalEquality +open import Size +open import Reflection +open import Reflection.AST +open import Reflection.AST.Argument as Argument hiding (map) +open import Reflection.AST.Argument.Information +open import Reflection.AST.Argument.Visibility +open import Reflection.AST.Name +open import Reflection.AST.Term +open import Reflection.AST.Pattern +open import Reflection.AST.Show +import Reflection.AST.Traversal +open import Reflection.TCM.Syntax +import Reflection.TCM.Effectful as TCM +open Data.List.Effectful.TraversableM (TCM.monad {lzero}) + +open import Vatras.Framework.Definitions + +module SizeByReflection where + private + infixr 1 _=<<_ + _=<<_ : ∀ {a} {b} {A : Set a} {B : Set b} → (B → TC A) → TC B → TC A + _=<<_ = flip bindTC + + hide : ∀ {a} {A : Set a} → Arg A → Arg A + hide (arg (arg-info _ m) a) = arg (arg-info hidden m) a + + getDataDefinition : Name → TC (ℕ × List Name) + getDataDefinition n = go =<< getDefinition n + where + go : Definition → TC (ℕ × List Name) + go (data-type arity constructors) = pure (arity , constructors) + go _ = typeError (strErr "The given name \"" ∷ nameErr n ∷ strErr "\" must be a data type" ∷ []) + + deconstructFunctionType : Type → List (String × Arg Type) × Type + deconstructFunctionType (pi argType (abs n resultType)) = map₁ ((n , argType) ∷_) (deconstructFunctionType resultType) + deconstructFunctionType rest = [] , rest + + getArgs : Name → TC (List (String × Arg Type) × Type) + getArgs functionName = deconstructFunctionType <$> getType functionName + + mapWithIndex : ∀ {a b} {A : Set a} {B : Set b} → (ℕ → A → B) → List A → List B + mapWithIndex {A = A} {B = B} f xs = go (length xs) xs + where + go : ℕ → List A → List B + go zero xs = [] + go (suc i) [] = [] + go (suc i) (x ∷ xs) = f i x ∷ go i xs + + withIndex : ∀ {a} {A : Set a} → List A → List (ℕ × A) + withIndex = mapWithIndex (_,_) + + withIndexReverse : ∀ {a} {A : Set a} → List A → List (ℕ × A) + withIndexReverse xs = zip (upTo (length xs)) xs + + mapWithIndexReverse : ∀ {a b} {A : Set a} {B : Set b} → (ℕ → A → B) → List A → List B + mapWithIndexReverse f xs = zipWith f (upTo (length xs)) xs + + removeIndices : ∀ {a} {A : Set a} → List ℕ → List A → List A + removeIndices {A = A} is = go zero + where + go : ℕ → List A → List A + go i [] = [] + go i (x ∷ xs) = if is-just (findᵇ (ℕ._≡ᵇ_ i) is) then go (suc i) xs else x ∷ go (suc i) xs + + module _ where + open Effect.Monad.Identity + open Reflection.AST.Traversal applicative + + fixVarsTerm : (ℕ → ℕ) → Term → Term + fixVarsTerm f = runIdentity ∘ traverseTerm (record defaultActions { onVar = λ _ i → mkIdentity (f i) }) (0 , []) + + fixVarsArgTerm : (ℕ → ℕ) → Arg Term → Arg Term + fixVarsArgTerm f (arg info term) = arg info (runIdentity (traverseTerm (record defaultActions { onVar = λ _ i → mkIdentity (f i) }) (0 , []) term)) + + fixVarsPats : (ℕ → ℕ) → List (Arg Pattern) → List (Arg Pattern) + fixVarsPats f = runIdentity ∘ traversePats (record defaultActions { onVar = λ _ i → mkIdentity (f i) }) (0 , []) + + handleRecursiveArgs : Name → (List (Arg Term) → Term) → List (ℕ × ℕ) → List (ℕ × Arg Term) → TC (List Term) + handleRecursiveArgs n sizeFun sizeFuns [] = pure [] + handleRecursiveArgs n sizeFun sizeFuns ((i , arg _ (def n' args)) ∷ as) with n ≡ᵇ n' + -- handle recursion + handleRecursiveArgs n sizeFun sizeFuns ((i , arg _ (def n' args)) ∷ as) | true = do + is <- handleRecursiveArgs n sizeFun sizeFuns as + pure (sizeFun (var i [] ⟨∷⟩ []) ∷ is) + -- handle atoms + handleRecursiveArgs n sizeFun sizeFuns ((i , arg _ (def (quote atoms) (arg _ (var Ai []) ∷ []))) ∷ as) | false = do + is <- handleRecursiveArgs n sizeFun sizeFuns as + pure (def (quote atomSize) (var (suc Ai + length as) [] ⟨∷⟩ var i [] ⟨∷⟩ []) ∷ is) + -- special case List(⁺) (for now) + handleRecursiveArgs n sizeFun sizeFuns ((i , arg _ (def n' (_ ∷ arg _ (def n'' _) ∷ []))) ∷ as) | false = do + is <- handleRecursiveArgs n sizeFun sizeFuns as + if quote List ≡ᵇ n' ∧ n ≡ᵇ n'' + then pure (def (quote sum) (def (quote map) (sizeFun [] ⟨∷⟩ var i [] ⟨∷⟩ []) ⟨∷⟩ []) ∷ is) + else if quote List⁺ ≡ᵇ n' ∧ n ≡ᵇ n'' + then pure (def (quote sum) (def (quote map) (sizeFun [] ⟨∷⟩ def (quote List⁺.toList) (var i [] ⟨∷⟩ []) ⟨∷⟩ []) ⟨∷⟩ []) ∷ is) + else pure is + handleRecursiveArgs n sizeFun sizeFuns ((i , arg _ (def n' args)) ∷ as) | false = handleRecursiveArgs n sizeFun sizeFuns as + -- handle size functions + handleRecursiveArgs n sizeFun sizeFuns ((i , arg _ (var j args)) ∷ as) = do + is <- handleRecursiveArgs n sizeFun sizeFuns as + maybe + (λ (_ , i') → pure (var i' (var i [] ⟨∷⟩ []) ∷ is)) + (pure is) + (findᵇ (λ (j' , _) → j' ℕ.≡ᵇ j + i) sizeFuns) + handleRecursiveArgs n sizeFun sizeFuns ((i , arg _ _) ∷ as) = handleRecursiveArgs n sizeFun sizeFuns as + + typeArguments : Type → TC (List (Arg Term)) + typeArguments (def f args) = pure args + typeArguments term = typeError (strErr "typeArguments got " ∷ termErr term ∷ []) + + appendArguments : Term → List (Arg Term) → TC Term + appendArguments (var i args) args' = pure (var i (args ++ args')) + appendArguments (con c args) args' = pure (con c (args ++ args')) + appendArguments (def f args) args' = pure (def f (args ++ args')) + appendArguments term args' = typeError (strErr "Cannot add arguments to " ∷ termErr term ∷ []) + + sizeFunType : String → Type → Term → TC Type + sizeFunType n type shape = do + args , _ <- deconstructFunctionType <$> normalise type -- TODO type can contain free variables + type <- appendArguments (fixVarsTerm (_+ length args) shape) (mapWithIndex (λ where i (n , arg info _) → arg info (var i [])) args) + pure (foldr + (λ (n , a) t → pi (hide a) (abs n t)) + (pi + (vArg type) + (abs n (def (quote ℕ) []))) + args) + + sizeType : Name → List ℕ → TC Type + sizeType n unsizedArgs = do + args , _ <- getArgs n + + let langType = vArg (def n (mapWithIndex (λ where i (_ , arg info _) → arg info (var (i + length args ∸ length unsizedArgs) [])) args)) + let expr→ℕ = pi langType (abs "expr" (def (quote ℕ) [])) + + sizeFuns→expr→ℕ <- foldr + (λ where (i , (n , arg info a)) t' → do + t <- t' + sizeFun <- sizeFunType n a (var i []) + pure (pi (vArg sizeFun) (abs (n S.++ "-size") t))) + (pure expr→ℕ) + (removeIndices unsizedArgs (withIndex args)) + + pure (foldr + (λ (n , a) t → pi (hide a) (abs n t)) + sizeFuns→expr→ℕ + args) + + sizeClause : Name → Name → ℕ → List ℕ → Name → TC Clause + sizeClause typeName sizeFunctionName arity unsizedArgs c = do + -- type arguments + targs , _ <- getArgs typeName + + -- constructor arguments + cargs , cResultType <- getArgs c + cResultArgs <- typeArguments cResultType + + let numSizeFuns = length targs ∸ length unsizedArgs + sizeFunTypes <- mapM + (λ where (funTypeI , (argName , arg _ argType) , arg _ argShape) → do + funType <- sizeFunType argName argType argShape + pure (argName S.++ "-size" , vArg funType)) + (withIndexReverse (removeIndices unsizedArgs (zip targs cResultArgs))) + + let argsPats = applyUpTo (λ argI → hArg (var (length cargs ∸ suc argI + numSizeFuns))) arity + let indiciesPats = fixVarsPats (_+ numSizeFuns) (map (λ where (arg _ a) → hArg (dot a)) (drop arity cResultArgs)) + let sizeFunPats = applyDownFrom (λ sizeFunI → vArg (var sizeFunI)) numSizeFuns + let cargsPats = con c (mapWithIndex (λ where cargI (_ , arg info _) → arg info (var (cargI + numSizeFuns))) (drop arity cargs)) ⟨∷⟩ [] + + sizeOperands <- sequenceM (mapWithIndex + (λ where + funI (arg _ (var typeI [])) → pure (typeI , funI) + funI (arg _ term) → typeError (strErr "Cannot yet apply size functions to specialized indicies" ∷ [])) + (removeIndices unsizedArgs cResultArgs)) + recursiveSize <- handleRecursiveArgs + typeName + (λ args → def sizeFunctionName (applyDownFrom (λ i → vArg (var i [])) numSizeFuns ++ args)) + sizeOperands + (mapWithIndex (λ where argI (_ , argType) → argI + numSizeFuns , argType) cargs) + + pure (clause + (cargs + ++ sizeFunTypes) + (argsPats + ++ indiciesPats + ++ sizeFunPats + ++ cargsPats) + (con (quote suc) + (foldl (λ acc t → + def (quote _+_) (vArg acc ∷ vArg t ∷ [])) + (quoteTerm zero) + recursiveSize + ⟨∷⟩ []))) + + generateSize : Name → Name → List ℕ → TC ⊤ + generateSize lang fun unsizedArgs = do + declareDef (vArg fun) =<< sizeType lang unsizedArgs + arity , constructors <- getDataDefinition lang + defineFun fun =<< mapM (sizeClause lang fun arity unsizedArgs) constructors + +import Vatras.Framework.Variants as V +open import Vatras.Lang.All + +unquoteDecl CCC-size = SizeByReflection.generateSize (quote CCC.CCC) CCC-size (0 ∷ 1 ∷ 2 ∷ []) +unquoteDecl 2CC-size = SizeByReflection.generateSize (quote 2CC.2CC) 2CC-size (0 ∷ 1 ∷ 2 ∷ []) +unquoteDecl OC-size = SizeByReflection.generateSize (quote OC.OC) OC-size (0 ∷ 1 ∷ 2 ∷ []) +unquoteDecl ADT-size = SizeByReflection.generateSize (quote ADT.ADT) ADT-size (0 ∷ 2 ∷ []) + +_ : CCC-size {String} {_} {NAT} ((0 , 0) CCC.-< (1 , 1) CCC.-< [] >- ∷ "A" CCC.⟨ (2 , 2) CCC.-< [] >- ∷ (3 , 3) CCC.-< (4 , 4) CCC.-< [] >- ∷ [] >- ∷ [] ⟩ ∷ [] >-) ≡ 16 +_ = refl + +_ : 2CC-size {String} {_} {NAT} ((0 , 0) 2CC.-< (1 , 1) 2CC.-< [] >- ∷ "A" 2CC.⟨ (2 , 2) 2CC.-< [] >- , (3 , 3) 2CC.-< (4 , 4) 2CC.-< [] >- ∷ [] >- ⟩ ∷ [] >-) ≡ 16 +_ = refl + +_ : OC-size {String} {_} {NAT} ((0 , 0) OC.-< (1 , 1) OC.-< [] >- ∷ "A" OC.❲ (3 , 3) OC.-< "B" OC.❲ (4 , 4) OC.-< [] >- ❳ ∷ [] >- ❳ ∷ [] >-) ≡ 14 +_ = refl + +sizeRose : ∀ {i : Size} {A : 𝔸} → V.Rose i A → ℕ +sizeRose {A = A} (a V.-< cs >-) = suc (atomSize A a + sum (map sizeRose cs)) + +_ : ADT-size {String} {V.Rose ∞} {NAT} sizeRose ("A" ADT.⟨ ADT.leaf ((1 , 1) V.-< [] >-) , "B" ADT.⟨ ADT.leaf ((2 , 2) V.-< [] >-) , ADT.leaf ((3 , 3) V.-< (4 , 4) V.-< [] >- ∷ [] >-) ⟩ ⟩) ≡ 19 +_ = refl From 90fe544cfc8de1dbab50758a1c1cfb3e481ba54c Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Thu, 4 Sep 2025 18:54:10 +0200 Subject: [PATCH 45/82] Create a dead option elimination transformation --- src/Vatras/Lang/OC/DeadElim.agda | 167 +++++++++++++++++++++++++++++++ 1 file changed, 167 insertions(+) create mode 100644 src/Vatras/Lang/OC/DeadElim.agda diff --git a/src/Vatras/Lang/OC/DeadElim.agda b/src/Vatras/Lang/OC/DeadElim.agda new file mode 100644 index 00000000..11803dfd --- /dev/null +++ b/src/Vatras/Lang/OC/DeadElim.agda @@ -0,0 +1,167 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) +open import Relation.Binary using (DecidableEquality) +module Vatras.Lang.OC.DeadElim (F : 𝔽) (_≟_ : DecidableEquality F) where + +open import Data.Bool using (Bool; true; false; if_then_else_) +open import Data.Empty using (⊥-elim) +open import Data.List as List using (List; []; _∷_) +import Data.List.Properties as List +open import Data.List.Relation.Unary.All as All using (All; []; _∷_) +open import Data.List.Relation.Unary.Any using (here; there) +open import Data.List.Membership.DecPropositional _≟_ using (_∈_; _∉_; _∈?_) +open import Data.Maybe using (just; nothing) +open import Data.Product using (Σ; _,_; proj₁; proj₂) +open import Function using (id) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_) +open import Relation.Nullary.Decidable using (yes; no; decidable-stable) +open import Size using (Size; ∞) + +open import Vatras.Util.AuxProofs using (true≢false; if-idemp) +import Vatras.Util.List as List +open import Vatras.Data.EqIndexedSet using (_≅[_][_]_; ≗→≅[]; _≅_; _⊆_) +open import Vatras.Framework.Variants using (_-<_>-) +open import Vatras.Lang.OC F using (OC; _-<_>-; _❲_❳; Configuration; ⟦_⟧ₒ) +open import Vatras.Lang.OC.Util using (all-oc) + +data RestrictOptions {A : 𝔸} : {i : Size} → List F → OC i A → Set₁ where + _-<_>- : ∀ {i} → {a : atoms A} → {cs : List (OC i A)} → (env : List F) → All (RestrictOptions env) cs → RestrictOptions env (a -< cs >-) + _❲_❳ : ∀ {i} → {f : F} → {c : OC i A} → {env : List F} → f ∉ env → RestrictOptions (f ∷ env) c → RestrictOptions env (f ❲ c ❳) + +data Undead {A : 𝔸} : {i : Size} → OC i A → Set₁ where + undead : {i : Size} → {env : List F} → {e : OC i A} → RestrictOptions env e → Undead e + +elimDead' : {i : Size} → {A : 𝔸} → (env : List F) → OC i A → Σ (OC ∞ A) (RestrictOptions env) +elimDead' env (a -< cs >-) = a -< List.map proj₁ (List.map (elimDead' env) cs) >- , (env -< All.fromList (List.map (elimDead' env) cs) >-) +elimDead' env (a ❲ c ❳) with a ∈? env +elimDead' env (a ❲ c ❳) | yes a∈env = elimDead' env c +elimDead' env (a ❲ c ❳) | no a∉env = a ❲ proj₁ (elimDead' (a ∷ env) c) ❳ , a∉env ❲ proj₂ (elimDead' (a ∷ env) c) ❳ + +elimDead : {i : Size} → {A : 𝔸} → OC i A → OC ∞ A +elimDead e = proj₁ (elimDead' [] e) + +elimDead-preserves' : {i : Size} → {A : 𝔸} → (env : List F) → (e : OC i A) → (c : Configuration) → All (λ f → c f ≡ true) env → ⟦ proj₁ (elimDead' env e) ⟧ₒ c ≡ ⟦ e ⟧ₒ c +elimDead-preserves' env (a -< cs >-) c c-env≡true = + ⟦ proj₁ (elimDead' env (a -< cs >-)) ⟧ₒ c + ≡⟨⟩ + ⟦ a -< List.map proj₁ (List.map (elimDead' env) cs) >- ⟧ₒ c + ≡⟨⟩ + just (a -< List.catMaybes (List.map (λ e → ⟦ e ⟧ₒ c) (List.map proj₁ (List.map (elimDead' env) cs))) >-) + ≡⟨ Eq.cong (λ e → just (a -< List.catMaybes e >-)) (List.map-∘ (List.map (elimDead' env) cs)) ⟨ + just (a -< List.catMaybes (List.map (λ e → ⟦ proj₁ e ⟧ₒ c) (List.map (elimDead' env) cs)) >-) + ≡⟨ Eq.cong (λ e → just (a -< List.catMaybes e >-)) (List.map-∘ cs) ⟨ + just (a -< List.catMaybes (List.map (λ e → ⟦ proj₁ (elimDead' env e) ⟧ₒ c) cs) >-) + ≡⟨ Eq.cong (λ e → just (a -< List.catMaybes e >-)) (List.map-cong (λ e → elimDead-preserves' env e c c-env≡true) cs) ⟩ + just (a -< List.catMaybes (List.map (λ e → ⟦ e ⟧ₒ c) cs) >-) + ≡⟨⟩ + ⟦ a -< cs >- ⟧ₒ c + ∎ + where + open Eq.≡-Reasoning +elimDead-preserves' env (a ❲ e ❳) c c-env≡true with a ∈? env +elimDead-preserves' env (a ❲ e ❳) c c-env≡true | yes a∈env with c a in c-a +elimDead-preserves' env (a ❲ e ❳) c c-env≡true | yes a∈env | true = elimDead-preserves' env e c c-env≡true +elimDead-preserves' env (a ❲ e ❳) c c-env≡true | yes a∈env | false = ⊥-elim (true≢false (All.lookup c-env≡true a∈env) c-a) +elimDead-preserves' env (a ❲ e ❳) c c-env≡true | no a∉env with c a in c-a +elimDead-preserves' env (a ❲ e ❳) c c-env≡true | no a∉env | true = elimDead-preserves' (a ∷ env) e c (c-a ∷ c-env≡true) +elimDead-preserves' env (a ❲ e ❳) c c-env≡true | no a∉env | false = Eq.refl + +elimDead-preserves : {i : Size} → {A : 𝔸} → (e : OC i A) → ⟦ elimDead e ⟧ₒ ≅[ id ][ id ] ⟦ e ⟧ₒ +elimDead-preserves e = ≗→≅[] (λ c → elimDead-preserves' [] e c []) + +-- TODO WFOC + +undead→≢ : {i : Size} → {A : 𝔸} → {f₁ f₂ : F} → {e : OC i A} → Undead (f₁ ❲ f₂ ❲ e ❳ ❳) → f₁ ≢ f₂ +undead→≢ (undead (f₁∉env ❲ f₂∉env ❲ undead-e ❳ ❳)) f₁≡f₂ = f₂∉env (here (Eq.sym f₁≡f₂)) + +changeConfig : F → Bool → Configuration → Configuration +changeConfig f₁ b c f₂ with f₁ ≟ f₂ +changeConfig f₁ b c f₂ | yes f₁≡f₂ = b +changeConfig f₁ b c f₂ | no f₁≢f₂ = c f₂ + +changeConfig-≡ : (f : F) → (b : Bool) → (c : Configuration) → changeConfig f b c f ≡ b +changeConfig-≡ f b c with f ≟ f +changeConfig-≡ f b c | yes f≡f = Eq.refl +changeConfig-≡ f b c | no f≢f = ⊥-elim (f≢f Eq.refl) + +changeConfig-≢ : {f₁ f₂ : F} → (b : Bool) → f₁ ≢ f₂ → (c : Configuration) → changeConfig f₁ b c f₂ ≡ c f₂ +changeConfig-≢ {f₁} {f₂} b f₁≢f₂ c with f₁ ≟ f₂ +changeConfig-≢ {f₁} {f₂} b f₁≢f₂ c | yes f₁≡f₂ = ⊥-elim (f₁≢f₂ f₁≡f₂) +changeConfig-≢ {f₁} {f₂} b f₁≢f₂ c | no f₁≢f₂ = Eq.refl + +changeConfig-∉ : {i : Size} → {A : 𝔸} → {env : List F} → (f : F) → (f ∈ env) → (b : Bool) → (c : Configuration) → (e : OC i A) → RestrictOptions env e → ⟦ e ⟧ₒ (changeConfig f b c) ≡ ⟦ e ⟧ₒ c +changeConfig-∉ f f∈env b c (a -< cs >-) (env -< undead-e >-) = + ⟦ a -< cs >- ⟧ₒ (changeConfig f b c) + ≡⟨⟩ + just (a -< List.catMaybes (List.map (λ e → ⟦ e ⟧ₒ (changeConfig f b c)) cs) >-) + ≡⟨ Eq.cong (λ x → just (a -< List.catMaybes x >-)) (List.map-cong-with∈ cs (λ e e∈cs → changeConfig-∉ f f∈env b c e (All.lookup undead-e e∈cs))) ⟩ + just (a -< List.catMaybes (List.map (λ e → ⟦ e ⟧ₒ c) cs) >-) + ≡⟨⟩ + ⟦ a -< cs >- ⟧ₒ c + ∎ + where + open Eq.≡-Reasoning +changeConfig-∉ f f∈env b c (f' ❲ e ❳) undead-e with f ≟ f' +changeConfig-∉ {env = env} f f∈env b c (f' ❲ e ❳) (f'∉env ❲ undead-e ❳) | yes f≡f' = ⊥-elim (f'∉env (Eq.subst (_∈ env) f≡f' f∈env)) +changeConfig-∉ f f∈env b c (f' ❲ e ❳) (f'∉env ❲ undead-e ❳) | no f≢f' = Eq.cong (λ e → if c f' then e else nothing) (changeConfig-∉ f (there f∈env) b c e undead-e) + +eval-option : {i : Size} → {A : 𝔸} → {f : F} → {e : OC i A} → Undead (f ❲ e ❳) → (c : Configuration) → ⟦ f ❲ e ❳ ⟧ₒ (changeConfig f true c) ≡ ⟦ e ⟧ₒ c +eval-option {f = f} {e = e} (undead (_ ❲ undead-e ❳)) c = + ⟦ f ❲ e ❳ ⟧ₒ (changeConfig f true c) + ≡⟨⟩ + (if changeConfig f true c f then ⟦ e ⟧ₒ (changeConfig f true c) else nothing) + ≡⟨ Eq.cong (λ b → if b then ⟦ e ⟧ₒ (changeConfig f true c) else nothing) (changeConfig-≡ f true c) ⟩ + ⟦ e ⟧ₒ (changeConfig f true c) + ≡⟨ changeConfig-∉ f (here Eq.refl) true c e undead-e ⟩ + ⟦ e ⟧ₒ c + ∎ + where + open Eq.≡-Reasoning + +join-options : {i : Size} → {A : 𝔸} → (f₁ f₂ : F) → (e : OC i A) → Undead (f₁ ❲ f₂ ❲ e ❳ ❳) → ⟦ f₁ ❲ f₂ ❲ e ❳ ❳ ⟧ₒ ≅ ⟦ f₂ ❲ e ❳ ⟧ₒ +join-options f₁ f₂ e undead-e'@(undead (f₁∉env ❲ f₂∉env ❲ undead-e ❳ ❳)) = go-⊆ , go-⊇ + where + go-⊆ : ⟦ f₁ ❲ f₂ ❲ e ❳ ❳ ⟧ₒ ⊆ ⟦ f₂ ❲ e ❳ ⟧ₒ + go-⊆ c with c f₂ in c-f₂ + go-⊆ c | false = c , ( + (if c f₁ then nothing else nothing) + ≡⟨ if-idemp (c f₁) ⟩ + nothing + ≡⟨ Eq.cong (λ b → if b then ⟦ e ⟧ₒ c else nothing) c-f₂ ⟨ + (if c f₂ then ⟦ e ⟧ₒ c else nothing) + ∎) + where + open Eq.≡-Reasoning + go-⊆ c | true with c f₁ + go-⊆ c | true | false = all-oc false , Eq.refl + go-⊆ c | true | true = c , ( + ⟦ e ⟧ₒ c + ≡⟨ Eq.cong (λ b → if b then ⟦ e ⟧ₒ c else nothing) c-f₂ ⟨ + (if c f₂ then ⟦ e ⟧ₒ c else nothing) + ∎) + where + open Eq.≡-Reasoning + + go-⊇ : ⟦ f₂ ❲ e ❳ ⟧ₒ ⊆ ⟦ f₁ ❲ f₂ ❲ e ❳ ❳ ⟧ₒ + go-⊇ c with c f₂ in c-f₂ + go-⊇ c | false = all-oc false , Eq.refl + go-⊇ c | true = changeConfig f₁ true c , ( + ⟦ e ⟧ₒ c + ≡⟨ changeConfig-∉ f₁ (there (here Eq.refl)) true c e undead-e ⟨ + ⟦ e ⟧ₒ (changeConfig f₁ true c) + ≡⟨ Eq.cong (λ b → if b then ⟦ e ⟧ₒ (changeConfig f₁ true c) else nothing) c-f₂ ⟨ + (if c f₂ + then ⟦ e ⟧ₒ (changeConfig f₁ true c) + else nothing) + ≡⟨ Eq.cong (λ b → if b then ⟦ e ⟧ₒ (changeConfig f₁ true c) else nothing) (changeConfig-≢ true (undead→≢ undead-e') c) ⟨ + (if changeConfig f₁ true c f₂ + then ⟦ e ⟧ₒ (changeConfig f₁ true c) + else nothing) + ≡⟨ Eq.cong (λ b → if b then if changeConfig f₁ true c f₂ then ⟦ e ⟧ₒ (changeConfig f₁ true c) else nothing else nothing) (changeConfig-≡ f₁ true c) ⟨ + (if changeConfig f₁ true c f₁ + then if changeConfig f₁ true c f₂ + then ⟦ e ⟧ₒ (changeConfig f₁ true c) + else nothing + else nothing) + ∎) + where + open Eq.≡-Reasoning From e2db0cf6e3c5beddb607e7846224fa72df6fe61c Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Thu, 4 Sep 2025 23:05:11 +0200 Subject: [PATCH 46/82] Rename SyntacticExpressiveness to Succinctness --- src/Vatras/Lang/2CC/FixedArtifactLength.agda | 2 +- src/Vatras/Lang/2CC/ReflectsVariantSize.agda | 2 +- ...yntacticExpressiveness.agda => Succinctness.agda} | 2 +- .../2CC Succinctness.agda} (99%) rename src/Vatras/{SyntacticExpressiveness => Succinctness}/2CC Succinctness}/2CC=2CC.agda (96%) rename src/Vatras/{SyntacticExpressiveness => Succinctness}/2CC=CCC.agda (64%) rename "src/Vatras/SyntacticExpressiveness/2CC\342\211\244ADT.agda" => "src/Vatras/Succinctness/2CC\342\211\244ADT.agda" (92%) rename "src/Vatras/SyntacticExpressiveness/2CC\342\211\244CCC.agda" => "src/Vatras/Succinctness/2CC\342\211\244CCC.agda" (99%) rename "src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" => "src/Vatras/Succinctness/CCC\342\211\244NCC.agda" (94%) rename "src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" => "src/Vatras/Succinctness/FST\342\211\2612CC.agda" (98%) rename "src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" => "src/Vatras/Succinctness/OC\342\211\2612CC.agda" (97%) rename src/Vatras/{SyntacticExpressiveness => Succinctness}/Reflection.agda (99%) rename src/Vatras/{SyntacticExpressiveness => Succinctness}/Sizes.agda (95%) diff --git a/src/Vatras/Lang/2CC/FixedArtifactLength.agda b/src/Vatras/Lang/2CC/FixedArtifactLength.agda index e53928f8..ae56bcfb 100644 --- a/src/Vatras/Lang/2CC/FixedArtifactLength.agda +++ b/src/Vatras/Lang/2CC/FixedArtifactLength.agda @@ -21,7 +21,7 @@ open import Vatras.Data.EqIndexedSet using (_∈_) open import Vatras.Framework.Variants using (Rose; children-equality) open import Vatras.Lang.2CC Dimension using (2CC; _⟨_,_⟩; _-<_>-; ⟦_⟧) open import Vatras.Lang.2CC.ReflectsVariantSize using (reflectsVariantSize) -open import Vatras.SyntacticExpressiveness.Sizes Dimension using (sizeRose; size2CC) +open import Vatras.Succinctness.Sizes Dimension using (sizeRose; size2CC) _≉_ : Rose ∞ A → Rose ∞ A → Set (a₁ Rose.-< cs₁ >-) ≉ (a₂ Rose.-< cs₂ >-) = List.length cs₁ ≢ List.length cs₂ diff --git a/src/Vatras/Lang/2CC/ReflectsVariantSize.agda b/src/Vatras/Lang/2CC/ReflectsVariantSize.agda index 22d94768..19e0dcb3 100644 --- a/src/Vatras/Lang/2CC/ReflectsVariantSize.agda +++ b/src/Vatras/Lang/2CC/ReflectsVariantSize.agda @@ -13,7 +13,7 @@ open import Size using (Size; ∞) open import Vatras.Data.EqIndexedSet using (_∈_) open import Vatras.Framework.Variants using (Rose; Rose-injective) open import Vatras.Lang.2CC Dimension using (2CC; _⟨_,_⟩; _-<_>-; ⟦_⟧) -open import Vatras.SyntacticExpressiveness.Sizes Dimension using (sizeRose; size2CC) +open import Vatras.Succinctness.Sizes Dimension using (sizeRose; size2CC) reflectsVariantSize : ∀ {i : Size} → (v : Rose ∞ A) diff --git a/src/Vatras/SyntacticExpressiveness.agda b/src/Vatras/Succinctness.agda similarity index 99% rename from src/Vatras/SyntacticExpressiveness.agda rename to src/Vatras/Succinctness.agda index 14ec0153..8ce0a9fd 100644 --- a/src/Vatras/SyntacticExpressiveness.agda +++ b/src/Vatras/Succinctness.agda @@ -1,4 +1,4 @@ -module Vatras.SyntacticExpressiveness where +module Vatras.Succinctness where open import Data.Empty using (⊥-elim) open import Data.Nat as ℕ using (ℕ; _≤_; _>_; _<_; _*_) diff --git a/src/Vatras/SyntacticExpressiveness/2CC_; _+_; _∸_; _*_; _0) +open import Vatras.Succinctness using (_≤Size_) +open import Vatras.Succinctness.Sizes using (sizeRose; Sized2CC; size2CC; SizedCCC; sizeCCC; sizeCCC>0) >⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ≤ᵇ n)) >⇒¬≤ᵇ (s≤s z≤n) = tt diff --git "a/src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" "b/src/Vatras/Succinctness/CCC\342\211\244NCC.agda" similarity index 94% rename from "src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" rename to "src/Vatras/Succinctness/CCC\342\211\244NCC.agda" index ac20d16f..ae5cc68a 100644 --- "a/src/Vatras/SyntacticExpressiveness/CCC\342\211\244NCC.agda" +++ "b/src/Vatras/Succinctness/CCC\342\211\244NCC.agda" @@ -1,5 +1,5 @@ open import Vatras.Framework.Definitions using (𝔽; 𝔸; atomSize) -module Vatras.SyntacticExpressiveness.CCC≤NCC (F : 𝔽) where +module Vatras.Succinctness.CCC≤NCC (F : 𝔽) where open import Data.Nat as ℕ using (suc; _≤_; s≤s; _+_) import Data.Nat.Properties as ℕ @@ -21,8 +21,8 @@ import Vatras.Util.Vec as Vec open import Vatras.Lang.All.Fixed F (Rose ∞) open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Translation.LanguageMap using (NCC→CCC) -open import Vatras.SyntacticExpressiveness using (_≤Size_) -open import Vatras.SyntacticExpressiveness.Sizes F using (SizedNCC; sizeNCC; SizedCCC; sizeCCC) +open import Vatras.Succinctness using (_≤Size_) +open import Vatras.Succinctness.Sizes F using (SizedNCC; sizeNCC; SizedCCC; sizeCCC) lemma : ∀ {i : Size} {A : 𝔸} (n : ℕ≥ 2) (ncc : NCC.NCC n i A) → sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc) ≤ sizeNCC n ncc lemma {A = A} (sucs n) (a NCC.NCC.-< cs >-) = diff --git "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" "b/src/Vatras/Succinctness/FST\342\211\2612CC.agda" similarity index 98% rename from "src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" rename to "src/Vatras/Succinctness/FST\342\211\2612CC.agda" index d388d5ce..03ce1ffc 100644 --- "a/src/Vatras/SyntacticExpressiveness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/Succinctness/FST\342\211\2612CC.agda" @@ -1,4 +1,4 @@ -module Vatras.SyntacticExpressiveness.FST≱2CC where +module Vatras.Succinctness.FST≱2CC where open import Data.Bool as Bool using (Bool; true; false; if_then_else_) import Data.Bool.Properties as Bool @@ -38,8 +38,8 @@ open import Vatras.Framework.Variants using (Rose; Rose-injective) import Vatras.Util.List as List open import Vatras.Lang.All.Fixed ℕ (Rose ∞) import Vatras.Lang.2CC.ReflectsVariantSize as 2CC -open import Vatras.SyntacticExpressiveness using (_≱Size_) -open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST; size2CC>0) +open import Vatras.Succinctness using (_≱Size_) +open import Vatras.Succinctness.Sizes ℕ using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST; size2CC>0) open FST.Impose NAT hiding (_∈_) open import Vatras.Lang.FST.Composition ℕ NAT using (⊛-all-unique) diff --git "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" "b/src/Vatras/Succinctness/OC\342\211\2612CC.agda" similarity index 97% rename from "src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" rename to "src/Vatras/Succinctness/OC\342\211\2612CC.agda" index b2b5a2eb..a5a08d14 100644 --- "a/src/Vatras/SyntacticExpressiveness/OC\342\211\2612CC.agda" +++ "b/src/Vatras/Succinctness/OC\342\211\2612CC.agda" @@ -1,6 +1,6 @@ open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT; atomSize) -- TODO abstract over (F : 𝔽) using a map (ℕ → 𝔽) -module Vatras.SyntacticExpressiveness.OC≱2CC where +module Vatras.Succinctness.OC≱2CC where open import Data.Bool using (true; false) open import Data.Empty using (⊥-elim) @@ -33,8 +33,8 @@ open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Lang.All.Fixed ℕ (Rose ∞) import Vatras.Lang.2CC.ReflectsVariantSize as 2CC open import Vatras.Lang.2CC.FixedArtifactLength ℕ NAT using (_≉_; unique-lengths⇒m*sizeRose≤size2CC) -open import Vatras.SyntacticExpressiveness using (_≱Size_) -open import Vatras.SyntacticExpressiveness.Sizes ℕ using (sizeRose; SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC; size2CC>0) +open import Vatras.Succinctness using (_≱Size_) +open import Vatras.Succinctness.Sizes ℕ using (sizeRose; SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC; size2CC>0) options : ℕ → List (OC.OC ∞ NAT) options zero = [] diff --git a/src/Vatras/SyntacticExpressiveness/Reflection.agda b/src/Vatras/Succinctness/Reflection.agda similarity index 99% rename from src/Vatras/SyntacticExpressiveness/Reflection.agda rename to src/Vatras/Succinctness/Reflection.agda index 333d8b6b..d65e8f3d 100644 --- a/src/Vatras/SyntacticExpressiveness/Reflection.agda +++ b/src/Vatras/Succinctness/Reflection.agda @@ -1,4 +1,4 @@ -module Vatras.SyntacticExpressiveness.Reflection where +module Vatras.Succinctness.Reflection where open import Data.Product using (_×_; _,_; Σ-syntax; map₁; uncurry; proj₁; proj₂; map₂) open import Data.Sum using (_⊎_) diff --git a/src/Vatras/SyntacticExpressiveness/Sizes.agda b/src/Vatras/Succinctness/Sizes.agda similarity index 95% rename from src/Vatras/SyntacticExpressiveness/Sizes.agda rename to src/Vatras/Succinctness/Sizes.agda index e4d904f5..0c85fd29 100644 --- a/src/Vatras/SyntacticExpressiveness/Sizes.agda +++ b/src/Vatras/Succinctness/Sizes.agda @@ -1,5 +1,5 @@ open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms; atomSize) -module Vatras.SyntacticExpressiveness.Sizes (F : 𝔽) where +module Vatras.Succinctness.Sizes (F : 𝔽) where open import Data.Nat using (ℕ; suc; zero; _+_; _>_; s≤s; z≤n) import Data.List as List @@ -11,7 +11,7 @@ open import Size using (Size; ∞) open import Vatras.Util.Nat.AtLeast using (ℕ≥) open import Vatras.Framework.Variants using (Rose) open import Vatras.Lang.All.Fixed F (Rose ∞) -open import Vatras.SyntacticExpressiveness using (SizedLang) +open import Vatras.Succinctness using (SizedLang) sizeRose : ∀ {i : Size} {A : 𝔸} → Rose i A → ℕ sizeRose {A = A} (a Rose.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeRose cs)) From e69781f23b6d3143288b20071ff2d189f82932a5 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Fri, 5 Sep 2025 01:15:43 +0200 Subject: [PATCH 47/82] Refactor the succinctness module structure --- .../ProofDefinition.agda} | 2 +- src/Vatras/Succinctness/{ => Relations}/2CC Relations}/2CC=2CC.agda | 4 ++-- src/Vatras/Succinctness/{ => Relations}/2CC=CCC.agda | 10 +++++----- .../Succinctness/Relations/2CC\342\211\244ADT.agda" | 4 ++-- .../Succinctness/Relations/2CC\342\211\244CCC.agda" | 4 ++-- .../Succinctness/Relations/CCC\342\211\244NCC.agda" | 4 ++-- .../Succinctness/Relations/FST\342\211\2612CC.agda" | 4 ++-- .../Succinctness/Relations/OC\342\211\2612CC.agda" | 4 ++-- src/Vatras/Succinctness/Sizes.agda | 2 +- 10 files changed, 22 insertions(+), 22 deletions(-) rename src/Vatras/{Succinctness.agda => Succinctness/ProofDefinition.agda} (99%) rename src/Vatras/Succinctness/{ => Relations}/2CC Relations}/2CC=2CC.agda (98%) rename src/Vatras/Succinctness/{ => Relations}/2CC=CCC.agda (70%) rename "src/Vatras/Succinctness/2CC\342\211\244ADT.agda" => "src/Vatras/Succinctness/Relations/2CC\342\211\244ADT.agda" (95%) rename "src/Vatras/Succinctness/2CC\342\211\244CCC.agda" => "src/Vatras/Succinctness/Relations/2CC\342\211\244CCC.agda" (99%) rename "src/Vatras/Succinctness/CCC\342\211\244NCC.agda" => "src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" (96%) rename "src/Vatras/Succinctness/FST\342\211\2612CC.agda" => "src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" (99%) rename "src/Vatras/Succinctness/OC\342\211\2612CC.agda" => "src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" (98%) diff --git a/src/Vatras/Succinctness.agda b/src/Vatras/Succinctness/ProofDefinition.agda similarity index 99% rename from src/Vatras/Succinctness.agda rename to src/Vatras/Succinctness/ProofDefinition.agda index 8ce0a9fd..a8cf2e4c 100644 --- a/src/Vatras/Succinctness.agda +++ b/src/Vatras/Succinctness/ProofDefinition.agda @@ -1,4 +1,4 @@ -module Vatras.Succinctness where +module Vatras.Succinctness.ProofDefinition where open import Data.Empty using (⊥-elim) open import Data.Nat as ℕ using (ℕ; _≤_; _>_; _<_; _*_) diff --git a/src/Vatras/Succinctness/2CC_; _+_; _∸_; _*_; _0) >⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ≤ᵇ n)) diff --git "a/src/Vatras/Succinctness/CCC\342\211\244NCC.agda" "b/src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" similarity index 96% rename from "src/Vatras/Succinctness/CCC\342\211\244NCC.agda" rename to "src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" index ae5cc68a..03a0c15f 100644 --- "a/src/Vatras/Succinctness/CCC\342\211\244NCC.agda" +++ "b/src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" @@ -1,5 +1,5 @@ open import Vatras.Framework.Definitions using (𝔽; 𝔸; atomSize) -module Vatras.Succinctness.CCC≤NCC (F : 𝔽) where +module Vatras.Succinctness.Relations.CCC≤NCC (F : 𝔽) where open import Data.Nat as ℕ using (suc; _≤_; s≤s; _+_) import Data.Nat.Properties as ℕ @@ -21,7 +21,7 @@ import Vatras.Util.Vec as Vec open import Vatras.Lang.All.Fixed F (Rose ∞) open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Translation.LanguageMap using (NCC→CCC) -open import Vatras.Succinctness using (_≤Size_) +open import Vatras.Succinctness.ProofDefinition using (_≤Size_) open import Vatras.Succinctness.Sizes F using (SizedNCC; sizeNCC; SizedCCC; sizeCCC) lemma : ∀ {i : Size} {A : 𝔸} (n : ℕ≥ 2) (ncc : NCC.NCC n i A) → sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc) ≤ sizeNCC n ncc diff --git "a/src/Vatras/Succinctness/FST\342\211\2612CC.agda" "b/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" similarity index 99% rename from "src/Vatras/Succinctness/FST\342\211\2612CC.agda" rename to "src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" index 03ce1ffc..5de9611f 100644 --- "a/src/Vatras/Succinctness/FST\342\211\2612CC.agda" +++ "b/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" @@ -1,4 +1,4 @@ -module Vatras.Succinctness.FST≱2CC where +module Vatras.Succinctness.Relations.FST≱2CC where open import Data.Bool as Bool using (Bool; true; false; if_then_else_) import Data.Bool.Properties as Bool @@ -38,7 +38,7 @@ open import Vatras.Framework.Variants using (Rose; Rose-injective) import Vatras.Util.List as List open import Vatras.Lang.All.Fixed ℕ (Rose ∞) import Vatras.Lang.2CC.ReflectsVariantSize as 2CC -open import Vatras.Succinctness using (_≱Size_) +open import Vatras.Succinctness.ProofDefinition using (_≱Size_) open import Vatras.Succinctness.Sizes ℕ using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST; size2CC>0) open FST.Impose NAT hiding (_∈_) diff --git "a/src/Vatras/Succinctness/OC\342\211\2612CC.agda" "b/src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" similarity index 98% rename from "src/Vatras/Succinctness/OC\342\211\2612CC.agda" rename to "src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" index a5a08d14..8d3495c0 100644 --- "a/src/Vatras/Succinctness/OC\342\211\2612CC.agda" +++ "b/src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" @@ -1,6 +1,6 @@ open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT; atomSize) -- TODO abstract over (F : 𝔽) using a map (ℕ → 𝔽) -module Vatras.Succinctness.OC≱2CC where +module Vatras.Succinctness.Relations.OC≱2CC where open import Data.Bool using (true; false) open import Data.Empty using (⊥-elim) @@ -33,7 +33,7 @@ open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Lang.All.Fixed ℕ (Rose ∞) import Vatras.Lang.2CC.ReflectsVariantSize as 2CC open import Vatras.Lang.2CC.FixedArtifactLength ℕ NAT using (_≉_; unique-lengths⇒m*sizeRose≤size2CC) -open import Vatras.Succinctness using (_≱Size_) +open import Vatras.Succinctness.ProofDefinition using (_≱Size_) open import Vatras.Succinctness.Sizes ℕ using (sizeRose; SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC; size2CC>0) options : ℕ → List (OC.OC ∞ NAT) diff --git a/src/Vatras/Succinctness/Sizes.agda b/src/Vatras/Succinctness/Sizes.agda index 0c85fd29..a54f3d72 100644 --- a/src/Vatras/Succinctness/Sizes.agda +++ b/src/Vatras/Succinctness/Sizes.agda @@ -11,7 +11,7 @@ open import Size using (Size; ∞) open import Vatras.Util.Nat.AtLeast using (ℕ≥) open import Vatras.Framework.Variants using (Rose) open import Vatras.Lang.All.Fixed F (Rose ∞) -open import Vatras.Succinctness using (SizedLang) +open import Vatras.Succinctness.ProofDefinition using (SizedLang) sizeRose : ∀ {i : Size} {A : 𝔸} → Rose i A → ℕ sizeRose {A = A} (a Rose.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeRose cs)) From 290d6e6be89ddcb9c7d47e3b3b10000780f8aab9 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Fri, 5 Sep 2025 13:19:58 +0200 Subject: [PATCH 48/82] Add the designed definition --- .../Succinctness/DesignedDefinition.agda | 191 ++++++++++++++++++ 1 file changed, 191 insertions(+) create mode 100644 src/Vatras/Succinctness/DesignedDefinition.agda diff --git a/src/Vatras/Succinctness/DesignedDefinition.agda b/src/Vatras/Succinctness/DesignedDefinition.agda new file mode 100644 index 00000000..2577f628 --- /dev/null +++ b/src/Vatras/Succinctness/DesignedDefinition.agda @@ -0,0 +1,191 @@ +open import Vatras.Framework.Definitions +open import Vatras.Framework.VariabilityLanguage +open import Data.Nat hiding (_≡ᵇ_) +module Vatras.Succinctness.DesignedDefinition (V : 𝕍) (size : {A : 𝔸} (VL : VariabilityLanguage V) → Expression VL A → ℕ) where + +open import Data.Empty using (⊥-elim) +open import Data.Product using (_×_; _,_; Σ-syntax; ∃-syntax; ∄-syntax; map₁) +open import Data.Sum using (_⊎_) +import Data.Nat.Properties as ℕ +open import Relation.Binary.PropositionalEquality as Eq using (_≡_) +open import Relation.Nullary.Decidable using (yes; no) +open import Function using (id) + +open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans) +open import Vatras.Framework.Relation.Expression V +open import Vatras.Framework.Relation.Expressiveness V + +size≤ + : {A : 𝔸} + → (m : ℕ) + → (f : ℕ → ℕ) + → (VL₁ VL₂ : VariabilityLanguage V) + → Expression VL₁ A + → Expression VL₂ A + → Set +size≤ m f VL₁ VL₂ e₁ e₂ = + size VL₁ e₁ ≤ m * f (size VL₂ e₂) + +minimalExpression + : {A : 𝔸} (VL : VariabilityLanguage V) + → Expression VL A + → Set _ +minimalExpression {A} VL e = + ∀ (e' : Expression VL A) (e≅e' : VL , VL ⊢ e ≣ e') + → size≤ 1 id VL VL e e' + +design + : (f : ℕ → ℕ) + → (VL₁ VL₂ : VariabilityLanguage V) + → Set _ +design f VL₁ VL₂ = + ∀ (A : 𝔸) + → Σ[ m ∈ ℕ ] + ∀ (e₁ : Expression VL₁ A) + (e₂ : Expression VL₂ A) + → VL₁ , VL₂ ⊢ e₁ ≣ e₂ + → minimalExpression VL₁ e₁ + → minimalExpression VL₂ e₂ + → size≤ m f VL₁ VL₂ e₁ e₂ + +relation + : (VL₁ VL₂ : VariabilityLanguage V) + → Set _ +relation VL₁ VL₂ = design id VL₁ VL₂ + +translatable + : (VL₁ VL₂ : VariabilityLanguage V) + → {A : 𝔸} + → (e₁ : Expression VL₁ A) + → Set _ +translatable VL₁ VL₂ {A} e₁ = + Σ[ e₂ ∈ Expression VL₂ A ] VL₂ , VL₁ ⊢ e₂ ≣ e₁ + +simplification + : (f : ℕ → ℕ) + → (VL₁ VL₂ : VariabilityLanguage V) + → Set _ +simplification f VL₁ VL₂ = + ∀ (A : 𝔸) → + Σ[ m ∈ ℕ ] + ∀ (e₂ : Expression VL₂ A) + → translatable VL₂ VL₁ e₂ + → Σ[ e₁ ∈ Expression VL₁ A ] + (VL₁ , VL₂ ⊢ e₁ ≣ e₂) + × size≤ m f VL₁ VL₂ e₁ e₂ + +simplification→design + : (f : ℕ → ℕ) + → (VL₁ VL₂ : VariabilityLanguage V) + → simplification f VL₁ VL₂ + → design f VL₁ VL₂ + +simplification→design f VL₁ VL₂ simplification A with simplification A +simplification→design f VL₁ VL₂ simplification A | m , simplification' = m , go + where + open ℕ.≤-Reasoning + + go : + ∀ (e₁ : Expression VL₁ A) (e₂ : Expression VL₂ A) (e₁≅e₂ : VL₁ , VL₂ ⊢ e₁ ≣ e₂) + → minimalExpression VL₁ e₁ + → minimalExpression VL₂ e₂ + → size≤ m f VL₁ VL₂ e₁ e₂ + go e₁ e₂ e₁≅e₂ e₁-minimal e₂-minimal with simplification' e₂ (e₁ , e₁≅e₂) + go e₁ e₂ e₁≅e₂ e₁-minimal e₂-minimal | e₁' , e₁'≅e₂ , e₁'≤e₂ = ℕ.≤-trans (e₁-minimal e₁' (≅-trans e₁≅e₂ (≅-sym e₁'≅e₂))) ( + begin + 1 * size VL₁ e₁' + ≡⟨ ℕ.*-identityˡ (size VL₁ e₁') ⟩ + size VL₁ e₁' + ≤⟨ e₁'≤e₂ ⟩ + m * f (size VL₂ e₂) + ∎) + +open import Axiom.ExcludedMiddle +module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where + + ∃minimalExpression + : {A : 𝔸} + → (VL : VariabilityLanguage V) + → (e : Expression VL A) + → Σ[ e' ∈ Expression VL A ] (VL , VL ⊢ e ≣ e') × minimalExpression VL e' + ∃minimalExpression {A} VL e = go (size VL e) zero (Eq.sym (ℕ.*-identityˡ (size VL e))) λ where () + where + open ℕ.≤-Reasoning + + go + : (m n : ℕ) + → size VL e ≡ m + n + → (∄[ e' ] (VL , VL ⊢ e ≣ e') × size {A} VL e' < n) + → Σ[ e' ∈ Expression VL A ] (VL , VL ⊢ e ≣ e') × minimalExpression VL e' + go zero n size≡m+n ∄smaller = e , ≅-refl , isMinimal + where + isMinimal : (e' : Expression VL A) → VL , VL ⊢ e ≣ e' → size≤ 1 id VL VL e e' + isMinimal e' e≅e' with size VL e ≤? size VL e' + isMinimal e' e≅e' | yes e≤e' = + begin + size VL e + ≤⟨ e≤e' ⟩ + size VL e' + ≡⟨ ℕ.*-identityˡ (size VL e') ⟨ + 1 * size VL e' + ∎ + isMinimal e' e≅e' | no e≰e' = ⊥-elim (∄smaller (e' , e≅e' , ( + begin-strict + size VL e' + <⟨ ℕ.≰⇒> e≰e' ⟩ + size VL e + ≡⟨ size≡m+n ⟩ + n + ∎))) + go (suc m) n size≡m+n ∄smaller with excludedMiddle {P = ∃[ e' ] (VL , VL ⊢ e ≣ e') × size {A} VL e' < suc n} + go (suc m) n size≡m+n ∄smaller | no ∄e' e'≰e'' ⟩ + size VL e' + ≤⟨ ℕ.≤-pred e'≤e ⟩ + n + ∎))) + + design→simplification + : (f : ℕ → ℕ) + → (∀ n m → n ≤ m → f n ≤ f m) + → (VL₁ VL₂ : VariabilityLanguage V) + → design f VL₁ VL₂ + → simplification f VL₁ VL₂ + design→simplification f f-monotone VL₁ VL₂ design A with design A + design→simplification f f-monotone VL₁ VL₂ design A | m , design' = m , go + where + open ℕ.≤-Reasoning + + go : + ∀ (e₂ : Expression VL₂ A) + → Σ[ e₁ ∈ Expression VL₁ A ] + (VL₁ , VL₂ ⊢ e₁ ≣ e₂) + → Σ[ e₁ ∈ Expression VL₁ A ] + (VL₁ , VL₂ ⊢ e₁ ≣ e₂) + × size≤ m f VL₁ VL₂ e₁ e₂ + go e₂ (e₁ , e₁≅e₂) with ∃minimalExpression VL₁ e₁ | ∃minimalExpression VL₂ e₂ + go e₂ (e₁ , e₁≅e₂) | e₁' , e₁≅e₁' , e₁'-minimal | e₂' , e₂≅e₂' , e₂'-minimal = e₁' , ≅-trans (≅-sym e₁≅e₁') e₁≅e₂ , ( + begin + size VL₁ e₁' + ≤⟨ design' e₁' e₂' (≅-trans (≅-sym e₁≅e₁') (≅-trans e₁≅e₂ e₂≅e₂')) e₁'-minimal e₂'-minimal ⟩ + m * f (size VL₂ e₂') + ≤⟨ ℕ.*-monoʳ-≤ m (f-monotone (size VL₂ e₂') (1 * size VL₂ e₂) (e₂'-minimal e₂ (≅-sym e₂≅e₂'))) ⟩ + m * f (1 * size VL₂ e₂) + ≡⟨ Eq.cong (λ x → m * f x) (ℕ.*-identityˡ (size VL₂ e₂)) ⟩ + m * f (size VL₂ e₂) + ∎) From 5860509c522b06cde5c41d99c3c4385e1a542d51 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Fri, 5 Sep 2025 23:20:04 +0200 Subject: [PATCH 49/82] Inline size comparison --- .../Succinctness/DesignedDefinition.agda | 58 ++++--------------- 1 file changed, 12 insertions(+), 46 deletions(-) diff --git a/src/Vatras/Succinctness/DesignedDefinition.agda b/src/Vatras/Succinctness/DesignedDefinition.agda index 2577f628..ea39c92a 100644 --- a/src/Vatras/Succinctness/DesignedDefinition.agda +++ b/src/Vatras/Succinctness/DesignedDefinition.agda @@ -4,7 +4,7 @@ open import Data.Nat hiding (_≡ᵇ_) module Vatras.Succinctness.DesignedDefinition (V : 𝕍) (size : {A : 𝔸} (VL : VariabilityLanguage V) → Expression VL A → ℕ) where open import Data.Empty using (⊥-elim) -open import Data.Product using (_×_; _,_; Σ-syntax; ∃-syntax; ∄-syntax; map₁) +open import Data.Product using (_×_; _,_; Σ-syntax; ∃-syntax; ∄-syntax) open import Data.Sum using (_⊎_) import Data.Nat.Properties as ℕ open import Relation.Binary.PropositionalEquality as Eq using (_≡_) @@ -15,24 +15,13 @@ open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans) open import Vatras.Framework.Relation.Expression V open import Vatras.Framework.Relation.Expressiveness V -size≤ - : {A : 𝔸} - → (m : ℕ) - → (f : ℕ → ℕ) - → (VL₁ VL₂ : VariabilityLanguage V) - → Expression VL₁ A - → Expression VL₂ A - → Set -size≤ m f VL₁ VL₂ e₁ e₂ = - size VL₁ e₁ ≤ m * f (size VL₂ e₂) - minimalExpression : {A : 𝔸} (VL : VariabilityLanguage V) → Expression VL A → Set _ minimalExpression {A} VL e = ∀ (e' : Expression VL A) (e≅e' : VL , VL ⊢ e ≣ e') - → size≤ 1 id VL VL e e' + → size VL e ≤ size VL e' design : (f : ℕ → ℕ) @@ -46,7 +35,7 @@ design f VL₁ VL₂ = → VL₁ , VL₂ ⊢ e₁ ≣ e₂ → minimalExpression VL₁ e₁ → minimalExpression VL₂ e₂ - → size≤ m f VL₁ VL₂ e₁ e₂ + → size VL₁ e₁ ≤ m * f (size VL₂ e₂) relation : (VL₁ VL₂ : VariabilityLanguage V) @@ -72,7 +61,7 @@ simplification f VL₁ VL₂ = → translatable VL₂ VL₁ e₂ → Σ[ e₁ ∈ Expression VL₁ A ] (VL₁ , VL₂ ⊢ e₁ ≣ e₂) - × size≤ m f VL₁ VL₂ e₁ e₂ + × size VL₁ e₁ ≤ m * f (size VL₂ e₂) simplification→design : (f : ℕ → ℕ) @@ -89,16 +78,9 @@ simplification→design f VL₁ VL₂ simplification A | m , simplification' = m ∀ (e₁ : Expression VL₁ A) (e₂ : Expression VL₂ A) (e₁≅e₂ : VL₁ , VL₂ ⊢ e₁ ≣ e₂) → minimalExpression VL₁ e₁ → minimalExpression VL₂ e₂ - → size≤ m f VL₁ VL₂ e₁ e₂ + → size VL₁ e₁ ≤ m * f (size VL₂ e₂) go e₁ e₂ e₁≅e₂ e₁-minimal e₂-minimal with simplification' e₂ (e₁ , e₁≅e₂) - go e₁ e₂ e₁≅e₂ e₁-minimal e₂-minimal | e₁' , e₁'≅e₂ , e₁'≤e₂ = ℕ.≤-trans (e₁-minimal e₁' (≅-trans e₁≅e₂ (≅-sym e₁'≅e₂))) ( - begin - 1 * size VL₁ e₁' - ≡⟨ ℕ.*-identityˡ (size VL₁ e₁') ⟩ - size VL₁ e₁' - ≤⟨ e₁'≤e₂ ⟩ - m * f (size VL₂ e₂) - ∎) + go e₁ e₂ e₁≅e₂ e₁-minimal e₂-minimal | e₁' , e₁'≅e₂ , e₁'≤e₂ = ℕ.≤-trans (e₁-minimal e₁' (≅-trans e₁≅e₂ (≅-sym e₁'≅e₂))) e₁'≤e₂ open import Axiom.ExcludedMiddle module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where @@ -119,16 +101,9 @@ module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where → Σ[ e' ∈ Expression VL A ] (VL , VL ⊢ e ≣ e') × minimalExpression VL e' go zero n size≡m+n ∄smaller = e , ≅-refl , isMinimal where - isMinimal : (e' : Expression VL A) → VL , VL ⊢ e ≣ e' → size≤ 1 id VL VL e e' + isMinimal : (e' : Expression VL A) → VL , VL ⊢ e ≣ e' → size VL e ≤ size VL e' isMinimal e' e≅e' with size VL e ≤? size VL e' - isMinimal e' e≅e' | yes e≤e' = - begin - size VL e - ≤⟨ e≤e' ⟩ - size VL e' - ≡⟨ ℕ.*-identityˡ (size VL e') ⟨ - 1 * size VL e' - ∎ + isMinimal e' e≅e' | yes e≤e' = e≤e' isMinimal e' e≅e' | no e≰e' = ⊥-elim (∄smaller (e' , e≅e' , ( begin-strict size VL e' @@ -141,16 +116,9 @@ module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where go (suc m) n size≡m+n ∄smaller | no ∄e' Date: Fri, 5 Sep 2025 23:52:38 +0200 Subject: [PATCH 50/82] Use `SizedLang` in the designed succinctness relation --- src/Vatras/Lang/2CC/FixedArtifactLength.agda | 2 +- src/Vatras/Lang/2CC/ReflectsVariantSize.agda | 2 +- .../Succinctness/DesignedDefinition.agda | 74 +++++----- src/Vatras/Succinctness/ProofDefinition.agda | 58 ++++---- .../Succinctness/Relations/2CC-; ⟦_⟧) open import Vatras.Lang.2CC.ReflectsVariantSize using (reflectsVariantSize) -open import Vatras.Succinctness.Sizes Dimension using (sizeRose; size2CC) +open import Vatras.Succinctness.Sizes using (sizeRose; size2CC) _≉_ : Rose ∞ A → Rose ∞ A → Set (a₁ Rose.-< cs₁ >-) ≉ (a₂ Rose.-< cs₂ >-) = List.length cs₁ ≢ List.length cs₂ diff --git a/src/Vatras/Lang/2CC/ReflectsVariantSize.agda b/src/Vatras/Lang/2CC/ReflectsVariantSize.agda index 19e0dcb3..7037eb53 100644 --- a/src/Vatras/Lang/2CC/ReflectsVariantSize.agda +++ b/src/Vatras/Lang/2CC/ReflectsVariantSize.agda @@ -13,7 +13,7 @@ open import Size using (Size; ∞) open import Vatras.Data.EqIndexedSet using (_∈_) open import Vatras.Framework.Variants using (Rose; Rose-injective) open import Vatras.Lang.2CC Dimension using (2CC; _⟨_,_⟩; _-<_>-; ⟦_⟧) -open import Vatras.Succinctness.Sizes Dimension using (sizeRose; size2CC) +open import Vatras.Succinctness.Sizes using (sizeRose; size2CC) reflectsVariantSize : ∀ {i : Size} → (v : Rose ∞ A) diff --git a/src/Vatras/Succinctness/DesignedDefinition.agda b/src/Vatras/Succinctness/DesignedDefinition.agda index ea39c92a..e0841aff 100644 --- a/src/Vatras/Succinctness/DesignedDefinition.agda +++ b/src/Vatras/Succinctness/DesignedDefinition.agda @@ -1,71 +1,73 @@ -open import Vatras.Framework.Definitions -open import Vatras.Framework.VariabilityLanguage -open import Data.Nat hiding (_≡ᵇ_) -module Vatras.Succinctness.DesignedDefinition (V : 𝕍) (size : {A : 𝔸} (VL : VariabilityLanguage V) → Expression VL A → ℕ) where +open import Vatras.Framework.Definitions using (𝔸; 𝕍) +module Vatras.Succinctness.DesignedDefinition (V : 𝕍) where open import Data.Empty using (⊥-elim) open import Data.Product using (_×_; _,_; Σ-syntax; ∃-syntax; ∄-syntax) open import Data.Sum using (_⊎_) +open import Data.Nat using (ℕ; zero; suc; _≤_; _<_; _≤?_; _+_; _*_) import Data.Nat.Properties as ℕ open import Relation.Binary.PropositionalEquality as Eq using (_≡_) open import Relation.Nullary.Decidable using (yes; no) open import Function using (id) open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans) +open import Vatras.Framework.VariabilityLanguage using (Expression) open import Vatras.Framework.Relation.Expression V open import Vatras.Framework.Relation.Expressiveness V +open import Vatras.Succinctness.Sizes using (SizedLang; Lang; size) minimalExpression - : {A : 𝔸} (VL : VariabilityLanguage V) - → Expression VL A + : {A : 𝔸} (VL : SizedLang V) + → Expression (Lang VL) A → Set _ minimalExpression {A} VL e = - ∀ (e' : Expression VL A) (e≅e' : VL , VL ⊢ e ≣ e') + ∀ (e' : Expression (Lang VL) A) (e≅e' : Lang VL , Lang VL ⊢ e ≣ e') → size VL e ≤ size VL e' design : (f : ℕ → ℕ) - → (VL₁ VL₂ : VariabilityLanguage V) + → (VL₁ VL₂ : SizedLang V) → Set _ design f VL₁ VL₂ = ∀ (A : 𝔸) → Σ[ m ∈ ℕ ] - ∀ (e₁ : Expression VL₁ A) - (e₂ : Expression VL₂ A) - → VL₁ , VL₂ ⊢ e₁ ≣ e₂ + ∀ (e₁ : Expression (Lang VL₁) A) + (e₂ : Expression (Lang VL₂) A) + → Lang VL₁ , Lang VL₂ ⊢ e₁ ≣ e₂ → minimalExpression VL₁ e₁ → minimalExpression VL₂ e₂ → size VL₁ e₁ ≤ m * f (size VL₂ e₂) relation - : (VL₁ VL₂ : VariabilityLanguage V) + : (VL₁ VL₂ : SizedLang V) → Set _ -relation VL₁ VL₂ = design id VL₁ VL₂ +relation = design id translatable - : (VL₁ VL₂ : VariabilityLanguage V) + : (VL₁ VL₂ : SizedLang V) → {A : 𝔸} - → (e₁ : Expression VL₁ A) + → (e₁ : Expression (Lang VL₁) A) → Set _ translatable VL₁ VL₂ {A} e₁ = - Σ[ e₂ ∈ Expression VL₂ A ] VL₂ , VL₁ ⊢ e₂ ≣ e₁ + Σ[ e₂ ∈ Expression (Lang VL₂) A ] + Lang VL₂ , Lang VL₁ ⊢ e₂ ≣ e₁ simplification : (f : ℕ → ℕ) - → (VL₁ VL₂ : VariabilityLanguage V) + → (VL₁ VL₂ : SizedLang V) → Set _ simplification f VL₁ VL₂ = ∀ (A : 𝔸) → Σ[ m ∈ ℕ ] - ∀ (e₂ : Expression VL₂ A) + ∀ (e₂ : Expression (Lang VL₂) A) → translatable VL₂ VL₁ e₂ - → Σ[ e₁ ∈ Expression VL₁ A ] - (VL₁ , VL₂ ⊢ e₁ ≣ e₂) + → Σ[ e₁ ∈ Expression (Lang VL₁) A ] + (Lang VL₁ , Lang VL₂ ⊢ e₁ ≣ e₂) × size VL₁ e₁ ≤ m * f (size VL₂ e₂) simplification→design : (f : ℕ → ℕ) - → (VL₁ VL₂ : VariabilityLanguage V) + → (VL₁ VL₂ : SizedLang V) → simplification f VL₁ VL₂ → design f VL₁ VL₂ @@ -75,7 +77,7 @@ simplification→design f VL₁ VL₂ simplification A | m , simplification' = m open ℕ.≤-Reasoning go : - ∀ (e₁ : Expression VL₁ A) (e₂ : Expression VL₂ A) (e₁≅e₂ : VL₁ , VL₂ ⊢ e₁ ≣ e₂) + ∀ (e₁ : Expression (Lang VL₁) A) (e₂ : Expression (Lang VL₂) A) (e₁≅e₂ : Lang VL₁ , Lang VL₂ ⊢ e₁ ≣ e₂) → minimalExpression VL₁ e₁ → minimalExpression VL₂ e₂ → size VL₁ e₁ ≤ m * f (size VL₂ e₂) @@ -87,9 +89,9 @@ module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where ∃minimalExpression : {A : 𝔸} - → (VL : VariabilityLanguage V) - → (e : Expression VL A) - → Σ[ e' ∈ Expression VL A ] (VL , VL ⊢ e ≣ e') × minimalExpression VL e' + → (VL : SizedLang V) + → (e : Expression (Lang VL) A) + → Σ[ e' ∈ Expression (Lang VL) A ] (Lang VL , Lang VL ⊢ e ≣ e') × minimalExpression VL e' ∃minimalExpression {A} VL e = go (size VL e) zero (Eq.sym (ℕ.*-identityˡ (size VL e))) λ where () where open ℕ.≤-Reasoning @@ -97,11 +99,11 @@ module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where go : (m n : ℕ) → size VL e ≡ m + n - → (∄[ e' ] (VL , VL ⊢ e ≣ e') × size {A} VL e' < n) - → Σ[ e' ∈ Expression VL A ] (VL , VL ⊢ e ≣ e') × minimalExpression VL e' + → (∄[ e' ] (Lang VL , Lang VL ⊢ e ≣ e') × size VL e' < n) + → Σ[ e' ∈ Expression (Lang VL) A ] (Lang VL , Lang VL ⊢ e ≣ e') × minimalExpression VL e' go zero n size≡m+n ∄smaller = e , ≅-refl , isMinimal where - isMinimal : (e' : Expression VL A) → VL , VL ⊢ e ≣ e' → size VL e ≤ size VL e' + isMinimal : (e' : Expression (Lang VL) A) → Lang VL , Lang VL ⊢ e ≣ e' → size VL e ≤ size VL e' isMinimal e' e≅e' with size VL e ≤? size VL e' isMinimal e' e≅e' | yes e≤e' = e≤e' isMinimal e' e≅e' | no e≰e' = ⊥-elim (∄smaller (e' , e≅e' , ( @@ -112,11 +114,11 @@ module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where ≡⟨ size≡m+n ⟩ n ∎))) - go (suc m) n size≡m+n ∄smaller with excludedMiddle {P = ∃[ e' ] (VL , VL ⊢ e ≣ e') × size {A} VL e' < suc n} + go (suc m) n size≡m+n ∄smaller with excludedMiddle {P = ∃[ e' ] (Lang VL , Lang VL ⊢ e ≣ e') × size VL e' < suc n} go (suc m) n size≡m+n ∄smaller | no ∄e'_; _<_; _*_) @@ -10,19 +11,12 @@ open import Relation.Binary.Structures using (IsEquivalence; IsPreorder; IsParti open import Size using (∞) open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans; ≅→≅[]; ⊆-index) -open import Vatras.Framework.Definitions using (𝔸) -open import Vatras.Framework.Variants using (Rose) -open import Vatras.Framework.Relation.Expression (Rose ∞) using (_,_⊢_≣_) +open import Vatras.Framework.Relation.Expression V using (_,_⊢_≣_) open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) open import Vatras.Framework.Compiler using (LanguageCompiler) +open import Vatras.Succinctness.Sizes using (SizedLang; Lang; size) -record SizedLang : Set₂ where - field - Lang : VariabilityLanguage (Rose ∞) - size : {A : 𝔸} → Expression Lang A → ℕ -open SizedLang - -_≤Size_ : SizedLang → SizedLang → Set₁ +_≤Size_ : SizedLang V → SizedLang V → Set₁ L₁ ≤Size L₂ = Σ[ n ∈ ℕ ] ∀ (A : 𝔸) → @@ -31,10 +25,10 @@ L₁ ≤Size L₂ = Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ × size L₁ e₁ ≤ n * size L₂ e₂ -_=Size_ : SizedLang → SizedLang → Set₁ +_=Size_ : SizedLang V → SizedLang V → Set₁ L₁ =Size L₂ = L₁ ≤Size L₂ × L₂ ≤Size L₁ -_≱Size_ : SizedLang → SizedLang → Set₁ +_≱Size_ : SizedLang V → SizedLang V → Set₁ L₁ ≱Size L₂ = ∀ (n : ℕ) → Σ[ A ∈ 𝔸 ] @@ -43,17 +37,17 @@ L₁ ≱Size L₂ = → Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ → size L₂ e₂ > n * size L₁ e₁ -_-) = begin - size2CC F₁ (rename f (a 2CC.2CC.-< cs >-)) + size2CC (rename f (a 2CC.2CC.-< cs >-)) ≡⟨⟩ - size2CC F₁ (a 2CC.2CC.-< List.map (rename f) cs >-) + size2CC (a 2CC.2CC.-< List.map (rename f) cs >-) ≡⟨⟩ - suc (atomSize A a + List.sum (List.map (size2CC F₁) (List.map (rename f) cs))) + suc (atomSize A a + List.sum (List.map size2CC (List.map (rename f) cs))) ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ - suc (atomSize A a + List.sum (List.map (size2CC F₁ ∘ rename f) cs)) + suc (atomSize A a + List.sum (List.map (size2CC ∘ rename f) cs)) ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-cong rename-preserves-size2CC cs) ⟩ - suc (atomSize A a + List.sum (List.map (size2CC F₂) cs)) + suc (atomSize A a + List.sum (List.map size2CC cs)) ≡⟨⟩ - size2CC F₂ (a 2CC.2CC.-< cs >-) + size2CC (a 2CC.2CC.-< cs >-) ∎ where open Eq.≡-Reasoning rename-preserves-size2CC (D 2CC.2CC.⟨ l , r ⟩) = begin - size2CC F₁ (rename f (D 2CC.2CC.⟨ l , r ⟩)) + size2CC (rename f (D 2CC.2CC.⟨ l , r ⟩)) ≡⟨⟩ - suc (size2CC F₁ (rename f l) + size2CC F₁ (rename f r)) + suc (size2CC (rename f l) + size2CC (rename f r)) ≡⟨ Eq.cong suc (Eq.cong₂ _+_ (rename-preserves-size2CC l) (rename-preserves-size2CC r)) ⟩ - suc (size2CC F₂ l + size2CC F₂ r) + suc (size2CC l + size2CC r) ≡⟨⟩ - size2CC F₂ (D 2CC.2CC.⟨ l , r ⟩) + size2CC (D 2CC.2CC.⟨ l , r ⟩) ∎ where open Eq.≡-Reasoning @@ -59,7 +60,7 @@ module _ {F₁ F₂ : 𝔽} (f : F₂ → F₁) (f⁻¹ : F₁ → F₂) (f⁻¹ 2CC≤2CC = 1 , λ A e → rename f e , ≅[]→≅ (rename-preserves f f⁻¹ f⁻¹∘f≗id e) - , ℕ.≤-reflexive (Eq.trans (rename-preserves-size2CC e) (Eq.sym (ℕ.+-identityʳ (size2CC F₂ e)))) + , ℕ.≤-reflexive (Eq.trans (rename-preserves-size2CC e) (Eq.sym (ℕ.+-identityʳ (size2CC e)))) 2CC=2CC : ∀ {F₁ F₂ : 𝔽} → (f : F₂ → F₁) @@ -71,76 +72,76 @@ module _ {F₁ F₂ : 𝔽} (f : F₂ → F₁) (f⁻¹ : F₁ → F₂) (f⁻¹ 2CC→NCC-preserves-size : ∀ {i : Size} {A : 𝔸} {F : 𝔽} → (e : 2CC.2CC F i A) - → sizeNCC F (sucs zero) (2CC→NCC e) ≡ size2CC F e + → sizeNCC (sucs zero) (2CC→NCC e) ≡ size2CC e 2CC→NCC-preserves-size {A = A} {F = F} (a 2CC.2CC.-< cs >-) = begin - sizeNCC F (sucs zero) (2CC→NCC (a 2CC.2CC.-< cs >-)) + sizeNCC (sucs zero) (2CC→NCC (a 2CC.2CC.-< cs >-)) ≡⟨⟩ - sizeNCC F (sucs zero) (a NCC.NCC.-< List.map 2CC→NCC cs >-) + sizeNCC (sucs zero) (a NCC.NCC.-< List.map 2CC→NCC cs >-) ≡⟨⟩ - suc (atomSize A a + List.sum (List.map (sizeNCC F (sucs zero)) (List.map 2CC→NCC cs))) + suc (atomSize A a + List.sum (List.map (sizeNCC (sucs zero)) (List.map 2CC→NCC cs))) ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ - suc (atomSize A a + List.sum (List.map (sizeNCC F (sucs zero) ∘ 2CC→NCC) cs)) + suc (atomSize A a + List.sum (List.map (sizeNCC (sucs zero) ∘ 2CC→NCC) cs)) ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-cong 2CC→NCC-preserves-size cs) ⟩ - suc (atomSize A a + List.sum (List.map (size2CC F) cs)) + suc (atomSize A a + List.sum (List.map size2CC cs)) ≡⟨⟩ - size2CC F (a 2CC.2CC.-< cs >-) + size2CC (a 2CC.2CC.-< cs >-) ∎ where open Eq.≡-Reasoning 2CC→NCC-preserves-size {F = F} (D 2CC.2CC.⟨ l , r ⟩) = begin - sizeNCC F (sucs zero) (2CC→NCC (D 2CC.2CC.⟨ l , r ⟩)) + sizeNCC (sucs zero) (2CC→NCC (D 2CC.2CC.⟨ l , r ⟩)) ≡⟨⟩ - sizeNCC F (sucs zero) (D NCC.NCC.⟨ 2CC→NCC l ∷ 2CC→NCC r ∷ [] ⟩) + sizeNCC (sucs zero) (D NCC.NCC.⟨ 2CC→NCC l ∷ 2CC→NCC r ∷ [] ⟩) ≡⟨⟩ - suc (Vec.sum (Vec.map (sizeNCC F (sucs zero)) (2CC→NCC l ∷ 2CC→NCC r ∷ []))) + suc (Vec.sum (Vec.map (sizeNCC (sucs zero)) (2CC→NCC l ∷ 2CC→NCC r ∷ []))) ≡⟨⟩ - suc (sizeNCC F (sucs zero) (2CC→NCC l) + (sizeNCC F (sucs zero) (2CC→NCC r) + 0)) - ≡⟨ Eq.cong (λ x → suc (sizeNCC F (sucs zero) (2CC→NCC l) + x)) (ℕ.+-identityʳ (sizeNCC F (sucs zero) (2CC→NCC r))) ⟩ - suc (sizeNCC F (sucs zero) (2CC→NCC l) + sizeNCC F (sucs zero) (2CC→NCC r)) + suc (sizeNCC (sucs zero) (2CC→NCC l) + (sizeNCC (sucs zero) (2CC→NCC r) + 0)) + ≡⟨ Eq.cong (λ x → suc (sizeNCC (sucs zero) (2CC→NCC l) + x)) (ℕ.+-identityʳ (sizeNCC (sucs zero) (2CC→NCC r))) ⟩ + suc (sizeNCC (sucs zero) (2CC→NCC l) + sizeNCC (sucs zero) (2CC→NCC r)) ≡⟨ Eq.cong suc (Eq.cong₂ _+_ (2CC→NCC-preserves-size l) (2CC→NCC-preserves-size r)) ⟩ - suc (size2CC F l + size2CC F r) + suc (size2CC l + size2CC r) ≡⟨⟩ - size2CC F (D 2CC.2CC.⟨ l , r ⟩) + size2CC (D 2CC.2CC.⟨ l , r ⟩) ∎ where open Eq.≡-Reasoning NCC→2CC-preserves-size : ∀ {i : Size} {A : 𝔸} {F : 𝔽} → (e : NCC.NCC F (sucs zero) i A) - → size2CC F (NCC→2CC e) ≡ sizeNCC F (sucs zero) e + → size2CC (NCC→2CC e) ≡ sizeNCC (sucs zero) e NCC→2CC-preserves-size {A = A} {F = F} (a NCC.NCC.-< cs >-) = begin - size2CC F (NCC→2CC (a NCC.NCC.-< cs >-)) + size2CC (NCC→2CC (a NCC.NCC.-< cs >-)) ≡⟨⟩ - size2CC F (a 2CC.2CC.-< List.map NCC→2CC cs >-) + size2CC (a 2CC.2CC.-< List.map NCC→2CC cs >-) ≡⟨⟩ - suc (atomSize A a + List.sum (List.map (size2CC F) (List.map NCC→2CC cs))) + suc (atomSize A a + List.sum (List.map size2CC (List.map NCC→2CC cs))) ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ - suc (atomSize A a + List.sum (List.map (size2CC F ∘ NCC→2CC) cs)) + suc (atomSize A a + List.sum (List.map (size2CC ∘ NCC→2CC) cs)) ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-cong NCC→2CC-preserves-size cs) ⟩ - suc (atomSize A a + List.sum (List.map (sizeNCC F (sucs zero)) cs)) + suc (atomSize A a + List.sum (List.map (sizeNCC (sucs zero)) cs)) ≡⟨⟩ - sizeNCC F (sucs zero) (a NCC.NCC.-< cs >-) + sizeNCC (sucs zero) (a NCC.NCC.-< cs >-) ∎ where open Eq.≡-Reasoning NCC→2CC-preserves-size {F = F} (D NCC.NCC.⟨ c₁ ∷ c₂ ∷ [] ⟩) = begin - size2CC F (NCC→2CC (D NCC.NCC.⟨ c₁ ∷ c₂ ∷ [] ⟩)) + size2CC (NCC→2CC (D NCC.NCC.⟨ c₁ ∷ c₂ ∷ [] ⟩)) ≡⟨⟩ - size2CC F (D 2CC.2CC.⟨ NCC→2CC c₁ , NCC→2CC c₂ ⟩) + size2CC (D 2CC.2CC.⟨ NCC→2CC c₁ , NCC→2CC c₂ ⟩) ≡⟨⟩ - suc (size2CC F (NCC→2CC c₁) + size2CC F (NCC→2CC c₂)) + suc (size2CC (NCC→2CC c₁) + size2CC (NCC→2CC c₂)) ≡⟨ Eq.cong suc (Eq.cong₂ _+_ (NCC→2CC-preserves-size c₁) (NCC→2CC-preserves-size c₂)) ⟩ - suc (sizeNCC F (sucs zero) c₁ + sizeNCC F (sucs zero) c₂) - ≡⟨ Eq.cong (λ x → suc (sizeNCC F (sucs zero) c₁) + x) (ℕ.+-identityʳ (sizeNCC F (sucs zero) c₂)) ⟨ - suc (sizeNCC F (sucs zero) c₁ + (sizeNCC F (sucs zero) c₂ + 0)) + suc (sizeNCC (sucs zero) c₁ + sizeNCC (sucs zero) c₂) + ≡⟨ Eq.cong (λ x → suc (sizeNCC (sucs zero) c₁) + x) (ℕ.+-identityʳ (sizeNCC (sucs zero) c₂)) ⟨ + suc (sizeNCC (sucs zero) c₁ + (sizeNCC (sucs zero) c₂ + 0)) ≡⟨⟩ - suc (Vec.sum (Vec.map (sizeNCC F (sucs zero)) (c₁ ∷ c₂ ∷ []))) + suc (Vec.sum (Vec.map (sizeNCC (sucs zero)) (c₁ ∷ c₂ ∷ []))) ≡⟨⟩ - sizeNCC F (sucs zero) (D NCC.NCC.⟨ c₁ ∷ c₂ ∷ [] ⟩) + sizeNCC (sucs zero) (D NCC.NCC.⟨ c₁ ∷ c₂ ∷ [] ⟩) ∎ where open Eq.≡-Reasoning @@ -148,5 +149,5 @@ NCC→2CC-preserves-size {F = F} (D NCC.NCC.⟨ c₁ ∷ c₂ ∷ [] ⟩) = NCC=2CC : ∀ {F : 𝔽} → SizedNCC F (sucs zero) =Size Sized2CC F NCC=2CC {F} = - (1 , λ A e → 2CC→NCC e , ≅[]→≅ (2CC→NCC-preserves e) , ℕ.≤-reflexive (Eq.trans (2CC→NCC-preserves-size e) (Eq.sym (ℕ.+-identityʳ (size2CC F e))))) - , (1 , λ A e → NCC→2CC e , ≅[]→≅ (NCC→2CC-preserves e) , ℕ.≤-reflexive (Eq.trans (NCC→2CC-preserves-size e) (Eq.sym (ℕ.+-identityʳ (sizeNCC F (sucs zero) e))))) + (1 , λ A e → 2CC→NCC e , ≅[]→≅ (2CC→NCC-preserves e) , ℕ.≤-reflexive (Eq.trans (2CC→NCC-preserves-size e) (Eq.sym (ℕ.+-identityʳ (size2CC e))))) + , (1 , λ A e → NCC→2CC e , ≅[]→≅ (NCC→2CC-preserves e) , ℕ.≤-reflexive (Eq.trans (NCC→2CC-preserves-size e) (Eq.sym (ℕ.+-identityʳ (sizeNCC (sucs zero) e))))) diff --git a/src/Vatras/Succinctness/Relations/2CC=CCC.agda b/src/Vatras/Succinctness/Relations/2CC=CCC.agda index e693c831..45b30575 100644 --- a/src/Vatras/Succinctness/Relations/2CC=CCC.agda +++ b/src/Vatras/Succinctness/Relations/2CC=CCC.agda @@ -10,8 +10,8 @@ open import Size using (∞) open import Vatras.Util.Nat.AtLeast using (sucs) open import Vatras.Framework.Variants using (Rose) open import Vatras.Lang.All.Fixed F (Rose ∞) -open import Vatras.Succinctness.ProofDefinition using (_=Size_; ≤Size-transitive) -open import Vatras.Succinctness.Sizes F using (Sized2CC; SizedCCC) +open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_=Size_; ≤Size-transitive) +open import Vatras.Succinctness.Sizes using (Sized2CC; SizedCCC) open import Vatras.Succinctness.Relations.2CC=2CC using (2CC=2CC; NCC=2CC) open import Vatras.Succinctness.Relations.2CC≤CCC F using (2CC≤CCC) open import Vatras.Succinctness.Relations.CCC≤NCC F using (CCC≤NCC) @@ -21,7 +21,7 @@ open import Vatras.Succinctness.Relations.CCC≤NCC F using (CCC≤NCC) → (f⁻¹ : F → F × ℕ) → f⁻¹ ∘ f ≗ id → f ∘ f⁻¹ ≗ id - → Sized2CC =Size SizedCCC + → Sized2CC F =Size SizedCCC F 2CC=CCC f f⁻¹ f⁻¹∘f≗id f∘f⁻¹≗id = ≤Size-transitive (proj₁ (2CC=2CC f f⁻¹ f⁻¹∘f≗id f∘f⁻¹≗id)) 2CC≤CCC , ≤Size-transitive (CCC≤NCC (sucs zero)) (proj₁ NCC=2CC) diff --git "a/src/Vatras/Succinctness/Relations/2CC\342\211\244ADT.agda" "b/src/Vatras/Succinctness/Relations/2CC\342\211\244ADT.agda" index 1eca3e6a..672c98ae 100644 --- "a/src/Vatras/Succinctness/Relations/2CC\342\211\244ADT.agda" +++ "b/src/Vatras/Succinctness/Relations/2CC\342\211\244ADT.agda" @@ -17,8 +17,8 @@ open import Vatras.Lang.All.Fixed F (Rose ∞) open import Vatras.Translation.Lang.2CC.Rename using (2CC-rename) open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Translation.LanguageMap using (ADT→2CC) -open import Vatras.Succinctness.ProofDefinition using (_≤Size_) -open import Vatras.Succinctness.Sizes F using (sizeRose; Sized2CC; size2CC; SizedADT; sizeADT) +open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≤Size_) +open import Vatras.Succinctness.Sizes using (sizeRose; Sized2CC; size2CC; SizedADT; sizeADT) open import Vatras.Lang.2CC.Encode using (encode; encoder) ADT→2CC' : LanguageCompiler ADT.ADTL 2CC.2CCL @@ -42,7 +42,7 @@ lemma2 {A = A} (a Rose.-< cs >-) = where open ℕ.≤-Reasoning -lemma : ∀ {A : 𝔸} → (adt : ADT.ADT A) → size2CC (LanguageCompiler.compile ADT→2CC' adt) ≤ sizeADT adt +lemma : ∀ {A : 𝔸} → (adt : ADT.ADT A) → size2CC (LanguageCompiler.compile ADT→2CC' adt) ≤ sizeADT sizeRose adt lemma (ADT.ADT.leaf v) = ℕ.m≤n⇒m≤1+n (lemma2 v) lemma (D ADT.ADT.⟨ l , r ⟩) = begin @@ -52,12 +52,12 @@ lemma (D ADT.ADT.⟨ l , r ⟩) = ≡⟨⟩ suc (size2CC (LanguageCompiler.compile ADT→2CC' l) + size2CC (LanguageCompiler.compile ADT→2CC' r)) ≤⟨ s≤s (ℕ.+-monoˡ-≤ (size2CC (LanguageCompiler.compile ADT→2CC' r)) (lemma l)) ⟩ - suc (sizeADT l + size2CC (LanguageCompiler.compile ADT→2CC' r)) - ≤⟨ s≤s (ℕ.+-monoʳ-≤ (sizeADT l) (lemma r)) ⟩ - suc (sizeADT l + sizeADT r) + suc (sizeADT sizeRose l + size2CC (LanguageCompiler.compile ADT→2CC' r)) + ≤⟨ s≤s (ℕ.+-monoʳ-≤ (sizeADT sizeRose l) (lemma r)) ⟩ + suc (sizeADT sizeRose l + sizeADT sizeRose r) ∎ where open ℕ.≤-Reasoning -2CC≤ADT : Sized2CC ≤Size SizedADT -2CC≤ADT = 1 , λ A adt → LanguageCompiler.compile ADT→2CC' adt , ≅-sym (≅[]→≅ (LanguageCompiler.preserves ADT→2CC' adt)) , Eq.subst (size2CC (LanguageCompiler.compile ADT→2CC' adt )≤_) (Eq.sym (ℕ.+-identityʳ (sizeADT adt))) (lemma adt) +2CC≤ADT : Sized2CC F ≤Size SizedADT F (Rose ∞) sizeRose +2CC≤ADT = 1 , λ A adt → LanguageCompiler.compile ADT→2CC' adt , ≅-sym (≅[]→≅ (LanguageCompiler.preserves ADT→2CC' adt)) , Eq.subst (size2CC (LanguageCompiler.compile ADT→2CC' adt )≤_) (Eq.sym (ℕ.+-identityʳ (sizeADT sizeRose adt))) (lemma adt) diff --git "a/src/Vatras/Succinctness/Relations/2CC\342\211\244CCC.agda" "b/src/Vatras/Succinctness/Relations/2CC\342\211\244CCC.agda" index 933d70bd..1c28efa4 100644 --- "a/src/Vatras/Succinctness/Relations/2CC\342\211\244CCC.agda" +++ "b/src/Vatras/Succinctness/Relations/2CC\342\211\244CCC.agda" @@ -26,7 +26,7 @@ open import Vatras.Framework.Variants using (Rose) import Vatras.Util.List as List open import Vatras.Lang.All open import Vatras.Framework.Compiler using (LanguageCompiler) -open import Vatras.Succinctness.ProofDefinition using (_≤Size_) +open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≤Size_) open import Vatras.Succinctness.Sizes using (sizeRose; Sized2CC; size2CC; SizedCCC; sizeCCC; sizeCCC>0) >⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ≤ᵇ n)) @@ -87,39 +87,39 @@ choice-list-size : ∀ {A : 𝔸} (D : F) (n : ℕ) → (c : 2CC.2CC (F × ℕ) ∞ A) → (cs : List (2CC.2CC (F × ℕ) ∞ A)) - → size2CC (F × ℕ) (choice-list D n c cs) ≡ List.length cs + List.sum (List.map (size2CC (F × ℕ)) (c ∷ cs)) -choice-list-size D n c₁ [] = Eq.sym (ℕ.+-identityʳ (size2CC (F × ℕ) c₁)) + → size2CC (choice-list D n c cs) ≡ List.length cs + List.sum (List.map size2CC (c ∷ cs)) +choice-list-size D n c₁ [] = Eq.sym (ℕ.+-identityʳ (size2CC c₁)) choice-list-size D n c₁ (c₂ ∷ []) = begin - size2CC (F × ℕ) (choice-list D n c₁ (c₂ ∷ [])) + size2CC (choice-list D n c₁ (c₂ ∷ [])) ≡⟨⟩ - size2CC (F × ℕ) ((D , n) 2CC.2CC.⟨ c₁ , c₂ ⟩) + size2CC ((D , n) 2CC.2CC.⟨ c₁ , c₂ ⟩) ≡⟨⟩ - suc (size2CC (F × ℕ) c₁ + size2CC (F × ℕ) c₂) - ≡⟨ Eq.cong (λ x → suc (size2CC (F × ℕ) c₁ + x)) (ℕ.+-identityʳ (size2CC (F × ℕ) c₂)) ⟨ - suc (size2CC (F × ℕ) c₁ + (size2CC (F × ℕ) c₂ + 0)) + suc (size2CC c₁ + size2CC c₂) + ≡⟨ Eq.cong (λ x → suc (size2CC c₁ + x)) (ℕ.+-identityʳ (size2CC c₂)) ⟨ + suc (size2CC c₁ + (size2CC c₂ + 0)) ≡⟨⟩ - List.length (c₂ ∷ []) + List.sum (List.map (size2CC (F × ℕ)) (c₁ ∷ c₂ ∷ [])) + List.length (c₂ ∷ []) + List.sum (List.map size2CC (c₁ ∷ c₂ ∷ [])) ∎ where open Eq.≡-Reasoning choice-list-size D n c₁ (c₂ ∷ c₃ ∷ cs) = begin - size2CC (F × ℕ) (choice-list D n c₁ (c₂ ∷ c₃ ∷ cs)) + size2CC (choice-list D n c₁ (c₂ ∷ c₃ ∷ cs)) ≡⟨⟩ - size2CC (F × ℕ) ((D , n) 2CC.2CC.⟨ c₁ , choice-list D (suc n) c₂ (c₃ ∷ cs) ⟩) + size2CC ((D , n) 2CC.2CC.⟨ c₁ , choice-list D (suc n) c₂ (c₃ ∷ cs) ⟩) ≡⟨⟩ - suc (size2CC (F × ℕ) c₁ + size2CC (F × ℕ) (choice-list D (suc n) c₂ (c₃ ∷ cs))) - ≡⟨ Eq.cong (λ x → suc (size2CC (F × ℕ) c₁ + x)) (choice-list-size D (suc n) c₂ (c₃ ∷ cs)) ⟩ - suc (size2CC (F × ℕ) c₁ + (List.length (c₃ ∷ cs) + List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs)))) - ≡⟨ Eq.cong suc (ℕ.+-assoc (size2CC (F × ℕ) c₁) (List.length (c₃ ∷ cs)) (List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs)))) ⟨ - suc (size2CC (F × ℕ) c₁ + List.length (c₃ ∷ cs) + List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs))) - ≡⟨ Eq.cong (λ x → suc (x + List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs)))) (ℕ.+-comm (size2CC (F × ℕ) c₁) (List.length (c₃ ∷ cs))) ⟩ - suc (List.length (c₃ ∷ cs) + size2CC (F × ℕ) c₁ + List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs))) - ≡⟨ Eq.cong suc (ℕ.+-assoc (List.length (c₃ ∷ cs)) (size2CC (F × ℕ) c₁) (List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs)))) ⟩ - suc (List.length (c₃ ∷ cs) + (size2CC (F × ℕ) c₁ + List.sum (List.map (size2CC (F × ℕ)) (c₂ ∷ c₃ ∷ cs)))) + suc (size2CC c₁ + size2CC (choice-list D (suc n) c₂ (c₃ ∷ cs))) + ≡⟨ Eq.cong (λ x → suc (size2CC c₁ + x)) (choice-list-size D (suc n) c₂ (c₃ ∷ cs)) ⟩ + suc (size2CC c₁ + (List.length (c₃ ∷ cs) + List.sum (List.map (size2CC) (c₂ ∷ c₃ ∷ cs)))) + ≡⟨ Eq.cong suc (ℕ.+-assoc (size2CC c₁) (List.length (c₃ ∷ cs)) (List.sum (List.map size2CC (c₂ ∷ c₃ ∷ cs)))) ⟨ + suc (size2CC c₁ + List.length (c₃ ∷ cs) + List.sum (List.map size2CC (c₂ ∷ c₃ ∷ cs))) + ≡⟨ Eq.cong (λ x → suc (x + List.sum (List.map size2CC (c₂ ∷ c₃ ∷ cs)))) (ℕ.+-comm (size2CC c₁) (List.length (c₃ ∷ cs))) ⟩ + suc (List.length (c₃ ∷ cs) + size2CC c₁ + List.sum (List.map size2CC (c₂ ∷ c₃ ∷ cs))) + ≡⟨ Eq.cong suc (ℕ.+-assoc (List.length (c₃ ∷ cs)) (size2CC c₁) (List.sum (List.map size2CC (c₂ ∷ c₃ ∷ cs)))) ⟩ + suc (List.length (c₃ ∷ cs) + (size2CC c₁ + List.sum (List.map size2CC (c₂ ∷ c₃ ∷ cs)))) ≡⟨⟩ - List.length (c₂ ∷ c₃ ∷ cs) + List.sum (List.map (size2CC (F × ℕ)) (c₁ ∷ c₂ ∷ c₃ ∷ cs)) + List.length (c₂ ∷ c₃ ∷ cs) + List.sum (List.map size2CC (c₁ ∷ c₂ ∷ c₃ ∷ cs)) ∎ where open Eq.≡-Reasoning @@ -132,54 +132,54 @@ translate (D CCC.CCC.⟨ c ∷ cs ⟩) = choice-list D zero (translate c) (List. translate-size : ∀ {i : Size} {A : 𝔸} → (ccc : CCC.CCC F i A) - → size2CC (F × ℕ) (translate ccc) < 2 * sizeCCC F ccc + → size2CC (translate ccc) < 2 * sizeCCC ccc translate-size {A = A} (a CCC.CCC.-< cs >-) = begin-strict - size2CC (F × ℕ) (translate (a CCC.CCC.-< cs >-)) + size2CC (translate (a CCC.CCC.-< cs >-)) ≡⟨⟩ - size2CC (F × ℕ) (a 2CC.2CC.-< List.map translate cs >-) + size2CC (a 2CC.2CC.-< List.map translate cs >-) ≡⟨⟩ - suc (atomSize A a + List.sum (List.map (size2CC (F × ℕ)) (List.map translate cs))) + suc (atomSize A a + List.sum (List.map size2CC (List.map translate cs))) ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ - suc (atomSize A a + List.sum (List.map (size2CC (F × ℕ) ∘ translate) cs)) - ≤⟨ s≤s (ℕ.+-monoʳ-≤ (atomSize A a) (List.sum-map-≤ (size2CC (F × ℕ) ∘ translate) (λ c → 2 * sizeCCC F c) cs (ℕ.<⇒≤ ∘ translate-size))) ⟩ - suc (atomSize A a + List.sum (List.map (λ c → 2 * sizeCCC F c) cs)) + suc (atomSize A a + List.sum (List.map (size2CC ∘ translate) cs)) + ≤⟨ s≤s (ℕ.+-monoʳ-≤ (atomSize A a) (List.sum-map-≤ (size2CC ∘ translate) (λ c → 2 * sizeCCC c) cs (ℕ.<⇒≤ ∘ translate-size))) ⟩ + suc (atomSize A a + List.sum (List.map (λ c → 2 * sizeCCC c) cs)) ≡⟨ Eq.cong (λ x → suc (atomSize A a + List.sum x)) (List.map-∘ cs) ⟩ - suc (atomSize A a + List.sum (List.map (2 *_) (List.map (sizeCCC F) cs))) - ≡⟨ Eq.cong (λ x → suc (atomSize A a + x)) (List.sum-* 2 (List.map (sizeCCC F) cs)) ⟩ - suc (atomSize A a + 2 * List.sum (List.map (sizeCCC F) cs)) - ≤⟨ s≤s (ℕ.+-monoˡ-≤ (2 * List.sum (List.map (sizeCCC F) cs)) (ℕ.m≤m+n (atomSize A a) (1 * atomSize A a))) ⟩ - suc (atomSize A a + 1 * atomSize A a + 2 * List.sum (List.map (sizeCCC F) cs)) + suc (atomSize A a + List.sum (List.map (2 *_) (List.map sizeCCC cs))) + ≡⟨ Eq.cong (λ x → suc (atomSize A a + x)) (List.sum-* 2 (List.map sizeCCC cs)) ⟩ + suc (atomSize A a + 2 * List.sum (List.map sizeCCC cs)) + ≤⟨ s≤s (ℕ.+-monoˡ-≤ (2 * List.sum (List.map sizeCCC cs)) (ℕ.m≤m+n (atomSize A a) (1 * atomSize A a))) ⟩ + suc (atomSize A a + 1 * atomSize A a + 2 * List.sum (List.map sizeCCC cs)) ≡⟨⟩ - suc (2 * atomSize A a + 2 * List.sum (List.map (sizeCCC F) cs)) - ≡⟨ Eq.cong suc (ℕ.*-distribˡ-+ 2 (atomSize A a) (List.sum (List.map (sizeCCC F) cs))) ⟨ - 1 + 2 * (atomSize A a + List.sum (List.map (sizeCCC F) cs)) - <⟨ ℕ.+-monoˡ-< (2 * (atomSize A a + List.sum (List.map (sizeCCC F) cs))) {x = 1} {y = 2} (ℕ.n<1+n 1) ⟩ - 2 + 2 * (atomSize A a + List.sum (List.map (sizeCCC F) cs)) - ≡⟨ ℕ.*-suc 2 (atomSize A a + List.sum (List.map (sizeCCC F) cs)) ⟨ - 2 * (suc (atomSize A a + List.sum (List.map (sizeCCC F) cs))) + suc (2 * atomSize A a + 2 * List.sum (List.map sizeCCC cs)) + ≡⟨ Eq.cong suc (ℕ.*-distribˡ-+ 2 (atomSize A a) (List.sum (List.map sizeCCC cs))) ⟨ + 1 + 2 * (atomSize A a + List.sum (List.map sizeCCC cs)) + <⟨ ℕ.+-monoˡ-< (2 * (atomSize A a + List.sum (List.map sizeCCC cs))) {x = 1} {y = 2} (ℕ.n<1+n 1) ⟩ + 2 + 2 * (atomSize A a + List.sum (List.map sizeCCC cs)) + ≡⟨ ℕ.*-suc 2 (atomSize A a + List.sum (List.map sizeCCC cs)) ⟨ + 2 * (suc (atomSize A a + List.sum (List.map sizeCCC cs))) ≡⟨⟩ - 2 * sizeCCC F (a CCC.CCC.-< cs >-) + 2 * sizeCCC (a CCC.CCC.-< cs >-) ∎ where open ℕ.≤-Reasoning translate-size (D CCC.CCC.⟨ c ∷ cs ⟩) = begin-strict - size2CC (F × ℕ) (translate (D CCC.CCC.⟨ c ∷ cs ⟩)) + size2CC (translate (D CCC.CCC.⟨ c ∷ cs ⟩)) ≡⟨⟩ - size2CC (F × ℕ) (choice-list D zero (translate c) (List.map translate cs)) + size2CC (choice-list D zero (translate c) (List.map translate cs)) ≡⟨ choice-list-size D zero (translate c) (List.map translate cs) ⟩ - List.length (List.map translate cs) + List.sum (List.map (size2CC (F × ℕ)) (List.map translate (c ∷ cs))) + List.length (List.map translate cs) + List.sum (List.map size2CC (List.map translate (c ∷ cs))) ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + List.sum x) (List.map-∘ (c ∷ cs)) ⟨ - List.length (List.map translate cs) + List.sum (List.map (size2CC (F × ℕ) ∘ translate) (c ∷ cs)) - ≤⟨ ℕ.+-monoʳ-≤ (List.length (List.map translate cs)) (List.sum-map-< (size2CC (F × ℕ) ∘ translate) (λ c → 2 * sizeCCC F c) (c ∷ cs) translate-size) ⟩ - List.length (List.map translate cs) + (List.sum (List.map (λ c → 2 * sizeCCC F c) (c ∷ cs)) ∸ List.length (c ∷ cs)) - ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + (List.sum x ∸ List.length (c ∷ cs))) (List.map-∘ {g = 2 *_} {f = sizeCCC F} (c ∷ cs)) ⟩ - List.length (List.map translate cs) + (List.sum (List.map (2 *_) (List.map (sizeCCC F) (c ∷ cs))) ∸ List.length (c ∷ cs)) - ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + (x ∸ List.length (c ∷ cs))) (List.sum-* 2 (List.map (sizeCCC F) (c ∷ cs))) ⟩ - List.length (List.map translate cs) + (2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) ∸ List.length (c ∷ cs)) - ≡⟨ Eq.cong (_+ (2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) ∸ List.length (c ∷ cs))) (List.length-map translate cs) ⟩ - List.length cs + (2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) ∸ List.length (c ∷ cs)) + List.length (List.map translate cs) + List.sum (List.map (size2CC ∘ translate) (c ∷ cs)) + ≤⟨ ℕ.+-monoʳ-≤ (List.length (List.map translate cs)) (List.sum-map-< (size2CC ∘ translate) (λ c → 2 * sizeCCC c) (c ∷ cs) translate-size) ⟩ + List.length (List.map translate cs) + (List.sum (List.map (λ c → 2 * sizeCCC c) (c ∷ cs)) ∸ List.length (c ∷ cs)) + ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + (List.sum x ∸ List.length (c ∷ cs))) (List.map-∘ {g = 2 *_} {f = sizeCCC} (c ∷ cs)) ⟩ + List.length (List.map translate cs) + (List.sum (List.map (2 *_) (List.map sizeCCC (c ∷ cs))) ∸ List.length (c ∷ cs)) + ≡⟨ Eq.cong (λ x → List.length (List.map translate cs) + (x ∸ List.length (c ∷ cs))) (List.sum-* 2 (List.map sizeCCC (c ∷ cs))) ⟩ + List.length (List.map translate cs) + (2 * List.sum (List.map sizeCCC (c ∷ cs)) ∸ List.length (c ∷ cs)) + ≡⟨ Eq.cong (_+ (2 * List.sum (List.map sizeCCC (c ∷ cs)) ∸ List.length (c ∷ cs))) (List.length-map translate cs) ⟩ + List.length cs + (2 * List.sum (List.map sizeCCC (c ∷ cs)) ∸ List.length (c ∷ cs)) ≡⟨ ℕ.+-∸-assoc (List.length cs) ( begin List.length (c ∷ cs) @@ -189,21 +189,21 @@ translate-size (D CCC.CCC.⟨ c ∷ cs ⟩) = List.sum (List.replicate (List.length (c ∷ cs)) 1) ≡⟨ Eq.cong List.sum (List.map-const 1 (c ∷ cs)) ⟨ List.sum (List.map (const 1) (c ∷ cs)) - ≤⟨ List.sum-map-≤ (const 1) (sizeCCC F) (c ∷ cs) (sizeCCC>0 F) ⟩ - List.sum (List.map (sizeCCC F) (c ∷ cs)) - ≤⟨ ℕ.m≤n*m (List.sum (List.map (sizeCCC F) (c ∷ cs))) 2 ⟩ - 2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) + ≤⟨ List.sum-map-≤ (const 1) sizeCCC (c ∷ cs) sizeCCC>0 ⟩ + List.sum (List.map sizeCCC (c ∷ cs)) + ≤⟨ ℕ.m≤n*m (List.sum (List.map sizeCCC (c ∷ cs))) 2 ⟩ + 2 * List.sum (List.map sizeCCC (c ∷ cs)) ∎) ⟨ - (List.length cs + 2 * List.sum (List.map (sizeCCC F) (c ∷ cs))) ∸ List.length (c ∷ cs) - ≤⟨ ℕ.∸-monoʳ-≤ (List.length cs + 2 * List.sum (List.map (sizeCCC F) (c ∷ cs))) (ℕ.n≤1+n (List.length cs)) ⟩ - (List.length cs + 2 * List.sum (List.map (sizeCCC F) (c ∷ cs))) ∸ List.length cs - ≡⟨ ℕ.m+n∸m≡n (List.length cs) (2 * List.sum (List.map (sizeCCC F) (c ∷ cs))) ⟩ - 2 * List.sum (List.map (sizeCCC F) (c ∷ cs)) - <⟨ ℕ.*-monoʳ-< 2 (ℕ.n<1+n (List.sum (List.map (sizeCCC F) (c ∷ cs)))) ⟩ - 2 * suc (List.sum (List.map (sizeCCC F) (c ∷ cs))) + (List.length cs + 2 * List.sum (List.map sizeCCC (c ∷ cs))) ∸ List.length (c ∷ cs) + ≤⟨ ℕ.∸-monoʳ-≤ (List.length cs + 2 * List.sum (List.map sizeCCC (c ∷ cs))) (ℕ.n≤1+n (List.length cs)) ⟩ + (List.length cs + 2 * List.sum (List.map sizeCCC (c ∷ cs))) ∸ List.length cs + ≡⟨ ℕ.m+n∸m≡n (List.length cs) (2 * List.sum (List.map sizeCCC (c ∷ cs))) ⟩ + 2 * List.sum (List.map sizeCCC (c ∷ cs)) + <⟨ ℕ.*-monoʳ-< 2 (ℕ.n<1+n (List.sum (List.map sizeCCC (c ∷ cs)))) ⟩ + 2 * suc (List.sum (List.map sizeCCC (c ∷ cs))) ≡⟨⟩ - 2 * sizeCCC F (D CCC.CCC.⟨ c ∷ cs ⟩) + 2 * sizeCCC (D CCC.CCC.⟨ c ∷ cs ⟩) ∎ where open ℕ.≤-Reasoning diff --git "a/src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" "b/src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" index 03a0c15f..82c1f650 100644 --- "a/src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" +++ "b/src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" @@ -21,8 +21,8 @@ import Vatras.Util.Vec as Vec open import Vatras.Lang.All.Fixed F (Rose ∞) open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Translation.LanguageMap using (NCC→CCC) -open import Vatras.Succinctness.ProofDefinition using (_≤Size_) -open import Vatras.Succinctness.Sizes F using (SizedNCC; sizeNCC; SizedCCC; sizeCCC) +open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≤Size_) +open import Vatras.Succinctness.Sizes using (SizedNCC; sizeNCC; SizedCCC; sizeCCC) lemma : ∀ {i : Size} {A : 𝔸} (n : ℕ≥ 2) (ncc : NCC.NCC n i A) → sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc) ≤ sizeNCC n ncc lemma {A = A} (sucs n) (a NCC.NCC.-< cs >-) = @@ -66,5 +66,5 @@ lemma (sucs n) (D NCC.NCC.⟨ c ∷ cs ⟩) = where open ℕ.≤-Reasoning -CCC≤NCC : (n : ℕ≥ 2) → SizedCCC ≤Size SizedNCC n +CCC≤NCC : (n : ℕ≥ 2) → SizedCCC F ≤Size SizedNCC F n CCC≤NCC n = 1 , λ A ncc → LanguageCompiler.compile (NCC→CCC n) ncc , ≅-sym (≅[]→≅ (LanguageCompiler.preserves (NCC→CCC n) ncc)) , Eq.subst (sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc )≤_) (Eq.sym (ℕ.+-identityʳ (sizeNCC n ncc))) (lemma n ncc) diff --git "a/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" "b/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" index 5de9611f..a348842d 100644 --- "a/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" +++ "b/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" @@ -38,8 +38,8 @@ open import Vatras.Framework.Variants using (Rose; Rose-injective) import Vatras.Util.List as List open import Vatras.Lang.All.Fixed ℕ (Rose ∞) import Vatras.Lang.2CC.ReflectsVariantSize as 2CC -open import Vatras.Succinctness.ProofDefinition using (_≱Size_) -open import Vatras.Succinctness.Sizes ℕ using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST; size2CC>0) +open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≱Size_) +open import Vatras.Succinctness.Sizes using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST; size2CC>0) open FST.Impose NAT hiding (_∈_) open import Vatras.Lang.FST.Composition ℕ NAT using (⊛-all-unique) @@ -287,7 +287,7 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( where open ℕ.≤-Reasoning -FST≱2CC : SizedFST ≱Size Sized2CC +FST≱2CC : SizedFST ℕ ≱Size Sized2CC ℕ FST≱2CC zero = NAT , fst zero , λ 2cc fst≅2cc → size2CC>0 2cc FST≱2CC (suc n) = NAT , fst m , λ 2cc fst≅2cc → begin-strict diff --git "a/src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" "b/src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" index 8d3495c0..77d7585e 100644 --- "a/src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" +++ "b/src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" @@ -33,8 +33,8 @@ open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Lang.All.Fixed ℕ (Rose ∞) import Vatras.Lang.2CC.ReflectsVariantSize as 2CC open import Vatras.Lang.2CC.FixedArtifactLength ℕ NAT using (_≉_; unique-lengths⇒m*sizeRose≤size2CC) -open import Vatras.Succinctness.ProofDefinition using (_≱Size_) -open import Vatras.Succinctness.Sizes ℕ using (sizeRose; SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC; size2CC>0) +open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≱Size_) +open import Vatras.Succinctness.Sizes using (sizeRose; SizedWFOC; sizeWFOC; sizeOC; Sized2CC; size2CC; size2CC>0) options : ℕ → List (OC.OC ∞ NAT) options zero = [] @@ -251,5 +251,5 @@ goal n@(suc n-1) 2cc (oc⊆2cc , 2cc⊆oc) = open ℕ.≤-Reasoning m = 4 * n -OC≱2CC : SizedWFOC ≱Size Sized2CC +OC≱2CC : SizedWFOC ℕ ≱Size Sized2CC ℕ OC≱2CC n = NAT , oc (4 * n) , λ 2cc oc≅2cc → goal n 2cc oc≅2cc diff --git a/src/Vatras/Succinctness/Sizes.agda b/src/Vatras/Succinctness/Sizes.agda index a54f3d72..c6a8f1d7 100644 --- a/src/Vatras/Succinctness/Sizes.agda +++ b/src/Vatras/Succinctness/Sizes.agda @@ -1,5 +1,5 @@ -open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms; atomSize) -module Vatras.Succinctness.Sizes (F : 𝔽) where +open import Vatras.Framework.Definitions using (𝔽; 𝕍; 𝔸; atoms; atomSize) +module Vatras.Succinctness.Sizes where open import Data.Nat using (ℕ; suc; zero; _+_; _>_; s≤s; z≤n) import Data.List as List @@ -9,79 +9,85 @@ open import Function using (_∘_) open import Size using (Size; ∞) open import Vatras.Util.Nat.AtLeast using (ℕ≥) +open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) open import Vatras.Framework.Variants using (Rose) -open import Vatras.Lang.All.Fixed F (Rose ∞) -open import Vatras.Succinctness.ProofDefinition using (SizedLang) +open import Vatras.Lang.All + +record SizedLang (V : 𝕍) : Set₂ where + field + Lang : VariabilityLanguage V + size : {A : 𝔸} → Expression Lang A → ℕ +open SizedLang public sizeRose : ∀ {i : Size} {A : 𝔸} → Rose i A → ℕ sizeRose {A = A} (a Rose.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeRose cs)) -size2CC : ∀ {i : Size} {A : 𝔸} → 2CC.2CC i A → ℕ +size2CC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → 2CC.2CC F i A → ℕ size2CC {A = A} (a 2CC.2CC.-< cs >-) = suc (atomSize A a + List.sum (List.map size2CC cs)) size2CC (D 2CC.2CC.⟨ l , r ⟩) = suc (size2CC l + size2CC r) -size2CC>0 : ∀ {i : Size} {A : 𝔸} → (2cc : 2CC.2CC i A) → size2CC 2cc > 0 +size2CC>0 : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → (2cc : 2CC.2CC F i A) → size2CC 2cc > 0 size2CC>0 (a 2CC.-< cs >-) = s≤s z≤n size2CC>0 (D 2CC.⟨ l , r ⟩) = s≤s z≤n -Sized2CC : SizedLang -Sized2CC = record - { Lang = 2CC.2CCL +Sized2CC : 𝔽 → SizedLang (Rose ∞) +Sized2CC F = record + { Lang = 2CC.2CCL F ; size = size2CC } -sizeNCC : ∀ {i : Size} {A : 𝔸} (n : ℕ≥ 2) → NCC.NCC n i A → ℕ +sizeNCC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} (n : ℕ≥ 2) → NCC.NCC F n i A → ℕ sizeNCC {A = A} n (a NCC.NCC.-< cs >-) = suc (atomSize A a + List.sum (List.map (sizeNCC n) cs)) sizeNCC n (D NCC.NCC.⟨ cs ⟩) = suc (Vec.sum (Vec.map (sizeNCC n) cs)) -SizedNCC : ℕ≥ 2 → SizedLang -SizedNCC n = record - { Lang = NCC.NCCL n +SizedNCC : 𝔽 → ℕ≥ 2 → SizedLang (Rose ∞) +SizedNCC F n = record + { Lang = NCC.NCCL F n ; size = sizeNCC n } -sizeCCC : ∀ {i : Size} {A : 𝔸} → CCC.CCC i A → ℕ +sizeCCC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → CCC.CCC F i A → ℕ sizeCCC {A = A} (a CCC.CCC.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeCCC cs)) sizeCCC (D CCC.CCC.⟨ cs ⟩) = suc (List.sum (List.map sizeCCC (List⁺.toList cs))) -sizeCCC>0 : ∀ {i : Size} {A : 𝔸} → (ccc : CCC.CCC i A) → sizeCCC ccc > 0 +sizeCCC>0 : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → (ccc : CCC.CCC F i A) → sizeCCC ccc > 0 sizeCCC>0 (a CCC.-< cs >-) = s≤s z≤n sizeCCC>0 (D CCC.⟨ cs ⟩) = s≤s z≤n -SizedCCC : SizedLang -SizedCCC = record - { Lang = CCC.CCCL +SizedCCC : 𝔽 → SizedLang (Rose ∞) +SizedCCC F = record + { Lang = CCC.CCCL F ; size = sizeCCC } -sizeADT : {A : 𝔸} → ADT.ADT A → ℕ -sizeADT (ADT.ADT.leaf v) = suc (sizeRose v) -sizeADT (D ADT.ADT.⟨ l , r ⟩) = suc (sizeADT l + sizeADT r) +sizeADT : {F : 𝔽} {V : 𝕍} {A : 𝔸} → ({A : 𝔸} → V A → ℕ) → ADT.ADT F V A → ℕ +sizeADT variantSize (ADT.ADT.leaf v) = suc (variantSize v) +sizeADT variantSize (D ADT.ADT.⟨ l , r ⟩) = suc (sizeADT variantSize l + sizeADT variantSize r) -SizedADT : SizedLang -SizedADT = record - { Lang = ADT.ADTL - ; size = sizeADT +SizedADT : 𝔽 → (V : 𝕍) → ({A : 𝔸} → V A → ℕ) → SizedLang V +SizedADT F V variantSize = record + { Lang = ADT.ADTL F V + ; size = sizeADT variantSize } -sizeOC : ∀ {i : Size} {A : 𝔸} → OC.OC i A → ℕ +sizeOC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → OC.OC F i A → ℕ sizeOC {A = A} (a OC.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeOC cs)) sizeOC (D OC.❲ c ❳) = suc (sizeOC c) -sizeWFOC : ∀ {i : Size} {A : 𝔸} → OC.WFOC i A → ℕ +sizeWFOC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → OC.WFOC F i A → ℕ sizeWFOC {A = A} (OC.Root a cs) = suc (atomSize A a + List.sum (List.map sizeOC cs)) -SizedWFOC : SizedLang -SizedWFOC = record - { Lang = OC.WFOCL +SizedWFOC : 𝔽 → SizedLang (Rose ∞) +SizedWFOC F = record + { Lang = OC.WFOCL F ; size = sizeWFOC } -sizeFST : {A : 𝔸} → FST.Impose.SPL A → ℕ +sizeFST : {F : 𝔽} {A : 𝔸} → FST.Impose.SPL {F} A → ℕ sizeFST (root FST.Impose.◀ features) = 1 + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) features) -SizedFST : SizedLang -SizedFST = record - { Lang = FST.FSTL +SizedFST : 𝔽 → SizedLang (Rose ∞) +SizedFST F = record + { Lang = FST.FSTL F ; size = sizeFST } From 96f0427974180ac600da93377440e54f7c8892f7 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sat, 6 Sep 2025 00:04:16 +0200 Subject: [PATCH 51/82] Split the relation definitions into separate files --- .../Succinctness/DefinitionEquivalence.agda | 109 +++++++++++++++ .../Succinctness/DesignedDefinition.agda | 128 +----------------- src/Vatras/Succinctness/ProofDefinition.agda | 23 ++++ 3 files changed, 135 insertions(+), 125 deletions(-) create mode 100644 src/Vatras/Succinctness/DefinitionEquivalence.agda diff --git a/src/Vatras/Succinctness/DefinitionEquivalence.agda b/src/Vatras/Succinctness/DefinitionEquivalence.agda new file mode 100644 index 00000000..4179319a --- /dev/null +++ b/src/Vatras/Succinctness/DefinitionEquivalence.agda @@ -0,0 +1,109 @@ +open import Vatras.Framework.Definitions using (𝔸; 𝕍) +module Vatras.Succinctness.DefinitionEquivalence (V : 𝕍) where + +open import Data.Empty using (⊥-elim) +open import Data.Product using (_×_; _,_; Σ-syntax; ∃-syntax; ∄-syntax) +open import Data.Nat using (ℕ; zero; suc; _+_; _*_; _≤_; _<_; _≤?_) +import Data.Nat.Properties as ℕ +open import Relation.Binary.PropositionalEquality as Eq using (_≡_) +open import Relation.Nullary.Decidable using (yes; no) + +open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans) +open import Vatras.Framework.VariabilityLanguage using (Expression) +open import Vatras.Framework.Relation.Expression V using (_,_⊢_≣_) +open import Vatras.Succinctness.Sizes using (SizedLang; Lang; size) +open import Vatras.Succinctness.DesignedDefinition V using (minimalExpression; design) +open import Vatras.Succinctness.ProofDefinition V using (simplification) + +simplification→design + : (f : ℕ → ℕ) + → (VL₁ VL₂ : SizedLang V) + → simplification f VL₁ VL₂ + → design f VL₁ VL₂ + +simplification→design f VL₁ VL₂ simplification A with simplification A +simplification→design f VL₁ VL₂ simplification A | m , simplification' = m , go + where + open ℕ.≤-Reasoning + + go : + ∀ (e₁ : Expression (Lang VL₁) A) (e₂ : Expression (Lang VL₂) A) (e₁≅e₂ : Lang VL₁ , Lang VL₂ ⊢ e₁ ≣ e₂) + → minimalExpression VL₁ e₁ + → minimalExpression VL₂ e₂ + → size VL₁ e₁ ≤ m * f (size VL₂ e₂) + go e₁ e₂ e₁≅e₂ e₁-minimal e₂-minimal with simplification' e₂ (e₁ , e₁≅e₂) + go e₁ e₂ e₁≅e₂ e₁-minimal e₂-minimal | e₁' , e₁'≅e₂ , e₁'≤e₂ = ℕ.≤-trans (e₁-minimal e₁' (≅-trans e₁≅e₂ (≅-sym e₁'≅e₂))) e₁'≤e₂ + +open import Axiom.ExcludedMiddle +module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where + + ∃minimalExpression + : {A : 𝔸} + → (VL : SizedLang V) + → (e : Expression (Lang VL) A) + → Σ[ e' ∈ Expression (Lang VL) A ] (Lang VL , Lang VL ⊢ e ≣ e') × minimalExpression VL e' + ∃minimalExpression {A} VL e = go (size VL e) zero (Eq.sym (ℕ.*-identityˡ (size VL e))) λ where () + where + open ℕ.≤-Reasoning + + go + : (m n : ℕ) + → size VL e ≡ m + n + → (∄[ e' ] (Lang VL , Lang VL ⊢ e ≣ e') × size VL e' < n) + → Σ[ e' ∈ Expression (Lang VL) A ] (Lang VL , Lang VL ⊢ e ≣ e') × minimalExpression VL e' + go zero n size≡m+n ∄smaller = e , ≅-refl , isMinimal + where + isMinimal : (e' : Expression (Lang VL) A) → Lang VL , Lang VL ⊢ e ≣ e' → size VL e ≤ size VL e' + isMinimal e' e≅e' with size VL e ≤? size VL e' + isMinimal e' e≅e' | yes e≤e' = e≤e' + isMinimal e' e≅e' | no e≰e' = ⊥-elim (∄smaller (e' , e≅e' , ( + begin-strict + size VL e' + <⟨ ℕ.≰⇒> e≰e' ⟩ + size VL e + ≡⟨ size≡m+n ⟩ + n + ∎))) + go (suc m) n size≡m+n ∄smaller with excludedMiddle {P = ∃[ e' ] (Lang VL , Lang VL ⊢ e ≣ e') × size VL e' < suc n} + go (suc m) n size≡m+n ∄smaller | no ∄e' e'≰e'' ⟩ + size VL e' + ≤⟨ ℕ.≤-pred e'≤e ⟩ + n + ∎))) + + design→simplification + : (f : ℕ → ℕ) + → (∀ n m → n ≤ m → f n ≤ f m) + → (VL₁ VL₂ : SizedLang V) + → design f VL₁ VL₂ + → simplification f VL₁ VL₂ + design→simplification f f-monotone VL₁ VL₂ design A with design A + design→simplification f f-monotone VL₁ VL₂ design A | m , design' = m , go + where + open ℕ.≤-Reasoning + + go : + ∀ (e₂ : Expression (Lang VL₂) A) + → Σ[ e₁ ∈ Expression (Lang VL₁) A ] + (Lang VL₁ , Lang VL₂ ⊢ e₁ ≣ e₂) + → Σ[ e₁ ∈ Expression (Lang VL₁) A ] + (Lang VL₁ , Lang VL₂ ⊢ e₁ ≣ e₂) + × size VL₁ e₁ ≤ m * f (size VL₂ e₂) + go e₂ (e₁ , e₁≅e₂) with ∃minimalExpression VL₁ e₁ | ∃minimalExpression VL₂ e₂ + go e₂ (e₁ , e₁≅e₂) | e₁' , e₁≅e₁' , e₁'-minimal | e₂' , e₂≅e₂' , e₂'-minimal = e₁' , ≅-trans (≅-sym e₁≅e₁') e₁≅e₂ , ( + begin + size VL₁ e₁' + ≤⟨ design' e₁' e₂' (≅-trans (≅-sym e₁≅e₁') (≅-trans e₁≅e₂ e₂≅e₂')) e₁'-minimal e₂'-minimal ⟩ + m * f (size VL₂ e₂') + ≤⟨ ℕ.*-monoʳ-≤ m (f-monotone (size VL₂ e₂') (size VL₂ e₂) (e₂'-minimal e₂ (≅-sym e₂≅e₂'))) ⟩ + m * f (size VL₂ e₂) + ∎) diff --git a/src/Vatras/Succinctness/DesignedDefinition.agda b/src/Vatras/Succinctness/DesignedDefinition.agda index e0841aff..3f14caf2 100644 --- a/src/Vatras/Succinctness/DesignedDefinition.agda +++ b/src/Vatras/Succinctness/DesignedDefinition.agda @@ -1,19 +1,12 @@ open import Vatras.Framework.Definitions using (𝔸; 𝕍) module Vatras.Succinctness.DesignedDefinition (V : 𝕍) where -open import Data.Empty using (⊥-elim) -open import Data.Product using (_×_; _,_; Σ-syntax; ∃-syntax; ∄-syntax) -open import Data.Sum using (_⊎_) -open import Data.Nat using (ℕ; zero; suc; _≤_; _<_; _≤?_; _+_; _*_) -import Data.Nat.Properties as ℕ -open import Relation.Binary.PropositionalEquality as Eq using (_≡_) -open import Relation.Nullary.Decidable using (yes; no) +open import Data.Product using (Σ-syntax) +open import Data.Nat using (ℕ; _≤_; _*_) open import Function using (id) -open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans) open import Vatras.Framework.VariabilityLanguage using (Expression) -open import Vatras.Framework.Relation.Expression V -open import Vatras.Framework.Relation.Expressiveness V +open import Vatras.Framework.Relation.Expression V using (_,_⊢_≣_) open import Vatras.Succinctness.Sizes using (SizedLang; Lang; size) minimalExpression @@ -42,118 +35,3 @@ relation : (VL₁ VL₂ : SizedLang V) → Set _ relation = design id - -translatable - : (VL₁ VL₂ : SizedLang V) - → {A : 𝔸} - → (e₁ : Expression (Lang VL₁) A) - → Set _ -translatable VL₁ VL₂ {A} e₁ = - Σ[ e₂ ∈ Expression (Lang VL₂) A ] - Lang VL₂ , Lang VL₁ ⊢ e₂ ≣ e₁ - -simplification - : (f : ℕ → ℕ) - → (VL₁ VL₂ : SizedLang V) - → Set _ -simplification f VL₁ VL₂ = - ∀ (A : 𝔸) → - Σ[ m ∈ ℕ ] - ∀ (e₂ : Expression (Lang VL₂) A) - → translatable VL₂ VL₁ e₂ - → Σ[ e₁ ∈ Expression (Lang VL₁) A ] - (Lang VL₁ , Lang VL₂ ⊢ e₁ ≣ e₂) - × size VL₁ e₁ ≤ m * f (size VL₂ e₂) - -simplification→design - : (f : ℕ → ℕ) - → (VL₁ VL₂ : SizedLang V) - → simplification f VL₁ VL₂ - → design f VL₁ VL₂ - -simplification→design f VL₁ VL₂ simplification A with simplification A -simplification→design f VL₁ VL₂ simplification A | m , simplification' = m , go - where - open ℕ.≤-Reasoning - - go : - ∀ (e₁ : Expression (Lang VL₁) A) (e₂ : Expression (Lang VL₂) A) (e₁≅e₂ : Lang VL₁ , Lang VL₂ ⊢ e₁ ≣ e₂) - → minimalExpression VL₁ e₁ - → minimalExpression VL₂ e₂ - → size VL₁ e₁ ≤ m * f (size VL₂ e₂) - go e₁ e₂ e₁≅e₂ e₁-minimal e₂-minimal with simplification' e₂ (e₁ , e₁≅e₂) - go e₁ e₂ e₁≅e₂ e₁-minimal e₂-minimal | e₁' , e₁'≅e₂ , e₁'≤e₂ = ℕ.≤-trans (e₁-minimal e₁' (≅-trans e₁≅e₂ (≅-sym e₁'≅e₂))) e₁'≤e₂ - -open import Axiom.ExcludedMiddle -module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where - - ∃minimalExpression - : {A : 𝔸} - → (VL : SizedLang V) - → (e : Expression (Lang VL) A) - → Σ[ e' ∈ Expression (Lang VL) A ] (Lang VL , Lang VL ⊢ e ≣ e') × minimalExpression VL e' - ∃minimalExpression {A} VL e = go (size VL e) zero (Eq.sym (ℕ.*-identityˡ (size VL e))) λ where () - where - open ℕ.≤-Reasoning - - go - : (m n : ℕ) - → size VL e ≡ m + n - → (∄[ e' ] (Lang VL , Lang VL ⊢ e ≣ e') × size VL e' < n) - → Σ[ e' ∈ Expression (Lang VL) A ] (Lang VL , Lang VL ⊢ e ≣ e') × minimalExpression VL e' - go zero n size≡m+n ∄smaller = e , ≅-refl , isMinimal - where - isMinimal : (e' : Expression (Lang VL) A) → Lang VL , Lang VL ⊢ e ≣ e' → size VL e ≤ size VL e' - isMinimal e' e≅e' with size VL e ≤? size VL e' - isMinimal e' e≅e' | yes e≤e' = e≤e' - isMinimal e' e≅e' | no e≰e' = ⊥-elim (∄smaller (e' , e≅e' , ( - begin-strict - size VL e' - <⟨ ℕ.≰⇒> e≰e' ⟩ - size VL e - ≡⟨ size≡m+n ⟩ - n - ∎))) - go (suc m) n size≡m+n ∄smaller with excludedMiddle {P = ∃[ e' ] (Lang VL , Lang VL ⊢ e ≣ e') × size VL e' < suc n} - go (suc m) n size≡m+n ∄smaller | no ∄e' e'≰e'' ⟩ - size VL e' - ≤⟨ ℕ.≤-pred e'≤e ⟩ - n - ∎))) - - design→simplification - : (f : ℕ → ℕ) - → (∀ n m → n ≤ m → f n ≤ f m) - → (VL₁ VL₂ : SizedLang V) - → design f VL₁ VL₂ - → simplification f VL₁ VL₂ - design→simplification f f-monotone VL₁ VL₂ design A with design A - design→simplification f f-monotone VL₁ VL₂ design A | m , design' = m , go - where - open ℕ.≤-Reasoning - - go : - ∀ (e₂ : Expression (Lang VL₂) A) - → Σ[ e₁ ∈ Expression (Lang VL₁) A ] - (Lang VL₁ , Lang VL₂ ⊢ e₁ ≣ e₂) - → Σ[ e₁ ∈ Expression (Lang VL₁) A ] - (Lang VL₁ , Lang VL₂ ⊢ e₁ ≣ e₂) - × size VL₁ e₁ ≤ m * f (size VL₂ e₂) - go e₂ (e₁ , e₁≅e₂) with ∃minimalExpression VL₁ e₁ | ∃minimalExpression VL₂ e₂ - go e₂ (e₁ , e₁≅e₂) | e₁' , e₁≅e₁' , e₁'-minimal | e₂' , e₂≅e₂' , e₂'-minimal = e₁' , ≅-trans (≅-sym e₁≅e₁') e₁≅e₂ , ( - begin - size VL₁ e₁' - ≤⟨ design' e₁' e₂' (≅-trans (≅-sym e₁≅e₁') (≅-trans e₁≅e₂ e₂≅e₂')) e₁'-minimal e₂'-minimal ⟩ - m * f (size VL₂ e₂') - ≤⟨ ℕ.*-monoʳ-≤ m (f-monotone (size VL₂ e₂') (size VL₂ e₂) (e₂'-minimal e₂ (≅-sym e₂≅e₂'))) ⟩ - m * f (size VL₂ e₂) - ∎) diff --git a/src/Vatras/Succinctness/ProofDefinition.agda b/src/Vatras/Succinctness/ProofDefinition.agda index a95f28fb..16464745 100644 --- a/src/Vatras/Succinctness/ProofDefinition.agda +++ b/src/Vatras/Succinctness/ProofDefinition.agda @@ -207,3 +207,26 @@ L₁ Date: Sat, 6 Sep 2025 23:34:04 +0200 Subject: [PATCH 52/82] Use the new succinctness definition MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The designed succinctness definition includes a translatable constraint that the old definition was missing. This gets rid of the unfortunate `¬Compiler→¬≤` and `¬Compiler→≤` properties. A drawback of this new definition is that it breaks transitivity. Consider some languages L1 and L3 that are complete and a language L2 that is incomplete. There is an expression e in L1 that cannot be translated to L2. If we have L1 <= L2 and L2 <= L3 we cannot conclude L1 <= L3 because we know nothing about the size of e translated to L3 because we just proved that there exists no translation to L2. Note that the order of `∀ (A : 𝔸)` and `Σ[ m ∈ ℕ ]` was changed. Due to parametricity (type parameters cannot be inspected) this does not change the actual semantics of the definitions. However, it does simplify the proofs by being friendlier to pattern matching and `with` clauses avoiding additional helper functions in many cases. --- .../Succinctness/DefinitionEquivalence.agda | 49 ++- .../Succinctness/DesignedDefinition.agda | 4 +- src/Vatras/Succinctness/ProofDefinition.agda | 285 ++++++++++-------- .../Succinctness/Relations/2CC_; _<_; _*_) +open import Data.Nat as ℕ using (ℕ; _≤_; _>_; _*_) import Data.Nat.Properties as ℕ -open import Data.Product using (_×_; _,_; Σ-syntax; proj₁; proj₂) +open import Data.Product as Product using (_×_; _,_; Σ-syntax; proj₁; proj₂) +open import Function using (id) open import Relation.Nullary.Negation using (¬_) import Relation.Binary.PropositionalEquality as Eq open import Relation.Binary.Structures using (IsEquivalence; IsPreorder; IsPartialOrder; IsStrictPartialOrder) -open import Size using (∞) open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans; ≅→≅[]; ⊆-index) open import Vatras.Framework.Relation.Expression V using (_,_⊢_≣_) -open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) +open import Vatras.Framework.Relation.Expressiveness V using (_≽_; _≋_; ≽-trans; ≋-refl; ≋-sym; ≋-trans) +open import Vatras.Framework.VariabilityLanguage using (Expression) open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Succinctness.Sizes using (SizedLang; Lang; size) -_≤Size_ : SizedLang V → SizedLang V → Set₁ -L₁ ≤Size L₂ = +translatable + : (L₁ L₂ : SizedLang V) + → {A : 𝔸} + → (e₁ : Expression (Lang L₁) A) + → Set _ +translatable L₁ L₂ {A} e₁ = + Σ[ e₂ ∈ Expression (Lang L₂) A ] + Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ + +_≤ₛ[_]_ + : (L₁ : SizedLang V) + → (f : ℕ → ℕ) + → (L₂ : SizedLang V) + → Set _ +L₁ ≤ₛ[ f ] L₂ = Σ[ n ∈ ℕ ] ∀ (A : 𝔸) → - ∀ (e₂ : Expression (Lang L₂) A) → - Σ[ e₁ ∈ Expression (Lang L₁) A ] + ∀ (e₂ : Expression (Lang L₂) A) + → translatable L₂ L₁ e₂ + → Σ[ e₁ ∈ Expression (Lang L₁) A ] Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ - × size L₁ e₁ ≤ n * size L₂ e₂ - -_=Size_ : SizedLang V → SizedLang V → Set₁ -L₁ =Size L₂ = L₁ ≤Size L₂ × L₂ ≤Size L₁ + × size L₁ e₁ ≤ n * f (size L₂ e₂) -_≱Size_ : SizedLang V → SizedLang V → Set₁ -L₁ ≱Size L₂ = +_≰ₛ[_]_ + : (L₁ : SizedLang V) + → (f : ℕ → ℕ) + → (L₂ : SizedLang V) + → Set _ +L₁ ≰ₛ[ f ] L₂ = ∀ (n : ℕ) → Σ[ A ∈ 𝔸 ] - Σ[ e₁ ∈ Expression (Lang L₁) A ] - ∀ (e₂ : Expression (Lang L₂) A ) - → Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ - → size L₂ e₂ > n * size L₁ e₁ + Σ[ e₂ ∈ Expression (Lang L₂) A ] + translatable L₂ L₁ e₂ + × ∀ (e₁ : Expression (Lang L₁) A) + → Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ + → size L₁ e₁ > n * f (size L₂ e₂) -_ n * size L₁ e₁ - go e₃ e₁≅e₃ with L₃→L₂ A e₃ - go e₃ e₁≅e₃ | e₂ , e₂≅e₃ , e₂≤e₃ = + go : (e₃ : Expression (Lang L₃) A) → Lang L₃ , Lang L₁ ⊢ e₃ ≣ e₁ → size L₃ e₃ > n * size L₁ e₁ + go e₃ e₃≅e₁ with L₃→L₂ A e₃ (L₂≽L₃ e₃) + go e₃ e₃≅e₁ | e₂ , e₂≅e₃ , e₂≤e₃ = begin-strict n * size L₁ e₁ <⟨ ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) @@ -92,7 +119,7 @@ L₁ n * size L₁ e₁ - go e₃ e₁≅e₃ with L₃→L₂ A e₃ - go e₃ e₁≅e₃ | e₂ , e₂≅e₃ , e₂≤e₃ = ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) + go : (e₃ : Expression (Lang L₃) A) → Lang L₃ , Lang L₁ ⊢ e₃ ≣ e₁ → size L₃ e₃ > n * size L₁ e₁ + go e₃ e₃≅e₁ with L₃→L₂ A e₃ (L₂≽L₃ e₃) + go e₃ e₃≅e₁ | e₂ , e₂≅e₃ , e₂≤e₃ = ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) (begin ℕ.suc (m * (n * size L₁ e₁)) ≡⟨ Eq.cong ℕ.suc (ℕ.*-assoc m n (size L₁ e₁)) ⟨ ℕ.suc (m * n * size L₁ e₁) - ≤⟨ ℕ.≤-trans (e₁< e₂ (≅-trans e₁≅e₃ (≅-sym e₂≅e₃))) e₂≤e₃ ⟩ + ≤⟨ ℕ.≤-trans (e₁< e₂ (≅-trans e₂≅e₃ e₃≅e₁)) e₂≤e₃ ⟩ m * size L₃ e₃ ∎) where open ℕ.≤-Reasoning - n * size L₃ e₃ - go e₁ e₃≅e₁ = + go : (e₁ : Expression (Lang L₁) A) → Lang L₁ , Lang L₃ ⊢ e₁ ≣ e₃ → size L₁ e₁ > n * size L₃ e₃ + go e₁ e₁≅e₃ = begin-strict n * size L₃ e₃ ≤⟨ ℕ.*-monoʳ-≤ n e₃≤e₂ ⟩ @@ -140,93 +169,85 @@ L₁ 0) >⇒¬≤ᵇ : ∀ {m n : ℕ} → m > n → Bool.T (Bool.not (m ≤ᵇ n)) @@ -449,8 +449,8 @@ translate-preserves : ∀ {i : Size} {A : 𝔸} → 2CC.⟦ translate e ⟧ ≅[ fnoc (max-dimension e) ][ conf ] CCC.⟦ e ⟧ translate-preserves e = translate-preserves-⊆ e (max-dimension e) ℕ.≤-refl , translate-preserves-⊇ e -2CC≤CCC : Sized2CC (F × ℕ) ≤Size SizedCCC F -2CC≤CCC = 2 , λ A ccc → +2CC≤CCC : Sized2CC (F × ℕ) ≤ₛ SizedCCC F +2CC≤CCC = 2 , λ A ccc ccc-translatable → translate ccc , ≅[]→≅ (translate-preserves ccc) , ℕ.<⇒≤ (translate-size ccc) diff --git "a/src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" "b/src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" index 82c1f650..2577e640 100644 --- "a/src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" +++ "b/src/Vatras/Succinctness/Relations/CCC\342\211\244NCC.agda" @@ -21,7 +21,7 @@ import Vatras.Util.Vec as Vec open import Vatras.Lang.All.Fixed F (Rose ∞) open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Translation.LanguageMap using (NCC→CCC) -open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≤Size_) +open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≤ₛ_) open import Vatras.Succinctness.Sizes using (SizedNCC; sizeNCC; SizedCCC; sizeCCC) lemma : ∀ {i : Size} {A : 𝔸} (n : ℕ≥ 2) (ncc : NCC.NCC n i A) → sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc) ≤ sizeNCC n ncc @@ -66,5 +66,5 @@ lemma (sucs n) (D NCC.NCC.⟨ c ∷ cs ⟩) = where open ℕ.≤-Reasoning -CCC≤NCC : (n : ℕ≥ 2) → SizedCCC F ≤Size SizedNCC F n -CCC≤NCC n = 1 , λ A ncc → LanguageCompiler.compile (NCC→CCC n) ncc , ≅-sym (≅[]→≅ (LanguageCompiler.preserves (NCC→CCC n) ncc)) , Eq.subst (sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc )≤_) (Eq.sym (ℕ.+-identityʳ (sizeNCC n ncc))) (lemma n ncc) +CCC≤NCC : (n : ℕ≥ 2) → SizedCCC F ≤ₛ SizedNCC F n +CCC≤NCC n = 1 , λ A ncc ncc-translatable → LanguageCompiler.compile (NCC→CCC n) ncc , ≅-sym (≅[]→≅ (LanguageCompiler.preserves (NCC→CCC n) ncc)) , Eq.subst (sizeCCC (LanguageCompiler.compile (NCC→CCC n) ncc )≤_) (Eq.sym (ℕ.+-identityʳ (sizeNCC n ncc))) (lemma n ncc) diff --git "a/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" "b/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" index a348842d..60b55c78 100644 --- "a/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" +++ "b/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" @@ -38,7 +38,10 @@ open import Vatras.Framework.Variants using (Rose; Rose-injective) import Vatras.Util.List as List open import Vatras.Lang.All.Fixed ℕ (Rose ∞) import Vatras.Lang.2CC.ReflectsVariantSize as 2CC -open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≱Size_) +import Vatras.Translation.LanguageMap +open import Vatras.Util.Nat.Diagonalization using (diagonalization; diagonalization⁻¹; diagonalization-injective) +open Vatras.Translation.LanguageMap.Expressiveness diagonalization diagonalization⁻¹ diagonalization-injective using (2CC≽FST) +open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≰ₛ_) open import Vatras.Succinctness.Sizes using (sizeRose; Sized2CC; size2CC; SizedFST; sizeFST; size2CC>0) open FST.Impose NAT hiding (_∈_) @@ -287,9 +290,9 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( where open ℕ.≤-Reasoning -FST≱2CC : SizedFST ℕ ≱Size Sized2CC ℕ -FST≱2CC zero = NAT , fst zero , λ 2cc fst≅2cc → size2CC>0 2cc -FST≱2CC (suc n) = NAT , fst m , λ 2cc fst≅2cc → +FST≱2CC : Sized2CC ℕ ≰ₛ SizedFST ℕ +FST≱2CC zero = NAT , fst zero , 2CC≽FST zero ℕ._≟_ (fst zero) , λ 2cc 2cc≅fst → size2CC>0 2cc +FST≱2CC (suc n) = NAT , fst m , 2CC≽FST zero ℕ._≟_ (fst m) , λ 2cc 2cc≅fst → begin-strict suc n * sizeFST (fst m) <⟨ ℕ.*-monoʳ-< (suc n) ( @@ -328,7 +331,7 @@ FST≱2CC (suc n) = NAT , fst m , λ 2cc fst≅2cc → (size-variant m) (variant-≉ m) (Unique.applyUpTo⁺₁ id m (λ i0) options : ℕ → List (OC.OC ∞ NAT) @@ -211,10 +212,10 @@ config n i = i <ᵇ n open ℕ.≤-Reasoning goal : ∀ {i} (n : ℕ) (2cc : 2CC.2CC i NAT) - → OC.⟦ oc (4 * n) ⟧ ≅ 2CC.⟦ 2cc ⟧ + → 2CC.⟦ 2cc ⟧ ≅ OC.⟦ oc (4 * n) ⟧ → n * sizeWFOC (oc (4 * n)) < size2CC 2cc -goal zero 2cc 2cc≅oc = size2CC>0 2cc -goal n@(suc n-1) 2cc (oc⊆2cc , 2cc⊆oc) = +goal zero 2cc oc≅2cc = size2CC>0 2cc +goal n@(suc n-1) 2cc (2cc⊆oc , oc⊆2cc) = begin-strict n * sizeWFOC (oc m) ≡⟨ Eq.cong (n *_) (size-oc m) ⟩ @@ -251,5 +252,5 @@ goal n@(suc n-1) 2cc (oc⊆2cc , 2cc⊆oc) = open ℕ.≤-Reasoning m = 4 * n -OC≱2CC : SizedWFOC ℕ ≱Size Sized2CC ℕ -OC≱2CC n = NAT , oc (4 * n) , λ 2cc oc≅2cc → goal n 2cc oc≅2cc +OC≱2CC : Sized2CC ℕ ≰ₛ SizedWFOC ℕ +OC≱2CC n = NAT , oc (4 * n) , 2CC≽OC (oc (4 * n)) , λ 2cc oc≅2cc → goal n 2cc oc≅2cc diff --git a/src/Vatras/Util/Nat/Diagonalization.agda b/src/Vatras/Util/Nat/Diagonalization.agda new file mode 100644 index 00000000..b2cc839a --- /dev/null +++ b/src/Vatras/Util/Nat/Diagonalization.agda @@ -0,0 +1,16 @@ +{-# OPTIONS --allow-unsolved-metas #-} +module Vatras.Util.Nat.Diagonalization where + +open import Data.Nat using (ℕ) +open import Data.Product using (_×_) +open import Function using (_∘_; id) +open import Relation.Binary.PropositionalEquality using (_≗_) + +diagonalization : ℕ × ℕ → ℕ +diagonalization = {!!} + +diagonalization⁻¹ : ℕ → ℕ × ℕ +diagonalization⁻¹ = {!!} + +diagonalization-injective : diagonalization⁻¹ ∘ diagonalization ≗ id +diagonalization-injective = {!!} From 9ac51bad0e4e03613ea5652be79059bbd6d42794 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sun, 7 Sep 2025 23:23:06 +0200 Subject: [PATCH 53/82] =?UTF-8?q?Proof=20that=20there=20exists=20a=20diago?= =?UTF-8?q?nalization=20of=20=E2=84=95?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Vatras/Util/List.agda | 34 +++- src/Vatras/Util/Nat/Diagonalization.agda | 212 ++++++++++++++++++++++- 2 files changed, 238 insertions(+), 8 deletions(-) diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index 10321df6..c6b75a91 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -10,7 +10,7 @@ import Data.Fin.Properties as Fin open import Data.Nat using (ℕ; suc; zero; NonZero; _+_; _∸_; _*_; _⊔_; _≤_; _<_; s≤s; z≤n) open import Data.Nat.Properties as ℕ using (m≤m+n) open import Data.List as List using (List; []; _∷_; lookup; foldr; _++_) -open import Data.List.Properties using (map-id; length-++) +open import Data.List.Properties as List using (map-id; length-++) open import Data.List.Membership.Propositional using (_∈_) import Data.List.Membership.Propositional.Properties as List open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_; toList; _⁺++⁺_) renaming (map to map⁺) @@ -449,3 +449,35 @@ applyUpTo-++⁺ : ∀ {ℓ} {A : Set ℓ} → List.applyUpTo f (n + m) ≡ List.applyUpTo f n ++ List.applyUpTo (λ i → f (n + i)) m applyUpTo-++⁺ f zero m = refl applyUpTo-++⁺ f (suc n) m = Eq.cong (f zero ∷_) (applyUpTo-++⁺ (f ∘ suc) n m) + +upTo-m∸upTo-n>m : ∀ {m n : ℕ} → n ≤ m → m ≤ List.sum (List.upTo (suc m)) ∸ List.sum (List.upTo n) +upTo-m∸upTo-n>m {m} {n} n≤m = + begin + m + ≡⟨ ℕ.m+n∸m≡n n m ⟨ + n + m ∸ n + ≡⟨ ℕ.+-∸-assoc n n≤m ⟩ + n + (m ∸ n) + ≡⟨ ℕ.+-identityʳ (n + (m ∸ n)) ⟨ + n + (m ∸ n) + 0 + ≤⟨ ℕ.m≤n+m ((n + (m ∸ n) + 0)) (List.sum (List.applyUpTo (n +_) (m ∸ n))) ⟩ + List.sum (List.applyUpTo (n +_) (m ∸ n)) + (n + (m ∸ n) + 0) + ≡⟨ List.sum-++ (List.applyUpTo (n +_) (m ∸ n)) (n + (m ∸ n) ∷ []) ⟨ + List.sum (List.applyUpTo (n +_) (m ∸ n) List.∷ʳ (n + (m ∸ n))) + ≡⟨ Eq.cong List.sum (applyUpTo-∷ʳ⁺ (n +_) (m ∸ n)) ⟩ + List.sum (List.applyUpTo (n +_) (suc (m ∸ n))) + ≡⟨ Eq.cong (λ x → List.sum (List.applyUpTo (n +_) x)) (ℕ.+-∸-assoc 1 n≤m) ⟨ + List.sum (List.applyUpTo (n +_) (suc m ∸ n)) + ≡⟨ ℕ.m+n∸m≡n (List.sum (List.upTo n)) (List.sum (List.applyUpTo (n +_) (suc m ∸ n))) ⟨ + List.sum (List.upTo n) + List.sum (List.applyUpTo (n +_) (suc m ∸ n)) ∸ List.sum (List.upTo n) + ≡⟨ Eq.cong (_∸ List.sum (List.upTo n)) (List.sum-++ (List.upTo n) (List.applyUpTo (n +_) (suc m ∸ n))) ⟨ + List.sum (List.upTo n ++ List.applyUpTo (n +_) (suc m ∸ n)) ∸ List.sum (List.upTo n) + ≡⟨ Eq.cong (λ x → List.sum x ∸ List.sum (List.upTo n)) (applyUpTo-++⁺ id n (suc m ∸ n)) ⟨ + List.sum (List.upTo (n + (suc m ∸ n))) ∸ List.sum (List.upTo n) + ≡⟨ Eq.cong (λ x → List.sum (List.upTo x) ∸ List.sum (List.upTo n)) (ℕ.+-∸-assoc n (ℕ.≤-trans n≤m (ℕ.n≤1+n m))) ⟨ + List.sum (List.upTo (n + suc m ∸ n)) ∸ List.sum (List.upTo n) + ≡⟨ Eq.cong (λ x → List.sum (List.upTo x) ∸ List.sum (List.upTo n)) (ℕ.m+n∸m≡n n (suc m)) ⟩ + List.sum (List.upTo (suc m)) ∸ List.sum (List.upTo n) + ∎ + where + open ℕ.≤-Reasoning diff --git a/src/Vatras/Util/Nat/Diagonalization.agda b/src/Vatras/Util/Nat/Diagonalization.agda index b2cc839a..8d15655e 100644 --- a/src/Vatras/Util/Nat/Diagonalization.agda +++ b/src/Vatras/Util/Nat/Diagonalization.agda @@ -1,16 +1,214 @@ {-# OPTIONS --allow-unsolved-metas #-} module Vatras.Util.Nat.Diagonalization where -open import Data.Nat using (ℕ) -open import Data.Product using (_×_) -open import Function using (_∘_; id) -open import Relation.Binary.PropositionalEquality using (_≗_) +open import Data.Bool using (Bool; true; false) +open import Data.Empty using (⊥-elim) +open import Data.List as List using (List; []; _∷_; _∷ʳ_; _++_; replicate) +import Data.List.Properties as List +open import Data.Nat using (ℕ; zero; suc; _+_; _∸_; _≤_; _<_; z≤n; s≤s; _≤?_) +import Data.Nat.Properties as ℕ +open import Data.Product as Product using (_×_; _,_; uncurry; Σ-syntax) +open import Function using (_∘_; id; const) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl; _≗_) +open import Relation.Nullary.Decidable using (yes; no) + +import Vatras.Util.List as List diagonalization : ℕ × ℕ → ℕ -diagonalization = {!!} +diagonalization (x , y) = List.sum (List.upTo (suc (x + y))) + x diagonalization⁻¹ : ℕ → ℕ × ℕ -diagonalization⁻¹ = {!!} +diagonalization⁻¹ n = go (suc n) n zero + module diagonalization⁻¹-implementation where + go : ℕ → ℕ → ℕ → ℕ × ℕ + go zero n i = zero , i + go (suc fuel) n i with suc i ≤? n + go (suc fuel) n i | yes ii = + go fuel (n ∸ List.sum (List.upTo (suc i)) ∸ suc i) (suc i) + ≡⟨ Eq.cong (λ x → go fuel x (suc i)) (ℕ.∸-+-assoc n (List.sum (List.upTo (suc i))) (suc i)) ⟩ + go fuel (n ∸ (List.sum (List.upTo (suc i)) + suc i)) (suc i) + ≡⟨ Eq.cong (λ x → go fuel (n ∸ (List.sum (List.upTo (suc i)) + x)) (suc i)) (ℕ.+-identityʳ (suc i)) ⟨ + go fuel (n ∸ (List.sum (List.upTo (suc i)) + (suc i + 0))) (suc i) + ≡⟨ Eq.cong (λ x → go fuel (n ∸ x) (suc i)) (List.sum-++ (List.upTo (suc i)) (suc i ∷ [])) ⟨ + go fuel (n ∸ (List.sum (List.upTo (suc i) ∷ʳ suc i))) (suc i) + ≡⟨ Eq.cong (λ x → go fuel (n ∸ List.sum x) (suc i)) (List.applyUpTo-∷ʳ⁺ id (suc i)) ⟩ + go fuel (n ∸ List.sum (List.upTo (suc (suc i)))) (suc i) + ≡⟨ lemma fuel (suc i) n x+y>i) ⟩ + x , y + ∎ + where + nm (ℕ.≰⇒> x+y≰i) ⟩ + List.sum (List.upTo (suc (x + y))) ∸ List.sum (List.upTo (suc i)) + ≤⟨ ℕ.∸-monoˡ-≤ (List.sum (List.upTo (suc i))) (ℕ.m≤m+n (List.sum (List.upTo (suc (x + y)))) x) ⟩ + List.sum (List.upTo (suc (x + y))) + x ∸ List.sum (List.upTo (suc i)) + ≡⟨⟩ + n ∸ List.sum (List.upTo (suc i)) + <⟨ ℕ.≰⇒> i x+y≰i ⟩ + x + y + ∎)) + where + open ℕ.≤-Reasoning + +diagonalization-surjective : diagonalization ∘ diagonalization⁻¹ ≗ id +diagonalization-surjective n = lemma (suc n) n zero (ℕ.n<1+n n) refl + where + open diagonalization⁻¹-implementation n + + lemma : (fuel n' i : ℕ) → n ∸ List.sum (List.upTo (suc i)) < fuel → List.sum (List.upTo (suc i)) + n' ≡ n → diagonalization (go fuel n' i) ≡ n + lemma zero n' i n i≥n'))) ⟨ + List.sum (List.upTo (suc (n' + i ∸ n'))) + n' + ≡⟨ Eq.cong (λ x → List.sum (List.upTo (suc x)) + n') (ℕ.m+n∸m≡n n' i) ⟩ + List.sum (List.upTo (suc i)) + n' + ≡⟨ upTo+n'≡n ⟩ + n + ∎ + where + open Eq.≡-Reasoning From 4916fbfb4d4b73138f8de4b3d1c49f68a31fb253 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 8 Sep 2025 10:14:54 +0200 Subject: [PATCH 54/82] =?UTF-8?q?Prove=20that=20=E2=89=A4=20and=20?= =?UTF-8?q?=E2=89=B0=20are=20opposites?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Vatras/Succinctness/ProofDefinition.agda | 36 ++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/src/Vatras/Succinctness/ProofDefinition.agda b/src/Vatras/Succinctness/ProofDefinition.agda index c43c1c2f..0016731a 100644 --- a/src/Vatras/Succinctness/ProofDefinition.agda +++ b/src/Vatras/Succinctness/ProofDefinition.agda @@ -1,13 +1,17 @@ open import Vatras.Framework.Definitions using (𝔸; 𝕍) module Vatras.Succinctness.ProofDefinition (V : 𝕍) where +import Axiom.ExcludedMiddle +import Axiom.DoubleNegationElimination +open import Data.Empty using (⊥-elim) open import Data.Nat as ℕ using (ℕ; _≤_; _>_; _*_) import Data.Nat.Properties as ℕ open import Data.Product as Product using (_×_; _,_; Σ-syntax; proj₁; proj₂) -open import Function using (id) -open import Relation.Nullary.Negation using (¬_) +open import Function using (id; _∘_) import Relation.Binary.PropositionalEquality as Eq open import Relation.Binary.Structures using (IsEquivalence; IsPreorder; IsPartialOrder; IsStrictPartialOrder) +open import Relation.Nullary.Decidable using (yes; no) +open import Relation.Nullary.Negation using (¬_; ¬∃⟶∀¬) open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans; ≅→≅[]; ⊆-index) open import Vatras.Framework.Relation.Expression V using (_,_⊢_≣_) @@ -251,3 +255,31 @@ L₁ <ₛ' L₂ = Lang L₁ ≋ Lang L₂ × L₁ ≤ₛ L₂ × L₂ ≰ₛ L } ; preserves = λ {A} e₂ → ≅→≅[] (≅-sym (proj₁ (proj₂ (L₂→L₁ A e₂ (L₁≽L₂ e₂))))) } + +open Axiom.ExcludedMiddle using (ExcludedMiddle) +open Axiom.DoubleNegationElimination using (em⇒dne) +module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where + ¬∀→∃¬ : ∀ {ℓ₁ ℓ₂} {A : Set ℓ₁} {P : A → Set ℓ₂} → ¬ (∀ (a : A) → P a) → Σ[ a ∈ A ] ¬ P a + ¬∀→∃¬ {A = A} {P = P} ¬∀P with excludedMiddle {P = Σ[ a ∈ A ] ¬ P a} + ¬∀→∃¬ {A = A} {P = P} ¬∀P | yes ∃P = ∃P + ¬∀→∃¬ {A = A} {P = P} ¬∀P | no ∄P = ⊥-elim (¬∀P (λ a → em⇒dne excludedMiddle (¬∃⟶∀¬ ∄P a))) + + map-∀ : ∀ {ℓ₁ ℓ₂ ℓ₃} {A : Set ℓ₁} {P : A → Set ℓ₂} {Q : A → Set ℓ₃} + → (∀ {a} → P a → Q a) → (∀ (a : A) → P a) → (∀ (a : A) → Q a) + map-∀ f ∀P a = f (∀P a) + + map-Σ : ∀ {ℓ₁ ℓ₂ ℓ₃} {A : Set ℓ₁} {P : A → Set ℓ₂} {Q : A → Set ℓ₃} + → (∀ {a} → P a → Q a) → Σ[ a ∈ A ] P a → Σ[ a ∈ A ] Q a + map-Σ f (a , Pa) = a , f Pa + + ¬∀→∃ : ∀ {ℓ₁ ℓ₂ ℓ₃} {A : Set ℓ₁} {P : A → Set ℓ₂} {Q : A → Set ℓ₃} → (∀ {a : A} → ¬ P a → Q a) → ¬ (∀ (a : A) → P a) → Σ[ a ∈ A ] Q a + ¬∀→∃ f P = map-Σ f (¬∀→∃¬ P) + + ¬∃→∀ : ∀ {ℓ₁ ℓ₂ ℓ₃} {A : Set ℓ₁} {P : A → Set ℓ₂} {Q : A → Set ℓ₃} → (∀ {a : A} → ¬ P a → Q a) → ¬ (Σ[ a ∈ A ] P a) → ∀ (a : A) → Q a + ¬∃→∀ f P = map-∀ f (¬∃⟶∀¬ P) + + ¬≤→≰ : {L₁ L₂ : SizedLang V} → ¬ (L₁ ≤ₛ L₂) → L₁ ≰ₛ L₂ + ¬≤→≰ = ¬∃→∀ (¬∀→∃ (¬∀→∃ (¬∀→∃ (¬∃→∀ (¬∃→∀ ℕ.≰⇒>))))) + + ¬≰→≤ : {L₁ L₂ : SizedLang V} → ¬ (L₁ ≰ₛ L₂) → L₁ ≤ₛ L₂ + ¬≰→≤ = ¬∀→∃ (¬∃→∀ (¬∃→∀ (¬∃→∀ (¬∀→∃ (¬∀→∃ ℕ.≮⇒≥))))) From ffb965cfc7fadae045936da72d6426b5429e553c Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 8 Sep 2025 11:23:59 +0200 Subject: [PATCH 55/82] =?UTF-8?q?Prove=20=E2=89=A4=E2=82=9B-weakening?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Vatras/Succinctness/ProofDefinition.agda | 18 ++++++ src/Vatras/Util/Big-O.agda | 68 ++++++++++++++++++++ 2 files changed, 86 insertions(+) create mode 100644 src/Vatras/Util/Big-O.agda diff --git a/src/Vatras/Succinctness/ProofDefinition.agda b/src/Vatras/Succinctness/ProofDefinition.agda index 0016731a..7dbeeea4 100644 --- a/src/Vatras/Succinctness/ProofDefinition.agda +++ b/src/Vatras/Succinctness/ProofDefinition.agda @@ -12,8 +12,10 @@ import Relation.Binary.PropositionalEquality as Eq open import Relation.Binary.Structures using (IsEquivalence; IsPreorder; IsPartialOrder; IsStrictPartialOrder) open import Relation.Nullary.Decidable using (yes; no) open import Relation.Nullary.Negation using (¬_; ¬∃⟶∀¬) +open import Relation.Unary using (_∈_) open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans; ≅→≅[]; ⊆-index) +open import Vatras.Util.Big-O using (𝒪[_]) open import Vatras.Framework.Relation.Expression V using (_,_⊢_≣_) open import Vatras.Framework.Relation.Expressiveness V using (_≽_; _≋_; ≽-trans; ≋-refl; ≋-sym; ≋-trans) open import Vatras.Framework.VariabilityLanguage using (Expression) @@ -256,6 +258,22 @@ L₁ <ₛ' L₂ = Lang L₁ ≋ Lang L₂ × L₁ ≤ₛ L₂ × L₂ ≰ₛ L ; preserves = λ {A} e₂ → ≅→≅[] (≅-sym (proj₁ (proj₂ (L₂→L₁ A e₂ (L₁≽L₂ e₂))))) } +≤ₛ-weakening : ∀ {L₁ L₂ : SizedLang V} {f g : ℕ → ℕ} → f ∈ 𝒪[ g ] → L₁ ≤ₛ[ f ] L₂ → L₁ ≤ₛ[ g ] L₂ +≤ₛ-weakening {L₁} {L₂} {f} {g} (m , f≤g) (n , L₂→L₁) .proj₁ = n * m +≤ₛ-weakening {L₁} {L₂} {f} {g} (m , f≤g) (n , L₂→L₁) .proj₂ A e₂ e₂-translatable with L₂→L₁ A e₂ e₂-translatable +≤ₛ-weakening {L₁} {L₂} {f} {g} (m , f≤g) (n , L₂→L₁) .proj₂ A e₂ e₂-translatable | e₁ , e₁≅e₂ , e₂≤e₁ = e₁ , e₁≅e₂ , ( + begin + size L₁ e₁ + ≤⟨ e₂≤e₁ ⟩ + n * f (size L₂ e₂) + ≤⟨ ℕ.*-monoʳ-≤ n (f≤g (size L₂ e₂)) ⟩ + n * (m * g (size L₂ e₂)) + ≡⟨ ℕ.*-assoc n m (g (size L₂ e₂)) ⟨ + n * m * g (size L₂ e₂) + ∎) + where + open ℕ.≤-Reasoning + open Axiom.ExcludedMiddle using (ExcludedMiddle) open Axiom.DoubleNegationElimination using (em⇒dne) module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where diff --git a/src/Vatras/Util/Big-O.agda b/src/Vatras/Util/Big-O.agda new file mode 100644 index 00000000..e51bda94 --- /dev/null +++ b/src/Vatras/Util/Big-O.agda @@ -0,0 +1,68 @@ +module Vatras.Util.Big-O where + +open import Data.Nat using (ℕ; zero; suc; _≤_; s≤s; z≤n; _*_; _^_) +import Data.Nat.Properties as ℕ +open import Data.Product using (_,_; Σ-syntax) +open import Function using (id) +import Relation.Binary.PropositionalEquality as Eq +open import Relation.Unary using (_∈_) + +𝒪[_] : (ℕ → ℕ) → (ℕ → ℕ) → Set +𝒪[ g ] f = Σ[ n ∈ ℕ ] ∀ m → f m ≤ n * g m + +𝒪-transitive : (f g h : ℕ → ℕ) → f ∈ 𝒪[ g ] → g ∈ 𝒪[ h ] → f ∈ 𝒪[ h ] +𝒪-transitive f g h (m₁ , f≤g) (m₂ , f≤h) = m₁ * m₂ , λ n → + begin + f n + ≤⟨ f≤g n ⟩ + m₁ * g n + ≤⟨ ℕ.*-monoʳ-≤ m₁ (f≤h n) ⟩ + m₁ * (m₂ * h n) + ≡⟨ ℕ.*-assoc m₁ m₂ (h n) ⟨ + m₁ * m₂ * h n + ∎ + where + open ℕ.≤-Reasoning + +module ReferenceFunctions where + n : ℕ → ℕ + n = id + + n^2 : ℕ → ℕ + n^2 n = n ^ 2 + + 2^n : ℕ → ℕ + 2^n n = 2 ^ n + +module Specializations where + 𝒪[n] : (ℕ → ℕ) → Set + 𝒪[n] = 𝒪[ ReferenceFunctions.n ] + + 𝒪[n^2] : (ℕ → ℕ) → Set + 𝒪[n^2] = 𝒪[ ReferenceFunctions.n^2 ] + + 𝒪[2^n] : (ℕ → ℕ) → Set + 𝒪[2^n] = 𝒪[ ReferenceFunctions.2^n ] + +module Examples where + open ReferenceFunctions + + n∈𝒪[n] : id ∈ 𝒪[ n ] + n∈𝒪[n] = 1 , λ n → ℕ.≤-reflexive (Eq.sym (ℕ.*-identityˡ n)) + + n∈𝒪[n^2] : n ∈ 𝒪[ n^2 ] + n∈𝒪[n^2] = 1 , λ + where + zero → ℕ.≤-refl + (suc n) → + begin + suc n + ≡⟨ ℕ.^-identityʳ (suc n) ⟨ + suc n ^ 1 + ≤⟨ ℕ.^-monoʳ-≤ (suc n) (s≤s (z≤n {n = 1})) ⟩ + suc n ^ 2 + ≡⟨ ℕ.*-identityˡ (suc n ^ 2) ⟨ + 1 * suc n ^ 2 + ∎ + where + open ℕ.≤-Reasoning From 5368a8a78dc9942f0a03d744a6895421e29de0a6 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 9 Sep 2025 12:53:26 +0200 Subject: [PATCH 56/82] Prove more general succinctness transitivity properties --- src/Vatras/Succinctness/ProofDefinition.agda | 170 +++++++++++++++++-- 1 file changed, 152 insertions(+), 18 deletions(-) diff --git a/src/Vatras/Succinctness/ProofDefinition.agda b/src/Vatras/Succinctness/ProofDefinition.agda index 7dbeeea4..aa1c30b8 100644 --- a/src/Vatras/Succinctness/ProofDefinition.agda +++ b/src/Vatras/Succinctness/ProofDefinition.agda @@ -8,6 +8,7 @@ open import Data.Nat as ℕ using (ℕ; _≤_; _>_; _*_) import Data.Nat.Properties as ℕ open import Data.Product as Product using (_×_; _,_; Σ-syntax; proj₁; proj₂) open import Function using (id; _∘_) +open import Relation.Binary using (_Preserves_⟶_) import Relation.Binary.PropositionalEquality as Eq open import Relation.Binary.Structures using (IsEquivalence; IsPreorder; IsPartialOrder; IsStrictPartialOrder) open import Relation.Nullary.Decidable using (yes; no) @@ -16,6 +17,7 @@ open import Relation.Unary using (_∈_) open import Vatras.Data.EqIndexedSet using (≅-refl; ≅-sym; ≅-trans; ≅→≅[]; ⊆-index) open import Vatras.Util.Big-O using (𝒪[_]) +open Vatras.Util.Big-O.Examples using (n∈𝒪[n]) open import Vatras.Framework.Relation.Expression V using (_,_⊢_≣_) open import Vatras.Framework.Relation.Expressiveness V using (_≽_; _≋_; ≽-trans; ≋-refl; ≋-sym; ≋-trans) open import Vatras.Framework.VariabilityLanguage using (Expression) @@ -59,6 +61,45 @@ L₁ ≰ₛ[ f ] L₂ = → Lang L₁ , Lang L₂ ⊢ e₁ ≣ e₂ → size L₁ e₁ > n * f (size L₂ e₂) + +≤ₛ[]-growthFactor : {L₁ L₂ : SizedLang V} (f : ℕ → ℕ) → L₁ ≤ₛ[ f ] L₂ → ℕ +≤ₛ[]-growthFactor f = proj₁ + +at-least-linear : (ℕ → ℕ) → Set +at-least-linear f = id ∈ 𝒪[ f ] + +monotonic : (ℕ → ℕ) → Set +monotonic f = f Preserves _≤_ ⟶ _≤_ + + +≤ₛ[]-refl : {L : SizedLang V} {f : ℕ → ℕ} → at-least-linear f → L ≤ₛ[ f ] L +≤ₛ[]-refl {L} (n , id≤f) = n , λ A e e-translatable → e , ≅-refl , id≤f (size L e) + +≤ₛ[]-transitive + : {L₁ L₂ L₃ : SizedLang V} + → (f g : ℕ → ℕ) + → monotonic f + → Lang L₁ ≽ Lang L₂ + → Lang L₂ ≽ Lang L₃ + → L₁ ≤ₛ[ f ] L₂ + → (L₂≤ₛL₃ : L₂ ≤ₛ[ g ] L₃) + → L₁ ≤ₛ[ (λ n → f (≤ₛ[]-growthFactor g L₂≤ₛL₃ * g n)) ] L₃ +≤ₛ[]-transitive {L₁} {L₂} {L₃} f g f-monotone L₁≽L₂ L₂≽L₃ (n₁ , L₂→L₁) (n₂ , L₃→L₂) .proj₁ = n₁ +≤ₛ[]-transitive {L₁} {L₂} {L₃} f g f-monotone L₁≽L₂ L₂≽L₃ (n₁ , L₂→L₁) (n₂ , L₃→L₂) .proj₂ A e₃ e₃-translatable with L₃→L₂ A e₃ (L₂≽L₃ e₃) +≤ₛ[]-transitive {L₁} {L₂} {L₃} f g f-monotone L₁≽L₂ L₂≽L₃ (n₁ , L₂→L₁) (n₂ , L₃→L₂) .proj₂ A e₃ e₃-translatable | e₂ , e₂≅e₃ , e₁≤e₂ with L₂→L₁ A e₂ (L₁≽L₂ e₂) +≤ₛ[]-transitive {L₁} {L₂} {L₃} f g f-monotone L₁≽L₂ L₂≽L₃ (n₁ , L₂→L₁) (n₂ , L₃→L₂) .proj₂ A e₃ e₃-translatable | e₂ , e₂≅e₃ , e₂≤e₃ | e₁ , e₁≅e₂ , e₁≤e₂ + = e₁ , ≅-trans e₁≅e₂ e₂≅e₃ , + (begin + size L₁ e₁ + ≤⟨ e₁≤e₂ ⟩ + n₁ * f (size L₂ e₂) + ≤⟨ ℕ.*-monoʳ-≤ n₁ (f-monotone e₂≤e₃) ⟩ + n₁ * f (n₂ * g (size L₃ e₃)) + ∎) + where + open ℕ.≤-Reasoning + + _≤ₛ_ : SizedLang V → SizedLang V → Set₁ L₁ ≤ₛ L₂ = L₁ ≤ₛ[ id ] L₂ @@ -73,7 +114,7 @@ L₁ <ₛ L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ L₁ ≤ₛ-refl : {L : SizedLang V} → L ≤ₛ L -≤ₛ-refl {L} = 1 , λ A e e-translatable → e , ≅-refl , ℕ.≤-reflexive (Eq.sym (ℕ.*-identityˡ (size L e))) +≤ₛ-refl = ≤ₛ[]-refl n∈𝒪[n] ≤ₛ-reflexive : {L₁ L₂ : SizedLang V} → L₁ =ₛ L₂ → L₁ ≤ₛ L₂ ≤ₛ-reflexive (L₁≤ₛL₂ , L₂≤ₛL₁) = L₁≤ₛL₂ @@ -109,10 +150,32 @@ L₁ <ₛ L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ L₁ =ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≋ Lang L₂ → Lang L₂ ≋ Lang L₃ → L₁ =ₛ L₂ → L₂ =ₛ L₃ → L₁ =ₛ L₃ =ₛ-transitive (L₁≽L₂ , L₂≽L₁) (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≤ₛL₁) (L₂≤ₛL₃ , L₃≤ₛL₂) = ≤ₛ-transitive L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ L₂≤ₛL₃ , ≤ₛ-transitive L₃≽L₂ L₂≽L₁ L₃≤ₛL₂ L₂≤ₛL₁ -<ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≽ Lang L₂ → Lang L₂ ≋ Lang L₃ → L₁ <ₛ L₂ → L₂ <ₛ L₃ → L₁ <ₛ L₃ -<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) (L₂≤ₛL₃@(m , L₃→L₂) , L₃≰ₛL₂) .proj₁ = ≤ₛ-transitive L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ L₂≤ₛL₃ -<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) (L₂≤ₛL₃@(m , L₃→L₂) , L₃≰ₛL₂) .proj₂ n with L₂≰ₛL₁ (m * n) -<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) (L₂≤ₛL₃@(m , L₃→L₂) , L₃≰ₛL₂) .proj₂ n | A , e₁ , (e₂ , e₁≅e₂) , e₁< +<ₛ→≤ₛ : {L₁ L₂ : SizedLang V} → L₁ <ₛ L₂ → L₁ ≤ₛ L₂ +<ₛ→≤ₛ (L₁≤ₛL₂ , L₂≰ₛL₁) = L₁≤ₛL₂ + + +≤ₛ-<ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≽ Lang L₂ → Lang L₂ ≽ Lang L₃ → L₁ ≤ₛ L₂ → L₂ <ₛ L₃ → L₁ <ₛ L₃ +≤ₛ-<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₁ = ≤ₛ-transitive L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ L₂≤ₛL₃ +≤ₛ-<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₂ n with L₃≰ₛL₂ (n * m) +≤ₛ-<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₂ n | A , e₂ , (e₃ , e₂≅e₃) , e₂< with L₂→L₁ A e₂ (L₁≽L₂ e₂) +≤ₛ-<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₂ n | A , e₂ , (e₃ , e₂≅e₃) , e₂< | e₁ , e₁≅e₂ , e₁≤e₂ + = A , e₁ , (e₃ , ≅-trans e₁≅e₂ e₂≅e₃) , λ e₃' e₃≅e₁ → + begin-strict + n * size L₁ e₁ + ≤⟨ ℕ.*-monoʳ-≤ n e₁≤e₂ ⟩ + n * (m * size L₂ e₂) + ≡⟨ ℕ.*-assoc n m (size L₂ e₂) ⟨ + n * m * size L₂ e₂ + <⟨ e₂< e₃' (≅-trans e₃≅e₁ e₁≅e₂) ⟩ + size L₃ e₃' + ∎ + where + open ℕ.≤-Reasoning + +<ₛ-≤ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≽ Lang L₂ → Lang L₂ ≋ Lang L₃ → L₁ <ₛ L₂ → L₂ ≤ₛ L₃ → L₁ <ₛ L₃ +<ₛ-≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃@(m , L₃→L₂) .proj₁ = ≤ₛ-transitive L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ L₂≤ₛL₃ +<ₛ-≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃@(m , L₃→L₂) .proj₂ n with L₂≰ₛL₁ (m * n) +<ₛ-≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃@(m , L₃→L₂) .proj₂ n | A , e₁ , (e₂ , e₁≅e₂) , e₁< = A , e₁ , Product.map₂ (≅-trans e₁≅e₂) (L₃≽L₂ e₂) , go where go : (e₃ : Expression (Lang L₃) A) → Lang L₃ , Lang L₁ ⊢ e₃ ≣ e₁ → size L₃ e₃ > n * size L₁ e₁ @@ -121,11 +184,13 @@ L₁ <ₛ L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ L₁ begin-strict n * size L₁ e₁ <⟨ ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) - (begin - ℕ.suc (m * (n * size L₁ e₁)) - ≡⟨ Eq.cong ℕ.suc (ℕ.*-assoc m n (size L₁ e₁)) ⟨ - ℕ.suc (m * n * size L₁ e₁) - ≤⟨ ℕ.≤-trans (e₁< e₂ (≅-trans e₂≅e₃ e₃≅e₁)) e₂≤e₃ ⟩ + (begin-strict + m * (n * size L₁ e₁) + ≡⟨ ℕ.*-assoc m n (size L₁ e₁) ⟨ + m * n * size L₁ e₁ + <⟨ e₁< e₂ (≅-trans e₂≅e₃ e₃≅e₁) ⟩ + size L₂ e₂ + ≤⟨ e₂≤e₃ ⟩ m * size L₃ e₃ ∎) ⟩ @@ -134,6 +199,9 @@ L₁ <ₛ L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ L₁ where open ℕ.≤-Reasoning +<ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≽ Lang L₂ → Lang L₂ ≋ Lang L₃ → L₁ <ₛ L₂ → L₂ <ₛ L₃ → L₁ <ₛ L₃ +<ₛ-transitive L₁≽L₂ L₂≋L₃ L₁<ₛL₂ L₂<ₛL₃ = <ₛ-≤ₛ-transitive L₁≽L₂ L₂≋L₃ L₁<ₛL₂ (<ₛ→≤ₛ L₂<ₛL₃) + <ₛ-irreflexive : {L₁ L₂ : SizedLang V} → L₁ =ₛ L₂ → ¬ (L₁ <ₛ L₂) <ₛ-irreflexive {L₁} {L₂} (L₁≤ₛL₂ , (n , L₁→L₂)) (L₁≤ₛL₂' , L₂≰ₛL₁) with L₂≰ₛL₁ n <ₛ-irreflexive {L₁} {L₂} (L₁≤ₛL₂ , (n , L₁→L₂)) (L₁≤ₛL₂' , L₂≰ₛL₁) | A , e₁ , e₁-translatable , e₂< with L₁→L₂ A e₁ e₁-translatable @@ -148,11 +216,11 @@ L₁ <ₛ L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ L₁ go : (e₃ : Expression (Lang L₃) A) → Lang L₃ , Lang L₁ ⊢ e₃ ≣ e₁ → size L₃ e₃ > n * size L₁ e₁ go e₃ e₃≅e₁ with L₃→L₂ A e₃ (L₂≽L₃ e₃) go e₃ e₃≅e₁ | e₂ , e₂≅e₃ , e₂≤e₃ = ℕ.*-cancelˡ-< m (n * size L₁ e₁) (size L₃ e₃) - (begin - ℕ.suc (m * (n * size L₁ e₁)) - ≡⟨ Eq.cong ℕ.suc (ℕ.*-assoc m n (size L₁ e₁)) ⟨ - ℕ.suc (m * n * size L₁ e₁) - ≤⟨ ℕ.≤-trans (e₁< e₂ (≅-trans e₂≅e₃ e₃≅e₁)) e₂≤e₃ ⟩ + (begin-strict + m * (n * size L₁ e₁) + ≡⟨ ℕ.*-assoc m n (size L₁ e₁) ⟨ + m * n * size L₁ e₁ + <⟨ ℕ.≤-trans (e₁< e₂ (≅-trans e₂≅e₃ e₃≅e₁)) e₂≤e₃ ⟩ m * size L₃ e₃ ∎) where @@ -182,6 +250,75 @@ L₁ <ₛ L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ L₁ open ℕ.≤-Reasoning +_<ₛ[_]_ + : (L₁ : SizedLang V) + → (f : ℕ → ℕ) + → (L₂ : SizedLang V) + → Set _ +L₁ <ₛ[ f ] L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ[ f ] L₁ + +<ₛ[]-growthFactor : {L₁ L₂ : SizedLang V} (f : ℕ → ℕ) → L₁ <ₛ[ f ] L₂ → ℕ +<ₛ[]-growthFactor f = proj₁ ∘ proj₁ + +≤ₛ[]-<ₛ[]-transitive + : {L₁ L₂ L₃ : SizedLang V} + → (f : ℕ → ℕ) + → monotonic f + → Lang L₁ ≽ Lang L₂ + → Lang L₂ ≋ Lang L₃ + → (L₁≤ₛL₂ : L₁ ≤ₛ L₂) + → L₂ <ₛ[ (λ n → f (≤ₛ[]-growthFactor id L₁≤ₛL₂ * n)) ] L₃ + → L₁ <ₛ[ f ] L₃ +≤ₛ[]-<ₛ[]-transitive {L₁} {L₂} {L₃} f f-monotone L₁≽L₂ (L₂≽L₃ , L₃≽L₂) L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₁ = ≤ₛ-transitive L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ L₂≤ₛL₃ +≤ₛ[]-<ₛ[]-transitive {L₁} {L₂} {L₃} f f-monotone L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₂ n with L₃≰ₛL₂ n +≤ₛ[]-<ₛ[]-transitive {L₁} {L₂} {L₃} f f-monotone L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₂ n | A , e₂ , (e₃ , e₂≅e₃) , e₂< with L₂→L₁ A e₂ (L₁≽L₂ e₂) +≤ₛ[]-<ₛ[]-transitive {L₁} {L₂} {L₃} f f-monotone L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₂ n | A , e₂ , (e₃ , e₂≅e₃) , e₂< | e₁ , e₁≅e₂ , e₁≤e₂ + = A , e₁ , (e₃ , ≅-trans e₁≅e₂ e₂≅e₃) , λ e₃' e₃≅e₁ → + begin-strict + n * f (size L₁ e₁) + ≤⟨ ℕ.*-monoʳ-≤ n (f-monotone (e₁≤e₂)) ⟩ + n * f (m * size L₂ e₂) + <⟨ e₂< e₃' (≅-trans e₃≅e₁ e₁≅e₂) ⟩ + size L₃ e₃' + ∎ + where + open ℕ.≤-Reasoning + +<ₛ[]-≤ₛ[]-transitive + : {L₁ L₂ L₃ : SizedLang V} + → (f : ℕ → ℕ) + → Lang L₁ ≽ Lang L₂ + → Lang L₂ ≋ Lang L₃ + → L₁ <ₛ[ f ] L₂ + → L₂ ≤ₛ L₃ + → L₁ <ₛ[ f ] L₃ +<ₛ[]-≤ₛ[]-transitive {L₁} {L₂} {L₃} f L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃@(m , L₃→L₂) .proj₁ = ≤ₛ-transitive L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ L₂≤ₛL₃ +<ₛ[]-≤ₛ[]-transitive {L₁} {L₂} {L₃} f L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃@(m , L₃→L₂) .proj₂ n with L₂≰ₛL₁ (m * n) +<ₛ[]-≤ₛ[]-transitive {L₁} {L₂} {L₃} f L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃@(m , L₃→L₂) .proj₂ n | A , e₁ , (e₂ , e₁≅e₂) , e₁< + = A , e₁ , Product.map₂ (≅-trans e₁≅e₂) (L₃≽L₂ e₂) , go + where + go : (e₃ : Expression (Lang L₃) A) → Lang L₃ , Lang L₁ ⊢ e₃ ≣ e₁ → size L₃ e₃ > n * f (size L₁ e₁) + go e₃ e₃≅e₁ with L₃→L₂ A e₃ (L₂≽L₃ e₃) + go e₃ e₃≅e₁ | e₂ , e₂≅e₃ , e₂≤e₃ = + begin-strict + n * f (size L₁ e₁) + <⟨ ℕ.*-cancelˡ-< m (n * f (size L₁ e₁)) (size L₃ e₃) + (begin-strict + m * (n * f (size L₁ e₁)) + ≡⟨ ℕ.*-assoc m n (f (size L₁ e₁)) ⟨ + m * n * f (size L₁ e₁) + <⟨ e₁< e₂ (≅-trans e₂≅e₃ e₃≅e₁) ⟩ + size L₂ e₂ + ≤⟨ e₂≤e₃ ⟩ + m * size L₃ e₃ + ∎) + ⟩ + size L₃ e₃ + ∎ + where + open ℕ.≤-Reasoning + + _=ₛ'_ : SizedLang V → SizedLang V → Set₁ L₁ =ₛ' L₂ = Lang L₁ ≋ Lang L₂ × L₁ ≤ₛ L₂ × L₂ ≤ₛ L₁ @@ -232,9 +369,6 @@ L₁ <ₛ' L₂ = Lang L₁ ≋ Lang L₂ × L₁ ≤ₛ L₂ × L₂ ≰ₛ L <ₛ'→<ₛ = proj₂ -<ₛ→≤ₛ : {L₁ L₂ : SizedLang V} → L₁ <ₛ L₂ → L₁ ≤ₛ L₂ -<ₛ→≤ₛ (L₁≤ₛL₂ , L₂≰ₛL₁) = L₁≤ₛL₂ - ≰→¬≤ : {L₁ L₂ : SizedLang V} → L₁ ≰ₛ L₂ → ¬ (L₁ ≤ₛ L₂) ≰→¬≤ {L₁} {L₂} L₁≰ₛL₂ (n , L₁→L₂) with L₁≰ₛL₂ n ≰→¬≤ {L₁} {L₂} L₁≰ₛL₂ (n , L₁→L₂) | A , e₂ , e₂-translatable , e₂< with L₁→L₂ A e₂ e₂-translatable From bdce75f4682c87a53b46badbcfa51c36b2d78eaa Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 11 Nov 2025 15:19:54 +0100 Subject: [PATCH 57/82] Add missing size definitions --- src/Vatras/Succinctness/Sizes.agda | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/src/Vatras/Succinctness/Sizes.agda b/src/Vatras/Succinctness/Sizes.agda index c6a8f1d7..fa65c82c 100644 --- a/src/Vatras/Succinctness/Sizes.agda +++ b/src/Vatras/Succinctness/Sizes.agda @@ -70,6 +70,25 @@ SizedADT F V variantSize = record ; size = sizeADT variantSize } +sizeNADT : {F : 𝔽} {V : 𝕍} {i : Size} {A : 𝔸} → ({A : 𝔸} → V A → ℕ) → NADT.NADT F V i A → ℕ +sizeNADT variantSize (NADT.NADT.leaf v) = suc (variantSize v) +sizeNADT variantSize (D NADT.NADT.⟨ cs ⟩) = suc (List.sum (List.map (sizeNADT variantSize) (List⁺.toList cs))) + +SizedNADT : 𝔽 → (V : 𝕍) → ({A : 𝔸} → V A → ℕ) → SizedLang V +SizedNADT F V variantSize = record + { Lang = NADT.NADTL F V + ; size = sizeNADT variantSize + } + +sizeVariantList : {V : 𝕍} {A : 𝔸} → ({A : 𝔸} → V A → ℕ) → VariantList.VariantList V A → ℕ +sizeVariantList variantSize l = List.sum (List.map variantSize (List⁺.toList l)) + +SizedVariantList : (V : 𝕍) → ({A : 𝔸} → V A → ℕ) → SizedLang V +SizedVariantList V variantSize = record + { Lang = VariantList.VariantListL V + ; size = sizeVariantList {V = V} variantSize + } + sizeOC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → OC.OC F i A → ℕ sizeOC {A = A} (a OC.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeOC cs)) sizeOC (D OC.❲ c ❳) = suc (sizeOC c) From e16ef099fb0e36c6f76201503133dac4810bc7ea Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 9 Sep 2025 19:29:01 +0200 Subject: [PATCH 58/82] Define an OC with a propositional selection language --- src/Vatras/Lang/All.agda | 6 ++++++ src/Vatras/Lang/All/Fixed.agda | 2 ++ src/Vatras/Lang/PropOC.agda | 37 ++++++++++++++++++++++++++++++++++ 3 files changed, 45 insertions(+) create mode 100644 src/Vatras/Lang/PropOC.agda diff --git a/src/Vatras/Lang/All.agda b/src/Vatras/Lang/All.agda index 52a110b2..e2094eca 100644 --- a/src/Vatras/Lang/All.agda +++ b/src/Vatras/Lang/All.agda @@ -21,6 +21,7 @@ import Vatras.Lang.OC import Vatras.Lang.FST import Vatras.Lang.Gruler import Vatras.Lang.VT +import Vatras.Lang.PropOC open import Data.Empty.Polymorphic using (⊥) open import Vatras.Util.Nat.AtLeast using (ℕ≥) @@ -89,3 +90,8 @@ module VT where open Vatras.Lang.VT using (VT; UnrootedVT; VTL; Configuration) public module _ {F : 𝔽} where open Vatras.Lang.VT F hiding (VT; UnrootedVT; VTL; Configuration) public + +module PropOC where + open Vatras.Lang.PropOC using (PropOC; PropOCL; WFPropOC; WFPropOCL; Configuration) public + module _ {F : 𝔽} where + open Vatras.Lang.PropOC F hiding (PropOC; PropOCL; WFPropOC; WFPropOCL; Configuration) public diff --git a/src/Vatras/Lang/All/Fixed.agda b/src/Vatras/Lang/All/Fixed.agda index 8084692e..d5253c97 100644 --- a/src/Vatras/Lang/All/Fixed.agda +++ b/src/Vatras/Lang/All/Fixed.agda @@ -14,6 +14,7 @@ import Vatras.Lang.OC import Vatras.Lang.FST import Vatras.Lang.Gruler import Vatras.Lang.VT +import Vatras.Lang.PropOC module VariantList = Vatras.Lang.VariantList V module CCC = Vatras.Lang.CCC F @@ -29,3 +30,4 @@ module OC = Vatras.Lang.OC F module FST = Vatras.Lang.FST F module Gruler = Vatras.Lang.Gruler F module VT = Vatras.Lang.VT F +module PropOC = Vatras.Lang.PropOC F diff --git a/src/Vatras/Lang/PropOC.agda b/src/Vatras/Lang/PropOC.agda new file mode 100644 index 00000000..4f634319 --- /dev/null +++ b/src/Vatras/Lang/PropOC.agda @@ -0,0 +1,37 @@ +open import Vatras.Framework.Definitions using (𝔽; ℂ; 𝔼) + +module Vatras.Lang.PropOC (F : 𝔽) where + +open import Data.List using (List) +open import Data.Maybe using (Maybe) +open import Function using (_∘_; flip) +open import Size using (Size; ∞) + +open import Vatras.Data.Prop using (Prop; Assignment; eval) +open import Vatras.Framework.Variants as V using (Rose) +open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; ⟪_,_,_⟫; 𝔼-Semantics) +open import Vatras.Lang.OC (Prop F) as OC + public + using (Root; _-<_>-; _❲_❳) + renaming + ( OC to PropOC + ; WFOC to WFPropOC + ) + +Configuration : ℂ +Configuration = Assignment F + +⟦_⟧ₒ-recurse : ∀ {i} → 𝔼-Semantics (List ∘ Rose ∞) Configuration (List ∘ PropOC i) +⟦ e ⟧ₒ-recurse c = OC.⟦ e ⟧ₒ-recurse (flip eval c) + +⟦_⟧ₒ : ∀ {i : Size} → 𝔼-Semantics (Maybe ∘ Rose ∞) Configuration (PropOC i) +⟦ e ⟧ₒ c = OC.⟦ e ⟧ₒ (flip eval c) + +⟦_⟧ : ∀ {i : Size} → 𝔼-Semantics (Rose ∞) Configuration (WFPropOC i) +⟦ e ⟧ c = OC.⟦ e ⟧ (flip eval c) + +PropOCL : ∀ {i : Size} → VariabilityLanguage (Maybe ∘ Rose ∞) +PropOCL {i} = ⟪ PropOC i , Configuration , ⟦_⟧ₒ ⟫ + +WFPropOCL : {i : Size} → VariabilityLanguage (Rose ∞) +WFPropOCL {i} = ⟪ WFPropOC i , Configuration , ⟦_⟧ ⟫ From c31b2f9ae0cdd74b1b8e3b32e3fab24cbc3afaba Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 9 Sep 2025 19:33:15 +0200 Subject: [PATCH 59/82] Prove that OC is a subset of PropOC --- src/Vatras/Translation/Lang/OC-to-PropOC.agda | 76 +++++++++++++++++++ src/Vatras/Translation/LanguageMap.lagda.md | 6 ++ 2 files changed, 82 insertions(+) create mode 100644 src/Vatras/Translation/Lang/OC-to-PropOC.agda diff --git a/src/Vatras/Translation/Lang/OC-to-PropOC.agda b/src/Vatras/Translation/Lang/OC-to-PropOC.agda new file mode 100644 index 00000000..e1cb5002 --- /dev/null +++ b/src/Vatras/Translation/Lang/OC-to-PropOC.agda @@ -0,0 +1,76 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) + +module Vatras.Translation.Lang.OC-to-PropOC (F : 𝔽) where + +open import Data.Bool using (if_then_else_) +open import Data.List as List using (List) +import Data.List.Properties as List +open import Data.Maybe using (nothing; just) +open import Function using (flip; id) +open import Size using (Size; ∞) +open import Relation.Binary.PropositionalEquality as Eq using (_≗_) + +open import Vatras.Data.EqIndexedSet using (_≅[_][_]_; ≗→≅[]; ≅[]-sym) +open import Vatras.Data.Prop using (var) +open import Vatras.Framework.Compiler using (LanguageCompiler) +open import Vatras.Framework.Relation.Function using (from; to) +open import Vatras.Framework.Variants as V using (Rose) +open import Vatras.Framework.Relation.Expressiveness (Rose ∞) using (expressiveness-from-compiler; _≽_) +open import Vatras.Lang.All +open OC using (OC; WFOC; WFOCL; Root; _-<_>-; _❲_❳) +open PropOC using (PropOC; WFPropOC; WFPropOCL) + +translate' : ∀ {i : Size} {A : 𝔸} → OC F i A → PropOC F i A +translate' (a -< cs >-) = a -< List.map translate' cs >- +translate' (f ❲ c ❳) = var f ❲ translate' c ❳ + +translate : ∀ {i : Size} {A : 𝔸} → WFOC F i A → WFPropOC F i A +translate (Root a cs) = Root a (List.map translate' cs) + +translate'-preserves-≗ + : ∀ {i : Size} {A : 𝔸} + → (e : OC F i A) + → PropOC.⟦ translate' e ⟧ₒ ≗ OC.⟦ e ⟧ₒ + +translate'-preserves-≗-recurse : ∀ {i : Size} {A : 𝔸} + → (cs : List (OC F i A)) + → PropOC.⟦ List.map translate' cs ⟧ₒ-recurse ≗ OC.⟦ cs ⟧ₒ-recurse + +translate'-preserves-≗ (a -< cs >-) assignment = Eq.cong (λ x → just (a V.-< x >-)) (translate'-preserves-≗-recurse cs assignment) +translate'-preserves-≗ (f ❲ c ❳) assignment = Eq.cong (if assignment f then_else nothing) (translate'-preserves-≗ c assignment) + +translate'-preserves-≗-recurse cs assignment = + begin + PropOC.⟦ List.map translate' cs ⟧ₒ-recurse assignment + ≡⟨⟩ + List.catMaybes (List.map (flip PropOC.⟦_⟧ₒ assignment) (List.map translate' cs)) + ≡⟨ Eq.cong List.catMaybes (List.map-∘ cs) ⟨ + List.catMaybes (List.map (λ e → PropOC.⟦ translate' e ⟧ₒ assignment) cs) + ≡⟨ Eq.cong List.catMaybes (List.map-cong (flip translate'-preserves-≗ assignment) cs) ⟩ + List.catMaybes (List.map (flip OC.⟦_⟧ₒ assignment) cs) + ≡⟨⟩ + OC.⟦ cs ⟧ₒ-recurse assignment + ∎ + where + open Eq.≡-Reasoning + +translate-preserves-≗ + : ∀ {i : Size} {A : 𝔸} + → (e : WFOC F i A) + → PropOC.⟦ translate e ⟧ ≗ OC.⟦ e ⟧ +translate-preserves-≗ (Root a cs) assignment = Eq.cong (a V.-<_>-) (translate'-preserves-≗-recurse cs assignment) + +translate-preserves + : ∀ {i : Size} {A : 𝔸} + → (e : WFOC F i A) + → PropOC.⟦ translate e ⟧ ≅[ id ][ id ] OC.⟦ e ⟧ +translate-preserves e = ≗→≅[] (translate-preserves-≗ e) + +OC→PropOC : LanguageCompiler (WFOCL F) (WFPropOCL F) +OC→PropOC .LanguageCompiler.compile = translate +OC→PropOC .LanguageCompiler.config-compiler e .to = id +OC→PropOC .LanguageCompiler.config-compiler e .from = id +OC→PropOC .LanguageCompiler.preserves e = ≅[]-sym (translate-preserves e) + +PropOC≽OC : WFPropOCL F ≽ WFOCL F +PropOC≽OC = expressiveness-from-compiler OC→PropOC diff --git a/src/Vatras/Translation/LanguageMap.lagda.md b/src/Vatras/Translation/LanguageMap.lagda.md index 517f18ed..3c825366 100644 --- a/src/Vatras/Translation/LanguageMap.lagda.md +++ b/src/Vatras/Translation/LanguageMap.lagda.md @@ -53,6 +53,7 @@ open ADT using (ADTL) open OC using (WFOCL) open FST using (FSTL) open VT using (VTL) +open PropOC using (WFPropOCL) open import Vatras.Lang.CCC.Encode using () renaming (encoder to CCC-Rose-encoder) open import Vatras.Translation.Lang.NCC.Rename using (NCC-rename≽NCC) @@ -81,6 +82,7 @@ import Vatras.Translation.Lang.FST-to-OC as FST-to-OC import Vatras.Translation.Lang.FST-to-VariantList as FST-to-VariantList import Vatras.Translation.Lang.VariantList-to-VT as VariantList-to-VT import Vatras.Translation.Lang.VT-to-ADT as VT-to-ADT +import Vatras.Translation.Lang.OC-to-PropOC as OC-to-PropOC ``` @@ -231,6 +233,10 @@ module Expressiveness {F : 𝔽} (f : F × ℕ → F) (f⁻¹ : F → F × ℕ) 2CC≽FST D _==_ = ≽-trans 2CC≽CCC (≽-trans (CCC≽VariantList D) (VariantList≽FST _==_)) + PropOC≽OC : WFPropOCL F ≽ WFOCL F + PropOC≽OC = OC-to-PropOC.PropOC≽OC F + + CCC≋NCC : ∀ (n : ℕ≥ 2) → CCCL F ≋ NCCL F n CCC≋NCC n = CCC≽NCC n , NCC≽CCC n From 69a2e6f5de37dea8f5a11fa546924b94ff660589 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 9 Sep 2025 19:34:48 +0200 Subject: [PATCH 60/82] Prove that PropOC is at least as succinct as OC --- .../Relations/PropOC\342\211\244OC.agda" | 89 +++++++++++++++++++ src/Vatras/Succinctness/Sizes.agda | 26 ++++++ 2 files changed, 115 insertions(+) create mode 100644 "src/Vatras/Succinctness/Relations/PropOC\342\211\244OC.agda" diff --git "a/src/Vatras/Succinctness/Relations/PropOC\342\211\244OC.agda" "b/src/Vatras/Succinctness/Relations/PropOC\342\211\244OC.agda" new file mode 100644 index 00000000..2181860a --- /dev/null +++ "b/src/Vatras/Succinctness/Relations/PropOC\342\211\244OC.agda" @@ -0,0 +1,89 @@ +open import Vatras.Framework.Definitions using (𝔽; 𝔸; atomSize) + +module Vatras.Succinctness.Relations.PropOC≤OC (F : 𝔽) where + +import Data.List as List +import Data.List.Properties as List +open import Data.Nat using (_+_; _*_; _≤_; z≤n; s≤s) +import Data.Nat.Properties as ℕ +open import Data.Product using (_,_) +open import Function using (_∘_) +open import Size using (Size; ∞) +import Relation.Binary.PropositionalEquality as Eq + +import Vatras.Util.List as List +open import Vatras.Data.EqIndexedSet using (≅[]→≅) +open import Vatras.Data.Prop using (var) +open import Vatras.Framework.Variants as V using (Rose) +open import Vatras.Succinctness.Sizes using (sizeProp; SizedWFOC; sizeOC; sizeWFOC; SizedWFPropOC; sizePropOC; sizeWFPropOC) +open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≤ₛ_) +import Vatras.Lang.All +open Vatras.Lang.All.OC using (OC; WFOC; Root; _-<_>-; _❲_❳) +open import Vatras.Translation.Lang.OC-to-PropOC F using (translate; translate'; translate-preserves) + +prop-oc≤oc : ∀ {i : Size} {A : 𝔸} (oc : OC F i A) → sizePropOC (translate' oc) ≤ 2 * sizeOC oc +prop-oc≤oc {A = A} (a -< cs >-) = + begin + sizePropOC (translate' (a -< cs >-)) + ≡⟨⟩ + 1 + (atomSize A a + List.sum (List.map sizePropOC (List.map translate' cs))) + ≡⟨ Eq.cong (λ x → 1 + (atomSize A a + List.sum x)) (List.map-∘ cs) ⟨ + 1 + (atomSize A a + List.sum (List.map (sizePropOC ∘ translate') cs)) + ≤⟨ ℕ.+-monoʳ-≤ 1 (ℕ.+-monoʳ-≤ (atomSize A a) (List.sum-map-≤ (sizePropOC ∘ translate') ((2 *_) ∘ sizeOC) cs prop-oc≤oc)) ⟩ + 1 + (atomSize A a + List.sum (List.map ((2 *_) ∘ sizeOC) cs)) + ≡⟨ Eq.cong (λ x → 1 + (atomSize A a + List.sum x)) (List.map-∘ cs) ⟩ + 1 + (atomSize A a + List.sum (List.map (2 *_) (List.map sizeOC cs))) + ≡⟨ Eq.cong (λ x → 1 + (atomSize A a + x)) (List.sum-* 2 (List.map sizeOC cs)) ⟩ + 1 + (atomSize A a + 2 * List.sum (List.map sizeOC cs)) + ≡⟨ Eq.cong (λ x → 1 + (x + 2 * List.sum (List.map sizeOC cs))) (ℕ.*-identityˡ (atomSize A a)) ⟨ + 1 + (1 * atomSize A a + 2 * List.sum (List.map sizeOC cs)) + ≤⟨ ℕ.+-monoʳ-≤ 1 (ℕ.+-monoˡ-≤ (2 * List.sum (List.map sizeOC cs)) (ℕ.*-monoˡ-≤ (atomSize A a) (s≤s (z≤n {1})))) ⟩ + 1 + (2 * atomSize A a + 2 * List.sum (List.map sizeOC cs)) + ≤⟨ ℕ.+-monoˡ-≤ (2 * atomSize A a + 2 * List.sum (List.map sizeOC cs)) (s≤s (z≤n {1})) ⟩ + 2 + (2 * atomSize A a + 2 * List.sum (List.map sizeOC cs)) + ≡⟨ Eq.cong (2 +_) (ℕ.*-distribˡ-+ 2 (atomSize A a) (List.sum (List.map sizeOC cs))) ⟨ + 2 + 2 * (atomSize A a + List.sum (List.map sizeOC cs)) + ≡⟨ ℕ.*-distribˡ-+ 2 1 (atomSize A a + List.sum (List.map sizeOC cs)) ⟨ + 2 * (1 + (atomSize A a + List.sum (List.map sizeOC cs))) + ≡⟨⟩ + 2 * sizeOC (a -< cs >-) + ∎ + where + open ℕ.≤-Reasoning +prop-oc≤oc (prop ❲ c ❳) = + begin + sizePropOC (translate' (prop ❲ c ❳)) + ≡⟨⟩ + 1 + (sizeProp (var prop) + sizePropOC (translate' c)) + ≡⟨⟩ + 2 + sizePropOC (translate' c) + ≤⟨ ℕ.+-monoʳ-≤ 2 (prop-oc≤oc c) ⟩ + 2 + 2 * sizeOC c + ≡⟨ ℕ.*-distribˡ-+ 2 1 (sizeOC c) ⟨ + 2 * (1 + sizeOC c) + ≡⟨⟩ + 2 * sizeOC (prop ❲ c ❳) + ∎ + where + open ℕ.≤-Reasoning + +wf-prop-oc≤wf-oc : ∀ {i : Size} {A : 𝔸} (oc : WFOC F i A) → sizeWFPropOC (translate oc) ≤ 2 * sizeWFOC oc +wf-prop-oc≤wf-oc {A = A} (Root a cs) = + begin + sizeWFPropOC (translate (Root a cs)) + ≡⟨⟩ + 1 + (atomSize A a + List.sum (List.map sizePropOC (List.map translate' cs))) + ≡⟨⟩ + sizePropOC (translate' (a -< cs >-)) + ≤⟨ prop-oc≤oc (a -< cs >-) ⟩ + 2 * sizeOC (a -< cs >-) + ≡⟨⟩ + 2 * (1 + (atomSize A a + List.sum (List.map sizeOC cs))) + ≡⟨⟩ + 2 * sizeWFOC (Root a cs) + ∎ + where + open ℕ.≤-Reasoning + +WFPropOC≤ₛWFOC : SizedWFPropOC F ≤ₛ SizedWFOC F +WFPropOC≤ₛWFOC = 2 , λ A oc oc-translatable → translate oc , ≅[]→≅ (translate-preserves oc) , wf-prop-oc≤wf-oc oc diff --git a/src/Vatras/Succinctness/Sizes.agda b/src/Vatras/Succinctness/Sizes.agda index fa65c82c..58e6c77d 100644 --- a/src/Vatras/Succinctness/Sizes.agda +++ b/src/Vatras/Succinctness/Sizes.agda @@ -8,6 +8,7 @@ import Data.Vec as Vec open import Function using (_∘_) open import Size using (Size; ∞) +open import Vatras.Data.Prop using (Prop; true; false; var; ¬_; _∧_) open import Vatras.Util.Nat.AtLeast using (ℕ≥) open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) open import Vatras.Framework.Variants using (Rose) @@ -93,6 +94,10 @@ sizeOC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → OC.OC F i A → ℕ sizeOC {A = A} (a OC.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeOC cs)) sizeOC (D OC.❲ c ❳) = suc (sizeOC c) +sizeOC>0 : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → (oc : OC.OC F i A) → sizeOC oc > 0 +sizeOC>0 (a OC.-< cs >-) = s≤s z≤n +sizeOC>0 (f OC.❲ c ❳) = s≤s z≤n + sizeWFOC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → OC.WFOC F i A → ℕ sizeWFOC {A = A} (OC.Root a cs) = suc (atomSize A a + List.sum (List.map sizeOC cs)) @@ -110,3 +115,24 @@ SizedFST F = record { Lang = FST.FSTL F ; size = sizeFST } + + +sizeProp : ∀ {F : 𝔽} → Prop F → ℕ +sizeProp true = 1 +sizeProp false = 1 +sizeProp (var v) = 1 +sizeProp (¬ e) = suc (sizeProp e) +sizeProp (e₁ ∧ e₂) = suc (sizeProp e₁ + sizeProp e₂) + +sizePropOC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → PropOC.PropOC F i A → ℕ +sizePropOC {A = A} (a PropOC.-< cs >-) = suc (atomSize A a + List.sum (List.map sizePropOC cs)) +sizePropOC (prop PropOC.❲ c ❳) = suc (sizeProp prop + sizePropOC c) + +sizeWFPropOC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → PropOC.WFPropOC F i A → ℕ +sizeWFPropOC {A = A} (PropOC.Root a cs) = suc (atomSize A a + List.sum (List.map sizePropOC cs)) + +SizedWFPropOC : 𝔽 → SizedLang (Rose ∞) +SizedWFPropOC F = record + { Lang = PropOC.WFPropOCL F + ; size = sizeWFPropOC + } From b3c4d3bf76cbc2c88812238b1ebc77ab492dc964 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Thu, 18 Sep 2025 18:19:37 +0200 Subject: [PATCH 61/82] Remove annoying module prefixes in 2CC-; 2CCL) +open ADT using (ADT; _⟨_,_⟩; leaf; ADTL) open import Vatras.Translation.Lang.2CC-to-ADT using (ADT≽2CC) open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≰ₛ_; _<ₛ_) open import Vatras.Succinctness.Sizes using (Sized2CC; size2CC; SizedADT; sizeADT; sizeRose) open import Vatras.Succinctness.Relations.2CC≤ADT ℕ using (2CC≤ADT) -e₁-cs : ℕ → ℕ → List (2CC.2CC ∞ NAT') +e₁-cs : ℕ → ℕ → List (2CC ∞ NAT') e₁-cs zero D = [] -e₁-cs (suc n) D = D 2CC.2CC.⟨ 0 2CC.2CC.-< [] >- , 1 2CC.2CC.-< [] >- ⟩ ∷ e₁-cs n (suc D) +e₁-cs (suc n) D = D ⟨ 0 -< [] >- , 1 -< [] >- ⟩ ∷ e₁-cs n (suc D) -e₁ : ℕ → 2CC.2CC ∞ NAT' -e₁ n = 0 2CC.2CC.-< e₁-cs n zero >- +e₁ : ℕ → 2CC ∞ NAT' +e₁ n = 0 -< e₁-cs n zero >- size-e₁-cs : ∀ n D → List.sum (List.map size2CC (e₁-cs n D)) ≡ n * 3 size-e₁-cs zero D = refl @@ -93,11 +95,11 @@ variants⊆e₁ n i = config n i' , Eq.cong (0 Rose.-<_>-) (go n i' zero λ o ≡⟨ Eq.cong (0 Rose.-< [] >- ∷_) (go m (Fin.fromℕ< k<2^m) (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-<2^m m j o k<2^m))) ⟩ 0 Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - (if true then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) - ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ - (if config n i' D then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + (if true then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ + (if config n i' D then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - 2CC.⟦ D 2CC.2CC.⟨ 0 2CC.2CC.-< [] >- , 1 2CC.2CC.-< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + 2CC.⟦ D ⟨ 0 -< [] >- , 1 -< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ∎ ... | no k≮2^m | p' = begin @@ -105,26 +107,26 @@ variants⊆e₁ n i = config n i' , Eq.cong (0 Rose.-<_>-) (go n i' zero λ o ≡⟨ Eq.cong (1 Rose.-< [] >- ∷_) (go m j' (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-≮2^m m j o k≮2^m))) ⟩ 1 Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - (if false then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) - ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ - (if config n i' D then 2CC.⟦ 0 2CC.2CC.-< [] >- ⟧ (config n i') else 2CC.⟦ 1 2CC.2CC.-< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + (if false then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ + (if config n i' D then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ≡⟨⟩ - 2CC.⟦ D 2CC.2CC.⟨ 0 2CC.2CC.-< [] >- , 1 2CC.2CC.-< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + 2CC.⟦ D ⟨ 0 -< [] >- , 1 -< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) ∎ where j' = Eq.subst Fin (ℕ.+-identityʳ (2 ^ m)) (Fin.reduce≥ j (ℕ.≮⇒≥ k≮2^m)) -ADT-leafs : ADT.ADT NAT' → List⁺ (Rose ∞ NAT') -ADT-leafs (ADT.ADT.leaf v) = v ∷ [] -ADT-leafs (D ADT.ADT.⟨ l , r ⟩) = ADT-leafs l List⁺.⁺++⁺ ADT-leafs r +ADT-leafs : ADT NAT' → List⁺ (Rose ∞ NAT') +ADT-leafs (leaf v) = v ∷ [] +ADT-leafs (D ⟨ l , r ⟩) = ADT-leafs l List⁺.⁺++⁺ ADT-leafs r -ADT-leaf-count : ADT.ADT NAT' → ℕ +ADT-leaf-count : ADT NAT' → ℕ ADT-leaf-count e₂ = List⁺.length (ADT-leafs e₂) -ADT-leaf-count-lemma : ∀ D → (l r : ADT.ADT NAT') → ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) ≡ ADT-leaf-count l + ADT-leaf-count r +ADT-leaf-count-lemma : ∀ D → (l r : ADT NAT') → ADT-leaf-count (D ⟨ l , r ⟩) ≡ ADT-leaf-count l + ADT-leaf-count r ADT-leaf-count-lemma D l r = begin - ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) + ADT-leaf-count (D ⟨ l , r ⟩) ≡⟨⟩ List⁺.length (ADT-leafs l List⁺.⁺++⁺ ADT-leafs r) ≡⟨ Eq.cong List.length (List⁺.toList-⁺++⁺ (ADT-leafs l) (ADT-leafs r)) ⟨ @@ -135,11 +137,11 @@ ADT-leaf-count-lemma D l r = where open Eq.≡-Reasoning -leafs-≤-size : (e₂ : ADT.ADT NAT') → ADT-leaf-count e₂ ≤ sizeADT sizeRose e₂ -leafs-≤-size (ADT.ADT.leaf v) = s≤s z≤n -leafs-≤-size (D ADT.ADT.⟨ l , r ⟩) = +leafs-≤-size : (e₂ : ADT NAT') → ADT-leaf-count e₂ ≤ sizeADT sizeRose e₂ +leafs-≤-size (leaf v) = s≤s z≤n +leafs-≤-size (D ⟨ l , r ⟩) = begin - ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) + ADT-leaf-count (D ⟨ l , r ⟩) ≡⟨ ADT-leaf-count-lemma D l r ⟩ ADT-leaf-count l + ADT-leaf-count r ≤⟨ ℕ.+-monoʳ-≤ (ADT-leaf-count l) (leafs-≤-size r) ⟩ @@ -161,25 +163,25 @@ _≟ᵥ_ : ∀ {i} → (v₁ v₂ : Rose i NAT') → Dec (v₁ ≡ v₂) (a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | yes a₁≡a₂ | no cs₁≢cs₂ = no (λ where refl → cs₁≢cs₂ refl) (a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | yes refl | yes refl = yes refl -ADT-leaf-count≤ₗ : ∀ D l r → ADT-leaf-count l ≤ ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) +ADT-leaf-count≤ₗ : ∀ D l r → ADT-leaf-count l ≤ ADT-leaf-count (D ⟨ l , r ⟩) ADT-leaf-count≤ₗ D l r = begin ADT-leaf-count l ≤⟨ ℕ.m≤m+n (ADT-leaf-count l) (ADT-leaf-count r) ⟩ ADT-leaf-count l + ADT-leaf-count r ≡⟨ ADT-leaf-count-lemma D l r ⟨ - ADT-leaf-count (D ADT.ADT.⟨ l , r ⟩) + ADT-leaf-count (D ⟨ l , r ⟩) ∎ where open ℕ.≤-Reasoning ADT-leaf∈⟦⟧ : ∀ v e₂ → v ∈ ADT.⟦ e₂ ⟧ → v ∈ listToIndexedSet (ADT-leafs e₂) -ADT-leaf∈⟦⟧ v (ADT.ADT.leaf .v) (c , refl) = zero , refl -ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) with c D -ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | true with ADT-leaf∈⟦⟧ v l (c , p) -ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | true | (i , p') = Fin.inject≤ i (ADT-leaf-count≤ₗ D l r) , Eq.trans p' (List.lookup-++ᵣ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) -ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | false with ADT-leaf∈⟦⟧ v r (c , p) -ADT-leaf∈⟦⟧ v (D ADT.ADT.⟨ l , r ⟩) (c , p) | false | (i , p') = (Fin.cast (Eq.sym (ADT-leaf-count-lemma D l r)) (ADT-leaf-count l Fin.↑ʳ i)) , Eq.trans p' (List.lookup-++ₗ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) +ADT-leaf∈⟦⟧ v (leaf .v) (c , refl) = zero , refl +ADT-leaf∈⟦⟧ v (D ⟨ l , r ⟩) (c , p) with c D +ADT-leaf∈⟦⟧ v (D ⟨ l , r ⟩) (c , p) | true with ADT-leaf∈⟦⟧ v l (c , p) +ADT-leaf∈⟦⟧ v (D ⟨ l , r ⟩) (c , p) | true | (i , p') = Fin.inject≤ i (ADT-leaf-count≤ₗ D l r) , Eq.trans p' (List.lookup-++ᵣ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) +ADT-leaf∈⟦⟧ v (D ⟨ l , r ⟩) (c , p) | false with ADT-leaf∈⟦⟧ v r (c , p) +ADT-leaf∈⟦⟧ v (D ⟨ l , r ⟩) (c , p) | false | (i , p') = (Fin.cast (Eq.sym (ADT-leaf-count-lemma D l r)) (ADT-leaf-count l Fin.↑ʳ i)) , Eq.trans p' (List.lookup-++ₗ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) ADT-leaf⊆⟦⟧ : ∀ e₂ → ADT.⟦ e₂ ⟧ ⊆ listToIndexedSet (ADT-leafs e₂) ADT-leaf⊆⟦⟧ e₂ i = ADT-leaf∈⟦⟧ (ADT.⟦ e₂ ⟧ i) e₂ (i , refl) @@ -286,9 +288,9 @@ variants⊆e₂⇒2^n≤e₂ n e₂ variants⊆e₂ = 16 ^ (1 + n) ∎ -lemma : ∀ n e₂ → ADT.ADTL , 2CC.2CCL ⊢ e₂ ≣ e₁ (4 * n) → n * size2CC (e₁ (4 * n)) < sizeADT sizeRose e₂ -lemma zero (ADT.ADT.leaf v) (e₂⊆e₁ , e₁⊆e₂) = s≤s z≤n -lemma zero (D ADT.ADT.⟨ l , r ⟩) (e₂⊆e₁ , e₁⊆e₂) = s≤s z≤n +lemma : ∀ n e₂ → ADTL , 2CCL ⊢ e₂ ≣ e₁ (4 * n) → n * size2CC (e₁ (4 * n)) < sizeADT sizeRose e₂ +lemma zero (leaf v) (e₂⊆e₁ , e₁⊆e₂) = s≤s z≤n +lemma zero (D ⟨ l , r ⟩) (e₂⊆e₁ , e₁⊆e₂) = s≤s z≤n lemma (suc m) e₂ (e₂⊆e₁ , e₁⊆e₂) = begin-strict n * size2CC (e₁ (4 * n)) From 929713331c39334813a5e6b5aaf61d237a4d2c12 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Thu, 4 Dec 2025 21:22:07 +0100 Subject: [PATCH 62/82] Generalize the coarseness of 2CC < ADT --- src/Vatras/Data/IndexedSet.lagda.md | 12 + src/Vatras/Lang/2CC/FixedArtifactLength.agda | 2 +- src/Vatras/Succinctness/ProofDefinition.agda | 15 + .../Succinctness/Relations/2CCe₂ = A , e₂ , e₂-translatable , λ e₁ e₁≅e₂ → + begin-strict + n * f (size L₂ e₂) + ≤⟨ ℕ.*-monoʳ-≤ n (f≤g (size L₂ e₂)) ⟩ + n * (m * g (size L₂ e₂)) + ≡⟨ ℕ.*-assoc n m (g (size L₂ e₂)) ⟨ + (n * m) * g (size L₂ e₂) + <⟨ >e₂ e₁ e₁≅e₂ ⟩ + size L₁ e₁ + ∎ + where + open ℕ.≤-Reasoning + open Axiom.ExcludedMiddle using (ExcludedMiddle) open Axiom.DoubleNegationElimination using (em⇒dne) module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where diff --git a/src/Vatras/Succinctness/Relations/2CC-; 2CCL) open ADT using (ADT; _⟨_,_⟩; leaf; ADTL) open import Vatras.Translation.Lang.2CC-to-ADT using (ADT≽2CC) -open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≰ₛ_; _<ₛ_) +open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≰ₛ[_]_; _<ₛ_; ≰ₛ-strengthening) open import Vatras.Succinctness.Sizes using (Sized2CC; size2CC; SizedADT; sizeADT; sizeRose) open import Vatras.Succinctness.Relations.2CC≤ADT ℕ using (2CC≤ADT) @@ -116,76 +116,6 @@ variants⊆e₁ n i = config n i' , Eq.cong (0 Rose.-<_>-) (go n i' zero λ o where j' = Eq.subst Fin (ℕ.+-identityʳ (2 ^ m)) (Fin.reduce≥ j (ℕ.≮⇒≥ k≮2^m)) -ADT-leafs : ADT NAT' → List⁺ (Rose ∞ NAT') -ADT-leafs (leaf v) = v ∷ [] -ADT-leafs (D ⟨ l , r ⟩) = ADT-leafs l List⁺.⁺++⁺ ADT-leafs r - -ADT-leaf-count : ADT NAT' → ℕ -ADT-leaf-count e₂ = List⁺.length (ADT-leafs e₂) - -ADT-leaf-count-lemma : ∀ D → (l r : ADT NAT') → ADT-leaf-count (D ⟨ l , r ⟩) ≡ ADT-leaf-count l + ADT-leaf-count r -ADT-leaf-count-lemma D l r = - begin - ADT-leaf-count (D ⟨ l , r ⟩) - ≡⟨⟩ - List⁺.length (ADT-leafs l List⁺.⁺++⁺ ADT-leafs r) - ≡⟨ Eq.cong List.length (List⁺.toList-⁺++⁺ (ADT-leafs l) (ADT-leafs r)) ⟨ - List.length (List⁺.toList (ADT-leafs l) List.++ List⁺.toList (ADT-leafs r)) - ≡⟨ List.length-++ (List⁺.toList (ADT-leafs l)) ⟩ - ADT-leaf-count l + ADT-leaf-count r - ∎ - where - open Eq.≡-Reasoning - -leafs-≤-size : (e₂ : ADT NAT') → ADT-leaf-count e₂ ≤ sizeADT sizeRose e₂ -leafs-≤-size (leaf v) = s≤s z≤n -leafs-≤-size (D ⟨ l , r ⟩) = - begin - ADT-leaf-count (D ⟨ l , r ⟩) - ≡⟨ ADT-leaf-count-lemma D l r ⟩ - ADT-leaf-count l + ADT-leaf-count r - ≤⟨ ℕ.+-monoʳ-≤ (ADT-leaf-count l) (leafs-≤-size r) ⟩ - ADT-leaf-count l + sizeADT sizeRose r - ≤⟨ ℕ.+-monoˡ-≤ (sizeADT sizeRose r) (leafs-≤-size l) ⟩ - sizeADT sizeRose l + sizeADT sizeRose r - <⟨ ℕ.n<1+n (sizeADT sizeRose l + sizeADT sizeRose r) ⟩ - suc (sizeADT sizeRose l + sizeADT sizeRose r) - ∎ - where - open ℕ.≤-Reasoning - -listToIndexedSet : (vs : List⁺ (Rose ∞ NAT')) → VariantGenerator (pred (List⁺.length vs)) -listToIndexedSet vs i = List.lookup (List⁺.toList vs) (Eq.subst Fin (ℕ.suc-pred (List⁺.length vs)) i) - -_≟ᵥ_ : ∀ {i} → (v₁ v₂ : Rose i NAT') → Dec (v₁ ≡ v₂) -(a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) with a₁ ℕ.≟ a₂ | List.≡-dec _≟ᵥ_ cs₁ cs₂ -(a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | no a₁≢a₂ | _ = no λ where refl → a₁≢a₂ refl -(a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | yes a₁≡a₂ | no cs₁≢cs₂ = no (λ where refl → cs₁≢cs₂ refl) -(a₁ Rose.-< cs₁ >-) ≟ᵥ (a₂ Rose.-< cs₂ >-) | yes refl | yes refl = yes refl - -ADT-leaf-count≤ₗ : ∀ D l r → ADT-leaf-count l ≤ ADT-leaf-count (D ⟨ l , r ⟩) -ADT-leaf-count≤ₗ D l r = - begin - ADT-leaf-count l - ≤⟨ ℕ.m≤m+n (ADT-leaf-count l) (ADT-leaf-count r) ⟩ - ADT-leaf-count l + ADT-leaf-count r - ≡⟨ ADT-leaf-count-lemma D l r ⟨ - ADT-leaf-count (D ⟨ l , r ⟩) - ∎ - where - open ℕ.≤-Reasoning - -ADT-leaf∈⟦⟧ : ∀ v e₂ → v ∈ ADT.⟦ e₂ ⟧ → v ∈ listToIndexedSet (ADT-leafs e₂) -ADT-leaf∈⟦⟧ v (leaf .v) (c , refl) = zero , refl -ADT-leaf∈⟦⟧ v (D ⟨ l , r ⟩) (c , p) with c D -ADT-leaf∈⟦⟧ v (D ⟨ l , r ⟩) (c , p) | true with ADT-leaf∈⟦⟧ v l (c , p) -ADT-leaf∈⟦⟧ v (D ⟨ l , r ⟩) (c , p) | true | (i , p') = Fin.inject≤ i (ADT-leaf-count≤ₗ D l r) , Eq.trans p' (List.lookup-++ᵣ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) -ADT-leaf∈⟦⟧ v (D ⟨ l , r ⟩) (c , p) | false with ADT-leaf∈⟦⟧ v r (c , p) -ADT-leaf∈⟦⟧ v (D ⟨ l , r ⟩) (c , p) | false | (i , p') = (Fin.cast (Eq.sym (ADT-leaf-count-lemma D l r)) (ADT-leaf-count l Fin.↑ʳ i)) , Eq.trans p' (List.lookup-++ₗ (List⁺.toList (ADT-leafs l)) (List⁺.toList (ADT-leafs r)) i) - -ADT-leaf⊆⟦⟧ : ∀ e₂ → ADT.⟦ e₂ ⟧ ⊆ listToIndexedSet (ADT-leafs e₂) -ADT-leaf⊆⟦⟧ e₂ i = ADT-leaf∈⟦⟧ (ADT.⟦ e₂ ⟧ i) e₂ (i , refl) - Fin-reduce≥-injective : ∀ {m n} (i : Fin (m + n)) (j : Fin (m + n)) (m≤i : m ≤ Fin.toℕ i) (m≤j : m ≤ Fin.toℕ j) → Fin.reduce≥ i m≤i ≡ Fin.reduce≥ j m≤j → i ≡ j Fin-reduce≥-injective {zero} {.(suc _)} zero j m≤i m≤j i≡j = i≡j Fin-reduce≥-injective {zero} {.(suc _)} (suc i) j m≤i m≤j i≡j = i≡j @@ -206,33 +136,66 @@ variants-unique n = AllPairs.tabulate⁺ {f = variants n} go go : {i j : Fin (suc (pred (2 ^ n)))} → i ≢ j → variants n i ≢ variants n j go {i} {j} i≢j vs-i≡vs-j = variants-cs-unique n (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i) (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) j) (i≢j ∘ Eq.subst-injective (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}})) (proj₂ (Rose-injective vs-i≡vs-j)) -IndexedSet-⊆⇒List-⊆ : ∀ {n} (gen : VariantGenerator n) (l : List⁺ (Rose ∞ NAT')) → gen ⊆ listToIndexedSet l → List.tabulate gen List.⊆ List⁺.toList l -IndexedSet-⊆⇒List-⊆ gen l gen⊆l {x} (here refl) with gen⊆l zero -... | i , x∈l = Eq.subst (List._∈ (List⁺.toList l)) (Eq.sym x∈l) (List.∈-lookup {xs = List⁺.toList l} i) -IndexedSet-⊆⇒List-⊆ {suc n} gen l gen⊆l {x} (there x∈gen) = IndexedSet-⊆⇒List-⊆ {n} (gen ∘ suc) l (gen⊆l ∘ suc) x∈gen - -variants⊆⇒2^n≤ : ∀ n l → variants n ⊆ listToIndexedSet l → 2 ^ n ≤ List⁺.length l -variants⊆⇒2^n≤ n l variants⊆l = +partition-choice-variants : + ∀ (D : ℕ) + → (l r : ADT NAT') + → (vs : List (Rose ∞ NAT')) + → Unique vs + → List.lookup vs ⊆ ADT.⟦ D ⟨ l , r ⟩ ⟧ + → Σ[ vs₁ ∈ List (Rose ∞ NAT') ] + Σ[ vs₂ ∈ List (Rose ∞ NAT') ] + Interleaving vs₁ vs₂ vs + × Unique vs₁ + × Unique vs₂ + × List.lookup vs₁ ⊆ ADT.⟦ l ⟧ + × List.lookup vs₂ ⊆ ADT.⟦ r ⟧ +partition-choice-variants D l r [] unique-vs vs⊆adt = [] , [] , [] , [] , [] , (λ where ()) , (λ where ()) +partition-choice-variants D l r (v ∷ vs) (v∉vs ∷ unique-vs) vs⊆adt + with partition-choice-variants D l r vs unique-vs (vs⊆adt ∘ suc) +... | vs₁ , vs₂ , is-interleaving , unique-vs₁ , unique-vs₂ , vs₁⊆l , vs₂⊆r + with vs⊆adt zero +... | config , v∈adt + with config D +... | true = v ∷ vs₁ , vs₂ , consˡ is-interleaving , List.All-Interleavingₗ is-interleaving v∉vs ∷ unique-vs₁ , unique-vs₂ , (λ where + zero → config , v∈adt + (suc n) → vs₁⊆l n) , vs₂⊆r +... | false = vs₁ , v ∷ vs₂ , consʳ is-interleaving , unique-vs₁ , List.All-Interleavingᵣ is-interleaving v∉vs ∷ unique-vs₂ , vs₁⊆l , (λ where + zero → config , v∈adt + (suc n) → vs₂⊆r n) + +minimal-adt-size : + ∀ (adt : ADT NAT') + → (vs : List (Rose ∞ NAT')) + → Unique vs + → List.lookup vs ⊆ ADT.⟦ adt ⟧ + → List.sum (List.map sizeRose vs) ≤ sizeADT sizeRose adt +minimal-adt-size (leaf v) [] unique-vs vs⊆adt = z≤n +minimal-adt-size (leaf v) (v' ∷ []) unique-vs vs⊆adt with proj₂ (vs⊆adt zero) +minimal-adt-size (leaf v) (v ∷ []) unique-vs vs⊆adt | refl = begin - 2 ^ n - ≡⟨ ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}} ⟨ - suc (pred (2 ^ n)) - ≡⟨ List.length-tabulate (variants n) ⟨ - List.length (List.tabulate (variants n)) - ≤⟨ List.length≤ (List.tabulate (variants n)) (List⁺.toList l) (variants-unique n) (IndexedSet-⊆⇒List-⊆ (variants n) l variants⊆l) ⟩ - List⁺.length l + List.sum (List.map sizeRose (v ∷ [])) + ≡⟨⟩ + sizeRose v + 0 + ≡⟨ ℕ.+-identityʳ (sizeRose v) ⟩ + sizeRose v + <⟨ ℕ.≤-refl ⟩ + suc (sizeRose v) ∎ where open ℕ.≤-Reasoning - -variants⊆e₂⇒2^n≤e₂ : ∀ n e₂ → variants n ⊆ ADT.⟦ e₂ ⟧ → 2 ^ n ≤ sizeADT sizeRose e₂ -variants⊆e₂⇒2^n≤e₂ n e₂ variants⊆e₂ = +minimal-adt-size (leaf v) (v₁ ∷ v₂ ∷ vs) ((v₁≢v₂ ∷ v₁∉vs) ∷ unique-vs) vs⊆adt = ⊥-elim (v₁≢v₂ (Eq.trans (proj₂ (vs⊆adt zero)) (Eq.sym (proj₂ (vs⊆adt (suc zero)))))) +minimal-adt-size (D ⟨ l , r ⟩) vs unique-vs vs⊆adt with partition-choice-variants D l r vs unique-vs vs⊆adt +minimal-adt-size (D ⟨ l , r ⟩) vs unique-vs vs⊆adt | vs₁ , vs₂ , is-interleaving , unique-vs₁ , unique-vs₂ , vs₁⊆l , vs₂⊆r = begin - 2 ^ n - ≤⟨ variants⊆⇒2^n≤ n (ADT-leafs e₂) (⊆-trans variants⊆e₂ (ADT-leaf⊆⟦⟧ e₂)) ⟩ - ADT-leaf-count e₂ - ≤⟨ leafs-≤-size e₂ ⟩ - sizeADT sizeRose e₂ + List.sum (List.map sizeRose vs) + ≡⟨ List.sum-Interleaving (List.map-Interleaving is-interleaving) ⟨ + List.sum (List.map sizeRose vs₁) + List.sum (List.map sizeRose vs₂) + ≤⟨ ℕ.+-mono-≤ (minimal-adt-size l vs₁ unique-vs₁ vs₁⊆l) (minimal-adt-size r vs₂ unique-vs₂ vs₂⊆r) ⟩ + sizeADT sizeRose l + sizeADT sizeRose r + <⟨ ℕ.≤-refl ⟩ + suc (sizeADT sizeRose l + sizeADT sizeRose r) + ≡⟨⟩ + sizeADT sizeRose (D ⟨ l , r ⟩) ∎ where open ℕ.≤-Reasoning @@ -288,45 +251,164 @@ variants⊆e₂⇒2^n≤e₂ n e₂ variants⊆e₂ = 16 ^ (1 + n) ∎ -lemma : ∀ n e₂ → ADTL , 2CCL ⊢ e₂ ≣ e₁ (4 * n) → n * size2CC (e₁ (4 * n)) < sizeADT sizeRose e₂ +sizeRose-variants-cs : ∀ n i → List.sum (List.map sizeRose (variants-cs n i)) ≡ n +sizeRose-variants-cs zero zero = refl +sizeRose-variants-cs (suc n) i with Fin.toℕ i -nonZero (ℕ.m^n>0 2 n)}}) i)) + +sizeRose∈variants : + ∀ (n : ℕ) + → (v : Rose ∞ NAT') + → v List.∈ List.tabulate (variants n) + → suc n ≡ sizeRose v +sizeRose∈variants n v v∈vs with List.∈-tabulate⁻ {f = variants n} v∈vs +sizeRose∈variants n v v∈vs | i , refl = Eq.sym (sizeRose-variants n i) + +lemma : ∀ n e₂ → ADTL , 2CCL ⊢ e₂ ≣ e₁ (3 * n) → n * 2 ^ (size2CC (e₁ (3 * n)) / 3) < sizeADT sizeRose e₂ lemma zero (leaf v) (e₂⊆e₁ , e₁⊆e₂) = s≤s z≤n lemma zero (D ⟨ l , r ⟩) (e₂⊆e₁ , e₁⊆e₂) = s≤s z≤n -lemma (suc m) e₂ (e₂⊆e₁ , e₁⊆e₂) = +lemma (suc k) e₂ (e₂⊆e₁ , e₁⊆e₂) = begin-strict - n * size2CC (e₁ (4 * n)) - ≡⟨ Eq.cong (n *_) (size-e₁ (4 * n)) ⟩ - n * (1 + (4 * n) * 3) - ≡⟨ ℕ.*-distribˡ-+ n 1 (4 * n * 3) ⟩ - n * 1 + n * (4 * n * 3) - ≡⟨ Eq.cong (_+ n * (4 * n * 3)) (ℕ.*-identityʳ n) ⟩ - n + n * (4 * n * 3) - ≡⟨ Eq.cong (λ x → n + n * (x * 3)) (ℕ.*-comm 4 n) ⟩ - n + n * (n * 4 * 3) - ≡⟨ Eq.cong (λ x → n + n * x) (ℕ.*-assoc n 4 3) ⟩ - n + n * (n * (4 * 3)) + n * 2 ^ (size2CC (e₁ m) / 3) + ≡⟨ Eq.cong (λ x → n * 2 ^ (x / 3)) (size-e₁ m) ⟩ + n * 2 ^ ((1 + m * 3) / 3) + ≤⟨ ℕ.*-monoʳ-≤ n (ℕ.^-monoʳ-≤ 2 (ℕ./-monoˡ-≤ 3 (ℕ.+-monoˡ-≤ (m * 3) (s≤s (z≤n {2}))))) ⟩ + n * 2 ^ ((3 + m * 3) / 3) + ≡⟨ Eq.cong (λ x → n * 2 ^ (x / 3)) (ℕ.*-distribʳ-+ 3 1 m) ⟨ + n * 2 ^ ((1 + m) * 3 / 3) + ≡⟨ Eq.cong (λ x → n * 2 ^ x) (ℕ.m*n/n≡m (1 + m) 3) ⟩ + n * 2 ^ (1 + m) ≡⟨⟩ - n + n * (n * 12) - ≡⟨ Eq.cong (n +_) (ℕ.*-assoc n n 12) ⟨ - n + n * n * 12 - ≤⟨ ℕ.+-monoˡ-≤ (n * n * 12) (ℕ.m≤m*n n n) ⟩ - n * n + n * n * 12 - ≡⟨ Eq.cong (n * n +_) (ℕ.*-comm (n * n) 12) ⟩ - n * n + 12 * (n * n) + n * (2 * 2 ^ m) + ≡⟨ ℕ.*-assoc n 2 (2 ^ m) ⟨ + n * 2 * 2 ^ m + <⟨ ℕ.*-monoˡ-< (2 ^ m) {{ℕ.>-nonZero (ℕ.m^n>0 2 m)}} (ℕ.*-monoʳ-< n (ℕ.≤-refl {3})) ⟩ + n * 3 * 2 ^ m + ≡⟨ Eq.cong (_* 2 ^ m) (ℕ.*-comm n 3) ⟩ + 3 * n * 2 ^ m ≡⟨⟩ - 13 * (n * n) - <⟨ 13*n^2<16^n n ⟩ - 16 ^ n - ≡⟨ ℕ.^-*-assoc 2 4 n ⟩ - 2 ^ (4 * n) - ≤⟨ variants⊆e₂⇒2^n≤e₂ (4 * n) e₂ (⊆-trans (variants⊆e₁ (4 * n)) e₁⊆e₂) ⟩ + m * 2 ^ m + ≤⟨ ℕ.*-monoˡ-≤ (2 ^ m) (ℕ.n≤1+n m) ⟩ + suc m * 2 ^ m + ≡⟨ Eq.cong (suc m *_) (ℕ.suc-pred (2 ^ m) {{ℕ.>-nonZero (ℕ.m^n>0 2 m)}}) ⟨ + suc m * suc (pred (2 ^ m)) + ≡⟨ Eq.cong (suc m *_) (List.length-tabulate (variants m)) ⟨ + suc m * List.length (List.tabulate (variants m)) + ≡⟨ List.sum-map-const (suc m) (List.tabulate (variants m)) ⟨ + List.sum (List.map (const (suc m)) (List.tabulate (variants m))) + ≡⟨ Eq.cong List.sum (List.map-cong-with∈ (List.tabulate (variants m)) (sizeRose∈variants m)) ⟩ + List.sum (List.map sizeRose (List.tabulate (variants m))) + ≤⟨ minimal-adt-size e₂ (List.tabulate (variants m)) (variants-unique m) (⊆-trans (IndexedSet.tabulate⁺ (variants⊆e₁ m)) e₁⊆e₂) ⟩ sizeADT sizeRose e₂ ∎ where open ℕ.≤-Reasoning - n = suc m + n = suc k + m = 3 * n + +ADT≰2CC : SizedADT ℕ (Rose ∞) sizeRose ≰ₛ[ (λ n → 2 ^ (n / 3)) ] Sized2CC ℕ +ADT≰2CC n = NAT' , e₁ (3 * n) , ADT≽2CC (e₁ (3 * n)) , lemma n + +2^n≥n : ∀ n → n ≤ 15 * 2 ^ (n / 3) +2^n≥n n with n ≤? 15 +2^n≥n n | yes n≤15 = + begin + n + ≤⟨ n≤15 ⟩ + 15 + ≤⟨ ℕ.m≤m*n 15 (2 ^ (n / 3)) {{ℕ.>-nonZero (ℕ.m^n>0 2 (n / 3))}} ⟩ + 15 * 2 ^ (n / 3) + ∎ + where + open ℕ.≤-Reasoning +2^n≥n n | no n≰15 = + begin + n + ≤⟨ All.wfRec <-wellFounded _ (λ n → 16 ≤ n → n ≤ 2 ^ (n / 3)) go n (ℕ.≰⇒> n≰15) ⟩ + 2 ^ (n / 3) + ≤⟨ ℕ.m≤n*m (2 ^ (n / 3)) 15 ⟩ + 15 * 2 ^ (n / 3) + ∎ + where + open ℕ.≤-Reasoning + + lemma' : ∀ n → 16 ≤ n → 2 ^ 5 * 2 ^ ((n ∸ 15) / 3) ≤ 2 ^ (n / 3) + lemma' n 16≤n = + begin + 2 ^ 5 * 2 ^ ((n ∸ 15) / 3) + ≡⟨ ℕ.^-distribˡ-+-* 2 5 ((n ∸ 15) / 3) ⟨ + 2 ^ (5 + (n ∸ 15) / 3) + ≡⟨ Eq.cong (2 ^_) (ℕ.+-distrib-/ 15 (n ∸ 15) (ℕ.m%n0 2 ((n ∸ 15) / 3)) ⟩ + 2 ^ 5 * 2 ^ ((n ∸ 15) / 3) + ≤⟨ lemma' n 16≤n ⟩ + 2 ^ (n / 3) + ∎ + where + open ℕ.≤-Reasoning + go n rec 16≤n | no n≰30 = + begin + n + ≤⟨ ℕ.m≤n+m n 16 ⟩ + 16 + n + ≡⟨⟩ + 32 + n ∸ 16 + ≡⟨ ℕ.+-∸-assoc 32 16≤n ⟩ + 32 + (n ∸ 16) + ≤⟨ ℕ.+-monoʳ-≤ 32 (ℕ.m≤n*m (n ∸ 16) 32) ⟩ + 32 + 32 * (n ∸ 16) + ≡⟨ ℕ.*-suc 32 (n ∸ 16) ⟨ + 32 * suc (n ∸ 16) + ≡⟨ Eq.cong (32 *_) (ℕ.+-∸-assoc 1 16≤n) ⟨ + 32 * (n ∸ 15) + ≡⟨⟩ + 2 ^ 5 * (n ∸ 15) + ≤⟨ ℕ.*-monoʳ-≤ (2 ^ 5) (rec {n ∸ 15} ( + begin-strict + n ∸ 15 + <⟨ ℕ.∸-monoʳ-< {n} {15} {0} (s≤s (z≤n {14})) (ℕ.≤-trans (ℕ.n≤1+n 15) 16≤n) ⟩ + n + ∎) (ℕ.∸-monoˡ-≤ 15 (ℕ.≰⇒> n≰30))) + ⟩ + 2 ^ 5 * 2 ^ ((n ∸ 15) / 3) + ≤⟨ lemma' n 16≤n ⟩ + 2 ^ (n / 3) + ∎ + where + open ℕ.≤-Reasoning -2CC≱ADT : SizedADT ℕ (Rose ∞) sizeRose ≰ₛ Sized2CC ℕ -2CC≱ADT n = NAT' , e₁ (4 * n) , ADT≽2CC (e₁ (4 * n)) , lemma n +id∈𝒪[exponential] : id ∈ 𝒪[ (λ n → 2 ^ (n / 3)) ] +id∈𝒪[exponential] .proj₁ = 15 +id∈𝒪[exponential] .proj₂ n = 2^n≥n n 2CC Date: Thu, 4 Dec 2025 21:29:24 +0100 Subject: [PATCH 63/82] Add some more transitivity theorems --- src/Vatras/Succinctness/ProofDefinition.agda | 42 +++++++++++++++----- 1 file changed, 31 insertions(+), 11 deletions(-) diff --git a/src/Vatras/Succinctness/ProofDefinition.agda b/src/Vatras/Succinctness/ProofDefinition.agda index c7af344c..85150e39 100644 --- a/src/Vatras/Succinctness/ProofDefinition.agda +++ b/src/Vatras/Succinctness/ProofDefinition.agda @@ -119,7 +119,12 @@ L₁ <ₛ L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ L₁ ≤ₛ-reflexive : {L₁ L₂ : SizedLang V} → L₁ =ₛ L₂ → L₁ ≤ₛ L₂ ≤ₛ-reflexive (L₁≤ₛL₂ , L₂≤ₛL₁) = L₁≤ₛL₂ -≤ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≽ Lang L₂ → Lang L₂ ≽ Lang L₃ → L₁ ≤ₛ L₂ → L₂ ≤ₛ L₃ → L₁ ≤ₛ L₃ +≤ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → + Lang L₁ ≽ Lang L₂ + → Lang L₂ ≽ Lang L₃ + → L₁ ≤ₛ L₂ + → L₂ ≤ₛ L₃ + → L₁ ≤ₛ L₃ ≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ (n₁ , L₂→L₁) (n₂ , L₃→L₂) .proj₁ = n₁ * n₂ ≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ (n₁ , L₂→L₁) (n₂ , L₃→L₂) .proj₂ A e₃ e₃-translatable with L₃→L₂ A e₃ (L₂≽L₃ e₃) ≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ (n₁ , L₂→L₁) (n₂ , L₃→L₂) .proj₂ A e₃ e₃-translatable | e₂ , e₂≅e₃ , e₁≤e₂ with L₂→L₁ A e₂ (L₁≽L₂ e₂) @@ -153,12 +158,15 @@ L₁ <ₛ L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ L₁ <ₛ→≤ₛ : {L₁ L₂ : SizedLang V} → L₁ <ₛ L₂ → L₁ ≤ₛ L₂ <ₛ→≤ₛ (L₁≤ₛL₂ , L₂≰ₛL₁) = L₁≤ₛL₂ - -≤ₛ-<ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≽ Lang L₂ → Lang L₂ ≽ Lang L₃ → L₁ ≤ₛ L₂ → L₂ <ₛ L₃ → L₁ <ₛ L₃ -≤ₛ-<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₁ = ≤ₛ-transitive L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ L₂≤ₛL₃ -≤ₛ-<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₂ n with L₃≰ₛL₂ (n * m) -≤ₛ-<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₂ n | A , e₂ , (e₃ , e₂≅e₃) , e₂< with L₂→L₁ A e₂ (L₁≽L₂ e₂) -≤ₛ-<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ L₁≤ₛL₂@(m , L₂→L₁) (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₂ n | A , e₂ , (e₃ , e₂≅e₃) , e₂< | e₁ , e₁≅e₂ , e₁≤e₂ +≤ₛ-≱ₛ-transitive : + ∀ {L₁ L₂ L₃ : SizedLang V} + → Lang L₁ ≽ Lang L₂ + → L₁ ≤ₛ L₂ + → L₃ ≰ₛ L₂ + → L₃ ≰ₛ L₁ +≤ₛ-≱ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₁≤ₛL₂@(m , L₂→L₁) L₃≰ₛL₂ n with L₃≰ₛL₂ (n * m) +≤ₛ-≱ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₁≤ₛL₂@(m , L₂→L₁) L₃≰ₛL₂ n | A , e₂ , (e₃ , e₂≅e₃) , e₂< with L₂→L₁ A e₂ (L₁≽L₂ e₂) +≤ₛ-≱ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₁≤ₛL₂@(m , L₂→L₁) L₃≰ₛL₂ n | A , e₂ , (e₃ , e₂≅e₃) , e₂< | e₁ , e₁≅e₂ , e₁≤e₂ = A , e₁ , (e₃ , ≅-trans e₁≅e₂ e₂≅e₃) , λ e₃' e₃≅e₁ → begin-strict n * size L₁ e₁ @@ -172,10 +180,18 @@ L₁ <ₛ L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ L₁ where open ℕ.≤-Reasoning -<ₛ-≤ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≽ Lang L₂ → Lang L₂ ≋ Lang L₃ → L₁ <ₛ L₂ → L₂ ≤ₛ L₃ → L₁ <ₛ L₃ -<ₛ-≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃@(m , L₃→L₂) .proj₁ = ≤ₛ-transitive L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ L₂≤ₛL₃ -<ₛ-≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃@(m , L₃→L₂) .proj₂ n with L₂≰ₛL₁ (m * n) -<ₛ-≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ (L₂≽L₃ , L₃≽L₂) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃@(m , L₃→L₂) .proj₂ n | A , e₁ , (e₂ , e₁≅e₂) , e₁< +≤ₛ-<ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≽ Lang L₂ → Lang L₂ ≽ Lang L₃ → L₁ ≤ₛ L₂ → L₂ <ₛ L₃ → L₁ <ₛ L₃ +≤ₛ-<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₁ = ≤ₛ-transitive L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ L₂≤ₛL₃ +≤ₛ-<ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ (L₂≤ₛL₃ , L₃≰ₛL₂) .proj₂ = ≤ₛ-≱ₛ-transitive L₁≽L₂ L₁≤ₛL₂ L₃≰ₛL₂ + +≱ₛ-≤ₛ-transitive : + ∀ {L₁ L₂ L₃ : SizedLang V} + → Lang L₂ ≋ Lang L₃ + → L₂ ≰ₛ L₁ + → L₂ ≤ₛ L₃ + → L₃ ≰ₛ L₁ +≱ₛ-≤ₛ-transitive {L₁} {L₂} {L₃} (L₂≽L₃ , L₃≽L₂) L₂≰ₛL₁ L₂≤ₛL₃@(m , L₃→L₂) n with L₂≰ₛL₁ (m * n) +≱ₛ-≤ₛ-transitive {L₁} {L₂} {L₃} (L₂≽L₃ , L₃≽L₂) L₂≰ₛL₁ L₂≤ₛL₃@(m , L₃→L₂) n | A , e₁ , (e₂ , e₁≅e₂) , e₁< = A , e₁ , Product.map₂ (≅-trans e₁≅e₂) (L₃≽L₂ e₂) , go where go : (e₃ : Expression (Lang L₃) A) → Lang L₃ , Lang L₁ ⊢ e₃ ≣ e₁ → size L₃ e₃ > n * size L₁ e₁ @@ -199,6 +215,10 @@ L₁ <ₛ L₂ = L₁ ≤ₛ L₂ × L₂ ≰ₛ L₁ where open ℕ.≤-Reasoning +<ₛ-≤ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≽ Lang L₂ → Lang L₂ ≋ Lang L₃ → L₁ <ₛ L₂ → L₂ ≤ₛ L₃ → L₁ <ₛ L₃ +<ₛ-≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≋L₃@(L₂≽L₃ , _) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃ .proj₁ = ≤ₛ-transitive L₁≽L₂ L₂≽L₃ L₁≤ₛL₂ L₂≤ₛL₃ +<ₛ-≤ₛ-transitive {L₁} {L₂} {L₃} L₁≽L₂ L₂≋L₃@(L₂≽L₃ , _) (L₁≤ₛL₂ , L₂≰ₛL₁) L₂≤ₛL₃ .proj₂ = ≱ₛ-≤ₛ-transitive L₂≋L₃ L₂≰ₛL₁ L₂≤ₛL₃ + <ₛ-transitive : {L₁ L₂ L₃ : SizedLang V} → Lang L₁ ≽ Lang L₂ → Lang L₂ ≋ Lang L₃ → L₁ <ₛ L₂ → L₂ <ₛ L₃ → L₁ <ₛ L₃ <ₛ-transitive L₁≽L₂ L₂≋L₃ L₁<ₛL₂ L₂<ₛL₃ = <ₛ-≤ₛ-transitive L₁≽L₂ L₂≋L₃ L₁<ₛL₂ (<ₛ→≤ₛ L₂<ₛL₃) From a11219c834f5ce31e71f2162a14460a13f105e83 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 9 Dec 2025 18:16:43 +0100 Subject: [PATCH 64/82] =?UTF-8?q?Replace=20=E2=89=B1=20in=20names=20with?= =?UTF-8?q?=20=E2=89=B0?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This makes the names consistent with the symbol that is used now. --- .../Succinctness/Relations/2CC\342\211\260FST.agda" | 8 ++++---- .../Vatras/Succinctness/Relations/2CC\342\211\260OC.agda" | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) rename "src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" => "src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" (98%) rename "src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" => "src/Vatras/Succinctness/Relations/2CC\342\211\260OC.agda" (98%) diff --git "a/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" "b/src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" similarity index 98% rename from "src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" rename to "src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" index 60b55c78..757a0ace 100644 --- "a/src/Vatras/Succinctness/Relations/FST\342\211\2612CC.agda" +++ "b/src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" @@ -1,4 +1,4 @@ -module Vatras.Succinctness.Relations.FST≱2CC where +module Vatras.Succinctness.Relations.2CC≰FST where open import Data.Bool as Bool using (Bool; true; false; if_then_else_) import Data.Bool.Properties as Bool @@ -290,9 +290,9 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( where open ℕ.≤-Reasoning -FST≱2CC : Sized2CC ℕ ≰ₛ SizedFST ℕ -FST≱2CC zero = NAT , fst zero , 2CC≽FST zero ℕ._≟_ (fst zero) , λ 2cc 2cc≅fst → size2CC>0 2cc -FST≱2CC (suc n) = NAT , fst m , 2CC≽FST zero ℕ._≟_ (fst m) , λ 2cc 2cc≅fst → +2CC≰FST : Sized2CC ℕ ≰ₛ SizedFST ℕ +2CC≰FST zero = NAT , fst zero , 2CC≽FST zero ℕ._≟_ (fst zero) , λ 2cc 2cc≅fst → size2CC>0 2cc +2CC≰FST (suc n) = NAT , fst m , 2CC≽FST zero ℕ._≟_ (fst m) , λ 2cc 2cc≅fst → begin-strict suc n * sizeFST (fst m) <⟨ ℕ.*-monoʳ-< (suc n) ( diff --git "a/src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" "b/src/Vatras/Succinctness/Relations/2CC\342\211\260OC.agda" similarity index 98% rename from "src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" rename to "src/Vatras/Succinctness/Relations/2CC\342\211\260OC.agda" index 85c9ea5a..b4554835 100644 --- "a/src/Vatras/Succinctness/Relations/OC\342\211\2612CC.agda" +++ "b/src/Vatras/Succinctness/Relations/2CC\342\211\260OC.agda" @@ -1,6 +1,6 @@ open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT; atomSize) -- TODO abstract over (F : 𝔽) using a map (ℕ → 𝔽) -module Vatras.Succinctness.Relations.OC≱2CC where +module Vatras.Succinctness.Relations.2CC≰OC where open import Data.Bool using (true; false) open import Data.Empty using (⊥-elim) @@ -252,5 +252,5 @@ goal n@(suc n-1) 2cc (2cc⊆oc , oc⊆2cc) = open ℕ.≤-Reasoning m = 4 * n -OC≱2CC : Sized2CC ℕ ≰ₛ SizedWFOC ℕ -OC≱2CC n = NAT , oc (4 * n) , 2CC≽OC (oc (4 * n)) , λ 2cc oc≅2cc → goal n 2cc oc≅2cc +2CC≰OC : Sized2CC ℕ ≰ₛ SizedWFOC ℕ +2CC≰OC n = NAT , oc (4 * n) , 2CC≽OC (oc (4 * n)) , λ 2cc oc≅2cc → goal n 2cc oc≅2cc From 0ac88f7e9b1848b8498b04977525cac7c0a712b9 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 9 Dec 2025 18:26:26 +0100 Subject: [PATCH 65/82] =?UTF-8?q?Generalize=20the=20dimension=20of=202CC?= =?UTF-8?q?=20=E2=89=B0=E2=82=9B=20FST?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../Relations/2CC\342\211\260FST.agda" | 156 ++++++++++++------ src/Vatras/Util/AuxProofs.agda | 15 +- 2 files changed, 121 insertions(+), 50 deletions(-) diff --git "a/src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" "b/src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" index 757a0ace..120378cb 100644 --- "a/src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" +++ "b/src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" @@ -1,9 +1,23 @@ -module Vatras.Succinctness.Relations.2CC≰FST where +open import Data.Nat as ℕ using (ℕ; suc; zero; _≤_; _<_; z≤n; s≤s; _>_; _+_; _∸_; _*_; _^_; _≟_) +open import Data.Product as Prod using (_×_; _,_; proj₁; proj₂; Σ-syntax; ∃-syntax) +open import Function using (_∘_; _∘′_; const; id) +open import Relation.Binary using (DecidableEquality) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≗_; _≢_; refl) +open import Vatras.Framework.Definitions using (𝔸; 𝔽; NAT; atomSize) + +module Vatras.Succinctness.Relations.2CC≰FST + (F : 𝔽) + (f : ℕ → F) + (_==_ : DecidableEquality F) + (f-injective : ∀ {i j : ℕ} → i ≢ j → f i ≢ f j) + (diagonalization : F × ℕ → F) + (diagonalization⁻¹ : F → F × ℕ) + (diagonalization-injective : diagonalization⁻¹ ∘ diagonalization ≗ id) + where -open import Data.Bool as Bool using (Bool; true; false; if_then_else_) +open import Data.Bool as Bool using (Bool; true; false; _∨_; if_then_else_) import Data.Bool.Properties as Bool open import Data.Empty using (⊥-elim) -open import Data.Nat as ℕ using (ℕ; suc; zero; _≤_; _<_; z≤n; s≤s; _>_; _+_; _∸_; _*_; _^_) import Data.Nat.Properties as ℕ open import Data.Fin as Fin using (Fin; zero; suc) import Data.Fin.Properties as Fin @@ -20,34 +34,29 @@ open import Data.List.Relation.Unary.AllPairs as AllPairs using (AllPairs; []; _ import Data.List.Relation.Unary.AllPairs.Properties as AllPairs import Data.List.Relation.Unary.Unique.Propositional as List import Data.List.Relation.Unary.Unique.Propositional.Properties as Unique -open import Data.Product as Prod using (_×_; _,_; proj₁; proj₂; Σ-syntax; ∃-syntax) import Data.Product.Properties as Prod open import Data.Unit using (tt) -open import Function using (_∘_; _∘′_; const; id) open import Function.Bundles using (Equivalence) -open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≗_; _≢_; refl) -open import Relation.Nullary.Decidable using (Dec; yes; no) +open import Relation.Nullary.Decidable using (Dec; does; yes; no) open import Relation.Nullary.Negation using (¬_) open import Relation.Unary using (Decidable) open import Size using (Size; ∞) -open import Vatras.Util.AuxProofs using (m∸n0) -open FST.Impose NAT hiding (_∈_) -open import Vatras.Lang.FST.Composition ℕ NAT using (⊛-all-unique) -open import Vatras.Lang.FST.Util ℕ NAT using (select≗filter) -open import Vatras.Lang.2CC.FixedArtifactLength ℕ NAT using (unique-lengths⇒m*sizeRose≤size2CC) renaming (_≉_ to _≉'_) +open FST.Impose NAT hiding (_∈_; _==_) +open import Vatras.Lang.FST.Composition F NAT using (⊛-all-unique) +open import Vatras.Lang.FST.Util F NAT using (select≗filter) +open import Vatras.Lang.2CC.FixedArtifactLength F NAT using (unique-lengths⇒m*sizeRose≤size2CC) renaming (_≉_ to _≉'_) artifact : ℕ → ℕ → FSTA ∞ artifact n zero = (0 , 2 ^ n) Rose.-< [] >- @@ -61,7 +70,7 @@ feature : ℕ → ℕ → FSF feature n i = (artifact n i ∷ []) ⊚ ([] ∷ [] , artifact-wf n i ∷ []) fst : ℕ → SPL -fst n = (0 , 0) ◀ List.applyUpTo (λ i → i :: feature n i) (suc n) +fst n = (0 , 0) ◀ List.applyUpTo (λ i → f i :: feature n i) (suc n) size-fst : ∀ (n : ℕ) @@ -70,11 +79,11 @@ size-fst n = begin sizeFST (fst n) ≡⟨⟩ - 1 + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → i :: feature n i) (suc n))) + 1 + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → f i :: feature n i) (suc n))) ≡⟨⟩ - 2 + (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → suc i :: feature n (suc i)) n)) - ≡⟨ Eq.cong (λ x → 2 + (sizeRose (artifact n zero) + 0 + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) x))) (List.map-upTo (λ i → suc i :: feature n (suc i)) n) ⟨ - 2 + (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.map (λ i → suc i :: feature n (suc i)) (List.upTo n))) + 2 + (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.applyUpTo (λ i → f (suc i) :: feature n (suc i)) n)) + ≡⟨ Eq.cong (λ x → 2 + (sizeRose (artifact n zero) + 0 + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) x))) (List.map-upTo (λ i → f (suc i) :: feature n (suc i)) n) ⟨ + 2 + (sizeRose (artifact n zero) + 0) + List.sum (List.map (suc ∘ List.sum ∘ List.map sizeRose ∘ FST.Impose.trees ∘ FST.Impose.impl) (List.map (λ i → f (suc i) :: feature n (suc i)) (List.upTo n))) ≡⟨ Eq.cong (λ x → 2 + (sizeRose (artifact n zero) + 0) + List.sum x) (List.map-∘ (List.upTo n)) ⟨ 2 + (sizeRose (artifact n zero) + 0) + List.sum (List.map (λ i → suc (sizeRose (artifact n (suc i)) + 0)) (List.upTo n)) ≡⟨⟩ @@ -131,41 +140,42 @@ variant-≉ n {l₁} {l₂} l₁≢l₂ v₁≡v₂ = l₁≢l₂ ( where open Eq.≡-Reasoning -fst-config : ℕ → ℕ → Bool -fst-config i f = f ℕ.≤ᵇ i +fst-config : ℕ → FST.Configuration +fst-config i f' = List.any (λ k → does (f k == f')) (List.upTo (suc i)) +-- f' ℕ.≤ᵇ i select-applyUpTo-feature : ∀ (k n i : ℕ) → i ≤ n - → select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) + → select (fst-config i) (List.applyUpTo (λ m → f m :: feature k m) (suc n)) ≡ List.applyUpTo (feature k) (suc i) select-applyUpTo-feature k n i i≤n = - select (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) - ≡⟨ select≗filter (fst-config i) (List.applyUpTo (λ m → m :: feature k m) (suc n)) ⟩ - List.map impl (List.filter P? (List.applyUpTo (λ m → m :: feature k m) (suc n))) - ≡⟨ Eq.cong (λ x → List.map impl (List.filterᵇ (fst-config i ∘ name) (List.applyUpTo (λ m → m :: feature k m) (suc x)))) (ℕ.m+[n∸m]≡n i≤n) ⟨ - List.map impl (List.filter P? (List.applyUpTo (λ m → m :: feature k m) (suc i + (n ∸ i)))) - ≡⟨ Eq.cong (λ x → List.map impl (List.filterᵇ (fst-config i ∘ name) x)) (List.applyUpTo-++⁺ (λ m → m :: feature k m) (suc i) (n ∸ i)) ⟩ + select (fst-config i) (List.applyUpTo (λ m → f m :: feature k m) (suc n)) + ≡⟨ select≗filter (fst-config i) (List.applyUpTo (λ m → f m :: feature k m) (suc n)) ⟩ + List.map impl (List.filter P? (List.applyUpTo (λ m → f m :: feature k m) (suc n))) + ≡⟨ Eq.cong (λ x → List.map impl (List.filterᵇ (fst-config i ∘ name) (List.applyUpTo (λ m → f m :: feature k m) (suc x)))) (ℕ.m+[n∸m]≡n i≤n) ⟨ + List.map impl (List.filter P? (List.applyUpTo (λ m → f m :: feature k m) (suc i + (n ∸ i)))) + ≡⟨ Eq.cong (λ x → List.map impl (List.filterᵇ (fst-config i ∘ name) x)) (List.applyUpTo-++⁺ (λ m → f m :: feature k m) (suc i) (n ∸ i)) ⟩ List.map impl (List.filter P? - ( List.applyUpTo (λ m → m :: feature k m) (suc i) - ++ List.applyUpTo (λ m → suc i + m :: feature k (suc i + m)) (n ∸ i))) + ( List.applyUpTo (λ m → f m :: feature k m) (suc i) + ++ List.applyUpTo (λ m → f (suc i + m) :: feature k (suc i + m)) (n ∸ i))) ≡⟨ Eq.cong (List.map impl) (List.filter-++ (Bool.T? ∘ fst-config i ∘ name) - (List.applyUpTo (λ m → m :: feature k m) (suc i)) - (List.applyUpTo (λ m → suc i + m :: feature k (suc i + m)) (n ∸ i)) ) + (List.applyUpTo (λ m → f m :: feature k m) (suc i)) + (List.applyUpTo (λ m → f (suc i + m) :: feature k (suc i + m)) (n ∸ i)) ) ⟩ List.map impl - ( List.filter P? (List.applyUpTo (λ m → m :: feature k m) (suc i)) - ++ List.filter P? (List.applyUpTo (λ m → suc i + m :: feature k (suc i + m)) (n ∸ i))) + ( List.filter P? (List.applyUpTo (λ m → f m :: feature k m) (suc i)) + ++ List.filter P? (List.applyUpTo (λ m → f (suc i + m) :: feature k (suc i + m)) (n ∸ i))) ≡⟨ Eq.cong (List.map impl) (Eq.cong₂ _++_ (List.filter-all P? - (All.applyUpTo⁺₁ (λ m → m :: feature k m) (suc i) P-true)) + (All.applyUpTo⁺₁ (λ m → f m :: feature k m) (suc i) P-true)) (List.filter-none P? - (All.applyUpTo⁺₂ (λ m → suc i + m :: feature k (suc i + m)) (n ∸ i) P-false))) + (All.applyUpTo⁺₂ (λ m → f (suc i + m) :: feature k (suc i + m)) (n ∸ i) P-false))) ⟩ - List.map impl (List.applyUpTo (λ m → m :: feature k m) (suc i) ++ []) - ≡⟨ Eq.cong (List.map impl) (List.++-identityʳ (List.applyUpTo (λ m → m :: feature k m) (suc i))) ⟩ - List.map impl (List.applyUpTo (λ m → m :: feature k m) (suc i)) - ≡⟨ List.map-applyUpTo impl (λ m → m :: feature k m) (suc i) ⟩ + List.map impl (List.applyUpTo (λ m → f m :: feature k m) (suc i) ++ []) + ≡⟨ Eq.cong (List.map impl) (List.++-identityʳ (List.applyUpTo (λ m → f m :: feature k m) (suc i))) ⟩ + List.map impl (List.applyUpTo (λ m → f m :: feature k m) (suc i)) + ≡⟨ List.map-applyUpTo impl (λ m → f m :: feature k m) (suc i) ⟩ List.applyUpTo (feature k) (suc i) ∎ where @@ -177,11 +187,59 @@ select-applyUpTo-feature k n i i≤n = P? : Decidable P P? = Bool.T? ∘ fst-config i ∘ name - P-true : {j : ℕ} → j < suc i → P (j :: feature k j) - P-true (s≤s j≤i) = ℕ.≤⇒≤ᵇ j≤i + P-true : {j : ℕ} → j < suc i → P (f j :: feature k j) + P-true {j} (s≤s j≤i) = Equivalence.from Bool.T-≡ (go (suc i) zero z≤n (s≤s j≤i)) + where + go : ∀ i k → k ≤ j → j < k + i → List.any (λ k → does (f k == f j)) (List.applyUpTo (k +_) i) ≡ true + go zero k k≤j j-) ( ≡⟨ ⊛-all-unique (List.applyUpTo (feature n) (suc i)) (unique-variant n zero (suc i)) ⟨ forget-uniqueness (⊛-all (List.applyUpTo (feature n) (suc i))) ≡⟨ Eq.cong (λ x → forget-uniqueness (⊛-all x)) (select-applyUpTo-feature n n i i≤n) ⟨ - forget-uniqueness (⊛-all (select (fst-config i) (List.applyUpTo (λ m → m :: feature n m) (suc n)))) + forget-uniqueness (⊛-all (select (fst-config i) (List.applyUpTo (λ m → f m :: feature n m) (suc n)))) ∎) where open Eq.≡-Reasoning @@ -290,9 +348,9 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( where open ℕ.≤-Reasoning -2CC≰FST : Sized2CC ℕ ≰ₛ SizedFST ℕ -2CC≰FST zero = NAT , fst zero , 2CC≽FST zero ℕ._≟_ (fst zero) , λ 2cc 2cc≅fst → size2CC>0 2cc -2CC≰FST (suc n) = NAT , fst m , 2CC≽FST zero ℕ._≟_ (fst m) , λ 2cc 2cc≅fst → +2CC≰FST : Sized2CC F ≰ₛ SizedFST F +2CC≰FST zero = NAT , fst zero , 2CC≽FST (f 0) _==_ (fst zero) , λ 2cc 2cc≅fst → size2CC>0 2cc +2CC≰FST (suc n) = NAT , fst m , 2CC≽FST (f 0) _==_ (fst m) , λ 2cc 2cc≅fst → begin-strict suc n * sizeFST (fst m) <⟨ ℕ.*-monoʳ-< (suc n) ( diff --git a/src/Vatras/Util/AuxProofs.agda b/src/Vatras/Util/AuxProofs.agda index b3291d4b..4653c528 100644 --- a/src/Vatras/Util/AuxProofs.agda +++ b/src/Vatras/Util/AuxProofs.agda @@ -4,6 +4,7 @@ open import Level using (Level) open import Function using (id; _∘_) open import Data.Bool using (Bool; false; true; if_then_else_; not; _∧_) +open import Data.Empty using (⊥-elim) open import Data.Fin using (Fin; zero; suc; fromℕ<) open import Data.Nat using (ℕ; zero; suc; NonZero; _≡ᵇ_; _⊓_; _+_; _∸_; _<_; _>_; _≤_; s≤s; z≤n) open import Data.Nat.Properties using (n<1+n; m⊓n≤m; +-comm; +-∸-comm; n∸n≡0; m≤n+m; +-∸-assoc; ∸-monoʳ-≤) @@ -11,7 +12,8 @@ open import Data.Fin using (Fin; zero; suc; fromℕ<) open import Data.List.Properties using (length-++) open import Data.Product using (_×_; _,_) open import Relation.Binary using (DecidableEquality) -open import Relation.Nullary.Decidable using (yes; no) +open import Relation.Nullary using (¬_) +open import Relation.Nullary.Decidable using (Dec; does; yes; no) import Relation.Binary.PropositionalEquality as Eq open Eq using (_≡_; _≢_; _≗_; refl) @@ -109,6 +111,17 @@ if-cong : ∀ {ℓ} {A : Set ℓ} {a b c d : A} x → (if x then a else b) ≡ (if x then c else d) if-cong _ refl refl = refl +----- Properties for Decidability + +does≡true : ∀ {p} {P : Set p} → (dec : Dec P) → P → does dec ≡ true +does≡true (no ¬p) p = ⊥-elim (¬p p) +does≡true (yes p) p' = Eq.refl + +does≡false : ∀ {p} {P : Set p} → (dec : Dec P) → ¬ P → does dec ≡ false +does≡false (no ¬p) ¬p' = Eq.refl +does≡false (yes p) ¬p = ⊥-elim (¬p p) + + ----- Properties of Vectors module Vec where From 4e175e1e67cf89675ada0f0a8e54777247a1babc Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 9 Dec 2025 18:30:56 +0100 Subject: [PATCH 66/82] =?UTF-8?q?Generalize=20the=20dimension=20of=202CC?= =?UTF-8?q?=20=E2=89=B0=E2=82=9B=20OC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../Relations/2CC\342\211\260OC.agda" | 147 +++++++++++++++--- 1 file changed, 124 insertions(+), 23 deletions(-) diff --git "a/src/Vatras/Succinctness/Relations/2CC\342\211\260OC.agda" "b/src/Vatras/Succinctness/Relations/2CC\342\211\260OC.agda" index b4554835..a2c80d46 100644 --- "a/src/Vatras/Succinctness/Relations/2CC\342\211\260OC.agda" +++ "b/src/Vatras/Succinctness/Relations/2CC\342\211\260OC.agda" @@ -1,10 +1,17 @@ +open import Data.Nat as ℕ using (ℕ; zero; suc; _≤_; _<_; s≤s; z≤n; _+_; _*_; _^_; _∸_; _≟_) +open import Relation.Binary using (DecidableEquality) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_) open import Vatras.Framework.Definitions using (𝔽; 𝔸; NAT; atomSize) --- TODO abstract over (F : 𝔽) using a map (ℕ → 𝔽) -module Vatras.Succinctness.Relations.2CC≰OC where -open import Data.Bool using (true; false) +module Vatras.Succinctness.Relations.2CC≰OC + (F : 𝔽) + (f : ℕ → F) + (_==_ : DecidableEquality F) + (f-injective : ∀ {i j : ℕ} → i ≢ j → f i ≢ f j) + where + +open import Data.Bool using (true; false; _∨_; if_then_else_) open import Data.Empty using (⊥-elim) -open import Data.Nat as ℕ using (ℕ; zero; suc; _≤_; _<_; s≤s; z≤n; _<ᵇ_; _+_; _*_; _^_; _∸_) import Data.Nat.Properties as ℕ open import Data.List as List using (List; []; _∷_) import Data.List.Properties as List @@ -16,30 +23,28 @@ import Data.List.Relation.Unary.AllPairs as AllPairs open import Data.List.Relation.Unary.Any using (here; there) open import Data.List.Relation.Unary.Unique.DecPropositional ℕ._≟_ using (Unique; []; _∷_) import Data.List.Relation.Unary.Unique.DecPropositional.Properties as Unique -open import Data.Maybe using (just) +open import Data.Maybe using (nothing; just) open import Data.Product using (_×_; _,_; proj₁; proj₂; ∃-syntax) open import Function using (_∘_; id; const) -open import Relation.Binary.PropositionalEquality as Eq using (_≡_; _≢_) -open import Relation.Nullary.Decidable using (yes; no) -open import Relation.Nullary.Reflects using (ofʸ; ofⁿ) +open import Relation.Nullary.Decidable using (Dec; _because_; does; yes; no) open import Size using (Size; ∞) -open import Vatras.Util.AuxProofs using (m∸n0) options : ℕ → List (OC.OC ∞ NAT) options zero = [] -options (suc n) = n OC.❲ (0 , 0) OC.-< [] >- ❳ ∷ options n +options (suc n) = f n OC.❲ (0 , 0) OC.-< [] >- ❳ ∷ options n oc : ℕ → OC.WFOC ∞ NAT oc n = OC.Root (0 , 0) ((0 , 2 ^ n) OC.-< [] >- ∷ options n) @@ -126,18 +131,100 @@ variant-≉ n {l₁} {l₂} l₁≢l₂ v₁≡v₂ = l₁≢l₂ ( open Eq.≡-Reasoning config : ℕ → OC.Configuration -config n i = i <ᵇ n +config n i = List.any (λ k → does (i == f k)) (List.upTo n) + +config≡true : ∀ l i → i < l → config l (f i) ≡ true +config≡true l i i- ∷_) (⟦options⟧-tail n l (ℕ.<⇒≤ n- ❳ ∷ options n)) + ≡⟨⟩ + List.catMaybes (OC.⟦ f n OC.❲ (0 , 0) OC.-< [] >- ❳ ⟧ₒ (config l) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n)) + ≡⟨⟩ + List.catMaybes ((if config l (f n) then just ((0 , 0) Rose.-< [] >-) else nothing) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n)) + ≡⟨ Eq.cong (λ x → List.catMaybes ((if x then just ((0 , 0) Rose.-< [] >-) else nothing) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n))) (config≡true l n n-) else nothing) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n)) + ≡⟨⟩ + List.catMaybes ((just ((0 , 0) Rose.-< [] >-)) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n)) + ≡⟨⟩ + ((0 , 0) Rose.-< [] >-) ∷ List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n)) + ≡⟨ Eq.cong ((0 , 0) Rose.-< [] >- ∷_) (⟦options⟧-tail n l (ℕ.<⇒≤ n-) ∷ variant-cs n + ∎ + where + open Eq.≡-Reasoning ⟦options⟧ : ∀ n l → l ≤ n @@ -145,9 +232,23 @@ config n i = i <ᵇ n ≡ variant-cs l ⟦options⟧ zero .zero z≤n = Eq.refl ⟦options⟧ (suc n) l l≤n with n ℕ.- ❳ ∷ options n)) + ≡⟨⟩ + List.catMaybes (OC.⟦ f n OC.❲ (0 , 0) OC.-< [] >- ❳ ⟧ₒ (config l) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n)) + ≡⟨⟩ + List.catMaybes ((if config l (f n) then just ((0 , 0) Rose.-< [] >-) else nothing) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n)) + ≡⟨ Eq.cong (λ x → List.catMaybes ((if x then just ((0 , 0) Rose.-< [] >-) else nothing) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n))) (config≡false l n (ℕ.≮⇒≥ n≮l)) ⟩ + List.catMaybes ((if false then just ((0 , 0) Rose.-< [] >-) else nothing) ∷ List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n)) + ≡⟨⟩ + List.catMaybes (List.map (λ e → OC.⟦ e ⟧ₒ (config l)) (options n)) + ≡⟨ ⟦options⟧ n l (ℕ.≮⇒≥ n≮l) ⟩ + variant-cs l + ∎ + where + open Eq.≡-Reasoning ⟦options⟧ (suc n) l l≤n | yes n Date: Tue, 9 Dec 2025 18:59:45 +0100 Subject: [PATCH 67/82] =?UTF-8?q?Generalize=20the=20dimension=20of=202CC?= =?UTF-8?q?=20<=E2=82=9B=20ADT?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../Succinctness/Relations/2CC-; 2CCL) -open ADT using (ADT; _⟨_,_⟩; leaf; ADTL) +open import Vatras.Util.List as List using (find-or-last) open import Vatras.Translation.Lang.2CC-to-ADT using (ADT≽2CC) open import Vatras.Succinctness.ProofDefinition (Rose ∞) using (_≰ₛ[_]_; _<ₛ_; ≰ₛ-strengthening) open import Vatras.Succinctness.Sizes using (Sized2CC; size2CC; SizedADT; sizeADT; sizeRose) -open import Vatras.Succinctness.Relations.2CC≤ADT ℕ using (2CC≤ADT) + +open import Vatras.Succinctness.Relations.2CC≤ADT F using (2CC≤ADT) +open import Vatras.Lang.All.Fixed F (Rose ∞) +open 2CC using (2CC; _⟨_,_⟩; _-<_>-; 2CCL) +open ADT using (ADT; _⟨_,_⟩; leaf; ADTL) e₁-cs : ℕ → ℕ → List (2CC ∞ NAT') e₁-cs zero D = [] -e₁-cs (suc n) D = D ⟨ 0 -< [] >- , 1 -< [] >- ⟩ ∷ e₁-cs n (suc D) +e₁-cs (suc n) D = f D ⟨ 0 -< [] >- , 1 -< [] >- ⟩ ∷ e₁-cs n (suc D) e₁ : ℕ → 2CC ∞ NAT' e₁ n = 0 -< e₁-cs n zero >- @@ -52,92 +68,141 @@ size-e₁-cs (suc n) D = Eq.cong (3 +_) (size-e₁-cs n (suc D)) size-e₁ : ∀ n → size2CC (e₁ n) ≡ 1 + n * 3 size-e₁ n = Eq.cong suc (size-e₁-cs n zero) -variants-cs : ∀ n → Fin (2 ^ n) → List (Rose ∞ NAT') -variants-cs zero zero = [] -variants-cs (suc n) i with Fin.toℕ i - ∷ variants-cs n (Fin.fromℕ< i<2^n) -... | no i≮2^n = 1 Rose.-< [] >- ∷ variants-cs n (Eq.subst Fin (ℕ.+-identityʳ (2 ^ n)) (Fin.reduce≥ i (ℕ.≮⇒≥ i≮2^n))) +variants-cs : ∀ n → Vec Bool n → List (Rose ∞ NAT') +variants-cs zero [] = [] +variants-cs (suc n) (b ∷ bs) = (if b then 0 else 1) Rose.-< [] >- ∷ variants-cs n bs -variants : ∀ n → VariantGenerator (pred (2 ^ n)) -variants n i = 0 Rose.-< variants-cs n (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i) >- +variants : ∀ n → Vec Bool n → Rose ∞ NAT' +variants n bs = 0 Rose.-< variants-cs n bs >- -variants⊆e₁ : ∀ n → variants n ⊆ 2CC.⟦ e₁ n ⟧ -variants⊆e₁ n i = config n i' , Eq.cong (0 Rose.-<_>-) (go n i' zero λ o → Eq.cong (config n i') (ℕ.+-identityʳ o)) - where - i' = Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) i +variants-cs-injective : ∀ n bs₁ bs₂ → variants-cs n bs₁ ≡ variants-cs n bs₂ → bs₁ ≡ bs₂ +variants-cs-injective zero [] [] refl = refl +variants-cs-injective (suc n) (false ∷ bs₁) (false ∷ bs₂) eq = Eq.cong (false ∷_) (variants-cs-injective n bs₁ bs₂ (List.∷-injectiveʳ eq)) +variants-cs-injective (suc n) (true ∷ bs₁) (true ∷ bs₂) eq = Eq.cong (true ∷_) (variants-cs-injective n bs₁ bs₂ (List.∷-injectiveʳ eq)) - config : ∀ n → Fin (2 ^ n) → ℕ → Bool - config zero zero k = true - config (suc n) i k with Fin.toℕ i - ∷ variants-cs m (Fin.fromℕ< k<2^m) - ≡⟨ Eq.cong (0 Rose.-< [] >- ∷_) (go m (Fin.fromℕ< k<2^m) (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-<2^m m j o k<2^m))) ⟩ - 0 Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) +variants⊆e₁ : ∀ n → variants n ⊆ 2CC.⟦ e₁ n ⟧ +variants⊆e₁ n bs = config n bs , Eq.cong (0 Rose.-<_>-) (go n bs zero refl (cast-is-id bs)) + where + config' : ∀ (n m : ℕ) → Vec Bool n → 2CC.Configuration + config' zero m [] d = false + config' (suc n) m (b ∷ bs) d with f m == d + config' (suc n) m (b ∷ bs) d | yes f-m≡d = b + config' (suc n) m (b ∷ bs) d | no f-m≡d = config' n (suc m) bs d + + config : ∀ n → Vec Bool n → 2CC.Configuration + config n bs d = config' n zero bs d + + -- TODO variable naming + config-lemma : ∀ m b (bs' : Vec Bool m) D → (n≡D+m : n ≡ D + suc m) → simple-drop D (Vec.cast n≡D+m bs) ≡ b ∷ bs' → config' n zero bs (f D) ≡ b + config-lemma m b bs' D n≡D+m x = go n zero bs D D b bs' (Eq.sym (ℕ.+-identityʳ D)) n≡D+m x + where + go : + ∀ n m bs D k {x : ℕ} b (bs' : Vec Bool x) + → D ≡ k + m + → (n≡k+x : n ≡ k + suc x) + → simple-drop k (Vec.cast n≡k+x bs) ≡ b ∷ bs' + → config' n m bs (f D) ≡ b + go zero m [] D k b bs' x₁ n≡k+x x₂ = ⊥-elim (ℕ.n≮0 (ℕ.≤-trans (ℕ.m≤n+m (suc _) k) (ℕ.≤-reflexive (Eq.sym n≡k+x)))) + go (suc n) m (x₃ ∷ bs) D zero b bs' x₁ n≡k+x x₂ rewrite ℕ.suc-injective n≡k+x rewrite x₁ with f m == f m + go (suc n) m (x₃ ∷ bs) D zero b bs' x₁ n≡k+x x₂ | yes refl = Vec.∷-injectiveˡ x₂ + go (suc n) m (x₃ ∷ bs) D zero b bs' x₁ n≡k+x x₂ | no f-m≢f-m = ⊥-elim (f-m≢f-m refl) + go (suc n) m (x₃ ∷ bs) D (suc k) b bs' x₁ n≡k+x x₂ with f m == f D + go (suc n) m (x₃ ∷ bs) D (suc k) b bs' x₁ n≡k+x x₂ | yes f-m≡f-D = ⊥-elim (f-injective (ℕ.<⇒≢ (ℕ.≤-<-trans (ℕ.m≤n+m m k) (ℕ.<-≤-trans (ℕ.n<1+n (k + m)) (ℕ.≤-reflexive (Eq.sym x₁))))) f-m≡f-D) + go (suc n) m (x₃ ∷ bs) D (suc k) b bs' x₁ (n≡k+x) x₂ | no f-m≢f-D = go n (suc m) bs D k b bs' (Eq.trans x₁ (Eq.sym (ℕ.+-suc k m))) (ℕ.suc-injective n≡k+x) x₂ + + go : ∀ (m : ℕ) (bs' : Vec Bool m) (D : ℕ) → (n≡D+m : n ≡ D + m) → simple-drop D (Vec.cast n≡D+m bs) ≡ bs' + → variants-cs m bs' ≡ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m D) + go zero [] D n≡D+m y = refl + go (suc m) (true ∷ bs') D n≡D+m y = + variants-cs (suc m) (true ∷ bs') + ≡⟨⟩ + 0 Rose.-< [] >- ∷ variants-cs m bs' + ≡⟨ Eq.cong ((0 Rose.-< [] >-) ∷_) (go m bs' (suc D) (Eq.trans n≡D+m (ℕ.+-suc D m)) (simple-drop-tail D bs true bs' n≡D+m (Eq.trans n≡D+m (ℕ.+-suc D m)) y)) ⟩ + 0 Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m (suc D)) ≡⟨⟩ - (if true then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) - ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ - (if config n i' D then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + (if true then 0 Rose.-< [] >- else 1 Rose.-< [] >-) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m (suc D)) + ≡⟨ Eq.cong (λ x → (if x then 0 Rose.-< [] >- else 1 Rose.-< [] >-) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m (suc D))) (config-lemma m true bs' D n≡D+m y) ⟨ + (if config n bs (f D) then 0 Rose.-< [] >- else 1 Rose.-< [] >-) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m (suc D)) ≡⟨⟩ - 2CC.⟦ D ⟨ 0 -< [] >- , 1 -< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + 2CC.⟦ f D ⟨ 0 -< [] >- , 1 -< [] >- ⟩ ⟧ (config n bs) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m (suc D)) + ≡⟨⟩ + List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs (suc m) D) ∎ - ... | no k≮2^m | p' = - begin - 1 Rose.-< [] >- ∷ variants-cs m j' - ≡⟨ Eq.cong (1 Rose.-< [] >- ∷_) (go m j' (suc D) (λ o → Eq.trans (Eq.trans (Eq.cong (config n i') (ℕ.+-suc o D)) (p (suc o))) (config-≮2^m m j o k≮2^m))) ⟩ - 1 Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + where open Eq.≡-Reasoning + go (suc m) (false ∷ bs') D n≡D+m y = + variants-cs (suc m) (false ∷ bs') + ≡⟨⟩ + 1 Rose.-< [] >- ∷ variants-cs m bs' + ≡⟨ Eq.cong ((1 Rose.-< [] >-) ∷_) (go m bs' (suc D) (Eq.trans n≡D+m (ℕ.+-suc D m)) (simple-drop-tail D bs false bs' n≡D+m (Eq.trans n≡D+m (ℕ.+-suc D m)) y)) ⟩ + 1 Rose.-< [] >- ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m (suc D)) ≡⟨⟩ - (if false then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) - ≡⟨ Eq.cong (λ x → (if x then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D))) p' ⟨ - (if config n i' D then 2CC.⟦ 0 -< [] >- ⟧ (config n i') else 2CC.⟦ 1 -< [] >- ⟧ (config n i')) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + (if false then 0 Rose.-< [] >- else 1 Rose.-< [] >-) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m (suc D)) + ≡⟨ Eq.cong (λ x → (if x then 0 Rose.-< [] >- else 1 Rose.-< [] >-) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m (suc D))) (config-lemma m false bs' D n≡D+m y) ⟨ + (if config n bs (f D) then 0 Rose.-< [] >- else 1 Rose.-< [] >-) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m (suc D)) ≡⟨⟩ - 2CC.⟦ D ⟨ 0 -< [] >- , 1 -< [] >- ⟩ ⟧ (config n i') ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n i')) (e₁-cs m (suc D)) + 2CC.⟦ f D ⟨ 0 -< [] >- , 1 -< [] >- ⟩ ⟧ (config n bs) ∷ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m (suc D)) + ≡⟨⟩ + List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs (suc m) D) ∎ - where - j' = Eq.subst Fin (ℕ.+-identityʳ (2 ^ m)) (Fin.reduce≥ j (ℕ.≮⇒≥ k≮2^m)) - -Fin-reduce≥-injective : ∀ {m n} (i : Fin (m + n)) (j : Fin (m + n)) (m≤i : m ≤ Fin.toℕ i) (m≤j : m ≤ Fin.toℕ j) → Fin.reduce≥ i m≤i ≡ Fin.reduce≥ j m≤j → i ≡ j -Fin-reduce≥-injective {zero} {.(suc _)} zero j m≤i m≤j i≡j = i≡j -Fin-reduce≥-injective {zero} {.(suc _)} (suc i) j m≤i m≤j i≡j = i≡j -Fin-reduce≥-injective {suc m} {zero} (suc i) (suc j) m≤i m≤j i≡j = Eq.cong suc (Fin-reduce≥-injective i j (ℕ.≤-pred m≤i) (ℕ.≤-pred m≤j) i≡j) -Fin-reduce≥-injective {suc m} {suc n} (suc i) (suc j) m≤i m≤j i≡j = Eq.cong suc (Fin-reduce≥-injective i j (ℕ.≤-pred m≤i) (ℕ.≤-pred m≤j) i≡j) - -variants-cs-unique : ∀ n i j → i ≢ j → variants-cs n i ≢ variants-cs n j -variants-cs-unique zero zero zero i≢j = ⊥-elim (i≢j refl) -variants-cs-unique (suc n) i j i≢j cs-i≡cs-j with Fin.toℕ i -nonZero (ℕ.m^n>0 2 n)}}) i) (Eq.subst Fin (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}}) j) (i≢j ∘ Eq.subst-injective (ℕ.suc-pred (2 ^ n) {{ℕ.>-nonZero (ℕ.m^n>0 2 n)}})) (proj₂ (Rose-injective vs-i≡vs-j)) + where open Eq.≡-Reasoning partition-choice-variants : - ∀ (D : ℕ) + ∀ (D : F) → (l r : ADT NAT') → (vs : List (Rose ∞ NAT')) → Unique vs @@ -251,22 +316,119 @@ minimal-adt-size (D ⟨ l , r ⟩) vs unique-vs vs⊆adt | vs₁ , vs₂ , is-in 16 ^ (1 + n) ∎ -sizeRose-variants-cs : ∀ n i → List.sum (List.map sizeRose (variants-cs n i)) ≡ n -sizeRose-variants-cs zero zero = refl -sizeRose-variants-cs (suc n) i with Fin.toℕ i -nonZero (ℕ.m^n>0 2 n)}}) i)) +sizeRose-variants : ∀ n bs → sizeRose (variants n bs) ≡ suc n +sizeRose-variants n bs = Eq.cong suc (sizeRose-variants-cs n bs) sizeRose∈variants : ∀ (n : ℕ) → (v : Rose ∞ NAT') - → v List.∈ List.tabulate (variants n) + → v List.∈ List.map (variants n) (List⁺.toList (enumerate-binary n)) → suc n ≡ sizeRose v -sizeRose∈variants n v v∈vs with List.∈-tabulate⁻ {f = variants n} v∈vs -sizeRose∈variants n v v∈vs | i , refl = Eq.sym (sizeRose-variants n i) +sizeRose∈variants n v p with (Any.satisfied (Any.map⁻ p)) +sizeRose∈variants n v p | bs , v≡variants-bs = + suc n + ≡⟨ sizeRose-variants n bs ⟨ + sizeRose (variants n bs) + ≡⟨ Eq.cong sizeRose v≡variants-bs ⟨ + sizeRose v + ∎ + where + open Eq.≡-Reasoning + +todo5 : + ∀ {a} {A : Set a} (xs : List⁺ A) (i : Fin (List⁺.length xs)) + → List.lookup (List⁺.toList xs) i + ≡ find-or-last (Fin.toℕ i) xs +todo5 (x ∷ []) zero = refl +todo5 (x₁ ∷ x₂ ∷ xs) zero = refl +todo5 (x₁ ∷ x₂ ∷ xs) (suc i) = todo5 (x₂ ∷ xs) i + +todo : ∀ {i} {I : Set i} {a} {A : Set a} {n : ℕ} {M : Vec Bool n → A} {N : I → A} → M ⊆ N → List.lookup (List.map M (List⁺.toList (enumerate-binary n))) ⊆ N +todo {n = zero} M⊆N zero = M⊆N [] +todo {I = I} {A = A} {n = suc n} {M = M} {N} M⊆N i with Fin.toℕ i -nonZero (ℕ.m^n>0 2 m)}}) ⟨ - suc m * suc (pred (2 ^ m)) - ≡⟨ Eq.cong (suc m *_) (List.length-tabulate (variants m)) ⟨ - suc m * List.length (List.tabulate (variants m)) - ≡⟨ List.sum-map-const (suc m) (List.tabulate (variants m)) ⟨ - List.sum (List.map (const (suc m)) (List.tabulate (variants m))) - ≡⟨ Eq.cong List.sum (List.map-cong-with∈ (List.tabulate (variants m)) (sizeRose∈variants m)) ⟩ - List.sum (List.map sizeRose (List.tabulate (variants m))) - ≤⟨ minimal-adt-size e₂ (List.tabulate (variants m)) (variants-unique m) (⊆-trans (IndexedSet.tabulate⁺ (variants⊆e₁ m)) e₁⊆e₂) ⟩ + ≡⟨ Eq.cong (suc m *_) (length-enumerate-binary m) ⟨ + suc m * List⁺.length (enumerate-binary m) + ≡⟨ Eq.cong (suc m *_) ((List⁺.length-map (variants m)) (enumerate-binary m)) ⟨ + suc m * List⁺.length (List⁺.map (variants m) (enumerate-binary m)) + ≡⟨ List.sum-map-const (suc m) (List.map (variants m) (List⁺.toList (enumerate-binary m))) ⟨ + List.sum (List.map (const (suc m)) (List.map (variants m) (List⁺.toList (enumerate-binary m)))) + ≡⟨ Eq.cong List.sum (List.map-cong-with∈ (List.map (variants m) (List⁺.toList (enumerate-binary m))) (sizeRose∈variants m)) ⟩ + List.sum (List.map sizeRose (List.map (variants m) (List⁺.toList (enumerate-binary m)))) + ≤⟨ minimal-adt-size e₂ (List.map (variants m) (List⁺.toList (enumerate-binary m))) (Unique.map⁺ (variants-injective m) (enumerate-binary-unique m)) (⊆-trans (todo (variants⊆e₁ m)) e₁⊆e₂) ⟩ sizeADT sizeRose e₂ ∎ where @@ -310,7 +472,7 @@ lemma (suc k) e₂ (e₂⊆e₁ , e₁⊆e₂) = n = suc k m = 3 * n -ADT≰2CC : SizedADT ℕ (Rose ∞) sizeRose ≰ₛ[ (λ n → 2 ^ (n / 3)) ] Sized2CC ℕ +ADT≰2CC : SizedADT F (Rose ∞) sizeRose ≰ₛ[ (λ n → 2 ^ (n / 3)) ] Sized2CC F ADT≰2CC n = NAT' , e₁ (3 * n) , ADT≽2CC (e₁ (3 * n)) , lemma n 2^n≥n : ∀ n → n ≤ 15 * 2 ^ (n / 3) @@ -388,7 +550,7 @@ ADT≰2CC n = NAT' , e₁ (3 * n) , ADT≽2CC (e₁ (3 * n)) , lemma n 32 + 32 * (n ∸ 16) ≡⟨ ℕ.*-suc 32 (n ∸ 16) ⟨ 32 * suc (n ∸ 16) - ≡⟨ Eq.cong (32 *_) (ℕ.+-∸-assoc 1 16≤n) ⟨ + ≡⟨ Eq.cong (32 *_) {n ∸ 15} {suc (n ∸ 16)} (ℕ.+-∸-assoc 1 16≤n) ⟨ 32 * (n ∸ 15) ≡⟨⟩ 2 ^ 5 * (n ∸ 15) @@ -410,5 +572,5 @@ id∈𝒪[exponential] : id ∈ 𝒪[ (λ n → 2 ^ (n / 3)) ] id∈𝒪[exponential] .proj₁ = 15 id∈𝒪[exponential] .proj₂ n = 2^n≥n n -2CC Date: Tue, 9 Dec 2025 19:06:29 +0100 Subject: [PATCH 68/82] =?UTF-8?q?Prove=20VariantList=20=E2=89=A4=E2=82=9B?= =?UTF-8?q?=20ADT?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../VariantList\342\211\244ADT.agda" | 122 ++++++++++++++++++ src/Vatras/Util/AuxProofs.agda | 8 ++ 2 files changed, 130 insertions(+) create mode 100644 "src/Vatras/Succinctness/Relations/VariantList\342\211\244ADT.agda" diff --git "a/src/Vatras/Succinctness/Relations/VariantList\342\211\244ADT.agda" "b/src/Vatras/Succinctness/Relations/VariantList\342\211\244ADT.agda" new file mode 100644 index 00000000..a1f4f002 --- /dev/null +++ "b/src/Vatras/Succinctness/Relations/VariantList\342\211\244ADT.agda" @@ -0,0 +1,122 @@ +open import Data.Nat using (ℕ; suc; _+_; _≤_; s≤s) +open import Relation.Binary using (DecidableEquality) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; 𝕍) + +module Vatras.Succinctness.Relations.VariantList≤ADT + (F : 𝔽) + (V : 𝕍) + (_==_ : DecidableEquality F) + (sizeV : ∀ {A : 𝔸} → V A → ℕ) + where + +open import Data.Bool using (true; false; if_then_else_) +import Data.Bool.Properties as Bool +open import Data.List as List using ([]; _∷_) +import Data.List.Properties as List +open import Data.List.NonEmpty as List⁺ using (_⁺++⁺_) +open import Data.Product using (_,_; proj₁; proj₂) +import Data.Nat.Properties as ℕ +import Relation.Binary.PropositionalEquality as Eq +open import Relation.Nullary.Decidable using (yes; no) + +open import Vatras.Util.AuxProofs using (Predicate-if) +import Vatras.Util.List as List +open import Vatras.Data.EqIndexedSet using (≅-sym; ≅[]→≅) +open import Vatras.Framework.Compiler using (LanguageCompiler) +open import Vatras.Succinctness.ProofDefinition V using (_≤ₛ_) +open import Vatras.Succinctness.Sizes using (SizedVariantList; sizeVariantList; SizedADT; sizeADT) + +open import Vatras.Lang.All.Fixed F V +open ADT using (ADT; leaf; _⟨_,_⟩) +open VariantList using (VariantList) + +open import Vatras.Lang.ADT.Path F V _==_ using (Path; _↣_; getValue; _∈?_) +open import Vatras.Translation.Lang.ADT.DeadElim F V _==_ using (kill-dead-below; kill-dead) +open import Vatras.Translation.Lang.ADT-to-VariantList F V _==_ using (ADT→VariantList; tr; tr-undead) + +size-kill-dead : ∀ {A : 𝔸} (defined : Path) (adt : ADT A) → sizeADT sizeV (kill-dead-below defined adt) ≤ sizeADT sizeV adt +size-kill-dead defined (leaf v) = ℕ.≤-refl +size-kill-dead defined (D ⟨ l , r ⟩) with D ∈? defined +size-kill-dead defined (D ⟨ l , r ⟩) | yes D∈defined = + begin + sizeADT sizeV (if getValue D∈defined then kill-dead-below defined l else kill-dead-below defined r) + ≡⟨ Bool.if-float (sizeADT sizeV) (getValue D∈defined) ⟩ + (if getValue D∈defined then sizeADT sizeV (kill-dead-below defined l) else sizeADT sizeV (kill-dead-below defined r)) + ≤⟨ Predicate-if (_≤ _) (getValue D∈defined) + (ℕ.≤-trans (size-kill-dead defined l) (ℕ.m≤m+n (sizeADT sizeV l) (sizeADT sizeV r))) + (ℕ.≤-trans (size-kill-dead defined r) (ℕ.m≤n+m (sizeADT sizeV r) (sizeADT sizeV l))) + ⟩ + sizeADT sizeV l + sizeADT sizeV r + <⟨ ℕ.n<1+n (sizeADT sizeV l + sizeADT sizeV r) ⟩ + suc (sizeADT sizeV l + sizeADT sizeV r) + ≡⟨⟩ + sizeADT sizeV (D ⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning +size-kill-dead defined (D ⟨ l , r ⟩) | no D∉defined = + begin + sizeADT sizeV (D ⟨ kill-dead-below (D ↣ true ∷ defined) l , kill-dead-below (D ↣ false ∷ defined) r ⟩) + ≡⟨⟩ + suc (sizeADT sizeV (kill-dead-below (D ↣ true ∷ defined) l) + sizeADT sizeV (kill-dead-below (D ↣ false ∷ defined) r)) + ≤⟨ s≤s (ℕ.+-mono-≤ (size-kill-dead (D ↣ true ∷ defined) l) (size-kill-dead (D ↣ false ∷ defined) r)) ⟩ + suc (sizeADT sizeV l + sizeADT sizeV r) + ≡⟨⟩ + sizeADT sizeV (D ⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning + +size-tr : ∀ {A : 𝔸} (adt : ADT A) → sizeVariantList {V} sizeV (tr adt) ≤ sizeADT sizeV adt +size-tr (leaf v) = + begin + sizeVariantList {V} sizeV (tr (leaf v)) + ≡⟨⟩ + sizeV v + 0 + ≡⟨ ℕ.+-identityʳ (sizeV v) ⟩ + sizeV v + <⟨ ℕ.n<1+n (sizeV v) ⟩ + 1 + sizeV v + ≡⟨⟩ + sizeADT sizeV (leaf v) + ∎ + where + open ℕ.≤-Reasoning +size-tr (f ⟨ l , r ⟩) = + begin + sizeVariantList {V} sizeV (tr (f ⟨ l , r ⟩)) + ≡⟨⟩ + sizeVariantList {V} sizeV (tr l ⁺++⁺ tr r) + ≡⟨⟩ + List.sum (List⁺.toList (List⁺.map sizeV (tr l ⁺++⁺ tr r))) + ≡⟨ Eq.cong (λ x → List.sum (List⁺.toList x)) (List.map-⁺++⁺ sizeV (tr l) (tr r)) ⟩ + List.sum (List⁺.toList (List⁺.map sizeV (tr l) ⁺++⁺ List⁺.map sizeV (tr r))) + ≡⟨ List.sum-++ (List⁺.toList (List⁺.map sizeV (tr l))) (List⁺.toList (List⁺.map sizeV (tr r))) ⟩ + List.sum (List⁺.toList (List⁺.map sizeV (tr l))) + List.sum (List⁺.toList (List⁺.map sizeV (tr r))) + ≡⟨⟩ + sizeVariantList {V} sizeV (tr l) + sizeVariantList {V} sizeV (tr r) + ≤⟨ ℕ.+-mono-≤ (size-tr l) (size-tr r) ⟩ + sizeADT sizeV l + sizeADT sizeV r + <⟨ ℕ.n<1+n (sizeADT sizeV l + sizeADT sizeV r) ⟩ + suc (sizeADT sizeV l + sizeADT sizeV r) + ≡⟨⟩ + sizeADT sizeV (f ⟨ l , r ⟩) + ∎ + where + open ℕ.≤-Reasoning + +size-tr-kill-dead : ∀ {A : 𝔸} (adt : ADT A) → sizeVariantList {V} sizeV (tr-undead (kill-dead adt)) ≤ sizeADT sizeV adt +size-tr-kill-dead adt = + begin + sizeVariantList {V} sizeV (tr-undead (kill-dead adt)) + ≤⟨ size-tr (kill-dead-below [] adt) ⟩ + sizeADT sizeV (kill-dead-below [] adt) + ≤⟨ size-kill-dead [] adt ⟩ + sizeADT sizeV adt + ∎ + where + open ℕ.≤-Reasoning + +VariantList≤ADT : SizedVariantList V sizeV ≤ₛ SizedADT F V sizeV +VariantList≤ADT .proj₁ = 1 +VariantList≤ADT .proj₂ A e₂ e₂-translatable = LanguageCompiler.compile ADT→VariantList e₂ , ≅-sym (≅[]→≅ (LanguageCompiler.preserves ADT→VariantList e₂)) , ℕ.≤-trans (size-tr-kill-dead e₂) (ℕ.≤-reflexive (Eq.sym (ℕ.+-identityʳ (sizeADT sizeV e₂)))) diff --git a/src/Vatras/Util/AuxProofs.agda b/src/Vatras/Util/AuxProofs.agda index 4653c528..30d3301f 100644 --- a/src/Vatras/Util/AuxProofs.agda +++ b/src/Vatras/Util/AuxProofs.agda @@ -111,6 +111,14 @@ if-cong : ∀ {ℓ} {A : Set ℓ} {a b c d : A} x → (if x then a else b) ≡ (if x then c else d) if-cong _ refl refl = refl +Predicate-if : ∀ {a} {A : Set a} {p} (P : A → Set p) {a b : A} x + → P a + → P b + → P (if x then a else b) +Predicate-if P false p₁ p₂ = p₂ +Predicate-if P true p₁ p₂ = p₁ + + ----- Properties for Decidability does≡true : ∀ {p} {P : Set p} → (dec : Dec P) → P → does dec ≡ true From d38fafb74088bbb8052c9dff35fe036dd8708fe4 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 9 Dec 2025 19:09:52 +0100 Subject: [PATCH 69/82] =?UTF-8?q?Prove=20NADT=20=E2=89=A4=E2=82=9B=20Varia?= =?UTF-8?q?ntList?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../NADT\342\211\244VariantList.agda" | 105 ++++++++++++++++++ src/Vatras/Util/List.agda | 27 +++++ 2 files changed, 132 insertions(+) create mode 100644 "src/Vatras/Succinctness/Relations/NADT\342\211\244VariantList.agda" diff --git "a/src/Vatras/Succinctness/Relations/NADT\342\211\244VariantList.agda" "b/src/Vatras/Succinctness/Relations/NADT\342\211\244VariantList.agda" new file mode 100644 index 00000000..9440d90d --- /dev/null +++ "b/src/Vatras/Succinctness/Relations/NADT\342\211\244VariantList.agda" @@ -0,0 +1,105 @@ +open import Data.Nat using (ℕ; zero; suc; _+_; _*_; _≤_; _>_; z≤n; s≤s) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; 𝕍) + +module Vatras.Succinctness.Relations.NADT≤VariantList (F : 𝔽) (V : 𝕍) (sizeV : ∀ {A : 𝔸} → V A → ℕ) (sizeV>0 : ∀ {A} (v : V A) → sizeV v > 0) (f : F) where + +open import Data.Product using (_,_; proj₁; proj₂) +import Data.Nat.Properties as ℕ +open import Data.List using ([]; _∷_; map; sum; length) +import Data.List.Properties as List +open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_) +import Relation.Binary.PropositionalEquality as Eq +open import Function using (const; _∘_) +open import Size using (∞) + +open import Vatras.Data.EqIndexedSet using (_≅[_][_]_; _⊆[_]_; ≅[]→≅) +open import Vatras.Util.List as List using (find-or-last) +open import Vatras.Succinctness.ProofDefinition V using (_≤ₛ_) +open import Vatras.Succinctness.Sizes using (SizedVariantList; sizeVariantList; SizedNADT; sizeNADT) +open import Vatras.Lang.All.Fixed F V +open VariantList using (VariantList) +open NADT using (NADT; _⟨_⟩; leaf) + +translate : ∀ {A : 𝔸} → VariantList A → NADT ∞ A +translate vs = f ⟨ List⁺.map leaf vs ⟩ + +translate-preserves-⊆ : ∀ {A : 𝔸} → (vs : VariantList A) → NADT.⟦ translate vs ⟧ ⊆[ (λ c → c f) ] VariantList.⟦ vs ⟧ +translate-preserves-⊆ vs config = + NADT.⟦ translate vs ⟧ config + ≡⟨⟩ + NADT.⟦ find-or-last (config f) (List⁺.map leaf vs) ⟧ config + ≡⟨ Eq.cong (λ x → NADT.⟦ x ⟧ config) (List.map-find-or-last leaf (config f) vs) ⟨ + NADT.⟦ leaf (find-or-last (config f) vs) ⟧ config + ≡⟨⟩ + find-or-last (config f) vs + ≡⟨⟩ + VariantList.⟦ vs ⟧ (config f) + ∎ + where + open Eq.≡-Reasoning + +translate-preserves-⊇ : ∀ {A : 𝔸} → (vs : VariantList A) → VariantList.⟦ vs ⟧ ⊆[ const ] NADT.⟦ translate vs ⟧ +translate-preserves-⊇ vs i = + VariantList.⟦ vs ⟧ i + ≡⟨⟩ + find-or-last i vs + ≡⟨⟩ + NADT.⟦ leaf (find-or-last i vs) ⟧ (const i) + ≡⟨ Eq.cong (λ x → NADT.⟦ x ⟧ (const i)) (List.map-find-or-last leaf i vs) ⟩ + NADT.⟦ find-or-last i (List⁺.map leaf vs) ⟧ (const i) + ≡⟨⟩ + NADT.⟦ translate vs ⟧ (const i) + ∎ + where + open Eq.≡-Reasoning + +translate-preserves : ∀ {A : 𝔸} → (vs : VariantList A) → NADT.⟦ translate vs ⟧ ≅[ (λ c → c f) ][ const ] VariantList.⟦ vs ⟧ +translate-preserves vs = translate-preserves-⊆ vs , translate-preserves-⊇ vs + +lemma : ∀ {A : 𝔸} (vs : VariantList A) → sizeNADT sizeV (translate vs) ≤ 3 * sizeVariantList {V} sizeV vs +lemma {A} vs = + begin + sizeNADT sizeV (translate vs) + ≡⟨⟩ + suc (sum (map (sizeNADT sizeV) (List⁺.toList (List⁺.map leaf vs)))) + ≡⟨⟩ + suc (sum (map (sizeNADT sizeV) (map leaf (List⁺.toList vs)))) + ≡⟨ Eq.cong (λ x → suc (sum x)) (List.map-∘ {g = sizeNADT sizeV} {f = leaf} (List⁺.toList vs)) ⟨ + suc (sum (map (sizeNADT sizeV ∘ leaf) (List⁺.toList vs))) + ≡⟨⟩ + suc (sum (map (λ v → suc (sizeV v)) (List⁺.toList vs))) + ≡⟨ Eq.cong (λ x → suc (sum x)) (List.map-∘ {g = suc} (List⁺.toList vs)) ⟩ + suc (sum (map suc (map sizeV (List⁺.toList vs)))) + ≡⟨ Eq.cong suc (List.sum-+ 1 (map sizeV (List⁺.toList vs))) ⟩ + suc (1 * length (map sizeV (List⁺.toList vs)) + sum (map sizeV (List⁺.toList vs))) + ≡⟨ Eq.cong (λ x → suc (x + sum (map sizeV (List⁺.toList vs)))) (ℕ.*-identityˡ (length (map sizeV (List⁺.toList vs)))) ⟩ + suc (length (map sizeV (List⁺.toList vs)) + sum (map sizeV (List⁺.toList vs))) + ≡⟨ Eq.cong (λ x → suc (x + sum (map sizeV (List⁺.toList vs)))) (List.length-map sizeV (List⁺.toList vs)) ⟩ + suc (List⁺.length vs + sum (map sizeV (List⁺.toList vs))) + ≡⟨⟩ + 1 + List⁺.length vs + sum (map sizeV (List⁺.toList vs)) + ≤⟨ ℕ.+-monoˡ-≤ (sum (map sizeV (List⁺.toList vs))) (ℕ.+-monoˡ-≤ (List⁺.length vs) (s≤s (z≤n {length (List⁺.tail vs)}))) ⟩ + List⁺.length vs + List⁺.length vs + sum (map sizeV (List⁺.toList vs)) + ≡⟨ Eq.cong (λ x → (List⁺.length vs + x) + sum (map sizeV (List⁺.toList vs))) (ℕ.+-identityʳ (List⁺.length vs)) ⟨ + List⁺.length vs + (List⁺.length vs + 0) + sum (map sizeV (List⁺.toList vs)) + ≡⟨⟩ + 2 * List⁺.length vs + sum (map sizeV (List⁺.toList vs)) + ≡⟨ Eq.cong (λ x → 2 * x + sum (map sizeV (List⁺.toList vs))) (ℕ.*-identityˡ (List⁺.length vs)) ⟨ + 2 * (1 * List⁺.length vs) + sum (map sizeV (List⁺.toList vs)) + ≡⟨ Eq.cong (λ x → 2 * x + sum (map sizeV (List⁺.toList vs))) (List.sum-map-const 1 (List⁺.toList vs)) ⟨ + 2 * sum (map (const 1) (List⁺.toList vs)) + sum (map sizeV (List⁺.toList vs)) + ≤⟨ ℕ.+-monoˡ-≤ (sum (map sizeV (List⁺.toList vs))) (ℕ.*-monoʳ-≤ 2 (List.sum-map-≤ (const 1) sizeV (List⁺.toList vs) sizeV>0)) ⟩ + 2 * sum (map sizeV (List⁺.toList vs)) + sum (map sizeV (List⁺.toList vs)) + ≡⟨ Eq.cong (2 * sum (map sizeV (List⁺.toList vs)) +_) (ℕ.*-identityˡ (sum (map sizeV (List⁺.toList vs)))) ⟨ + 2 * sum (map sizeV (List⁺.toList vs)) + 1 * sum (map sizeV (List⁺.toList vs)) + ≡⟨ ℕ.*-distribʳ-+ (sum (map sizeV (List⁺.toList vs))) 2 1 ⟨ + 3 * sum (map sizeV (List⁺.toList vs)) + ≡⟨⟩ + 3 * sizeVariantList {V} sizeV vs + ∎ + where + open ℕ.≤-Reasoning + +NADT≤VariantList : SizedNADT F V sizeV ≤ₛ SizedVariantList V sizeV +NADT≤VariantList .proj₁ = 3 +NADT≤VariantList .proj₂ A vs vs-translatable = translate vs , ≅[]→≅ (translate-preserves vs) , lemma {A} vs diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index a33ff3ba..e1478de4 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -329,6 +329,33 @@ sum-map-const n (x ∷ xs) = where open Eq.≡-Reasoning +sum-+ : ∀ (n : ℕ) (xs : List ℕ) → List.sum (List.map (n +_) xs) ≡ n * List.length xs + List.sum xs +sum-+ n [] = Eq.trans (Eq.sym (ℕ.*-zeroʳ n)) (Eq.sym (ℕ.+-identityʳ (n * 0))) +sum-+ n (x ∷ xs) = + begin + List.sum (List.map (n +_) (x ∷ xs)) + ≡⟨⟩ + n + x + List.sum (List.map (n +_) xs) + ≡⟨ Eq.cong (n + x +_) (sum-+ n xs) ⟩ + n + x + (n * List.length xs + List.sum xs) + ≡⟨ Eq.cong (_+ (n * List.length xs + List.sum xs)) (ℕ.+-comm n x) ⟩ + x + n + (n * List.length xs + List.sum xs) + ≡⟨ ℕ.+-assoc (x + n) (n * List.length xs) (List.sum xs) ⟨ + (x + n + n * List.length xs) + List.sum xs + ≡⟨ Eq.cong (_+ List.sum xs) (ℕ.+-assoc x n (n * List.length xs)) ⟩ + (x + (n + n * List.length xs)) + List.sum xs + ≡⟨ Eq.cong (_+ List.sum xs) (ℕ.+-comm x (n + n * List.length xs)) ⟩ + ((n + n * List.length xs) + x) + List.sum xs + ≡⟨ ℕ.+-assoc (n + n * List.length xs) x (List.sum xs) ⟩ + (n + n * List.length xs) + (x + List.sum xs) + ≡⟨ Eq.cong (_+ (x + List.sum xs)) (ℕ.*-suc n (List.length xs)) ⟨ + n * suc (List.length xs) + (x + List.sum xs) + ≡⟨⟩ + n * List.length (x ∷ xs) + List.sum (x ∷ xs) + ∎ + where + open Eq.≡-Reasoning + sum-* : ∀ (n : ℕ) (xs : List ℕ) → List.sum (List.map (n *_) xs) ≡ n * List.sum xs sum-* n [] = Eq.sym (ℕ.*-zeroʳ n) sum-* n (x ∷ xs) = From 4a07f0dc83af3156dc83ab7b5acee131dcf104f9 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 9 Dec 2025 19:13:21 +0100 Subject: [PATCH 70/82] =?UTF-8?q?Prove=20ADT=20=E2=89=A4=E2=82=9B=20NADT?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../Relations/ADT\342\211\244NADT.agda" | 416 ++++++++++++++++++ src/Vatras/Succinctness/Sizes.agda | 8 + 2 files changed, 424 insertions(+) create mode 100644 "src/Vatras/Succinctness/Relations/ADT\342\211\244NADT.agda" diff --git "a/src/Vatras/Succinctness/Relations/ADT\342\211\244NADT.agda" "b/src/Vatras/Succinctness/Relations/ADT\342\211\244NADT.agda" new file mode 100644 index 00000000..32be9e30 --- /dev/null +++ "b/src/Vatras/Succinctness/Relations/ADT\342\211\244NADT.agda" @@ -0,0 +1,416 @@ +open import Data.Nat using (ℕ; zero; suc; _+_; _*_; pred; _∸_; _≟_; _≤_; _<_; z≤n; s≤s; _0; SizedADT; sizeADT) +open import Vatras.Lang.All +open ADT using (ADT) +open NADT using (NADT) + +open import Vatras.Translation.Lang.ADT-to-VariantList using () + +translate : ∀ {i : Size} {A : 𝔸} → NADT F V i A → ADT (F × ℕ) V A +translate-cs : ∀ {i : Size} {A : 𝔸} → F → ℕ → (NADT F V i A) → List (NADT F V i A) → ADT (F × ℕ) V A + +-- TODO why do I need ADT.ADT +translate (NADT.leaf v) = ADT.ADT.leaf v +translate (f NADT.⟨ c ∷ cs ⟩) = translate-cs f zero c cs + +translate-cs f n c [] = translate c +translate-cs f n c₁ (c₂ ∷ cs) = (f , n) ADT.ADT.⟨ translate c₁ , translate-cs f (suc n) c₂ cs ⟩ + +⌈_⌉ : ∀ {i : Size} {A : 𝔸} → NADT F V i A → ℕ +⌈ NADT.leaf v ⌉ = 1 +⌈ f NADT.⟨ c ∷ cs ⟩ ⌉ = length (c ∷ cs) ⊔ max (map ⌈_⌉ (c ∷ cs)) + +data ChoiceArity≤ (n : ℕ) {A : 𝔸} : {i : Size} → NADT F V i A → Set₁ where + leaf : + ∀ {i : Size} + → (v : V A) + → ChoiceArity≤ n {i = ↑ i} (NADT.NADT.leaf v) + choice : + ∀ {i : Size} + → (f : F) + → (c : NADT F V i A) + → (cs : List (NADT F V i A)) + → length (c ∷ cs) ≤ n + → All (ChoiceArity≤ n) (c ∷ cs) + → ChoiceArity≤ n (f NADT.NADT.⟨ c ∷ cs ⟩) + +⌈⌉-head : + ∀ {i : Size} {A : 𝔸} + → (c : NADT F V i A) + → (cs : List (NADT F V i A)) + → ⌈ c ⌉ ≤ length (c ∷ cs) ⊔ max (map ⌈_⌉ (c ∷ cs)) +⌈⌉-head c cs = + begin + ⌈ c ⌉ + ≤⟨ ℕ.m≤m⊔n ⌈ c ⌉ (max (map ⌈_⌉ cs)) ⟩ + ⌈ c ⌉ ⊔ max (map ⌈_⌉ cs) + ≤⟨ ℕ.m≤n⊔m (length (c ∷ cs)) (⌈ c ⌉ ⊔ max (map ⌈_⌉ cs)) ⟩ + length (c ∷ cs) ⊔ (⌈ c ⌉ ⊔ max (map ⌈_⌉ cs)) + ≡⟨⟩ + length (c ∷ cs) ⊔ max (map ⌈_⌉ (c ∷ cs)) + ∎ + where + open ℕ.≤-Reasoning + +⌈⌉-tail : + ∀ {i : Size} {A : 𝔸} + → (c : NADT F V i A) + → (cs : List (NADT F V i A)) + → length cs ⊔ max (map ⌈_⌉ cs) ≤ length (c ∷ cs) ⊔ max (map ⌈_⌉ (c ∷ cs)) +⌈⌉-tail c cs = + begin + length cs ⊔ max (map ⌈_⌉ cs) + ≤⟨ ℕ.⊔-monoʳ-≤ (length cs) (ℕ.m≤n⊔m ⌈ c ⌉ (max (map ⌈_⌉ cs))) ⟩ + length cs ⊔ (⌈ c ⌉ ⊔ max (map ⌈_⌉ cs)) + ≤⟨ ℕ.⊔-monoˡ-≤ (⌈ c ⌉ ⊔ max (map ⌈_⌉ cs)) (ℕ.n≤1+n (length cs)) ⟩ + length (c ∷ cs) ⊔ (⌈ c ⌉ ⊔ max (map ⌈_⌉ cs)) + ≡⟨⟩ + length (c ∷ cs) ⊔ max (map ⌈_⌉ (c ∷ cs)) + ∎ + where + open ℕ.≤-Reasoning + +weaken-ChoiceArity : + ∀ {i : Size} → {A : 𝔸} + → {m n : ℕ} + → m ≤ n + → {nadt : NADT F V i A} + → ChoiceArity≤ m nadt + → ChoiceArity≤ n nadt +weaken-ChoiceArity m≤n (leaf v) = leaf v +weaken-ChoiceArity m≤n (choice f c cs cs≤m ChoiceArity-cs) = choice f c cs (ℕ.≤-trans cs≤m m≤n) (All.map (weaken-ChoiceArity m≤n) ChoiceArity-cs) + +ChoiceArity≤-⌈⌉ : ∀ {i : Size} → {A : 𝔸} → (nadt : NADT F V i A) → ChoiceArity≤ ⌈ nadt ⌉ nadt +ChoiceArity≤-⌈⌉ (NADT.leaf v) = leaf v +ChoiceArity≤-⌈⌉ {A = A} (f NADT.⟨ c ∷ cs ⟩) = choice f c cs (ℕ.m≤m⊔n (length (c ∷ cs)) (max (map ⌈_⌉ (c ∷ cs)))) (lemma c cs) + where + open ℕ.≤-Reasoning + + lemma : ∀ {i : Size} → (c : NADT F V i A) → (cs : List (NADT F V i A)) → All (ChoiceArity≤ ⌈ f NADT.NADT.⟨ c ∷ cs ⟩ ⌉) (c ∷ cs) + lemma c [] = weaken-ChoiceArity (⌈⌉-head c []) (ChoiceArity≤-⌈⌉ c) ∷ [] + lemma c₁ (c₂ ∷ cs) = + weaken-ChoiceArity (⌈⌉-head c₁ (c₂ ∷ cs)) (ChoiceArity≤-⌈⌉ c₁) + ∷ All.map (weaken-ChoiceArity (⌈⌉-tail c₁ (c₂ ∷ cs))) (lemma c₂ cs) + +conf' : ℕ → ℕ → ADT.Configuration (F × ℕ) → NADT.Configuration F +conf' zero n config f = n +conf' (suc fuel) n config f with config (f , n) +conf' (suc fuel) n config f | true = n +conf' (suc fuel) n config f | false = conf' fuel (suc n) config f + +conf : ℕ → ADT.Configuration (F × ℕ) → NADT.Configuration F +conf fuel config f = conf' fuel zero config f + +fnoc : NADT.Configuration F → ADT.Configuration (F × ℕ) +fnoc config (f , n) = does (config f ≤? n) + +conf≡n : + ∀ fuel n config f goal + → goal < n + fuel + → n ≤ goal + → (∀ k → k < goal → config (f , k) ≡ false) + → config (f , goal) ≡ true + → conf' fuel n config f ≡ goal +conf≡n zero n config f goal goaln : + ∀ fuel n config f goal + → goal < n + fuel + → n ≤ goal + → (∀ k → k < goal → config (f , k) ≡ false) + → config (f , goal) ≡ false + → goal < conf' fuel n config f +conf>n zero n config f goal goaln (suc fuel) n config f goal goaln fuel (suc n) config f goal + (ℕ.≤-trans goaln m zero config f n ( + begin-strict + n + ≡⟨ ℕ.+-identityʳ n ⟨ + n + 0 + <⟨ ℕ.+-monoʳ-< n (s≤s z≤n) ⟩ + n + length (c₁ ∷ c₂ ∷ cs) + ≤⟨ n+cs≤m ⟩ + m + ∎) z≤n config≡false config-f) + ⟩ + conf m config f ∸ n + ∎ + where + open ℕ.≤-Reasoning + + open Eq.≡-Reasoning + +translate-preserves-⊇ : ∀ {A : 𝔸} → (nadt : NADT F V ∞ A) → NADT.⟦ nadt ⟧ ⊆[ fnoc ] ADT.⟦ translate nadt ⟧ +translate-preserves-⊇ (NADT.leaf v) config = refl +translate-preserves-⊇ {A} (f NADT.⟨ c ∷ cs ⟩) config = go zero c cs + where + go : (n : ℕ) → (c : NADT F V ∞ A) → (cs : List (NADT F V ∞ A)) → NADT.⟦ find-or-last (config f ∸ n) (c ∷ cs) ⟧ config ≡ ADT.⟦ translate-cs f n c cs ⟧ (fnoc config) + go n c [] = translate-preserves-⊇ c config + go n c₁ (c₂ ∷ cs) with config f ≤? n in config-f≤n-proof + go n c₁ (c₂ ∷ cs) | yes config-f≤n = + NADT.⟦ find-or-last (config f ∸ n) (c₁ ∷ c₂ ∷ cs) ⟧ config + ≡⟨ Eq.cong (λ x → NADT.⟦ find-or-last x (c₁ ∷ c₂ ∷ cs) ⟧ config) (ℕ.m≤n⇒m∸n≡0 config-f≤n) ⟩ + NADT.⟦ find-or-last zero (c₁ ∷ c₂ ∷ cs) ⟧ config + ≡⟨⟩ + NADT.⟦ c₁ ⟧ config + ≡⟨ translate-preserves-⊇ c₁ config ⟩ + ADT.⟦ translate c₁ ⟧ (fnoc config) + ≡⟨⟩ + (if true then ADT.⟦ translate c₁ ⟧ (fnoc config) else ADT.⟦ translate-cs f (suc n) c₂ cs ⟧ (fnoc config) ) + ≡⟨ Eq.cong (if_then ADT.⟦ translate c₁ ⟧ (fnoc config) else ADT.⟦ translate-cs f (suc n) c₂ cs ⟧ (fnoc config)) (Eq.cong does config-f≤n-proof) ⟨ + (if fnoc config (f , n) then ADT.⟦ translate c₁ ⟧ (fnoc config) else ADT.⟦ translate-cs f (suc n) c₂ cs ⟧ (fnoc config) ) + ≡⟨⟩ + ADT.⟦ (f , n) ADT.ADT.⟨ translate c₁ , translate-cs f (suc n) c₂ cs ⟩ ⟧ (fnoc config) + ≡⟨⟩ + ADT.⟦ translate-cs f n c₁ (c₂ ∷ cs) ⟧ (fnoc config) + ∎ + where + open Eq.≡-Reasoning + go n c₁ (c₂ ∷ cs) | no config-f≰n = + NADT.⟦ find-or-last (config f ∸ n) (c₁ ∷ c₂ ∷ cs) ⟧ config + ≡⟨ Eq.cong (λ x → NADT.⟦ x ⟧ config) (List.find-or-last-prepend-∸ {n = config f ∸ n} (c₁ ∷ []) (c₂ ∷ cs) fnoc-lemma) ⟩ + NADT.⟦ find-or-last ((config f ∸ n) ∸ 1) (c₂ ∷ cs) ⟧ config + ≡⟨ Eq.cong (λ x → NADT.⟦ find-or-last x (c₂ ∷ cs) ⟧ config) (ℕ.∸-+-assoc (config f) n 1) ⟩ + NADT.⟦ find-or-last (config f ∸ (n + 1)) (c₂ ∷ cs) ⟧ config + ≡⟨ Eq.cong (λ x → NADT.⟦ find-or-last (config f ∸ x) (c₂ ∷ cs) ⟧ config) (ℕ.+-comm n 1) ⟩ + NADT.⟦ find-or-last (config f ∸ suc n) (c₂ ∷ cs) ⟧ config + ≡⟨ go (suc n) c₂ cs ⟩ + ADT.⟦ translate-cs f (suc n) c₂ cs ⟧ (fnoc config) + ≡⟨⟩ + (if false then ADT.⟦ translate c₁ ⟧ (fnoc config) else ADT.⟦ translate-cs f (suc n) c₂ cs ⟧ (fnoc config) ) + ≡⟨ Eq.cong (if_then ADT.⟦ translate c₁ ⟧ (fnoc config) else ADT.⟦ translate-cs f (suc n) c₂ cs ⟧ (fnoc config)) (Eq.cong does config-f≤n-proof) ⟨ + (if fnoc config (f , n) then ADT.⟦ translate c₁ ⟧ (fnoc config) else ADT.⟦ translate-cs f (suc n) c₂ cs ⟧ (fnoc config)) + ≡⟨⟩ + ADT.⟦ (f , n) ADT.ADT.⟨ translate c₁ , translate-cs f (suc n) c₂ cs ⟩ ⟧ (fnoc config) + ≡⟨⟩ + ADT.⟦ translate-cs f n c₁ (c₂ ∷ cs) ⟧ (fnoc config) + ∎ + where + fnoc-lemma : List⁺.length (c₁ ∷ []) Data.Nat.≤ config f ∸ n + fnoc-lemma = + begin + List⁺.length (c₁ ∷ []) + ≡⟨⟩ + 1 + ≡⟨ Eq.cong suc (ℕ.n∸n≡0 n) ⟨ + suc (n ∸ n) + ≡⟨ ℕ.+-∸-assoc 1 {n} ℕ.≤-refl ⟨ + suc n ∸ n + ≤⟨ ℕ.∸-monoˡ-≤ n (ℕ.≰⇒> config-f≰n) ⟩ + config f ∸ n + ∎ + where + open ℕ.≤-Reasoning + open Eq.≡-Reasoning + +translate-preserves : ∀ {A : 𝔸} → (nadt : NADT F V ∞ A) → ADT.⟦ translate nadt ⟧ ≅[ conf ⌈ nadt ⌉ ][ fnoc ] NADT.⟦ nadt ⟧ +translate-preserves nadt = translate-preserves-⊆ ⌈ nadt ⌉ (ChoiceArity≤-⌈⌉ nadt) , translate-preserves-⊇ nadt + +lemma : ∀ {i : Size} {A : 𝔸} → (nadt : NADT F V i A) → sizeADT sizeV (translate nadt) ≤ 2 * sizeNADT sizeV nadt ∸ 1 +lemma {A = A} (NADT.leaf v) = + begin + sizeADT sizeV (translate (NADT.NADT.leaf v)) + ≡⟨⟩ + sizeNADT {V = V} sizeV (NADT.NADT.leaf {F = F} v) + ≡⟨⟩ + suc (sizeV v) + ≡⟨⟩ + 2 + sizeV v ∸ 1 + ≡⟨ Eq.cong (λ x → 2 + x ∸ 1) (ℕ.*-identityˡ (sizeV v)) ⟨ + 2 + 1 * sizeV v ∸ 1 + ≤⟨ ℕ.∸-monoˡ-≤ 1 (ℕ.+-monoʳ-≤ 2 (ℕ.*-monoˡ-≤ (sizeV v) (s≤s (z≤n {1})))) ⟩ + 2 + 2 * sizeV v ∸ 1 + ≡⟨ Eq.cong (_∸ 1) (ℕ.*-distribˡ-+ 2 1 (sizeV v)) ⟨ + 2 * suc (sizeV v) ∸ 1 + ≡⟨⟩ + 2 * sizeNADT {V = V} sizeV (NADT.NADT.leaf {F = F} v) ∸ 1 + ∎ + where + open ℕ.≤-Reasoning +lemma {A = A} (f NADT.⟨ c ∷ cs ⟩) = + begin + sizeADT sizeV (translate (f NADT.NADT.⟨ c ∷ cs ⟩)) + ≡⟨⟩ + sizeADT sizeV (translate-cs f zero c cs) + ≤⟨ go zero c cs ⟩ + 2 * sum (map (sizeNADT sizeV) (c ∷ cs)) + ≤⟨ ℕ.n≤1+n (2 * sum (map (sizeNADT sizeV) (c ∷ cs))) ⟩ + 1 + 2 * sum (map (sizeNADT sizeV) (c ∷ cs)) + ≡⟨⟩ + (2 + 2 * sum (map (sizeNADT sizeV) (c ∷ cs))) ∸ 1 + ≡⟨ Eq.cong (_∸ 1) (ℕ.*-distribˡ-+ 2 1 (sum (map (sizeNADT sizeV) (c ∷ cs)))) ⟨ + 2 * suc (sum (map (sizeNADT sizeV) (c ∷ cs))) ∸ 1 + ≡⟨⟩ + 2 * suc (sum (map (sizeNADT sizeV) (c ∷ cs))) ∸ 1 + ≡⟨⟩ + 2 * sizeNADT sizeV (f NADT.NADT.⟨ c ∷ cs ⟩) ∸ 1 + ∎ + where + open ℕ.≤-Reasoning + + go : ∀ {i : Size} → (n : ℕ) → (c : NADT F V i A) → (cs : List (NADT F V i A)) + → sizeADT sizeV (translate-cs f n c cs) + ≤ 2 * sum (map (sizeNADT sizeV) (c ∷ cs)) + go n c [] = + begin + sizeADT sizeV (translate-cs f n c []) + ≡⟨⟩ + sizeADT sizeV (translate c) + ≤⟨ lemma c ⟩ + 2 * sizeNADT sizeV c ∸ 1 + ≤⟨ ℕ.m∸n≤m (2 * sizeNADT sizeV c) 1 ⟩ + 2 * sizeNADT sizeV c + ≡⟨ Eq.cong (2 *_) (ℕ.+-identityʳ (sizeNADT sizeV c)) ⟨ + 2 * (sizeNADT sizeV c + 0) + ≡⟨⟩ + 2 * sum (map (sizeNADT sizeV) (c ∷ [])) + ∎ + go n c₁ (c₂ ∷ cs) = + begin + sizeADT sizeV (translate-cs f n c₁ (c₂ ∷ cs)) + ≡⟨⟩ + sizeADT sizeV ((f , n) ADT.ADT.⟨ translate c₁ , translate-cs f (suc n) c₂ cs ⟩) + ≡⟨⟩ + suc (sizeADT sizeV (translate c₁) + sizeADT sizeV (translate-cs f (suc n) c₂ cs)) + ≤⟨ ℕ.+-monoˡ-≤ (sizeADT sizeV (translate-cs f (suc n) c₂ cs)) (s≤s (lemma c₁)) ⟩ + suc (2 * sizeNADT sizeV c₁ ∸ 1) + sizeADT sizeV (translate-cs f (suc n) c₂ cs) + ≤⟨ ℕ.+-monoʳ-≤ (suc (2 * sizeNADT sizeV c₁ ∸ 1)) (go (suc n) c₂ cs) ⟩ + suc (2 * sizeNADT sizeV c₁ ∸ 1) + 2 * sum (map (sizeNADT sizeV) (c₂ ∷ cs)) + ≡⟨ Eq.cong (_+ 2 * sum (map (sizeNADT sizeV) (c₂ ∷ cs))) (ℕ.+-∸-assoc 1 {2 * sizeNADT sizeV c₁} {1} (ℕ.≤-trans (sizeNADT>0 sizeV c₁) (ℕ.m≤n*m (sizeNADT sizeV c₁) 2))) ⟨ + 2 * sizeNADT sizeV c₁ + 2 * sum (map (sizeNADT sizeV) (c₂ ∷ cs)) + ≡⟨ ℕ.*-distribˡ-+ 2 (sizeNADT sizeV c₁) (sum (map (sizeNADT sizeV) (c₂ ∷ cs))) ⟨ + 2 * (sizeNADT sizeV c₁ + sum (map (sizeNADT sizeV) (c₂ ∷ cs))) + ≡⟨⟩ + 2 * sum (map (sizeNADT sizeV) (c₁ ∷ c₂ ∷ cs)) + ∎ + +ADT≤NADT : SizedADT (F × ℕ) V sizeV ≤ₛ SizedNADT F V sizeV +ADT≤NADT .proj₁ = 2 +ADT≤NADT .proj₂ A e₂ e₂-translatable = translate e₂ , ≅[]→≅ (translate-preserves e₂) , ℕ.≤-trans (lemma e₂) (ℕ.m∸n≤m (2 * sizeNADT sizeV e₂) 1) diff --git a/src/Vatras/Succinctness/Sizes.agda b/src/Vatras/Succinctness/Sizes.agda index 58e6c77d..209bb5ff 100644 --- a/src/Vatras/Succinctness/Sizes.agda +++ b/src/Vatras/Succinctness/Sizes.agda @@ -65,6 +65,10 @@ sizeADT : {F : 𝔽} {V : 𝕍} {A : 𝔸} → ({A : 𝔸} → V A → ℕ) → sizeADT variantSize (ADT.ADT.leaf v) = suc (variantSize v) sizeADT variantSize (D ADT.ADT.⟨ l , r ⟩) = suc (sizeADT variantSize l + sizeADT variantSize r) +sizeADT>0 : {F : 𝔽} {V : 𝕍} → (variantSize : {A : 𝔸} → V A → ℕ) → {A : 𝔸} → (adt : ADT.ADT F V A) → sizeADT variantSize adt > 0 +sizeADT>0 variantSize (ADT.ADT.leaf v) = s≤s z≤n +sizeADT>0 variantSize (D ADT.ADT.⟨ l , r ⟩) = s≤s z≤n + SizedADT : 𝔽 → (V : 𝕍) → ({A : 𝔸} → V A → ℕ) → SizedLang V SizedADT F V variantSize = record { Lang = ADT.ADTL F V @@ -75,6 +79,10 @@ sizeNADT : {F : 𝔽} {V : 𝕍} {i : Size} {A : 𝔸} → ({A : 𝔸} → V A sizeNADT variantSize (NADT.NADT.leaf v) = suc (variantSize v) sizeNADT variantSize (D NADT.NADT.⟨ cs ⟩) = suc (List.sum (List.map (sizeNADT variantSize) (List⁺.toList cs))) +sizeNADT>0 : {F : 𝔽} {V : 𝕍} → (variantSize : {A : 𝔸} → V A → ℕ) → {A : 𝔸} → {i : Size} → (nadt : NADT.NADT F V i A) → sizeNADT variantSize nadt > 0 +sizeNADT>0 variantSize (NADT.NADT.leaf v) = s≤s z≤n +sizeNADT>0 variantSize (D NADT.NADT.⟨ cs ⟩) = s≤s z≤n + SizedNADT : 𝔽 → (V : 𝕍) → ({A : 𝔸} → V A → ℕ) → SizedLang V SizedNADT F V variantSize = record { Lang = NADT.NADTL F V From 1cab421986f752d72bf98eecf5270086a557f215 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 9 Dec 2025 19:19:38 +0100 Subject: [PATCH 71/82] =?UTF-8?q?Prove=20NADT=20=E2=89=A4=E2=82=9B=20ADT?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../Relations/NADT\342\211\244ADT.agda" | 94 +++++++++++++++++++ src/Vatras/Succinctness/Sizes.agda | 3 + src/Vatras/Util/List.agda | 16 +++- 3 files changed, 112 insertions(+), 1 deletion(-) create mode 100644 "src/Vatras/Succinctness/Relations/NADT\342\211\244ADT.agda" diff --git "a/src/Vatras/Succinctness/Relations/NADT\342\211\244ADT.agda" "b/src/Vatras/Succinctness/Relations/NADT\342\211\244ADT.agda" new file mode 100644 index 00000000..8e2b20cb --- /dev/null +++ "b/src/Vatras/Succinctness/Relations/NADT\342\211\244ADT.agda" @@ -0,0 +1,94 @@ +open import Data.Nat using (ℕ; suc; _+_; _≟_; s≤s) +open import Vatras.Framework.Definitions using (𝔽; 𝔸; 𝕍) + +module Vatras.Succinctness.Relations.NADT≤ADT (F : 𝔽) (V : 𝕍) (sizeV : ∀ {A : 𝔸} → V A → ℕ) (sizeV : ∀ {A : 𝔸} → V A → ℕ) where + +open import Data.Bool using (true; false; if_then_else_) +open import Data.Product using (proj₁; proj₂) renaming (_,_ to _and_) +open import Data.List using ([]; _∷_) +open import Data.List.NonEmpty as List⁺ using (_∷_) +import Data.Nat.Properties as ℕ +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl) +open import Relation.Nullary.Decidable using (yes; no) +open import Size using (∞) + +open import Vatras.Util.List as List using (find-or-last) +open import Vatras.Data.EqIndexedSet using (_≅[_][_]_; _⊆[_]_; ≅[]→≅) +open import Vatras.Succinctness.ProofDefinition V using (_≤ₛ_) +open import Vatras.Succinctness.Sizes using (SizedNADT; sizeNADT; SizedADT; sizeADT) +open import Vatras.Lang.All.Fixed F V +open ADT using (ADT; _⟨_,_⟩; leaf) +open NADT using (NADT; _⟨_⟩; leaf) + +open import Vatras.Translation.Lang.ADT-to-VariantList using () + +translate : ∀ {A : 𝔸} → ADT A → NADT ∞ A +translate (leaf v) = leaf v +translate (f ⟨ l , r ⟩) = f ⟨ translate l ∷ translate r ∷ [] ⟩ + +conf : NADT.Configuration → ADT.Configuration +conf config f with config f ≟ 0 +conf config f | yes _ = true +conf config f | no _ = false + +fnoc : ADT.Configuration → NADT.Configuration +fnoc config f = if config f then 0 else 1 + +translate-preserves-⊆ : ∀ {A : 𝔸} → (adt : ADT A) → NADT.⟦ translate adt ⟧ ⊆[ conf ] ADT.⟦ adt ⟧ +translate-preserves-⊆ (leaf v) config = refl +translate-preserves-⊆ (f ⟨ l , r ⟩) config with config f ≟ 0 +translate-preserves-⊆ (f ⟨ l , r ⟩) config | yes config-f≡0 = + NADT.⟦ find-or-last (config f) (translate l ∷ translate r ∷ []) ⟧ config + ≡⟨ Eq.cong (λ x → NADT.⟦ find-or-last x (translate l ∷ translate r ∷ []) ⟧ config) config-f≡0 ⟩ + NADT.⟦ find-or-last 0 (translate l ∷ translate r ∷ []) ⟧ config + ≡⟨⟩ + NADT.⟦ translate l ⟧ config + ≡⟨ translate-preserves-⊆ l config ⟩ + ADT.⟦ l ⟧ (conf config) + ≡⟨⟩ + (if true then ADT.⟦ l ⟧ (conf config) else ADT.⟦ r ⟧ (conf config)) + ∎ + where + open Eq.≡-Reasoning +translate-preserves-⊆ (f ⟨ l , r ⟩) config | no config-f≢0 = + NADT.⟦ find-or-last (config f) (translate l ∷ translate r ∷ []) ⟧ config + ≡⟨ Eq.cong (λ x → NADT.⟦ x ⟧ config) (List.find-or-last-last (config f) (translate l ∷ translate r ∷ []) (s≤s (ℕ.n≢0⇒n>0 config-f≢0))) ⟩ + NADT.⟦ List⁺.last (translate l ∷ translate r ∷ []) ⟧ config + ≡⟨⟩ + NADT.⟦ translate r ⟧ config + ≡⟨ translate-preserves-⊆ r config ⟩ + ADT.⟦ r ⟧ (conf config) + ≡⟨⟩ + (if false then ADT.⟦ l ⟧ (conf config) else ADT.⟦ r ⟧ (conf config)) + ∎ + where + open Eq.≡-Reasoning + +translate-preserves-⊇ : ∀ {A : 𝔸} → (adt : ADT A) → ADT.⟦ adt ⟧ ⊆[ fnoc ] NADT.⟦ translate adt ⟧ +translate-preserves-⊇ (leaf v) config = refl +translate-preserves-⊇ (f ⟨ l , r ⟩) config with config f +translate-preserves-⊇ (f ⟨ l , r ⟩) config | true = translate-preserves-⊇ l config +translate-preserves-⊇ (f ⟨ l , r ⟩) config | false = translate-preserves-⊇ r config + +translate-preserves : ∀ {A : 𝔸} → (adt : ADT A) → NADT.⟦ translate adt ⟧ ≅[ conf ][ fnoc ] ADT.⟦ adt ⟧ +translate-preserves adt = translate-preserves-⊆ adt and translate-preserves-⊇ adt + +lemma : ∀ {A : 𝔸} → (adt : ADT A) → sizeNADT sizeV (translate adt) ≡ sizeADT sizeV adt +lemma (leaf v) = refl +lemma (f ⟨ l , r ⟩) = + sizeNADT sizeV (translate (f ⟨ l , r ⟩)) + ≡⟨⟩ + suc (sizeNADT sizeV (translate l) + (sizeNADT sizeV (translate r) + 0)) + ≡⟨ Eq.cong (λ x → suc (sizeNADT sizeV (translate l) + x)) (ℕ.+-identityʳ (sizeNADT sizeV (translate r))) ⟩ + suc (sizeNADT sizeV (translate l) + sizeNADT sizeV (translate r)) + ≡⟨ Eq.cong₂ (λ x y → suc (x + y)) (lemma l) (lemma r) ⟩ + suc (sizeADT sizeV l + sizeADT sizeV r) + ≡⟨⟩ + sizeADT sizeV (f ⟨ l , r ⟩) + ∎ + where + open Eq.≡-Reasoning + +NADT≤ADT : SizedNADT F V sizeV ≤ₛ SizedADT F V sizeV +NADT≤ADT .proj₁ = 1 +NADT≤ADT .proj₂ A e₂ e₂-translatable = translate e₂ and ≅[]→≅ (translate-preserves e₂) and ℕ.≤-reflexive (Eq.trans (lemma e₂) (Eq.sym (ℕ.+-identityʳ (sizeADT sizeV e₂)))) diff --git a/src/Vatras/Succinctness/Sizes.agda b/src/Vatras/Succinctness/Sizes.agda index 209bb5ff..da75aa1d 100644 --- a/src/Vatras/Succinctness/Sizes.agda +++ b/src/Vatras/Succinctness/Sizes.agda @@ -23,6 +23,9 @@ open SizedLang public sizeRose : ∀ {i : Size} {A : 𝔸} → Rose i A → ℕ sizeRose {A = A} (a Rose.-< cs >-) = suc (atomSize A a + List.sum (List.map sizeRose cs)) +sizeRose>0 : ∀ {i : Size} {A : 𝔸} → (v : Rose i A) → sizeRose v > 0 +sizeRose>0 {A = A} (a Rose.-< cs >-) = s≤s z≤n + size2CC : ∀ {F : 𝔽} {i : Size} {A : 𝔸} → 2CC.2CC F i A → ℕ size2CC {A = A} (a 2CC.2CC.-< cs >-) = suc (atomSize A a + List.sum (List.map size2CC cs)) size2CC (D 2CC.2CC.⟨ l , r ⟩) = suc (size2CC l + size2CC r) diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index e1478de4..c6993a15 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -7,13 +7,14 @@ open import Data.Bool using (Bool; true; false) open import Data.Empty using (⊥-elim) open import Data.Fin as Fin using (Fin; zero; suc) import Data.Fin.Properties as Fin -open import Data.Nat using (ℕ; suc; zero; NonZero; _+_; _∸_; _*_; _⊔_; _≤_; _<_; s≤s; z≤n) +open import Data.Nat using (ℕ; suc; zero; NonZero; _+_; _∸_; _*_; _⊔_; _≤_; _≥_; _<_; s≤s; z≤n) open import Data.Nat.Properties as ℕ using (m≤m+n) open import Data.List as List using (List; []; _∷_; lookup; foldr; _++_) open import Data.List.Properties as List using (map-id; length-++) open import Data.List.Membership.Propositional using (_∈_) import Data.List.Membership.Propositional.Properties as List open import Data.List.NonEmpty as List⁺ using (List⁺; _∷_; toList; _⁺++⁺_) renaming (map to map⁺) +import Data.List.NonEmpty.Properties as List⁺ open import Data.List.Relation.Unary.All as All using (All; []; _∷_) import Data.List.Relation.Unary.All.Properties as All open import Data.List.Relation.Unary.Any using (here; there) @@ -37,6 +38,12 @@ max-≤ n [] () max-≤ n (.n ∷ xs) (here refl) = ℕ.m≤m⊔n n (max xs) max-≤ n (x ∷ xs) (there x∈xs) = ℕ.≤-trans (max-≤ n xs x∈xs) (ℕ.m≤n⊔m x (max xs)) +-- TODO: Contribute to stl +last-∷ : ∀ {ℓ} {A : Set ℓ} → (x y : A) → (zs : List A) → List⁺.last (x ∷ y ∷ zs) ≡ List⁺.last (y ∷ zs) +last-∷ x y zs with List.initLast zs +last-∷ x y .[] | [] = refl +last-∷ x y .(xs List.∷ʳ x₁) | xs List.∷ʳ′ x₁ = refl + -- TODO: Contribute to stl map-⁺++⁺ : ∀ {a} {A : Set a} {b} {B : Set b} (f : A → B) (xs ys : List⁺ A) → List⁺.map f (xs ⁺++⁺ ys) ≡ List⁺.map f xs ⁺++⁺ List⁺.map f ys @@ -139,6 +146,13 @@ find-or-last-zero : ∀ {ℓ} {A : Set ℓ} (x : A) (xs : List A) find-or-last-zero _ [] = refl find-or-last-zero _ (_ ∷ _) = refl +find-or-last-last : ∀ {ℓ} {A : Set ℓ} + → (n : ℕ) (xs : List⁺ A) + → suc n ≥ List⁺.length xs + → find-or-last n xs ≡ List⁺.last xs +find-or-last-last n (x ∷ []) n≥xs = refl +find-or-last-last (suc n) (x ∷ y ∷ zs) (s≤s n≥xs) = Eq.trans (find-or-last-last n (y ∷ zs) n≥xs) (Eq.sym (last-∷ x y zs)) + map-find-or-last : ∀ {a b} {A : Set a} {B : Set b} → (f : A → B) → (i : ℕ) From 3385ba9400dce3d34a59ce648da08dd9412aaf95 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 8 Dec 2025 23:08:22 +0100 Subject: [PATCH 72/82] Simplify the FixedArtifactLength lemma --- src/Vatras/Lang/2CC/FixedArtifactLength.agda | 113 +++++++++--------- .../Relations/2CC\342\211\260FST.agda" | 22 ++-- .../Relations/2CC\342\211\260OC.agda" | 23 ++-- 3 files changed, 76 insertions(+), 82 deletions(-) diff --git a/src/Vatras/Lang/2CC/FixedArtifactLength.agda b/src/Vatras/Lang/2CC/FixedArtifactLength.agda index 38104732..0b853814 100644 --- a/src/Vatras/Lang/2CC/FixedArtifactLength.agda +++ b/src/Vatras/Lang/2CC/FixedArtifactLength.agda @@ -3,13 +3,13 @@ module Vatras.Lang.2CC.FixedArtifactLength (Dimension : 𝔽) (A : 𝔸) where open import Data.Bool using (true; false) open import Data.Empty using (⊥-elim) -open import Data.List as List using (List; []; _∷_; concatMap; _++_) +open import Data.List as List using (List; []; _∷_; _++_) import Data.List.Properties as List open import Data.List.Relation.Ternary.Interleaving.Propositional using (Interleaving; []; consˡ; consʳ) -open import Data.List.Relation.Unary.All using (All; []; _∷_) +open import Data.List.Relation.Unary.All as All using (All; []; _∷_) import Data.List.Relation.Unary.All.Properties open import Data.List.Relation.Unary.AllPairs as AllPairs using (AllPairs; []; _∷_) -open import Data.Nat as ℕ using (ℕ; suc; _+_; _∸_; _*_; _≤_; z≤n; s≤s) +open import Data.Nat as ℕ using (ℕ; suc; _+_; _∸_; _*_; _≤_; z≤n; s≤s; _≥_) import Data.Nat.Properties as ℕ open import Data.Product using (_×_; _,_; proj₂; ∃-syntax) open import Function using (_∘_; const) @@ -17,7 +17,7 @@ open import Relation.Binary.PropositionalEquality as Eq using (refl; _≡_; _≢ open import Size using (Size; ∞) import Vatras.Util.List as List -open import Vatras.Data.EqIndexedSet using (_∈_) +open import Vatras.Data.EqIndexedSet using (_∈_; _⊆_) open import Vatras.Framework.Variants using (Rose; children-equality) open import Vatras.Lang.2CC Dimension using (2CC; _⟨_,_⟩; _-<_>-; ⟦_⟧) open import Vatras.Lang.2CC.ReflectsVariantSize using (reflectsVariantSize) @@ -41,54 +41,51 @@ fixedChildCount {cs₁ = cs₁} {cs₂ = cs₂} (c , v≡e) = where open Eq.≡-Reasoning -partition : ∀ {i : Size} {ℓ} {I : Set ℓ} +partition : ∀ {i : Size} → (D : Dimension) (c₁ c₂ : 2CC i A) - → (is : List I) - → (f : I → Rose ∞ A) - → AllPairs (λ i j → f i ≉ f j) is - → All (λ i → f i ∈ ⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) is - → ∃[ is₁ ] ∃[ is₂ ] - Interleaving is₁ is₂ is - × All (λ i → f i ∈ ⟦ c₁ ⟧) is₁ - × All (λ i → f i ∈ ⟦ c₂ ⟧) is₂ -partition D c₁ c₂ [] f unique-vs vs⊆e = [] , [] , [] , [] , [] -partition D c₁ c₂ (i ∷ is) f (v∉vs ∷ unique-vs) ((c , v≡e) ∷ vs⊆e) - with partition D c₁ c₂ is f unique-vs vs⊆e -... | is₁ , is₂ , partition , vs₁⊆e , vs₂⊆e + → (vs : List (Rose ∞ A)) + → AllPairs _≉_ vs + → All (_∈ ⟦ D 2CC.⟨ c₁ , c₂ ⟩ ⟧) vs + → ∃[ vs₁ ] ∃[ vs₂ ] + Interleaving vs₁ vs₂ vs + × All (_∈ ⟦ c₁ ⟧) vs₁ + × All (_∈ ⟦ c₂ ⟧) vs₂ +partition D c₁ c₂ [] unique-vs vs⊆e = [] , [] , [] , [] , [] +partition D c₁ c₂ (v ∷ vs) (v∉vs ∷ unique-vs) ((c , v≡e) ∷ vs⊆e) + with partition D c₁ c₂ vs unique-vs vs⊆e +... | vs₁ , vs₂ , partition , vs₁⊆e , vs₂⊆e with c D -... | true = i ∷ is₁ , is₂ , consˡ partition , (c , v≡e) ∷ vs₁⊆e , vs₂⊆e -... | false = is₁ , i ∷ is₂ , consʳ partition , vs₁⊆e , (c , v≡e) ∷ vs₂⊆e +... | true = v ∷ vs₁ , vs₂ , consˡ partition , (c , v≡e) ∷ vs₁⊆e , vs₂⊆e +... | false = vs₁ , v ∷ vs₂ , consʳ partition , vs₁⊆e , (c , v≡e) ∷ vs₂⊆e -sum≤size2CC : ∀ {i : Size} {ℓ} {I : Set ℓ} +sum≤size2CC : ∀ {i : Size} → (e : 2CC i A) - → (is : List I) - → (f : I → Rose ∞ A) - → AllPairs (λ i j → f i ≉ f j) is - → All (λ i → f i ∈ ⟦ e ⟧) is - → List.sum (List.map (sizeRose ∘ f) is) ≤ size2CC e -sum≤size2CC (a -< cs >-) [] f unique-vs vs⊆e = z≤n -sum≤size2CC (a -< cs >-) (i₁ ∷ []) f unique-vs (v∈e ∷ []) = + → (vs : List (Rose ∞ A)) + → AllPairs (_≉_) vs + → All (_∈ ⟦ e ⟧) vs + → List.sum (List.map sizeRose vs) ≤ size2CC e +sum≤size2CC (a -< cs >-) [] unique-vs vs⊆e = z≤n +sum≤size2CC (a -< cs >-) (v ∷ []) unique-vs (v∈e ∷ []) = begin - List.sum (List.map (sizeRose ∘ f) (i₁ ∷ [])) + List.sum (List.map sizeRose (v ∷ [])) ≡⟨⟩ - sizeRose (f i₁) + 0 - ≡⟨ ℕ.+-identityʳ (sizeRose (f i₁)) ⟩ - sizeRose (f i₁) - ≤⟨ reflectsVariantSize (f i₁) (a -< cs >-) v∈e ⟩ + sizeRose v + 0 + ≡⟨ ℕ.+-identityʳ (sizeRose v) ⟩ + sizeRose v + ≤⟨ reflectsVariantSize v (a -< cs >-) v∈e ⟩ size2CC (a -< cs >-) ∎ where open ℕ.≤-Reasoning -sum≤size2CC (a -< cs >-) (i₁ ∷ i₂ ∷ is) f ((v₁≢v₂ ∷ v₁∉vs) ∷ unique-vs) (v₁∈e ∷ v₂∈e ∷ vs⊆e) with f i₁ | f i₂ -... | a₁ Rose.-< cs₁ >- | a₂ Rose.-< cs₂ >- = +sum≤size2CC (a -< cs >-) ((a₁ Rose.-< cs₁ >-) ∷ (a₂ Rose.-< cs₂ >-) ∷ vs) ((v₁≢v₂ ∷ v₁∉vs) ∷ unique-vs) (v₁∈e ∷ v₂∈e ∷ vs⊆e) = ⊥-elim (v₁≢v₂ (Eq.trans (fixedChildCount v₁∈e) (Eq.sym (fixedChildCount v₂∈e)))) -sum≤size2CC (D ⟨ c₁ , c₂ ⟩) is f unique-vs vs⊆e with partition D c₁ c₂ is f unique-vs vs⊆e -... | is₁ , is₂ , partition , vs₁⊆c₁ , vs₂⊆c₂ = +sum≤size2CC (D ⟨ c₁ , c₂ ⟩) vs unique-vs vs⊆e with partition D c₁ c₂ vs unique-vs vs⊆e +... | vs₁ , vs₂ , partition , vs₁⊆c₁ , vs₂⊆c₂ = begin - List.sum (List.map (sizeRose ∘ f) is) + List.sum (List.map sizeRose vs) ≡⟨ List.sum-Interleaving (List.map-Interleaving partition) ⟨ - List.sum (List.map (sizeRose ∘ f) is₁) + List.sum (List.map (sizeRose ∘ f) is₂) - ≤⟨ ℕ.+-mono-≤ (sum≤size2CC c₁ is₁ f (List.AllPairs-resp-⊆ (List.Interleaving⇒Sublistˡ partition) unique-vs) vs₁⊆c₁) (sum≤size2CC c₂ is₂ f (List.AllPairs-resp-⊆ (List.Interleaving⇒Sublistʳ partition) unique-vs) vs₂⊆c₂) ⟩ + List.sum (List.map sizeRose vs₁) + List.sum (List.map sizeRose vs₂) + ≤⟨ ℕ.+-mono-≤ (sum≤size2CC c₁ vs₁ (List.AllPairs-resp-⊆ (List.Interleaving⇒Sublistˡ partition) unique-vs) vs₁⊆c₁) (sum≤size2CC c₂ vs₂ (List.AllPairs-resp-⊆ (List.Interleaving⇒Sublistʳ partition) unique-vs) vs₂⊆c₂) ⟩ size2CC c₁ + size2CC c₂ <⟨ ℕ.n<1+n (size2CC c₁ + size2CC c₂) ⟩ size2CC (D ⟨ c₁ , c₂ ⟩) @@ -96,26 +93,26 @@ sum≤size2CC (D ⟨ c₁ , c₂ ⟩) is f unique-vs vs⊆e with partition D c where open ℕ.≤-Reasoning -unique-lengths⇒m*sizeRose≤size2CC : ∀ {i : Size} (n : ℕ) - → (2cc : 2CC i A) - → (ls : List ℕ) - → (f : ℕ → Rose ∞ A) - → (∀ (l : ℕ) → n ≤ sizeRose (f l)) - → (∀ {l₁ l₂ : ℕ} → l₁ ≢ l₂ → f l₁ ≉ f l₂) - → AllPairs _≢_ ls - → All (λ l → f l ∈ ⟦ 2cc ⟧) ls - → List.length ls * n ≤ size2CC 2cc -unique-lengths⇒m*sizeRose≤size2CC n 2cc ls f f-size f-≉ unique-ls all-∈ = +different-children-counts : + ∀ {i : Size} + → (n : ℕ) + → (e : 2CC i A) + → (vs : List (Rose ∞ A)) + → All (_∈ ⟦ e ⟧) vs + → All (λ v → sizeRose v ≥ n) vs + → AllPairs _≉_ vs + → size2CC e ≥ List.length vs * n +different-children-counts n e vs vs⊆e vs≥n unique-vs = begin - List.length ls * n - ≡⟨ List.sum-replicate (List.length ls) n ⟨ - List.sum (List.replicate (List.length ls) n) - ≡⟨ Eq.cong List.sum (List.map-const n ls) ⟨ - List.sum (List.map (const n) ls) - ≤⟨ List.sum-map-≤ (const n) (sizeRose ∘ f) ls f-size ⟩ - List.sum (List.map (sizeRose ∘ f) ls) - ≤⟨ sum≤size2CC 2cc ls f (AllPairs.map f-≉ unique-ls) all-∈ ⟩ - size2CC 2cc + List.length vs * n + ≡⟨ List.sum-replicate (List.length vs) n ⟨ + List.sum (List.replicate (List.length vs) n) + ≡⟨ Eq.cong List.sum (List.map-const n vs) ⟨ + List.sum (List.map (const n) vs) + ≤⟨ List.sum-map-≤-with∈ vs (λ v v∈vs → All.lookup vs≥n v∈vs) ⟩ + List.sum (List.map sizeRose vs) + ≤⟨ sum≤size2CC e vs unique-vs (vs⊆e) ⟩ + size2CC e ∎ where open ℕ.≤-Reasoning diff --git "a/src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" "b/src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" index 120378cb..82259767 100644 --- "a/src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" +++ "b/src/Vatras/Succinctness/Relations/2CC\342\211\260FST.agda" @@ -56,7 +56,7 @@ open import Vatras.Succinctness.Sizes using (sizeRose; Sized2CC; size2CC; SizedF open FST.Impose NAT hiding (_∈_; _==_) open import Vatras.Lang.FST.Composition F NAT using (⊛-all-unique) open import Vatras.Lang.FST.Util F NAT using (select≗filter) -open import Vatras.Lang.2CC.FixedArtifactLength F NAT using (unique-lengths⇒m*sizeRose≤size2CC) renaming (_≉_ to _≉'_) +open import Vatras.Lang.2CC.FixedArtifactLength F NAT using (different-children-counts) renaming (_≉_ to _≉'_) artifact : ℕ → ℕ → FSTA ∞ artifact n zero = (0 , 2 ^ n) Rose.-< [] >- @@ -301,7 +301,7 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( → k + l ≤ suc n → (2cc : 2CC.2CC i NAT) → FST.⟦ fst n ⟧ ⊆ 2CC.⟦ 2cc ⟧ - → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) (List.applyUpTo (k +_) l) + → All (_∈ 2CC.⟦ 2cc ⟧) (List.applyUpTo (λ m → variant n (k + m)) l) ⊆⇒All∈ n zero k l≤n 2cc fst⊆2cc = [] ⊆⇒All∈ n (suc l) k l≤n 2cc fst⊆2cc with variant∈fst n k (ℕ.≤-pred ( begin @@ -322,8 +322,8 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( (Eq.sym (ℕ.+-identityʳ k)) (Eq.trans variant≡fst fst≡2cc)) ∷ Eq.subst - (All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧)) - (List.applyUpTo-cong (λ l → Eq.sym (ℕ.+-suc k l)) l) + (All (_∈ 2CC.⟦ 2cc ⟧)) + (List.applyUpTo-cong (λ l → Eq.cong (variant n) (Eq.sym (ℕ.+-suc k l))) l) (⊆⇒All∈ n l (suc k) (ℕ.≤-trans (ℕ.≤-reflexive (Eq.sym (ℕ.+-suc k l))) l≤n) 2cc fst⊆2cc) 2*n≤2^n : (n : ℕ) → 2 * n ≤ 2 ^ n @@ -379,17 +379,15 @@ variant∈fst n i i≤n = fst-config i , Eq.cong ((0 , 0) Rose.-<_>-) ( 6 * suc n * 2 ^ m ≡⟨⟩ m * 2 ^ m - ≡⟨ Eq.cong (_* 2 ^ m) (List.length-upTo m) ⟨ - List.length (List.upTo m) * 2 ^ m - ≤⟨ unique-lengths⇒m*sizeRose≤size2CC + ≡⟨ Eq.cong (_* 2 ^ m) (List.length-applyUpTo (variant m) m) ⟨ + List.length (List.applyUpTo (variant m) m) * 2 ^ m + ≤⟨ different-children-counts (2 ^ m) 2cc - (List.upTo m) - (variant m) - (size-variant m) - (variant-≉ m) - (Unique.applyUpTo⁺₁ id m (λ i0) @@ -278,12 +279,12 @@ config≡false l i l≤i = go l zero (ℕ.≤-trans (ℕ.≤-reflexive (ℕ.+-id → l ≤ suc n → (2cc : 2CC.2CC i NAT) → OC.⟦ oc n ⟧ ⊆ 2CC.⟦ 2cc ⟧ - → All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧) (List.upTo l) + → All (_∈ 2CC.⟦ 2cc ⟧) (List.applyUpTo (variant n) l) ⊆⇒All∈ n zero l≤n 2cc oc⊆2cc = [] ⊆⇒All∈ n (suc l) (s≤s l≤n) 2cc oc⊆2cc = Eq.subst - (All (λ l → variant n l ∈ 2CC.⟦ 2cc ⟧)) - (List.applyUpTo-∷ʳ⁺ id l) + (All (λ l → l ∈ 2CC.⟦ 2cc ⟧)) + (List.applyUpTo-∷ʳ⁺ (variant n) l) (All.∷ʳ⁺ (⊆⇒All∈ n l (ℕ.<⇒≤ (s≤s l≤n)) 2cc oc⊆2cc) (Eq.subst @@ -335,17 +336,15 @@ goal n@(suc n-1) 2cc (2cc⊆oc , oc⊆2cc) = m * 2 ^ m <⟨ ℕ.*-monoˡ-< (2 ^ m) {{ℕ.>-nonZero (ℕ.m^n>0 2 m)}} (ℕ.n<1+n m) ⟩ suc m * 2 ^ m - ≡⟨ Eq.cong (_* 2 ^ m) (List.length-upTo (suc m)) ⟨ - List.length (List.upTo (suc m)) * 2 ^ m - ≤⟨ unique-lengths⇒m*sizeRose≤size2CC + ≡⟨ Eq.cong (_* 2 ^ m) (List.length-applyUpTo (variant m) (suc m)) ⟨ + List.length (List.applyUpTo (variant m) (suc m)) * 2 ^ m + ≤⟨ different-children-counts (2 ^ m) 2cc - (List.upTo (suc m)) - (variant m) - (size-variant m) - (variant-≉ (suc m)) - (Unique.applyUpTo⁺₁ id (suc m) (λ i Date: Tue, 9 Dec 2025 20:05:13 +0100 Subject: [PATCH 73/82] =?UTF-8?q?Generalize=20the=20coarseness=20of=20the?= =?UTF-8?q?=20relationship=20between=20=E2=89=B0=20and=20=E2=89=A4?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Vatras/Succinctness/ProofDefinition.agda | 42 +++++++++---------- .../Succinctness/Relations/2CCe₂ = A , e₂ , e₂-translatable , λ e₁ e₁≅e₂ → begin-strict n * f (size L₂ e₂) @@ -465,8 +465,8 @@ module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where ¬∃→∀ : ∀ {ℓ₁ ℓ₂ ℓ₃} {A : Set ℓ₁} {P : A → Set ℓ₂} {Q : A → Set ℓ₃} → (∀ {a : A} → ¬ P a → Q a) → ¬ (Σ[ a ∈ A ] P a) → ∀ (a : A) → Q a ¬∃→∀ f P = map-∀ f (¬∃⟶∀¬ P) - ¬≤→≰ : {L₁ L₂ : SizedLang V} → ¬ (L₁ ≤ₛ L₂) → L₁ ≰ₛ L₂ - ¬≤→≰ = ¬∃→∀ (¬∀→∃ (¬∀→∃ (¬∀→∃ (¬∃→∀ (¬∃→∀ ℕ.≰⇒>))))) + ¬≤ₛ[]→≰ₛ[] : {L₁ L₂ : SizedLang V} (f : ℕ → ℕ) → ¬ (L₁ ≤ₛ[ f ] L₂) → L₁ ≰ₛ[ f ] L₂ + ¬≤ₛ[]→≰ₛ[] f = ¬∃→∀ (¬∀→∃ (¬∀→∃ (¬∀→∃ (¬∃→∀ (¬∃→∀ ℕ.≰⇒>))))) - ¬≰→≤ : {L₁ L₂ : SizedLang V} → ¬ (L₁ ≰ₛ L₂) → L₁ ≤ₛ L₂ - ¬≰→≤ = ¬∀→∃ (¬∃→∀ (¬∃→∀ (¬∃→∀ (¬∀→∃ (¬∀→∃ ℕ.≮⇒≥))))) + ¬≰[]→≤[] : {L₁ L₂ : SizedLang V} (f : ℕ → ℕ) → ¬ (L₁ ≰ₛ[ f ] L₂) → L₁ ≤ₛ[ f ] L₂ + ¬≰[]→≤[] f = ¬∀→∃ (¬∃→∀ (¬∃→∀ (¬∃→∀ (¬∀→∃ (¬∀→∃ ℕ.≮⇒≥))))) diff --git a/src/Vatras/Succinctness/Relations/2CC Date: Sat, 13 Dec 2025 19:29:54 +0100 Subject: [PATCH 74/82] Prove independence of size definition --- src/Vatras/Succinctness/ProofDefinition.agda | 44 +++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/src/Vatras/Succinctness/ProofDefinition.agda b/src/Vatras/Succinctness/ProofDefinition.agda index 9a39a645..d0914900 100644 --- a/src/Vatras/Succinctness/ProofDefinition.agda +++ b/src/Vatras/Succinctness/ProofDefinition.agda @@ -20,7 +20,7 @@ open import Vatras.Util.Big-O using (𝒪[_]) open Vatras.Util.Big-O.Examples using (n∈𝒪[n]) open import Vatras.Framework.Relation.Expression V using (_,_⊢_≣_) open import Vatras.Framework.Relation.Expressiveness V using (_≽_; _≋_; ≽-trans; ≋-refl; ≋-sym; ≋-trans) -open import Vatras.Framework.VariabilityLanguage using (Expression) +open import Vatras.Framework.VariabilityLanguage using (VariabilityLanguage; Expression) open import Vatras.Framework.Compiler using (LanguageCompiler) open import Vatras.Succinctness.Sizes using (SizedLang; Lang; size) @@ -443,6 +443,48 @@ L₁ <ₛ' L₂ = Lang L₁ ≋ Lang L₂ × L₁ ≤ₛ L₂ × L₂ ≰ₛ L where open ℕ.≤-Reasoning +proportionalSize : ∀ {ℓ} {L : 𝔸 → Set ℓ} → ({A : 𝔸} → L A → ℕ) → ({A : 𝔸} → L A → ℕ) → Set _ +proportionalSize {L = L} s₁ s₂ = + Σ[ n ∈ ℕ ] + Σ[ m ∈ ℕ ] + ∀ {A : 𝔸} + → (e : L A) + → s₁ e ≤ n * s₂ e + × s₂ e ≤ m * s₁ e + +sizeDefinitionIndependence : + ∀ (L₁ L₂ : VariabilityLanguage V) + → (s₁ s₂ : ∀ {A : 𝔸} → Expression L₁ A → ℕ) + → (s₃ s₄ : ∀ {A : 𝔸} → Expression L₂ A → ℕ) + → proportionalSize {L = Expression L₁} s₁ s₂ + → proportionalSize {L = Expression L₂} s₃ s₄ + → record {Lang = L₁; size = s₁} ≤ₛ record {Lang = L₂; size = s₃} + → record {Lang = L₁; size = s₂} ≤ₛ record {Lang = L₂; size = s₄} +sizeDefinitionIndependence L₁ L₂ s₁ s₂ s₃ s₄ (n₁ , m₁ , s₁=s₂) (n₂ , m₂ , s₃=s₄) (k , L₂→L₁) .proj₁ = m₁ * k * n₂ +sizeDefinitionIndependence L₁ L₂ s₁ s₂ s₃ s₄ (n₁ , m₁ , s₁=s₂) (n₂ , m₂ , s₃=s₄) (k , L₂→L₁) .proj₂ A e₂ e₂-translatable + with L₂→L₁ A e₂ e₂-translatable +... | e₁ , e₁≅e₂ , e₁≤e₂ + with s₁=s₂ e₁ +... | s₁≤s₂ , s₂≤s₁ + with s₃=s₄ e₂ +... | s₃≤s₄ , s₄≤s₃ + = e₁ , e₁≅e₂ , ( + begin + s₂ e₁ + ≤⟨ s₂≤s₁ ⟩ + m₁ * s₁ e₁ + ≤⟨ ℕ.*-monoʳ-≤ m₁ e₁≤e₂ ⟩ + m₁ * (k * s₃ e₂) + ≡⟨ ℕ.*-assoc m₁ k (s₃ e₂) ⟨ + m₁ * k * s₃ e₂ + ≤⟨ ℕ.*-monoʳ-≤ (m₁ * k) s₃≤s₄ ⟩ + m₁ * k * (n₂ * s₄ e₂) + ≡⟨ ℕ.*-assoc (m₁ * k) n₂ (s₄ e₂) ⟨ + m₁ * k * n₂ * s₄ e₂ + ∎) + where + open ℕ.≤-Reasoning + open Axiom.ExcludedMiddle using (ExcludedMiddle) open Axiom.DoubleNegationElimination using (em⇒dne) module Classical (excludedMiddle : ∀ {ℓ} → ExcludedMiddle ℓ) where From 348054efc369f747375251958dd7eb595f2cd0c9 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 13 Apr 2026 14:06:00 +0200 Subject: [PATCH 75/82] Remove a superfluous `--allow-unsolved-metas` --- src/Vatras/Util/Nat/Diagonalization.agda | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Vatras/Util/Nat/Diagonalization.agda b/src/Vatras/Util/Nat/Diagonalization.agda index 8d15655e..3750bf4e 100644 --- a/src/Vatras/Util/Nat/Diagonalization.agda +++ b/src/Vatras/Util/Nat/Diagonalization.agda @@ -1,4 +1,3 @@ -{-# OPTIONS --allow-unsolved-metas #-} module Vatras.Util.Nat.Diagonalization where open import Data.Bool using (Bool; true; false) From 81ddeb2067a2084776817b0ec8c814062cb24be1 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 13 Apr 2026 14:11:07 +0200 Subject: [PATCH 76/82] Rename some variables and lemmas in 2CC-) (go n bs zero refl ( config : ∀ n → Vec Bool n → 2CC.Configuration config n bs d = config' n zero bs d - -- TODO variable naming - config-lemma : ∀ m b (bs' : Vec Bool m) D → (n≡D+m : n ≡ D + suc m) → simple-drop D (Vec.cast n≡D+m bs) ≡ b ∷ bs' → config' n zero bs (f D) ≡ b + config-lemma : + ∀ m b (bs' : Vec Bool m) D + → (n≡D+m : n ≡ D + suc m) + → simple-drop D (Vec.cast n≡D+m bs) ≡ b ∷ bs' + → config' n zero bs (f D) ≡ b config-lemma m b bs' D n≡D+m x = go n zero bs D D b bs' (Eq.sym (ℕ.+-identityʳ D)) n≡D+m x where go : - ∀ n m bs D k {x : ℕ} b (bs' : Vec Bool x) + ∀ n m bs D k {x : ℕ} b' (bs' : Vec Bool x) → D ≡ k + m → (n≡k+x : n ≡ k + suc x) - → simple-drop k (Vec.cast n≡k+x bs) ≡ b ∷ bs' - → config' n m bs (f D) ≡ b - go zero m [] D k b bs' x₁ n≡k+x x₂ = ⊥-elim (ℕ.n≮0 (ℕ.≤-trans (ℕ.m≤n+m (suc _) k) (ℕ.≤-reflexive (Eq.sym n≡k+x)))) - go (suc n) m (x₃ ∷ bs) D zero b bs' x₁ n≡k+x x₂ rewrite ℕ.suc-injective n≡k+x rewrite x₁ with f m == f m - go (suc n) m (x₃ ∷ bs) D zero b bs' x₁ n≡k+x x₂ | yes refl = Vec.∷-injectiveˡ x₂ - go (suc n) m (x₃ ∷ bs) D zero b bs' x₁ n≡k+x x₂ | no f-m≢f-m = ⊥-elim (f-m≢f-m refl) - go (suc n) m (x₃ ∷ bs) D (suc k) b bs' x₁ n≡k+x x₂ with f m == f D - go (suc n) m (x₃ ∷ bs) D (suc k) b bs' x₁ n≡k+x x₂ | yes f-m≡f-D = ⊥-elim (f-injective (ℕ.<⇒≢ (ℕ.≤-<-trans (ℕ.m≤n+m m k) (ℕ.<-≤-trans (ℕ.n<1+n (k + m)) (ℕ.≤-reflexive (Eq.sym x₁))))) f-m≡f-D) - go (suc n) m (x₃ ∷ bs) D (suc k) b bs' x₁ (n≡k+x) x₂ | no f-m≢f-D = go n (suc m) bs D k b bs' (Eq.trans x₁ (Eq.sym (ℕ.+-suc k m))) (ℕ.suc-injective n≡k+x) x₂ + → simple-drop k (Vec.cast n≡k+x bs) ≡ b' ∷ bs' + → config' n m bs (f D) ≡ b' + go zero m [] D k b' bs' D≡k+m n≡k+x h = ⊥-elim (ℕ.n≮0 (ℕ.≤-trans (ℕ.m≤n+m (suc _) k) (ℕ.≤-reflexive (Eq.sym n≡k+x)))) + go (suc n) m (b ∷ bs) D zero b' bs' D≡k+m n≡k+x h rewrite ℕ.suc-injective n≡k+x rewrite D≡k+m with f m == f m + go (suc n) m (b ∷ bs) D zero b' bs' D≡k+m n≡k+x h | yes refl = Vec.∷-injectiveˡ h + go (suc n) m (b ∷ bs) D zero b' bs' D≡k+m n≡k+x h | no f-m≢f-m = ⊥-elim (f-m≢f-m refl) + go (suc n) m (b ∷ bs) D (suc k) b' bs' D≡k+m n≡k+x h with f m == f D + go (suc n) m (b ∷ bs) D (suc k) b' bs' D≡k+m n≡k+x h | yes f-m≡f-D = ⊥-elim (f-injective (ℕ.<⇒≢ (ℕ.≤-<-trans (ℕ.m≤n+m m k) (ℕ.<-≤-trans (ℕ.n<1+n (k + m)) (ℕ.≤-reflexive (Eq.sym D≡k+m))))) f-m≡f-D) + go (suc n) m (b ∷ bs) D (suc k) b' bs' D≡k+m (n≡k+x) h | no f-m≢f-D = go n (suc m) bs D k b' bs' (Eq.trans D≡k+m (Eq.sym (ℕ.+-suc k m))) (ℕ.suc-injective n≡k+x) h go : ∀ (m : ℕ) (bs' : Vec Bool m) (D : ℕ) → (n≡D+m : n ≡ D + m) → simple-drop D (Vec.cast n≡D+m bs) ≡ bs' → variants-cs m bs' ≡ List.map (λ e → 2CC.⟦ e ⟧ (config n bs)) (e₁-cs m D) @@ -339,18 +342,21 @@ sizeRose∈variants n v p | bs , v≡variants-bs = where open Eq.≡-Reasoning -todo5 : +lookup≡find-or-last : ∀ {a} {A : Set a} (xs : List⁺ A) (i : Fin (List⁺.length xs)) → List.lookup (List⁺.toList xs) i ≡ find-or-last (Fin.toℕ i) xs -todo5 (x ∷ []) zero = refl -todo5 (x₁ ∷ x₂ ∷ xs) zero = refl -todo5 (x₁ ∷ x₂ ∷ xs) (suc i) = todo5 (x₂ ∷ xs) i - -todo : ∀ {i} {I : Set i} {a} {A : Set a} {n : ℕ} {M : Vec Bool n → A} {N : I → A} → M ⊆ N → List.lookup (List.map M (List⁺.toList (enumerate-binary n))) ⊆ N -todo {n = zero} M⊆N zero = M⊆N [] -todo {I = I} {A = A} {n = suc n} {M = M} {N} M⊆N i with Fin.toℕ i Date: Mon, 13 Apr 2026 14:13:28 +0200 Subject: [PATCH 77/82] Move OC dead elimination to `Translation` --- src/Vatras/{ => Translation}/Lang/OC/DeadElim.agda | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) rename src/Vatras/{ => Translation}/Lang/OC/DeadElim.agda (99%) diff --git a/src/Vatras/Lang/OC/DeadElim.agda b/src/Vatras/Translation/Lang/OC/DeadElim.agda similarity index 99% rename from src/Vatras/Lang/OC/DeadElim.agda rename to src/Vatras/Translation/Lang/OC/DeadElim.agda index 11803dfd..2a4f47bb 100644 --- a/src/Vatras/Lang/OC/DeadElim.agda +++ b/src/Vatras/Translation/Lang/OC/DeadElim.agda @@ -1,6 +1,6 @@ open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) open import Relation.Binary using (DecidableEquality) -module Vatras.Lang.OC.DeadElim (F : 𝔽) (_≟_ : DecidableEquality F) where +module Vatras.Translation.Lang.OC.DeadElim (F : 𝔽) (_≟_ : DecidableEquality F) where open import Data.Bool using (Bool; true; false; if_then_else_) open import Data.Empty using (⊥-elim) From d0585cb73515cbf58a46abe006fdcc9117d11dd0 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 13 Apr 2026 14:14:34 +0200 Subject: [PATCH 78/82] Use typical option names for OC dead elimination --- src/Vatras/Translation/Lang/OC/DeadElim.agda | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Vatras/Translation/Lang/OC/DeadElim.agda b/src/Vatras/Translation/Lang/OC/DeadElim.agda index 2a4f47bb..5c457b2e 100644 --- a/src/Vatras/Translation/Lang/OC/DeadElim.agda +++ b/src/Vatras/Translation/Lang/OC/DeadElim.agda @@ -32,9 +32,9 @@ data Undead {A : 𝔸} : {i : Size} → OC i A → Set₁ where elimDead' : {i : Size} → {A : 𝔸} → (env : List F) → OC i A → Σ (OC ∞ A) (RestrictOptions env) elimDead' env (a -< cs >-) = a -< List.map proj₁ (List.map (elimDead' env) cs) >- , (env -< All.fromList (List.map (elimDead' env) cs) >-) -elimDead' env (a ❲ c ❳) with a ∈? env -elimDead' env (a ❲ c ❳) | yes a∈env = elimDead' env c -elimDead' env (a ❲ c ❳) | no a∉env = a ❲ proj₁ (elimDead' (a ∷ env) c) ❳ , a∉env ❲ proj₂ (elimDead' (a ∷ env) c) ❳ +elimDead' env (f ❲ c ❳) with f ∈? env +elimDead' env (f ❲ c ❳) | yes a∈env = elimDead' env c +elimDead' env (f ❲ c ❳) | no a∉env = f ❲ proj₁ (elimDead' (f ∷ env) c) ❳ , a∉env ❲ proj₂ (elimDead' (f ∷ env) c) ❳ elimDead : {i : Size} → {A : 𝔸} → OC i A → OC ∞ A elimDead e = proj₁ (elimDead' [] e) @@ -57,13 +57,13 @@ elimDead-preserves' env (a -< cs >-) c c-env≡true = ∎ where open Eq.≡-Reasoning -elimDead-preserves' env (a ❲ e ❳) c c-env≡true with a ∈? env -elimDead-preserves' env (a ❲ e ❳) c c-env≡true | yes a∈env with c a in c-a -elimDead-preserves' env (a ❲ e ❳) c c-env≡true | yes a∈env | true = elimDead-preserves' env e c c-env≡true -elimDead-preserves' env (a ❲ e ❳) c c-env≡true | yes a∈env | false = ⊥-elim (true≢false (All.lookup c-env≡true a∈env) c-a) -elimDead-preserves' env (a ❲ e ❳) c c-env≡true | no a∉env with c a in c-a -elimDead-preserves' env (a ❲ e ❳) c c-env≡true | no a∉env | true = elimDead-preserves' (a ∷ env) e c (c-a ∷ c-env≡true) -elimDead-preserves' env (a ❲ e ❳) c c-env≡true | no a∉env | false = Eq.refl +elimDead-preserves' env (f ❲ e ❳) c c-env≡true with f ∈? env +elimDead-preserves' env (f ❲ e ❳) c c-env≡true | yes a∈env with c f in c-a +elimDead-preserves' env (f ❲ e ❳) c c-env≡true | yes a∈env | true = elimDead-preserves' env e c c-env≡true +elimDead-preserves' env (f ❲ e ❳) c c-env≡true | yes a∈env | false = ⊥-elim (true≢false (All.lookup c-env≡true a∈env) c-a) +elimDead-preserves' env (f ❲ e ❳) c c-env≡true | no a∉env with c f in c-a +elimDead-preserves' env (f ❲ e ❳) c c-env≡true | no a∉env | true = elimDead-preserves' (f ∷ env) e c (c-a ∷ c-env≡true) +elimDead-preserves' env (f ❲ e ❳) c c-env≡true | no a∉env | false = Eq.refl elimDead-preserves : {i : Size} → {A : 𝔸} → (e : OC i A) → ⟦ elimDead e ⟧ₒ ≅[ id ][ id ] ⟦ e ⟧ₒ elimDead-preserves e = ≗→≅[] (λ c → elimDead-preserves' [] e c []) From 3b90f96d7603b768f2f80c6bb42eb07f8ac215de Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Mon, 13 Apr 2026 14:15:23 +0200 Subject: [PATCH 79/82] Add some useful documentation --- src/Vatras/Framework/Definitions.agda | 17 +++++++ src/Vatras/Lang/2CC/FixedArtifactLength.agda | 24 ++++++++++ src/Vatras/Lang/FST/NoBaseArtifacts.agda | 25 +++++++++++ src/Vatras/Lang/PropOC.agda | 5 +++ .../Succinctness/Relations/2CC=2CC.agda | 6 +++ src/Vatras/Translation/Lang/OC/DeadElim.agda | 44 +++++++++++++++++++ src/Vatras/Util/Nat/Diagonalization.agda | 17 +++++++ 7 files changed, 138 insertions(+) diff --git a/src/Vatras/Framework/Definitions.agda b/src/Vatras/Framework/Definitions.agda index 262fb4ef..d536425f 100644 --- a/src/Vatras/Framework/Definitions.agda +++ b/src/Vatras/Framework/Definitions.agda @@ -24,6 +24,7 @@ Any actual data we can think of to plug in here (e.g., strings, tokens or nodes of an abstract syntax tree) can be checked for equality. -} record 𝔸 : Set₁ where + -- We do not actually need eta equality in Vatras and it does break a proof when enabled (no idea why). no-eta-equality field atoms : Set @@ -67,6 +68,11 @@ and hence expressions are parameterized in the type of this atomic data. 𝔼 = 𝔸 → Set₁ -- some default atoms +{-| +String artifacts. +Equality is defined character wise +and size is measured by length (in characters not bytes). +-} STRING : 𝔸 STRING = record { atoms = String @@ -74,6 +80,12 @@ STRING = record ; atomSize = String.length } +{-| +Pairs of natural numbers as artifacts. +The first element in the pair is treated as an identifier +whereas the second element determines the size of the artifact. +Both elements of the pair are tested for equality. +-} NAT : 𝔸 NAT = record { atoms = ℕ × ℕ @@ -81,6 +93,11 @@ NAT = record ; atomSize = proj₂ } +{-| +Natural number artifacts. +Each number is treated as a separate artifact. +The size of all artifacts is zero. +-} NAT' : 𝔸 NAT' = record { atoms = ℕ diff --git a/src/Vatras/Lang/2CC/FixedArtifactLength.agda b/src/Vatras/Lang/2CC/FixedArtifactLength.agda index 0b853814..f7c8e223 100644 --- a/src/Vatras/Lang/2CC/FixedArtifactLength.agda +++ b/src/Vatras/Lang/2CC/FixedArtifactLength.agda @@ -1,3 +1,7 @@ +{-| +This module shows that artifacts of choice calculus expressions have a fixed number of children. +Afterwards, we introduce some more usable lemmas on top og this insight. +-} open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) module Vatras.Lang.2CC.FixedArtifactLength (Dimension : 𝔽) (A : 𝔸) where @@ -26,6 +30,11 @@ open import Vatras.Succinctness.Sizes using (sizeRose; size2CC) _≉_ : Rose ∞ A → Rose ∞ A → Set (a₁ Rose.-< cs₁ >-) ≉ (a₂ Rose.-< cs₂ >-) = List.length cs₁ ≢ List.length cs₂ +{-| +The key insight of this module: +Given a choice calculus expression with an artifact at the root, +all expressed variants must have the same number of children. +-} fixedChildCount : ∀ {i} → {a₁ : atoms A} {cs₁ : List (Rose ∞ A)} → {a₂ : atoms A} {cs₂ : List (2CC i A)} @@ -41,6 +50,11 @@ fixedChildCount {cs₁ = cs₁} {cs₂ = cs₂} (c , v≡e) = where open Eq.≡-Reasoning +{-| +We can partition a list of variants +on whether we can choose the left or right alternative of a choice +in order to configure each variant. +-} partition : ∀ {i : Size} → (D : Dimension) (c₁ c₂ : 2CC i A) → (vs : List (Rose ∞ A)) @@ -58,6 +72,10 @@ partition D c₁ c₂ (v ∷ vs) (v∉vs ∷ unique-vs) ((c , v≡e) ∷ vs⊆e) ... | true = v ∷ vs₁ , vs₂ , consˡ partition , (c , v≡e) ∷ vs₁⊆e , vs₂⊆e ... | false = vs₁ , v ∷ vs₂ , consʳ partition , vs₁⊆e , (c , v≡e) ∷ vs₂⊆e +{-| +Gives a lower bound on the size of a choice calculus expression +given that it expresses a number of variants with pairwise different child count. +-} sum≤size2CC : ∀ {i : Size} → (e : 2CC i A) → (vs : List (Rose ∞ A)) @@ -93,6 +111,12 @@ sum≤size2CC (D ⟨ c₁ , c₂ ⟩) vs unique-vs vs⊆e with partition D c₁ where open ℕ.≤-Reasoning +{-| +Gives a lower bound on the size of a choice calculus expression +given that it expresses a number of variants with pairwise different child count. +In contrast to `sum≤size2CC`, this lemma is a simplified special case +which makes use of a lower bound on the variant size. +-} different-children-counts : ∀ {i : Size} → (n : ℕ) diff --git a/src/Vatras/Lang/FST/NoBaseArtifacts.agda b/src/Vatras/Lang/FST/NoBaseArtifacts.agda index 98a17bb3..5e4d3329 100644 --- a/src/Vatras/Lang/FST/NoBaseArtifacts.agda +++ b/src/Vatras/Lang/FST/NoBaseArtifacts.agda @@ -1,3 +1,10 @@ +{-| +Proof that feature structure trees do not contain a base artifact. +In other words: Every feature structure tree contains a variant that has no children. +Hence, feature structure trees are incomplete +(they cannot encode a variant set that does not contain a variant without children). +-} + open import Vatras.Framework.Definitions using (𝔽; NAT') module Vatras.Lang.FST.NoBaseArtifacts {F : 𝔽} where @@ -18,16 +25,28 @@ import Vatras.Lang.FST as FST open FST.Impose F NAT' +{-| +A variant that has at least one child. +-} variant : Rose ∞ NAT' variant = 0 Rose.-< 0 Rose.-< [] >- ∷ [] >- +{-| +A variant set that does not contain the variant that has no children. +-} variantGenerator : VariantGenerator (Rose ∞) NAT' 0 variantGenerator zero = variant +{-| +The configuration `λ f → false` results in no selected features. +-} select-false : ∀ features → select (λ f → false) features ≡ [] select-false [] = refl select-false (feature ∷ features) = select-false features +{-| +Every feature structure tree contains a variant without children. +-} lemma : ∀ (e : SPL) → Σ[ a ∈ ℕ ] ⟦ e ⟧ (λ f → false) ≡ a Rose.-< [] >- lemma (a ◀ features) = a , ( begin @@ -42,10 +61,16 @@ lemma (a ◀ features) = a , ( where open Eq.≡-Reasoning +{-| +The variant set `variantGenerator` cannot be expressed by a feature structure tree. +-} does-not-describe-variant : ¬ (Σ[ e ∈ SPL ] (⟦ e ⟧ ≅ variantGenerator)) does-not-describe-variant (e , variant⊆e , e⊆variant) with variant⊆e (λ f → false) | lemma e does-not-describe-variant (e , variant⊆e , e⊆variant) | zero , e≡variant | a , e≡empty with Eq.trans (Eq.sym (proj₂ (Rose-injective e≡variant))) (proj₂ (Rose-injective e≡empty)) does-not-describe-variant (e , variant⊆e , e⊆variant) | zero , e≡variant | a , e≡empty | () +{-| +Due to `does-not-describe-variant`, feature structure trees are incomplete. +-} FST-is-incomplete : Incomplete (Rose ∞) (FST.FSTL F) FST-is-incomplete complete = does-not-describe-variant (Prod.map₂ (≅-sym) (complete variantGenerator)) diff --git a/src/Vatras/Lang/PropOC.agda b/src/Vatras/Lang/PropOC.agda index 4f634319..83fc3e77 100644 --- a/src/Vatras/Lang/PropOC.agda +++ b/src/Vatras/Lang/PropOC.agda @@ -1,3 +1,8 @@ +{-| +A specialization of option calculus with propositional formulas as dimensions. +The semantics is adapted in order to evaluate the propositional formulas. +Hence, the configuration consists of an `Assignment` of variables to `Bool`. +-} open import Vatras.Framework.Definitions using (𝔽; ℂ; 𝔼) module Vatras.Lang.PropOC (F : 𝔽) where diff --git a/src/Vatras/Succinctness/Relations/2CC=2CC.agda b/src/Vatras/Succinctness/Relations/2CC=2CC.agda index ff0a4f40..78da6b4d 100644 --- a/src/Vatras/Succinctness/Relations/2CC=2CC.agda +++ b/src/Vatras/Succinctness/Relations/2CC=2CC.agda @@ -1,3 +1,9 @@ +{-| +Renaming dimensions of binary choice calculus expressions preserves their size. +Furthermore, the two representations of choice calculus in Vatras, +namely 2CC and NCC with binary choices, +are equally succinct. +-} module Vatras.Succinctness.Relations.2CC=2CC where open import Data.Nat as ℕ using (zero; suc; _+_) diff --git a/src/Vatras/Translation/Lang/OC/DeadElim.agda b/src/Vatras/Translation/Lang/OC/DeadElim.agda index 5c457b2e..5416b0c2 100644 --- a/src/Vatras/Translation/Lang/OC/DeadElim.agda +++ b/src/Vatras/Translation/Lang/OC/DeadElim.agda @@ -1,3 +1,13 @@ +{-| +Removes dead options from an option calculus expression. +A dead option is an option which can be replaced by its child (i.e., removed) without altering the semantics of the expression. +In particular, an option which is below another option the same dimension can never be disabled. +If the dimension is disabled, the parent option is already disable. +Hence, the child option is not even considered. + +Given an `Undead` expression, we then apply some transformations like join top level options. +-} + open import Vatras.Framework.Definitions using (𝔽; 𝔸; atoms) open import Relation.Binary using (DecidableEquality) module Vatras.Translation.Lang.OC.DeadElim (F : 𝔽) (_≟_ : DecidableEquality F) where @@ -23,19 +33,31 @@ open import Vatras.Framework.Variants using (_-<_>-) open import Vatras.Lang.OC F using (OC; _-<_>-; _❲_❳; Configuration; ⟦_⟧ₒ) open import Vatras.Lang.OC.Util using (all-oc) +{-| +An option calculus expression with no dead options and a list of dimensions that do not appear in that expression. +-} data RestrictOptions {A : 𝔸} : {i : Size} → List F → OC i A → Set₁ where _-<_>- : ∀ {i} → {a : atoms A} → {cs : List (OC i A)} → (env : List F) → All (RestrictOptions env) cs → RestrictOptions env (a -< cs >-) _❲_❳ : ∀ {i} → {f : F} → {c : OC i A} → {env : List F} → f ∉ env → RestrictOptions (f ∷ env) c → RestrictOptions env (f ❲ c ❳) +{-| +An option calculus expression with no dead options. +-} data Undead {A : 𝔸} : {i : Size} → OC i A → Set₁ where undead : {i : Size} → {env : List F} → {e : OC i A} → RestrictOptions env e → Undead e +{-| +Given a list of dimensions that are dead in this expression, remove all dead options. +-} elimDead' : {i : Size} → {A : 𝔸} → (env : List F) → OC i A → Σ (OC ∞ A) (RestrictOptions env) elimDead' env (a -< cs >-) = a -< List.map proj₁ (List.map (elimDead' env) cs) >- , (env -< All.fromList (List.map (elimDead' env) cs) >-) elimDead' env (f ❲ c ❳) with f ∈? env elimDead' env (f ❲ c ❳) | yes a∈env = elimDead' env c elimDead' env (f ❲ c ❳) | no a∉env = f ❲ proj₁ (elimDead' (f ∷ env) c) ❳ , a∉env ❲ proj₂ (elimDead' (f ∷ env) c) ❳ +{-| +Remove all dead options. +-} elimDead : {i : Size} → {A : 𝔸} → OC i A → OC ∞ A elimDead e = proj₁ (elimDead' [] e) @@ -65,14 +87,27 @@ elimDead-preserves' env (f ❲ e ❳) c c-env≡true | no a∉env with c f in c- elimDead-preserves' env (f ❲ e ❳) c c-env≡true | no a∉env | true = elimDead-preserves' (f ∷ env) e c (c-a ∷ c-env≡true) elimDead-preserves' env (f ❲ e ❳) c c-env≡true | no a∉env | false = Eq.refl +{-| +`elimDead` doesn't change the semantics of the expression. +-} elimDead-preserves : {i : Size} → {A : 𝔸} → (e : OC i A) → ⟦ elimDead e ⟧ₒ ≅[ id ][ id ] ⟦ e ⟧ₒ elimDead-preserves e = ≗→≅[] (λ c → elimDead-preserves' [] e c []) -- TODO WFOC + +-- The following lemmas show that we can join top level options if the expression is `Undead`. + +{-| +In an undead option calculus expression, +child dimensions need to be different. +-} undead→≢ : {i : Size} → {A : 𝔸} → {f₁ f₂ : F} → {e : OC i A} → Undead (f₁ ❲ f₂ ❲ e ❳ ❳) → f₁ ≢ f₂ undead→≢ (undead (f₁∉env ❲ f₂∉env ❲ undead-e ❳ ❳)) f₁≡f₂ = f₂∉env (here (Eq.sym f₁≡f₂)) +{-| +Change a configuration at a particular dimension to a specific value. +-} changeConfig : F → Bool → Configuration → Configuration changeConfig f₁ b c f₂ with f₁ ≟ f₂ changeConfig f₁ b c f₂ | yes f₁≡f₂ = b @@ -88,6 +123,9 @@ changeConfig-≢ {f₁} {f₂} b f₁≢f₂ c with f₁ ≟ f₂ changeConfig-≢ {f₁} {f₂} b f₁≢f₂ c | yes f₁≡f₂ = ⊥-elim (f₁≢f₂ f₁≡f₂) changeConfig-≢ {f₁} {f₂} b f₁≢f₂ c | no f₁≢f₂ = Eq.refl +{-| +We can change the configuration of dimensions which don't appear in an expression. +-} changeConfig-∉ : {i : Size} → {A : 𝔸} → {env : List F} → (f : F) → (f ∈ env) → (b : Bool) → (c : Configuration) → (e : OC i A) → RestrictOptions env e → ⟦ e ⟧ₒ (changeConfig f b c) ≡ ⟦ e ⟧ₒ c changeConfig-∉ f f∈env b c (a -< cs >-) (env -< undead-e >-) = ⟦ a -< cs >- ⟧ₒ (changeConfig f b c) @@ -104,6 +142,9 @@ changeConfig-∉ f f∈env b c (f' ❲ e ❳) undead-e with f ≟ f' changeConfig-∉ {env = env} f f∈env b c (f' ❲ e ❳) (f'∉env ❲ undead-e ❳) | yes f≡f' = ⊥-elim (f'∉env (Eq.subst (_∈ env) f≡f' f∈env)) changeConfig-∉ f f∈env b c (f' ❲ e ❳) (f'∉env ❲ undead-e ❳) | no f≢f' = Eq.cong (λ e → if c f' then e else nothing) (changeConfig-∉ f (there f∈env) b c e undead-e) +{-| +An option whose dimensions is configured to `true` is semantically equivalent to its child. +-} eval-option : {i : Size} → {A : 𝔸} → {f : F} → {e : OC i A} → Undead (f ❲ e ❳) → (c : Configuration) → ⟦ f ❲ e ❳ ⟧ₒ (changeConfig f true c) ≡ ⟦ e ⟧ₒ c eval-option {f = f} {e = e} (undead (_ ❲ undead-e ❳)) c = ⟦ f ❲ e ❳ ⟧ₒ (changeConfig f true c) @@ -117,6 +158,9 @@ eval-option {f = f} {e = e} (undead (_ ❲ undead-e ❳)) c = where open Eq.≡-Reasoning +{-| +We can collapse top-level options if there are no dead options. +-} join-options : {i : Size} → {A : 𝔸} → (f₁ f₂ : F) → (e : OC i A) → Undead (f₁ ❲ f₂ ❲ e ❳ ❳) → ⟦ f₁ ❲ f₂ ❲ e ❳ ❳ ⟧ₒ ≅ ⟦ f₂ ❲ e ❳ ⟧ₒ join-options f₁ f₂ e undead-e'@(undead (f₁∉env ❲ f₂∉env ❲ undead-e ❳ ❳)) = go-⊆ , go-⊇ where diff --git a/src/Vatras/Util/Nat/Diagonalization.agda b/src/Vatras/Util/Nat/Diagonalization.agda index 3750bf4e..45fc0374 100644 --- a/src/Vatras/Util/Nat/Diagonalization.agda +++ b/src/Vatras/Util/Nat/Diagonalization.agda @@ -1,3 +1,11 @@ +{-| +This module is a formal proof that ℕ and ℕ × ℕ have equal cardinality. +In particular, we provide a bijection between ℕ and ℕ × ℕ +using a version of Cantor's diagonal argument. + +This is already a well established result. +We only provide a full proof of this result due to procrastination 😅. +-} module Vatras.Util.Nat.Diagonalization where open import Data.Bool using (Bool; true; false) @@ -13,6 +21,15 @@ open import Relation.Nullary.Decidable using (yes; no) import Vatras.Util.List as List +{-| +A bijection between ℕ × ℕ and ℕ. +It counts through the pair like in a triangle: +y\x 0 1 2 3 +0 0 2 5 9 +1 1 4 8 +2 3 7 +3 6 +-} diagonalization : ℕ × ℕ → ℕ diagonalization (x , y) = List.sum (List.upTo (suc (x + y))) + x From c5ce2f872d02da4a710cbb12ec34eeb01036a939 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Thu, 16 Apr 2026 13:49:29 +0200 Subject: [PATCH 80/82] Rename NoBaseArtifacts into NoCoreFeature The name was misleading as every variant has a root artifact (although it doesn't have any children). The new name also incorporates existing software product line terminology. --- .../Lang/FST/{NoBaseArtifacts.agda => NoCoreFeature.agda} | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) rename src/Vatras/Lang/FST/{NoBaseArtifacts.agda => NoCoreFeature.agda} (95%) diff --git a/src/Vatras/Lang/FST/NoBaseArtifacts.agda b/src/Vatras/Lang/FST/NoCoreFeature.agda similarity index 95% rename from src/Vatras/Lang/FST/NoBaseArtifacts.agda rename to src/Vatras/Lang/FST/NoCoreFeature.agda index 5e4d3329..8420fc2d 100644 --- a/src/Vatras/Lang/FST/NoBaseArtifacts.agda +++ b/src/Vatras/Lang/FST/NoCoreFeature.agda @@ -1,12 +1,12 @@ {-| -Proof that feature structure trees do not contain a base artifact. +Proof that feature structure trees do not contain a core feature. In other words: Every feature structure tree contains a variant that has no children. Hence, feature structure trees are incomplete (they cannot encode a variant set that does not contain a variant without children). -} open import Vatras.Framework.Definitions using (𝔽; NAT') -module Vatras.Lang.FST.NoBaseArtifacts {F : 𝔽} where +module Vatras.Lang.FST.NoCoreFeature {F : 𝔽} where open import Data.Bool using (true; false) open import Data.Fin using (zero) From b0902d2055d461a3fc7cbc4724c270c926136c97 Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Sat, 13 Dec 2025 23:45:23 +0100 Subject: [PATCH 81/82] Remove a lemma that is available in the standard library --- src/Vatras/Lang/FST.lagda.md | 3 +-- src/Vatras/Util/List.agda | 6 ------ 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/src/Vatras/Lang/FST.lagda.md b/src/Vatras/Lang/FST.lagda.md index 7dad7b24..751732ca 100644 --- a/src/Vatras/Lang/FST.lagda.md +++ b/src/Vatras/Lang/FST.lagda.md @@ -34,7 +34,6 @@ open import Vatras.Framework.Composition.FeatureAlgebra open import Vatras.Framework.VariabilityLanguage open import Vatras.Util.Function using (cong-app₂) -open import Vatras.Util.List using (++-tail) ``` ## Basic Definitions @@ -385,7 +384,7 @@ We now prove some useful properties of the above statements. ⊕-strangers ls [] _ _ rewrite ++-identityʳ ls = refl ⊕-strangers ls (r ∷ rs) (r∉rs ∷ u-rs) (r∉ls ∷ d-ls-rs) -- Goal: (ls ⊙ r) ⊕ rs ≡ ls ++ r ∷ rs - rewrite (Eq.sym (++-tail r rs ls)) + rewrite (Eq.sym (List.∷ʳ-++ ls r rs)) -- Goal: (ls ⊙ r) ⊕ rs ≡ (ls ++ r ∷ []) ++ rs rewrite ⊙-stranger r ls r∉ls -- Goal: (ls ++ r ∷ []) ⊕ rs ≡ (ls ++ r ∷ []) ++ rs diff --git a/src/Vatras/Util/List.agda b/src/Vatras/Util/List.agda index ee13f6d9..8f5bcbb9 100644 --- a/src/Vatras/Util/List.agda +++ b/src/Vatras/Util/List.agda @@ -50,12 +50,6 @@ last-∷ x y zs with List.initLast zs last-∷ x y .[] | [] = refl last-∷ x y .(xs List.∷ʳ x₁) | xs List.∷ʳ′ x₁ = refl --- TODO: Contribute to stl -++-tail : ∀ {ℓ} {A : Set ℓ} (y : A) (ys xs : List A) - → (xs ++ y ∷ []) ++ ys ≡ xs ++ y ∷ ys -++-tail y ys [] = refl -++-tail y ys (x ∷ xs) = Eq.cong (x ∷_) (++-tail y ys xs) - ∈xs++v∷ys⇒∈xs++ys : ∀ {ℓ} {A : Set ℓ} → (u v : A) → (xs ys : List A) From f536bb1da12c92234f151b93513f5838a3c9386c Mon Sep 17 00:00:00 2001 From: Benjamin Moosherr Date: Tue, 14 Apr 2026 12:10:40 +0200 Subject: [PATCH 82/82] Add my thesis to the README --- README.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/README.md b/README.md index 73621631..a3d056c8 100644 --- a/README.md +++ b/README.md @@ -130,6 +130,14 @@ Details on the features implemented in Vatras, including tutorials for integrati The PhD thesis presents a refined and extended version of our OOPSLA'24 paper in chapter 3. In the thesis, we extended the discussion on existing variability languages to better reflect and compare their assumptions on the underlying object language and their varying semantic domains. Consequently, we also extended our formal framework and case study to also study differences in semantic domains. We also refined the notation to better align with the Agda code and to avoid some minor ambiguities. +### On the Succinctness of Languages for Static Variability + +[![Thesis](https://img.shields.io/badge/Thesis-PDF-purple)](https://doi.org/10.18725/OPARU-59127) + +> Benjamin Moosherr. _On the Succinctness of Languages for Static Variability_. Master Thesis, University of Ulm, November 2025. Reviewed by Matthias Tichy and Thomas Thüm. Supervised by Paul Maximilian Bittner. + +This master thesis extends Vatras by a succinctness relation. Succinctness expresses how the size of expressions must change when translated using a variability language compiler. Hence, succinctness allows us to differentiate between variability languages which have equal semantic expressiveness but whose translation results in combinatorial explosion. + ### On the Expressive Power of Languages for Static Variability (OOPSLA'24) [![Preprint](https://img.shields.io/badge/OOPSLA'24-Preprint-purple)](https://github.com/SoftVarE-Group/Papers/raw/main/2024/2024-OOPSLA-Bittner.pdf)