Lie algebra properties of Whitehead products

Cubical/Algebra/AbGroup/Properties.agda

@@ -37,6 +37,17 @@ module AbGroupTheory (A : AbGroup ℓ) where
   implicitInverse : ∀ {a b} → a + b ≡ 0g → b ≡ - a
   implicitInverse b+a≡0 = invUniqueR b+a≡0
 
+  invDistrAb : ∀ a b → - (a + b) ≡ ((- a) + (- b))
+  invDistrAb a b = invDistr a b ∙ +Comm (- b) (- a)
+
+  inv^Distr : ∀ a b → (n : ℕ) → iter n -_ (a + b) ≡ (iter n -_ a + iter n -_ b)
+  inv^Distr a b zero = refl
+  inv^Distr a b (suc zero) = invDistrAb a b
+  inv^Distr a b (suc (suc n)) =
+    invInv (iter n -_ (a + b))
+    ∙ inv^Distr a b n
+    ∙ cong₂ _+_ (sym (invInv (iter n -_ a))) (sym (invInv (iter n -_ b)))
+
 addGroupHom : (A : AbGroup ℓ) (B : AbGroup ℓ') (ϕ ψ : AbGroupHom A B) → AbGroupHom A B
 fst (addGroupHom A B ϕ ψ) x = AbGroupStr._+_ (snd B) (ϕ .fst x) (ψ .fst x)
 snd (addGroupHom A B ϕ ψ) = makeIsGroupHom

Cubical/Algebra/Group/Properties.agda

@@ -7,6 +7,9 @@ open import Cubical.Foundations.Structure
 open import Cubical.Foundations.Isomorphism
 open import Cubical.Foundations.GroupoidLaws hiding (assoc)
 open import Cubical.Data.Sigma
+open import Cubical.Data.Nat hiding (_·_)
+open import Cubical.Data.Sum
+open import Cubical.Data.Nat.IsEven
 
 open import Cubical.Algebra.Semigroup
 open import Cubical.Algebra.Monoid.Base
@@ -89,6 +92,27 @@ module GroupTheory (G : Group ℓ) where
           a · (1g · inv a)          ≡⟨ congR _·_ (·IdL (inv a)) ∙ ·InvR a ⟩
           1g ∎
 
+    -iter-odd+even : (n m : ℕ) (g : fst G)
+      → isEvenT n ≡ isOddT m
+      → GroupStr._·_ (snd G)
+          (iter n (GroupStr.inv (snd G)) g)
+          (iter m (GroupStr.inv (snd G)) g)
+       ≡ GroupStr.1g (snd G)
+    -iter-odd+even n m g p with (evenOrOdd n)
+    ... | inl q = cong₂ (GroupStr._·_ (snd G))
+                        (iterEvenInv (GroupStr.inv (snd G))
+                          invInv n q g)
+                        (iterOddInv (GroupStr.inv (snd G))
+                          invInv m (transport p q) g)
+                ∙ GroupStr.·InvR (snd G) g
+    ... | inr q = cong₂ (GroupStr._·_ (snd G))
+                        (iterOddInv (GroupStr.inv (snd G))
+                          invInv n q g)
+                        (iterEvenInv (GroupStr.inv (snd G))
+                          invInv m
+                            (transport (even≡odd→odd≡even n m p) q) g)
+                ∙ GroupStr.·InvL (snd G) g
+
 congIdLeft≡congIdRight : (_·G_ : G → G → G) (-G_ : G → G)
             (0G : G)
             (rUnitG : (x : G) → x ·G 0G ≡ x)

Cubical/Data/Nat/Base.agda

@@ -34,6 +34,11 @@ iter : ∀ {ℓ} {A : Type ℓ} → ℕ → (A → A) → A → A
 iter zero f z    = z
 iter (suc n) f z = f (iter n f z)
 
+iter+ : ∀ {ℓ} {A : Type ℓ} (n m : ℕ) (f : A → A) (z : A)
+  → iter (n + m) f z ≡ iter n f (iter m f z)
+iter+ zero m f z _ = iter m f z
+iter+ (suc n) m f z i = f (iter+ n m f z i)
+
 elim : ∀ {ℓ} {A : ℕ → Type ℓ}
   → A zero
   → ((n : ℕ) → A n → A (suc n))
@@ -56,17 +61,19 @@ isOdd zero = false
 isOdd (suc n) = isEven n
 
 --Typed version
-private
-  toType : Bool → Type
-  toType false = ⊥
-  toType true = Unit
+toType : Bool → Type
+toType false = ⊥
+toType true = Unit
 
 isEvenT : ℕ → Type
 isEvenT n = toType (isEven n)
 
 isOddT : ℕ → Type
 isOddT n = isEvenT (suc n)
 
+evenOrOddT : (n : ℕ) → Type
+evenOrOddT n = isEvenT n ⊎ isOddT n
+
 isZero : ℕ → Bool
 isZero zero = true
 isZero (suc n) = false

Cubical/Data/Nat/IsEven.agda

@@ -1,11 +1,15 @@
 module Cubical.Data.Nat.IsEven where
 
 open import Cubical.Foundations.Prelude
+open import Cubical.Foundations.Pointed
+open import Cubical.Foundations.Path
+open import Cubical.Foundations.GroupoidLaws
 
 open import Cubical.Data.Empty as ⊥
 open import Cubical.Data.Bool
 open import Cubical.Data.Nat
 open import Cubical.Data.Sum
+open import Cubical.Data.Nat.Mod
 
 -- negation result
 ¬IsEvenFalse : (n : ℕ) → (isEven n ≡ false) → isOdd n ≡ true
@@ -70,3 +74,168 @@ evenOrOdd-Odd : (n : ℕ) → (isEven n ≡ false) → Σ[ x ∈ isOddT n ] even
 evenOrOdd-Odd zero p = ⊥.rec (true≢false p)
 evenOrOdd-Odd (suc zero) p = tt , refl
 evenOrOdd-Odd (suc (suc n)) p = evenOrOdd-Odd n p
+
+isEvenT→isEvenTrue : (n : ℕ) → isEvenT n → (isEven n ≡ true)
+isEvenT→isEvenTrue zero x = refl
+isEvenT→isEvenTrue (suc (suc n)) x = isEvenT→isEvenTrue n x
+
+isEvenT→isOddFalse : (n : ℕ) → isEvenT n → (isOdd n ≡ false)
+isEvenT→isOddFalse zero x = refl
+isEvenT→isOddFalse (suc (suc n)) x = isEvenT→isOddFalse n x
+
+isOddT→isEvenFalse : (n : ℕ) → isOddT n → (isEven n ≡ false)
+isOddT→isEvenFalse (suc n) x = isEvenT→isOddFalse n x
+
+isOddT→isOddTrue : (n : ℕ) → isOddT n → (isOdd n ≡ true)
+isOddT→isOddTrue (suc n) x = isEvenT→isEvenTrue n x
+
+------------
+
+even+even≡even : (n m : ℕ) → isEvenT n → isEvenT m → isEvenT (n + m)
+even+even≡even zero m p q = q
+even+even≡even (suc (suc n)) m p q = even+even≡even n m p q
+
+even+odd≡odd : (n m : ℕ) → isEvenT n → isOddT m → isOddT (n + m)
+even+odd≡odd zero m p q = q
+even+odd≡odd (suc (suc n)) m p q = even+odd≡odd n m p q
+
+odd+even≡odd : (n m : ℕ) → isOddT n → isEvenT m → isOddT (n + m)
+odd+even≡odd n m p q = subst isOddT (+-comm m n) (even+odd≡odd m n q p)
+
+odd+odd≡even : (n m : ℕ) → isOddT n → isOddT m → isEvenT (n + m)
+odd+odd≡even (suc n) (suc m) p q =
+  subst isEvenT (cong suc (sym (+-suc n m)))
+        (even+even≡even n m p q)
+
+isEven·2 : (n : ℕ) → isEvenT (n + n)
+isEven·2 zero = tt
+isEven·2 (suc n) =
+  subst isEvenT (cong suc (+-comm (suc n) n)) (isEven·2 n)
+
+even·x≡even : (n m : ℕ) → isEvenT n → isEvenT (n · m)
+even·x≡even zero m p = tt
+even·x≡even (suc (suc n)) m p =
+  subst isEvenT (sym (+-assoc m m (n · m)))
+    (even+even≡even (m + m) (n · m) (isEven·2 m) (even·x≡even n m p))
+
+x·even≡even : (n m : ℕ) → isEvenT m → isEvenT (n · m)
+x·even≡even n m p = subst isEvenT (·-comm m n) (even·x≡even m n p)
+
+odd·odd≡odd : (n m : ℕ) → isOddT n → isOddT m → isOddT (n · m)
+odd·odd≡odd (suc n) (suc m) p q =
+  subst isOddT t (even+even≡even m _ q
+    (even+even≡even n _ p (even·x≡even n m p)))
+  where
+  t : suc (m + (n + n · m)) ≡ suc (m + n · suc m)
+  t = cong suc (cong (m +_) (cong (n +_) (·-comm n m) ∙ ·-comm (suc m) n))
+
+even≡odd→odd≡even : (n m : ℕ) → isEvenT n ≡ isOddT m → isOddT n ≡ isEvenT m
+even≡odd→odd≡even zero zero p = sym p
+even≡odd→odd≡even zero (suc zero) p = refl
+even≡odd→odd≡even zero (suc (suc m)) p = even≡odd→odd≡even zero m p
+even≡odd→odd≡even (suc zero) zero p = refl
+even≡odd→odd≡even (suc zero) (suc zero) p = sym p
+even≡odd→odd≡even (suc zero) (suc (suc m)) p = even≡odd→odd≡even (suc zero) m p
+even≡odd→odd≡even (suc (suc n)) m p = even≡odd→odd≡even n m p
+
+-- Relation to mod 2
+isEvenT↔≡0 : (n : ℕ) → isEvenT n ↔ ((n mod 2) ≡ 0)
+isEvenT↔≡0 zero .fst _ = refl
+isEvenT↔≡0 zero .snd _ = tt
+isEvenT↔≡0 (suc zero) .fst ()
+isEvenT↔≡0 (suc zero) .snd = snotz
+isEvenT↔≡0 (suc (suc n)) =
+  comp↔ (isEvenT↔≡0 n)
+    (subst (λ x → (modInd 1 n ≡ 0) ↔ (x ≡ 0))
+      (sym (mod+mod≡mod 2 2 n
+          ∙ cong (_mod 2) main ∙ mod-idempotent n)) id↔)
+  where
+  main : ((2 mod 2) + (n mod 2)) ≡ n mod 2
+  main = cong (_+ (n mod 2)) (zero-charac 2)
+
+isOddT↔≡1 : (n : ℕ) → isOddT n ↔ ((n mod 2) ≡ 1)
+isOddT↔≡1 zero .fst ()
+isOddT↔≡1 zero .snd x = snotz (sym x)
+isOddT↔≡1 (suc zero) .fst _ = refl
+isOddT↔≡1 (suc zero) .snd _ = tt
+isOddT↔≡1 (suc (suc n)) =
+  comp↔ (isOddT↔≡1 n)
+    (subst (λ x → (modInd 1 n ≡ 1) ↔ (x ≡ 1))
+      (sym (mod-idempotent n) ∙ sym (mod+mod≡mod 2 2 n)) id↔)
+
+-- characterisation of even/odd iterations of involutions
+module _ {ℓ} {A : Type ℓ} (invA : A → A)
+         (invol : (a : A) → invA (invA a) ≡ a) where
+  iterEvenInv : (k : ℕ) → isEvenT k → (a : A) → iter k invA a ≡ a
+  iterEvenInv zero evk a = refl
+  iterEvenInv (suc (suc k)) evk a =
+    invol (iter k invA a) ∙ iterEvenInv k evk a
+
+  iterOddInv : (k : ℕ) → isOddT k → (a : A) → iter k invA a ≡ invA a
+  iterOddInv (suc k) p a = cong invA (iterEvenInv k p a)
+
+  iter+iter : (k : ℕ) (a : A) → iter k invA (iter k invA a) ≡ a
+  iter+iter k a = sym (iter+ k k invA a) ∙ iterEvenInv (k + k) (isEven·2 k) a
+
+-- pointed versions
+module _ {ℓ} {A : Pointed ℓ} (invA : A →∙ A)
+         (invol : invA ∘∙ invA ≡ idfun∙ A) where
+  private -- technical lemmas
+    sqEven' : (k : ℕ) (p : isEvenT k)
+      → iterEvenInv (fst invA) (funExt⁻ (cong fst invol)) k p (pt A)
+       ≡ iter∙ k invA .snd
+    sqEven' zero p = refl
+    sqEven' (suc (suc k)) p =
+        (rUnit _
+        ∙ (λ i → ((λ j → fst (invol (~ i ∧ j)) (iter k (fst invA) (pt A)))
+          ∙ (λ j → fst (invol (~ i)) (iterEvenInv (fst invA)
+                       (funExt⁻ (λ i₁ → fst (invol i₁))) k p (pt A) j)))
+          ∙ λ j → fst (invol (~ i ∨ j)) (pt A) )
+        ∙ cong₂ _∙_ (sym (lUnit _))
+                (rUnit (funExt⁻ (cong fst invol) (pt A))
+                ∙ cong₂ _∙_ refl (rUnit refl)
+               ∙ PathP→compPathL (symP (cong snd invol)))
+        ∙ assoc (cong (fst invA) (cong (fst invA) (iterEvenInv (fst invA)
+                                       (funExt⁻ (cong fst invol)) k p (pt A))))
+              (cong (fst invA) (snd invA))
+              (snd invA))
+      ∙ cong₂ _∙_ (sym (cong-∙ (fst invA)
+                       (cong (fst invA) (iterEvenInv (fst invA)
+                                        (funExt⁻ (cong fst invol)) k p (pt A)))
+                       (snd invA))
+                 ∙ cong (congS (fst invA))
+                  (cong₂ _∙_ (cong (cong (fst invA))
+                  (sqEven' k p)) refl)) refl
+
+    sqOdd' : (k : ℕ) (p : isOddT k)
+      → iterOddInv (fst invA) (funExt⁻ (cong fst invol)) k p (pt A) ∙ snd invA
+       ≡ iter∙ k invA .snd
+    sqOdd' (suc zero) p = refl
+    sqOdd' (suc (suc (suc k))) p =
+      cong₂ _∙_ (cong (congS (fst invA))
+        (sqEven' (suc (suc k)) p))
+        refl
+
+    sqEven : (k : ℕ) (p : isEvenT k)
+      → Square (iterEvenInv (fst invA) (funExt⁻ (cong fst invol)) k p (pt A))
+                refl (iter∙ k invA .snd) refl
+    sqEven k p = sqEven' k p ◁ λ i j → iter∙ k invA .snd (i ∨ j)
+
+
+    sqOdd : (k : ℕ) (p : isOddT k)
+      → Square (iterOddInv (fst invA) (funExt⁻ (cong fst invol)) k p (pt A))
+                refl (iter∙ k invA .snd) (snd invA)
+    sqOdd k p = flipSquare (sym (sqOdd' k p)
+      ◁ symP (compPath-filler' (iterOddInv (fst invA)
+                                (funExt⁻ (cong (λ r → fst r) invol)) k p (pt A))
+                               (snd invA)))
+
+  iter∙EvenInv : (k : ℕ) → isEvenT k → iter∙ k invA ≡ idfun∙ A
+  iter∙EvenInv k p i .fst x =
+    iterEvenInv (fst invA) (funExt⁻ (cong fst invol)) k p x i
+  iter∙EvenInv k p i .snd j = sqEven k p j i
+
+  iter∙OddInv : (k : ℕ) → isOddT k → iter∙ k invA ≡ invA
+  iter∙OddInv k p i .fst x =
+    iterOddInv (fst invA) (funExt⁻ (cong fst invol)) k p x i
+  iter∙OddInv k p i .snd j = sqOdd k p j i

Cubical/Data/Vec/Base.agda

@@ -35,6 +35,12 @@ map : ∀ {A : Type ℓ} {B : Type ℓ'} {n} → (A → B) → Vec A n → Vec B
 map f []       = []
 map f (x ∷ xs) = f x ∷ map f xs
 
+compMap : {C : Type ℓ''} {n : ℕ}
+  → (f : B → C) (g : A → B) (v : Vec A n)
+  → map (λ x → f (g x)) v ≡ map f (map g v)
+compMap f g [] = refl
+compMap f g (x ∷ v) i = f (g x) ∷ compMap f g v i
+
 replicate : ∀ {n} {A : Type ℓ} → A → Vec A n
 replicate {n = zero}  x = []
 replicate {n = suc n} x = x ∷ replicate x
@@ -63,4 +69,3 @@ concat (xs ∷ xss) = xs ++ concat xss
 lookup : ∀ {n} {A : Type ℓ} → Fin n → Vec A n → A
 lookup zero    (x ∷ xs) = x
 lookup (suc i) (x ∷ xs) = lookup i xs
-

Cubical/Foundations/Equiv.agda

@@ -19,6 +19,7 @@ module Cubical.Foundations.Equiv where
 open import Cubical.Foundations.Function
 open import Cubical.Foundations.Prelude
 open import Cubical.Foundations.Isomorphism
+open import Cubical.Foundations.GroupoidLaws
 
 open import Cubical.Foundations.Equiv.Base public
 open import Cubical.Data.Sigma.Base
@@ -323,3 +324,29 @@ isEquiv≃isEquiv' f = isoToEquiv (isEquiv-isEquiv'-Iso f)
 
 -- The fact that funExt is an equivalence can be found in Cubical.Functions.FunExtEquiv
 
+-- characterisation of retract proof produced by isoToEquiv
+retEqIsoToEquiv : ∀ {ℓ ℓ'} {A : Type ℓ} {B : Type ℓ'}
+  (is : Iso A B) (x : _)
+    → retEq (isoToEquiv is) x
+     ≡ ((sym (leftInv is (inv is (fun is x)))
+     ∙ cong (inv is) ((rightInv is (fun is x)))))
+     ∙ leftInv is x
+retEqIsoToEquiv is x i j =
+  hcomp (λ k → λ {(i = i1)
+                 → compPath-filler (sym (leftInv is (inv is (fun is x)))
+                                   ∙ cong (inv is) ((rightInv is (fun is x))))
+                                    (leftInv is x) k j
+                  ; (j = i0) → (cong (inv is) (sym (rightInv is (fun is x)))
+                              ∙ leftInv is (inv is (fun is x))) (i ∨ k)
+                  ; (j = i1) → lUnit (leftInv is x) (~ i) k})
+    (lemma j i)
+  where
+  p = sym (symDistr (sym (leftInv is (inv is (fun is x))))
+                        (cong (inv is) (rightInv is (fun is x))))
+
+  lemma : Square (cong (inv is) (sym (rightInv is (fun is x)))
+                ∙ leftInv is (inv is (fun is x)))
+          refl refl
+          (sym (leftInv is (inv is (fun is x)))
+         ∙ cong (inv is) ((rightInv is (fun is x))))
+  lemma = p ◁ λ i j → p i1 (~ i ∧ j)

Cubical/Foundations/Pointed/Base.agda

@@ -10,6 +10,8 @@ open import Cubical.Foundations.Isomorphism
 open import Cubical.Foundations.Univalence
 open import Cubical.Foundations.Function
 
+open import Cubical.Data.Nat
+
 private
   variable
     ℓ ℓ' : Level
@@ -39,6 +41,16 @@ idfun∙ : (A : Pointed ℓ) → A →∙ A
 idfun∙ A .fst x = x
 idfun∙ A .snd = refl
 
+iter∙ : {A : Pointed ℓ} (k : ℕ) → A →∙ A → A →∙ A
+iter∙ k f .fst = iter k (fst f)
+iter∙ zero f .snd = refl
+iter∙ (suc k) f .snd = cong (fst f) (iter∙ k f .snd) ∙ snd f
+
+subst∙ : ∀ {ℓ ℓA} {X : Type ℓ} (A : X → Pointed ℓA)
+  → {x y : X} (p : x ≡ y) → A x →∙ A y
+subst∙ A p .fst = subst (fst ∘ A) p
+subst∙ A p .snd i = transp (λ j → fst (A (p (i ∨ j)))) i (pt (A (p i)))
+
 infix 3 _≃∙_
 {-Pointed equivalences -}
 _≃∙_ : (A : Pointed ℓ) (B : Pointed ℓ') → Type (ℓ-max ℓ ℓ')

Cubical/Foundations/Pointed/Properties.agda

@@ -262,3 +262,20 @@ constantPointed≡ {A = A} {B = B , b} f Hf i =
          ; (i = i1) → snd f k
          ; (j = i1) → snd f k })
     (Hf ((~ i) ∧ (~ j)) (pt A))
+
+
+-- Properties of subst∙
+subst∙refl : ∀ {ℓ ℓA} {X : Type ℓ} (A : X → Pointed ℓA)
+  → {x : X} → subst∙ A (refl {x = x}) ≡ idfun∙ (A x)
+subst∙refl A {x} = ΣPathP ((funExt transportRefl)
+  , (λ j i → transp (λ t → fst (A x)) (j ∨ i) (pt (A x))))
+
+subst∙Id : ∀ {ℓ ℓA ℓB} {X : Type ℓ} (A : X → Pointed ℓA) {B : Pointed ℓB}
+  → {x y : X} (p : x ≡ y) (f : A x →∙ B)
+    → f ∘∙ subst∙ A (sym p) ≡ transport (λ i → A (p i) →∙ B) f
+subst∙Id A {B = B} {x = x} =
+  J (λ y p → (f : A x →∙ B)
+            → f ∘∙ subst∙ A (sym p)
+            ≡ transport (λ i → A (p i) →∙ B) f)
+    λ f → (cong₂ _∘∙_ refl (subst∙refl A) ∙ ∘∙-idˡ _)
+         ∙ sym (transportRefl f)