{-# OPTIONS --cubical --safe #-}
module Cubical.HITs.FiniteMultiset.Base where

open import Cubical.Foundations.Prelude
open import Cubical.HITs.SetTruncation
open import Cubical.Foundations.HLevels

private
  variable
    A : Type₀

infixr 5 _∷_

data FMSet (A : Type₀) : Type₀ where
  []    : FMSet A
  _∷_   : (x : A) → (xs : FMSet A) → FMSet A
  comm  : ∀ x y xs → x ∷ y ∷ xs ≡ y ∷ x ∷ xs
  trunc : isSet (FMSet A)

pattern [_] x = x ∷ []

module FMSetElim {ℓ} {B : FMSet A → Type ℓ}
  ([]* : B []) (_∷*_ : (x : A) {xs : FMSet A} → B xs → B (x ∷ xs))
  (comm* : (x y : A) {xs : FMSet A} (b : B xs)
         → PathP (λ i → B (comm x y xs i)) (x ∷* (y ∷* b)) (y ∷* (x ∷* b)))
  (trunc* : (xs : FMSet A) → isSet (B xs)) where

  f : (xs : FMSet A) → B xs
  f [] = []*
  f (x ∷ xs) = x ∷* f xs
  f (comm x y xs i) = comm* x y (f xs) i
  f (trunc xs zs p q i j) =
    isOfHLevel→isOfHLevelDep {n = 2} trunc*  (f xs) (f zs) (cong f p) (cong f q) (trunc xs zs p q) i j

module FMSetElimProp {ℓ} {B : FMSet A → Type ℓ} (BProp : {xs : FMSet A} → isProp (B xs))
  ([]* : B []) (_∷*_ : (x : A) {xs : FMSet A} → B xs → B (x ∷ xs)) where

  f : (xs : FMSet A) → B xs
  f = FMSetElim.f []* _∷*_
        (λ x y {xs} b →
          toPathP (BProp (transp (λ i → B (comm x y xs i)) i0 (x ∷* (y ∷* b))) (y ∷* (x ∷* b))))
        (λ xs → isProp→isSet BProp)

module FMSetRec {ℓ} {B : Type ℓ} (BType : isSet B)
  ([]* : B) (_∷*_ : A → B → B)
  (comm* : (x y : A) (b : B) → x ∷* (y ∷* b) ≡ y ∷* (x ∷* b)) where

  f : FMSet A → B
  f = FMSetElim.f []* (λ x b → x ∷* b) (λ x y b → comm* x y b) (λ _ → BType)


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

module Algebra.Construct.Free.Semilattice.Relation.Unary.Any.Dec where

open import Prelude hiding (⊥; ⊤)
open import Algebra.Construct.Free.Semilattice.Eliminators
open import Algebra.Construct.Free.Semilattice.Definition
open import Cubical.Foundations.HLevels
open import Data.Empty.UniversePolymorphic
open import HITs.PropositionalTruncation.Sugar
open import HITs.PropositionalTruncation.Properties
open import HITs.PropositionalTruncation
open import Data.Unit.UniversePolymorphic
open import Algebra.Construct.Free.Semilattice.Relation.Unary.Any.Def
open import Relation.Nullary
open import Relation.Nullary.Decidable
open import Relation.Nullary.Decidable.Properties
open import Relation.Nullary.Decidable.Logic

private
  variable p : Level

◇? : ∀ {P : A → Type p} → (∀ x → Dec (P x)) → (xs : 𝒦 A) → Dec (◇ P xs)
◇? {A = A} {P = P} P? = 𝒦-elim-prop (λ {xs} → isPropDec (isProp-◇ {P = P} {xs = xs})) (λ x xs → fn x xs (P? x)) (no (Poly⊥⇔Mono⊥ .fun))
  where
  fn : ∀ x xs → Dec (P x) → Dec (◇ P xs) → Dec (◇ P (x ∷ xs))
  fn x xs (yes Px) Pxs = yes ∣ inl Px ∣
  fn x xs (no ¬Px) (yes Pxs) = yes ∣ inr Pxs ∣
  fn x xs (no ¬Px) (no ¬Pxs) = no (refute-trunc (either′ ¬Px ¬Pxs))


{-# OPTIONS --without-K #-}
module HIT.Interval where

open import PathOperations
open import PathStructure.Id.Tr
open import Types

module I-Definition where
  private
    data #I : Set where
      #0 : #I
      #1 : #I

  I : Set
  I = #I

  0ᵢ : I
  0ᵢ = #0

  1ᵢ : I
  1ᵢ = #1

  postulate
    seg : 0ᵢ ≡ 1ᵢ

  I-ind : ∀ {p} (P : I → Set p)
    (x₀ : P 0ᵢ) (x₁ : P 1ᵢ) (p : tr P seg x₀ ≡ x₁) →
    ∀ i → P i
  I-ind P x₀ x₁ p #0 = x₀
  I-ind P x₀ x₁ p #1 = x₁

  postulate
    I-β-i : ∀ {p} (P : I → Set p)
      (x₀ : P 0ᵢ) (x₁ : P 1ᵢ)
      (p : tr P seg x₀ ≡ x₁) →
      apd (I-ind P x₀ x₁ p) seg ≡ p

  I-rec : ∀ {p} {P : Set p}
    (x₀ x₁ : P) (p : x₀ ≡ x₁)
    (i : I) → P
  I-rec x₀ x₁ p #0 = x₀
  I-rec x₀ x₁ p #1 = x₁

  postulate
    I-β-r : ∀ {p} {P : Set p}
      (x₀ x₁ : P) (p : x₀ ≡ x₁) →
      ap (I-rec x₀ x₁ p) seg ≡ p

open I-Definition public

from-path-space : ∀ {a} {A : Set a} →
  (Σ A λ x → Σ A λ y → x ≡ y) → I → A
from-path-space (x , y , p) = I-rec x y p

to-path-space : ∀ {a} {A : Set a} →
  (I → A) → Σ A λ x → Σ A λ y → x ≡ y
to-path-space f = f 0ᵢ , f 1ᵢ , ap f seg


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

syntax Lens | L

type
  S : 0-ary
  A : 0-ary

term
  get : S  ->  A
  put : S  A  ->  S

theory
  (PG) s : S  a : A   |> get (put (s, a))   = a
  (GP) s : S          |> put (s, get(s))    = s
  (PP) s : S  a b : A |> put (put(s, a), b) = put (s, a)
-}

module Lens.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 Lens.Signature
open import Lens.Syntax

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

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

infix 1 _▹_⊢_≋ₐ_

-- Axioms of equality
data _▹_⊢_≋ₐ_ : ∀ 𝔐 Γ {α} → (𝔐 ▷ L) α Γ → (𝔐 ▷ L) α Γ → Set where
  PG : ⁅ S ⁆ ⁅ A ⁆̣       ▹ ∅ ⊢   get (put 𝔞 𝔟) ≋ₐ 𝔟
  GP : ⁅ S ⁆̣             ▹ ∅ ⊢   put 𝔞 (get 𝔞) ≋ₐ 𝔞
  PP : ⁅ S ⁆ ⁅ A ⁆ ⁅ A ⁆̣ ▹ ∅ ⊢ put (put 𝔞 𝔟) 𝔠 ≋ₐ put 𝔞 𝔟

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


{-# OPTIONS --cubical --no-import-sorts --no-exact-split --safe #-}
module Cubical.Data.Nat.Order where

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

open import Cubical.Data.Empty as ⊥
open import Cubical.Data.Sigma
open import Cubical.Data.Sum as ⊎

open import Cubical.Data.Nat.Base
open import Cubical.Data.Nat.Properties

open import Cubical.Induction.WellFounded

open import Cubical.Relation.Nullary

infix 4 _≤_ _<_

_≤_ : ℕ → ℕ → Type₀
m ≤ n = Σ[ k ∈ ℕ ] k + m ≡ n

_<_ : ℕ → ℕ → Type₀
m < n = suc m ≤ n

data Trichotomy (m n : ℕ) : Type₀ where
  lt : m < n → Trichotomy m n
  eq : m ≡ n → Trichotomy m n
  gt : n < m → Trichotomy m n

private
  variable
    k l m n : ℕ

private
  witness-prop : ∀ j → isProp (j + m ≡ n)
  witness-prop {m} {n} j = isSetℕ (j + m) n

m≤n-isProp : isProp (m ≤ n)
m≤n-isProp {m} {n} (k , p) (l , q)
  = Σ≡Prop witness-prop lemma
  where
  lemma : k ≡ l
  lemma = inj-+m (p ∙ (sym q))

zero-≤ : 0 ≤ n
zero-≤ {n} = n , +-zero n

suc-≤-suc : m ≤ n → suc m ≤ suc n
suc-≤-suc (k , p) = k , (+-suc k _) ∙ (cong suc p)

≤-+k : m ≤ n → m + k ≤ n + k
≤-+k {m} {k = k} (i , p)
  = i , +-assoc i m k ∙ cong (_+ k) p

≤-k+ : m ≤ n → k + m ≤ k + n
≤-k+ {m} {n} {k}
  = subst (_≤ k + n) (+-comm m k)
  ∘ subst (m + k ≤_) (+-comm n k)
  ∘ ≤-+k

pred-≤-pred : suc m ≤ suc n → m ≤ n
pred-≤-pred (k , p) = k , injSuc ((sym (+-suc k _)) ∙ p)

≤-refl : m ≤ m
≤-refl = 0 , refl

≤-suc : m ≤ n → m ≤ suc n
≤-suc (k , p) = suc k , cong suc p

≤-predℕ : predℕ n ≤ n
≤-predℕ {zero} = ≤-refl
≤-predℕ {suc n} = ≤-suc ≤-refl

≤-trans : k ≤ m → m ≤ n → k ≤ n
≤-trans {k} {m} {n} (i , p) (j , q) = i + j , l2 ∙ (l1 ∙ q)
  where
  l1 : j + i + k ≡ j + m
  l1 = (sym (+-assoc j i k)) ∙ (cong (j +_) p)
  l2 : i + j + k ≡ j + i + k
  l2 = cong (_+ k) (+-comm i j)

≤-antisym : m ≤ n → n ≤ m → m ≡ n
≤-antisym {m} (i , p) (j , q) = (cong (_+ m) l3) ∙ p
  where
  l1 : j + i + m ≡ m
  l1 = (sym (+-assoc j i m)) ∙ ((cong (j +_) p) ∙ q)
  l2 : j + i ≡ 0
  l2 = m+n≡n→m≡0 l1
  l3 : 0 ≡ i
  l3 = sym (snd (m+n≡0→m≡0×n≡0 l2))

≤-k+-cancel : k + m ≤ k + n → m ≤ n
≤-k+-cancel {k} {m} (l , p) = l , inj-m+ (sub k m ∙ p)
 where
 sub : ∀ k m → k + (l + m) ≡ l + (k + m)
 sub k m = +-assoc k l m ∙ cong (_+ m) (+-comm k l) ∙ sym (+-assoc l k m)

≤-+k-cancel : m + k ≤ n + k → m ≤ n
≤-+k-cancel {m} {k} {n} (l , p) = l , cancelled
 where
 cancelled : l + m ≡ n
 cancelled = inj-+m (sym (+-assoc l m k) ∙ p)

≤-·k : m ≤ n → m · k ≤ n · k
≤-·k {m} {n} {k} (d , r) = d · k , reason where
  reason : d · k + m · k ≡ n · k
  reason = d · k + m · k ≡⟨ ·-distribʳ d m k ⟩
           (d + m) · k   ≡⟨ cong (_· k) r ⟩
           n · k         ∎

<-k+-cancel : k + m < k + n → m < n
<-k+-cancel {k} {m} {n} = ≤-k+-cancel ∘ subst (_≤ k + n) (sym (+-suc k m))

¬-<-zero : ¬ m < 0
¬-<-zero (k , p) = snotz ((sym (+-suc k _)) ∙ p)

¬m<m : ¬ m < m
¬m<m {m} = ¬-<-zero ∘ ≤-+k-cancel {k = m}

≤0→≡0 : n ≤ 0 → n ≡ 0
≤0→≡0 {zero} ineq = refl
≤0→≡0 {suc n} ineq = ⊥.rec (¬-<-zero ineq)

predℕ-≤-predℕ : m ≤ n → (predℕ m) ≤ (predℕ n)
predℕ-≤-predℕ {zero} {zero}   ineq = ≤-refl
predℕ-≤-predℕ {zero} {suc n}  ineq = zero-≤
predℕ-≤-predℕ {suc m} {zero}  ineq = ⊥.rec (¬-<-zero ineq)
predℕ-≤-predℕ {suc m} {suc n} ineq = pred-≤-pred ineq

¬m+n<m : ¬ m + n < m
¬m+n<m {m} {n} = ¬-<-zero ∘ <-k+-cancel ∘ subst (m + n <_) (sym (+-zero m))

<-weaken : m < n → m ≤ n
<-weaken (k , p) = suc k , sym (+-suc k _) ∙ p

≤<-trans : l ≤ m → m < n → l < n
≤<-trans p = ≤-trans (suc-≤-suc p)

<≤-trans : l < m → m ≤ n → l < n
<≤-trans = ≤-trans

<-trans : l < m → m < n → l < n
<-trans p = ≤<-trans (<-weaken p)

<-asym : m < n → ¬ n ≤ m
<-asym m<n = ¬m<m ∘ <≤-trans m<n

<-+k : m < n → m + k < n + k
<-+k p = ≤-+k p

<-k+ : m < n → k + m < k + n
<-k+ {m} {n} {k} p = subst (λ km → km ≤ k + n) (+-suc k m) (≤-k+ p)

<-·sk : m < n → m · suc k < n · suc k
<-·sk {m} {n} {k} (d , r) = (d · suc k + k) , reason where
  reason : (d · suc k + k) + suc (m · suc k) ≡ n · suc k
  reason = (d · suc k + k) + suc (m · suc k) ≡⟨ sym (+-assoc (d · suc k) k _) ⟩
           d · suc k + (k + suc (m · suc k)) ≡[ i ]⟨ d · suc k + +-suc k (m · suc k) i ⟩
           d · suc k + suc m · suc k         ≡⟨ ·-distribʳ d (suc m) (suc k) ⟩
           (d + suc m) · suc k               ≡⟨ cong (_· suc k) r ⟩
           n · suc k                         ∎

≤-∸-+-cancel : m ≤ n → (n ∸ m) + m ≡ n
≤-∸-+-cancel {zero} {n} _ = +-zero _
≤-∸-+-cancel {suc m} {zero} m≤n = ⊥.rec (¬-<-zero m≤n)
≤-∸-+-cancel {suc m} {suc n} m+1≤n+1 = +-suc _ _ ∙ cong suc (≤-∸-+-cancel (pred-≤-pred m+1≤n+1))

left-≤-max : m ≤ max m n
left-≤-max {zero} {n} = zero-≤
left-≤-max {suc m} {zero} = ≤-refl
left-≤-max {suc m} {suc n} = suc-≤-suc left-≤-max

right-≤-max : n ≤ max m n
right-≤-max {zero} {m} = zero-≤
right-≤-max {suc n} {zero} = ≤-refl
right-≤-max {suc n} {suc m} = suc-≤-suc right-≤-max

min-≤-left : min m n ≤ m
min-≤-left {zero} {n} = ≤-refl
min-≤-left {suc m} {zero} = zero-≤
min-≤-left {suc m} {suc n} = suc-≤-suc min-≤-left

min-≤-right : min m n ≤ n
min-≤-right {zero} {n} = zero-≤
min-≤-right {suc m} {zero} = ≤-refl
min-≤-right {suc m} {suc n} = suc-≤-suc min-≤-right

Trichotomy-suc : Trichotomy m n → Trichotomy (suc m) (suc n)
Trichotomy-suc (lt m<n) = lt (suc-≤-suc m<n)
Trichotomy-suc (eq m=n) = eq (cong suc m=n)
Trichotomy-suc (gt n<m) = gt (suc-≤-suc n<m)

_≟_ : ∀ m n → Trichotomy m n
zero ≟ zero = eq refl
zero ≟ suc n = lt (n , +-comm n 1)
suc m ≟ zero = gt (m , +-comm m 1)
suc m ≟ suc n = Trichotomy-suc (m ≟ n)

<-split : m < suc n → (m < n) ⊎ (m ≡ n)
<-split {n = zero} = inr ∘ snd ∘ m+n≡0→m≡0×n≡0 ∘ snd ∘ pred-≤-pred
<-split {zero} {suc n} = λ _ → inl (suc-≤-suc zero-≤)
<-split {suc m} {suc n} = ⊎.map suc-≤-suc (cong suc) ∘ <-split ∘ pred-≤-pred

private
  acc-suc : Acc _<_ n → Acc _<_ (suc n)
  acc-suc a
    = acc λ y y<sn
    → case <-split y<sn of λ
    { (inl y<n) → access a y y<n
    ; (inr y≡n) → subst _ (sym y≡n) a
    }

<-wellfounded : WellFounded _<_
<-wellfounded zero = acc λ _ → ⊥.rec ∘ ¬-<-zero
<-wellfounded (suc n) = acc-suc (<-wellfounded n)

<→≢ : n < m → ¬ n ≡ m
<→≢ {n} {m} p q = ¬m<m (subst (_< m) q p)

module _
    (b₀ : ℕ)
    (P : ℕ → Type₀)
    (base : ∀ n → n < suc b₀ → P n)
    (step : ∀ n → P n → P (suc b₀ + n))
  where
  open WFI (<-wellfounded)

  private
    dichotomy : ∀ b n → (n < b) ⊎ (Σ[ m ∈ ℕ ] n ≡ b + m)
    dichotomy b n
      = case n ≟ b return (λ _ → (n < b) ⊎ (Σ[ m ∈ ℕ ] n ≡ b + m)) of λ
      { (lt o) → inl o
      ; (eq p) → inr (0 , p ∙ sym (+-zero b))
      ; (gt (m , p)) → inr (suc m , sym p ∙ +-suc m b ∙ +-comm (suc m) b)
      }

    dichotomy<≡ : ∀ b n → (n<b : n < b) → dichotomy b n ≡ inl n<b
    dichotomy<≡ b n n<b
      = case dichotomy b n return (λ d → d ≡ inl n<b) of λ
      { (inl x) → cong inl (m≤n-isProp x n<b)
      ; (inr (m , p)) → ⊥.rec (<-asym n<b (m , sym (p ∙ +-comm b m)))
      }

    dichotomy+≡ : ∀ b m n → (p : n ≡ b + m) → dichotomy b n ≡ inr (m , p)
    dichotomy+≡ b m n p
      = case dichotomy b n return (λ d → d ≡ inr (m , p)) of λ
      { (inl n<b) → ⊥.rec (<-asym n<b (m , +-comm m b ∙ sym p))
      ; (inr (m' , q))
      → cong inr (Σ≡Prop (λ x → isSetℕ n (b + x)) (inj-m+ {m = b} (sym q ∙ p)))
      }

    b = suc b₀

    lemma₁ : ∀{x y z} → x ≡ suc z + y → y < x
    lemma₁ {y = y} {z} p = z , +-suc z y ∙ sym p

    subStep : (n : ℕ) → (∀ m → m < n → P m) → (n < b) ⊎ (Σ[ m ∈ ℕ ] n ≡ b + m) → P n
    subStep n _   (inl l) = base n l
    subStep n rec (inr (m , p))
      = transport (cong P (sym p)) (step m (rec m (lemma₁ p)))

    wfStep : (n : ℕ) → (∀ m → m < n → P m) → P n
    wfStep n rec = subStep n rec (dichotomy b n)

    wfStepLemma₀ : ∀ n (n<b : n < b) rec → wfStep n rec ≡ base n n<b
    wfStepLemma₀ n n<b rec = cong (subStep n rec) (dichotomy<≡ b n n<b)

    wfStepLemma₁ : ∀ n rec → wfStep (b + n) rec ≡ step n (rec n (lemma₁ refl))
    wfStepLemma₁ n rec
      = cong (subStep (b + n) rec) (dichotomy+≡ b n (b + n) refl)
      ∙ transportRefl _

  +induction : ∀ n → P n
  +induction = induction wfStep

  +inductionBase : ∀ n → (l : n < b) → +induction n ≡ base n l
  +inductionBase n l = induction-compute wfStep n ∙ wfStepLemma₀ n l _

  +inductionStep : ∀ n → +induction (b + n) ≡ step n (+induction n)
  +inductionStep n = induction-compute wfStep (b + n) ∙ wfStepLemma₁ n _

module <-Reasoning where
  -- TODO: would it be better to mirror the way it is done in the agda-stdlib?
  infixr 2 _<⟨_⟩_ _≤<⟨_⟩_ _≤⟨_⟩_ _<≤⟨_⟩_ _≡<⟨_⟩_ _≡≤⟨_⟩_ _<≡⟨_⟩_ _≤≡⟨_⟩_
  _<⟨_⟩_ : ∀ k → k < n → n < m → k < m
  _ <⟨ p ⟩ q = <-trans p q

  _≤<⟨_⟩_ : ∀ k → k ≤ n → n < m → k < m
  _ ≤<⟨ p ⟩ q = ≤<-trans p q

  _≤⟨_⟩_ : ∀ k → k ≤ n → n ≤ m → k ≤ m
  _ ≤⟨ p ⟩ q = ≤-trans p q

  _<≤⟨_⟩_ : ∀ k → k < n → n ≤ m → k < m
  _ <≤⟨ p ⟩ q = <≤-trans p q

  _≡≤⟨_⟩_ : ∀ k → k ≡ l → l ≤ m → k ≤ m
  _ ≡≤⟨ p ⟩ q = subst (λ k → k ≤ _) (sym p) q

  _≡<⟨_⟩_ : ∀ k → k ≡ l → l < m → k < m
  _ ≡<⟨ p ⟩ q = _ ≡≤⟨ cong suc p ⟩ q

  _≤≡⟨_⟩_ : ∀ k → k ≤ l → l ≡ m → k ≤ m
  _ ≤≡⟨ p ⟩ q = subst (λ l → _ ≤ l) q p

  _<≡⟨_⟩_ : ∀ k → k < l → l ≡ m → k < m
  _ <≡⟨ p ⟩ q = _ ≤≡⟨ p ⟩ q


-- Martin-Löf identity type without the K axiom
-- (we do not assume uniqueness of identity proofs).

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

module Tools.PropositionalEquality where

-- We reexport Agda's builtin equality type.

open import Agda.Builtin.Equality public using (_≡_; refl)
open import Tools.Empty

-- Inequality.

infix 4 _≢_

_≢_ : {A : Set} → A → A → Set
a ≢ b = a ≡ b → ⊥

-- Symmetry.

sym : {A : Set} {a b : A} → a ≡ b → b ≡ a
sym refl = refl

-- Transitivity.

trans : {A : Set} {a b c : A} → a ≡ b → b ≡ c → a ≡ c
trans refl refl = refl

-- Non-dependent congruence rules.

cong : {A B : Set} {a b : A} (f : A → B) → a ≡ b → f a ≡ f b
cong f refl = refl

cong₂ : ∀ {A B C : Set} {a a′ b b′}
        (f : A → B → C) → a ≡ a′ → b ≡ b′
      → f a b ≡ f a′ b′
cong₂ f refl refl = refl

cong₃ : ∀ {A B C D : Set} {a a′ b b′ c c′}
        (f : A → B → C → D) → a ≡ a′ → b ≡ b′ → c ≡ c′
      → f a b c ≡ f a′ b′ c′
cong₃ f refl refl refl = refl

cong₄ : ∀ {A B C D E : Set} {a a′ b b′ c c′ d d′}
        (f : A → B → C → D → E) → a ≡ a′ → b ≡ b′ → c ≡ c′ → d ≡ d′
      → f a b c d ≡ f a′ b′ c′ d′
cong₄ f refl refl refl refl = refl

-- Substitution (type-cast).

subst : {A : Set} {a b : A} {ℓ : Agda.Primitive.Level} (F : A → Set ℓ) → a ≡ b → F a → F b
subst F refl f = f

-- Two substitutions simultaneously.

subst₂ : ∀ {A B : Set} {a a′ b b′} {ℓ : Agda.Primitive.Level} (F : A → B → Set ℓ)
       → a ≡ a′ → b ≡ b′ → F a b → F a′ b′
subst₂ F refl refl f = f

-- Three substitutions simultaneously.

subst₃ : ∀ {A B C : Set} {a a′ b b′ c c′} (F : A → B → C → Set)
       → a ≡ a′ → b ≡ b′ → c ≡ c′ → F a b c → F a′ b′ c′
subst₃ F refl refl refl f = f


module nat-tests where

open import eq
open import nat
open import nat-division
open import nat-to-string
open import product

{- you can prove x + 0 ≡ x and 0 + x ≡ x without induction, if you
   use this more verbose definition of addition: -}
_+a_ : ℕ → ℕ → ℕ
0 +a 0 = 0
(suc x) +a 0 = (suc x)
0 +a (suc y) = (suc y)
(suc x) +a (suc y) = suc (suc (x +a y))

0+a : ∀ (x : ℕ) → x +a 0 ≡ x
0+a 0 = refl
0+a (suc y) = refl

+a0 : ∀ (x : ℕ) → 0 +a x ≡ x
+a0 0 = refl
+a0 (suc y) = refl

8-div-3-lem : (8 ÷ 3 !! refl) ≡ (2 , 2)
8-div-3-lem = refl

23-div-5-lem : (23 ÷ 5 !! refl) ≡ (4 , 3)
23-div-5-lem = refl

ℕ-to-string-lem : ℕ-to-string 237 ≡ "237"
ℕ-to-string-lem = refl


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

module HoTT.Identity.NaturalNumber where

private variable m n : ℕ

_=ℕ_ : ℕ → ℕ → 𝒰₀
zero =ℕ zero = 𝟏
zero =ℕ (succ _) = 𝟎
succ _ =ℕ zero = 𝟎
succ m =ℕ succ n = m =ℕ n

private
  r : (n : ℕ) → n =ℕ n
  r zero = ★
  r (succ n) = r n

=ℕ-elim : m == n → m =ℕ n
=ℕ-elim {m} p = transport (m =ℕ_) p (r m)

=ℕ-intro : m =ℕ n → m == n
=ℕ-intro {zero} {zero} _ = refl
=ℕ-intro {zero} {succ n} ()
=ℕ-intro {succ m} {zero} ()
=ℕ-intro {succ m} {succ n} = ap succ ∘ =ℕ-intro

=ℕ-equiv : {m n : ℕ} → m == n ≃ m =ℕ n
=ℕ-equiv {x} = f , qinv→isequiv (g , η , ε {x})
  where
  f = =ℕ-elim
  g = =ℕ-intro

  η : g ∘ f {m} {n} ~ id
  η {zero} refl = refl
  η {succ n} refl = ap (ap succ) (η refl)

  ε : f ∘ g {m} {n} ~ id
  ε {zero} {zero} ★ = refl
  ε {zero} {succ n} ()
  ε {succ m} {zero} ()
  ε {succ m} {succ n} p = transport-ap (succ m =ℕ_) succ (g p) (r m) ∙ ε {m} p


module Data.DependentWidthTree where

import      Lvl
open import Functional using (id)
open import Functional.Dependent
open import Numeral.Finite
open import Numeral.Natural
open import Type

private variable ℓ ℓᵢ ℓₗ ℓₙ ℓₒ : Lvl.Level
private variable N N₁ N₂ L T A B : Type{ℓ}

module _ {N : Type{ℓₙ}} (Index : N → Type{ℓᵢ}) where
  -- A tree where the number of children depends on the data stored in a node.
  -- Leaves should be represented by having nodes that indicate no children.
  -- Note: A tree that have no leaves will not be constructible.
  data Tree : Type{ℓₙ Lvl.⊔ ℓᵢ} where
    Node : (node : N) → (Index(node) → Tree) → Tree

  -- The data of the root node of a tree.
  root : Tree → N
  root (Node node _) = node

  -- The children of a node of a tree.
  -- They are indexed by `Index`.
  child : (t : Tree) → (Index(root t) → Tree)
  child (Node _ child) = child

  Tree-elim : ∀{P : Tree → Type{ℓ}} → (∀(node)(child) → (∀(i) → P(child(i))) → P(Node node child)) → ((tree : Tree) → P(tree))
  Tree-elim{P = P} f (Node node child) = f node child (Tree-elim{P = P} f ∘ child)

  open import Logic.Propositional
  -- It is impossible for every node to have at least one child while at the same time a tree exists.
  -- Note that constructively, this is not enough to prove the existence of leaves.
  Tree-no-leaves-impossibility : (∀{node} → Index(node)) → Tree → ⊥
  Tree-no-leaves-impossibility p (Node n c) = Tree-no-leaves-impossibility p (c(p{n}))

module _ {N : Type{ℓₙ}} (width : N → ℕ) where
  FiniteTree = Tree(𝕟 ∘ width)

module _ where
  open import Data.Boolean

  -- A tree of finite variating width holding no data other than the structure of the tree (the number of children for each node).
  -- Example:
  --   3:
  --   ├1:
  --   │└0
  --   ├2:
  --   │├0
  --   │└1:
  --   │ └0
  --   └0
  FiniteTreeStructure = FiniteTree id

  -- An empty tree contains no children.
  -- This is also functioning as a leaf to a tree.
  empty : FiniteTreeStructure
  empty = Node 0 \()

  -- A tree containing a single child that contains a leaf.
  singleton : FiniteTreeStructure
  singleton = Node 1 \{𝟎 → empty}

  isLeaf : FiniteTreeStructure → Bool
  isLeaf(Node 𝟎     _) = 𝑇
  isLeaf(Node (𝐒 _) _) = 𝐹

  isNode : FiniteTreeStructure → Bool
  isNode(Node 𝟎     _) = 𝐹
  isNode(Node (𝐒 _) _) = 𝑇

  import      Numeral.CoordinateVector as CoordinateVector
  open import Numeral.Natural.Function
  open import Numeral.Natural.Oper

  -- The height is the length of the longest path from the root node.
  -- Alternative implementation (will not pass the termination checker):
  --   height(Node 𝟎         child) = 𝟎
  --   height(Node (𝐒(node)) child) = 𝐒(CoordinateVector.foldᵣ(max ∘ height) 𝟎 child)
  height : FiniteTreeStructure → ℕ
  height = Tree-elim 𝕟 (\{𝟎 _ _ → 𝟎 ; (𝐒(c)) _ prev → 𝐒(CoordinateVector.foldᵣ max 𝟎 prev)})

  -- The size of a tree is the number of nodes in the tree.
  size : FiniteTreeStructure → ℕ
  size = Tree-elim 𝕟 (\{𝟎 _ _ → 𝟎 ; (𝐒(c)) _ prev → 𝐒(CoordinateVector.foldᵣ (_+_) 𝟎 prev)})


module Sublist where

open import Data.List
open import Data.List.All
open import Data.List.Any
open import Level
open import Relation.Binary.PropositionalEquality hiding ([_])
open import Function
open import Category.Monad
open import Data.Product

open import Membership-equality hiding (_⊆_; set)

infix 3 _⊆_

-- Sublist without re-ordering, to be improved later...
data _⊆_ {a}{A : Set a} : List A → List A → Set a where
  []   : ∀ {ys} → [] ⊆ ys
  keep : ∀ {x xs ys} → xs ⊆ ys → x ∷ xs ⊆ x ∷ ys
  skip : ∀ {x xs ys} → xs ⊆ ys → xs ⊆ x ∷ ys

singleton-⊆ : ∀ {a} {A : Set a} {x : A} {xs : List A} → x ∈ xs → [ x ] ⊆ xs
singleton-⊆ (here refl) = keep []
singleton-⊆ (there mem) = skip (singleton-⊆ mem)

reflexive-⊆ : ∀ {a} {A : Set a} {xs : List A} → xs ⊆ xs
reflexive-⊆ {xs = []} = []
reflexive-⊆ {xs = x ∷ xs} = keep reflexive-⊆

All-⊆ : ∀ {a p} {A : Set a} {P : A → Set p} {xs ys} → xs ⊆ ys → All P ys → All P xs
All-⊆ [] al = []
All-⊆ (keep inc) (px ∷ al) = px ∷ All-⊆ inc al
All-⊆ (skip inc) (px ∷ al) =  All-⊆ inc al


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

open import Categories.Category

module Categories.Category.Construction.Spans {o ℓ e} (𝒞 : Category o ℓ e) where

open import Level

open import Categories.Category.Diagram.Span 𝒞
open import Categories.Morphism.Reasoning 𝒞

open Category 𝒞
open HomReasoning
open Equiv

open Span
open Span⇒

Spans : Obj → Obj → Category (o ⊔ ℓ) (o ⊔ ℓ ⊔ e) e
Spans X Y = record
  { Obj = Span X Y
  ; _⇒_ = Span⇒
  ; _≈_ = λ f g → arr f ≈ arr g
  ; id = id-span⇒
  ; _∘_ = _∘ₛ_
  ; assoc = assoc
  ; sym-assoc = sym-assoc
  ; identityˡ = identityˡ
  ; identityʳ = identityʳ
  ; identity² = identity²
  ; equiv = record
    { refl = refl
    ; sym = sym
    ; trans = trans
    }
  ; ∘-resp-≈ = ∘-resp-≈
  }


-- ----------------------------------------------------------------------
-- The Agda σ-library
--
-- Renamings
-- ----------------------------------------------------------------------

-- A renaming is defined as a substitution ρ, mapping
-- indices to indices (w/ explicit bounds). It is a subclass
-- of substitutions.
--
-- The σ-library provides renamings as primitives.

module Sigma.Renaming.Base where

open import Data.Nat using (ℕ; suc; zero; _+_)
open import Data.Fin using (Fin; zero; suc)

open import Function as Fun using (_∘_)

open import Data.Product using (_×_; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)

open import Sigma.Subst.Base using (Sub; _∷_; []; _++_)

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

-- A renaming ρ : 𝕀ⁿ → 𝕀ᵐ is denoted { i ↦ j : i ∈ 𝕀ⁿ, j ∈ 𝕀ᵐ }
Ren : ℕ → ℕ → Set
Ren m n = Sub (Fin n) m

space : ∀ { m n } → Ren m n → ℕ × ℕ
space { m } { n } _ = ⟨ m , n ⟩

dom : ∀ { m n } → Ren m n → ℕ
dom = proj₁ ∘ space

rng : ∀ { m n } → Ren m n → ℕ
rng = proj₂ ∘ space

-- Identity renaming idₙ : 𝕀ⁿ → 𝕀ⁿ.
-- Defined by idₙ = { i ↦ i : i ∈ 𝕀ⁿ }.
id : ∀ { n } → Ren n n
id = Fun.id

-- Shift operator ↑ₙ : 𝕀ⁿ → 𝕀ⁿ⁺¹
-- Defined by ↑ₙ i = 1 + i
↑ : ∀ { n } → Ren n (1 + n)
↑ = suc

infix 10 _⇑

-- Lift operator ρ ⇑
-- Defined by ρ ⇑ = { 0 ↦ 0 } ∪ { ↑ i ↦ ↑ j : i ∈ 𝕀ⁿ, j ∈ 𝕀ᵐ }
-- This operator is used for defining a capture avoiding renaming.
--
-- For example in λ. e, free variables of e are now shifted:
--  e   :     0   1   2
--  λ e : 0   1   2   3
-- since λ binds 0.
_⇑ : ∀ { m n } → Ren m n → Ren (1 + m) (1 + n)
ρ ⇑ = zero ∷ ↑ ∘ ρ

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

-- Generalizing the above primitives to "multi-variable binders"
-- allows for formalization of binders that bind multiple variables,
-- such as patterns. So-called multi-variate binders.

-- Multi-variate identity idₙᵐ : 𝕀ᵐ → 𝕀ᵐ⁺ⁿ
-- Defined by idₙᵐ = { i ↦ i' : i ∈ 𝕀ᵐ, i' ∈ 𝕀ᵐ⁺ⁿ, i = i' }.
--
-- For example:
-- id✶ 1 = 0 ∷ []ₙ
-- id✶ 2 = 0 ∷ ↑ ∘ (0 ∷ []) = 0 ∷ 1 ∷ []ₙ
-- id✶ 3 = 0 ∷ ↑ ∘ id✶ 2 = 0 ∷ 1 ∷ 2 ∷ []ₙ
id✶ : ∀ { n } m → Ren m (m + n)
id✶ zero = []
id✶ (suc m) = zero ∷ ↑ ∘ id✶ m

-- Multi-variate shift operator ↑ₙᵐ : 𝕀ⁿ → 𝕀ᵐ⁺ⁿ
-- Defined by ↑ₙᵐ = { i ↦ m + i : i ∈ 𝕀ⁿ }
↑✶_ : ∀ { n } k → Ren n (k + n)
↑✶ zero = id
↑✶ suc k = ↑ ∘ ↑✶ k

-- Multi-variate lift operator ρ ⇑ᵏ
-- Defined by ρ ⇑ᵏ = { i ↦ i' } ∪ { ↑ᵏ i ↦ ↑ᵏ j : i ∈ 𝕀ⁿ, j ∈ 𝕀ᵐ }
-- This operator is used for defining a multi-variate capture avoiding renaming.
--
-- For example in λ. e, free variables of e are now shifted by k:
--  e   :         0   1       2       3
--  λ e : 0   ... k   k + 1   k + 2   k + 3
-- since λ binds 0, ..., k - 1.
_⇑✶_ :  ∀ { m n } → Ren m n → ∀ k → Ren (k + m) (k + n)
ρ ⇑✶ k = id✶ k ++ (↑✶ k ∘ ρ)


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

module Math.Combinatorics.IntegerFunction.Properties.Lemma where

open import Data.Integer
open import Data.Integer.Solver
open import Relation.Binary.PropositionalEquality

lemma₁ : ∀ a b c d → a * b * (c * d) ≡ (a * c) * (b * d)
lemma₁ = solve 4 (λ a b c d → a :* b :* (c :* d) := (a :* c) :* (b :* d) ) refl
  where open +-*-Solver

lemma₂ : ∀ n → n ≡ 1ℤ + (n - 1ℤ)
lemma₂ = solve 1 (λ n → n := con 1ℤ :+ (n :- con 1ℤ)) refl
  where open +-*-Solver

lemma₃ : ∀ m n → m ≡ n + (m - n)
lemma₃ = solve 2 (λ m n → m := n :+ (m :- n)) refl
  where open +-*-Solver


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

open import LogicalFormulae
open import Agda.Primitive using (Level; lzero; lsuc; _⊔_)
open import Functions.Definition
open import Setoids.Setoids
open import Setoids.Subset
open import Graphs.Definition
open import Sets.EquivalenceRelations

module Graphs.Complement {a b c : _} {V' : Set a} {V : Setoid {a} {b} V'} (G : Graph c V) where

open Graph G
open Setoid V
open Equivalence eq

complement : Graph (b ⊔ c) V
Graph._<->_ complement x y = ((x <-> y) → False) && ((x ∼ y) → False)
Graph.noSelfRelation complement x (pr1 ,, pr2) = pr2 reflexive
Graph.symmetric complement (x!-y ,, x!=y) = (λ pr → x!-y (Graph.symmetric G pr)) ,, λ pr → x!=y (Equivalence.symmetric eq pr)
Graph.wellDefined complement x=y r=s (x!-r ,, x!=r) = (λ y-s → x!-r (wellDefined (Equivalence.symmetric eq x=y) (Equivalence.symmetric eq r=s) y-s)) ,, λ y=s → x!=r (transitive x=y (transitive y=s (Equivalence.symmetric eq r=s)))


module Classes where

open import Agda.Primitive
open import Agda.Builtin.Equality
open import Relation.Binary.PropositionalEquality.Core

open ≡-Reasoning

id : ∀ {ℓ} {A : Set ℓ} → A → A
id x = x

_$_ : ∀ {ℓ} {A B : Set ℓ} → (A → B) → A → B
_$_ = id

_∘_ : ∀ {ℓ} {A B C : Set ℓ} → (B → C) → (A → B) → A → C
f ∘ g = λ x → f (g x)

record Functor {ℓ} (F : Set ℓ → Set ℓ) : Set (lsuc ℓ)  where
  field
    fmap : ∀ {A B} → (A → B) → F A → F B

    F-id : ∀ {A} → (a : F A) → fmap id a ≡ a
    F-∘ : ∀ {A B C} → (g : B → C) (f : A → B) (a : F A) → fmap (g ∘ f) a ≡ (fmap g ∘ fmap f) a

  _<$>_ : ∀ {A B} → (A → B) → F A → F B
  _<$>_ = fmap

  infixl 20 _<$>_

open Functor {{...}} public

record Applicative (F : Set → Set) : Set₁ where
  field
    {{funF}} : Functor F

    pure : {A : Set} → A → F A
    _<*>_ : {A B : Set} → F (A → B) → F A → F B

    A-id  : ∀ {A} → (v : F A) → pure id <*> v ≡ v
    A-∘   : ∀ {A B C} → (u : F (B →  C)) (v : F (A → B)) (w : F A) → pure _∘_ <*> u <*> v <*> w ≡ u <*> (v <*> w)
    A-hom : ∀ {A B} → (f : A → B) (x : A) → pure f <*> pure x ≡ pure (f x)
    A-ic  : ∀ {A B} → (u : F (A → B)) (y : A) → u <*> pure y ≡ pure (_$ y) <*> u

  infixl 20 _<*>_

open Applicative {{...}} public

postulate
  -- this is from parametricity: fmap is universal w.r.t. the functor laws
  appFun : ∀ {A B F} {{aF : Applicative F}} → (f : A → B) (x : F A) → pure f <*> x ≡ fmap f x

record Monad (F : Set → Set) : Set₁ where
  field
    {{appF}} : Applicative F
    _>>=_ : ∀ {A B} → F A → (A → F B) → F B

  return : ∀ {A} → A → F A
  return = pure

  _>=>_ : {A B C : Set} → (A → F B) → (B → F C) → A → F C
  f >=> g = λ a → f a >>= g

  infixl 10 _>>=_
  infixr 10 _>=>_

  field
    left-1  : ∀ {A B} → (a : A) (k : A → F B) → return a >>= k ≡ k a
    right-1 : ∀ {A} → (m : F A) → m >>= return ≡ m
    assoc : ∀ {A B C D} → (f : A → F B) (g : B → F C) (h : C → F D) (a : A) → (f >=> (g >=> h)) a ≡ ((f >=> g) >=> h) a

open Monad {{...}} public


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

open import LogicalFormulae
open import Groups.Definition
open import Setoids.Setoids
open import Sets.EquivalenceRelations
open import Rings.Definition

open import Agda.Primitive using (Level; lzero; lsuc; _⊔_)

module Rings.Subrings.Definition {a b : _} {A : Set a} {S : Setoid {a} {b} A} {_+A_ _*A_ : A → A → A} (R : Ring S _+A_ _*A_) where

open import Setoids.Subset S
open Ring R
open Group additiveGroup
open import Groups.Subgroups.Definition additiveGroup
open Setoid S
open Equivalence eq

record Subring {c : _} (pred : A → Set c) : Set (a ⊔ b ⊔ c) where
  field
    isSubgroup : Subgroup pred
    containsOne : pred 1R
    closedUnderProduct : {x y : A} → pred x → pred y → pred (x *A y)
  isSubset = Subgroup.isSubset isSubgroup

subringMult : {c : _} {pred : A → Set c} → (s : Subring pred) → Sg A pred → Sg A pred → Sg A pred
subringMult s (a , prA) (b , prB) = (a *A b) , Subring.closedUnderProduct s prA prB

subringIsRing : {c : _} {pred : A → Set c} → (subring : Subring pred) → Ring (subsetSetoid (Subring.isSubset subring)) (subgroupOp (Subring.isSubgroup subring)) (subringMult subring)
Ring.additiveGroup (subringIsRing sub) = subgroupIsGroup (Subring.isSubgroup sub)
Ring.*WellDefined (subringIsRing sub) {r , prR} {s , prS} {t , prT} {u , prU} r=t s=u = *WellDefined r=t s=u
Ring.1R (subringIsRing sub) = (1R , Subring.containsOne sub)
Ring.groupIsAbelian (subringIsRing sub) {a , prA} {b , prB} = groupIsAbelian
Ring.*Associative (subringIsRing sub) {a , prA} {b , prB} {c , prC} = *Associative
Ring.*Commutative (subringIsRing sub) {a , prA} {b , prB} = *Commutative
Ring.*DistributesOver+ (subringIsRing sub) {a , prA} {b , prB} {c , prC} = *DistributesOver+
Ring.identIsIdent (subringIsRing sub) {a , prA} = identIsIdent


module prelude where

Subset : Set → Set₁
Subset(X) = X → Set

_∈_ : ∀ {X} → X → Subset(X) → Set
(x ∈ A) = A(x)

_⊆_ : ∀ {X} → Subset(X) → Subset(X) → Set
(A ⊆ B) = ∀ x → (x ∈ A) → (x ∈ B)

record Inhabited {X} (S : Subset(X)) : Set where
  constructor _,_
  field witness : X
  field witness-in : (witness ∈ S)

Rel : Set → Set₁
Rel(X) = X → X → Set

data ℕ : Set where
  zero : ℕ
  succ : ℕ → ℕ

data ℤ : Set where
  succ : ℕ → ℤ
  -ve : ℕ → ℤ

+ve : ℕ → ℤ
+ve zero = -ve zero
+ve (succ n) = (succ n)

sucz : ℤ → ℤ
sucz (succ x) = succ (succ x)
sucz (-ve zero) = succ zero
sucz (-ve (succ x)) = -ve x

pred : ℤ → ℤ
pred (succ zero) = -ve zero
pred (succ (succ x)) = succ x
pred (-ve x) = -ve (succ x)

_+_ : ℤ → ℤ → ℤ
succ zero + y = sucz y
succ (succ x) + y = sucz (succ x + y)
-ve zero + y = y
-ve (succ x) + y = pred (-ve x + y)

data _^_ (X : Set) : ℕ → Set where
  nil : (X ^ zero)
  _∷_ : ∀ {n} → X → (X ^ n) → (X ^ succ(n))

data _≡_ {D : Set} (d : D) : D → Set where
  refl : (d ≡ d)

sym : ∀ {D} {d e : D} → (d ≡ e) → (e ≡ d)
sym refl = refl

trans : ∀ {D} {d e f : D} → (d ≡ e) → (e ≡ f) → (d ≡ f)
trans refl refl = refl

subst : ∀ {X L R} (P : X → Set) → (L ≡ R) → (P R) → (P L)
subst P refl p = p

data _≣_ {X : Set₁} (x : X) : X → Set₁ where
  REFL : (x ≣ x)

SYM : ∀ {D} {d e : D} → (d ≣ e) → (e ≣ d)
SYM REFL = REFL

TRANS : ∀ {D} {d e f : D} → (d ≣ e) → (e ≣ f) → (d ≣ f)
TRANS REFL REFL = REFL

SUBST : ∀ {X L R} (P : X → Set) →
  (L ≣ R) →
  (P R) →
  (P L)
SUBST P REFL p = p

succ-dist-+ : ∀ m n → ((succ m + n) ≡ sucz (+ve m + n))
succ-dist-+ zero     n = refl
succ-dist-+ (succ m) n = refl

record ⊤ : Set where
  constructor tt

data ⊥ : Set where

¬ : Set → Set
¬(X) = (X → ⊥)

contradiction : ∀ {X : Set} → ⊥ → X
contradiction ()

data _∨_ (X Y : Set) : Set where
  in₁ : X → (X ∨ Y)
  in₂ : Y → (X ∨ Y)

_∪_ : ∀ {X} → Subset(X) → Subset(X) → Subset(X)
(A ∪ B) x = (x ∈ A) ∨ (x ∈ B)

record _∧_ (X Y : Set) : Set where
  constructor _,_
  field proj₁ : X
  field proj₂ : Y

_∩_ : ∀ {X} → Subset(X) → Subset(X) → Subset(X)
(A ∩ B) x = (x ∈ A) ∧ (x ∈ B)

All : ∀ {X n} → Subset(X) → Subset(X ^ n)
All(S) nil = ⊤
All(S) (x ∷ xs) = (x ∈ S) ∧ (xs ∈ All(S))

All-resp-⊆ : ∀ {X} {A B : Subset(X)} {n} → (A ⊆ B) → (All {n = n} (A) ⊆ All(B))
All-resp-⊆ A⊆B nil tt = tt
All-resp-⊆ A⊆B (x ∷ xs) (x∈A , xs∈A) = (A⊆B x x∈A , All-resp-⊆ A⊆B xs xs∈A)

All-resp-∩ : ∀ {X} {A B : Subset(X)} {n} → ((All {n = n} (A) ∩ All(B)) ⊆ All(A ∩ B))
All-resp-∩ nil (tt , tt) = tt
All-resp-∩ (d ∷ ds) ((d∈A , ds∈A) , (d∈B , ds∈B)) = ((d∈A , d∈B) , (All-resp-∩ ds (ds∈A , ds∈B)))

record DirectedGraph(D : Set) : Set₁ where

  field _⇒_ : Rel(D)

  data _⇒+_ (d e : D) : Set where
    ⇒-impl-⇒+ : (d ⇒ e) → (d ⇒+ e)
    ⇒⇒+-impl-⇒+ : ∀ {f} → (d ⇒ f) → (f ⇒+ e) → (d ⇒+ e)

record Forest(D : Set) : Set₁ where

  field DG : DirectedGraph(D)
  open DirectedGraph DG public

  field ⇒-parent-uniq : ∀ {d e f} → (d ⇒ f) → (e ⇒ f) → (d ≡ e)
  field ⇒-acyclic : ∀ {d} → (d ⇒+ d) → ⊥

record PartialOrder(D : Set) : Set₁ where

  field _≤_ : Rel(D)
  field ≤-refl : ∀ {d} → (d ≤ d)
  field ≤-trans : ∀ {d e f} → (d ≤ e) → (e ≤ f) → (d ≤ f)
  field ≤-asym : ∀ {d e} → (d ≤ e) → (e ≤ d) → (d ≡ e)

  field _≤?_ : ∀ d e → ((d ≤ e) ∨ ¬(d ≤ e))

  _<_ : Rel(D)
  d < e = (d ≤ e) ∧ ¬(d ≡ e)

  ≡-impl-≤ : ∀ {d e} → (d ≡ e) → (d ≤ e)
  ≡-impl-≤ refl = ≤-refl

  <-trans-≤ : ∀ {d e f} → (d < e) → (e ≤ f) → (d < f)
  <-trans-≤ (d≤e , d≠e) e≤f = (≤-trans d≤e e≤f , (λ d≡f → d≠e (trans d≡f (≤-asym (≤-trans (≡-impl-≤ (sym d≡f)) d≤e) e≤f))))

  ≤-trans-< : ∀ {d e f} → (d ≤ e) → (e < f) → (d < f)
  ≤-trans-< d≤e (e≤f , e≠f) = (≤-trans d≤e e≤f , (λ d≡f → e≠f (trans (≤-asym (≤-trans e≤f (≡-impl-≤ (sym d≡f))) d≤e) d≡f)))

  <-trans : ∀ {d e f} → (d < e) → (e < f) → (d < f)
  <-trans d<e (e≤f , e≠f) = <-trans-≤ d<e e≤f

  <-impl-≤ : ∀ {d e} → (d < e) → (d ≤ e)
  <-impl-≤ (d≤e , d≠e) = d≤e

  <-impl-≱ : ∀ {d e} → (d < e) → ¬(e ≤ d)
  <-impl-≱ (d≤e , d≠e) e≤d = d≠e (≤-asym d≤e e≤d)

  Past : D → Subset(D)
  Past(d) e = (e < d)

  Future : D → Subset(D)
  Future(d) e = (d < e)

  Decreasing : ∀ {n} → Subset(D ^ n)
  Decreasing nil = ⊤
  Decreasing (d ∷ ds) = (ds ∈ (All(Past(d)) ∩  Decreasing))

  Increasing : ∀ {n} → Subset(D ^ n)
  Increasing nil = ⊤
  Increasing (d ∷ ds) = (ds ∈ (All(Future(d)) ∩  Increasing))

  _≤*_ : ∀ {n} → Rel(D ^ n)
  nil ≤* nil = ⊤
  (d ∷ ds) ≤* (e ∷ es) = (d ≤ e) ∧ (ds ≤* es)

  Min : Subset(D) → Subset(D)
  Min(S) d = (d ∈ S) ∧ (∀ e → (e ∈ S) → (d ≤ e))

  Max : Subset(D) → Subset(D)
  Max(S) d = (d ∈ S) ∧ (∀ e → (e ∈ S) → (e ≤ d))

  Min* : ∀ {n} → Subset(D ^ n) → Subset(D ^ n)
  Min*(S) ds = (ds ∈ S) ∧ (∀ es → (es ∈ S) → (ds ≤* es))

  Max* : ∀ {n} → Subset(D ^ n) → Subset(D ^ n)
  Max*(S) ds = (ds ∈ S) ∧ (∀ es → (es ∈ S) → (es ≤* ds))

record FiniteTotalOrder(D : Set) : Set₁ where

  field PO : PartialOrder(D)
  open PartialOrder PO public

  field min_∵_ : ∀ (S : Subset(D)) → Inhabited(S) → Inhabited(Min(S))
  field max_∵_ : ∀ (S : Subset(D)) → Inhabited(S) → Inhabited(Max(S))

  ≤-total : ∀ d e → (d ≤ e) ∨ (e < d)
  ≤-total d e with d ≤? e
  ≤-total d e | in₁ d≤e = in₁ d≤e
  ≤-total d e | in₂ d≰e with max (λ f → (d ≡ f) ∨ (e ≡ f)) ∵ (d , in₁ refl)
  ≤-total d e | in₂ d≰e | .d , (in₁ refl , d-max) = in₂ (e≤d , e≠d) where

    e≤d = d-max e (in₂ refl)
    e≠d = λ e=d → d≰e (≡-impl-≤ (sym e=d))

  ≤-total d e | in₂ d≰e | .e , (in₂ refl , e-max) = contradiction (d≰e (e-max d (in₁ refl)))

  Max-hd : ∀ S {n} d (ds : D ^ n) →
    ((d ∷ ds) ∈ Max*(Decreasing ∩ All(S))) →
    (d ∈ Max(S))
  Max-hd S d ds (((d>ds , ds↓) , (d∈S , ds∈S)) , d∷ds-max) = (d∈S , d-max) where

    d-max : ∀ e → (e ∈ S) → (e ≤ d)
    d-max e e∈S with ≤-total e d
    d-max e e∈S | in₁ e≤d = e≤d
    d-max e e∈S | in₂ d<e with d∷ds-max (e ∷ ds) ((All-resp-⊆ (λ f d<f → <-trans d<f d<e) ds d>ds , ds↓) , (e∈S , ds∈S))
    d-max e e∈S | in₂ d<e | (e≤d , ds≤ds) = e≤d

  Max-tl : ∀ S {n} d (ds : D ^ n) →
    ((d ∷ ds) ∈ Max*(Decreasing ∩ All(S))) →
    (ds ∈ Max*(All(Past(d)) ∩ (Decreasing ∩ All(S))))
  Max-tl S d ds (((d>ds , ds↓) , (d∈S , ds∈S)) , d∷ds-max) = ((d>ds , (ds↓ , ds∈S)) , ds-max) where

    ds-max : ∀ es → (es ∈ (All(Past(d)) ∩ (Decreasing ∩ All(S)))) → (es ≤* ds)
    ds-max es (d>es , (es↓ , es∈S)) with d∷ds-max (d ∷ es) ((d>es , es↓) , (d∈S , es∈S))
    ds-max es (d>es , (es↓ , es∈S)) | (d≤d , es≤ds) = es≤ds

record Equivalence(D : Set) : Set₁ where

  field _~_ : Rel(D)
  field ~-refl : ∀ {d} → (d ~ d)
  field ~-trans : ∀ {d e f} → (d ~ e) → (e ~ f) → (d ~ f)
  field ~-sym : ∀ {d e} → (d ~ e) → (e ~ d)

  field _~?_ : ∀ d e → ((d ~ e) ∨ ¬(d ~ e))

  ≡-impl-~ : ∀ {d e} → (d ≡ e) → (d ~ e)
  ≡-impl-~ refl = ~-refl


-- Andreas, 2017-01-12, issue #2386

open import Agda.Primitive

data _≡_ {a b} {A : Set (a ⊔ b)} : (x y : A) → Set where
  refl : (x : A) → x ≡ x

{-# BUILTIN EQUALITY _≡_ #-}

-- Should be accepted

-- The type of primTrustMe has to match the flavor of EQUALITY

primitive primTrustMe : ∀ {a b}{A : Set _} {x y : A} → x ≡ y

testTM : ∀{A : Set} {a : A} → primTrustMe {x = a} {y = a} ≡ refl _
testTM = refl _

-- Testing rewrite

subst : ∀{ℓ}{A : Set ℓ} {P : A → Set}{a b : A} → _≡_ {a = ℓ} {b = ℓ} a b → P a → P b
subst eq p rewrite eq = p


open import Agda.Primitive
open import Agda.Builtin.Sigma

variable
  ℓ₁ ℓ₂ : Level

is-universal-element : {X : Set ℓ₁} {A : X → Set ℓ₂} → Σ X A → Set (ℓ₁ ⊔ ℓ₂)
is-universal-element {ℓ₁} {ℓ₂} {X} {A} (x , a) = ∀ y → A y

fails : {X : Set ℓ₁} {A : X → Set ℓ₂} (x : X) (a : A x)
      → is-universal-element {A = _} (x , a) → (y : X) → A y -- a is yellow
fails {ℓ₁} {ℓ₂} {X = X} {A} x a u y = u y

works : ∀ {ℓ₁} {ℓ₂} {X : Set ℓ₁} {A : X → Set ℓ₂} (x : X) (a : A x)
      → is-universal-element {A = _} (x , a) → (y : X) → A y
works x a u y = u y


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

-- The Category of Algebraic Kan Complexes
module Categories.Category.Instance.KanComplexes where

open import Level

open import Function using (_$_)
open import Data.Product using (Σ; _,_; proj₁)

open import Categories.Category
open import Categories.Category.SubCategory
open import Categories.Category.Construction.KanComplex
open import Categories.Category.Instance.SimplicialSet

import Categories.Category.Instance.SimplicialSet.Properties as ΔSetₚ

import Categories.Morphism.Reasoning as MR

module _ (o ℓ : Level) where
  open Category (SimplicialSet o ℓ)
  open ΔSetₚ o ℓ
  open IsKanComplex
  open Equiv
  open MR (SimplicialSet o ℓ)

  -- As we are working with Algebraic Kan Complexes, maps between two Kan Complexes ought
  -- to take the chosen filler in 'X' to the chosen filler in 'Y'.
  PreservesFiller : ∀ {X Y : ΔSet} → IsKanComplex o ℓ X → IsKanComplex o ℓ Y → (X ⇒ Y) → Set (o ⊔ ℓ)
  PreservesFiller {X} {Y} X-Kan Y-Kan f = ∀ {n} {k} → (i : Λ[ n , k ] ⇒ X) → (f ∘ filler X-Kan {n} i) ≈ filler Y-Kan (f ∘ i)

  KanComplexes : Category (suc o ⊔ suc ℓ) (o ⊔ ℓ ⊔ (o ⊔ ℓ)) (o ⊔ ℓ)
  KanComplexes = SubCategory (SimplicialSet o ℓ) {I = Σ ΔSet (IsKanComplex o ℓ)} $ record
    { U = proj₁
    ; R = λ { {_ , X-Kan} {_ , Y-Kan} f → PreservesFiller X-Kan Y-Kan f }
    ; Rid = λ { {_ , X-Kan} i → begin
        id ∘ filler X-Kan i   ≈⟨ identityˡ {f = filler X-Kan i} ⟩
        filler X-Kan i        ≈˘⟨ filler-cong X-Kan (identityˡ {f = i}) ⟩
        filler X-Kan (id ∘ i) ∎
      }
    ; _∘R_ = λ { {_ , X-Kan} {_ , Y-Kan} {_ , Z-Kan} {f} {g} f-preserves g-preserves i → begin
        (f ∘ g) ∘ filler X-Kan i ≈⟨ assoc {f = filler X-Kan i} {g = g} {h = f} ⟩
        f ∘ (g ∘ filler X-Kan i) ≈⟨ ∘-resp-≈ʳ {f = (g ∘ filler X-Kan i)} {h = filler Y-Kan (g ∘ i)} {g = f} (g-preserves i) ⟩
        f ∘ filler Y-Kan (g ∘ i) ≈⟨ f-preserves (g ∘ i) ⟩
        filler Z-Kan (f ∘ g ∘ i) ≈˘⟨ filler-cong Z-Kan (assoc {f = i} {g = g} {h = f}) ⟩
        filler Z-Kan ((f ∘ g) ∘ i) ∎
      }
    }
    where
      open HomReasoning


-- Qualified mixfix operators
module Issue597 where

open import Common.Prelude as Prel hiding (if_then_else_)
open import Common.Level using (lzero)

lz = lzero Common.Level.⊔ lzero

module A where

  data _×_ (A B : Set) : Set where
    _,_ : A → B → A × B

  if_then_else_ : ∀ {A : Set} → Bool → A → A → A
  if true  then x else y = x
  if false then x else y = y

  pattern _+2 n = suc (suc n)

  module B where

    _₁ : ∀ {A B} → A × B → A
    (x , y)₁ = x

    _₂ : ∀ {A B} → A × B → B
    (x , y)₂ = y

    syntax Exist (λ x → p) = ∃ x ∶ p
    data Exist {A : Set}(P : A → Set) : Set where
      _,_ : (x : A) → P x → Exist P

pp : Nat → Nat
pp 0 = 0
pp 1 = 0
pp (n A.+2) = n

infix 5 add_
add_ : Nat A.× Nat → Nat
add_ p = p A.B.₁ Prel.+ p A.B.₂

six : Nat
six = add 1 A., 5

two : Nat
two = A.if true then 2 else 4

data Even : Nat → Set where
  ez  : Even 0
  ess : ∀ n → Even n → Even (suc (suc n))

pair : A.B.∃ n ∶ Even n
pair = 2 A.B., ess zero ez


------------------------------------------------------------------------
-- The Agda standard library
--
-- Some defined operations (multiplication by natural number and
-- exponentiation)
------------------------------------------------------------------------

open import Algebra

module Algebra.Operations {s₁ s₂} (S : Semiring s₁ s₂) where

open Semiring S renaming (zero to *-zero)
open import Data.Nat
  using (zero; suc; ℕ) renaming (_+_ to _ℕ+_; _*_ to _ℕ*_)
open import Data.Product using (module Σ)
open import Function
open import Relation.Binary
open import Relation.Binary.PropositionalEquality as PropEq using (_≡_)
import Relation.Binary.EqReasoning as EqR
open EqR setoid

------------------------------------------------------------------------
-- Operations

-- Multiplication by natural number.

infixr 7 _×_

_×_ : ℕ → Carrier → Carrier
0     × x = 0#
suc n × x = x + n × x

-- A variant that includes a "redundant" case which ensures that 1 × y
-- is definitionally equal to y.

_×′_ : ℕ → Carrier → Carrier
0     ×′ x = 0#
1     ×′ x = x
suc n ×′ x = x + n ×′ x

-- Exponentiation.

infixr 8 _^_

_^_ : Carrier → ℕ → Carrier
x ^ zero  = 1#
x ^ suc n = x * x ^ n

------------------------------------------------------------------------
-- Some properties

-- Unfolding lemma for _×′_.

1+×′ : ∀ n x → suc n ×′ x ≈ x + n ×′ x
1+×′ 0 x = begin
  x       ≈⟨ sym $ Σ.proj₂ +-identity x ⟩
  x + 0#  ∎
1+×′ (suc n) x = begin
  x + suc n ×′ x  ≡⟨⟩
  x + suc n ×′ x  ∎

-- _×_ and _×′_ are extensionally equal (up to the setoid
-- equivalence).

×≈×′ : ∀ n x → n × x ≈ n ×′ x
×≈×′ 0       x = begin 0# ∎
×≈×′ (suc n) x = begin
  x + n × x   ≈⟨ +-cong refl (×≈×′ n x) ⟩
  x + n ×′ x  ≈⟨ sym $ 1+×′ n x ⟩
  suc n ×′ x  ∎

-- _×_ is homomorphic with respect to _ℕ+_/_+_.

×-homo-+ : ∀ c m n → (m ℕ+ n) × c ≈ m × c + n × c
×-homo-+ c 0 n = begin
  n × c       ≈⟨ sym $ Σ.proj₁ +-identity (n × c) ⟩
  0# + n × c  ∎
×-homo-+ c (suc m) n = begin
  c + (m ℕ+ n) × c     ≈⟨ +-cong refl (×-homo-+ c m n) ⟩
  c + (m × c + n × c)  ≈⟨ sym $ +-assoc c (m × c) (n × c) ⟩
  c + m × c + n × c    ∎

-- _×′_ is homomorphic with respect to _ℕ+_/_+_.

×′-homo-+ : ∀ c m n → (m ℕ+ n) ×′ c ≈ m ×′ c + n ×′ c
×′-homo-+ c m n = begin
  (m ℕ+ n) ×′ c    ≈⟨ sym $ ×≈×′ (m ℕ+ n) c ⟩
  (m ℕ+ n) ×  c    ≈⟨ ×-homo-+ c m n ⟩
  m ×  c + n ×  c  ≈⟨ +-cong (×≈×′ m c) (×≈×′ n c) ⟩
  m ×′ c + n ×′ c  ∎

-- _× 1# is homomorphic with respect to _ℕ*_/_*_.

×1-homo-* : ∀ m n → (m ℕ* n) × 1# ≈ (m × 1#) * (n × 1#)
×1-homo-* 0 n = begin
  0#             ≈⟨ sym $ Σ.proj₁ *-zero (n × 1#) ⟩
  0# * (n × 1#)  ∎
×1-homo-* (suc m) n = begin
  (n ℕ+ m ℕ* n) × 1#                   ≈⟨ ×-homo-+ 1# n (m ℕ* n) ⟩
  n × 1# + (m ℕ* n) × 1#               ≈⟨ +-cong refl (×1-homo-* m n) ⟩
  n × 1# + (m × 1#) * (n × 1#)         ≈⟨ sym $ +-cong (Σ.proj₁ *-identity (n × 1#)) refl ⟩
  1# * (n × 1#) + (m × 1#) * (n × 1#)  ≈⟨ sym $ Σ.proj₂ distrib (n × 1#) 1# (m × 1#) ⟩
  (1# + m × 1#) * (n × 1#)             ∎

-- _×′ 1# is homomorphic with respect to _ℕ*_/_*_.

×′1-homo-* : ∀ m n → (m ℕ* n) ×′ 1# ≈ (m ×′ 1#) * (n ×′ 1#)
×′1-homo-* m n = begin
  (m ℕ* n) ×′ 1#         ≈⟨ sym $ ×≈×′ (m ℕ* n) 1# ⟩
  (m ℕ* n) ×  1#         ≈⟨ ×1-homo-* m n ⟩
  (m ×  1#) * (n ×  1#)  ≈⟨ *-cong (×≈×′ m 1#) (×≈×′ n 1#) ⟩
  (m ×′ 1#) * (n ×′ 1#)  ∎

-- _×_ preserves equality.

×-cong : _×_ Preserves₂ _≡_ ⟶ _≈_ ⟶ _≈_
×-cong {n} {n′} {x} {x′} n≡n′ x≈x′ = begin
  n  × x   ≈⟨ reflexive $ PropEq.cong (λ n → n × x) n≡n′ ⟩
  n′ × x   ≈⟨ ×-congʳ n′ x≈x′ ⟩
  n′ × x′  ∎
  where
  ×-congʳ : ∀ n → (_×_ n) Preserves _≈_ ⟶ _≈_
  ×-congʳ 0       x≈x′ = refl
  ×-congʳ (suc n) x≈x′ = x≈x′ ⟨ +-cong ⟩ ×-congʳ n x≈x′

-- _×′_ preserves equality.

×′-cong : _×′_ Preserves₂ _≡_ ⟶ _≈_ ⟶ _≈_
×′-cong {n} {n′} {x} {x′} n≡n′ x≈x′ = begin
  n  ×′ x   ≈⟨ sym $ ×≈×′ n x ⟩
  n  ×  x   ≈⟨ ×-cong n≡n′ x≈x′ ⟩
  n′ ×  x′  ≈⟨ ×≈×′ n′ x′ ⟩
  n′ ×′ x′  ∎

-- _^_ preserves equality.

^-cong : _^_ Preserves₂ _≈_ ⟶ _≡_ ⟶ _≈_
^-cong {x} {x'} {n} {n'} x≈x' n≡n' = begin
  x  ^ n   ≈⟨ reflexive $ PropEq.cong (_^_ x) n≡n' ⟩
  x  ^ n'  ≈⟨ ^-congˡ n' x≈x' ⟩
  x' ^ n'  ∎
  where
  ^-congˡ : ∀ n → (λ x → x ^ n) Preserves _≈_ ⟶ _≈_
  ^-congˡ zero    x≈x' = refl
  ^-congˡ (suc n) x≈x' = x≈x' ⟨ *-cong ⟩ ^-congˡ n x≈x'


{-# OPTIONS --sized-types #-}
module SOList.Total {A : Set}(_≤_ : A → A → Set)  where

open import Bound.Total A
open import Bound.Total.Order _≤_
open import Data.List
open import Size

data SOList : {ι : Size} → Bound → Bound → Set where
  onil : {ι : Size}{b t : Bound}
                   → LeB b t
                   → SOList {↑ ι} b t
  ocons : {ι : Size}{b t : Bound}(x : A)
                   → SOList {ι} b (val x)
                   → SOList {ι} (val x) t
                   → SOList {↑ ι} b t

forget : {b t : Bound} → SOList b t → List A
forget (onil _) = []
forget (ocons x xs ys) = forget xs ++ (x ∷ forget ys)


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

open import Relation.Binary.PropositionalEquality using (_≡_; refl; sym; cong)
open import Relation.Nullary using (Dec; yes; no)

import Data.Product as Product
import Data.Sum as Sum
import Data.Nat as ℕ
import Data.Nat.Properties as ℕₚ

open Product using (∃-syntax; _,_)
open Sum using (inj₁)
open ℕ using (ℕ; _+_; zero; suc)

open import PiCalculus.LinearTypeSystem.Algebras
module PiCalculus.LinearTypeSystem.Algebras.Graded where

_≔_∙_ : ℕ → ℕ → ℕ → Set
x ≔ y ∙ z = x ≡ (y + z)

computeʳ : (x y : ℕ) → Dec (∃[ z ] (x ≔ y ∙ z))
computeʳ x y with y ℕₚ.≤″? x
computeʳ x y | yes (ℕ.less-than-or-equal proof) = yes (_ , (sym proof))
computeʳ x y | no ¬p = no λ where
  (_ , p) → ¬p (ℕ.less-than-or-equal (sym p))

Graded : Algebra ℕ
Algebra.0∙ Graded = 0
Algebra.1∙ Graded = 1
Algebra._≔_∙_ Graded = _≔_∙_
Algebra.∙-computeʳ Graded = computeʳ
Algebra.∙-unique Graded refl refl = refl
Algebra.∙-uniqueˡ Graded refl = ℕₚ.+-cancelʳ-≡ _ _
Algebra.0∙-minˡ Graded {zero} {zero} refl = refl
Algebra.∙-idˡ Graded = refl
Algebra.∙-comm Graded {y = y} refl = ℕₚ.+-comm y _
Algebra.∙-assoc Graded {z = z} {v = v} refl refl = v + z , (ℕₚ.+-assoc _ v z , refl)


module Open where

open import bool
open import nat
open import product
open import sum
open import functor

data Row : Set₁ where
  Empty : Row
  Ty : Set → Row
  Prod : Row → Row → Row

infixr 19 _♯_

_′ = Ty
_♯_ = Prod

all : Row → Set
all Empty = ⊤
all (Ty x) = x
all (Prod r₁ r₂) = (all r₁) × (all r₂)

one : Row → Set
one Empty = ⊥
one (Ty x) = x
one (Prod r₁ r₂) = (one r₁) ⊎ (one r₂)

_⊗_ : {A B : Row} → all A → all B → all (A ♯ B)
_⊗_ p₁ p₂ = p₁ , p₂

_&_ : {A : Set}{B : Row} → A → all B → all (A ′ ♯ B)
_&_ {A}{B} = _⊗_ {A ′}{B}

_⊕_ : {A B : Row} → (one A) ⊎ (one B) → one (A ♯ B)
_⊕_ p = p

⊕inj₁ : {A B : Row} → one A → one (A ♯ B)
⊕inj₁ = inj₁
⊕inj₂ : {A B : Row} → one B → one (A ♯ B)
⊕inj₂ = inj₂

inj : {A : Set}{B : Row} → A → one (A ′ ♯ B)
inj {A}{B} = ⊕inj₁ {A ′}{B}

test₁ : all (ℕ ′ ♯ 𝔹 ′ ♯ Empty)
test₁ = _&_ {ℕ}{𝔹 ′ ♯ Empty} 1 (_&_ {𝔹}{Empty} tt triv)


module Cats.Util.SetoidReasoning where

open import Relation.Binary.SetoidReasoning public

open import Relation.Binary using (Setoid)
open import Relation.Binary.EqReasoning as EqR using (_IsRelatedTo_)

infixr 2 _≡⟨⟩_

_≡⟨⟩_ : ∀ {c l} {S : Setoid  c l} → ∀ x {y} → _IsRelatedTo_ S x y → _IsRelatedTo_ S x y
_≡⟨⟩_ {S = S} = EqR._≡⟨⟩_ S

triangle : ∀ {l l′} (S : Setoid l l′) →
  let open Setoid S in
  ∀ m {x y}
  → x ≈ m
  → y ≈ m
  → x ≈ y
triangle S m x≈m y≈m = trans x≈m (sym y≈m)
  where
    open Setoid S


module Day2 where

open import Data.String as String
open import Data.Maybe
open import Foreign.Haskell using (Unit)
open import Data.List as List hiding (fromMaybe)
open import Data.Nat
open import Data.Nat.DivMod
import Data.Nat.Show as ℕs
open import Data.Char
open import Data.Vec as Vec renaming (_>>=_ to _VV=_ ; toList to VecToList)
open import Data.Product
open import Relation.Nullary
open import Data.Nat.Properties
open import Data.Bool.Base
open import AocIO
open import AocUtil
open import AocVec
import Data.Fin as Fin

natDiff : ℕ → ℕ → ℕ
natDiff zero y = y
natDiff x zero = x
natDiff (suc x) (suc y) = natDiff x y

fromMaybe :  ∀ {a} {A : Set a} → A → Maybe A → A
fromMaybe v (just x) = x
fromMaybe v nothing = v

find : ∀ {a} {A : Set a} → (A → Bool) → List A → Maybe A
find pred [] = nothing
find pred (x ∷ ls) with (pred x)
... | false = find pred ls
... | true = just x

dividesEvenly : ℕ → ℕ → Bool
dividesEvenly zero zero = true
dividesEvenly zero dividend = false
dividesEvenly (suc divisor) dividend with (dividend mod (suc divisor))
... | Fin.Fin.zero = true
... | Fin.Fin.suc p = false

oneDividesTheOther : ℕ → ℕ → Bool
oneDividesTheOther x y = dividesEvenly x y ∨ dividesEvenly y x

main2 : IO Unit
main2 = mainBuilder (readFileMain processFile)
  where
    parseLine : List Char → List ℕ
    parseLine ls with (words ls)
    ... | line-words = List.map unsafeParseNat line-words
    minMax : {n : ℕ} → Vec ℕ (suc n) → (ℕ × ℕ)
    minMax {0} (x ∷ []) = x , x
    minMax {suc _} (x ∷ ls) with (minMax ls)
    ... | min , max = (min ⊓ x) , (max ⊔ x)
    minMaxDiff : List ℕ → ℕ
    minMaxDiff ls = helper (Vec.fromList ls)
      where
        helper : {n : ℕ} → Vec ℕ n → ℕ
        helper [] = 0
        helper (x ∷ vec) with (minMax (x ∷ vec))
        ... | min , max = natDiff min max
    lineDiff : List Char → ℕ
    lineDiff s = minMaxDiff (parseLine s)
    processFile : String → IO Unit
    processFile file-content with (lines (String.toList file-content))
    ... | file-lines with (List.map lineDiff file-lines)
    ... | line-diffs = printString (ℕs.show (List.sum line-diffs))

main : IO Unit
main = mainBuilder (readFileMain processFile)
  where
    parseLine : List Char → List ℕ
    parseLine ls with (words ls)
    ... | line-words = List.map unsafeParseNat line-words
    pierreDiv : ℕ → ℕ → ℕ
    pierreDiv x y with (x ⊓ y) | (x ⊔ y)
    ... | 0 | _ = 0
    ... | _ | 0 = 0
    ... | (suc min) | (suc max) = (suc max) div (suc min)
    lineDivider : List ℕ → Maybe ℕ
    lineDivider [] = nothing
    lineDivider (x ∷ ln) with (find (oneDividesTheOther x) ln)
    ... | nothing = lineDivider ln
    ... | just y = just (pierreDiv x y)
    lineScore : List Char → ℕ
    lineScore s = fromMaybe 0 (lineDivider (parseLine s))
    processFile : String → IO Unit
    processFile file-content with (lines (String.toList file-content))
    ... | file-lines with (List.map lineScore file-lines)
    ... | line-scores = printString (ℕs.show (List.sum line-scores))


module Issue422 where

data Bool : Set where
  true false : Bool

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

foo : Bool → Bool → Bool
foo true  b    = b
foo n      true = true
foo false b    = false

good : foo false true ≡ true
good = refl

data Nat : Set where
  zero : Nat
  suc  : Nat → Nat

data T : Set where
  t₁ : Nat → T
  t₂ : Nat → Nat → T
  t₃ : Nat → Nat → Nat → T

bar : Nat → Nat → Nat → T
bar x  zero    z      = t₂ x z
bar x  y      (suc z) = t₃ x y z
bar x (suc y)  zero   = t₂ x y

postulate
  a b c : Nat

eqn₁ : bar a zero c ≡ t₂ a c
eqn₁ = refl

eqn₂ : bar a (suc b) (suc c) ≡ t₃ a (suc b) c
eqn₂ = refl

eqn₃ : bar a (suc b) zero ≡ t₂ a b
eqn₃ = refl


{-# OPTIONS --safe #-}
module Cubical.Algebra.CommSemiring.Base where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.SIP using (TypeWithStr)

open import Cubical.Algebra.CommMonoid
open import Cubical.Algebra.Monoid

private
  variable
    ℓ ℓ' : Level

record IsCommSemiring {R : Type ℓ}
                  (0r 1r : R) (_+_ _·_ : R → R → R) : Type ℓ where

  field
    +IsCommMonoid  : IsCommMonoid 0r _+_
    ·IsCommMonoid  : IsCommMonoid 1r _·_
    ·LDist+        : (x y z : R) → x · (y + z) ≡ (x · y) + (x · z)
    AnnihilL       : (x : R) → 0r · x ≡ 0r

  open IsCommMonoid +IsCommMonoid public
    renaming
      ( isSemigroup to +IsSemigroup
      ; isMonoid    to +IsMonoid)

  open IsCommMonoid ·IsCommMonoid public
    renaming
      ( isSemigroup to ·IsSemigroup
      ; isMonoid    to ·IsMonoid)
    hiding
      ( is-set ) -- We only want to export one proof of this

record CommSemiringStr (A : Type ℓ) : Type (ℓ-suc ℓ) where

  field
    0r      : A
    1r      : A
    _+_     : A → A → A
    _·_     : A → A → A
    isCommSemiring  : IsCommSemiring 0r 1r _+_ _·_

  infixl 7 _·_
  infixl 6 _+_

  open IsCommSemiring isCommSemiring public

CommSemiring : ∀ ℓ → Type (ℓ-suc ℓ)
CommSemiring ℓ = TypeWithStr ℓ CommSemiringStr


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

--
-- This module defines/proves some basic functions/theorem using only
-- the induction principle of the equality types the way they are done
-- in the HoTT book.  The functions defined/theorems proved in this
-- module is often exposed in a better way from the main equality
-- module, the word better means simpler definitions/proofs.  This
-- module is thus not meant for use in "production" hott.
--

module hott.core.equality.induction-proofs where

open import hott.core

-- The symmetry of ≡ defined in terms of the induction principle
sym : ∀{ℓ} {A : Type ℓ} {x y : A}
    → x ≡ y → y ≡ x
sym {ℓ} {A}  = induction≡ D d
  where
    D : {u v : A} → u ≡ v → Type ℓ
    D {u} {v} _ = v ≡ u
    d : {u : A} → D {u} refl
    d  = refl

-- The transitivity of ≡.
trans : ∀{ℓ} {A : Type ℓ} {x y z : A}
      → x ≡ y → y ≡ z → x ≡ z
trans {ℓ} {A} xEy = induction≡ D d xEy
  where
    D : {u v : A} → u ≡ v → Type ℓ
    D {u} {v} _ = {w : A} → v ≡ w → u ≡ w

    d : {u : A} → D {u} refl
    d uEw = uEw

symIsInv : ∀{ℓ} {A : Type ℓ} {x y : A}
         → (p : x ≡ y) → sym p ≡ p ⁻¹
symIsInv refl = refl


{-# OPTIONS --without-K #-}
module Data.Inductive.Higher.Interval where

open import Relation.Equality
open import Relation.Path.Operation

-- The interval, which we denote I, is perhaps an even simpler higher inductive type than the
-- circle generated by:
module Interval where
  private
    data #I : Set where
      #0 : #I
      #1 : #I

  I : Set
  I = #I

  -- A point 0ᵢ
  0ᵢ : I
  0ᵢ = #0

  -- A point 1₁
  1ᵢ : I
  1ᵢ = #1

  postulate -- A path segment
    path-seg : 0ᵢ ≡ 1ᵢ

  -- "The recursion principle for the interval says that given a type B along with
  interval-rec : ∀ {b} {B : Set b} →
                       (b₀ b₁ : B) → -- points b₀, b₁ and
                       (p : b₀ ≡ b₁) → -- a path b₀ ≡ b₁
                       (i : I) → B -- there is a function f : I → B such that
  interval-rec b₀ b₁ p #0 = b₀ -- f(0ᵢ) ≡ b₀
  interval-rec b₀ b₁ p #1 = b₁ -- f(1ᵢ) ≡ b₁"

  -- The induction principle says that given P : I → U along with
  interval-ind : ∀ {b} (P : I → Set b)
                       (b₀ : P 0ᵢ) → -- a point b₀ : P(0ᵢ)
                       (b₁ : P 1ᵢ) → -- a point b₁ : P(1ᵢ) and
                       (p : transport {_}{_}{I}{P} path-seg b₀ ≡ b₁) →
                       ∀ i → P i -- there is a function f : Π(x:I) P(x) such that
  interval-ind P b₀ b₁ p #0 = b₀ -- f(0ᵢ) ≡ b₀
  interval-ind P b₀ b₁ p #1 = b₁ -- f(1ᵢ) ≡ b₁"
open Interval public


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

module encode-decode where

import 05-identity-types
open 05-identity-types public

record Lift {i j : Level} (A : UU i) : UU (i ⊔ j) where
  field
    raise : A

module Coprod where
  code-left : {i j : Level} {A : UU i} {B : UU j} → A → (coprod A B) → (UU i)
  code-left a₀ (inl a) = Id a₀ a
  code-left a₀ (inr b) = Lift 𝟘

  code-right : {i j : Level} {A : UU i} {B : UU j} → B → (coprod A B) → (UU j)
  code-right b₀ (inr b) = Id b₀ b
  code-right b₀ (inl a) = Lift 𝟘

  encode-left : {i j : Level} {A : UU i} {B : UU j} → (a₀ : A) → (x : coprod A B) → (p : Id (inl a₀) x) → (code-left a₀ x)
  encode-left a₀ x p = tr (code-left a₀) p refl

  decode-left : {i j : Level} {A : UU i} {B : UU j} → (a₀ : A) → (x : coprod A B) → (c : (code-left a₀ x)) → Id (inl a₀) x
  decode-left a₀ (inl a) refl = refl
  decode-left a₀ (inr b) c    = ind-empty (Lift.raise c)

module Nats where
  code : ℕ → ℕ → (UU lzero)
  code zero-ℕ     zero-ℕ     = 𝟙
  code (succ-ℕ m) zero-ℕ     = Lift 𝟘
  code zero-ℕ     (succ-ℕ n) = Lift 𝟘
  code (succ-ℕ m) (succ-ℕ n) = code m n

  recursion : (n : ℕ) → code n n
  recursion zero-ℕ     = star
  recursion (succ-ℕ n) = recursion n

  encode : (m n : ℕ) → (Id m n) → (code m n)
  encode m n p = tr (code m) p (recursion m)

  decode : (m n : ℕ) → (code m n) → (Id m n)
  decode zero-ℕ     zero-ℕ     s = refl
  decode (succ-ℕ m) zero-ℕ     e = ind-empty (Lift.raise e)
  decode zero-ℕ     (succ-ℕ n) e = ind-empty (Lift.raise e)
  decode (succ-ℕ m) (succ-ℕ n) c = ap succ-ℕ (decode m n c)

  -- This doesn't work.
  constant-fn : (n : ℕ) → code n n
  constant-fn n = star


open import Auto.Prelude

-- using a type argument as a proof

h0 : (x₁ x₂ : ⊥) → x₁ ≡ x₂
h0 = {!!}
--h0 = λ x₁ → λ ()

-- using dependent pair to define non-dep pair

module DND where
 _×_ : Set → Set → Set
 A × B = Σ A (λ _ → B)

 h1-2 : ∀ {A B} → A × B → B × A
-- h1-2 = {!!}  -- no solution found
 h1-2 = λ h → Σ-i {!!} {!!}
-- h1-2 = λ h → Σ-i (Σ.prf h) (Σ.wit h)


open import Data.Product using ( ∃ ; _×_ ; _,_ )
open import Relation.Binary.PropositionalEquality using ( _≡_ ; refl )
open import Relation.Nullary using ( ¬_ )
open import Relation.Unary using ( _∈_ ; ∅ )
open import Web.Semantic.DL.Signature using ( Signature ; CN ; RN )
open import Web.Semantic.Util using ( Setoid ; Subset ; _∘_ ; False )

module Web.Semantic.DL.TBox.Interp where

data Interp (Σ : Signature) : Set₁ where
  interp :
    (Δ : Set) →
    (_≈_ : Δ → Δ → Set) →
    (ref : ∀ {x} → (x ≈ x)) →
    (sym : ∀ {x y} → (x ≈ y) → (y ≈ x)) →
    (trans : ∀ {x y z} → (x ≈ y) → (y ≈ z) → (x ≈ z)) →
    (con : CN Σ → Subset Δ) →
    (rol : RN Σ → Subset (Δ × Δ)) →
    (con-≈ : ∀ {x y} c → (x ∈ con c) → (x ≈ y) → (y ∈ con c)) →
    (rol-≈ : ∀ {w x y z} r → (w ≈ x) → ((x , y) ∈ rol r) → (y ≈ z) → ((w , z) ∈ rol r)) →
    Interp Σ

Δ : ∀ {Σ} → Interp Σ → Set
Δ (interp Δ _≈_ ref sym trans con rol con-≈ rol-≈) = Δ

_⊨_≈_ : ∀ {Σ} → (I : Interp Σ) → (Δ I) → (Δ I) → Set
_⊨_≈_ (interp Δ _≈_ ref sym trans con rol con-≈ rol-≈) = _≈_

≈-refl : ∀ {Σ} → (I : Interp Σ) → ∀ {x} → (I ⊨ x ≈ x)
≈-refl (interp Δ _≈_ ref sym trans con rol con-≈ rol-≈) = ref

≈-sym : ∀ {Σ} → (I : Interp Σ) → ∀ {x y} → (I ⊨ x ≈ y) → (I ⊨ y ≈ x)
≈-sym (interp Δ _≈_ ref sym trans con rol con-≈ rol-≈) = sym

≈-trans : ∀ {Σ} → (I : Interp Σ) → ∀ {x y z} → (I ⊨ x ≈ y) → (I ⊨ y ≈ z) → (I ⊨ x ≈ z)
≈-trans (interp Δ _≈_ ref sym trans con rol con-≈ rol-≈) = trans

con : ∀ {Σ} → (I : Interp Σ) → CN Σ → Subset (Δ I)
con (interp Δ _≈_ ref sym trans con rol con-≈ rol-≈) = con

rol : ∀ {Σ} → (I : Interp Σ) → RN Σ → Subset (Δ I × Δ I)
rol (interp Δ _≈_ ref sym trans con rol con-≈ rol-≈) = rol

con-≈ : ∀ {Σ} → (I : Interp Σ) → ∀ {x y} c → (x ∈ con I c) → (I ⊨ x ≈ y) → (y ∈ con I c)
con-≈ (interp Δ _≈_ ref sym trans con rol con-≈ rol-≈) = con-≈

rol-≈ : ∀ {Σ} → (I : Interp Σ) → ∀ {w x y z} r → (I ⊨ w ≈ x) → ((x , y) ∈ rol I r) → (I ⊨ y ≈ z) → ((w , z) ∈ rol I r)
rol-≈ (interp Δ _≈_ ref sym trans con rol con-≈ rol-≈) = rol-≈

_⊨_≉_ : ∀ {Σ} → (I : Interp Σ) → (Δ I) → (Δ I) → Set
I ⊨ x ≉ y = ¬(I ⊨ x ≈ y)

emp : ∀ {Σ} → Interp Σ
emp = interp False (λ ()) (λ {}) (λ {}) (λ {}) (λ c → ∅) (λ r → ∅) (λ {}) (λ {})

≈-refl′ : ∀ {Σ} (I : Interp Σ) → ∀ {x y} → (x ≡ y) → (I ⊨ x ≈ y)
≈-refl′ I refl = ≈-refl I


{-# OPTIONS --safe #-}
module Cubical.Algebra.Monoid.Instances.Nat where

open import Cubical.Foundations.Prelude

open import Cubical.Data.Nat

open import Cubical.Algebra.Monoid

NatMonoid : Monoid ℓ-zero
fst NatMonoid = ℕ
MonoidStr.ε (snd NatMonoid) = 0
MonoidStr._·_ (snd NatMonoid) = _+_
MonoidStr.isMonoid (snd NatMonoid) = makeIsMonoid isSetℕ +-assoc +-zero (λ _ → refl)


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

open import LogicalFormulae
open import Setoids.Setoids
open import Sets.EquivalenceRelations
open import Numbers.Naturals.Semiring
open import Numbers.Integers.Integers
open import Numbers.Integers.Addition
open import Groups.Lemmas
open import Groups.Definition
open import Groups.Cyclic.Definition
open import Semirings.Definition

module Groups.Cyclic.DefinitionLemmas {m n : _} {A : Set m} {S : Setoid {m} {n} A} {_+_ : A → A → A} (G : Group S _+_) where

open Setoid S
open Group G
open Equivalence eq

elementPowerCommutes : (x : A) (n : ℕ) → (x + positiveEltPower G x n) ∼ ((positiveEltPower G x n) + x)
elementPowerCommutes x zero = transitive identRight (symmetric identLeft)
elementPowerCommutes x (succ n) = transitive (+WellDefined reflexive (elementPowerCommutes x n)) +Associative

elementPowerCollapse : (x : A) (i j : ℤ) → Setoid._∼_ S ((elementPower G x i) + (elementPower G x j)) (elementPower G x (i +Z j))
elementPowerCollapse x (nonneg a) (nonneg b) rewrite equalityCommutative (+Zinherits a b) = positiveEltPowerCollapse G x a b
elementPowerCollapse x (nonneg zero) (negSucc b) = identLeft
elementPowerCollapse x (nonneg (succ a)) (negSucc zero) = transitive (+WellDefined (elementPowerCommutes x a) reflexive) (transitive (symmetric +Associative) (transitive (+WellDefined reflexive (transitive (+WellDefined reflexive (invContravariant G)) (transitive (+WellDefined reflexive (transitive (+WellDefined (invIdent G) reflexive) identLeft)) invRight))) identRight))
elementPowerCollapse x (nonneg (succ a)) (negSucc (succ b)) = transitive (transitive (+WellDefined (elementPowerCommutes x a) reflexive) (transitive (symmetric +Associative) (+WellDefined reflexive (transitive (transitive (+WellDefined reflexive (inverseWellDefined G (transitive (+WellDefined reflexive (elementPowerCommutes x b)) +Associative))) (transitive (+WellDefined reflexive (invContravariant G)) (transitive +Associative (transitive (+WellDefined invRight (invContravariant G)) identLeft)))) (symmetric (invContravariant G)))))) (elementPowerCollapse x (nonneg a) (negSucc b))
elementPowerCollapse x (negSucc zero) (nonneg zero) = identRight
elementPowerCollapse x (negSucc zero) (nonneg (succ b)) = transitive (transitive +Associative (+WellDefined (transitive (+WellDefined (inverseWellDefined G identRight) reflexive) invLeft) reflexive)) identLeft
elementPowerCollapse x (negSucc (succ a)) (nonneg zero) = identRight
elementPowerCollapse x (negSucc (succ a)) (nonneg (succ b)) = transitive (transitive +Associative (+WellDefined (transitive (+WellDefined (invContravariant G) reflexive) (transitive (symmetric +Associative) (transitive (+WellDefined reflexive invLeft) identRight))) reflexive)) (elementPowerCollapse x (negSucc a) (nonneg b))
elementPowerCollapse x (negSucc a) (negSucc b) = transitive (+WellDefined reflexive (invContravariant G)) (transitive (transitive (transitive +Associative (+WellDefined (transitive (symmetric (invContravariant G)) (transitive (inverseWellDefined G +Associative) (transitive (inverseWellDefined G (+WellDefined (symmetric (elementPowerCommutes x b)) reflexive)) (transitive (inverseWellDefined G (symmetric +Associative)) (transitive (invContravariant G) (+WellDefined (inverseWellDefined G (transitive (positiveEltPowerCollapse G x b a) (identityOfIndiscernablesRight _∼_ reflexive (applyEquality (positiveEltPower G x) {b +N a} {a +N b} (Semiring.commutative ℕSemiring b a))))) reflexive)))))) reflexive)) (+WellDefined (symmetric (invContravariant G)) reflexive)) (symmetric (invContravariant G)))

positiveEltPowerInverse : (m : ℕ) → (x : A) → (positiveEltPower G (inverse x) m) ∼ inverse (positiveEltPower G x m)
positiveEltPowerInverse zero x = symmetric (invIdent G)
positiveEltPowerInverse (succ m) x = transitive (+WellDefined reflexive (positiveEltPowerInverse m x)) (transitive (symmetric (invContravariant G)) (inverseWellDefined G (symmetric (elementPowerCommutes x m))))

positiveEltPowerMultiplies : (m n : ℕ) → (x : A) → (positiveEltPower G x (m *N n)) ∼ (positiveEltPower G (positiveEltPower G x n) m)
positiveEltPowerMultiplies zero n x = reflexive
positiveEltPowerMultiplies (succ m) n x = transitive (symmetric (positiveEltPowerCollapse G x n (m *N n))) (+WellDefined reflexive (positiveEltPowerMultiplies m n x))

powerZero : (m : ℕ) → positiveEltPower G 0G m ∼ 0G
powerZero zero = reflexive
powerZero (succ m) = transitive identLeft (powerZero m)

elementPowerMultiplies : (m n : ℤ) → (x : A) → (elementPower G x (m *Z n)) ∼ (elementPower G (elementPower G x n) m)
elementPowerMultiplies (nonneg m) (nonneg n) x = positiveEltPowerMultiplies m n x
elementPowerMultiplies (nonneg zero) (negSucc n) x = reflexive
elementPowerMultiplies (nonneg (succ m)) (negSucc n) x =  transitive (transitive (inverseWellDefined G (transitive (transitive (elementPowerWellDefinedZ' G (nonneg (succ (n +N m *N n) +N m)) (nonneg (m *N succ n +N succ n)) (applyEquality nonneg (transitivity (applyEquality succ (transitivity (equalityCommutative (Semiring.+Associative ℕSemiring n (m *N n) m)) (applyEquality (n +N_) (transitivity (transitivity (Semiring.commutative ℕSemiring _ m) (applyEquality (m +N_) (multiplicationNIsCommutative m n))) (multiplicationNIsCommutative (succ n) m))))) (Semiring.commutative ℕSemiring (succ n) _))) {x}) (symmetric (positiveEltPowerCollapse G x (m *N succ n) (succ n)))) (+WellDefined (positiveEltPowerMultiplies m (succ n) x) reflexive))) (invContravariant G)) (+WellDefined reflexive (symmetric (positiveEltPowerInverse m (x + positiveEltPower G x n))))
elementPowerMultiplies (negSucc m) (nonneg zero) r = transitive (symmetric (invIdent G)) (inverseWellDefined G (transitive (symmetric identLeft) (+WellDefined reflexive (symmetric (powerZero m)))))
elementPowerMultiplies (negSucc m) (nonneg (succ n)) x = inverseWellDefined G (transitive (transitive (+WellDefined reflexive (transitive (elementPowerWellDefinedZ' G (nonneg ((m +N n *N m) +N n)) (nonneg (n +N m *N succ n)) (applyEquality nonneg (transitivity (Semiring.commutative ℕSemiring _ n) (applyEquality (n +N_) (multiplicationNIsCommutative _ m)))) {x}) (symmetric (positiveEltPowerCollapse G x n (m *N succ n))))) +Associative) (+WellDefined reflexive (positiveEltPowerMultiplies m (succ n) x)))
elementPowerMultiplies (negSucc m) (negSucc n) r = transitive (transitive (transitive (transitive (elementPowerWellDefinedZ' G (nonneg (succ m *N succ n)) (nonneg (m *N succ n +N succ n)) (applyEquality nonneg (Semiring.commutative ℕSemiring (succ n) _)) {r}) (symmetric (positiveEltPowerCollapse G r (m *N succ n) (succ n)))) (transitive (elementPowerCollapse r (nonneg (m *N succ n)) (nonneg (succ n))) (transitive (transitive (elementPowerWellDefinedZ' G (nonneg (m *N succ n) +Z nonneg (succ n)) (nonneg (m *N succ n +N succ n)) (equalityCommutative (+Zinherits (m *N succ n) (succ n))) {r}) (symmetric (positiveEltPowerCollapse G r (m *N succ n) (succ n)))) (+WellDefined (positiveEltPowerMultiplies m (succ n) r) reflexive)))) (+WellDefined (transitive (symmetric (invTwice G _)) (inverseWellDefined G (symmetric (positiveEltPowerInverse m (r + positiveEltPower G r n))))) (symmetric (invTwice G _)))) (symmetric (invContravariant G))

positiveEltPowerHomAbelian : ({x y : A} → (x + y) ∼ (y + x)) → (x y : A) → (r : ℕ) → (positiveEltPower G (x + y) r) ∼ (positiveEltPower G x r + positiveEltPower G y r)
positiveEltPowerHomAbelian ab x y zero = symmetric identRight
positiveEltPowerHomAbelian ab x y (succ r) = transitive (symmetric +Associative) (transitive (+WellDefined reflexive (transitive (+WellDefined reflexive (positiveEltPowerHomAbelian ab x y r)) (transitive (+WellDefined reflexive ab) (transitive +Associative ab)))) +Associative)

elementPowerHomAbelian : ({x y : A} → (x + y) ∼ (y + x)) → (x y : A) → (r : ℤ) → (elementPower G (x + y) r) ∼ (elementPower G x r + elementPower G y r)
elementPowerHomAbelian ab x y (nonneg n) = positiveEltPowerHomAbelian ab x y n
elementPowerHomAbelian ab x y (negSucc n) = transitive (transitive (inverseWellDefined G (positiveEltPowerHomAbelian ab x y (succ n))) (inverseWellDefined G ab)) (invContravariant G)


{-# OPTIONS --universe-polymorphism #-}
module Categories.Cocone where

open import Level

open import Categories.Category
open import Categories.Functor hiding (_≡_; _∘_)

record Cocone {o ℓ e} {o′ ℓ′ e′} {C : Category o ℓ e} {J : Category o′ ℓ′ e′} (F : Functor J C) : Set (o ⊔ ℓ ⊔ e ⊔ o′ ⊔ ℓ′) where
  module J = Category J
  open Category C
  open Functor F
  field
    N : Obj
    ψ : ∀ X → ((F₀ X) ⇒ N)
    .commute : ∀ {X Y} (f : J [ X , Y ]) → ψ X ≡ ψ Y ∘ F₁ f


{-# OPTIONS --without-K #-}
module PathStructure.Sigma {a b} {A : Set a} {B : A → Set b} where

open import Equivalence
open import PathOperations
open import Transport
open import Types

ap₂-dep : ∀ {a b c} {A : Set a} {B : A → Set b} {C : Set c}
  {x x′ : A} {y : B x} {y′ : B x′}
  (f : (a : A) (b : B a) → C) (p : x ≡ x′) (q : tr B p y ≡ y′) →
  f x y ≡ f x′ y′
ap₂-dep {B = B} f p q = J
  (λ x x′ p → (y : B x) (y′ : B x′) (q : tr B p y ≡ y′) → f x y ≡ f x′ y′)
  (λ x _ _ q → ap (f x) q)
  _ _ p _ _ q

ap₂-dep-eq : ∀ {a b c} {A : Set a} {B : A → Set b} {C : Set c}
  (f : (x : A) → B x → C)
  {x x′ : A} (p p′ : x ≡ x′) (pp : p ≡ p′)
  {y : B x} {y′ : B x′} (q : tr B p y ≡ y′) (q′ : tr B p′ y ≡ y′)
  (qq : tr (λ z → tr B z y ≡ y′) pp q ≡ q′) →
  ap₂-dep f p q ≡ ap₂-dep f p′ q′
ap₂-dep-eq {B = B} f {x = x} {x′ = x′} p p′ pp q q′ qq = J
  (λ p p′ pp → (y : B x) (y′ : B x′)
    (q : tr B p y ≡ y′) (q′ : tr B p′ y ≡ y′)
    (qq : tr (λ z → tr B z y ≡ y′) pp q ≡ q′) →
    ap₂-dep f p q ≡ ap₂-dep f p′ q′)
  (λ p _ _ q q′ qq → J
    (λ q q′ qq → ap₂-dep f p q ≡ ap₂-dep f p q′)
    (λ _ → refl)
    _ _ qq)
  _ _ pp _ _ _ _ qq

split-path : {x y : Σ A B} →
  x ≡ y → Σ (π₁ x ≡ π₁ y) (λ p → tr B p (π₂ x) ≡ π₂ y)
split-path {x = x} p = ap π₁ p , tr-∘ π₁ p (π₂ x) ⁻¹ · apd π₂ p

merge-path : {x y : Σ A B} →
  Σ (π₁ x ≡ π₁ y) (λ p → tr B p (π₂ x) ≡ π₂ y) → x ≡ y
merge-path pq = ap₂-dep _,_ (π₁ pq) (π₂ pq)

split-merge-eq : {x y : Σ A B} →
  (x ≡ y) ≃ Σ (π₁ x ≡ π₁ y) (λ p → tr B p (π₂ x) ≡ π₂ y)
split-merge-eq
  = split-path
  , (merge-path , λ pq → J
      (λ x x′ p → (y : B x) (y′ : B x′) (q : tr B p y ≡ y′) →
        split-path (merge-path (p , q)) ≡ p , q)
      (λ x y y′ q → J {A = B x}
        (λ _ _ q → split-path (merge-path (refl , q)) ≡ refl , q)
        (λ _ → refl) _ _ q)
      _ _ (π₁ pq) _ _ (π₂ pq))
  , (merge-path , J
      (λ _ _ p → merge-path (split-path p) ≡ p)
      (λ _ → refl) _ _)


module Prelude.Ord.Properties where

open import Prelude.Ord
open import Prelude.Empty
open import Prelude.Equality
open import Prelude.Equality.Inspect

open import Prelude.Function
open import Prelude.Decidable
open import Prelude.Bool
open import Prelude.Bool.Properties

-- Ord/Laws extra lemmas
module _  {ℓ} {A : Set ℓ} {{_ : Ord/Laws A}} where

  <⇒≤ : {a b : A} → a < b → a ≤ b
  <⇒≤ = lt-to-leq

  ≡⇒≮ : {a b : A} → a ≡ b → a ≮ b
  ≡⇒≮ refl a<b = less-antisym a<b a<b

  <⇒≱ : {a b : A} → a < b → a ≱ b
  <⇒≱ = flip leq-less-antisym

  ≮⇒≥ : {a b : A} → a ≮ b → a ≥ b
  ≮⇒≥ {a = a} {b = b} ¬a<b
    with compare a b
  ...| less a<b = ⊥-elim (¬a<b a<b)
  ...| equal a≡b = eq-to-leq (sym a≡b)
  ...| greater a>b = lt-to-leq a>b

  ≰⇒> : {a b : A} → a ≰ b → a > b
  ≰⇒> {a = a} {b = b} a≰b
    with compare a b
  ...| less a<b = ⊥-elim (a≰b (lt-to-leq a<b))
  ...| equal a≡b = ⊥-elim (a≰b (eq-to-leq a≡b))
  ...| greater b>a = b>a

  ≰⇒≥ : {a b : A} → a ≰ b → a ≥ b
  ≰⇒≥ = <⇒≤ ∘ ≰⇒>

  <?⇒< :  {a b : A} → (a <? b) ≡ true → a < b
  <?⇒< {a = a} {b = b} a<?b
    with compare a b
  ...| less a<b = a<b
  ...| equal a≡b rewrite a≡b = case a<?b of λ ()
  ...| greater _ = case a<?b of λ ()

  ≮?⇒≮ : {a b : A} → (a <? b) ≡ false → a ≮ b
  ≮?⇒≮ {a = a} {b = b} a≮?b
    with compare a b
  ...| less _ = case a≮?b of λ ()
  ...| equal a≡b rewrite a≡b = λ a<b → ⊥-elim (less-antirefl a<b)
  ...| greater a>b = λ a<b → ⊥-elim (less-antisym a>b a<b)

  ≤?⇒≤ :  {a b : A} → (a ≤? b) ≡ true → a ≤ b
  ≤?⇒≤ {a = a} {b = b} a≤?b
    with inspect (compare b a)
  ...| less a<b with≡ compare≡ rewrite compare≡ =
       case a≤?b of λ ()
  ...| equal a≡b with≡ _ = eq-to-leq (sym a≡b)
  ...| greater a>b with≡ _ = lt-to-leq a>b

  ≰?⇒≰ :  {a b : A} → (a ≤? b) ≡ false → a ≰ b
  ≰?⇒≰ {a = a} {b = b} a≰?b
    with (compare b a)
  ...| less b<a = <⇒≱ b<a
  ...| equal a≡b rewrite a≡b = case a≰?b of λ ()
  ...| greater _ = case a≰?b of λ ()

  ≰?⇒≥ : {a b : A} → (a ≤? b) ≡ false → a ≥ b
  ≰?⇒≥ = ≰⇒≥ ∘ ≰?⇒≰


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

{- The type of all types in some universe with a fixed truncation level
   behaves almost like a universe itself. In this utility module, we develop
   some notation for efficiently working with this pseudo-universe.
   It will lead to considerably more briefer and more comprehensible proofs. -}
module Universe.Utility.TruncUniverse where

open import lib.Basics
open import lib.NType2
open import lib.types.Pi
open import lib.types.Sigma
open import lib.types.TLevel
open import lib.types.Unit

open import Universe.Utility.General

module _ {n : ℕ₋₂} where
  ⟦_⟧ : ∀ {i} → n -Type i → Type i
  ⟦ (B , _) ⟧ = B

module _ {n : ℕ₋₂} where
  Lift-≤ : ∀ {i j} → n -Type i → n -Type (i ⊔ j)
  Lift-≤ {i} {j} (A , h) = (Lift {j = j} A , equiv-preserves-level (lift-equiv ⁻¹) h)

  raise : ∀ {i} → n -Type i → S n -Type i
  raise (A , h) = (A , raise-level n h)

  raise-≤T : ∀ {i} {m n : ℕ₋₂} → m ≤T n → m -Type i → n -Type i
  raise-≤T p (A , h) = (A , raise-level-≤T p h)

  ⊤-≤ : n -Type lzero
  ⊤-≤ = (⊤ , raise-level-≤T (-2≤T n) Unit-is-contr)

  Π-≤ : ∀ {i j} (A : Type i) → (A → n -Type j) → n -Type (i ⊔ j)
  Π-≤ A B = (Π A (fst ∘ B) , Π-level (snd ∘ B))

  infixr 2 _→-≤_

  _→-≤_ : ∀ {i j} → Type i → n -Type j → n -Type (i ⊔ j)
  A →-≤ B = Π-≤ A (λ _ → B)

  Σ-≤ : ∀ {i j} (A : n -Type i) → (⟦ A ⟧ → n -Type j) → n -Type (i ⊔ j)
  Σ-≤ A B = (Σ ⟦ A ⟧ (λ a → ⟦ B a ⟧) , Σ-level (snd A) (snd ∘ B))

  infixr 4 _×-≤_

  _×-≤_ : ∀ {i j} → n -Type i → n -Type j → n -Type (i ⊔ j)
  A ×-≤ B = Σ-≤ A (λ _ → B)

  Path-< : ∀ {i} (A : S n -Type i) (x y : ⟦ A ⟧) → n -Type i
  Path-< A x y = (x == y , snd A _ _)

  Path-≤ : ∀ {i} (A : n -Type i) (x y : ⟦ A ⟧) → n -Type i
  Path-≤ A x y = Path-< (raise A) x y

  _≃-≤_ : ∀ {i j} (A : n -Type i) (B : n -Type j) → n -Type (i ⊔ j)
  A ≃-≤ B = (⟦ A ⟧ ≃ ⟦ B ⟧ , ≃-level (snd A) (snd B))

_-Type-≤_ : (n : ℕ₋₂) (i : ULevel) → S n -Type lsucc i
n -Type-≤ i = (n -Type i , n -Type-level i)


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

module Lecture4 where

import Lecture3
open Lecture3 public

-- the identity type on a type A, given a fixed basepoint x
data Id {i : Level} {A : UU i} (x : A) : A → UU i where
  refl : Id x x

_==_ : {i : Level} {A : UU i} (x y : A) → UU i
x == y = Id x y

ind-Id : {i j : Level} {A : UU i} {x : A} (B : (y : A) (p : Id x y) → UU j) →
  (B x refl) → (y : A) (p : Id x y) → B y p
ind-Id x b y refl = b

-- groupoid structure on identity types (a.k.a. paths)

inv : {i : Level} {A : UU i} {x y : A} → Id x y → Id y x
inv (refl) = refl

_⁻¹ : {i : Level} {A : UU i} {x y : A} → Id x y → Id y x
x ⁻¹ = inv x

concat : {i : Level} {A : UU i} {x z : A} (y : A) → Id x y → Id y z → Id x z
concat x refl q = q

_·_ : {i : Level} {A : UU i} {x z : A} {y : A} → Id x y → Id y z → Id x z
p · q = concat _ p q

-- equational reasoning (TODO: demonstrate this by reworking some of the proofs to use it)
infix 15 _==∎    -- \qed
infixr 10 _==⟨_⟩_    -- \< \>

_==∎ : ∀ {i : Level} {A : UU i} (a : A) → a == a
a ==∎ = refl

_==⟨_⟩_ : ∀ {i : Level} {A : UU i} (a : A) {b c : A} → a == b → b == c → a == c
a ==⟨ γ ⟩ η = γ · η
-- end equational reasoning

assoc : {i : Level} {A : UU i} {x y z w : A} (p : Id x y) (q : Id y z) (r : Id z w) → Id (concat _ p (concat _ q r)) (concat _ (concat _ p q) r)
assoc refl q r = refl

left-unit : {i : Level} {A : UU i} {x y : A} (p : Id x y) → Id (concat _ refl p) p
left-unit refl = refl

right-unit : {i : Level} {A : UU i} {x y : A} (p : Id x y) → Id (concat _ p refl) p
right-unit refl = refl

left-inv : {i : Level} {A : UU i} {x y : A} (p : Id x y) →
  Id (concat _ (inv p) p) refl
left-inv refl = refl

right-inv : {i : Level} {A : UU i} {x y : A} (p : Id x y) →
  Id (concat _ p (inv p)) refl
right-inv refl = refl

-- action on paths of a function

ap : {i j : Level} {A : UU i} {B : UU j} (f : A → B) {x y : A} (p : Id x y) → Id (f x) (f y)
ap f refl = refl

ap-id : {i : Level} {A : UU i} {x y : A} (p : Id x y) → Id (ap id p) p
ap-id refl = refl

ap-comp : {i j k : Level} {A : UU i} {B : UU j} {C : UU k} (g : B → C) (f : A → B) {x y : A} (p : Id x y) → Id (ap (comp g f) p) (ap g (ap f p))
ap-comp g f refl = refl

ap-refl : {i j : Level} {A : UU i} {B : UU j} (f : A → B) (x : A) →
  Id (ap f (refl {_} {_} {x})) refl
ap-refl f x = refl

ap-concat : {i j : Level} {A : UU i} {B : UU j} (f : A → B) {x y z : A} (p : Id x y) (q : Id y z) → Id (ap f (concat _ p q)) (concat _ (ap f p) (ap f q))
ap-concat f refl q = refl

ap-inv : {i j : Level} {A : UU i} {B : UU j} (f : A → B) {x y : A} (p : Id x y) → Id (ap f (inv p)) (inv (ap f p))
ap-inv f refl = refl

tr : {i j : Level} {A : UU i} (B : A → UU j) {x y : A} (p : Id x y) (b : B x) → B y
tr B refl b = b

apd : {i j : Level} {A : UU i} {B : A → UU j} (f : (x : A) → B x) {x y : A} (p : Id x y) → Id (tr B p (f x)) (f y)
apd f refl = refl

-- Exercises below

-- Exercise 4.1 The composition of transports is the transport of the concatenation
tr-concat : {i j : Level} {A : UU i} (B : A → UU j) {x y z : A} (p : Id x y) (q : Id y z) (b : B x) → Id (tr B q (tr B p b)) (tr B (concat _ p q) b)
tr-concat B refl refl b = refl

-- Exercise 4.2 Taking the inverse distributes contravariantly over concatenation
inv-assoc : {i : Level} {A : UU i} {x y z : A} (p : Id x y) (q : Id y z) → Id (inv (concat _ p q)) (concat _ (inv q) (inv p))
inv-assoc refl refl = refl

-- Exercise 4.3 If B is a weakened family over A (trivial bundle, not dependent), then tr is refl
tr-triv : {i j : Level} {A : UU i} {B : UU j} {x y : A} (p : Id x y) (b : B) → Id (tr (weaken A B) p b) b
tr-triv refl b = refl

-- Exercise 4.4 Transporting, using x=y and f:A → B, an identity between identities
tr-fib : {i j : Level} {A : UU i} {B : UU j} {f : A → B} {x y : A} (p : Id x y) (b : B) →
  (q : Id (f x) b) → Id (tr (λ (a : A) → Id (f a) b) p q) (concat _ (inv (ap f p)) q)
tr-fib refl b q = refl

tr-fib' : {i j : Level} {A : UU i} {B : UU j} {f : A → B} {x y : A} (p : Id x y) (b : B) →
  (q : Id b (f x)) → Id (tr (λ (a : A) → Id b (f a)) p q) (concat _ q (ap f p))
tr-fib' refl b refl = refl

-- Exercise 4.5
inv-con : {i : Level} {A : UU i} {x y z : A} (p : Id x y) (q : Id y z) (r : Id x z) → (Id (p · q) r) → (Id q ((inv p) · r))
inv-con refl refl r refl = refl

con-inv : {i : Level} {A : UU i} {x y z : A} (p : Id x y) (q : Id y z) (r : Id x z) → (Id (p · q) r) → (Id p (r · (inv q)))
con-inv refl refl r refl = refl

-- Exercise 4.6 Path lifting, from a path in the base A to a path in the total space Σ A B
lift : {i j : Level} {A : UU i} {B : A → UU j} {x y : A} (p : Id x y) (b : B x) → Id (dpair x b) (dpair y (tr B p b))
lift refl b = refl

-- Exercise 4.7 Some laws of arithmetic (follow-up from Remark 2.3.1)
right-unit-addN : (m : ℕ) → Id (m + Nzero) m
right-unit-addN Nzero = refl
right-unit-addN (Nsucc m) = ap Nsucc (right-unit-addN m)

left-unit-addN : (m : ℕ) → Id (Nzero + m) m
left-unit-addN m = refl

assoc-addN : (m n k : ℕ) → Id (m + (n + k)) ((m + n) + k)
assoc-addN Nzero n k = refl
assoc-addN (Nsucc m) n k = ap Nsucc (assoc-addN m n k)

right-succ-addN : (m n : ℕ) → Id (m + (Nsucc n)) (Nsucc (m + n))
right-succ-addN Nzero n = refl
right-succ-addN (Nsucc m) n = ap Nsucc (right-succ-addN m n)

comm-addN : (m n : ℕ) → Id (m + n) (n + m)
comm-addN Nzero Nzero = refl
comm-addN Nzero (Nsucc n) = ap Nsucc (comm-addN Nzero n)
comm-addN (Nsucc m) Nzero = ap Nsucc (comm-addN m Nzero)
comm-addN (Nsucc m) (Nsucc n) =
  ((Nsucc m) + (Nsucc n))
    ==⟨ ap Nsucc (comm-addN m (Nsucc n)) ⟩
  (Nsucc ((Nsucc n) + m))
    ==⟨ inv (right-succ-addN (Nsucc n) m) ⟩
  ((Nsucc n) + (Nsucc m))
    ==∎

left-zero-mulN : (m : ℕ) → Id (Nzero ** m) Nzero
left-zero-mulN m = refl

right-zero-mulN : (m : ℕ) → Id (m ** Nzero) Nzero
right-zero-mulN Nzero = refl
right-zero-mulN (Nsucc m) = concat (m ** Nzero) (right-unit-addN _) (right-zero-mulN m)

left-unit-mulN : (m : ℕ) → Id ((Nsucc Nzero) ** m) m
left-unit-mulN m = refl

right-unit-mulN : (m : ℕ) → Id (m ** (Nsucc Nzero)) m
right-unit-mulN Nzero = refl
right-unit-mulN (Nsucc m) =
  ((Nsucc m) ** (Nsucc Nzero))
    ==⟨ comm-addN _ (Nsucc Nzero) ⟩
  (Nsucc Nzero) + (m ** (Nsucc Nzero))
    ==⟨ ap Nsucc (right-unit-mulN m) ⟩
  (Nsucc m)
    ==∎

distr-addN-mulN : (m n k : ℕ) → Id ((m + n) ** k) ((m ** k) + (n ** k))
distr-addN-mulN Nzero n k = refl
distr-addN-mulN (Nsucc m) n k =
  ((Nsucc m) + n) ** k
    ==⟨ refl ⟩
  (Nsucc (m + n)) ** k
    ==⟨ refl ⟩
  ((m + n) ** k) + k
    ==⟨ ap (λ x → x + k) (distr-addN-mulN m n k) ⟩
  ((m ** k) + (n ** k)) + k
    ==⟨ inv (assoc-addN (m ** k) (n ** k) k) ⟩
  (m ** k) + ((n ** k) + k)
    ==⟨ ap (λ x → (m ** k) + x) (comm-addN (n ** k) k) ⟩
  (m ** k) + (k + (n ** k))
    ==⟨ assoc-addN (m ** k) k (n ** k) ⟩
  ((m ** k) + k) + (n ** k)
    ==⟨ refl ⟩
  ((Nsucc m) ** k) + (n ** k)
    ==∎

assoc-mulN : (m n k : ℕ) → Id (m ** (n ** k)) ((m ** n) ** k)
assoc-mulN Nzero n k = refl
assoc-mulN (Nsucc m) n k =
  ((Nsucc m) ** (n ** k))
    ==⟨ refl ⟩
  (m ** (n ** k)) + (n ** k)
    ==⟨ ap (λ x → x + (n ** k)) (assoc-mulN m n k) ⟩
  ((m ** n) ** k) + (n ** k)
    ==⟨ inv (distr-addN-mulN (m ** n) n k) ⟩
  ((m ** n) + n) ** k
    ==⟨ refl ⟩
  (Nsucc m ** n) ** k
    ==∎


-- {-# OPTIONS --show-implicit --show-irrelevant #-}
module Data.QuadTree.FunctorProofs.FunctorLaws where

open import Haskell.Prelude renaming (zero to Z; suc to S)
open import Data.Logic
open import Data.QuadTree.InternalAgda
open import Agda.Primitive
open import Data.QuadTree.Implementation.Functors

-- First, define the Functor laws

IdentityLaw : (f : (t : Set) -> {{ eqT : Eq t }} -> Set) -> {{ff : FunctorEq f}} -> Set₁
IdentityLaw f {{ff}} = {t : Set} -> {{ eqT : Eq t }}
  -> (v : f t) -> fmapₑ ff id v ≡ id v

CompositionLaw : (f : (t : Set) -> {{ eqT : Eq t }} -> Set) -> {{ff : FunctorEq f}} -> Set₁
CompositionLaw f {{ff}} = {a b c : Set} -> {{ eqA : Eq a }} {{ eqB : Eq b }} {{ eqC : Eq c }}
  -> (v : f a) -> (fun1 : a -> b) -> (fun2 : b -> c) -> fmapₑ ff (fun2 ∘ fun1) v ≡ fmapₑ ff fun2 (fmapₑ ff fun1 v)


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

module Categories.Category.Cocomplete where

open import Level

open import Categories.Category using (Category)
open import Categories.Functor using (Functor)
open import Categories.Diagram.Colimit using (Colimit)

Cocomplete : (o ℓ e : Level) {o′ ℓ′ e′ : Level} (C : Category o′ ℓ′ e′) → Set _
Cocomplete o ℓ e C = ∀ {J : Category o ℓ e} (F : Functor J C) → Colimit F


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

-- The category of Cats is Monoidal

module Categories.Category.Monoidal.Instance.Cats where

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

open import Categories.Category
open import Categories.Functor using (Functor; _∘F_) renaming (id to idF)
open import Categories.Category.Instance.Cats
open import Categories.Category.Monoidal
open import Categories.Functor.Bifunctor
open import Categories.Category.Instance.One
open import Categories.Category.Product
open import Categories.Category.Product.Properties
import Categories.Category.Cartesian as Cartesian
open import Categories.NaturalTransformation.NaturalIsomorphism using (NaturalIsomorphism)

-- Cats is a Monoidal Category with Product as Bifunctor
module Product {o ℓ e : Level} where
  private
    C = Cats o ℓ e
    open Cartesian C

  Cats-has-all : BinaryProducts
  Cats-has-all = record { product = λ {A} {B} → record
    { A×B = Product A B
    ; π₁ = πˡ
    ; π₂ = πʳ
    ; ⟨_,_⟩ = _※_
    ; project₁ = λ {_} {h} {i} → project₁ {i = h} {j = i}
    ; project₂ = λ {_} {h} {i} → project₂ {i = h} {j = i}
    ; unique = unique
    } }

  Cats-is : Cartesian
  Cats-is = record { terminal = One-⊤ ; products = Cats-has-all }

  private
    module Cart = Cartesian.Cartesian Cats-is

  Cats-Monoidal : Monoidal C
  Cats-Monoidal = Cart.monoidal


------------------------------------------------------------------------
-- The Agda standard library
--
-- Finite sets
------------------------------------------------------------------------

-- Note that elements of Fin n can be seen as natural numbers in the
-- set {m | m < n}. The notation "m" in comments below refers to this
-- natural number view.

module Data.Fin where

open import Data.Nat as Nat
  using (ℕ; zero; suc; z≤n; s≤s)
  renaming ( _+_ to _N+_; _∸_ to _N∸_
           ; _≤_ to _N≤_; _≥_ to _N≥_; _<_ to _N<_; _≤?_ to _N≤?_)
open import Function
import Level
open import Relation.Nullary.Decidable
open import Relation.Binary

------------------------------------------------------------------------
-- Types

-- Fin n is a type with n elements.

data Fin : ℕ → Set where
  zero : {n : ℕ} → Fin (suc n)
  suc  : {n : ℕ} (i : Fin n) → Fin (suc n)

-- A conversion: toℕ "n" = n.

toℕ : ∀ {n} → Fin n → ℕ
toℕ zero    = 0
toℕ (suc i) = suc (toℕ i)

-- A Fin-indexed variant of Fin.

Fin′ : ∀ {n} → Fin n → Set
Fin′ i = Fin (toℕ i)

------------------------------------------------------------------------
-- Conversions

-- toℕ is defined above.

-- fromℕ n = "n".

fromℕ : (n : ℕ) → Fin (suc n)
fromℕ zero    = zero
fromℕ (suc n) = suc (fromℕ n)

-- fromℕ≤ {m} _ = "m".

fromℕ≤ : ∀ {m n} → m N< n → Fin n
fromℕ≤ (Nat.s≤s Nat.z≤n)       = zero
fromℕ≤ (Nat.s≤s (Nat.s≤s m≤n)) = suc (fromℕ≤ (Nat.s≤s m≤n))

-- # m = "m".

#_ : ∀ m {n} {m<n : True (suc m N≤? n)} → Fin n
#_ _ {m<n = m<n} = fromℕ≤ (toWitness m<n)

-- raise m "n" = "m + n".

raise : ∀ {m} n → Fin m → Fin (n N+ m)
raise zero    i = i
raise (suc n) i = suc (raise n i)

-- reduce≥ "m + n" _ = "n".

reduce≥ : ∀ {m n} (i : Fin (m N+ n)) (i≥m : toℕ i N≥ m) → Fin n
reduce≥ {zero}  i       i≥m       = i
reduce≥ {suc m} zero    ()
reduce≥ {suc m} (suc i) (s≤s i≥m) = reduce≥ i i≥m

-- inject⋆ m "n" = "n".

inject : ∀ {n} {i : Fin n} → Fin′ i → Fin n
inject {i = zero}  ()
inject {i = suc i} zero    = zero
inject {i = suc i} (suc j) = suc (inject j)

inject! : ∀ {n} {i : Fin (suc n)} → Fin′ i → Fin n
inject! {n = zero}  {i = suc ()} _
inject!             {i = zero}   ()
inject! {n = suc _} {i = suc _}  zero    = zero
inject! {n = suc _} {i = suc _}  (suc j) = suc (inject! j)

inject+ : ∀ {m} n → Fin m → Fin (m N+ n)
inject+ n zero    = zero
inject+ n (suc i) = suc (inject+ n i)

inject₁ : ∀ {m} → Fin m → Fin (suc m)
inject₁ zero    = zero
inject₁ (suc i) = suc (inject₁ i)

inject≤ : ∀ {m n} → Fin m → m N≤ n → Fin n
inject≤ zero    (Nat.s≤s le) = zero
inject≤ (suc i) (Nat.s≤s le) = suc (inject≤ i le)

------------------------------------------------------------------------
-- Operations

-- Folds.

fold : ∀ (T : ℕ → Set) {m} →
       (∀ {n} → T n → T (suc n)) →
       (∀ {n} → T (suc n)) →
       Fin m → T m
fold T f x zero    = x
fold T f x (suc i) = f (fold T f x i)

fold′ : ∀ {n t} (T : Fin (suc n) → Set t) →
        (∀ i → T (inject₁ i) → T (suc i)) →
        T zero →
        ∀ i → T i
fold′             T f x zero     = x
fold′ {n = zero}  T f x (suc ())
fold′ {n = suc n} T f x (suc i)  =
  f i (fold′ (T ∘ inject₁) (f ∘ inject₁) x i)

-- Lifts functions.

lift : ∀ {m n} k → (Fin m → Fin n) → Fin (k N+ m) → Fin (k N+ n)
lift zero    f i       = f i
lift (suc k) f zero    = zero
lift (suc k) f (suc i) = suc (lift k f i)

-- "m" + "n" = "m + n".

infixl 6 _+_

_+_ : ∀ {m n} (i : Fin m) (j : Fin n) → Fin (toℕ i N+ n)
zero  + j = j
suc i + j = suc (i + j)

-- "m" - "n" = "m ∸ n".

infixl 6 _-_

_-_ : ∀ {m} (i : Fin m) (j : Fin′ (suc i)) → Fin (m N∸ toℕ j)
i     - zero   = i
zero  - suc ()
suc i - suc j  = i - j

-- m ℕ- "n" = "m ∸ n".

infixl 6 _ℕ-_

_ℕ-_ : (n : ℕ) (j : Fin (suc n)) → Fin (suc n N∸ toℕ j)
n     ℕ- zero   = fromℕ n
zero  ℕ- suc ()
suc n ℕ- suc i  = n ℕ- i

-- m ℕ-ℕ "n" = m ∸ n.

infixl 6 _ℕ-ℕ_

_ℕ-ℕ_ : (n : ℕ) → Fin (suc n) → ℕ
n     ℕ-ℕ zero   = n
zero  ℕ-ℕ suc ()
suc n ℕ-ℕ suc i  = n ℕ-ℕ i

-- pred "n" = "pred n".

pred : ∀ {n} → Fin n → Fin n
pred zero    = zero
pred (suc i) = inject₁ i

------------------------------------------------------------------------
-- Order relations

infix 4 _≤_ _<_

_≤_ : ∀ {n} → Rel (Fin n) Level.zero
_≤_ = _N≤_ on toℕ

_<_ : ∀ {n} → Rel (Fin n) Level.zero
_<_ = _N<_ on toℕ

data _≺_ : ℕ → ℕ → Set where
  _≻toℕ_ : ∀ n (i : Fin n) → toℕ i ≺ n

-- An ordering view.

data Ordering {n : ℕ} : Fin n → Fin n → Set where
  less    : ∀ greatest (least : Fin′ greatest) →
            Ordering (inject least) greatest
  equal   : ∀ i → Ordering i i
  greater : ∀ greatest (least : Fin′ greatest) →
            Ordering greatest (inject least)

compare : ∀ {n} (i j : Fin n) → Ordering i j
compare zero    zero    = equal   zero
compare zero    (suc j) = less    (suc j) zero
compare (suc i) zero    = greater (suc i) zero
compare (suc i) (suc j) with compare i j
compare (suc .(inject least)) (suc .greatest) | less    greatest least =
                                                  less    (suc greatest) (suc least)
compare (suc .greatest) (suc .(inject least)) | greater greatest least =
                                                  greater (suc greatest) (suc least)
compare (suc .i)        (suc .i)              | equal i = equal (suc i)


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

module Categories.NaturalTransformation.NaturalIsomorphism.Properties where

open import Level

open import Categories.Category
open import Categories.Category.Instance.Setoids
open import Categories.Functor renaming (id to idF)
open import Categories.Functor.Construction.LiftSetoids
open import Categories.NaturalTransformation.NaturalIsomorphism
open import Categories.NaturalTransformation.Properties

import Categories.Morphism as Mor
import Categories.Morphism.Properties as Morₚ
import Categories.Morphism.Reasoning as MR

private
  variable
    o ℓ e : Level
    C D : Category o ℓ e

module _ {F G : Functor C D} (α : NaturalIsomorphism F G) where
  private module C = Category C
  open Category D
  open Mor D
  open Functor F
  open Functor G renaming (F₀ to G₀; F₁ to G₁)
  open NaturalIsomorphism α

  -- We can move equations along natural isomorphism.

  module _ {A B} {f g : A C.⇒ B} where

    push-eq : F₁ f ≈ F₁ g → G₁ f ≈ G₁ g
    push-eq hyp = MR.push-eq D FX≅GX (⇒.commute f) (⇒.commute g) hyp

    pull-eq : G₁ f ≈ G₁ g → F₁ f ≈ F₁ g
    pull-eq hyp = MR.push-eq D (≅.sym FX≅GX) (⇐.commute f) (⇐.commute g) hyp

-- properties of natural isomorphisms over an endofunctor
module _ {F : Endofunctor C} where
  private
    module C = Category C
    module F = Functor F
    module MC = Mor C

  module _ (α : F ≃ idF) where
    open C
    open HomReasoning
    open F
    open MC
    open MR C
    open Mor C
    open Morₚ C
    open NaturalIsomorphism α

    F≃id-comm₁ : ∀ {A} → ⇒.η (F₀ A) ≈ F₁ (⇒.η A)
    F≃id-comm₁ {A} = begin
      ⇒.η (F₀ A)                           ≈⟨ introʳ (F-resp-≈ (iso.isoˡ _) ○ identity) ⟩
      ⇒.η (F₀ A) ∘ F₁ (⇐.η A ∘ ⇒.η A)      ≈⟨ refl⟩∘⟨ homomorphism ⟩
      ⇒.η (F₀ A) ∘ F₁ (⇐.η A) ∘ F₁ (⇒.η A) ≈⟨ cancelˡ (⇒.commute _ ○ iso.isoˡ _) ⟩
      F₁ (⇒.η A)                           ∎

    F≃id-comm₂ : ∀ {A} → ⇐.η (F₀ A) ≈ F₁ (⇐.η A)
    F≃id-comm₂ {A} = begin
      ⇐.η (F₀ A)                             ≈⟨ introˡ (F-resp-≈ (iso.isoˡ _) ○ identity) ⟩
      F₁ (⇐.η A ∘ ⇒.η A) ∘ ⇐.η (F₀ A)        ≈⟨ homomorphism ⟩∘⟨refl ⟩
      (F₁ (⇐.η A) ∘ F₁ (⇒.η A)) ∘ ⇐.η (F₀ A) ≈⟨ cancelʳ (⟺ (⇐.commute _) ○ iso.isoˡ _) ⟩
      F₁ (⇐.η A)                             ∎

    F≃id⇒id : ∀ {A} {f : A ⇒ A} → F₁ f ≈ id → f ≈ id
    F≃id⇒id {A} {f} eq = Iso⇒Mono (Iso-swap (iso A)) _ _ helper
      where helper : ⇐.η A ∘ f ≈ ⇐.η A ∘ id
            helper = begin
              ⇐.η A ∘ f    ≈⟨ ⇐.commute f ⟩
              F₁ f ∘ ⇐.η A ≈⟨ eq ⟩∘⟨refl ⟩
              id ∘ ⇐.η A   ≈˘⟨ id-comm ⟩
              ⇐.η A ∘ id   ∎

-- unlift universe level
module _ {c ℓ ℓ′ e} {F G : Functor C (Setoids c ℓ)} (α : LiftSetoids ℓ′ e ∘F F ≃ LiftSetoids ℓ′ e ∘F G) where
  open NaturalIsomorphism α

  unlift-≃ : F ≃ G
  unlift-≃ = record
    { F⇒G = unlift-nat F⇒G
    ; F⇐G = unlift-nat F⇐G
    ; iso = λ X → record
      { isoˡ = λ eq → lower (iso.isoˡ X (lift eq))
      ; isoʳ = λ eq → lower (iso.isoʳ X (lift eq))
      }
    }


module Data.Fin.Subset.Disjoint where

open import Data.Nat
open import Data.Vec hiding (_∈_)
open import Data.Fin
open import Data.List as List hiding (zipWith)
open import Data.Fin.Subset

-- disjointness and relational specifiation of disjoint union
module _ {n} where

  _◆_ : Subset n → Subset n → Set
  l ◆ r = Empty (l ∩ r)

  data _⨄_ : List (Subset n) → Subset n → Set where
    []  : [] ⨄ ⊥
    _∷_ : ∀ {xs x y} → x ◆ y → xs ⨄ y → (x ∷ xs) ⨄ (x ∪ y)

-- picking from support
module _ {n} where
  _⊇⟨_⟩_ : Subset n → (l : ℕ) → Vec (Fin n) l → Set
  xs ⊇⟨ l ⟩ ys = All (λ y → y ∈ xs) ys
    where open import Data.Vec.All

-- removing from support
module _ {n} where
  _\\_ : ∀ {l} → Subset n → Vec (Fin n) l → Subset n
  xs \\ [] = xs
  xs \\ (x ∷ ys) = (xs [ x ]≔ outside) \\ ys


{-# OPTIONS --safe #-}
module Cubical.Algebra.Group.Instances.IntMod where

open import Cubical.Foundations.Prelude
open import Cubical.Foundations.Isomorphism
open import Cubical.Algebra.Group.Instances.Int
open import Cubical.Algebra.Group.Base
open import Cubical.Algebra.Monoid.Base
open import Cubical.Algebra.Semigroup.Base
open import Cubical.Data.Empty renaming (rec to ⊥-rec)
open import Cubical.Data.Bool
open import Cubical.Data.Fin
open import Cubical.Data.Fin.Arithmetic
open import Cubical.Data.Nat
open import Cubical.Data.Nat.Order
open import Cubical.Algebra.Group.Instances.Unit
  renaming (Unit to UnitGroup)
open import Cubical.Algebra.Group.Instances.Bool
  renaming (Bool to BoolGroup)
open import Cubical.Algebra.Group.MorphismProperties
open import Cubical.Algebra.Group.Morphisms
open import Cubical.Foundations.HLevels
open import Cubical.Data.Sigma

open GroupStr
open IsGroup
open IsMonoid

ℤ/_ : ℕ → Group₀
ℤ/ zero = UnitGroup
fst (ℤ/ suc n) = Fin (suc n)
1g (snd (ℤ/ suc n)) = 0
GroupStr._·_ (snd (ℤ/ suc n)) = _+ₘ_
inv (snd (ℤ/ suc n)) = -ₘ_
IsSemigroup.is-set (isSemigroup (isMonoid (isGroup (snd (ℤ/ suc n))))) =
  isSetFin
IsSemigroup.assoc (isSemigroup (isMonoid (isGroup (snd (ℤ/ suc n))))) =
  λ x y z → sym (+ₘ-assoc x y z)
fst (identity (isMonoid (isGroup (snd (ℤ/ suc n)))) x) = +ₘ-rUnit x
snd (identity (isMonoid (isGroup (snd (ℤ/ suc n)))) x) = +ₘ-lUnit x
fst (inverse (isGroup (snd (ℤ/ suc n))) x) = +ₘ-rCancel x
snd (inverse (isGroup (snd (ℤ/ suc n))) x) = +ₘ-lCancel x

ℤ/1≅Unit : GroupIso (ℤ/ 1) UnitGroup
ℤ/1≅Unit = contrGroupIsoUnit isContrFin1

Bool≅ℤ/2 : GroupIso BoolGroup (ℤ/ 2)
Iso.fun (fst Bool≅ℤ/2) false = 1
Iso.fun (fst Bool≅ℤ/2) true = 0
Iso.inv (fst Bool≅ℤ/2) (zero , p) = true
Iso.inv (fst Bool≅ℤ/2) (suc zero , p) = false
Iso.inv (fst Bool≅ℤ/2) (suc (suc x) , p) =
  ⊥-rec (¬-<-zero (predℕ-≤-predℕ (predℕ-≤-predℕ p)))
Iso.rightInv (fst Bool≅ℤ/2) (zero , p) =
  Σ≡Prop (λ _ → m≤n-isProp) refl
Iso.rightInv (fst Bool≅ℤ/2) (suc zero , p) =
  Σ≡Prop (λ _ → m≤n-isProp) refl
Iso.rightInv (fst Bool≅ℤ/2) (suc (suc x) , p) =
  ⊥-rec (¬-<-zero (predℕ-≤-predℕ (predℕ-≤-predℕ p)))
Iso.leftInv (fst Bool≅ℤ/2) false = refl
Iso.leftInv (fst Bool≅ℤ/2) true = refl
snd Bool≅ℤ/2 =
  makeIsGroupHom λ { false false → refl
                   ; false true → refl
                   ; true false → refl
                   ; true true → refl}

ℤ/2≅Bool : GroupIso (ℤ/ 2) BoolGroup
ℤ/2≅Bool = invGroupIso Bool≅ℤ/2


------------------------------------------------------------------------------
-- Conat properties
------------------------------------------------------------------------------

{-# OPTIONS --exact-split              #-}
{-# OPTIONS --no-sized-types           #-}
{-# OPTIONS --no-universe-polymorphism #-}
{-# OPTIONS --without-K                #-}

module FOTC.Data.Conat.PropertiesI where

open import FOTC.Base
open import FOTC.Data.Conat
open import FOTC.Data.Nat

------------------------------------------------------------------------------
-- Because a greatest post-fixed point is a fixed-point, then the
-- Conat predicate is also a pre-fixed point of the functional NatF,
-- i.e.
--
-- NatF Conat ≤ Conat (see FOTC.Data.Conat.Type).
Conat-in : ∀ {n} →
           n ≡ zero ∨ (∃[ n' ] n ≡ succ₁ n' ∧ Conat n') →
           Conat n
Conat-in h = Conat-coind A h' h
  where
  A : D → Set
  A n = n ≡ zero ∨ (∃[ n' ] n ≡ succ₁ n' ∧ Conat n')

  h' : ∀ {n} → A n → n ≡ zero ∨ (∃[ n' ] n ≡ succ₁ n' ∧ A n')
  h' (inj₁ n≡0)              = inj₁ n≡0
  h' (inj₂ (n' , prf , Cn')) = inj₂ (n' , prf , Conat-out Cn')

0-Conat : Conat zero
0-Conat = Conat-coind A h refl
  where
  A : D → Set
  A n = n ≡ zero

  h : ∀ {n} → A n → n ≡ zero ∨ (∃[ n' ] n ≡ succ₁ n' ∧ A n')
  h An = inj₁ An

-- Adapted from (Sander 1992, p. 57).
∞-Conat : Conat ∞
∞-Conat = Conat-coind A h refl
  where
  A : D → Set
  A n = n ≡ ∞

  h : ∀ {n} → A n → n ≡ zero ∨ (∃[ n' ] n ≡ succ₁ n' ∧ A n')
  h An = inj₂ (∞ , trans An ∞-eq , refl)

N→Conat : ∀ {n} → N n → Conat n
N→Conat Nn = Conat-coind N h Nn
  where
  h : ∀ {m} → N m → m ≡ zero ∨ (∃[ m' ] m ≡ succ₁ m' ∧ N m')
  h nzero          = inj₁ refl
  h (nsucc {m} Nm) = inj₂ (m , refl , Nm)

-- A different proof.
N→Conat' : ∀ {n} → N n → Conat n
N→Conat' nzero          = Conat-in (inj₁ refl)
N→Conat' (nsucc {n} Nn) = Conat-in (inj₂ (n , refl , (N→Conat' Nn)))

------------------------------------------------------------------------------
-- References
--
-- Sander, Herbert P. (1992). A Logic of Functional Programs with an
-- Application to Concurrency. PhD thesis. Department of Computer
-- Sciences: Chalmers University of Technology and University of
-- Gothenburg.