546 lines
34 KiB
Agda
546 lines
34 KiB
Agda
module Lattice.Builder where
|
||
|
||
open import Lattice
|
||
open import Equivalence
|
||
open import Utils using (Unique; push; empty; Unique-append; Unique-++⁻ˡ; Unique-++⁻ʳ; Unique-narrow; All¬-¬Any; ¬Any-map; fins; fins-complete; findUniversal; Decidable-¬; ∈-cartesianProduct; foldr₁; x∷xs≢[])
|
||
open import Data.Nat as Nat using (ℕ)
|
||
open import Data.Fin as Fin using (Fin; suc; zero; _≟_)
|
||
open import Data.Maybe as Maybe using (Maybe; just; nothing; _>>=_; maybe)
|
||
open import Data.Maybe.Properties using (just-injective)
|
||
open import Data.List.NonEmpty using (List⁺; tail; toList) renaming (_∷_ to _∷⁺_)
|
||
open import Data.List.Membership.Propositional as MemProp using (lose) renaming (_∈_ to _∈ˡ_; mapWith∈ to mapWith∈ˡ)
|
||
open import Data.List.Membership.Propositional.Properties using () renaming (∈-++⁺ʳ to ∈ˡ-++⁺ʳ; ∈-++⁺ˡ to ∈ˡ-++⁺ˡ; ∈-cartesianProductWith⁺ to ∈ˡ-cartesianProductWith⁺; ∈-filter⁻ to ∈ˡ-filter⁻; ∈-filter⁺ to ∈ˡ-filter⁺; ∈-lookup to ∈ˡ-lookup)
|
||
open import Data.List.Relation.Unary.Any as Any using (Any; here; there; any?; satisfied; index)
|
||
open import Data.List.Relation.Unary.Any.Properties using (¬Any[]; lookup-result)
|
||
open import Data.List.Relation.Unary.All using (All; []; _∷_; map; lookup; zipWith; tabulate; universal; all?)
|
||
open import Data.List.Relation.Unary.All.Properties using () renaming (++⁺ to ++ˡ⁺; ++⁻ʳ to ++ˡ⁻ʳ)
|
||
open import Data.List using (List; _∷_; []; cartesianProduct; cartesianProductWith; foldr; filter) renaming (_++_ to _++ˡ_)
|
||
open import Data.List.Properties using () renaming (++-conicalʳ to ++ˡ-conicalʳ; ++-identityʳ to ++ˡ-identityʳ; ++-assoc to ++ˡ-assoc)
|
||
open import Data.Sum using (_⊎_; inj₁; inj₂)
|
||
open import Data.Product using (Σ; _,_; _×_; proj₁; proj₂; uncurry)
|
||
open import Data.Empty using (⊥-elim)
|
||
open import Relation.Nullary using (¬_; Dec; yes; no; ¬?; _×-dec_)
|
||
open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl; sym; trans; cong; subst)
|
||
open import Relation.Binary.PropositionalEquality.Properties using (decSetoid)
|
||
open import Relation.Binary using () renaming (Decidable to Decidable²)
|
||
open import Relation.Unary using (Decidable)
|
||
open import Relation.Unary.Properties using (_∩?_)
|
||
open import Agda.Primitive using (lsuc; Level) renaming (_⊔_ to _⊔ℓ_)
|
||
|
||
record Graph : Set where
|
||
constructor mkGraph
|
||
field
|
||
size : ℕ
|
||
|
||
Node : Set
|
||
Node = Fin (Nat.suc size)
|
||
|
||
nodes = fins (Nat.suc size)
|
||
|
||
nodes-complete = fins-complete (Nat.suc size)
|
||
|
||
Edge : Set
|
||
Edge = Node × Node
|
||
|
||
field
|
||
edges : List Edge
|
||
|
||
nodes-nonempty : ¬ (proj₁ nodes ≡ [])
|
||
nodes-nonempty ()
|
||
|
||
data Path : Node → Node → Set where
|
||
done : ∀ {n : Node} → Path n n
|
||
step : ∀ {n₁ n₂ n₃ : Node} → (n₁ , n₂) ∈ˡ edges → Path n₂ n₃ → Path n₁ n₃
|
||
|
||
data IsDone : ∀ {n₁ n₂} → Path n₁ n₂ → Set where
|
||
isDone : ∀ {n : Node} → IsDone (done {n})
|
||
|
||
IsDone? : ∀ {n₁ n₂} → Decidable (IsDone {n₁} {n₂})
|
||
IsDone? done = yes isDone
|
||
IsDone? (step _ _) = no (λ {()})
|
||
|
||
_++_ : ∀ {n₁ n₂ n₃} → Path n₁ n₂ → Path n₂ n₃ → Path n₁ n₃
|
||
done ++ p = p
|
||
(step e p₁) ++ p₂ = step e (p₁ ++ p₂)
|
||
|
||
++-done : ∀ {n₁ n₂} (p : Path n₁ n₂) → p ++ done ≡ p
|
||
++-done done = refl
|
||
++-done (step e∈edges p) rewrite ++-done p = refl
|
||
|
||
++-assoc : ∀ {n₁ n₂ n₃ n₄} (p₁ : Path n₁ n₂) (p₂ : Path n₂ n₃) (p₃ : Path n₃ n₄) →
|
||
(p₁ ++ p₂) ++ p₃ ≡ p₁ ++ (p₂ ++ p₃)
|
||
++-assoc done p₂ p₃ = refl
|
||
++-assoc (step n₁,n∈edges p₁) p₂ p₃ rewrite ++-assoc p₁ p₂ p₃ = refl
|
||
|
||
IsDone-++ˡ : ∀ {n₁ n₂ n₃} (p₁ : Path n₁ n₂) (p₂ : Path n₂ n₃) →
|
||
¬ IsDone p₁ → ¬ IsDone (p₁ ++ p₂)
|
||
IsDone-++ˡ done _ done≢done = ⊥-elim (done≢done isDone)
|
||
|
||
interior : ∀ {n₁ n₂} → Path n₁ n₂ → List Node
|
||
interior done = []
|
||
interior (step _ done) = []
|
||
interior (step {n₂ = n₂} _ p) = n₂ ∷ interior p
|
||
|
||
interior-extend : ∀ {n₁ n₂ n₃} → (p : Path n₁ n₂) → (n₂,n₃∈edges : (n₂ , n₃) ∈ˡ edges) →
|
||
let p' = (p ++ (step n₂,n₃∈edges done))
|
||
in (interior p' ≡ interior p) ⊎ (interior p' ≡ interior p ++ˡ (n₂ ∷ []))
|
||
interior-extend done _ = inj₁ refl
|
||
interior-extend (step n₁,n₂∈edges done) n₂n₃∈edges = inj₂ refl
|
||
interior-extend {n₂ = n₂} (step {n₂ = n} n₁,n∈edges p@(step _ _)) n₂n₃∈edges
|
||
with p ++ (step n₂n₃∈edges done) | interior-extend p n₂n₃∈edges
|
||
... | done | inj₁ []≡intp rewrite sym []≡intp = inj₁ refl
|
||
... | done | inj₂ []=intp++[n₂] with () ← ++ˡ-conicalʳ (interior p) (n₂ ∷ []) (sym []=intp++[n₂])
|
||
... | step _ p | inj₁ IH rewrite IH = inj₁ refl
|
||
... | step _ p | inj₂ IH rewrite IH = inj₂ refl
|
||
|
||
interior-++ : ∀ {n₁ n₂ n₃} → (p₁ : Path n₁ n₂) → (p₂ : Path n₂ n₃) →
|
||
¬ IsDone p₁ → ¬ IsDone p₂ →
|
||
interior (p₁ ++ p₂) ≡ interior p₁ ++ˡ (n₂ ∷ interior p₂)
|
||
interior-++ done _ done≢done _ = ⊥-elim (done≢done isDone)
|
||
interior-++ _ done _ done≢done = ⊥-elim (done≢done isDone)
|
||
interior-++ (step _ done) (step _ _) _ _ = refl
|
||
interior-++ (step n₁,n∈edges p@(step n,n'∈edges p')) p₂ _ p₂≢done
|
||
rewrite interior-++ p p₂ (λ {()}) p₂≢done = refl
|
||
|
||
SimpleWalkVia : List Node → Node → Node → Set
|
||
SimpleWalkVia ns n₁ n₂ = Σ (Path n₁ n₂) (λ p → Unique (interior p) × All (_∈ˡ ns) (interior p))
|
||
|
||
SimpleWalk-extend : ∀ {n₁ n₂ n₃ ns} → (w : SimpleWalkVia ns n₁ n₂) → (n₂ , n₃) ∈ˡ edges → All (λ nʷ → ¬ nʷ ≡ n₂) (interior (proj₁ w)) → n₂ ∈ˡ ns → SimpleWalkVia ns n₁ n₃
|
||
SimpleWalk-extend (p , (Unique-intp , intp⊆ns)) n₂,n₃∈edges w≢n₂ n₂∈ns
|
||
with p ++ (step n₂,n₃∈edges done) | interior-extend p n₂,n₃∈edges
|
||
... | p' | inj₁ intp'≡intp rewrite sym intp'≡intp = (p' , Unique-intp , intp⊆ns)
|
||
... | p' | inj₂ intp'≡intp++[n₂]
|
||
with intp++[n₂]⊆ns ← ++ˡ⁺ intp⊆ns (n₂∈ns ∷ [])
|
||
rewrite sym intp'≡intp++[n₂] = (p' , (subst Unique (sym intp'≡intp++[n₂]) (Unique-append (¬Any-map sym (All¬-¬Any w≢n₂)) Unique-intp) , intp++[n₂]⊆ns))
|
||
|
||
∈ˡ-narrow : ∀ {x y : Node} {ys : List Node} → x ∈ˡ (y ∷ ys) → ¬ y ≡ x → x ∈ˡ ys
|
||
∈ˡ-narrow (here refl) x≢y = ⊥-elim (x≢y refl)
|
||
∈ˡ-narrow (there x∈ys) _ = x∈ys
|
||
|
||
SplitSimpleWalkViaHelp : ∀ {n n₁ n₂ ns} (nⁱ : Node)
|
||
(w : SimpleWalkVia (n ∷ ns) n₁ n₂)
|
||
(p₁ : Path n₁ nⁱ) (p₂ : Path nⁱ n₂) →
|
||
¬ IsDone p₁ → ¬ IsDone p₂ →
|
||
All (_∈ˡ ns) (interior p₁) →
|
||
proj₁ w ≡ p₁ ++ p₂ →
|
||
(Σ (SimpleWalkVia ns n₁ n × SimpleWalkVia ns n n₂) λ (w₁ , w₂) → proj₁ w₁ ++ proj₁ w₂ ≡ proj₁ w) ⊎ (Σ (SimpleWalkVia ns n₁ n₂) λ w' → proj₁ w' ≡ proj₁ w)
|
||
SplitSimpleWalkViaHelp nⁱ w done _ done≢done _ _ _ = ⊥-elim (done≢done isDone)
|
||
SplitSimpleWalkViaHelp nⁱ w p₁ done _ done≢done _ _ = ⊥-elim (done≢done isDone)
|
||
SplitSimpleWalkViaHelp {n} {ns = ns} nⁱ w@(p , (Unique-intp , intp⊆ns)) p₁@(step _ _) p₂@(step {n₂ = nⁱ'} nⁱ,nⁱ',∈edges p₂') p₁≢done p₂≢done intp₁⊆ns p≡p₁++p₂
|
||
with intp≡intp₁++[n]++intp₂ ← trans (cong interior p≡p₁++p₂) (interior-++ p₁ p₂ p₁≢done p₂≢done)
|
||
with nⁱ∈n∷ns ∷ intp₂⊆n∷ns ← ++ˡ⁻ʳ (interior p₁) (subst (All (_∈ˡ (n ∷ ns))) intp≡intp₁++[n]++intp₂ intp⊆ns)
|
||
with nⁱ ≟ n
|
||
... | yes refl
|
||
with Unique-intp₁ ← Unique-++⁻ˡ (interior p₁) (subst Unique intp≡intp₁++[n]++intp₂ Unique-intp)
|
||
with (push n≢intp₂ Unique-intp₂) ← Unique-++⁻ʳ (interior p₁) (subst Unique intp≡intp₁++[n]++intp₂ Unique-intp)
|
||
= inj₁ (((p₁ , (Unique-intp₁ , intp₁⊆ns)) , (p₂ , (Unique-intp₂ , zipWith (uncurry ∈ˡ-narrow) (intp₂⊆n∷ns , n≢intp₂)))) , sym p≡p₁++p₂)
|
||
... | no nⁱ≢n
|
||
with p₂'
|
||
... | done
|
||
= let
|
||
-- note: copied with below branch. can't use with <- to
|
||
-- share and re-use because the termination checker loses the thread.
|
||
p₁' = (p₁ ++ (step nⁱ,nⁱ',∈edges done))
|
||
n≢nⁱ n≡nⁱ = nⁱ≢n (sym n≡nⁱ)
|
||
intp₁'=intp₁++[nⁱ] = subst (λ xs → interior p₁' ≡ interior p₁ ++ˡ xs) (++ˡ-identityʳ (nⁱ ∷ [])) (interior-++ p₁ (step nⁱ,nⁱ',∈edges done) p₁≢done (λ {()}))
|
||
intp₁++[nⁱ]⊆ns = ++ˡ⁺ intp₁⊆ns (∈ˡ-narrow nⁱ∈n∷ns n≢nⁱ ∷ [])
|
||
intp₁'⊆ns = subst (All (_∈ˡ ns)) (sym intp₁'=intp₁++[nⁱ]) intp₁++[nⁱ]⊆ns
|
||
-- end shared with below branch.
|
||
Unique-intp₁++[nⁱ] = Unique-++⁻ˡ (interior p₁ ++ˡ (nⁱ ∷ [])) (subst Unique (trans intp≡intp₁++[n]++intp₂ (sym (++ˡ-assoc (interior p₁) (nⁱ ∷ []) []))) Unique-intp)
|
||
in inj₂ ((p₁ ++ (step nⁱ,nⁱ',∈edges done) , (subst Unique (sym intp₁'=intp₁++[nⁱ]) Unique-intp₁++[nⁱ] , intp₁'⊆ns)) , sym p≡p₁++p₂)
|
||
... | p₂'@(step _ _)
|
||
= let p₁' = (p₁ ++ (step nⁱ,nⁱ',∈edges done))
|
||
n≢nⁱ n≡nⁱ = nⁱ≢n (sym n≡nⁱ)
|
||
intp₁'=intp₁++[nⁱ] = subst (λ xs → interior p₁' ≡ interior p₁ ++ˡ xs) (++ˡ-identityʳ (nⁱ ∷ [])) (interior-++ p₁ (step nⁱ,nⁱ',∈edges done) p₁≢done (λ {()}))
|
||
intp₁++[nⁱ]⊆ns = ++ˡ⁺ intp₁⊆ns (∈ˡ-narrow nⁱ∈n∷ns n≢nⁱ ∷ [])
|
||
intp₁'⊆ns = subst (All (_∈ˡ ns)) (sym intp₁'=intp₁++[nⁱ]) intp₁++[nⁱ]⊆ns
|
||
p≡p₁'++p₂' = trans p≡p₁++p₂ (sym (++-assoc p₁ (step nⁱ,nⁱ',∈edges done) p₂'))
|
||
in SplitSimpleWalkViaHelp nⁱ' w p₁' p₂' (IsDone-++ˡ _ _ p₁≢done) (λ {()}) intp₁'⊆ns p≡p₁'++p₂'
|
||
|
||
SplitSimpleWalkVia : ∀ {n n₁ n₂ ns} (w : SimpleWalkVia (n ∷ ns) n₁ n₂) → (Σ (SimpleWalkVia ns n₁ n × SimpleWalkVia ns n n₂) λ (w₁ , w₂) → proj₁ w₁ ++ proj₁ w₂ ≡ proj₁ w) ⊎ (Σ (SimpleWalkVia ns n₁ n₂) λ w' → proj₁ w' ≡ proj₁ w)
|
||
SplitSimpleWalkVia (done , (_ , _)) = inj₂ ((done , (empty , [])) , refl)
|
||
SplitSimpleWalkVia (step n₁,n₂∈edges done , (_ , _)) = inj₂ ((step n₁,n₂∈edges done , (empty , [])) , refl)
|
||
SplitSimpleWalkVia w@(step {n₂ = nⁱ} n₁,nⁱ∈edges p@(step _ _) , (push nⁱ≢intp Unique-intp , nⁱ∈ns ∷ intp⊆ns)) = SplitSimpleWalkViaHelp nⁱ w (step n₁,nⁱ∈edges done) p (λ {()}) (λ {()}) [] refl
|
||
|
||
open import Data.List.Membership.DecSetoid (decSetoid {A = Node} _≟_) using () renaming (_∈?_ to _∈ˡ?_)
|
||
|
||
splitFromInteriorʳ : ∀ {n₁ n₂ n} (p : Path n₁ n₂) → n ∈ˡ (interior p) →
|
||
Σ (Path n n₂) (λ p' → ¬ IsDone p' × (Σ (List Node) λ ns → interior p ≡ ns ++ˡ n ∷ interior p'))
|
||
splitFromInteriorʳ done ()
|
||
splitFromInteriorʳ (step _ done) ()
|
||
splitFromInteriorʳ (step {n₂ = n'} n₁,n'∈edges p'@(step _ _)) (here refl) = (p' , ((λ {()}) , ([] , refl)))
|
||
splitFromInteriorʳ (step {n₂ = n'} n₁,n'∈edges p'@(step _ _)) (there n∈intp')
|
||
with (p'' , (¬IsDone-p'' , (ns , intp'≡ns++intp''))) ← splitFromInteriorʳ p' n∈intp'
|
||
rewrite intp'≡ns++intp'' = (p'' , (¬IsDone-p'' , (n' ∷ ns , refl)))
|
||
|
||
splitFromInteriorˡ : ∀ {n₁ n₂ n} (p : Path n₁ n₂) → n ∈ˡ (interior p) →
|
||
Σ (Path n₁ n) (λ p' → ¬ IsDone p' × (Σ (List Node) λ ns → interior p ≡ interior p' ++ˡ ns))
|
||
splitFromInteriorˡ done ()
|
||
splitFromInteriorˡ (step _ done) ()
|
||
splitFromInteriorˡ p@(step {n₂ = n'} n₁,n'∈edges p'@(step _ _)) (here refl) = (step n₁,n'∈edges done , ((λ {()}) , (interior p , refl)))
|
||
splitFromInteriorˡ p@(step {n₂ = n'} n₁,n'∈edges p'@(step _ _)) (there n∈intp')
|
||
with splitFromInteriorˡ p' n∈intp'
|
||
... | (p''@(step _ _) , (¬IsDone-p'' , (ns , intp'≡intp''++ns)))
|
||
rewrite intp'≡intp''++ns
|
||
= (step n₁,n'∈edges p'' , ((λ { () }) , (ns , refl)))
|
||
... | (done , (¬IsDone-Done , _)) = ⊥-elim (¬IsDone-Done isDone)
|
||
|
||
findCycleHelp : ∀ {n₁ nⁱ n₂} (p : Path n₁ n₂) (p₁ : Path n₁ nⁱ) (p₂ : Path nⁱ n₂) →
|
||
¬ IsDone p₁ → Unique (interior p₁) →
|
||
p ≡ p₁ ++ p₂ →
|
||
(Σ (SimpleWalkVia (proj₁ nodes) n₁ n₂) λ w → proj₁ w ≡ p) ⊎ (Σ Node (λ n → Σ (SimpleWalkVia (proj₁ nodes) n n) λ w → ¬ IsDone (proj₁ w)))
|
||
findCycleHelp p p₁ done ¬IsDonep₁ Unique-intp₁ p≡p₁++done rewrite ++-done p₁ = inj₁ ((p₁ , (Unique-intp₁ , tabulate (λ {x} _ → nodes-complete x))) , sym p≡p₁++done)
|
||
findCycleHelp {nⁱ = nⁱ} p p₁ (step nⁱ,nⁱ'∈edges p₂') ¬IsDone-p₁ Unique-intp₁ p≡p₁++p₂
|
||
with nⁱ ∈ˡ? interior p₁
|
||
... | no nⁱ∉intp₁ =
|
||
let p₁' = p₁ ++ step nⁱ,nⁱ'∈edges done
|
||
intp₁'≡intp₁++[nⁱ] = subst (λ xs → interior p₁' ≡ interior p₁ ++ˡ xs) (++ˡ-identityʳ (nⁱ ∷ [])) (interior-++ p₁ (step nⁱ,nⁱ'∈edges done) ¬IsDone-p₁ (λ {()}))
|
||
¬IsDone-p₁' = IsDone-++ˡ p₁ (step nⁱ,nⁱ'∈edges done) ¬IsDone-p₁
|
||
p≡p₁'++p₂' = trans p≡p₁++p₂ (sym (++-assoc p₁ (step nⁱ,nⁱ'∈edges done) p₂'))
|
||
Unique-intp₁' = subst Unique (sym intp₁'≡intp₁++[nⁱ]) (Unique-append nⁱ∉intp₁ Unique-intp₁)
|
||
in findCycleHelp p p₁' p₂' ¬IsDone-p₁' Unique-intp₁' p≡p₁'++p₂'
|
||
... | yes nⁱ∈intp₁
|
||
with (pᶜ , (¬IsDone-pᶜ , (ns , intp₁≡ns++intpᶜ))) ← splitFromInteriorʳ p₁ nⁱ∈intp₁
|
||
rewrite sym (++ˡ-assoc ns (nⁱ ∷ []) (interior pᶜ)) =
|
||
let Unique-intp₁' = subst Unique intp₁≡ns++intpᶜ Unique-intp₁
|
||
in inj₂ (nⁱ , ((pᶜ , (Unique-++⁻ʳ (ns ++ˡ nⁱ ∷ []) Unique-intp₁' , tabulate (λ {x} _ → nodes-complete x))) , ¬IsDone-pᶜ))
|
||
|
||
findCycle : ∀ {n₁ n₂} (p : Path n₁ n₂) → (Σ (SimpleWalkVia (proj₁ nodes) n₁ n₂) λ w → proj₁ w ≡ p) ⊎ (Σ Node (λ n → Σ (SimpleWalkVia (proj₁ nodes) n n) λ w → ¬ IsDone (proj₁ w)))
|
||
findCycle done = inj₁ ((done , (empty , [])) , refl)
|
||
findCycle (step n₁,n₂∈edges done) = inj₁ ((step n₁,n₂∈edges done , (empty , [])) , refl)
|
||
findCycle p@(step {n₂ = n'} n₁,n'∈edges p'@(step _ _)) = findCycleHelp p (step n₁,n'∈edges done) p' (λ {()}) empty refl
|
||
|
||
toSimpleWalk : ∀ {n₁ n₂} (p : Path n₁ n₂) → SimpleWalkVia (proj₁ nodes) n₁ n₂
|
||
toSimpleWalk done = (done , (empty , []))
|
||
toSimpleWalk (step {n₂ = nⁱ} n₁,nⁱ∈edges p')
|
||
with toSimpleWalk p'
|
||
... | (done , _) = (step n₁,nⁱ∈edges done , (empty , []))
|
||
... | (p''@(step _ _) , (Unique-intp'' , intp''⊆nodes))
|
||
with nⁱ ∈ˡ? interior p''
|
||
... | no nⁱ∉intp'' = (step n₁,nⁱ∈edges p'' , (push (tabulate (λ { n∈intp'' refl → nⁱ∉intp'' n∈intp'' })) Unique-intp'' , (nodes-complete nⁱ) ∷ intp''⊆nodes))
|
||
... | yes nⁱ∈intp''
|
||
with splitFromInteriorʳ p'' nⁱ∈intp''
|
||
... | (done , (¬IsDone=p''ʳ , (ns , intp''≡ns++intp''ʳ))) = ⊥-elim (¬IsDone=p''ʳ isDone)
|
||
... | (p''ʳ@(step _ _) , (¬IsDone=p''ʳ , (ns , intp''≡ns++intp''ʳ))) =
|
||
-- no rewrites because then I can't reason about the return value of toSimpleWalk
|
||
-- rewrite intp''≡ns++intp''ʳ
|
||
-- rewrite sym (++ˡ-assoc ns (nⁱ ∷ []) (interior p''ʳ)) =
|
||
let reassoc-intp''≡ns++intp''ʳ = subst (interior p'' ≡_) (sym (++ˡ-assoc ns (nⁱ ∷ []) (interior p''ʳ))) intp''≡ns++intp''ʳ
|
||
intp''ʳ⊆nodes = ++ˡ⁻ʳ (ns ++ˡ nⁱ ∷ []) (subst (All (_∈ˡ (proj₁ nodes))) reassoc-intp''≡ns++intp''ʳ intp''⊆nodes)
|
||
Unique-ns++intp''ʳ = subst Unique reassoc-intp''≡ns++intp''ʳ Unique-intp''
|
||
nⁱ∈p''ˡ = ∈ˡ-++⁺ʳ ns {ys = nⁱ ∷ []} (here refl)
|
||
in (step n₁,nⁱ∈edges p''ʳ , (Unique-narrow (ns ++ˡ nⁱ ∷ []) Unique-ns++intp''ʳ nⁱ∈p''ˡ , nodes-complete nⁱ ∷ intp''ʳ⊆nodes ))
|
||
|
||
toSimpleWalk-IsDone⁻ : ∀ {n₁ n₂} (p : Path n₁ n₂) →
|
||
¬ IsDone p → ¬ IsDone (proj₁ (toSimpleWalk p))
|
||
toSimpleWalk-IsDone⁻ done ¬IsDone-p _ = ¬IsDone-p isDone
|
||
toSimpleWalk-IsDone⁻ (step {n₂ = nⁱ} n₁,nⁱ∈edges p') _ isDone-w
|
||
with toSimpleWalk p'
|
||
... | (done , _) with () ← isDone-w
|
||
... | (p''@(step _ _) , (Unique-intp'' , intp''⊆nodes))
|
||
with nⁱ ∈ˡ? interior p''
|
||
... | no nⁱ∉intp'' with () ← isDone-w
|
||
... | yes nⁱ∈intp''
|
||
with splitFromInteriorʳ p'' nⁱ∈intp''
|
||
... | (done , (¬IsDone=p''ʳ , (ns , intp''≡ns++intp''ʳ))) = ¬IsDone=p''ʳ isDone
|
||
... | (p''ʳ@(step _ _) , (¬IsDone=p''ʳ , (ns , intp''≡ns++intp''ʳ)))
|
||
with () ← isDone-w
|
||
|
||
Adjacency : Set
|
||
Adjacency = ∀ (n₁ n₂ : Node) → List (Path n₁ n₂)
|
||
|
||
Adjacency-update : ∀ (n₁ n₂ : Node) → (List (Path n₁ n₂) → List (Path n₁ n₂)) → Adjacency → Adjacency
|
||
Adjacency-update n₁ n₂ f adj n₁' n₂'
|
||
with n₁ ≟ n₁' | n₂ ≟ n₂'
|
||
... | yes refl | yes refl = f (adj n₁ n₂)
|
||
... | _ | _ = adj n₁' n₂'
|
||
|
||
Adjacency-append : ∀ {n₁ n₂ : Node} → List (Path n₁ n₂) → Adjacency → Adjacency
|
||
Adjacency-append {n₁} {n₂} ps = Adjacency-update n₁ n₂ (ps ++ˡ_)
|
||
|
||
Adjacency-append-monotonic : ∀ {adj n₁ n₂ n₁' n₂'} {ps : List (Path n₁ n₂)} {p : Path n₁' n₂'} → p ∈ˡ adj n₁' n₂' → p ∈ˡ Adjacency-append ps adj n₁' n₂'
|
||
Adjacency-append-monotonic {adj} {n₁} {n₂} {n₁'} {n₂'} {ps} p∈adj
|
||
with n₁ ≟ n₁' | n₂ ≟ n₂'
|
||
... | yes refl | yes refl = ∈ˡ-++⁺ʳ ps p∈adj
|
||
... | yes refl | no _ = p∈adj
|
||
... | no _ | no _ = p∈adj
|
||
... | no _ | yes _ = p∈adj
|
||
|
||
adj⁰ : Adjacency
|
||
adj⁰ n₁ n₂
|
||
with n₁ ≟ n₂
|
||
... | yes refl = done ∷ []
|
||
... | no _ = []
|
||
|
||
adj⁰-done : ∀ n → done ∈ˡ adj⁰ n n
|
||
adj⁰-done n
|
||
with n ≟ n
|
||
... | yes refl = here refl
|
||
... | no n≢n = ⊥-elim (n≢n refl)
|
||
|
||
seedWithEdges : ∀ (es : List Edge) → (∀ {e} → e ∈ˡ es → e ∈ˡ edges) → Adjacency → Adjacency
|
||
seedWithEdges es e∈es⇒e∈edges adj = foldr (λ ((n₁ , n₂) , n₁n₂∈edges) → Adjacency-update n₁ n₂ ((step n₁n₂∈edges done) ∷_)) adj (mapWith∈ˡ es (λ {e} e∈es → (e , e∈es⇒e∈edges e∈es)))
|
||
|
||
seedWithEdges-monotonic : ∀ {n₁ n₂ es adj} → (e∈es⇒e∈edges : ∀ {e} → e ∈ˡ es → e ∈ˡ edges) → ∀ {p} → p ∈ˡ adj n₁ n₂ → p ∈ˡ seedWithEdges es e∈es⇒e∈edges adj n₁ n₂
|
||
seedWithEdges-monotonic {es = []} e∈es⇒e∈edges p∈adj = p∈adj
|
||
seedWithEdges-monotonic {es = (n₁ , n₂) ∷ es} e∈es⇒e∈edges p∈adj = Adjacency-append-monotonic {ps = step (e∈es⇒e∈edges (here refl)) done ∷ []} (seedWithEdges-monotonic (λ e∈es → e∈es⇒e∈edges (there e∈es)) p∈adj)
|
||
|
||
e∈seedWithEdges : ∀ {n₁ n₂ es adj} → (e∈es⇒e∈edges : ∀ {e} → e ∈ˡ es → e ∈ˡ edges) → ∀ (n₁n₂∈es : (n₁ , n₂) ∈ˡ es) → (step (e∈es⇒e∈edges n₁n₂∈es) done) ∈ˡ seedWithEdges es e∈es⇒e∈edges adj n₁ n₂
|
||
e∈seedWithEdges {es = []} e∈es⇒e∈edges ()
|
||
e∈seedWithEdges {es = (n₁' , n₂') ∷ es} e∈es⇒e∈edges (here refl)
|
||
with n₁' ≟ n₁' | n₂' ≟ n₂'
|
||
... | yes refl | yes refl = here refl
|
||
... | no n₁'≢n₁' | _ = ⊥-elim (n₁'≢n₁' refl)
|
||
... | _ | no n₂'≢n₂' = ⊥-elim (n₂'≢n₂' refl)
|
||
e∈seedWithEdges {n₁} {n₂} {es = (n₁' , n₂') ∷ es} {adj} e∈es⇒e∈edges (there n₁n₂∈es) = Adjacency-append-monotonic {ps = step (e∈es⇒e∈edges (here refl)) done ∷ []} (e∈seedWithEdges (λ e∈es → e∈es⇒e∈edges (there e∈es)) n₁n₂∈es)
|
||
|
||
adj¹ : Adjacency
|
||
adj¹ = seedWithEdges edges (λ x → x) adj⁰
|
||
|
||
adj¹-adj⁰ : ∀ {n₁ n₂ p} → p ∈ˡ adj⁰ n₁ n₂ → p ∈ˡ adj¹ n₁ n₂
|
||
adj¹-adj⁰ p∈adj⁰ = seedWithEdges-monotonic (λ x → x) p∈adj⁰
|
||
|
||
edge∈adj¹ : ∀ {n₁ n₂} (n₁n₂∈edges : (n₁ , n₂) ∈ˡ edges) → (step n₁n₂∈edges done) ∈ˡ adj¹ n₁ n₂
|
||
edge∈adj¹ = e∈seedWithEdges (λ x → x)
|
||
|
||
through : Node → Adjacency → Adjacency
|
||
through n adj n₁ n₂ = cartesianProductWith _++_ (adj n₁ n) (adj n n₂) ++ˡ adj n₁ n₂
|
||
|
||
through-monotonic : ∀ adj n {n₁ n₂ p} → p ∈ˡ adj n₁ n₂ → p ∈ˡ (through n adj) n₁ n₂
|
||
through-monotonic adj n p∈adjn₁n₂ = ∈ˡ-++⁺ʳ _ p∈adjn₁n₂
|
||
|
||
through-++ : ∀ adj n {n₁ n₂} {p₁ : Path n₁ n} {p₂ : Path n n₂} → p₁ ∈ˡ adj n₁ n → p₂ ∈ˡ adj n n₂ → (p₁ ++ p₂) ∈ˡ through n adj n₁ n₂
|
||
through-++ adj n p₁∈adj p₂∈adj = ∈ˡ-++⁺ˡ (∈ˡ-cartesianProductWith⁺ _++_ p₁∈adj p₂∈adj)
|
||
|
||
throughAll : List Node → Adjacency
|
||
throughAll = foldr through adj¹
|
||
|
||
throughAll-adj₁ : ∀ {n₁ n₂ p} ns → p ∈ˡ adj¹ n₁ n₂ → p ∈ˡ throughAll ns n₁ n₂
|
||
throughAll-adj₁ [] p∈adj¹ = p∈adj¹
|
||
throughAll-adj₁ (n ∷ ns) p∈adj¹ = through-monotonic (throughAll ns) n (throughAll-adj₁ ns p∈adj¹)
|
||
|
||
paths-throughAll : ∀ {n₁ n₂ : Node} (ns : List Node) (w : SimpleWalkVia ns n₁ n₂) → proj₁ w ∈ˡ throughAll ns n₁ n₂
|
||
paths-throughAll {n₁} [] (done , (_ , _)) = adj¹-adj⁰ (adj⁰-done n₁)
|
||
paths-throughAll {n₁} [] (step e∈edges done , (_ , _)) = edge∈adj¹ e∈edges
|
||
paths-throughAll {n₁} [] (step _ (step _ _) , (_ , (() ∷ _)))
|
||
paths-throughAll (n ∷ ns) w
|
||
with SplitSimpleWalkVia w
|
||
... | inj₁ ((w₁ , w₂) , w₁++w₂≡w) rewrite sym w₁++w₂≡w = through-++ (throughAll ns) n (paths-throughAll ns w₁) (paths-throughAll ns w₂)
|
||
... | inj₂ (w' , w'≡w) rewrite sym w'≡w = through-monotonic (throughAll ns) n (paths-throughAll ns w')
|
||
|
||
adj : Adjacency
|
||
adj = throughAll (proj₁ nodes)
|
||
|
||
PathExists : Node → Node → Set
|
||
PathExists n₁ n₂ = Path n₁ n₂
|
||
|
||
PathExists? : Decidable² PathExists
|
||
PathExists? n₁ n₂
|
||
with allSimplePathsNoted ← paths-throughAll {n₁ = n₁} {n₂ = n₂} (proj₁ nodes)
|
||
with adj n₁ n₂
|
||
... | [] = no (λ p → let w = toSimpleWalk p in ¬Any[] (allSimplePathsNoted w))
|
||
... | (p ∷ ps) = yes p
|
||
|
||
NoCycles : Set
|
||
NoCycles = ∀ {n} (p : Path n n) → IsDone p
|
||
|
||
NoCycles? : Dec NoCycles
|
||
NoCycles? with any? (λ n → any? (Decidable-¬ IsDone?) (adj n n)) (proj₁ nodes)
|
||
... | yes existsCycle =
|
||
no (λ ∀p,IsDonep → let (n , n,n-cycle) = satisfied existsCycle in
|
||
let (p , ¬IsDone-p) = satisfied n,n-cycle in
|
||
¬IsDone-p (∀p,IsDonep p))
|
||
... | no noCycles =
|
||
yes (λ { done → isDone
|
||
; p@(step {n₁ = n} _ _) →
|
||
let w = toSimpleWalk p in
|
||
let ¬IsDone-w = toSimpleWalk-IsDone⁻ p (λ {()}) in
|
||
let w∈adj = paths-throughAll (proj₁ nodes) w in
|
||
⊥-elim (noCycles (lose (nodes-complete n) (lose w∈adj ¬IsDone-w)))
|
||
})
|
||
|
||
NoCycles⇒adj-complete : NoCycles → ∀ {n₁ n₂} {p : Path n₁ n₂} → p ∈ˡ adj n₁ n₂
|
||
NoCycles⇒adj-complete noCycles {n₁} {n₂} {p}
|
||
with findCycle p
|
||
... | inj₁ (w , w≡p) rewrite sym w≡p = paths-throughAll (proj₁ nodes) w
|
||
... | inj₂ (nᶜ , (wᶜ , wᶜ≢done)) = ⊥-elim (wᶜ≢done (noCycles (proj₁ wᶜ)))
|
||
|
||
Is-⊤ : Node → Set
|
||
Is-⊤ n = All (PathExists n) (proj₁ nodes)
|
||
|
||
Is-⊥ : Node → Set
|
||
Is-⊥ n = All (λ n' → PathExists n' n) (proj₁ nodes)
|
||
|
||
Has-⊤ : Set
|
||
Has-⊤ = Any Is-⊤ (proj₁ nodes)
|
||
|
||
Has-⊤? : Dec Has-⊤
|
||
Has-⊤? = findUniversal (proj₁ nodes) PathExists?
|
||
|
||
Has-⊥ : Set
|
||
Has-⊥ = Any Is-⊥ (proj₁ nodes)
|
||
|
||
Has-⊥? : Dec Has-⊥
|
||
Has-⊥? = findUniversal (proj₁ nodes) (λ n₁ n₂ → PathExists? n₂ n₁)
|
||
|
||
Pred : Node → Node → Node → Set
|
||
Pred n₁ n₂ n = PathExists n n₁ × PathExists n n₂
|
||
|
||
Succ : Node → Node → Node → Set
|
||
Succ n₁ n₂ n = PathExists n₁ n × PathExists n₂ n
|
||
|
||
Pred? : ∀ (n₁ n₂ : Node) → Decidable (Pred n₁ n₂)
|
||
Pred? n₁ n₂ n = PathExists? n n₁ ×-dec PathExists? n n₂
|
||
|
||
Suc? : ∀ (n₁ n₂ : Node) → Decidable (Succ n₁ n₂)
|
||
Suc? n₁ n₂ n = PathExists? n₁ n ×-dec PathExists? n₂ n
|
||
|
||
preds : Node → Node → List Node
|
||
preds n₁ n₂ = filter (Pred? n₁ n₂) (proj₁ nodes)
|
||
|
||
sucs : Node → Node → List Node
|
||
sucs n₁ n₂ = filter (Suc? n₁ n₂) (proj₁ nodes)
|
||
|
||
Have-⊔ : Node → Node → Set
|
||
Have-⊔ n₁ n₂ = Σ Node (λ n → Pred n₁ n₂ n × (∀ n' → Pred n₁ n₂ n' → PathExists n' n))
|
||
|
||
Have-⊓ : Node → Node → Set
|
||
Have-⊓ n₁ n₂ = Σ Node (λ n → Succ n₁ n₂ n × (∀ n' → Succ n₁ n₂ n' → PathExists n n'))
|
||
|
||
-- when filtering nodes by a predicate P, then trying to find a universal
|
||
-- element according to another predicate Q, the universality can be
|
||
-- extended from "element of the filtered list for to which all other elements relate" to
|
||
-- "node satisfying P to which all other nodes satisfying P relate".
|
||
filter-nodes-universal : ∀ {P : Node → Set} (P? : Decidable P) -- e.g. Pred n₁ n₂
|
||
{Q : Node → Node → Set} (Q? : Decidable² Q) -- e.g. PathExists? n' n
|
||
→ Dec (Σ Node λ n → P n × (∀ n' → P n' → Q n n'))
|
||
filter-nodes-universal {P = P} P? {Q = Q} Q?
|
||
with findUniversal (filter P? (proj₁ nodes)) Q?
|
||
... | yes founduni =
|
||
let idx = index founduni
|
||
n = Any.lookup founduni
|
||
n∈filter = ∈ˡ-lookup idx
|
||
(_ , Pn) = ∈ˡ-filter⁻ P? {xs = proj₁ nodes} n∈filter
|
||
nuni = lookup-result founduni
|
||
in yes (n , (Pn , λ n' Pn' →
|
||
let n'∈filter = ∈ˡ-filter⁺ P? (nodes-complete n') Pn'
|
||
in lookup nuni n'∈filter))
|
||
... | no nouni = no λ (n , (Pn , nuni')) →
|
||
let n∈filter = ∈ˡ-filter⁺ P? (nodes-complete n) Pn
|
||
nuni = tabulate {xs = filter P? (proj₁ nodes)} (λ {n'} n'∈filter → nuni' n' (proj₂ (∈ˡ-filter⁻ P? {xs = proj₁ nodes} n'∈filter)))
|
||
in nouni (lose n∈filter nuni)
|
||
|
||
Have-⊔? : Decidable² Have-⊔
|
||
Have-⊔? n₁ n₂ = filter-nodes-universal (Pred? n₁ n₂) (λ n₁ n₂ → PathExists? n₂ n₁)
|
||
|
||
Have-⊓? : Decidable² Have-⊓
|
||
Have-⊓? n₁ n₂ = filter-nodes-universal (Suc? n₁ n₂) PathExists?
|
||
|
||
Total-⊔ : Set
|
||
Total-⊔ = ∀ n₁ n₂ → Have-⊔ n₁ n₂
|
||
|
||
Total-⊓ : Set
|
||
Total-⊓ = ∀ n₁ n₂ → Have-⊓ n₁ n₂
|
||
|
||
P-Total? : ∀ {P : Node → Node → Set} (P? : Decidable² P) → Dec (∀ n₁ n₂ → P n₁ n₂)
|
||
P-Total? {P} P?
|
||
with all? (λ (n₁ , n₂) → P? n₁ n₂) (cartesianProduct (proj₁ nodes) (proj₁ nodes))
|
||
... | yes allP = yes λ n₁ n₂ →
|
||
let n₁n₂∈prod = ∈-cartesianProduct (nodes-complete n₁) (nodes-complete n₂)
|
||
in lookup allP n₁n₂∈prod
|
||
... | no ¬allP = no λ allP → ¬allP (universal (λ (n₁ , n₂) → allP n₁ n₂) _)
|
||
|
||
Total-⊔? : Dec Total-⊔
|
||
Total-⊔? = P-Total? Have-⊔?
|
||
|
||
Total-⊓? : Dec Total-⊓
|
||
Total-⊓? = P-Total? Have-⊓?
|
||
|
||
module AssumeWellFormed (noCycles : NoCycles) (total-⊔ : Total-⊔) (total-⊓ : Total-⊓) where
|
||
n₁→n₂×n₂→n₁⇒n₁≡n₂ : ∀ {n₁ n₂} → PathExists n₁ n₂ → PathExists n₂ n₁ → n₁ ≡ n₂
|
||
n₁→n₂×n₂→n₁⇒n₁≡n₂ n₁→n₂ n₂→n₁
|
||
with n₁→n₂ | n₂→n₁ | noCycles (n₁→n₂ ++ n₂→n₁)
|
||
... | done | done | _ = refl
|
||
... | step _ _ | done | _ = refl
|
||
... | done | step _ _ | _ = refl
|
||
... | step _ _ | step _ _ | ()
|
||
|
||
_⊔_ : Node → Node → Node
|
||
_⊔_ n₁ n₂ = proj₁ (total-⊔ n₁ n₂)
|
||
|
||
_⊓_ : Node → Node → Node
|
||
_⊓_ n₁ n₂ = proj₁ (total-⊓ n₁ n₂)
|
||
|
||
⊤ : Node
|
||
⊤ = foldr₁ nodes-nonempty _⊔_
|
||
|
||
⊥ : Node
|
||
⊥ = foldr₁ nodes-nonempty _⊓_
|
||
|
||
_≼_ : Node → Node → Set
|
||
_≼_ n₁ n₂ = n₁ ⊔ n₂ ≡ n₂
|
||
|
||
n₁≼n₂→PathExistsn₂n₁ : ∀ n₁ n₂ → (n₁ ≼ n₂) → PathExists n₂ n₁
|
||
n₁≼n₂→PathExistsn₂n₁ n₁ n₂ n₁⊔n₂≡n₂
|
||
with total-⊔ n₁ n₂ | n₁⊔n₂≡n₂
|
||
... | (_ , ((n₂→n₁ , _) , _)) | refl = n₂→n₁
|
||
|
||
PathExistsn₂n₁→n₁≼n₂ : ∀ n₁ n₂ → PathExists n₂ n₁ → (n₁ ≼ n₂)
|
||
PathExistsn₂n₁→n₁≼n₂ n₁ n₂ n₂→n₁
|
||
with total-⊔ n₁ n₂
|
||
... | (n , ((n→n₁ , n→n₂) , n'→n₁×n'→n₂⇒n'→n))
|
||
rewrite n₁→n₂×n₂→n₁⇒n₁≡n₂ n→n₂ (n'→n₁×n'→n₂⇒n'→n n₂ (n₂→n₁ , done)) = refl
|
||
|
||
foldr₁⊔-Pred : ∀ {ns : List Node} (ns≢[] : ¬ (ns ≡ [])) → let n = foldr₁ ns≢[] _⊔_ in All (PathExists n) ns
|
||
foldr₁⊔-Pred {ns = []} []≢[] = ⊥-elim ([]≢[] refl)
|
||
foldr₁⊔-Pred {ns = n₁ ∷ []} _ = done ∷ []
|
||
foldr₁⊔-Pred {ns = n₁ ∷ ns'@(n₂ ∷ ns'')} ns≢[] =
|
||
let
|
||
ns'≢[] = x∷xs≢[] n₂ ns''
|
||
n' = foldr₁ ns'≢[] _⊔_
|
||
(n , ((n→n₁ , n→n') , r)) = total-⊔ n₁ n'
|
||
in
|
||
n→n₁ ∷ map (n→n' ++_) (foldr₁⊔-Pred ns'≢[])
|
||
|
||
-- TODO: this is very similar structurally to foldr₁⊔-Pred
|
||
foldr₁⊓-Suc : ∀ {ns : List Node} (ns≢[] : ¬ (ns ≡ [])) → let n = foldr₁ ns≢[] _⊓_ in All (λ n' → PathExists n' n) ns
|
||
foldr₁⊓-Suc {ns = []} []≢[] = ⊥-elim ([]≢[] refl)
|
||
foldr₁⊓-Suc {ns = n₁ ∷ []} _ = done ∷ []
|
||
foldr₁⊓-Suc {ns = n₁ ∷ ns'@(n₂ ∷ ns'')} ns≢[] =
|
||
let
|
||
ns'≢[] = x∷xs≢[] n₂ ns''
|
||
n' = foldr₁ ns'≢[] _⊓_
|
||
(n , ((n₁→n , n'→n) , r)) = total-⊓ n₁ n'
|
||
in
|
||
n₁→n ∷ map (_++ n'→n) (foldr₁⊓-Suc ns'≢[])
|
||
|
||
⊤-is-⊤ : Is-⊤ ⊤
|
||
⊤-is-⊤ = foldr₁⊔-Pred nodes-nonempty
|
||
|
||
⊥-is-⊥ : Is-⊥ ⊥
|
||
⊥-is-⊥ = foldr₁⊓-Suc nodes-nonempty
|
||
|
||
⊔-refl : ∀ n → n ⊔ n ≡ n
|
||
⊔-refl n
|
||
with (n' , ((n'→n , _) , n''→n×n''→n⇒n''→n')) ← total-⊔ n n
|
||
= n₁→n₂×n₂→n₁⇒n₁≡n₂ n'→n (n''→n×n''→n⇒n''→n' n (done , done))
|
||
|
||
⊓-refl : ∀ n → n ⊓ n ≡ n
|
||
⊓-refl n
|
||
with (n' , ((n→n' , _) , n→n''×n→n''⇒n'→n'')) ← total-⊓ n n
|
||
= n₁→n₂×n₂→n₁⇒n₁≡n₂ (n→n''×n→n''⇒n'→n'' n (done , done)) n→n'
|
||
|
||
⊔-comm : ∀ n₁ n₂ → n₁ ⊔ n₂ ≡ n₂ ⊔ n₁
|
||
⊔-comm n₁ n₂
|
||
with (n₁₂ , ((n₁n₂→n₁ , n₁n₂→n₂) , n'→n₁×n'→n₂⇒n'→n₁₂)) ← total-⊔ n₁ n₂
|
||
with (n₂₁ , ((n₂n₁→n₂ , n₂n₁→n₁) , n'→n₂×n'→n₁⇒n'→n₂₁)) ← total-⊔ n₂ n₁
|
||
= n₁→n₂×n₂→n₁⇒n₁≡n₂ (n'→n₂×n'→n₁⇒n'→n₂₁ n₁₂ (n₁n₂→n₂ , n₁n₂→n₁))
|
||
(n'→n₁×n'→n₂⇒n'→n₁₂ n₂₁ (n₂n₁→n₁ , n₂n₁→n₂))
|
||
|
||
⊓-comm : ∀ n₁ n₂ → n₁ ⊓ n₂ ≡ n₂ ⊓ n₁
|
||
⊓-comm n₁ n₂
|
||
with (n₁₂ , ((n₁→n₁n₂ , n₂→n₁n₂) , n₁→n'×n₂→n'⇒n₁₂→n')) ← total-⊓ n₁ n₂
|
||
with (n₂₁ , ((n₂→n₂n₁ , n₁→n₂n₁) , n₂→n'×n₁→n'⇒n₂₁→n')) ← total-⊓ n₂ n₁
|
||
= n₁→n₂×n₂→n₁⇒n₁≡n₂ (n₁→n'×n₂→n'⇒n₁₂→n' n₂₁ (n₁→n₂n₁ , n₂→n₂n₁))
|
||
(n₂→n'×n₁→n'⇒n₂₁→n' n₁₂ (n₂→n₁n₂ , n₁→n₁n₂))
|