module Ag10 where

import Relation.Binary.PropositionalEquality as Eq
open Eq using (_≡_; refl)
open Eq.≡-Reasoning
open import Data.Nat using (ℕ)
open import Function using (_∘_)
open import Ag09 using (_≃_; _≲_; extensionality; _⇔_)
open Ag09.≃-Reasoning
open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
open import Data.Unit using (⊤; tt)
open import Data.Sum using (_⊎_; inj₁; inj₂) renaming ([_,_] to case-⊎)
open import Data.Empty using (⊥; ⊥-elim)
import Function.Equivalence using (_⇔_)

⇔≃× : ∀ {A B : Set} → (A ⇔ B) ≃ ((A → B) × (B → A))
⇔≃× =
  record
  { to = λ{ x → ⟨ Ag09._⇔_.to x , Ag09._⇔_.from x ⟩}
  ; from = λ{ ⟨ x , y ⟩ → record { to = x ; from = y } }
  ; from∘to = λ{ x → refl }
  ; to∘from = λ{ x → refl }
  }

⊎-comm : ∀ {A B : Set} → (A ⊎ B) ≃ (B ⊎ A)
⊎-comm =
  record
  { to = λ{ (inj₁ x) → inj₂ x ; (inj₂ y) → inj₁ y }
  ; from =  λ{ (inj₁ x) → inj₂ x ; (inj₂ y) → inj₁ y}
  ; from∘to = λ{ (inj₁ x) → refl ; (inj₂ y) → refl }
  ; to∘from = λ{ (inj₁ x) → refl ; (inj₂ y) → refl}
  }

⊎-assoc : ∀ {A B C : Set} → (A ⊎ B) ⊎ C ≃ A ⊎ (B ⊎ C)
⊎-assoc =
  record
  { to = λ{ (inj₁ (inj₁ x)) → inj₁ x ; (inj₁ (inj₂ y)) → inj₂ (inj₁ y) ; (inj₂ z) → inj₂ (inj₂ z) }
  ; from = λ{ (inj₁ x) → inj₁ (inj₁ x) ; (inj₂ (inj₁ y)) → inj₁ (inj₂ y) ; (inj₂ (inj₂ z)) → inj₂ z }
  ; from∘to = λ{ (inj₁ (inj₁ x)) → refl ; (inj₁ (inj₂ y)) → refl ; (inj₂ z) → refl }
  ; to∘from = λ{ (inj₁ x) → refl ; (inj₂ (inj₁ y)) → refl ; (inj₂ (inj₂ z)) → refl }
  }

⊥-identityˡ : ∀ {A : Set} → ⊥ ⊎ A ≃ A
⊥-identityˡ =
    record
    { to = λ{ (inj₂ a) → a }
    ; from = λ{ a → (inj₂ a) }
    ; from∘to = λ{ (inj₂ a) → refl }
    ; to∘from = λ{ a → refl }
    }

⊥-identityʳ : ∀ {A : Set} → A ⊎ ⊥ ≃ A
⊥-identityʳ {A} =
    ≃-begin
      (A ⊎ ⊥)
    ≃⟨ ⊎-comm ⟩
      (⊥ ⊎ A)
    ≃⟨ ⊥-identityˡ ⟩
      A
    ≃-∎

⊎-weak-× : ∀ {A B C : Set} → (A ⊎ B) × C → A ⊎ (B × C)
⊎-weak-× ⟨ inj₁ x , snd ⟩ = inj₁ x
⊎-weak-× ⟨ inj₂ y , snd ⟩ = inj₂ ⟨ y , snd ⟩

⊎×-implies-×⊎ : ∀ {A B C D : Set} → (A × B) ⊎ (C × D) → (A ⊎ C) × (B ⊎ D)
⊎×-implies-×⊎ (inj₁ ⟨ fst , snd ⟩) = ⟨ inj₁ fst , inj₁ snd ⟩
⊎×-implies-×⊎ (inj₂ ⟨ fst , snd ⟩) = ⟨ inj₂ fst , inj₂ snd ⟩


{-# OPTIONS --without-K --safe #-}

module Categories.Category.Instance.Monoidals where

open import Level

open import Categories.Category
open import Categories.Category.Helper
open import Categories.Category.Monoidal
open import Categories.Functor.Monoidal
open import Categories.Functor.Monoidal.Properties
open import Categories.NaturalTransformation.NaturalIsomorphism

module _ o ℓ e where

  Monoidals : Category (suc (o ⊔ ℓ ⊔ e)) (o ⊔ ℓ ⊔ e) (o ⊔ ℓ ⊔ e)
  Monoidals = categoryHelper record
    { Obj       = MonoidalCategory o ℓ e
    ; _⇒_       = MonoidalFunctor
    ; _≈_       = λ F G → M.F F ≃ M.F G
    ; id        = idF-Monoidal _
    ; _∘_       = ∘-Monoidal
    ; assoc     = λ {_ _ _ _ F G H} → associator (M.F F) (M.F G) (M.F H)
    ; identityˡ = unitorˡ
    ; identityʳ = unitorʳ
    ; equiv     = record
      { refl  = ≃.refl
      ; sym   = ≃.sym
      ; trans = ≃.trans
      }
    ; ∘-resp-≈  = _ⓘₕ_
    }
    where module M = MonoidalFunctor

  StrongMonoidals : Category (suc (o ⊔ ℓ ⊔ e)) (o ⊔ ℓ ⊔ e) (o ⊔ ℓ ⊔ e)
  StrongMonoidals = categoryHelper record
    { Obj       = MonoidalCategory o ℓ e
    ; _⇒_       = StrongMonoidalFunctor
    ; _≈_       = λ F G → M.F F ≃ M.F G
    ; id        = idF-StrongMonoidal _
    ; _∘_       = ∘-StrongMonoidal
    ; assoc     = λ {_ _ _ _ F G H} → associator (M.F F) (M.F G) (M.F H)
    ; identityˡ = unitorˡ
    ; identityʳ = unitorʳ
    ; equiv     = record
      { refl  = ≃.refl
      ; sym   = ≃.sym
      ; trans = ≃.trans
      }
    ; ∘-resp-≈  = _ⓘₕ_
    }
    where module M = StrongMonoidalFunctor


module UniDB.Core where

open import Data.Nat public using (ℕ; suc; zero)
open import Data.Fin public using (Fin; suc; zero)
open import Function public using (id; _∘_)
open import Relation.Binary.PropositionalEquality as PropEq public
  using (_≡_; _≢_; refl; sym; cong; cong₂; trans; subst; module ≡-Reasoning)

open ≡-Reasoning public

Inj : {A B : Set} (f : A → B) → Set
Inj {A} f = {x y : A} → f x ≡ f y → x ≡ y

--------------------------------------------------------------------------------

Dom : Set
Dom = ℕ

infixl 10 _∪_
_∪_ : Dom → Dom → Dom
γ ∪ zero  = γ
γ ∪ suc δ = suc (γ ∪ δ)

∪-assoc : (γ₁ γ₂ γ₃ : Dom) → γ₁ ∪ (γ₂ ∪ γ₃) ≡ (γ₁ ∪ γ₂) ∪ γ₃
∪-assoc γ₁ γ₂ zero     = refl
∪-assoc γ₁ γ₂ (suc γ₃) = cong suc (∪-assoc γ₁ γ₂ γ₃)

--------------------------------------------------------------------------------

STX : Set₁
STX = Dom → Set

MOR : Set₁
MOR = Dom → Dom → Set

--------------------------------------------------------------------------------

Ix : STX
Ix = Fin


{-# OPTIONS --safe #-}
module Cubical.Algebra.CommRing.QuotientRing where

open import Cubical.Foundations.Prelude

open import Cubical.Data.Nat
open import Cubical.Data.FinData

open import Cubical.HITs.SetQuotients as SQ renaming (_/_ to _/sq_)
open import Cubical.HITs.PropositionalTruncation as PT

open import Cubical.Algebra.CommRing
open import Cubical.Algebra.CommRing.Ideal
open import Cubical.Algebra.CommRing.FGIdeal
open import Cubical.Algebra.Ring
open import Cubical.Algebra.Ring.QuotientRing renaming (_/_ to _/Ring_) hiding (asRing)

private
  variable
    ℓ ℓ' : Level

_/_ : (R : CommRing ℓ) → (I : IdealsIn R) → CommRing ℓ
R / I =
  fst asRing , commringstr _ _ _ _ _
                 (iscommring (RingStr.isRing (snd asRing))
                             (elimProp2 (λ _ _ → squash/ _ _)
                                        commEq))
   where
       asRing = (CommRing→Ring R) /Ring (CommIdeal→Ideal I)
       _·/_ : fst asRing → fst asRing → fst asRing
       _·/_ = RingStr._·_ (snd asRing)
       commEq : (x y : fst R) → ([ x ] ·/ [ y ]) ≡ ([ y ] ·/ [ x ])
       commEq x y i = [ CommRingStr.·Comm (snd R) x y i ]

[_]/ : {R : CommRing ℓ} {I : IdealsIn R} → (a : fst R) → fst (R / I)
[ a ]/ = [ a ]

--

module Quotient-FGideal-CommRing-Ring
  (A'@(A , Ar) : CommRing ℓ)
  (B'@(B , Br) : Ring ℓ')
  (g'@(g , gr) : RingHom (CommRing→Ring A') B')
  where

  open CommRingStr Ar using ()
    renaming
    ( 0r        to 0A
    ; 1r        to 1A
    ; _+_       to _+A_
    ; -_        to -A_
    ; _·_       to _·A_ )

  open RingStr Br using ()
    renaming
    ( 0r        to 0B
    ; 1r        to 1B
    ; _+_       to _+B_
    ; -_        to -B_
    ; _·_       to _·B_
    ; +Lid     to +BIdL
    ; is-set    to isSetB)

  open CommRingStr
  open IsRingHom

  module _
    {n : ℕ}
    (v : FinVec A n)
    (gnull : (k : Fin n) → g ( v k) ≡ 0B)
    where

    f : RingHom (CommRing→Ring (A' / (generatedIdeal _ v))) B'
    fst f = SQ.rec (isSetB)
            g
            λ a b → PT.rec (isSetB _ _)
                     λ x → g a                                   ≡⟨ cong g (sym (+Rid Ar a)) ⟩
                     g (a +A 0A)                                  ≡⟨ cong (λ X → g (a +A X)) (sym (snd (+Inv Ar b))) ⟩
                     g (a +A ((-A b) +A b))                       ≡⟨ cong g (+Assoc Ar a (-A b) b) ⟩
                     g ((a +A -A b) +A b)                         ≡⟨ pres+ gr (a +A -A b) b ⟩
                     (g(a +A -A b) +B g b)                        ≡⟨ cong (λ X → g X +B g b) (snd x) ⟩
                     (g (linearCombination A' (fst x) v) +B g b)  ≡⟨ cong (λ X → X +B g b) (cancelLinearCombination A' B' g' n (fst x) v gnull) ⟩
                     0B +B g b                                    ≡⟨ +BIdL (g b) ⟩
                     g b ∎
    snd f = makeIsRingHom
            (pres1 gr)
            (elimProp (λ x p q i y j → isSetB _ _ (p y) (q y) i j)
                      λ a → elimProp (λ _ → isSetB _ _)
                             λ a' → pres+ gr a a')
            (elimProp (λ x p q i y j → isSetB _ _ (p y) (q y) i j)
                      λ a → elimProp (λ _ → isSetB _ _)
                             λ a' → pres· gr a a')

module Quotient-FGideal-CommRing-CommRing
  (A'@(A , Ar) : CommRing ℓ)
  (B'@(B , Br) : CommRing ℓ')
  (g'@(g , gr) : CommRingHom A' B')
  {n : ℕ}
  (v : FinVec A n)
  (gnull : (k : Fin n) → g ( v k) ≡ CommRingStr.0r (snd B'))
  where

  f : CommRingHom (A' / (generatedIdeal _ v)) B'
  f = Quotient-FGideal-CommRing-Ring.f A' (CommRing→Ring B') g' v gnull


{-# OPTIONS --without-K --safe #-}

module TypeTheory.HoTT.Function.Properties where

-- agda-stdlib
open import Axiom.Extensionality.Propositional
open import Level

-- agda-misc
open import TypeTheory.HoTT.Base

private
  variable
    a b : Level
    A : Set a
    B : Set b

module _ {a b} {A : Set a} {B : Set b} where
  isProp-→ : Extensionality a b → isProp B → isProp (A → B)
  isProp-→ ext B-isProp f g = ext λ x → B-isProp (f x) (g x)


{-# OPTIONS --without-K #-}

open import lib.Basics
open import lib.types.Group
open import lib.types.Unit
open import lib.groups.Homomorphisms
open import lib.groups.Lift

module lib.groups.Unit where

Unit-group-structure : GroupStructure Unit
Unit-group-structure = record
  { ident = unit
  ; inv = λ _ → unit
  ; comp = λ _ _ → unit
  ; unitl = λ _ → idp
  ; unitr = λ _ → idp
  ; assoc = λ _ _ _ → idp
  ; invr = λ _ → idp
  ; invl = λ _ → idp
  }

Unit-group : Group lzero
Unit-group = group _ Unit-is-set Unit-group-structure

Lift-Unit-group : ∀ {i} → Group i
Lift-Unit-group = Lift-group Unit-group

0ᴳ = Lift-Unit-group

contr-is-0ᴳ : ∀ {i} (G : Group i) → is-contr (Group.El G) → G == 0ᴳ
contr-is-0ᴳ G pA = group-ua
  (group-hom (λ _ → lift unit) (λ _ _ → idp) , snd (contr-equiv-LiftUnit pA))

0ᴳ-hom-out-level : ∀ {i j} {G : Group i}
  → is-contr (0ᴳ {j} →ᴳ G)
0ᴳ-hom-out-level {G = G} =
  (cst-hom ,
   λ φ → hom= _ _ (λ= (λ {(lift unit) → ! (GroupHom.pres-ident φ)})))

0ᴳ-hom-in-level : ∀ {i j} {G : Group i}
  → is-contr (G →ᴳ 0ᴳ {j})
0ᴳ-hom-in-level {G = G} =
  (cst-hom , λ φ → hom= _ _ (λ= (λ _ → idp)))


{-# OPTIONS --injective-type-constructors #-}
module InjectiveTypeConstructors where

data D (A : Set) : Set where

data _==_ (A : Set) : Set → Set where
  refl : A == A

injD : ∀ {A B} → D A == D B → A == B
injD refl = refl


module Prelude.Bool where

data Bool : Set where
  true  : Bool
  false : Bool

{-# BUILTIN BOOL  Bool  #-}
{-# BUILTIN TRUE  true  #-}
{-# BUILTIN FALSE false #-}

not : Bool -> Bool
not true  = false
not false = true

notnot : Bool -> Bool
notnot true  = not (not true)
notnot false = not (not false)

infix 90 if_then_else_
infix 90 if'_then_else_

if_then_else_ : ∀{ P : Bool -> Set} -> (b : Bool) -> P true -> P false -> P b
if true  then a else b = a
if false then a else b = b

if'_then_else_ : ∀{ P : Set} -> (b : Bool) -> P -> P  -> P
if' true  then a else b = a
if' false then a else b = b


module Common.Coinduction where

open import Common.Level

infix 1000 ♯_

postulate
  ∞  : ∀ {a} (A : Set a) → Set a
  ♯_ : ∀ {a} {A : Set a} → A → ∞ A
  ♭  : ∀ {a} {A : Set a} → ∞ A → A

{-# BUILTIN INFINITY ∞  #-}
{-# BUILTIN SHARP    ♯_ #-}
{-# BUILTIN FLAT     ♭  #-}

private

  my-♯ : ∀ {a} {A : Set a} → A → ∞ A
  my-♯ x = ♯ x


{-# OPTIONS --without-K #-}

open import HoTT
open import cohomology.FunctionOver
open import cohomology.Theory

{- Cohomology groups are independent of basepoint, and the action of
 - the cohomology is independent of the basepoint-preservation path -}

module cohomology.BaseIndependence {i} (CT : CohomologyTheory i) where

open CohomologyTheory CT

C-base-indep : (n : ℤ) {A : Type i} (a₀ a₁ : A)
  → C n (A , a₀) ≃ᴳ C n (A , a₁)
C-base-indep n a₀ a₁ =
  C-Susp n (_ , a₁) ∘eᴳ (C-Susp n (_ , a₀))⁻¹ᴳ

CF-base-indep : (n : ℤ) {X Y : Ptd i}
  (f : fst X → fst Y) (p₁ p₂ : f (snd X) == snd Y)
  → CF-hom n (f , p₁) == CF-hom n (f , p₂)
CF-base-indep n {X} {Y} f p₁ p₂ = transport
  (λ q → CF-hom n (f , p₁) == CF-hom n (f , p₂) [ uncurry _→ᴳ_ ↓ q ])
  (!-inv-l (pair×= (group-ua (C-Susp n Y)) (group-ua (C-Susp n X))))
  (!ᵈ (C-Susp-↓ n (f , p₁)) ∙ᵈ C-Susp-↓ n (f , p₂))

CF-λ= : (n : ℤ) {X Y : Ptd i} {f g : fst (X ⊙→ Y)}
  → (∀ x → fst f x == fst g x)
  → CF-hom n f == CF-hom n g
CF-λ= n h = CF-base-indep n _ _ _ ∙ ap (CF-hom n) (⊙λ= h idp)

CF-↓dom= : (n : ℤ) {X Y Z : Ptd i}
  {f : fst (X ⊙→ Y)} {g : fst (X ⊙→ Z)} {p : Y == Z}
  → fst f == fst g [ (λ V → fst X → fst V) ↓ p ]
  → CF-hom n f == CF-hom n g [ (λ G → G →ᴳ C n X) ↓ ap (C n) p ]
CF-↓dom= n {p = idp} r =
  CF-base-indep n _ _ _ ∙ ap (CF-hom n) (pair= r (from-transp! _ _ idp))

CF-↓cod= : (n : ℤ) {X Y Z : Ptd i}
  {f : fst (X ⊙→ Z)} {g : fst (Y ⊙→ Z)} {p : X == Y}
  → fst f == fst g [ (λ U → fst U → fst Z) ↓ p ]
  → CF-hom n f == CF-hom n g [ (λ G → C n Z →ᴳ G) ↓ ap (C n) p ]
CF-↓cod= n {p = idp} r =
  CF-base-indep n _ _ _ ∙ ap (CF-hom n) (pair= r (from-transp! _ _ idp))


{-

This file contains:

- Properties of set truncations

-}
{-# OPTIONS --cubical --safe #-}
module Cubical.HITs.SetTruncation.Properties where

open import Cubical.Core.Glue

open import Cubical.HITs.SetTruncation.Base

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Isomorphism
open import Cubical.Foundations.Equiv
open import Cubical.Foundations.HLevels

private
  variable
    ℓ : Level
    A : Type ℓ

-- lemma 6.9.1 in HoTT book
elimSetTrunc : {B : ∥ A ∥₀ → Type ℓ} →
               (Bset : (x : ∥ A ∥₀) → isSet (B x)) →
               (g : (a : A) → B (∣ a ∣₀)) →
               (x : ∥ A ∥₀) → B x
elimSetTrunc Bset g ∣ a ∣₀ = g a
elimSetTrunc {A = A} {B = B} Bset g (squash₀ x y p q i j) =
  isOfHLevel→isOfHLevelDep {n = 2} Bset  (elimSetTrunc Bset g x) (elimSetTrunc Bset g y)
    (cong (elimSetTrunc Bset g) p) (cong (elimSetTrunc Bset g) q) (squash₀ x y p q) i j

setTruncUniversal : {B : Type ℓ} → (isSet B) → (∥ A ∥₀ → B) ≃ (A → B)
setTruncUniversal Bset = isoToEquiv (iso intro elim leftInv rightInv)
  where
  intro = (λ h a → h ∣ a ∣₀)
  elim = elimSetTrunc (λ x → Bset)

  leftInv : ∀ g → intro (elim g) ≡ g
  leftInv g = refl

  rightInv : ∀ h → elim (intro h) ≡ h
  rightInv h i x = elimSetTrunc (λ x → isProp→isSet (Bset (elim (intro h) x) (h x)))
                                (λ a → refl) x i

elimSetTrunc2 : {B : ∥ A ∥₀ → ∥ A ∥₀ → Type ℓ}
                (Bset : ((x y : ∥ A ∥₀) → isSet (B x y)))
                (g : (a b : A) → B ∣ a ∣₀ ∣ b ∣₀)
                (x y : ∥ A ∥₀) → B x y
elimSetTrunc2 Bset g = elimSetTrunc (λ _ → hLevelPi 2 (λ _ → Bset _ _)) (λ a →
                       elimSetTrunc (λ _ → Bset _ _) (λ b → g a b))

elimSetTrunc3 : {B : (x y z : ∥ A ∥₀) → Type ℓ}
                (Bset : ((x y z : ∥ A ∥₀) → isSet (B x y z)))
                (g : (a b c : A) → B ∣ a ∣₀ ∣ b ∣₀ ∣ c ∣₀)
                (x y z : ∥ A ∥₀) → B x y z
elimSetTrunc3 Bset g = elimSetTrunc2 (λ _ _ → hLevelPi 2 λ _ → Bset _ _ _) (λ a b →
                       elimSetTrunc (λ _ → Bset _ _ _) (λ c → g a b c))


module Prelude.Equality where

open import Prelude.Decidable

open import Agda.Builtin.Equality public

record Eq {a} (A : Set a) : Set a where
  infix 4 _==_
  field
    _==_ : (x y : A) → Dec (x ≡ y)

open Eq {{...}} public

sym : ∀ {a} {A : Set a} {x y : A} → x ≡ y → y ≡ x
sym refl = refl

infixr 0 _⟨≡⟩_ _⟨≡⟩ʳ_ _ʳ⟨≡⟩_ _ʳ⟨≡⟩ʳ_

trans : ∀ {a} {A : Set a} {x y z : A} → x ≡ y → y ≡ z → x ≡ z
trans refl eq = eq

_⟨≡⟩_ = trans

_⟨≡⟩ʳ_ : ∀ {a} {A : Set a} {x y z : A} → x ≡ y → z ≡ y → x ≡ z
eq ⟨≡⟩ʳ refl = eq

_ʳ⟨≡⟩_ : ∀ {a} {A : Set a} {x y z : A} → y ≡ x → y ≡ z → x ≡ z
refl ʳ⟨≡⟩ eq = eq

_ʳ⟨≡⟩ʳ_ : ∀ {a} {A : Set a} {x y z : A} → y ≡ x → z ≡ y → x ≡ z
refl ʳ⟨≡⟩ʳ refl = refl

infixl 4 cong _*≡_
syntax cong f eq = f $≡ eq
cong : ∀ {a b} {A : Set a} {B : Set b} (f : A → B) {x y} → x ≡ y → f x ≡ f y
cong f refl = refl

_*≡_ : ∀ {a b} {A : Set a} {B : Set b} {f g : A → B} {x y} → f ≡ g → x ≡ y → f x ≡ g y
refl *≡ refl = refl

cong₂ : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} (f : A → B → C) {x₁ x₂ y₁ y₂} →
        x₁ ≡ x₂ → y₁ ≡ y₂ → f x₁ y₁ ≡ f x₂ y₂
cong₂ f refl refl = refl

transport : ∀ {a b} {A : Set a} (B : A → Set b) {x y} → x ≡ y → B x → B y
transport B refl bx = bx

transport₂ : ∀ {a b c} {A : Set a} {B : Set b} (C : A → B → Set c) {x₁ x₂ y₁ y₂} → x₁ ≡ x₂ → y₁ ≡ y₂ → C x₁ y₁ → C x₂ y₂
transport₂ C refl refl cxy = cxy

-- Decidable equality helpers --

decEq₁ : ∀ {a b} {A : Set a} {B : Set b} {f : A → B} → (∀ {x y} → f x ≡ f y → x ≡ y) →
           ∀ {x y} → Dec (x ≡ y) → Dec (f x ≡ f y)
decEq₁ f-inj (yes refl) = yes refl
decEq₁ f-inj (no  neq)  = no λ eq → neq (f-inj eq)

decEq₂ : ∀ {a b c} {A : Set a} {B : Set b} {C : Set c} {f : A → B → C} →
           (∀ {x y z w} → f x y ≡ f z w → x ≡ z) →
           (∀ {x y z w} → f x y ≡ f z w → y ≡ w) →
           ∀ {x y z w} → Dec (x ≡ y) → Dec (z ≡ w) → Dec (f x z ≡ f y w)
decEq₂ f-inj₁ f-inj₂ (no neq)    _         = no λ eq → neq (f-inj₁ eq)
decEq₂ f-inj₁ f-inj₂  _         (no neq)   = no λ eq → neq (f-inj₂ eq)
decEq₂ f-inj₁ f-inj₂ (yes refl) (yes refl) = yes refl

{-# INLINE decEq₁ #-}
{-# INLINE decEq₂ #-}

-- Equality reasoning --

infixr 0 eqReasoningStep eqReasoningStepʳ
infix  1 _∎

-- Giving the proofs in the reverse order means the values of x and y
-- are inferred before checking the x ≡ y proof. This leads to significant
-- performance improvements in some cases.

syntax eqReasoningStep x q p = x ≡⟨ p ⟩ q
eqReasoningStep : ∀ {a} {A : Set a} (x : A) {y z} → y ≡ z → x ≡ y → x ≡ z
x ≡⟨ refl ⟩ p = p

syntax eqReasoningStepʳ x q p = x ≡⟨ p ⟩ʳ q
eqReasoningStepʳ : ∀ {a} {A : Set a} (x : A) {y z} → y ≡ z → y ≡ x → x ≡ z
x ≡⟨ refl ⟩ʳ p = p

_∎ : ∀ {a} {A : Set a} (x : A) → x ≡ x
x ∎ = refl

-- Instances --

instance
  EqEq : ∀ {a} {A : Set a} {x y : A} → Eq (x ≡ y)
  _==_ {{EqEq}} refl refl = yes refl


{-

Finite Structures over Finite Set
  In short, the type of structures should be finite set itself.

This file contains:
- Definition and properties of finite sets equipped with finite structures;
- The type of finitely-structured finite sets is Rijke finite,
  so that we can count their number up to equivalence/isomorphism.

-}
{-# OPTIONS --safe #-}

module Cubical.Data.FinType.FiniteStructure where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Isomorphism
open import Cubical.Foundations.Equiv renaming (_∙ₑ_ to _⋆_)

open import Cubical.HITs.PropositionalTruncation as Prop
open import Cubical.HITs.SetTruncation as Set

open import Cubical.Data.Nat
open import Cubical.Data.Sigma

open import Cubical.Data.FinSet
open import Cubical.Data.FinSet.Induction
open import Cubical.Data.FinSet.Cardinality
open import Cubical.Data.FinType
open import Cubical.Data.FinType.Sigma

private
  variable
    ℓ ℓ' : Level
    n : ℕ
    S : FinSet ℓ → FinSet ℓ'

-- type of finite sets with finite structure

FinSetWithStr : (S : FinSet ℓ → FinSet ℓ') → Type (ℓ-max (ℓ-suc ℓ) ℓ')
FinSetWithStr {ℓ = ℓ} S = Σ[ X ∈ FinSet ℓ ] S X .fst

-- type of finite sets with a fixed cardinal

FinSetOfCard : (ℓ : Level) (n : ℕ) → Type (ℓ-suc ℓ)
FinSetOfCard ℓ n = Σ[ X ∈ FinSet ℓ ] (card X ≡ n)

FinSetWithStrOfCard : (S : FinSet ℓ → FinSet ℓ') (n : ℕ) → Type (ℓ-max (ℓ-suc ℓ) ℓ')
FinSetWithStrOfCard {ℓ = ℓ} S n = Σ[ X ∈ FinSetOfCard ℓ n ] S (X .fst) .fst

FinSetOfCard≡ : (X Y : FinSetOfCard ℓ n) → (X .fst ≡ Y .fst) ≃ (X ≡ Y)
FinSetOfCard≡ _ _ = Σ≡PropEquiv (λ _ → isSetℕ _ _)

open Iso

∥FinSetOfCard∥₂≡ : (X Y : FinSetOfCard ℓ n) → ∥ X .fst ≡ Y .fst ∥ → ∣ X ∣₂ ≡ ∣ Y ∣₂
∥FinSetOfCard∥₂≡ _ _ =
  Prop.rec (squash₂ _ _) (λ p → PathIdTrunc₀Iso .inv ∣ FinSetOfCard≡ _ _ .fst p ∣)

isPathConnectedFinSetOfCard : isContr ∥ FinSetOfCard ℓ n ∥₂
isPathConnectedFinSetOfCard {n = n} .fst = ∣ 𝔽in n , card𝔽in n ∣₂
isPathConnectedFinSetOfCard {n = n} .snd =
  Set.elim (λ _ → isProp→isSet (squash₂ _ _)) (λ (X , p) → sym (∥FinSetOfCard∥₂≡ _ _ (card≡n p)))

isFinTypeFinSetOfCard : isFinType 1 (FinSetOfCard ℓ n)
isFinTypeFinSetOfCard .fst = isPathConnected→isFinType0 isPathConnectedFinSetOfCard
isFinTypeFinSetOfCard .snd X Y =
  isFinSet→isFinType 0 (EquivPresIsFinSet (FinSet≡ _ _ ⋆ FinSetOfCard≡ _ _) (isFinSetType≡Eff (X .fst) (Y .fst)))

-- the type of finitely-structured finite sets is Rijke finite
-- in particular, we can count their number up to equivalence

isFinTypeFinSetWithStrOfCard :
  (S : FinSet ℓ → FinSet ℓ') (n : ℕ)
  → isFinType 0 (FinSetWithStrOfCard S n)
isFinTypeFinSetWithStrOfCard S n =
  isFinTypeΣ {n = 0} (_ , isFinTypeFinSetOfCard) (λ X → _ , isFinSet→isFinType 0 (S (X .fst) .snd))


{-# OPTIONS --safe --experimental-lossy-unification #-}
module Cubical.Algebra.Polynomials.Multivariate.Properties where

open import Cubical.Foundations.Prelude

open import Cubical.Data.Nat renaming(_+_ to _+n_; _·_ to _·n_)
open import Cubical.Data.Vec

open import Cubical.Algebra.Ring
open import Cubical.Algebra.CommRing

open import Cubical.Algebra.Polynomials.Multivariate.Base

private variable
  ℓ ℓ' : Level

module Nth-Poly-structure (A' : CommRing ℓ) (n : ℕ) where

  private
    A = fst A'
    Ar = CommRing→Ring A'

  open CommRingStr (snd A')
  open RingTheory Ar

-----------------------------------------------------------------------------

  Poly-com-adv : (P Q R S : Poly A' n) →  ((P Poly+ Q) Poly+ (R Poly+ S) ≡ (P Poly+ R) Poly+ (Q Poly+ S))
  Poly-com-adv P Q R S = ((P Poly+ Q) Poly+ (R Poly+ S) ≡⟨ Poly+-assoc (P Poly+ Q) R S ⟩
                     (((P Poly+ Q) Poly+ R) Poly+ S) ≡⟨ cong (λ X → X Poly+ S) (sym (Poly+-assoc P Q R)) ⟩
                     ((P Poly+ (Q Poly+ R)) Poly+ S) ≡⟨ cong (λ X → (P Poly+ X) Poly+ S) (Poly+-comm Q R) ⟩
                     ((P Poly+ (R Poly+ Q)) Poly+ S) ≡⟨ cong (λ X → X Poly+ S) (Poly+-assoc P R Q) ⟩
                     (((P Poly+ R) Poly+ Q) Poly+ S) ≡⟨ sym (Poly+-assoc (P Poly+ R) Q S) ⟩
                     ((P Poly+ R) Poly+ (Q Poly+ S)) ∎)

  Poly+-Lid : (P : Poly A' n) → 0P Poly+ P ≡ P
  Poly+-Lid P = (Poly+-comm 0P P) ∙ (Poly+-Rid P)

  Poly-inv : Poly A' n → Poly A' n
  Poly-inv = Poly-Rec-Set.f A' n (Poly A' n) trunc
             0P
             (λ v a → base v (- a))
             (λ PS RS → PS Poly+ RS)
             Poly+-assoc
             Poly+-Rid
             Poly+-comm
             (λ v → base v (- 0r) ≡⟨ cong (base v) 0Selfinverse ⟩ base v 0r ≡⟨ base-0P v ⟩ 0P ∎)
             λ v a b → (base-Poly+ v (- a) (- b)) ∙ (cong (base v) (-Dist a b))

  Poly-invinv : (P : Poly A' n) → Poly-inv (Poly-inv P) ≡ P
  Poly-invinv = Poly-Ind-Prop.f A' n (λ P → Poly-inv (Poly-inv P) ≡ P) (λ _ → trunc _ _)
                refl
                (λ v a → cong (base v) (-Idempotent a))
                λ {P Q} ind-P ind-Q → cong₂ _Poly+_ ind-P ind-Q

  Poly+-rinv : (P : Poly A' n ) → P Poly+ (Poly-inv P) ≡ 0P
  Poly+-rinv = Poly-Ind-Prop.f A' n (λ P → (P Poly+ Poly-inv P) ≡ 0P) (λ _ → trunc _ _)
               (Poly+-Rid 0P)
               (λ v a → (base-Poly+ v a (- a)) ∙ cong (base v) (+Rinv a) ∙ base-0P v)
               λ {P Q} ind-P ind-Q → ((P Poly+ Q) Poly+ ((Poly-inv P) Poly+ (Poly-inv Q)))
                                               ≡⟨ Poly-com-adv P Q (Poly-inv P) (Poly-inv Q) ⟩
                                      ((P Poly+ Poly-inv P) Poly+ (Q Poly+ Poly-inv Q))
                                               ≡⟨ cong₂ _Poly+_ ind-P ind-Q ⟩
                                      (0P Poly+ 0P)
                                               ≡⟨ Poly+-Rid 0P ⟩
                                      0P ∎

  Poly+-linv : (P  : Poly A' n) → (Poly-inv P) Poly+ P ≡ 0P
  Poly+-linv = Poly-Ind-Prop.f A' n _ (λ _ → trunc _ _)
               (Poly+-Rid 0P)
               (λ v a → (base-Poly+ v (- a) a) ∙ cong (base v) (snd (+Inv a)) ∙ base-0P v)
               λ {U V} ind-U ind-V → Poly-com-adv (Poly-inv U) (Poly-inv V) U V ∙ cong₂ _Poly+_ ind-U ind-V ∙ Poly+-Rid 0P

-----------------------------------------------------------------------------

  _Poly*_ : Poly A' n → Poly A' n → Poly A' n
  _Poly*_ = -- Induction Left Argument
            Poly-Rec-Set.f A' n (Poly A' n → Poly A' n)
            (λ f g p q i j Q → trunc (f Q) (g Q) (λ X → p X Q) (λ X → q X Q) i j )
            (λ Q    → 0P)
            (λ v a  → -- Induction Right Argument
                       Poly-Rec-Set.f A' n (Poly A' n) trunc
                       0P
                       (λ v' a' → base (v +n-vec v') (a · a'))
                       _Poly+_
                       Poly+-assoc
                       Poly+-Rid
                       Poly+-comm
                       (λ v' → (cong (base (v +n-vec v')) (0RightAnnihilates a)) ∙ (base-0P (v +n-vec v')))
                       λ v' b c → (base-Poly+ (v +n-vec v') (a · b) (a · c)) ∙ (cong (base (v +n-vec v')) (sym (·Rdist+ a b c))))
                       -- End Right induction
            (λ PS QS Q → (PS Q) Poly+ (QS Q) )
            (λ PS QS RS i Q → Poly+-assoc (PS Q) (QS Q) (RS Q) i)
            (λ PS i Q       → Poly+-Rid (PS Q) i)
            (λ PS QS i Q    → Poly+-comm (PS Q) (QS Q) i)
            (λ v    → funExt (
                             -- Induction Right Argument
                             Poly-Ind-Prop.f A' n _ (λ _ → trunc _ _)
                             refl
                             (λ v' a' → (cong (base (v +n-vec v')) (0LeftAnnihilates a')) ∙ (base-0P (v +n-vec v')))
                             λ {P Q} ind-P ind-Q → (cong₂ _Poly+_ ind-P ind-Q) ∙ (Poly+-Rid 0P) ))
                             -- End Right Induction
            λ v a b → funExt (
                             -- Induction Right Argument
                             Poly-Ind-Prop.f A' n _ (λ _ → trunc _ _)
                             (Poly+-Rid 0P)
                             (λ v' c → (base-Poly+ (v +n-vec v') (a · c) (b · c)) ∙ (cong (base (v +n-vec v')) (sym (·Ldist+ a b c))))
                             λ {P Q} ind-P ind-Q → (Poly-com-adv _ _ _ _) ∙ (cong₂ _Poly+_ ind-P ind-Q))
                             -- End Right Induction
            -- End Left Induction

  Poly*-assoc : (P Q R : Poly A' n) → P Poly* (Q Poly* R) ≡ (P Poly* Q) Poly* R
  Poly*-assoc = Poly-Ind-Prop.f A' n _
                (λ P p q i Q R j → trunc (P Poly* (Q Poly* R)) ((P Poly* Q) Poly* R) (p Q R) (q Q R) i j)
                (λ _ _ → refl)
                (λ v a → Poly-Ind-Prop.f A' n _
                          (λ Q p q i R j → trunc (base v a Poly* (Q Poly* R)) ((base v a Poly* Q) Poly* R) (p R) (q R) i j)
                          (λ _ → refl)
                          (λ v' a' → Poly-Ind-Prop.f A' n _ (λ _ → trunc _ _)
                                      refl
                                      (λ v'' a'' → cong₂ base (+n-vec-assoc v v' v'') (·Assoc a a' a''))
                                      (λ {U V} ind-U ind-V → cong₂ _Poly+_ ind-U ind-V))
                          (λ {U V} ind-U ind-V R → cong₂ _Poly+_ (ind-U R) (ind-V R)))
                λ {U V} ind-U ind-V Q R → cong₂ _Poly+_ (ind-U Q R) (ind-V Q R)

  0PLeftAnnihilatesPoly : (P : Poly A' n) → 0P Poly* P ≡ 0P
  0PLeftAnnihilatesPoly P = refl

  0PRightAnnihilatesPoly : (P : Poly A' n) → P Poly* 0P ≡ 0P
  0PRightAnnihilatesPoly = Poly-Ind-Prop.f A' n (λ P → (P Poly* 0P) ≡ 0P) (λ _ → trunc _ _)
                           refl
                           (λ _ _ → refl)
                           λ {P Q} ind-P ind-Q → (cong₂ _Poly+_ ind-P ind-Q) ∙ (Poly+-Rid 0P)

  1P : Poly A' n
  1P = base (replicate zero) 1r

  Poly*-Rid : (P : Poly A' n) → P Poly* 1P ≡ P
  Poly*-Rid = Poly-Ind-Prop.f A' n (λ P → (P Poly* 1P) ≡ P) (λ _ → trunc _ _)
              refl
              (λ v a → cong₂ base (+n-vec-rid v) (·Rid a))
              (λ {P Q} ind-P ind-Q → cong₂ _Poly+_ ind-P ind-Q)

  Poly*-Lid : (P : Poly A' n) → 1P Poly* P ≡ P
  Poly*-Lid = Poly-Ind-Prop.f A' n (λ P → (1P Poly* P) ≡ P) (λ _ → trunc _ _)
              refl
              (λ v a → cong₂ base (+n-vec-lid v) (·Lid a))
              λ {P Q} ind-P ind-Q → cong₂ _Poly+_ ind-P ind-Q

  Poly*-Rdist : (P Q R : Poly A' n) → P Poly* (Q Poly+ R) ≡ (P Poly* Q) Poly+ (P Poly* R)
  Poly*-Rdist = Poly-Ind-Prop.f A' n _
                (λ P p q i Q R j → trunc (P Poly* (Q Poly+ R)) ((P Poly* Q) Poly+ (P Poly* R)) (p Q R) (q Q R) i j)
                (λ _ _ → sym (Poly+-Rid 0P))
                (λ v a → λ Q R → refl)
                λ {U V} ind-U ind-V Q R → (cong₂ _Poly+_ (ind-U Q R) (ind-V Q R)) ∙ Poly-com-adv (U Poly* Q) (U Poly* R) (V Poly* Q) (V Poly* R)

  Poly*-Ldist : (P Q R : Poly A' n) → (P Poly+ Q) Poly* R ≡ (P Poly* R) Poly+ (Q Poly* R)
  Poly*-Ldist P Q R = refl

  Poly*-comm : (P Q : Poly A' n) → P Poly* Q ≡ Q Poly* P
  Poly*-comm = Poly-Ind-Prop.f A' n _
               (λ P p q i Q j → trunc (P Poly* Q) (Q Poly* P) (p Q) (q Q) i j)
               (λ Q → sym (0PRightAnnihilatesPoly Q))
               (λ v a → Poly-Ind-Prop.f A' n _ (λ _ → trunc _ _)
                          refl
                          (λ v' a' → cong₂ base (+n-vec-comm v v') (·Comm a a'))
                          (λ {U V} ind-U ind-V → cong₂ _Poly+_ ind-U ind-V))
               λ {U V} ind-U ind-V Q → ((cong₂ _Poly+_ (ind-U Q) (ind-V Q)) ∙ sym (Poly*-Rdist Q U V))


------------------------------------------------------------------------
-- The Agda standard library
--
-- Some examples showing where the integers and some related
-- operations and properties are defined, and how they can be used
------------------------------------------------------------------------

module README.Integer where

-- The integers and various arithmetic operations are defined in
-- Data.Integer.

open import Data.Integer

-- The +_ function converts natural numbers into integers.

ex₁ : ℤ
ex₁ = + 2

-- The -_ function negates an integer.

ex₂ : ℤ
ex₂ = - + 4

-- Some binary operators are also defined, including addition,
-- subtraction and multiplication.

ex₃ : ℤ
ex₃ = + 1  +  + 3 * - + 2  -  + 4

-- Propositional equality and some related properties can be found
-- in Relation.Binary.PropositionalEquality.

open import Relation.Binary.PropositionalEquality as P using (_≡_)

ex₄ : ex₃ ≡ - + 9
ex₄ = P.refl

-- Data.Integer.Properties contains a number of properties related to
-- integers. Algebra defines what a commutative ring is, among other
-- things.

open import Algebra
import Data.Integer.Properties as Integer
private
  module CR = CommutativeRing Integer.commutativeRing

ex₅ : ∀ i j → i * j ≡ j * i
ex₅ i j = CR.*-comm i j

-- The module ≡-Reasoning in Relation.Binary.PropositionalEquality
-- provides some combinators for equational reasoning.

open P.≡-Reasoning
open import Data.Product

ex₆ : ∀ i j → i * (j + + 0) ≡ j * i
ex₆ i j = begin
  i * (j + + 0)  ≡⟨ P.cong (_*_ i) (proj₂ CR.+-identity j) ⟩
  i * j          ≡⟨ CR.*-comm i j ⟩
  j * i          ∎

-- The module RingSolver in Data.Integer.Properties contains a solver
-- for integer equalities involving variables, constants, _+_, _*_, -_
-- and _-_.

ex₇ : ∀ i j → i * - j - j * i ≡ - + 2 * i * j
ex₇ = solve 2 (λ i j → i :* :- j :- j :* i  :=  :- con (+ 2) :* i :* j)
              P.refl
  where open Integer.RingSolver


{-# OPTIONS --without-K --safe #-}

-- Some of the obvious properties of cartesian functors
module Categories.Functor.Cartesian.Properties where

open import Data.Product using (_,_; proj₁; proj₂)
open import Level

open import Categories.Category.Core using (Category)
open import Categories.Category.Cartesian
open import Categories.Category.Product using (Product; _⁂_)
open import Categories.Functor using (Functor; _∘F_) renaming (id to idF)
open import Categories.Functor.Cartesian
open import Categories.Morphism.Reasoning
open import Categories.NaturalTransformation hiding (id)
import Categories.Object.Product as OP

private
  variable
    o ℓ e o′ ℓ′ e′ o″ ℓ″ e″ : Level

idF-Cartesian : {A : Category o ℓ e} {CA : Cartesian A} → CartesianF CA CA idF
idF-Cartesian {A = A} {CA} = record
  { ε = id
  ; ⊗-homo = ntHelper record
    { η = λ _ → id
    ; commute = λ _ → id-comm-sym A }
  }
  where
  open Category A

∘-Cartesian : {A : Category o ℓ e} {B : Category o′ ℓ′ e′} {C : Category o″ ℓ″ e″}
  {CA : Cartesian A} {CB : Cartesian B} {CC : Cartesian C}
  {F : Functor B C} {G : Functor A B} (CF : CartesianF CB CC F) (CG : CartesianF CA CB G) → CartesianF CA CC (F ∘F G)
∘-Cartesian {B = B} {C} {CA} {CB} {CC} {F} {G} CF CG = record
  { ε = F.₁ CG.ε ∘ CF.ε
  ; ⊗-homo = ntHelper record
    { η = λ X → F.₁ (NTG.η X) ∘ NTF.η (Functor.F₀ (G ⁂ G) X)
    ; commute = λ { {A} {B} f →
      let GGA = F₀ (G ⁂ G) A in
      let GGB = F₀ (G ⁂ G) B in
      let GGf = F₁ (G ⁂ G) f in
      begin
      (F.₁ (NTG.η B) ∘ NTF.η GGB) ∘ F₁ (⊗ CC ∘F ((F ∘F G) ⁂ (F ∘F G))) f  ≈⟨ C.assoc ⟩
      F.₁ (NTG.η B) ∘ NTF.η GGB ∘ F₁ (⊗ CC ∘F ((F ∘F G) ⁂ (F ∘F G))) f    ≈⟨ (refl⟩∘⟨ NTF.commute GGf) ⟩
      F.₁ (NTG.η B) ∘ (F.₁ (F₁ (⊗ CB) GGf) ∘ NTF.η GGA)                   ≈⟨ C.sym-assoc ⟩
      (F.₁ (NTG.η B) ∘ F.₁ (F₁ (⊗ CB) GGf)) ∘ NTF.η GGA                   ≈˘⟨ (F.homomorphism ⟩∘⟨refl) ⟩
      (F.₁ (NTG.η B B.∘ F₁ (⊗ CB) GGf)) ∘ NTF.η GGA                       ≈⟨ (F.F-resp-≈ (NTG.commute f) ⟩∘⟨refl) ⟩
      F.F₁ (F₁ G (F₁ (⊗ CA) f) B.∘ NTG.η A) ∘ NTF.η GGA                   ≈⟨ (F.homomorphism ⟩∘⟨refl) ⟩
      (F₁ ((F ∘F G) ∘F ⊗ CA) f ∘ F.₁ (NTG.η A)) ∘ NTF.η GGA               ≈⟨ C.assoc ⟩
      F₁ ((F ∘F G) ∘F ⊗ CA) f ∘ F.₁ (NTG.η A) ∘ NTF.η GGA ∎}
    }
  }
  where
  module CF = CartesianF CF
  module CG = CartesianF CG
  module NTF = NaturalTransformation CF.⊗-homo
  module NTG = NaturalTransformation CG.⊗-homo
  module F = Functor F
  module B = Category B
  module C = Category C
  open C using (_≈_; _∘_)
  open C.HomReasoning
  open Cartesian CC using (products)
  open Functor
  open OP C using (Product)
  open Product
  open Cartesian using (⊗)


{-# OPTIONS --cubical --no-import-sorts --safe #-}
module Cubical.Algebra.RingSolver.NatAsAlmostRing where

open import Cubical.Foundations.Prelude
open import Cubical.Data.Nat
open import Cubical.Algebra.RingSolver.AlmostRing
open import Cubical.Algebra.Semigroup
open import Cubical.Algebra.Monoid
open import Cubical.Algebra.AbGroup

ℕAsAlmostRing : AlmostRing {ℓ-zero}
ℕAsAlmostRing = almostring ℕ 0 1 _+_ _·_ (λ n → n) (isalmostring
                    (ismonoid (issemigroup isSetℕ +-assoc) (λ n → (+-zero n) , refl))
                    (ismonoid (issemigroup isSetℕ ·-assoc) λ n → (·-identityʳ n) , (·-identityˡ n))
                    +-comm
                    ·-comm
                    (λ k l n → sym (·-distribˡ k l n) )
                    (λ k l n → sym (·-distribʳ k l n))
                    (λ _ _ → refl) (λ _ _ → refl)
                    (λ _ → refl) λ x → sym (0≡m·0 x))


{-# OPTIONS --without-K #-}
open import HoTT.Base
open import HoTT.Equivalence

module HoTT.Identity.Boolean where

private
  variable
    x y : 𝟐

_=𝟐_ : 𝟐 → 𝟐 → 𝒰₀
0₂ =𝟐 0₂ = 𝟏
0₂ =𝟐 1₂ = 𝟎
1₂ =𝟐 0₂ = 𝟎
1₂ =𝟐 1₂ = 𝟏

=𝟐-equiv : x == y ≃ x =𝟐 y
=𝟐-equiv = f , qinv→isequiv (g , η , ε)
  where
  f : x == y → x =𝟐 y
  f {0₂} p = transport (0₂ =𝟐_) p ★
  f {1₂} p = transport (1₂ =𝟐_) p ★
  g : x =𝟐 y → x == y
  g {0₂} {0₂} _ = refl
  g {0₂} {1₂} ()
  g {1₂} {0₂} ()
  g {1₂} {1₂} _ = refl
  η : g ∘ f {x} {y} ~ id
  η {0₂} refl = refl
  η {1₂} refl = refl
  ε : f ∘ g {x} {y} ~ id
  ε {0₂} {0₂} ★ = refl
  ε {0₂} {1₂} ()
  ε {1₂} {0₂} ()
  ε {1₂} {1₂} ★ = refl


module Agda.Builtin.FromNat where

open import Agda.Primitive
open import Agda.Builtin.Nat

record Number {a} (A : Set a) : Set (lsuc a) where
  field
    Constraint : Nat → Set a
    fromNat : ∀ n → {{_ : Constraint n}} → A

open Number {{...}} public using (fromNat)

{-# BUILTIN FROMNAT fromNat #-}
{-# DISPLAY Number.fromNat _ n = fromNat n #-}


{-# OPTIONS --without-K --exact-split #-}

module 02-pi where

import 00-preamble
open 00-preamble public

-- Section 2.3 The identity function, composition, and their laws

-- Definition 2.3.1
id : {i : Level} {A : UU i} → A → A
id a = a

-- Definition 2.3.2
_∘_ :
  {i j k : Level} {A : UU i} {B : UU j} {C : UU k} →
  (B → C) → ((A → B) → (A → C))
(g ∘ f) a = g (f a)

-- Exercises

-- Exercise 2.3
const : {i j : Level} (A : UU i) (B : UU j) (b : B) → A → B
const A B b x = b

-- Exercise 2.4
_∘'_ :
  {i j k : Level} {A : UU i} {B : A → UU j} {C : (x : A) → B x → UU k} →
  (g : (x : A) → (y : B x) → C x y) (f : (x : A) → B x) → (x : A) → C x (f x)
(g ∘' f) x = g x (f x)

-- Exercise 2.5
Π-swap : {i j k : Level} {A : UU i} {B : UU j} {C : A → (B → UU k)} →
  ((x : A) (y : B) → C x y) → ((y : B) (x : A) → C x y)
Π-swap f y x = f x y


{-
This second-order equational theory was created from the following second-order syntax description:

syntax Sub | S

type
  L : 0-ary
  T : 0-ary

term
  vr : L  ->  T
  sb : L.T  T  ->  T

theory
  (C) x y : T |> sb (a. x[], y[]) = x[]
  (L) x : T |> sb (a. vr(a), x[]) = x[]
  (R) a : L  x : L.T |> sb (b. x[b], vr(a[])) = x[a[]]
  (A) x : (L,L).T  y : L.T  z : T |> sb (a. sb (b. x[a,b], y[a]), z[]) = sb (b. sb (a. x[a, b], z[]), sb (a. y[a], z[]))
-}

module Sub.Equality where

open import SOAS.Common
open import SOAS.Context
open import SOAS.Variable
open import SOAS.Families.Core
open import SOAS.Families.Build
open import SOAS.ContextMaps.Inductive

open import Sub.Signature
open import Sub.Syntax

open import SOAS.Metatheory.SecondOrder.Metasubstitution S:Syn
open import SOAS.Metatheory.SecondOrder.Equality S:Syn

private
  variable
    α β γ τ : ST
    Γ Δ Π : Ctx

infix 1 _▹_⊢_≋ₐ_

-- Axioms of equality
data _▹_⊢_≋ₐ_ : ∀ 𝔐 Γ {α} → (𝔐 ▷ S) α Γ → (𝔐 ▷ S) α Γ → Set where
  C : ⁅ T ⁆ ⁅ T ⁆̣     ▹ ∅ ⊢              sb 𝔞 𝔟 ≋ₐ 𝔞
  L : ⁅ T ⁆̣           ▹ ∅ ⊢        sb (vr x₀) 𝔞 ≋ₐ 𝔞
  R : ⁅ L ⁆ ⁅ L ⊩ T ⁆̣ ▹ ∅ ⊢ sb (𝔟⟨ x₀ ⟩) (vr 𝔞) ≋ₐ 𝔟⟨ 𝔞 ⟩
  A : ⁅ L · L ⊩ T ⁆ ⁅ L ⊩ T ⁆ ⁅ T ⁆̣ ▹ ∅
    ⊢  sb (sb (𝔞⟨ x₁ ◂ x₀ ⟩) (𝔟⟨ x₀ ⟩)) 𝔠
    ≋ₐ sb (sb (𝔞⟨ x₀ ◂ x₁ ⟩) 𝔠) (sb (𝔟⟨ x₀ ⟩) 𝔠)

open EqLogic _▹_⊢_≋ₐ_
open ≋-Reasoning


{-# OPTIONS --safe --warning=error --without-K #-}

open import LogicalFormulae
open import Agda.Primitive using (Level; lzero; lsuc; _⊔_)
open import Decidable.Sets
open import Lists.Lists
open import Numbers.Naturals.Semiring

module UnorderedSet.Definition {a : _} {V : Set a} (dec : DecidableSet V) where

data UnorderedSetOf : List V → Set a where
  empty' : UnorderedSetOf []
  addCons : (v : V) → (vs : List V) → .(contains vs v → False) → UnorderedSetOf vs → UnorderedSetOf (v :: vs)

record UnorderedSet : Set a where
  field
    elts : List V
    set : UnorderedSetOf elts

empty : UnorderedSet
empty = record { elts = [] ; set = empty' }

add : V → UnorderedSet → UnorderedSet
add v record { elts = elts ; set = set } with containsDecidable dec elts v
... | inl x = record { elts = elts ; set = set }
... | inr x = record { elts = v :: elts ; set = addCons v elts x set }

singleton : V → UnorderedSet
singleton v = record { elts = v :: [] ; set = addCons v [] (λ ()) empty' }

ofList : (l : List V) → UnorderedSet
ofList [] = record { elts = [] ; set = empty' }
ofList (x :: l) = add x (ofList l)

union : UnorderedSet → UnorderedSet → UnorderedSet
union record { elts = eltsA ; set = setA } record { elts = eltsB ; set = setB } = ofList (eltsA ++ eltsB)

count : UnorderedSet → ℕ
count record { elts = e ; set = _ } = length e

setContains : (v : V) → UnorderedSet → Set a
setContains v record { elts = elts ; set = set } = contains elts v


{- 2010-09-17 a small case study to test irrelevance -}

module IrrelevanceCaseStudyPartialFunctions where

data _≡_ {A : Set}(a : A) : A → Set where
  refl : a ≡ a

record ⊤ : Set where

record Sigma (A : Set)(B : A → Set) : Set where
  constructor _,_
  field
    fst : A
    snd : B fst

syntax Sigma A (λ x → B) = Σ x ∈ A , B

data Subset (A : Set)(P : A → Set) : Set where
  _#_ : (elem : A) → .(P elem) → Subset A P

elimSubset : ∀ {A C : Set} {P} →
             Subset A P → ((a : A) → .(P a) → C) → C
elimSubset (a # p) k = k a p

syntax Subset A (λ x → P) = ⁅ x ∈ A ∣ P ⁆

elem : {A : Set}{P : A → Set} → ⁅ x ∈ A ∣ P x ⁆ → A
elem (x # p) = x

elim₂ : ∀ {A C : Set} {P Q : A → Set} →
        Subset A (λ x → Sigma (P x) (λ _ → Q x)) →
        ((a : A) → .(P a) → .(Q a) → C) → C
elim₂ (a # (p , q)) k = k a p q

record _⇀_ (A B : Set) : Set1 where
  constructor mkParFun
  field
    dom : A → Set
    _′_ : ⁅ x ∈ A ∣ dom x ⁆ → B

open _⇀_ public

syntax mkParFun dom f = f ↾ dom

pure : {A B : Set} → (A → B) → A ⇀ B
pure f = record { dom = λ x → ⊤ ; _′_ = λ a → f (elem a) }

_∘_ : {A B C : Set} → (B ⇀ C) → (A ⇀ B) → A ⇀ C
(g ↾ Q) ∘ (f ↾ P) = gf ↾ QP where
  QP : _ → Set
  QP x             = Σ x∈P ∈ P x , Q (f (x # x∈P))
  gf : Subset _ QP → _
  gf (x # (p , q)) = g (f (x # p) # q)

_⊑_ : {A B : Set} → (f f' : A ⇀ B) → Set
(f ↾ P) ⊑ (f' ↾ P') =
  Σ φ ∈ (∀ {x} → P x → P' x) ,
    (∀ {x} (p : P x) → f (x # p) ≡ f' (x # φ p))


{-# OPTIONS --universe-polymorphism #-}

open import Categories.Category
open import Categories.Object.Terminal
open import Level

module Categories.Object.Terminal.Products {o ℓ e : Level}
    (C : Category o ℓ e)
    (T : Terminal C) where

open import Categories.Object.Product

open Category C
open Terminal T

[⊤×⊤] : Obj
[⊤×⊤] = ⊤

[⊤×⊤]-product : Product C ⊤ ⊤
[⊤×⊤]-product = record
    { A×B       = [⊤×⊤]
    ; π₁        = !
    ; π₂        = !
    ; ⟨_,_⟩     = λ _ _ → !
    ; commute₁  = !-unique₂ _ _
    ; commute₂  = !-unique₂ _ _
    ; universal = λ _ _ → !-unique _
    }

[⊤×_] : Obj → Obj
[⊤× X ] = X

[⊤×_]-product : (X : Obj) → Product C ⊤ X
[⊤×_]-product X = record
    { A×B       = [⊤× X ]
    ; π₁        = !
    ; π₂        = id
    ; ⟨_,_⟩     = λ _ f → f
    ; commute₁  = !-unique₂ _ _
    ; commute₂  = identityˡ
    ; universal = λ {A}{f}{g}{i} _ id∘i≡g →
        begin
            g
        ↑⟨ id∘i≡g ⟩
            id ∘ i
        ↓⟨ identityˡ ⟩
            i
        ∎
    } where open HomReasoning

[_×⊤] : Obj → Obj
[ X ×⊤] = X

[_×⊤]-product : (X : Obj) → Product C X ⊤
[_×⊤]-product X = record
    { A×B       = [ X ×⊤]
    ; π₁        = id
    ; π₂        = !
    ; ⟨_,_⟩     = λ f _ → f
    ; commute₁  = identityˡ
    ; commute₂  = !-unique₂ _ _
    ; universal = λ {A}{f}{g}{i} id∘i≡f _ →
        begin
            f
        ↑⟨ id∘i≡f ⟩
            id ∘ i
        ↓⟨ identityˡ ⟩
            i
        ∎
    } where open HomReasoning


------------------------------------------------------------------------
-- The Agda standard library
--
-- Documentation for the List type
------------------------------------------------------------------------

{-# OPTIONS --warning noMissingDefinitions #-}

module README.Data.List where

open import Algebra.Structures using (IsCommutativeMonoid)
open import Data.Char.Base using (Char; fromℕ)
open import Data.Char.Properties as CharProp hiding (setoid)
open import Data.Nat using (ℕ; _+_; _<_; s≤s; z≤n; _*_; _∸_; _≤_)
open import Data.Nat.Properties as NatProp
open import Relation.Binary.PropositionalEquality
  using (_≡_; refl; sym; cong; setoid)

------------------------------------------------------------------------
-- 1. Basics
------------------------------------------------------------------------
-- The `List` datatype is exported by the following file:

open import Data.List
  using
  (List
  ; []; _∷_
  ; sum; map; take; reverse; _++_; drop
  )

module Basics where

  -- Lists are built using the "[]" and "_∷_" constructors.

  list₁ : List ℕ
  list₁ = 3 ∷ 1 ∷ 2 ∷ []

  -- Basic operations over lists are also exported by the same file.

  lem₁ : sum list₁ ≡ 6
  lem₁ = refl

  lem₂ : map (_+ 2) list₁ ≡ 5 ∷ 3 ∷ 4 ∷ []
  lem₂ = refl

  lem₃ : take 2 list₁ ≡ 3 ∷ 1 ∷ []
  lem₃ = refl

  lem₄ : reverse list₁ ≡ 2 ∷ 1 ∷ 3 ∷ []
  lem₄ = refl

  lem₅ : list₁ ++ list₁ ≡ 3 ∷ 1 ∷ 2 ∷ 3 ∷ 1 ∷ 2 ∷ []
  lem₅ = refl

  -- Various properties of these operations can be found in:

  open import Data.List.Properties

  lem₆ : ∀ n (xs : List ℕ) → take n xs ++ drop n xs ≡ xs
  lem₆ = take++drop

  lem₇ : ∀ (xs : List ℕ) → reverse (reverse xs) ≡ xs
  lem₇ = reverse-involutive

  lem₈ : ∀ (xs ys zs : List ℕ) → (xs ++ ys) ++ zs ≡ xs ++ (ys ++ zs)
  lem₈ = ++-assoc

------------------------------------------------------------------------
-- 2. Binary relations over lists
------------------------------------------------------------------------

-- All binary relations over lists are found in the folder
-- `Data.List.Relation.Binary`.

------------------------------------------------------------------------
-- Pointwise

module PointwiseExplanation where

  -- One of the most basic ways to form a binary relation between two
  -- lists of type `List A`, given a binary relation over `A`, is to say
  -- that two lists are related if:
  --   i) the first elements in the lists are related
  --   ii) the second elements in the lists are related
  --   iii) the third elements in the lists are related etc.
  --
  -- A formalisation of this "pointwise" lifting of a relation to lists
  -- is found in:

  open import Data.List.Relation.Binary.Pointwise

  -- The same syntax to construct a list (`[]` & `_∷_`) is used to
  -- construct proofs for the `Pointwise` relation. For example if you
  -- want to prove that one list is strictly less than another list:

  lem₁ : Pointwise _<_ (0 ∷ 2 ∷ 1 ∷ []) (1 ∷ 4 ∷ 2 ∷ [])
  lem₁ = 0<1 ∷ 2<4 ∷ 1<2 ∷ []
    where
    0<1 = s≤s z≤n
    2<4 = s≤s (s≤s (s≤s z≤n))
    1<2 = s≤s 0<1

  -- Lists that are related by `Pointwise` must be of the same length.
  -- For example:

  open import Relation.Nullary using (¬_)

  lem₂ : ¬ Pointwise _<_ (0 ∷ 2 ∷ []) (1 ∷ [])
  lem₂ (0<1 ∷ ())

------------------------------------------------------------------------
-- Equality

module EqualityExplanation where

  -- There are many different options for what it means for two
  -- different lists of type `List A` to be "equal". We will initially
  -- consider notions of equality that require the list elements to be
  -- in the same order and later discuss other types of equality.

  -- The most basic option in the former case is simply to use
  -- propositional equality `_≡_` over lists:

  open import Relation.Binary.PropositionalEquality
    using (_≡_; sym; refl)

  lem₁ : 1 ∷ 2 ∷ 3 ∷ [] ≡ 1 ∷ 2 ∷ 3 ∷ []
  lem₁ = refl

  -- However propositional equality is only suitable when we want to
  -- use propositional equality to compare the individual elements.
  -- Although a contrived example, consider trying to prove the
  -- equality of two lists of the type `List (ℕ → ℕ)`:

  lem₂ : (λ x → 2 * x + 2) ∷ [] ≡ (λ x → 2 * (x + 1)) ∷ []

  -- In such a case it is impossible to prove the two lists equal with
  -- refl as the two functions are not propositionally equal. In the
  -- absence of postulating function extensionality (see README.Axioms),
  -- the most common definition of function equality is to say that two
  -- functions are equal if their outputs are always propositionally
  -- equal for any input. This notion of function equality `_≗_` is
  -- found in:

  open import Relation.Binary.PropositionalEquality using (_≗_)

  -- We now want to use the `Pointwise` relation to say that the two
  -- lists are equal if their elements are pointwise equal with resepct
  -- to `_≗_`. However instead of using the pointwise module directly
  -- to write:

  open import Data.List.Relation.Binary.Pointwise using (Pointwise)

  lem₃ : Pointwise _≗_ ((λ x → x + 1) ∷ []) ((λ x → x + 2 ∸ 1) ∷ [])

  -- the library provides some nicer wrappers and infix notation in the
  -- folder "Data.List.Relation.Binary.Equality".

  -- Within this folder there are four different modules.

  import Data.List.Relation.Binary.Equality.Setoid           as SetoidEq
  import Data.List.Relation.Binary.Equality.DecSetoid        as DecSetoidEq
  import Data.List.Relation.Binary.Equality.Propositional    as PropEq
  import Data.List.Relation.Binary.Equality.DecPropositional as DecPropEq

  -- Which one should be used depends on whether the underlying equality
  -- over "A" is:
  --   i)  propositional or setoid-based
  --   ii) decidable.

  -- Each of the modules except `PropEq` are designed to be opened with a
  -- module parameter. This is to avoid having to specify the underlying
  -- equality relation or the decidability proofs every time you use the
  -- list equality.

  -- In our example function equality is not decidable and not propositional
  -- and so we want to use the `SetoidEq` module. This requires a proof that
  -- the `_≗_` relation forms a setoid over functions of the type `ℕ → ℕ`.
  -- This is found in:

  open import Relation.Binary.PropositionalEquality using (_→-setoid_)

  -- The `SetoidEq` module should therefore be opened as follows:

  open SetoidEq (ℕ →-setoid ℕ)

  -- All four equality modules provide an infix operator `_≋_` for the
  -- new equality relation over lists. The type of `lem₃` can therefore
  -- be rewritten as:

  lem₄ : (λ x → x + 1) ∷ [] ≋ (λ x → x + 2 ∸ 1) ∷ []
  lem₄ = 2x+2≗2[x+1] ∷ []
    where
    2x+2≗2[x+1] : (λ x → x + 1) ≗ (λ x → x + 2 ∸ 1)
    2x+2≗2[x+1] x = sym (+-∸-assoc x (s≤s z≤n))

  -- The modules also provide proofs that the `_≋_` relation is a
  -- setoid in its own right and therefore is reflexive, symmetric,
  -- transitive:

  lem₅ : (λ x → 2 * x + 2) ∷ [] ≋ (λ x → 2 * x + 2) ∷ []
  lem₅ = ≋-refl

  -- If we could prove that `_≗_` forms a `DecSetoid` then we could use
  -- the module `DecSetoidEq` instead. This exports everything from
  -- `SetoidEq` as well as the additional proof `_≋?_` that the list
  -- equality is decidable.

  -- This pattern of four modules for each of the four different types
  -- of equality is repeated throughout the library (e.g. see the
  -- `Membership` subheading below). Note that in this case the modules
  -- `PropEq` and `DecPropEq` are not very useful as if two lists are
  -- pointwise propositionally equal they are necessarily
  -- propositionally equal (and vice-versa). There are proofs of this
  -- fact exported by `PropEq` and `DecPropEq`. Although, these two
  -- types of list equality are not very useful in practice, they are
  -- included for completeness's sake.

------------------------------------------------------------------------
-- Permutations

module PermutationExplanation where

  -- Alternatively you might consider two lists to be equal if they
  -- contain the same elements regardless of the order of the elements.
  -- This is known as either "set equality" or a "permutation".

  -- The easiest-to-use formalisation of this relation is found in the
  -- module:

  open import Data.List.Relation.Binary.Permutation.Propositional

  -- The permutation relation is written as `_↭_` and has four
  -- constructors. The first `refl` says that a list is always
  -- a permutation of itself, the second `prep` says that if the
  -- heads of the lists are the same they can be skipped, the third
  -- `swap` says that the first two elements of the lists can be
  -- swapped and the fourth `trans` says that permutation proofs
  -- can be chained transitively.

  -- For example a proof that two lists are a permutation of one
  -- another can be written as follows:

  lem₁ : 1 ∷ 2 ∷ 3 ∷ [] ↭ 3 ∷ 1 ∷ 2 ∷ []
  lem₁ = trans (prep 1 (swap 2 3 refl)) (swap 1 3 refl)

  -- In practice it is difficult to parse the constructors in the
  -- proof above and hence understand why it holds. The
  -- `PermutationReasoning` module can be used to write this proof
  -- in a much more readable form:

  open PermutationReasoning

  lem₂ : 1 ∷ 2 ∷ 3 ∷ [] ↭ 3 ∷ 1 ∷ 2 ∷ []
  lem₂ = begin
    1 ∷ 2 ∷ 3 ∷ []  ↭⟨ prep 1 (swap 2 3 refl) ⟩
    1 ∷ 3 ∷ 2 ∷ []  ↭⟨ swap 1 3 refl ⟩
    3 ∷ 1 ∷ 2 ∷ []  ∎

  -- As might be expected, properties of the permutation relation may be
  -- found in `Data.List.Relation.Binary.Permutation.Inductive.Properties`.

  open import Data.List.Relation.Binary.Permutation.Propositional.Properties

  lem₃ : ∀ {xs ys : List ℕ} → xs ↭ ys → map fromℕ xs ↭ map fromℕ ys
  lem₃ = map⁺ fromℕ

  lem₄ : IsCommutativeMonoid {A = List ℕ} _↭_ _++_ []
  lem₄ = ++-isCommutativeMonoid

  -- Note: at the moment permutations have only been formalised for
  -- propositional equality. Permutations for the other three types of
  -- equality (decidable propositional, setoid and decidable setoid)
  -- will hopefully be added in later versions of the library.

------------------------------------------------------------------------
-- Other relations

-- There exist many other binary relations in the
-- `Data.List.Relation.Binary` folder, including:
--    1. lexicographic orderings
--    2. bag/multiset equality
--    3. the subset relations.
--    4. the sublist relations

------------------------------------------------------------------------
-- 3. Properties of lists
------------------------------------------------------------------------

-- Whereas binary relations deal with how two lists relate to one
-- another, the unary relations in `Data.List.Relation.Unary` are used
-- to reason about the properties of an individual list.

------------------------------------------------------------------------
-- Any

module AnyExplanation where

  -- The predicate `Any` encodes the idea of at least one element of a
  -- given list satisfying a given property (or more formally a
  -- predicate, see the `Pred` type in `Relation.Unary`).

  open import Data.List.Relation.Unary.Any as Any

  -- A proof of type Any consists of a sequence of the "there"
  -- constructors, which says that the element lies in the remainder of
  -- the list, followed by a single "here" constructor which indicates
  -- that the head of the list satisfies the predicate and takes a proof
  -- that it does so.

  -- For example a proof that a given list of natural numbers contains
  -- at least one number greater than or equal to 4 can be written as
  -- follows:

  lem₁ : Any (4 ≤_) (3 ∷ 5 ∷ 1 ∷ 6 ∷ [])
  lem₁ = there (here 4≤5)
    where
    4≤5 = s≤s (s≤s (s≤s (s≤s z≤n)))

  -- Note that nothing requires that the proof of `Any` points at the
  -- first such element in the list. There is therefore an alternative
  -- proof for the above lemma which points to 6 instead of 5.

  lem₂ : Any (4 ≤_) (3 ∷ 5 ∷ 1 ∷ 6 ∷ [])
  lem₂ = there (there (there (here 4≤6)))
    where
    4≤6 = s≤s (s≤s (s≤s (s≤s z≤n)))

  -- There also exist various operations over proofs of `Any` whose names
  -- shadow the corresponding list operation. The standard way of using
  -- these is to use `as` to name the module:

  import Data.List.Relation.Unary.Any as Any

  -- and then use the qualified name `Any.map`. For example, map can
  -- be used to change the predicate of `Any`:

  open import Data.Nat.Properties using (≤-trans; n≤1+n)

  lem₃ : Any (3 ≤_) (3 ∷ 5 ∷ 1 ∷ 6 ∷ [])
  lem₃ = Any.map 4≤x⇒3≤x lem₂
    where
    4≤x⇒3≤x : ∀ {x} → 4 ≤ x → 3 ≤ x
    4≤x⇒3≤x = ≤-trans (n≤1+n 3)

------------------------------------------------------------------------
-- All

module AllExplanation where

  -- The dual to `Any` is the predicate `All` which encodes the idea that
  -- every element in a given list satisfies a given property.

  open import Data.List.Relation.Unary.All

  -- Proofs for `All` are constructed using exactly the same syntax as
  -- is used to construct lists ("[]" & "_∷_"). For example to prove
  -- that every element in a list is less than or equal to one:

  lem₁ : All (_≤ 1) (1 ∷ 0 ∷ 1 ∷ [])
  lem₁ = 1≤1 ∷ 0≤1 ∷ 1≤1 ∷ []
    where
    0≤1 = z≤n
    1≤1 = s≤s z≤n

  -- As with `Any`, the module also provides the standard operators
  -- `map`, `zip` etc. to manipulate proofs for `All`.

  import Data.List.Relation.Unary.All as All
  open import Data.Nat.Properties using (≤-trans; n≤1+n)

  lem₂ : All (_≤ 2) (1 ∷ 0 ∷ 1 ∷ [])
  lem₂ = All.map ≤1⇒≤2 lem₁
    where
    ≤1⇒≤2 : ∀ {x} → x ≤ 1 → x ≤ 2
    ≤1⇒≤2 x≤1 = ≤-trans x≤1 (n≤1+n 1)

------------------------------------------------------------------------
-- Membership

module MembershipExplanation where

  -- Membership of a list is simply a special case of `Any` where
  -- `x ∈ xs` is defined as `Any (x ≈_) xs`.

  -- Just like pointwise equality of lists, the exact membership module
  -- that should be used depends on whether the equality on the
  -- underlying elements of the list is i) propositional or setoid-based
  -- and ii) decidable.

  import Data.List.Membership.Setoid as SetoidMembership
  import Data.List.Membership.DecSetoid as DecSetoidMembership
  import Data.List.Membership.Propositional as PropMembership
  import Data.List.Membership.DecPropositional as DecPropMembership

  -- For example if we want to reason about membership for `List ℕ`
  -- then you would use the `DecSetoidMembership` as we use
  -- propositional equality over `ℕ` and it is also decidable. Therefore
  -- the module `DecPropMembership` should be opened as follows:

  open DecPropMembership NatProp._≟_

  -- As membership is just an instance of `Any` we also need to import
  -- the constructors `here` and `there`. (See issue #553 on Github for
  -- why we're struggling to have `here` and `there` automatically
  -- re-exported by the membership modules).

  open import Data.List.Relation.Unary.Any using (here; there)

  -- These modules provide the infix notation `_∈_` which can be used
  -- as follows:

  lem₁ : 1 ∈ 2 ∷ 1 ∷ 3 ∷ []
  lem₁ = there (here refl)

  -- Properties of the membership relation can be found in the following
  -- two files:

  import Data.List.Membership.Setoid.Properties as SetoidProperties
  import Data.List.Membership.Propositional.Properties as PropProperties

  -- As of yet there are no corresponding files for properties of
  -- membership for decidable versions of setoid and propositional
  -- equality as we have no properties that only hold when equality is
  -- decidable.

  -- These `Properties` modules are NOT parameterised in the same way as
  -- the main membership modules as some of the properties relate
  -- membership proofs for lists of different types. For example in the
  -- following the first `∈` refers to lists of type `List ℕ` whereas
  -- the second `∈` refers to lists of type `List Char`.

  open DecPropMembership CharProp._≟_ renaming (_∈_ to _∈ᶜ_)
  open SetoidProperties using (∈-map⁺)

  lem₂ : {v : ℕ} {xs : List ℕ} → v ∈ xs → fromℕ v ∈ᶜ map fromℕ xs
  lem₂ = ∈-map⁺ (setoid ℕ) (setoid Char) (cong fromℕ)


{-# OPTIONS --without-K #-}
open import Function.Related.TypeIsomorphisms.NP
open import Function.Inverse.NP
open import Data.Maybe.NP
open import Data.Nat

open import Explore.Type
open import Explore.Explorable
open import Explore.Sum

module Explore.Explorable.Maybe where

μMaybe : ∀ {A} → Explorable A → Explorable (Maybe A)
μMaybe μA = μ-iso (sym Maybe↔𝟙⊎) (μ𝟙 ⊎-μ μA)

μMaybe^ : ∀ {A} n → Explorable A → Explorable (Maybe^ n A)
μMaybe^ zero    μA = μA
μMaybe^ (suc n) μA = μMaybe (μMaybe^ n μA)


module Structure.Setoid.Category where

open import Data
import      Data.Tuple as Tuple
open import Functional
open import Function.Equals
open import Function.Equals.Proofs
open import Function.Proofs
open import Logic.Predicate
import      Lvl
open import Structure.Category
open import Structure.Categorical.Properties
open import Structure.Function
open import Structure.Operator
open import Structure.Relator.Equivalence
open import Structure.Relator.Properties
open import Structure.Setoid
open import Type
open import Type.Properties.Singleton

private variable ℓ ℓₑ ℓₒ : Lvl.Level

-- TODO: Maybe move this?
FunctionObject : Setoid{ℓₑ}{ℓₒ} → Setoid{ℓₑ}{ℓₒ} → Type
FunctionObject ([∃]-intro A) ([∃]-intro B) = ∃{Obj = (A → B)} Function

instance
  FunctionObject-equiv : ∀{A B : Setoid{ℓₑ}{ℓₒ}} → Equiv(FunctionObject A B)
  Equiv._≡_ FunctionObject-equiv = (_⊜_) on₂ [∃]-witness
  Reflexivity.proof  (Equivalence.reflexivity  (Equiv.equivalence FunctionObject-equiv)) = reflexivity(_⊜_)
  Symmetry.proof     (Equivalence.symmetry     (Equiv.equivalence FunctionObject-equiv)) = symmetry(_⊜_)
  Transitivity.proof (Equivalence.transitivity (Equiv.equivalence FunctionObject-equiv)) = transitivity(_⊜_)

-- The setoid category contains setoids and functions respecting the congruence property in the setoid.
setoidCategory : Category{Obj = Setoid{ℓₑ}{ℓₒ}} FunctionObject
Category._∘_ setoidCategory ([∃]-intro f) ([∃]-intro g) = [∃]-intro (f ∘ g) ⦃ [∘]-function {f = f}{g = g} ⦄
Category.id setoidCategory = [∃]-intro id
BinaryOperator.congruence (Category.binaryOperator setoidCategory) f₁f₂ g₁g₂ = [⊜][∘]-binaryOperator-raw f₁f₂ g₁g₂
Morphism.Associativity.proof (Category.associativity setoidCategory) {x = _} {y = _} {z = _} {x = [∃]-intro f} {y = [∃]-intro g} {z = [∃]-intro h} = [∘]-associativity {f = f} {g = g} {h = h}
Morphism.Identityₗ.proof (Tuple.left  (Category.identity setoidCategory)) = [∘]-identityₗ
Morphism.Identityᵣ.proof (Tuple.right (Category.identity setoidCategory)) = [∘]-identityᵣ

setoidCategoryObject : ∀{ℓₑ}{ℓₒ} → CategoryObject
setoidCategoryObject{ℓₑ}{ℓₒ} = intro(setoidCategory{ℓₑ}{ℓₒ})

module _ where
  open import Data.Proofs
  open import Relator.Equals

  Empty-initialObject : Object.Initial(FunctionObject{ℓₑ}) ([∃]-intro Empty)
  IsUnit.unit Empty-initialObject = [∃]-intro empty
  _⊜_.proof (IsUnit.uniqueness Empty-initialObject) {}

  Unit-terminalObject : Object.Terminal(FunctionObject{ℓₑ}) ([∃]-intro Unit)
  IsUnit.unit Unit-terminalObject = [∃]-intro (const <>)
  _⊜_.proof (IsUnit.uniqueness Unit-terminalObject) = [≡]-intro


{- Formal verification of authenticated append-only skiplists in Agda, version 1.0.

   Copyright (c) 2020 Oracle and/or its affiliates.
   Licensed under the Universal Permissive License v 1.0 as shown at https://opensource.oracle.com/licenses/upl
-}
open import Data.Empty
open import Data.Nat
open import Data.Product
open import Data.Nat.Divisibility
open import Data.Nat.Properties

open import Relation.Nullary
open import Relation.Nullary.Negation
open import Relation.Binary.PropositionalEquality
open import Relation.Binary.HeterogeneousEquality
 using (_≅_; ≅-to-≡; ≡-to-≅; _≇_)
 renaming (cong to ≅-cong; refl to ≅-refl; cong₂ to ≅-cong₂)

open import Function

-- This module proves a number of properties about even numbers.
-- We borrow some things from Data.Nat.Divisibility but specialize most
-- of them to divisibility-by-2.
module Data.Nat.Even where

 open import AAOSL.Lemmas

 Even : ℕ → Set
 Even n = 2 ∣ n

 even? : (n : ℕ) → Dec (Even n)
 even? n = 2 ∣? n

 Odd : ℕ → Set
 Odd = ¬_ ∘ Even

 even-irrelevant : ∀{n}(p q : Even n) → p ≡ q
 even-irrelevant (divides q₁ e₁) (divides q₂ e₂)
   with *2-injective q₁ q₂ (trans (sym e₁) e₂)
 ...| refl = cong (divides q₁) (≡-irrelevant e₁ e₂)

 --------------------------------------------------
 -- Properties about stepping and unstepping 'Even'

 even-unstep : ∀ k → Even (2 + k) → Even k
 even-unstep k (divides (suc q) e) = divides q (suc-injective (suc-injective e))

 even-step : ∀ k → Even k → Even (2 + k)
 even-step k (divides q₁ eq) = divides (1 + q₁) (cong (suc ∘ suc) eq)

 -----------------------------
 -- Properties of Even and Odd

 mutual
  even-odd-suc : ∀ k → Even k → Odd (suc k)
  even-odd-suc zero    x (divides q e) = ⊥-1≡m*2 q e
  even-odd-suc (suc k) x x₁            = even-suc-odd (suc k) x₁ x

  even-suc-odd : ∀ k → Even (suc k) → Odd k
  even-suc-odd zero    (divides q e) x₁ = ⊥-1≡m*2 q e
  even-suc-odd (suc k) x             x₁ = even-odd-suc k (even-unstep k x) x₁

 mutual
  odd-suc-suc : ∀ k → Odd k → Even (suc k)
  odd-suc-suc zero x = ⊥-elim (x (divides 0 refl))
  odd-suc-suc (suc k) x = even-step k (odd-pred-even (suc k) x)

  odd-pred-even : ∀ k → Odd k → Even (pred k)
  odd-pred-even zero x = ⊥-elim (x (divides 0 refl))
  odd-pred-even (suc k) x with even? k
  ...| no imp = ⊥-elim (x (odd-suc-suc k imp))
  ...| yes prf = prf

 -----------------------------
 -- Properties of Even and _*_

 *-preserve-even : ∀ k d → Even k → Even (k * d)
 *-preserve-even k d = ∣m⇒∣m*n d

 -----------------------------
 -- Properties of Even and _≤_

 even>0⇒>1 : ∀ {k} → 0 < k → Even k → 1 < k
 even>0⇒>1 {0}           ()
 even>0⇒>1 {1}           0<k e = ⊥-elim ((even-odd-suc 0 (divides 0 refl)) e)
 even>0⇒>1 {suc (suc k)} (s≤s z≤n) _ = s≤s (s≤s z≤n)

 0<odd : ∀{d} → Odd d → 0 < d
 0<odd {zero}  imp = ⊥-elim (imp (divides zero refl))
 0<odd {suc d} _   = s≤s z≤n

 -----------------------------
 -- Properties of Even and _∸_

 even∸1-odd : ∀ {k} → 1 < k → Even k → Odd (k ∸ 1)
 even∸1-odd {suc zero} 1<k ek = λ x → contradiction refl (<⇒≢ 1<k)
 even∸1-odd {suc (suc k)} 1<k ek = λ x → even-suc-odd (suc k) ek x

 odd∸1-even : ∀ {k} → Odd k → Even (k ∸ 1)
 odd∸1-even {zero} ok = ⊥-elim (ok (divides 0 refl))
 odd∸1-even {suc zero} ok = divides 0 refl
 odd∸1-even {suc (suc k)} ok = odd-pred-even (suc (suc k)) ok

 -----------------------------
 -- Properties of Even and _^_

 even-2^k : ∀ {k} → 0 < k → Even (2 ^ k)
 even-2^k {suc k} x = *-preserve-even 2 (2 ^ k) (divides 1 refl)

 odd-2^kd-1 : ∀ k d → 0 < k → 0 < d → ¬ Even (2 ^ k * d ∸ 1)
 odd-2^kd-1 k d 0<k 0<d x
   = even∸1-odd {2 ^ k * d} (pow*d>1 k d 0<k 0<d)
                            (*-preserve-even (2 ^ k) d (even-2^k 0<k))
                            x

 ----------------------------------------------------------------
 -- Every natural number can be viewed as a power of two times
 -- an odd number. We can witness that conversion in the from and
 -- to functions below.
 data Pow2 : ℕ → Set where
   zero : Pow2 zero
   pos  : ∀ {n} l d → Odd d → n ≡ 2 ^ l * d → Pow2 n

 pos-cong : ∀{n₁ n₂} (p : n₁ ≡ n₂)
          → ∀{d₁ d₂} (q : d₁ ≡ d₂)
          → (o₁ : Odd d₁)(o₂ : Odd d₂)
          → ∀{m} (r₁ : m ≡ 2 ^ n₁ * d₁) (r₂ : m ≡ 2 ^ n₂ * d₂)
          → pos n₁ d₁ o₁ r₁ ≡ pos n₂ d₂ o₂ r₂
 pos-cong {n₁ = n} refl {d₁ = d} refl o₁ o₂ r₁ r₂
   = cong₂ (pos n d) (fun-ext (λ x → ⊥-elim (o₁ x))) (≡-irrelevant r₁ r₂)

 -- One must mark this as terminating. The recursive call
 -- is made with 'quotient prf', and although we know it is
 -- strictly smaller than (suc n), Agda can't infer it.
 {-# TERMINATING #-}
 to : (n : ℕ) → Pow2 n
 to 0       = zero
 to (suc n) with even? (suc n)
 ...| no  odd = pos 0 (suc n) odd (cong suc (+-comm 0 n))
 ...| yes prf with to (quotient prf)
 ...| zero             = ⊥-elim (1+n≢0 (_∣_.equality prf))
 ...| pos l d odd prf' = pos (suc l) d odd
                         (trans (_∣_.equality prf)
                         (trans (cong (λ x → x * 2) prf')
                                (a*b*2-lemma (2 ^ l) d)))

 -- Converting from a Pow2 is trivial, since we kept the
 -- original number there.
 from : ∀{n} → Pow2 n → ℕ
 from zero              = zero
 from (pos {n} _ _ _ _) = n

 -- From and To form an isomorphism
 -- TODO-1: Document and justify this pragma
 {-# TERMINATING #-}
 from-to-iso : ∀ n → from (to n) ≡ n
 from-to-iso zero = refl
 from-to-iso (suc n) with even? (suc n)
 ...| no  odd = refl
 ...| yes prf with to (quotient prf)
 ...| zero             = ⊥-elim (1+n≢0 (_∣_.equality prf))
 ...| pos l d odd prf' = refl

 --------------------------------
 -- Properties of to and equality

 inj-to : ∀ {m n} → m ≡ n → to m ≅ to n
 inj-to refl = ≅-refl

 to-inj :  ∀ {m n} → to m ≇ to n → m ≢ n
 to-inj x x₁ = x (inj-to x₁)

 ---------------------------
 -- Uniqueness of 2^k*d form

 2^kd-≢-d : ∀{k d₁ d₂}
          → d₁ ≢ d₂
          → 2 ^ k * d₁ ≢ 2 ^ k * d₂
 2^kd-≢-d {k} hip abs with 2^k-is-suc k
 ...| r , prf rewrite prf = hip (*-cancelˡ-≡ r abs)

 2^kd-≢-k : ∀{k₁ k₂ d₁ d₂}
             → k₁ ≢ k₂
             → Odd d₁ → Odd d₂
             → 2 ^ k₁ * d₁ ≢ 2 ^ k₂ * d₂
 2^kd-≢-k {zero} {zero} {d₁} {d₂} k₁≢k₂ o₁ o₂ e₁≡e₂ = k₁≢k₂ refl
 2^kd-≢-k {zero} {suc k₂} {d₁} {d₂} k₁≢k₂ o₁ o₂ e₁≡e₂
   rewrite +-identityʳ d₁
         | *-assoc 2 (2 ^ k₂) d₂
         | *-comm 2 (2 ^ k₂ * d₂) = o₁ (divides (2 ^ k₂ * d₂) e₁≡e₂)
 2^kd-≢-k {suc k₁} {zero} {d₁} {d₂} k₁≢k₂ o₁ o₂ e₁≡e₂
   rewrite +-identityʳ d₂
         | *-assoc 2 (2 ^ k₁) d₁
         | *-comm 2 (2 ^ k₁ * d₁) = o₂ (divides (2 ^ k₁ * d₁) (sym e₁≡e₂))
 2^kd-≢-k {suc k₁} {suc k₂} {d₁} {d₂} k₁≢k₂ o₁ o₂ e₁≡e₂
   rewrite  *-assoc 2 (2 ^ k₁) d₁
         |  *-assoc 2 (2 ^ k₂) d₂ = *-cong-≢ 2 (s≤s z≤n) (2^kd-≢-k (suc-≢ k₁≢k₂) o₁ o₂) e₁≡e₂

 ----------------------
 -- Correctness of 'to'

 -- The trick to 2^kd is to use heterogeneous equality first.
 -- The problem stems from the type of arguments of pos depending
 -- on each other. Agda has trouble understanding that the different
 -- ways to write 'n' are all equal. Hence, we abstract that away.
 to-2^kd-≅ : ∀{n d} k → (o : Odd d)(p : n ≡ 2 ^ k * d)
           → to n ≅ pos k d o refl
 to-2^kd-≅ {n} {d} k o p with to n
 ...| zero = ⊥-elim (0≢a*b-magic (1≤2^n k) (0<odd o) p)
 to-2^kd-≅ {n} {d} k o p
    | pos k₀ d₀ o₀ p₀
   with k ≟ k₀
 ...| no abs = ⊥-elim (2^kd-≢-k abs o o₀ (trans (sym p) p₀))
 ...| yes refl
   with d ≟ d₀
 ...| no abs = ⊥-elim (2^kd-≢-d {k₀} abs (trans (sym p) p₀))
 to-2^kd-≅ {n} {d} .k₀ o p
    | pos k₀ d₀ o₀ p₀ | yes refl | yes refl
   rewrite fun-ext {f = o} {o₀} (λ x → ⊥-elim (o x)) | p
   with p₀
 ...| refl = ≅-refl

 -- And then, Agda is happy to understand it is equal after all.
 to-2^kd : ∀{d} k → (o : Odd d) → to (2 ^ k * d) ≡ pos k d o refl
 to-2^kd {d} k p = ≅-to-≡ (to-2^kd-≅ k p refl)

 to-reduce : ∀ {m k d}
           → (mprf : m ≡ (2 ^ k) * d)
           → (od : Odd d)
           → to m ≡ pos k d od mprf
 to-reduce {m} {k} {d} refl od = to-2^kd k od


{-# OPTIONS --cubical #-}

module Miscellaneous.CubicalInteger where

import      Lvl
open import Numeral.Natural as ℕ using (ℕ)
open import Numeral.Sign as Sign using (−|+ ; −|0|+ ; ➖ ; ➕)
open import Type.Cubical
open import Type.Cubical.Path.Equality
open import Type

apply : ∀{ℓ}{T : Type{ℓ}}{x y : T} → Interval → (x ≡ y) → T
apply i xy = xy i

infix 10010 −ₙ_ +ₙ_
infix 10020 _+_ _−_

-- The type of integers ℤ = {…,−2,−1,0,1,2,…}.
-- Represented by using the exclusive union of ℕ and ℕ, but the zeroes are equal.
data ℤ : Type{Lvl.𝟎} where
  signed : (−|+) → ℕ → ℤ
  𝟎-sign : (signed ➖ ℕ.𝟎 ≡ signed ➕ ℕ.𝟎)

-- Intuitive constructor patterns
-- −ₙ_ : ℕ → ℤ
-- +ₙ_ : ℕ → ℤ
pattern −ₙ_ n = signed ➖ n
pattern +ₙ_ n = signed ➕ n
pattern 𝟎  = +ₙ(ℕ.𝟎) -- Zero (0).
pattern 𝟏  = +ₙ(ℕ.𝟏) -- One (1).
pattern −𝟏 = −ₙ(ℕ.𝟏) -- Negative one (−1).

open import Structure.Relator.Properties
open import Type.Cubical.Path
open import Type.Cubical.Path.Proofs

-- module _ where
--   open import Type.Isomorphism
--   postulate univalence : ∀{ℓ}{A B : Type{ℓ}} → (A ≅ B) ≅ (A ≡ B)

elim : ∀{ℓ} → (P : ℤ → Type{ℓ}) → (neg : (n : ℕ) → P(−ₙ n)) → (pos : (n : ℕ) → P(+ₙ n)) → PathP(pointOn(map P 𝟎-sign)) (neg ℕ.𝟎) (pos ℕ.𝟎) → ((n : ℤ) → P(n))
elim(P) neg _   eq (−ₙ n) = neg n
elim(P) _   pos eq (+ₙ n) = pos n
elim(P) _   _   eq (𝟎-sign i) = eq i

-- Sign.
-- The sign part of an integer where zero is interpreted as positive.
-- Notes on the proof of the path:
--   The 𝟎-sign case guarantees that the function respects the congruence property (in this case (−0 = +0) → (sign(−0) = sign(+0))).
--   It is proven by providing the value on a path varying on the variable `i`. In this case, it is constant (both −0 and +0 maps to ➕).
sign : ℤ → (−|+)
sign (signed _ ℕ.𝟎)      = ➕
sign (signed s (ℕ.𝐒(_))) = s
sign (𝟎-sign i) = ➕

-- Zeroable sign.
sign₀ : ℤ → (−|0|+)
sign₀ (signed s ℕ.𝟎)      = Sign.𝟎
sign₀ (signed s (ℕ.𝐒(_))) = Sign.zeroable s
sign₀ (𝟎-sign i) = Sign.𝟎

-- Absolute value.
-- The natural part of an integer.
absₙ : ℤ → ℕ
absₙ(−ₙ n) = n
absₙ(+ₙ n) = n
absₙ(𝟎-sign _) = ℕ.𝟎

open import Data.Either
open import Functional using (_$_)
open import Logic.Propositional
import      Numeral.Sign.Oper as Sign
import      Numeral.Natural.Oper as ℕ
open import Relator.Equals using () renaming (_≡_ to Id ; [≡]-intro to Id-intro)
open import Relator.Equals.Proofs.Equivalence using () renaming ([≡]-equiv to Id-equiv ; [≡]-symmetry to Id-symmetry ; [≡]-to-function to Id-to-function ; [≡]-function to Id-function)
open import Syntax.Transitivity

Sign-decidable-eq : ∀(s₁ s₂ : (−|+)) → (Id s₁ s₂ ∨ ¬(Id s₁ s₂))
Sign-decidable-eq ➕ ➕ = [∨]-introₗ Id-intro
Sign-decidable-eq ➕ ➖ = [∨]-introᵣ \()
Sign-decidable-eq ➖ ➕ = [∨]-introᵣ \()
Sign-decidable-eq ➖ ➖ = [∨]-introₗ Id-intro

step : (−|+) → ℤ → ℤ
step s₁ (signed s₂ n) with Sign-decidable-eq s₁ s₂
step _  (signed s n)         | Left  _ = signed s (ℕ.𝐒(n))
step s₁ (signed s₂ ℕ.𝟎)      | Right _ = signed s₁ (ℕ.𝐒(ℕ.𝟎))
step s₁ (signed s₂ (ℕ.𝐒(n))) | Right _ = signed s₂ n
step ➕ (𝟎-sign i) = 𝟏
step ➖ (𝟎-sign i) = −𝟏

-- Predecessor.
-- Alternative implementation:
--   𝐏(−ₙ n)      = −ₙ(ℕ.𝐒(n))
--   𝐏(+ₙ ℕ.𝟎)    = −ₙ(ℕ.𝐒(ℕ.𝟎))
--   𝐏(+ₙ(ℕ.𝐒 n)) = +ₙ n
--   𝐏(𝟎-sign i)  = reflexivity(_≡_) {−𝟏} i
𝐏 : ℤ → ℤ
𝐏 = step ➖

-- Successor.
-- Alternative implementation:
--   𝐒(−ₙ(ℕ.𝐒 n)) = −ₙ n
--   𝐒(−ₙ ℕ.𝟎)    = +ₙ(ℕ.𝐒(ℕ.𝟎))
--   𝐒(+ₙ n)      = +ₙ(ℕ.𝐒(n))
--   𝐒(𝟎-sign i)  = reflexivity(_≡_) {𝟏} i
𝐒 : ℤ → ℤ
𝐒 = step ➕

-- Negation.
−_ : ℤ → ℤ
−(signed s n) = signed (Sign.− s) n
−(𝟎-sign i) = symmetry(_≡_) 𝟎-sign i

-- Absolute value.
abs : ℤ → ℤ
abs(signed _ n) = signed ➕ n
abs(𝟎-sign i) = 𝟎

-- Addition.
_+_ : ℤ → ℤ → ℤ
x + (signed _ ℕ.𝟎)      = x
x + (signed s (ℕ.𝐒(y))) = step s (x + (signed s y))
x + 𝟎-sign i = x

-- Subtraction.
_−_ : ℤ → ℤ → ℤ
x − y = x + (− y)

import Numeral.Natural.Oper.Proofs as ℕ

_⋅_ : ℤ → ℤ → ℤ
x ⋅ y = signed ((sign x) Sign.⨯ (sign y)) ((absₙ x) ℕ.⋅ (absₙ y))

𝟎-signs : ∀{s₁ s₂} → (signed s₁ ℕ.𝟎 ≡ signed s₂ ℕ.𝟎)
𝟎-signs {➕} {➕} = reflexivity(_≡_)
𝟎-signs {➕} {➖} = symmetry(_≡_) 𝟎-sign
𝟎-signs {➖} {➕} = 𝟎-sign
𝟎-signs {➖} {➖} = reflexivity(_≡_)

-- Notes on the proof of the path:
--   𝐏(𝟎-sign i) = −𝟏
--   𝐒(𝐏(𝟎-sign i)) = 𝐒(−𝟏) = −𝟎
--   and
--   • i=0: const(−ₙ 0) j = −ₙ 0
--   • i=1: 𝟎-sign j
--   • j=0: −ₙ 0
--   • j=1: 𝟎-sign i
--   which means:
--   • i=0 ∧ j=0: −0 , −0
--   • i=0 ∧ j=1: −0 , −0
--   • i=1 ∧ j=0: −0 , −0
--   • i=1 ∧ j=1: +0 , +0
--   The value varies between −0 and +0. Therefore, a path between them should be used: 𝟎-sign.
--   It is −𝟎 when i or j is 0 and +𝟎 when i and j is 0. Therefore, min.
𝐒-𝐏-inverses : ∀{n} → (𝐒(𝐏(n)) ≡ n)
𝐒-𝐏-inverses {+ₙ(ℕ.𝟎)}    = 𝟎-sign
𝐒-𝐏-inverses {+ₙ(ℕ.𝐒(x))} = reflexivity(_≡_)
𝐒-𝐏-inverses {−ₙ x}       = reflexivity(_≡_)
𝐒-𝐏-inverses {𝟎-sign i} j = 𝟎-sign (Interval.min i j)

𝐏-𝐒-inverses : ∀{n} → (𝐏(𝐒(n)) ≡ n)
𝐏-𝐒-inverses {−ₙ(ℕ.𝟎)}    = symmetry(_≡_) 𝟎-sign
𝐏-𝐒-inverses {−ₙ(ℕ.𝐒(x))} = reflexivity(_≡_)
𝐏-𝐒-inverses {+ₙ x}       = reflexivity(_≡_)
𝐏-𝐒-inverses {𝟎-sign i} j = 𝟎-sign (Interval.max i (Interval.flip j))

step-inverses : ∀{s₁ s₂}{n} → ¬(Id s₁ s₂) → (step s₁ (step s₂ n) ≡ n)
step-inverses {➕} {➕} eq with () ← eq Id-intro
step-inverses {➕} {➖} eq = 𝐒-𝐏-inverses
step-inverses {➖} {➕} eq = 𝐏-𝐒-inverses
step-inverses {➖} {➖} eq with () ← eq Id-intro

open import Structure.Function.Domain

{- TODO: Is something similar to this possible? Maybe (rel = ∀{x} → Unique(P(x))) instead?
induction : ∀{ℓ} → (P : ℤ → Type{ℓ}) → (∀{x y} → (x ≡ y) → P(x) → P(y)) → ((n : ℕ) → P(−ₙ n)) → P(𝟎) → ((n : ℕ) → P(+ₙ n)) → ((n : ℤ) → P(n))
induction(P) rel neg zero pos n = elim(P) neg pos ? n
-}

open import Functional using (_∘_)
import      Numeral.Sign.Proofs as Sign
open import Structure.Function
import      Structure.Operator.Names as Names
open import Structure.Operator.Properties
open import Structure.Operator

𝐒-to-step : ∀{s}{n} → (signed s (ℕ.𝐒(n)) ≡ step s (signed s n))
𝐒-to-step {➕} {n} = reflexivity(_≡_)
𝐒-to-step {➖} {n} = reflexivity(_≡_)

step-swap : ∀{s₁ s₂}{x} → (step s₁ (step s₂ x) ≡ step s₂ (step s₁ x))
step-swap {➕} {➕} {x} = reflexivity(_≡_)
step-swap {➕} {➖} {x} = 𝐒-𝐏-inverses {x} 🝖 symmetry(_≡_) 𝐏-𝐒-inverses
step-swap {➖} {➕} {x} = 𝐏-𝐒-inverses {x} 🝖 symmetry(_≡_) 𝐒-𝐏-inverses
step-swap {➖} {➖} {x} = reflexivity(_≡_)

[+]ᵣ-of-step : ∀{s}{x y} → (x + step s(y) ≡ step s(x + y))
[+]ᵣ-of-step {s₁}{x} {signed s₂ n} with Sign-decidable-eq s₁ s₂
[+]ᵣ-of-step {s} {x} {signed s n} | Left Id-intro = reflexivity(_≡_)
[+]ᵣ-of-step {➕} {x} {signed ➕ n}       | Right p with () ← p Id-intro
[+]ᵣ-of-step {➕} {x} {signed ➖ ℕ.𝟎}     | Right _ = reflexivity(_≡_)
[+]ᵣ-of-step {➖} {x} {signed ➕ ℕ.𝟎}     | Right _ = reflexivity(_≡_)
[+]ᵣ-of-step {➕} {x} {signed ➖ (ℕ.𝐒 n)} | Right _ = symmetry(_≡_) 𝐒-𝐏-inverses
[+]ᵣ-of-step {➖} {x} {signed ➕ (ℕ.𝐒 n)} | Right _ = symmetry(_≡_) 𝐏-𝐒-inverses
[+]ᵣ-of-step {➖} {x} {signed ➖ n}       | Right p with () ← p Id-intro
[+]ᵣ-of-step {➕} {x} {𝟎-sign i} = reflexivity(_≡_)
[+]ᵣ-of-step {➖} {x} {𝟎-sign i} = reflexivity(_≡_)

[+]ₗ-of-step : ∀{s}{x y} → (step s(x) + y ≡ step s(x + y))
[+]ₗ-of-step {s₁} {x} {signed s₂ ℕ.𝟎} = reflexivity(_≡_)
[+]ₗ-of-step {s₁} {x} {signed s₂ (ℕ.𝐒 n)} =
  step s₁ x + signed s₂ (ℕ.𝐒 n)       🝖[ _≡_ ]-[]
  step s₂ (step s₁ x + signed s₂ n)   🝖[ _≡_ ]-[ congruence₂ᵣ(step)(s₂) ([+]ₗ-of-step {s₁} {x} {signed s₂ n}) ]
  step s₂ (step s₁ (x + signed s₂ n)) 🝖[ _≡_ ]-[ step-swap{s₂}{s₁}{x + signed s₂ n} ]
  step s₁ (step s₂ (x + signed s₂ n)) 🝖[ _≡_ ]-[ congruence₂ᵣ(step)(s₁) ([+]ᵣ-of-step {s₂} {x} {signed s₂ n}) ]-sym
  step s₁ (x + step s₂ (signed s₂ n)) 🝖[ _≡_ ]-[ congruence₂ᵣ(step)(s₁) (congruence₂ᵣ(_+_)(x) (𝐒-to-step {s₂}{n})) ]-sym
  step s₁ (x + signed s₂ (ℕ.𝐒 n))     🝖-end
[+]ₗ-of-step {➕} {signed ➕ ℕ.𝟎} {𝟎-sign i} j = 𝟏
[+]ₗ-of-step {➕} {signed ➖ ℕ.𝟎} {𝟎-sign i} j = 𝟏
[+]ₗ-of-step {➖} {signed ➕ ℕ.𝟎} {𝟎-sign i} j = −𝟏
[+]ₗ-of-step {➖} {signed ➖ ℕ.𝟎} {𝟎-sign i} j = −𝟏
[+]ₗ-of-step {➕} {signed ➕ (ℕ.𝐒 n)} {𝟎-sign i} j = +ₙ (ℕ.𝐒(ℕ.𝐒 n))
[+]ₗ-of-step {➕} {signed ➖ (ℕ.𝐒 n)} {𝟎-sign i} j = −ₙ n
[+]ₗ-of-step {➖} {signed ➕ (ℕ.𝐒 n)} {𝟎-sign i} j = +ₙ n
[+]ₗ-of-step {➖} {signed ➖ (ℕ.𝐒 n)} {𝟎-sign i} j = −ₙ (ℕ.𝐒(ℕ.𝐒 n))
[+]ₗ-of-step {➕} {𝟎-sign i₁} {𝟎-sign i} j = 𝟏
[+]ₗ-of-step {➖} {𝟎-sign i₁} {𝟎-sign i} j = −𝟏

instance
  [−]-involution : Involution(−_)
  Involution.proof [−]-involution {signed s n} rewrite involution(Sign.−_) {s} = reflexivity(_≡_)
  Involution.proof [−]-involution {𝟎-sign i} = reflexivity(_≡_)

instance
  [+]-commutativity : Commutativity(_+_)
  Commutativity.proof [+]-commutativity {x}{y} = p{x}{y} where
    p : Names.Commutativity(_+_)
    ps : ∀{x}{s}{n} → (x + signed s (ℕ.𝐒 n) ≡ signed s (ℕ.𝐒 n) + x)
    ps {x}{s}{n} =
      (x + signed s (ℕ.𝐒 n))   🝖[ _≡_ ]-[ congruence₂ᵣ(_+_)(_) (𝐒-to-step{s}{n}) ]
      (x + step s(signed s n)) 🝖[ _≡_ ]-[ [+]ᵣ-of-step {s}{x}{signed s n} ]
      step s(x + signed s n)   🝖[ _≡_ ]-[ congruence₂ᵣ(step)(s) (p {x} {signed s n}) ]
      step s(signed s n + x)   🝖[ _≡_ ]-[ [+]ₗ-of-step {s}{signed s n}{x} ]-sym
      (step s(signed s n) + x) 🝖[ _≡_ ]-[ congruence₂ₗ(_+_)(x) (𝐒-to-step{s}{n}) ]-sym
      (signed s (ℕ.𝐒 n) + x)   🝖-end
    {-# INLINE ps #-}

    p {signed s₁ ℕ.𝟎}      {signed s₂ ℕ.𝟎}      = congruence₂(_+_) (𝟎-signs {s₁}{s₂}) (𝟎-signs {s₂}{s₁})
    p {signed s₁ ℕ.𝟎}      {signed s₂ (ℕ.𝐒 n₂)} = ps {signed s₁ ℕ.𝟎}{s₂}{n₂}
    p {signed s₁ (ℕ.𝐒 n₁)} {signed s₂ ℕ.𝟎}      = symmetry(_≡_) (ps {signed s₂ ℕ.𝟎}{s₁}{n₁})
    p {signed s₁ (ℕ.𝐒 n₁)} {signed s₂ (ℕ.𝐒 n₂)} = ps {signed s₁ (ℕ.𝐒 n₁)}{s₂}{n₂}
    p {signed ➕ ℕ.𝟎}     {𝟎-sign i}          j = 𝟎-sign (Interval.max i (Interval.flip j))
    p {signed ➖ ℕ.𝟎}     {𝟎-sign i}          j = 𝟎-sign (Interval.min i j)
    p {signed ➕ (ℕ.𝐒 n)} {𝟎-sign i}          j = {!!}
    p {signed ➖ (ℕ.𝐒 n)} {𝟎-sign i}          j = {!!}
    p {𝟎-sign i}          {signed ➕ ℕ.𝟎}     j = 𝟎-sign (Interval.max i j)
    p {𝟎-sign i}          {signed ➖ ℕ.𝟎}     j = 𝟎-sign (Interval.min i (Interval.flip j))
    p {𝟎-sign i}          {signed ➕ (ℕ.𝐒 n)} j = {!!}
    p {𝟎-sign i}          {signed ➖ (ℕ.𝐒 n)} j = {!!}
    p {𝟎-sign i}          {𝟎-sign j}          k = {!!}

instance
  [+]-identityᵣ : Identityᵣ(_+_)(𝟎)
  Identityᵣ.proof [+]-identityᵣ {signed _ _} = reflexivity(_≡_)
  Identityᵣ.proof [+]-identityᵣ {𝟎-sign i} = reflexivity(_≡_)

instance
  [+]-identityₗ : Identityₗ(_+_)(𝟎)
  Identityₗ.proof [+]-identityₗ {x} = commutativity(_+_) {𝟎}{x} 🝖 identityᵣ(_+_)(𝟎)

instance
  [+]-identity : Identity(_+_)(𝟎)
  [+]-identity = intro

open import Logic.IntroInstances

instance
  [+][−]-inverseFunctionᵣ : InverseFunctionᵣ(_+_)(−_)
  [+][−]-inverseFunctionᵣ = intro(\{x} → p{x}) where
    p : Names.InverseFunctionᵣ(_+_)(𝟎)(−_)
    p {signed ➕ ℕ.𝟎} = reflexivity(_≡_)
    p {signed ➖ ℕ.𝟎} = 𝟎-sign
    p {signed s (ℕ.𝐒 n)} =
      signed s (ℕ.𝐒 n) + (− signed s (ℕ.𝐒 n))                     🝖[ _≡_ ]-[]
      signed s (ℕ.𝐒 n) + signed (Sign.− s) (ℕ.𝐒 n)                🝖[ _≡_ ]-[ congruence₂(_+_) (𝐒-to-step {s} {n}) (𝐒-to-step {Sign.− s} {n}) ]
      step s (signed s n) + step (Sign.− s) (signed (Sign.− s) n) 🝖[ _≡_ ]-[ [+]ₗ-of-step {s}{signed s n}{step (Sign.− s) (signed (Sign.− s) n)} ]
      step s (signed s n + step (Sign.− s) (signed (Sign.− s) n)) 🝖[ _≡_ ]-[ congruence₂ᵣ(step)(s) ([+]ᵣ-of-step {Sign.− s}{signed s n}{signed (Sign.− s) n}) ]
      step s (step (Sign.− s) (signed s n + signed (Sign.− s) n)) 🝖[ _≡_ ]-[ step-inverses (Sign.[−]-no-fixpoints ∘ symmetry(Id)) ]
      signed s n + signed (Sign.− s) n                            🝖[ _≡_ ]-[]
      signed s n + (− signed s n)                                 🝖[ _≡_ ]-[ p{signed s n} ]
      𝟎                                                           🝖-end
    p {𝟎-sign i} j = 𝟎-sign (Interval.max i j)

instance
  [+][−]-inverseFunctionₗ : InverseFunctionₗ(_+_)(−_)
  InverseFunctionₗ.proof [+][−]-inverseFunctionₗ {x} = commutativity(_+_) {− x}{x} 🝖 inverseFunctionᵣ(_+_)(−_) {x}

instance
  [+][−]-inverseFunction : InverseFunction(_+_)(−_)
  [+][−]-inverseFunction = intro

instance
  [+]-associativity : Associativity(_+_)
  [+]-associativity = intro(\{x}{y}{z} → p{x}{y}{z}) where
    p : Names.Associativity(_+_)
    p {x} {y} {signed s ℕ.𝟎} = reflexivity(_≡_)
    p {x} {y} {signed s (ℕ.𝐒 z)} =
      (x + y) + signed s (ℕ.𝐒 z)    🝖[ _≡_ ]-[ congruence₂ᵣ(_+_)(x + y) (𝐒-to-step {s}{z}) ]
      (x + y) + step s (signed s z) 🝖[ _≡_ ]-[ [+]ᵣ-of-step {s}{x + y}{signed s z} ]
      step s ((x + y) + signed s z) 🝖[ _≡_ ]-[ congruence₂ᵣ(step)(s) (p{x}{y}{signed s z}) ]
      step s (x + (y + signed s z)) 🝖[ _≡_ ]-[ [+]ᵣ-of-step {s}{x}{y + signed s z} ]-sym
      x + step s (y + signed s z)   🝖[ _≡_ ]-[ congruence₂ᵣ(_+_)(x) ([+]ᵣ-of-step {s}{y}{signed s z}) ]-sym
      x + (y + step s (signed s z)) 🝖[ _≡_ ]-[ congruence₂ᵣ(_+_)(x) (congruence₂ᵣ(_+_)(y) (𝐒-to-step {s})) ]-sym
      x + (y + signed s (ℕ.𝐒 z))    🝖-end
    p {x} {y} {𝟎-sign i} = reflexivity(_≡_)

Stepᵣ-injective : ∀{s}{x y} → (step s x ≡ step s y) → (x ≡ y)
Stepᵣ-injective {s} {x} {y} p = symmetry(_≡_) (step-inverses Sign.[−]-no-fixpoints) 🝖 congruence₂ᵣ(step)(Sign.− s) p 🝖 step-inverses Sign.[−]-no-fixpoints

open import Numeral.Natural.Equiv.Path

instance
  absₙ-signed-inverses : ∀{s} → Inverseᵣ(absₙ)(signed s)
  Inverseᵣ.proof (absₙ-signed-inverses {➕}) = reflexivity(Path)
  Inverseᵣ.proof (absₙ-signed-inverses {➖}) = reflexivity(Path)

Signedᵣ-injective : ∀{s}{x y} → (signed s x ≡ signed s y) → (Id x y)
Signedᵣ-injective {s} p = ℕ-Path-to-Id (symmetry(Path) (inverseᵣ(absₙ)(signed s)) 🝖 congruence₁(absₙ) p 🝖 inverseᵣ(absₙ)(signed s))

ℤ-different-identities : ¬(𝟎 ≡ 𝟏)
ℤ-different-identities p with () ← Signedᵣ-injective p

open import Structure.Relator

instance
  postulate [⋅]-commutativity : Commutativity(_⋅_)
  {-Commutativity.proof [⋅]-commutativity {signed s₁ x} {signed s₂ y} = congruence₂(signed) (sub₂(Id)(Path) (commutativity ⦃ Id-equiv ⦄ (Sign._⨯_) {s₁}{s₂})) (sub₂(Id)(Path) (commutativity ⦃ Id-equiv ⦄ (ℕ._⋅_) {x}{y}))
  Commutativity.proof [⋅]-commutativity {signed ➕ x} {𝟎-sign i} j    = {!!}
  -- {!substitute₁(\expr → ((signed ➕ x) ⋅ expr) ≡ (expr ⋅ (signed ➕ x))) ? ?!}
  Commutativity.proof [⋅]-commutativity {signed ➖ x} {𝟎-sign i}    = {!sub₂(Id)(Path) ?!}
  Commutativity.proof [⋅]-commutativity {𝟎-sign i}    {signed s y}  = {!𝟎-sign i!}
  Commutativity.proof [⋅]-commutativity {𝟎-sign i}    {𝟎-sign i₁}   = {!!}-}
  {-Commutativity.proof [⋅]-commutativity {signed s₁ x} {signed s₂ y}
    rewrite commutativity ⦃ Id-equiv ⦄ (ℕ._⋅_) {x}{y}
    rewrite commutativity ⦃ Id-equiv ⦄ (Sign._⨯_) {s₁}{s₂}
    = reflexivity(Path)
  Commutativity.proof [⋅]-commutativity {signed ➕ x} {𝟎-sign i}    = {!substitute₁(\expr → ((signed ➕ x) ⋅ expr) ≡ (expr ⋅ (signed ➕ x))) ? ?!}
  Commutativity.proof [⋅]-commutativity {signed ➖ x} {𝟎-sign i}    = {!sub₂(Id)(Path) ?!}
  Commutativity.proof [⋅]-commutativity {𝟎-sign i}    {signed s y}  = {!𝟎-sign i!}
  Commutativity.proof [⋅]-commutativity {𝟎-sign i}    {𝟎-sign i₁}   = {!!}-}
-- (signed ➕ x) ⋅ -0 ≡ -0 ⋅ (signed ➕ x)
-- (signed ➕ x) ⋅ +0 ≡ +0 ⋅ (signed ➕ x)

instance
  postulate [⋅]-associativity : Associativity(_⋅_)

open import Numeral.Sign.Proofs
open import Structure.Operator

instance
  [⋅]-identityᵣ : Identityᵣ(_⋅_)(𝟏)
  Identityᵣ.proof [⋅]-identityᵣ {signed s x} rewrite identityᵣ(Sign._⨯_)(➕) {s} = {!!}
  -- rewrite identityᵣ(Sign._⨯_)(➕) {s} = {!!} -- reflexivity(Path) -- congruence₂ₗ(signed)(x) {!!}
  Identityᵣ.proof [⋅]-identityᵣ {𝟎-sign i} = {!!} -- reflexivity(Path)

instance
  [⋅]-identityₗ : Identityₗ(_⋅_)(𝟏)
  Identityₗ.proof [⋅]-identityₗ {signed s x} = {!!}
  -- rewrite identityₗ(Sign._⨯_)(➕) {s} = {!!} -- reflexivity(Path)
  Identityₗ.proof [⋅]-identityₗ {𝟎-sign i} = {!!} -- reflexivity(Path)

instance
  [⋅]-identity : Identity(_⋅_)(𝟏)
  [⋅]-identity = intro

instance
  postulate [⋅][+]-distributivityₗ : Distributivityₗ(_⋅_)(_+_)

instance
  postulate [⋅][+]-distributivityᵣ : Distributivityᵣ(_⋅_)(_+_)

open import Logic.Predicate
open import Structure.Operator.Field
open import Structure.Operator.Group
open import Structure.Operator.Monoid
open import Structure.Operator.Ring

instance
  [+]-monoid : Monoid(_+_)
  Monoid.identity-existence [+]-monoid = [∃]-intro 𝟎

instance
  [+]-group : Group(_+_)
  Group.monoid            [+]-group = [+]-monoid
  Group.inverse-existence [+]-group = [∃]-intro (−_) ⦃ [+][−]-inverseFunction ⦄

instance
  [+]-commutativeGroup : CommutativeGroup(_+_)
  [+]-commutativeGroup = intro

instance
  [⋅]-monoid : Monoid(_⋅_)
  Monoid.identity-existence [⋅]-monoid = [∃]-intro 𝟏

instance
  [⋅]-rng : Rng(_+_)(_⋅_)
  [⋅]-rng = intro

instance
  [⋅]-unity : Unity(_+_)(_⋅_)
  Unity.[⋅]-identity-existence [⋅]-unity = [∃]-intro 𝟏

instance
  [⋅]-ring : Ring(_+_)(_⋅_)
  [⋅]-ring = intro

instance
  [⋅]-ringNonZero : Unity.DistinctIdentities [⋅]-unity
  Ring.NonZero.proof [⋅]-ringNonZero = ℤ-different-identities ∘ symmetry(_≡_)

open import Data
open import Data.Boolean
import      Data.Boolean.Operators
open        Data.Boolean.Operators.Programming
open import Data.Boolean.Stmt
open import Functional
import      Numeral.Natural.Oper.Comparisons as ℕ
import      Numeral.Natural.Oper.Comparisons.Proofs as ℕ

test : (−|+) → (−|+) → (ℕ → ℕ → Bool)
test ➕ ➕ = (ℕ._≤?_)
test ➕ ➖ = ((_&&_) on₂ ((!) ∘ ℕ.positive?))
test ➖ ➕ = (const ∘ const) 𝑇
test ➖ ➖ = (ℕ._≥?_)

_≤_ : ℤ → ℤ → Type{Lvl.𝟎}
signed s₁ x ≤ signed s₂ y = IsTrue(test s₁ s₂ x y)
signed ➕ ℕ.𝟎     ≤ 𝟎-sign _ = ⊤
signed ➕ (ℕ.𝐒 x) ≤ 𝟎-sign _ = ⊥
signed ➖ _       ≤ 𝟎-sign _ = ⊤
𝟎-sign _ ≤ signed ➕ _       = ⊤
𝟎-sign _ ≤ signed ➖ ℕ.𝟎     = ⊤
𝟎-sign _ ≤ signed ➖ (ℕ.𝐒 y) = ⊥
𝟎-sign _ ≤ 𝟎-sign _ = ⊤

{-data _≤_ : ℤ → ℤ → Type{Lvl.𝟎} where
  neg : ∀{x y} → (x ℕ.≥ y) → ((signed ➖ x) ≤ (signed ➖ y))
  mix : ∀{x y} → ((signed ➖ x) ≤ (signed ➕ y))
  pos : ∀{x y} → (x ℕ.≤ y) → ((signed ➕ x) ≤ (signed ➕ y))
-}

instance
  [≤]-reflexivity : Reflexivity(_≤_)
  Reflexivity.proof [≤]-reflexivity {signed ➕ ℕ.𝟎} = <>
  Reflexivity.proof [≤]-reflexivity {signed ➕ (ℕ.𝐒 x)} = ℕ.[≤?]-reflexivity {x}
  Reflexivity.proof [≤]-reflexivity {signed ➖ ℕ.𝟎} = <>
  Reflexivity.proof [≤]-reflexivity {signed ➖ (ℕ.𝐒 x)} = ℕ.[≤?]-reflexivity {x}
  Reflexivity.proof [≤]-reflexivity {𝟎-sign i} = <>

{-
instance
  [≤]-antisymmetry : Antisymmetry(_≤_)(_≡_)
  Antisymmetry.proof [≤]-antisymmetry {signed x x₁} {signed x₂ x₃} lt gt = ?
  Antisymmetry.proof [≤]-antisymmetry {signed x x₁} {𝟎-sign i} lt gt = ?
  Antisymmetry.proof [≤]-antisymmetry {𝟎-sign i} {signed x x₁} lt gt = ?
  Antisymmetry.proof [≤]-antisymmetry {𝟎-sign i} {𝟎-sign i₁} lt gt = ?
-}


{-# OPTIONS --safe #-}
module Cubical.Categories.Instances.CommRings where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Function

open import Cubical.Algebra.Ring
open import Cubical.Algebra.CommRing

open import Cubical.Categories.Category

open Category
open CommRingHoms

CommRingsCategory : ∀ {ℓ} → Category (ℓ-suc ℓ) ℓ
ob CommRingsCategory                     = CommRing _
Hom[_,_] CommRingsCategory               = CommRingHom
id CommRingsCategory {R}                 = idCommRingHom R
_⋆_ CommRingsCategory {R} {S} {T}        = compCommRingHom R S T
⋆IdL CommRingsCategory {R} {S}           = compIdCommRingHom {R = R} {S}
⋆IdR CommRingsCategory {R} {S}           = idCompCommRingHom {R = R} {S}
⋆Assoc CommRingsCategory {R} {S} {T} {U} = compAssocCommRingHom {R = R} {S} {T} {U}
isSetHom CommRingsCategory               = isSetRingHom _ _


module RedBlack where

open import Data.Nat

-- | The colour of a node.
data Color : Set where
  red   : Color
  black : Color

-- | The red black tree
data Tree  (A : Set) : ℕ       -- black height
                     → Color   -- color of the root
                     → Set
     where

  -- Empty node is always black
  empty :  Tree A 0 black

  -- Both the children of the red node are black.
  red   :  {d : ℕ}
        → Tree A d black  -- left child
        → A               -- element on the node
        → Tree A d black  -- right child
        → Tree A d red    -- The black height does not change

  -- The children can be of either color
  black : {d : ℕ} {cL cR : Color}
        → Tree A d       cL    -- left child
        → A                    -- element
        → Tree A d       cR    -- right child
        → Tree A (d + 1) black -- black height goes up by one.

-- Converts a tree with red root to a black tree. The type encodes the
-- fact that the height of the tree goes up by 1.
blacken : {A : Set} {d : ℕ}
        → Tree A d       red
        → Tree A (d + 1) black
blacken (red lt x rt) = black lt x rt


{-# OPTIONS --without-K --safe #-}

open import Categories.Category

-- Reasoning facilities about morphism equivalences (not necessarily 'squares')

module Categories.Morphism.Reasoning {o ℓ e} (C : Category o ℓ e) where

-- some items are defined in sub-modules
open import Categories.Morphism.Reasoning.Core C public
open import Categories.Morphism.Reasoning.Iso C public

open Category C
open Definitions C
open HomReasoning

-- create a commutative square from an equivalence
toSquare : ∀ {A B} {f g : A ⇒ B} → f ≈ g → CommutativeSquare f id id g
toSquare {_} {_} {f} {g} f≈g = begin
      id ∘ f   ≈⟨ identityˡ ⟩
      f        ≈⟨ f≈g ⟩
      g        ≈˘⟨ identityʳ ⟩
      g ∘ id   ∎