-- import SciLean.Algebra
-- import Mathlib

import SciLean.Mathlib.Data.Enumtype

namespace SciLean

--- Table `C` with index set `ι` and element type `α`
class Table (C : Type u) (ι : Type v) (α : Type w) where
  toFun : C → ι → α

namespace Table

  -- Function that should be interpreted as a table
  def TableFun (α β) := α → β
  infixr:34 " ↦ " => TableFun

  -- Mark function as a table
  abbrev toTable (f : α → β) : α ↦ β := f
  -- @[simp] theorem toTable_apply (f : α → β) : toTable f = f := by rfl
  instance (ι : Type v) (α : Type w) : Table (ι ↦ α) ι α := ⟨λ f => f⟩
  -- TODO: support `table (i,j) => f i j`
  macro "table" xs:Lean.explicitBinders "=> " b:term : term => Lean.expandExplicitBinders `Table.toTable xs b

  --- Automatically infering `ι` and `α` based on C
  class Trait (C : Type u) where
    Index : Type v
    Value : Type w

  -- Is this good idea?
  @[reducible]
  instance (C : Type u) (ι : Type v) (α : Type w) [Table C ι α] : Trait C := ⟨ι, α⟩

  attribute [reducible, inline] Trait.Index Trait.Value

  export Trait (Index Value)

  -- Maybe not a good idea
  -- instance (ι : Type v) (α : Type w) : Table (ι → α) ι α := ⟨λ f => f⟩

  @[reducible]
  abbrev get {C} [Trait C] [Table C (Index C) (Value C)] (c : C) := @toFun _ (Index C) (Value C) _ c

  --- TODO:
  --  Merge all those macros into one
  --
  --  Element assignment:
  --      1. f[i] := x    ==   f := f.set i x
  --      2. f[i] += x    ==   f := f.set i (f[i] + x)
  --
  --  Add slicing notation:
  --      1. f[:]    ==  f[:₀]  ==  table     i => f[i]    : ι ↦ α
  --      2. f[:,:]             ==  table (i,j) => f[i,j]  : ι₀ × ι₁ ↦ α
  --  Curry notation:
  --      3. f[:₀,:₁]   ==  table     i j => f[i,j]   : ι₀ ↦ ι₁ ↦ α       where  f : ι₀ × ι₁ ↦ α
  --      4. f[:₁,:₀]   ==  table     j i => f[i,j]   : ι₁ ↦ ι₀ ↦ α       where  f : ι₀ × ι₁ ↦ α
  --      5. f[:,:₁,:]  ==  table (i,j) k => f[i,k,j] : ι₀ × ι₂ ↦ ι₁ ↦ α  where  f : ι₀ × ι₁ × ι₂ ↦ α
  --  Uncurry notation:
  --      5. f[:][:]  == table (i,j) => f[i][j]  :  ι₀ × ι₁ ↦ α       where  f : ι₀ ↦ ι₁ ↦ α
  --
  --  Common examples:  (mean: ∑' == 1/n * ∑) (norm: ∥ ∥)
  --      1. average of columns:    (∑' j, A[:,j])(A[:₀,:₁] - ∑ j', A[:,j'])[:,:]
  --      2. center columns:         (A[:₀,:₁] - ∑ j', A[:,j'])[:,:]
  --      3. normalize of columns:  ((A[:₁,:₀] / (table j, ∥A[:,j]∥))[:₁,:₀])[:,:]
  --         The core operation (A[:₁,:₀] / (table j, ∥A[:,j]∥) produces `B : ι₁ ↦ ι₀ ↦ α`. Uncurrying back to `ι₀ × ι₁ ↦ α` is the awful (`B[:₁,:₀])[:,:]`
  --
  --  Corner/Odd cases:
  --        1. curry and uncurry:  (f[:₀,:₁])[:,:]  ==  table (k,l)     => (table i j => f[i,j])[k,l]  ==  f
  --        2. not the same as 1:   f[:₀,:₁] [:,:]  ==  table (i,j,k) l => f[i,l][j,k]                !=  f
  --        3. transpose:          (f[:₁,:₀])[:,:]  ==  table (k,l)     => (table j i => f[i,j])[k,l]  ==  transpose f
  --        4. uncurry:             f[:][:]         ==  table (i,j)     => f[i][j]
  --        5. curry:               f[:₀,:₁]        ==  table i j       => f[i,j]
  --        6. identity:            f[:]            ==  table i         => f[i]
  --        7. identity:           (f[:])[:]        ==  table i         => (table j => f[j])[i]
  --
  --  For indices that are Enumtype add ranged notation
  --      1. f[a:b]     == table     i : Fin (dist a b)      => f[offset a i]   : Fin (dist a b) ↦ α
  --      2. f[a:b,:]   == table (i,j) : Fin (dist a b) × ι₁ => f[offset a i, j]  : Fin (dist a b)×ι₁ ↦ α
  --      3. f[a:b,:₁]  == table     (i: Fin (dist a b)) j   => f[offset a i, j]  : Fin (dist a b) ↦ ι₁ ↦ α
  --      where (dist a b)   := (toFin b).1 - (toFin a).1
  --            (offset a i) := fromFin (i.1 + (toFin a).1)

  macro c:term noWs "[" i1:term"]" : term =>
    `(get $c $i1)

  macro c:term noWs "[" i1:term "," i2:term "]" : term =>
    `(get $c ($i1,$i2))

  macro c:term noWs "[" i1:term "," i2:term "," i3:term "]" : term =>
    `(get $c ($i1,$i2,$i3))

  macro c:term noWs "[" i1:term "," i2:term "," i3:term "," i4:term "]" : term =>
    `(get $c ($i1,$i2,$i3,$i4))

  section ExtraOperations

     -- Here we use formulation with [Trait C] [Table C (Index C) (Value C)]
     -- instead of [Table C ι α]
     --
     -- This way, for example, `Intro.intro` needs to infer only `C` and does not have to infer `ι` and ‵α`
     -- Plus when declaring instance you can just write, for example, `instance {T} : Intro T`.

     class Intro (C : Type u) [Trait C] [Table C (Index C) (Value C)] where
       intro : (Index C → Value C) → C
       valid : ∀ f i, (intro f)[i] = f i

     export Intro (intro)

     instance {C ι α} [Table C ι α] [Intro C] : Coe (ι ↦ α) C := ⟨λ f => intro f⟩

     class Set (C : Type u) [Trait C] [Table C (Index C) (Value C)] where
       set : C → (Index C) → (Value C) → C
       valid : ∀ c i a, ((set c i a)[i] = a) ∧
                        (∀ j, j ≠ i → (set c i a)[j] = c[j])

     export Set (set)

     class MapIdx (C : Type u) [Trait C] [Table C (Index C) (Value C)] where
       mapIdx : ((Index C) → (Value C) → (Value C)) → C → C
       valid : ∀ f c i, (mapIdx f c)[i] = f i (c[i])

     export MapIdx (mapIdx)

     class Map (C : Type u) [Trait C] [Table C (Index C) (Value C)] where
       map : ((Value C) → (Value C)) → C → C
       valid : ∀ f c i, (map f c)[i] = f (c[i])

     export Map (map)

     -- export Map₂ (map₂)

     -- Some tables can have infinite index set `(Index C)` but only finite many indices actually hold a value
     -- Prime example is OpenVDB/NanoVDB but sparse matrices also qualify for this
     class Active (C : Type u) [Trait C] [Table C (Index C) (Value C)] where
       active : C → (Index C) → Bool
       finite : (c : C) → Enumtype {i : (Index C) // active c i = true }

     -- Add ActiveMapIdx -- runs map only over active indices

  end ExtraOperations

  section BasicIdentities

    variable {C : Type u} {ι : Type v} {α : Type w}
    variable [Table C ι α] [Intro C]

    @[simp] theorem get_intro (f : Index C → Value C) : (intro f)[i] = f i := by apply Intro.valid; done
    @[simp] theorem intro_get (c : C) : intro (λ i => c[i]) = c := sorry
    @[simp] theorem get_tableFun {ι : Type v} {α : Type w} (i : ι) (f : ι ↦ α) : f[i] = f i := by rfl

  end BasicIdentities

  section AlgebraicOperations

     variable {C : Type u}
     variable [Trait C] [Table C (Index C) (Value C)] [Intro C]

     instance instTableAdd [Add (Value C)] : Add C := ⟨λ c d => intro (λ i => c[i] + d[i])⟩
     instance instTableSub [Sub (Value C)] : Sub C := ⟨λ c d => intro (λ i => c[i] - d[i])⟩
     instance instTableNeg [Neg (Value C)] : Neg C := ⟨λ c => intro (λ i => -c[i])⟩
     instance instTableHMul {α} [HMul α (Value C) (Value C)] : HMul α C C := ⟨λ s c => intro (λ i => s * c[i])⟩
     instance instTableZero [Zero (Value C)] : Zero C := ⟨intro λ _ => 0⟩

     -- TODO: Add instances for different algebraic structures like Group

     -- This section is probably a bit controversial as we probably do not want those theorems inside of `simp` tactic
     -- They should be used in a specialized tactic optimizing algebraic expressions with tables
     section UnfoldOperations

       -- variable {C} [Trait C] [Table C (Index C) (Value C)] [Vec (Value C)] [Intro C]
       -- variable [Trait C] [Table C (Index C) (Value C)] [Intro C]

       -- Unfold definition's of vector oprations back
       -- This way we can get fast saxpy type operations i.e.`s*x+y` transforms to `intro λ i => s*x[i] + y[i]`
       -- We specify class instances directly to prevent crazy TC searches.
       theorem add_norm [Add (Value C)] (c d : C) : HAdd.hAdd (self := instHAdd) c d = intro (λ i => c[i] + d[i]) := by rfl
       theorem sub_norm [Sub (Value C)] (c d : C) : HSub.hSub (self := instHSub) c d = intro (λ i => c[i] - d[i]) := by rfl
       theorem neg_norm [Neg (Value C)] (c : C) : Neg.neg (self := instTableNeg) c = intro (λ i => -c[i]) := by rfl
       theorem hmul_norm {α} [HMul α (Value C) (Value C)] (a : α) (c : C) : HMul.hMul (self := instTableHMul) a c = intro (table i => a * c[i]) := by rfl
       theorem zero_norm [Zero (Value C)]: (Zero.zero (self := instTableZero) : C) = intro (λ _ => 0) := by rfl

     end UnfoldOperations

     section UnfoldOperationsOnIntro

       theorem add_norm' {C ι α} [Table C ι α] [Intro C] [Add α] (c d : C)
         : HAdd.hAdd (self := instHAdd) c d = intro (λ i => c[i] + d[i]) := by rfl

       -- @[simp]
       -- theorem sub_norm' {C ι α} [Table C ι α] [Intro C] [Sub α] (c d : C)
       --   : HSub.hSub (self := instHSub) c d = intro (λ i => c[i] - d[i]) := by rfl

       -- theorem neg_norm' {C ι α} [Table C ι α] [Intro C] [Neg α] (c : C)
       --   : Neg.neg (self := instTableNeg) c = intro (λ i => -c[i]) := by rfl

       -- theorem hmul_norm' {α} [HMul α (Value C) (Value C)] (a : α) (c : C) : HMul.hMul (self := instTableHMul) a c = intro (table i => a * c[i]) := by rfl
       -- theorem zero_norm' [Zero (Value C)]: (Zero.zero (self := instTableZero) : C) = intro (λ _ => 0) := by rfl

     end UnfoldOperationsOnIntro

  end AlgebraicOperations

  -- Algebraic operations on tables with lazy evaluation
  -- This provides something like Eigen's expression templates
  -- https://en.wikipedia.org/wiki/Expression_templates
  section LazyOperations

     section ElementWise
       variable {ι : Type v}
       variable {C : Type u} {α : Type w} [Table C ι α]
       variable {C' : Type u'} {α' : Type w'} [Table C' ι α']

       instance [HAdd α α' β] : HAdd C C' (ι ↦ β) := ⟨λ c c' => λ i => c[i] + c'[i]⟩
       instance [HSub α α' β] : HSub C C' (ι ↦ β) := ⟨λ c c' => λ i => c[i] - c'[i]⟩
       instance [HMul α α' β] : HMul C C' (ι ↦ β) := ⟨λ c c' => λ i => c[i] * c'[i]⟩
       instance [HDiv α α' β] : HDiv C C' (ι ↦ β) := ⟨λ c c' => λ i => c[i] / c'[i]⟩

       -- TODO: Add other homogenous lazy oprations
       instance [Add α] : Add (ι ↦ α) := ⟨λ c c' => λ i => c[i] + c'[i]⟩
       instance [Zero α] : Zero (ι ↦ α) := ⟨λ i => 0⟩

       @[simp] theorem elwise_hadd_apply [HAdd α α' β] (c : C) (c' : C') (i) : (c + c')[i] = c[i] + c'[i] := by simp[HAdd.hAdd] done
       @[simp] theorem elwise_hsub_apply [HSub α α' β] (c : C) (c' : C') (i) : (c - c')[i] = c[i] - c'[i] := by simp[HSub.hSub] done
       @[simp] theorem elwise_hmul_apply [HMul α α' β] (c : C) (c' : C') (i) : (c * c')[i] = c[i] * c'[i] := by simp[HMul.hMul] done
       @[simp] theorem elwise_hdiv_apply [HDiv α α' β] (c : C) (c' : C') (i) : (c / c')[i] = c[i] / c'[i] := by simp[HDiv.hDiv] done

     end ElementWise

     --- Matrix style multiplication
     section Mul
       -- These instances are a bit finicky and can easily lead to infinite loop
       -- It is important to first look for instance `Table` and only then for
       -- instances of `HMul α α' β` or `Iterable κ`

       variable {ι κ μ : Type v}

       -- matrix * matrix
       instance {C : Type u} {α : Type w} [Table C (ι×κ) α]
                {C' : Type u'} {α' : Type w'} [Table C' (κ×μ) α']
                [Enumtype κ]
                [HMul α α' β] [Add β] [Zero β]
                : HMul C C' (ι × μ ↦ β)
                := ⟨toTable λ c c' (i,j) => ∑ k, (c[i, k] * c'[k,j] : β)⟩

       -- matrix * vector
       instance {C : Type u} {α : Type w} [Table C (ι×κ) α]
                {U' : Type u'} {α' : Type w'} [Table U' κ α']
                [Enumtype κ]
                [HMul α α' β] [Add β] [Zero β]
                : HMul C U' (ι ↦ β)
                := ⟨λ c u i => ∑ k, c[i,k] * u[k]⟩

       -- vector * matrix
       instance {U : Type u} {α : Type w} [Table U κ α]
                {C' : Type u'} {α' : Type w'} [Table C' (κ×μ) α']
                [Enumtype κ]
                [HMul α α' β] [Add β] [Zero β]
                : HMul U C' (μ ↦ β)
                := ⟨λ u c k => ∑ j, u[j] * c[j,k]⟩

       instance {U : Type u} {α : Type w} [Table U κ α]
                {U' : Type u'} {α' : Type w'} [Table U' κ α']
                [Enumtype κ]
                [HMul α α' β] [Add β] [Zero β]
                : HMul U U' β
                := ⟨λ u v => ∑ i, u[i] * v[i]⟩

       -- TODO: Add other unfolding theorems

       -- fix:
       -- @[simp] theorem hmul_apply [HMul α α' β] [Add β] [Zero β]
       --                 (c : C) (c' : C')
       --                 : (c*c')[i,j] = ∑ k, c[i, k] * c'[k,j]
       --                 := by simp[HMul.hMul,Mul.mul] done

     end Mul

     section Broadcasting

       -- still not sure how to state theorems and instances about `Table`
       -- variable {C : Type u} [Trait C] [Table C (Index C) (Value C)] [Intro C]
       variable {C : Type u} {ι : Type v} {α : Type w} [Table C ι α]

       -- Thise two can lead to ambiquous notation, we prefer the later
       -- i.e. The class `HAdd C (ι ↦ α) (ι ↦ ι ↦ α)` class has two different instance that are not equal!!!
       -- The second one ensures that `(c + b)[i] = c[i] + b[i]`
       instance (priority := low) [Add α] : HAdd C α (ι ↦ α) := ⟨λ c a i => c[i]+a⟩
       instance (priority := low) [Add α] : HAdd α C (ι ↦ α) := ⟨λ a c i => a+c[i]⟩
       instance [HAdd α β α] : HAdd C (ι ↦ β) (ι ↦ α) := ⟨λ c b i => c[i]+b[i]⟩
       instance [HAdd β α α] : HAdd (ι ↦ β) C (ι ↦ α) := ⟨λ b c i => b[i]+c[i]⟩

       instance (priority := low) [Sub α] : HSub C α (ι ↦ α) := ⟨λ c a i => c[i]-a⟩
       instance (priority := low) [Sub α] : HSub α C (ι ↦ α) := ⟨λ a c i => a-c[i]⟩
       instance [HSub α β α] : HSub C (ι ↦ β) (ι ↦ α) := ⟨λ c b i => c[i]-b[i]⟩
       instance [HSub β α α] : HSub (ι ↦ β) C (ι ↦ α) := ⟨λ b c i => b[i]-c[i]⟩

       -- Not sure about these as they might clash with HMul β C C
       instance (priority := low) [HMul α β α] : HMul C β (ι ↦ α) := ⟨λ c b i => c[i]*b⟩
       instance (priority := low) [HMul β α α] : HMul β C (ι ↦ α) := ⟨λ b c i => b*c[i]⟩
       instance [HMul α β α] : HMul C (ι ↦ β) (ι ↦ α) := ⟨λ c b i => c[i]*b[i]⟩
       instance [HMul β α α] : HMul (ι ↦ β) C (ι ↦ α) := ⟨λ b c i => b[i]*c[i]⟩

       instance (priority := low) [Div α] : HDiv C α (ι ↦ α) := ⟨λ c a i => c[i]/a⟩
       instance (priority := low) [Div α] : HDiv α C (ι ↦ α) := ⟨λ a c i => a/c[i]⟩
       instance [HDiv α β α] : HDiv C (ι ↦ β) (ι ↦ α) := ⟨λ c b i => c[i]/b[i]⟩
       instance [HDiv β α α] : HDiv (ι ↦ β) C (ι ↦ α) := ⟨λ b c i => b[i]/c[i]⟩

       @[simp] theorem hadd_apply_1 [Add α] (c : C) (a : α) (i) : (c + a)[i] = c[i] + a := by simp[HAdd.hAdd] done
       @[simp] theorem hadd_apply_2 [Add α] (c : C) (a : α) (i) : (a + c)[i] = a + c[i] := by simp[HAdd.hAdd] done
       @[simp] theorem hadd_apply_3 [HAdd α β α] (c : C) (b : ι ↦ β) (i) : (c + b)[i] = c[i] + b[i] := by simp[HAdd.hAdd] done
       @[simp] theorem hadd_apply_4 [HAdd β α α] (c : C) (b : ι ↦ β) (i) : (b + c)[i] = b[i] + c[i] := by simp[HAdd.hAdd] done

       @[simp] theorem hsub_apply_1 [Sub α] (c : C) (a : α) (i) : (c - a)[i] = c[i] - a := by simp[HSub.hSub] done
       @[simp] theorem hsub_apply_2 [Sub α] (c : C) (a : α) (i) : (a - c)[i] = a - c[i] := by simp[HSub.hSub] done
       @[simp] theorem hsub_apply_3 [HSub α β α] (c : C) (b : ι ↦ β) (i) : (c - b)[i] = c[i] - b[i] := by simp[HSub.hSub] done
       @[simp] theorem hsub_apply_4 [HSub β α α] (c : C) (b : ι ↦ β) (i) : (b - c)[i] = b[i] - c[i] := by simp[HSub.hSub] done

       @[simp] theorem hmul_apply_1 [Mul α] (c : C) (a : α) (i) : (c * a)[i] = c[i] * a := by simp[HMul.hMul] done
       @[simp] theorem hmul_apply_2 [Mul α] (c : C) (a : α) (i) : (a * c)[i] = a * c[i] := by simp[HMul.hMul] done
       @[simp] theorem hmul_apply_3 [HMul α β α] (c : C) (b : ι ↦ β) (i) : (c * b)[i] = c[i] * b[i] := by simp[HMul.hMul] done
       @[simp] theorem hmul_apply_4 [HMul β α α] (c : C) (b : ι ↦ β) (i) : (b * c)[i] = b[i] * c[i] := by simp[HMul.hMul] done

       @[simp] theorem hdiv_apply_1 [Div α] (c : C) (a : α) (i) : (c / a)[i] = c[i] / a := by simp[HDiv.hDiv] done
       @[simp] theorem hdiv_apply_2 [Div α] (c : C) (a : α) (i) : (a / c)[i] = a / c[i] := by simp[HDiv.hDiv] done
       @[simp] theorem hdiv_apply_3 [HDiv α β α] (c : C) (b : ι ↦ β) (i) : (c / b)[i] = c[i] / b[i] := by simp[HDiv.hDiv] done
       @[simp] theorem hdiv_apply_4 [HDiv β α α] (c : C) (b : ι ↦ β) (i) : (b / c)[i] = b[i] / c[i] := by simp[HDiv.hDiv] done

     end Broadcasting

  end LazyOperations

  section ForInNotation

    -- Usefull for modifying a table as we want to run only over indices and not values
    open Enumtype in
    def allIdx {C} (c : C) [Trait C] [Enumtype (Index C)] : Range (Index C) := fullRange (Index C)

    -- notation:
    --      for (a,i,li) in F do
    --          ..
    -- This seems to be broken ...
    -- open Enumtype in
    -- instance {m} [Monad m] {ι} {α : Type w} [Enumtype ι] [ForIn m (Range ι) (ι × Nat)]
    --          : ForIn m (ι ↦ α) (α × ι × Nat) :=
    -- {
    --   forIn := λ F init f => do
    --              let mut val := init
    --              for (i,li) in fullRange ι do
    --                match (← f (F[i], i, li) val) with
    --                | ForInStep.done d => return d
    --                | ForInStep.yield d => val ← d
    --              pure init
    -- }

  end ForInNotation

  -- View of a table if usefull if you want to modify a subset of a table and still refer to it as a table
  section TableView

    def TableView {κ} (C : Type u) [Trait C] (tr : κ → (Index C)) := C
    def view   {κ} {C} [Trait C] (c : C) (tr : κ → (Index C)) : TableView C tr := c
    def unview {κ} {C} [Trait C] {tr : κ → (Index C)} (c : TableView C tr) : C := c

    instance {κ} (C : Type u) [Trait C] (tr : κ → (Index C)) : Trait (TableView C tr) :=
    {
      Index := κ
      Value := (Value C)
    }

    instance {C ι α κ} [Table C ι α] (tr : κ → ι) : Table (TableView C tr) κ α :=
    {
      toFun := λ c j => (unview c)[tr j]
    }

    instance {C ι α κ} [Table C ι α] (tr : κ → ι) [Set C] : Set (TableView C tr) :=
    {
      set := λ c j a => view (set (unview c) (tr j) a) tr
      valid := sorry
    }

  end TableView

  section BasicTests

     -- def test : IO Unit := do
     --     for (a,i,li) in (table i : Fin 2 × Fin 3 × Fin 4 => i.2) do
     --        IO.println s!"i = {i}  |  li = {li}  |  a = {a}"

     -- #eval test

     variable (ℝ : Type) [Add ℝ] [Sub ℝ] [Neg ℝ] [Zero ℝ]
     variable (A : Fin n × Fin m ↦ ℝ)

     -- curry
     example : Fin n ↦ Fin m ↦ ℝ := (table i j => A[i,j])
     -- example : A[:₀,:₁] = (table i j => A[i,j]) := by rfl

     -- curry and swap
     example : Fin m ↦ Fin n ↦ ℝ := (table j i => A[i,j])
     -- example : A[:₁,:₀] = (table j i => A[i,j]) := by rfl

     -- transpose
     example : Fin m × Fin n ↦ ℝ := λ (i,j) => A[j,i]
     -- example : (A[:₁,:₀])[:,:] = table (i,j) => A[j,i] := by rfl

     -- sum rows v1
     example : Fin n ↦ ℝ := (∑ j, table i => A[i,j])
     -- example : (∑ j, A[:,j]) = (∑ j, table i => A[i,j]) := by rfl

     -- sum rows v2
     example : Fin n ↦ ℝ := (table i => ∑ j, A[i,j])
     example : (∑ j, A[·,j]) = (table i => ∑ j, A[i,j]) := by rfl
     example : (table i => ∑ j, A[i,j]) = (∑ j, table i => A[i,j]) := by funext i; admit  --- TODO: (∑ i, f i) x = (∑ i, f i x)

     -- center columns -- common task in data analysis
     -- example : Fin n × Fin m ↦ ℝ := λ (i,j) => A[i,j] - ∑ j', A[i,j']
     -- example : (A[:₀,:₁] - ∑ j', A[:,j'])[:,:] = table (i,j) => A[i,j] - ∑ j', A[i,j'] := by rfl
     --- Future notation:
     --      A[:₀,:₁]                  : Fin n ↦ Fin m ↦ ℝ
     --      ∑ j', A[:,j']             : Fin n          ↦ ℝ
     --      A[:₀,:₁] - ∑ j', A[:,j']  : Fin n ↦ Fin m ↦ ℝ
     --
     --- Alternatively:
     --      A[:₁,:₀]                  : Fin m ↦ Fin n ↦ ℝ
     --      ∑ j', A[:,j']             :          Fin n ↦ ℝ
     --      A[:₁,:₀] - ∑ j', A[:,j']  : Fin m ↦ Fin n ↦ ℝ

     -- This is ambiguous if `n == m` and we prefer the first one!

     -- variable (M : Fin n × Fin n ↦ ℝ)
     -- example : Fin n ↦ Fin n ↦ ℝ := (table i j => M[i,j]) - (table i => ∑' j, M[i,j])  --- This is ambiguous notation! Not clear what
     -- should be prefered?
     -- example : (table i j => M[i,j]) - (∑' j, table i => M[i,j]) = (table i j => M[i,j] - ∑' j', M[i,j']) := by funext x y; simp[HSub.hSub,Sub.sub]; admit  --- TODO: (∑' i, f i) x = (∑' i, f i x)
     -- example : (table i j => M[i,j]) - (∑' j, table i => M[i,j]) = (table i j => M[i,j] - ∑' j', M[j,j']) := NOT TRUE

     -- normalize columns
     -- example : Fin n × Fin m ↦ ℝ := λ (i,j) => A[i,j] / ∥λ i' => A[i',j]∥
     -- example : A[:₁,:₀] / (table j => ∥A[:,j]∥) = (λ (i,j) => A[i,j] / Math.sqrt (∑ i', A[i',j]*A[i',j])) := by rfl
     -- example : (table j i => A[i,j]) / (table j => ∥λ i => A[i,j]∥) = (table j i => A[i,j] / ∥λ i' => A[i',j]∥) := sorry
     -- example : M[:₁,:₀] / (table j => ∥A[:,j]∥) = (λ (i,j) => A[i,j] / Math.sqrt (∑ i', A[i',j]*A[i',j])) := by rfl

  end BasicTests

  section TestBLASOperations
    variable {C} [Trait C] [Table C (Index C) (Value C)] [Intro C]
    variable {S X} [Add X] [Sub X] [Neg X] [HMul S X X]
    abbrev xpy  (x y : X) := x + y
    abbrev saxpy (s : S) (x y : X) := s*x + y
    abbrev saxsrypnz (s r : S) (x y z: X) := s*x - r*y + (-z)

    variable {α} [Add (Value C)] [Sub (Value C)] [Neg (Value C)] [HMul α (Value C) (Value C)]
    -- example (x y : C) : xpy x y = intro (λ i => x[i] + y[i]) := by simp done
    -- example (s : α) (x y : C) : saxpy s x y = intro (λ i => s*x[i] + y[i]) := by simp done
    -- example (s r : α) (x y z  : C) : saxsrypnz s r x y z = intro (λ i => s*x[i] - r*y[i] + -z[i]) := by simp done
  end TestBLASOperations

end Table


import category_theory.adjunction
import category_theory.comma
import category_theory.punit
import category_theory.limits.types

open category_theory opposite

variables (C : Type) [category.{0} C] (F : C ⥤ Type) (G : Cᵒᵖ ⥤ Type)

def presheaf_to_copresheaf : (Cᵒᵖ ⥤ Type) ⥤ (C ⥤ Type)ᵒᵖ :=
functor.right_op (coyoneda ⋙ (whiskering_left C (Cᵒᵖ ⥤ Type) Type).obj yoneda)

def copresheaf_to_presheaf : (C ⥤ Type)ᵒᵖ ⥤ (Cᵒᵖ ⥤ Type) :=
coyoneda ⋙ (whiskering_left Cᵒᵖ (C ⥤ Type) Type).obj coyoneda

local attribute [simp] copresheaf_to_presheaf presheaf_to_copresheaf

example : presheaf_to_copresheaf C ⊣ copresheaf_to_presheaf C :=
adjunction.mk_of_unit_counit
  { unit :=
    { app := λ F,
      { app := λ X FX,
        { app := λ Y f, f.app X FX },
          naturality' := begin
            intros X Y f,
            ext FX Z g,
            dsimp at *,
            exact function.funext_iff.1 (g.naturality f) FX
          end } },
    counit :=
    { app := λ F, show op (unop ((presheaf_to_copresheaf C).obj
          ((copresheaf_to_presheaf C).obj F))) ⟶ op (unop F),
        from quiver.hom.op
      { app := λ X FX,
        { app := λ Y f, f.app X FX },
          naturality' := begin
            intros X Y f,
            ext FX Z g,
            dsimp at *,
            exact function.funext_iff.1 (g.naturality f) FX
          end } },
    left_triangle' := begin
      ext F,
      dsimp [presheaf_to_copresheaf, copresheaf_to_presheaf],
      refine quiver.hom.unop_inj _,
      ext, refl
    end,
    right_triangle' := by { ext, refl } }

def as_cone (X : C) : limits.cone (comma.snd ((category_theory.functor.const (discrete unit)).obj X) (𝟭 C)) :=
{ X := X,
  π :=
  { app := λ Y, Y.hom,
    naturality' := λ Y Z f, f.3 } }

def is_limit_as_cone (X : C) : limits.is_limit (as_cone C X) :=
{ lift := λ s, s.2.app ⟨(), X, 𝟙 X⟩,
  fac' := λ s j, begin
      dsimp [as_cone],
      let f : (⟨(), X, 𝟙 X⟩ : comma ((category_theory.functor.const (discrete unit)).obj X) (𝟭 C)) ⟶ j :=
        ⟨⟨⟨subsingleton.elim _ _⟩⟩, j.hom, by tidy⟩,
      have := (@s.2.naturality f).symm,
      dsimp at *,
      simp [this]
    end,
  uniq' := λ s m h, begin
    dsimp [as_cone] at *,
    rw ← h,
    simp,
  end }

def iso_of_preserves_limits (F : Cᵒᵖ ⥤ Type) [limits.preserves_limits F] :
  F ≅ (copresheaf_to_presheaf C).obj ((presheaf_to_copresheaf C).obj F) :=
nat_iso.of_components
  (λ X,
    { hom := λ FX, { app := λ Y f, f.app X FX },
      inv := λ f,
      begin
        dsimp at *,
        have := f.app,
        dsimp at this,
        apply (limits.is_limit_of_preserves F (is_limit_as_cone Cᵒᵖ X)).lift
          (limits.limit.cone _),
        dsimp [as_cone] at *,
        tidy,
        rcases j with ⟨⟨⟩, j, g⟩,
        dsimp at *,
        have x : F.obj X := sorry,
        exact F.map g x,
        dsimp,
        funext,

      end }  )
  _

variable {C}

structure corepresentation :=
( corepr : C )
( unit : F.obj corepr )
( extend : Π {X : C}, F.obj X → (corepr ⟶ X) )
( map_extend_unit {X : C} (f : F.obj X) : F.map (extend f) unit = f )
( unit_map_extend {X : C} (f : corepr ⟶ X) : extend (F.map f unit) = f )

def hom_ext {R : corepresentation F} {X : C} {f g : R.corepr ⟶ X}
  (h : F.map f R.unit = F.map g R.unit) : f = g :=
by rw [← R.unit_map_extend f, h, R.unit_map_extend]

example (R : corepresentation F) {X Y : C} (f : F.obj X) (g : X ⟶ Y) :
  R.extend f ≫ g = R.extend (F.map g f) :=
hom_ext _ $ by simp [R.map_extend_unit]

def is_repr (R : corepresentation F) : (coyoneda.obj (op R.corepr)) ≅ F :=
nat_iso.of_components
  (λ X, { hom := λ f, F.map f R.unit,
          inv := λ f, R.extend f,
          hom_inv_id' := by funext x; simp [R.unit_map_extend],
          inv_hom_id' := by funext x; simp [R.map_extend_unit] })
  begin
    intros X Y f,
    funext x,
    simp
  end

structure corepresentation2 :=
( corepr : C )
( unit : F.obj corepr )
( extend : Π {X : C}, F.obj X → (corepr ⟶ X) )
( map_extend_unit {X : C} (f : F.obj X) : F.map (extend f) unit = f )
( extend_unit : extend unit = 𝟙 corepr )
( extend_comp {X Y : C} (f : F.obj X) (g : X ⟶ Y) : extend f ≫ g = extend (F.map g f) )

example (R : corepresentation2 F) : corepresentation F :=
{ unit_map_extend := begin
    intros X f,
    rw [← R.extend_comp, R.extend_unit, category.id_comp],
  end
  ..R }

structure representation2 :=
( repr : C )
( counit : G.obj (op repr) )
( restrict : Π {X : C}, G.obj (op X) → (X ⟶ repr ) )
( map_restrict_counit {X : C} (f : G.obj (op X)) : G.map ((restrict f).op) counit = f )
( restrict_counit : restrict counit = 𝟙 repr )
( comp_restrict {X Y : C} (f : G.obj (op X)) (g : Y ⟶ X) : g ≫ restrict f = restrict (G.map g.op f) )

example (R : representation2 G) : corepresentation2 (presheaf_to_copresheaf G) :=
{ corepr := R.repr,
  unit := begin
    dsimp [presheaf_to_copresheaf],
    have := R.counit,

  end, }


import .ops
open subtype nnf model

def unmodal_seqt (Γ : seqt) : list seqt :=
list.map
(λ d,
{main := d :: (unbox (Γ.main ++ Γ.hdld)), hdld := [],
 pmain := begin intros v hv φ hsat hin hall, exfalso, apply list.not_mem_nil, exact hin end,
 phdld := box_only_nil})
(undia (Γ.main ++ Γ.hdld))

def unmodal_nil_hdld (Γ : seqt) : ∀ (i : seqt),  i ∈ unmodal_seqt Γ → (i.hdld = []) :=
list.mapp _ _
begin intros φ h, constructor end

def unmodal_seqt_size (Γ : seqt) : ∀ (i : seqt),  i ∈ unmodal_seqt Γ → (prod.measure_lex seqt_size i Γ) :=
list.mapp _ _
begin
  intros φ h,
  constructor, simp [-list.map_append],
  apply undia_degree h
end

def unmodal_mem_box (Γ : seqt) : ∀ (i : seqt),  i ∈ unmodal_seqt Γ → (∀ φ, box φ ∈ Γ.main ++ Γ.hdld → φ ∈ i.main) :=
list.mapp _ _ begin intros φ h ψ hψ, right, apply (@unbox_iff (Γ.main++Γ.hdld) ψ).1 hψ end

def unmodal_sat_of_sat (Γ : seqt) : ∀ (i : seqt),  i ∈ unmodal_seqt Γ →
(∀ {st : Type} (k : KT st) s Δ
(h₁ : ∀ φ, box φ ∈ Γ.main++Γ.hdld → box φ ∈ Δ)
(h₂ : ∀ φ, dia φ ∈ Γ.main++Γ.hdld → dia φ ∈ Δ),
sat k s Δ → ∃ s', sat k s' i.main) :=
list.mapp _ _
begin
  intros φ hmem st k s Δ h₁ h₂ h,
  have : force k s (dia φ),
    { apply h, apply h₂, rw undia_iff, exact hmem },
  rcases this with ⟨w, hrel, hforce⟩,
  split, swap, {exact w},
  { intro ψ, intro hψ, cases hψ,
    {rw hψ, exact hforce},
    {have := h₁ _ ((@unbox_iff (Γ.main++Γ.hdld) ψ).2 hψ),
     have := h _ this,
     apply this _ hrel} },
end

-- TODO: Rewrite this ugly one.
def mem_unmodal_seqt (Γ : seqt) (φ) (h : φ ∈ undia (Γ.main++Γ.hdld)) :
(⟨φ :: unbox (Γ.main++Γ.hdld), [], begin intros v hv φ hsat hin hall, exfalso, apply list.not_mem_nil, exact hin end, box_only_nil⟩ : seqt) ∈ unmodal_seqt Γ :=
begin
  dsimp [unmodal_seqt],
  apply list.mem_map_of_mem (λ φ, (⟨φ :: unbox (Γ.main++Γ.hdld), _,_,_⟩:seqt)) h
end

def unsat_of_unsat_unmodal {Γ : seqt} (h : modal_applicable Γ) (i : seqt) : i ∈ unmodal_seqt Γ ∧ unsatisfiable (i.main ++ i.hdld) → unsatisfiable (Γ.main ++ Γ.hdld) :=
begin
  intro hex, intros st k s h,
  have := unmodal_sat_of_sat Γ i hex.1 k s (Γ.main ++ Γ.hdld) (λ x hx, hx) (λ x hx, hx) h,
  cases this with w hw,
  have := hex.2,
  rw (unmodal_nil_hdld _ _ hex.1) at this,
  simp at this,
  exact this _ _ _ hw
end

/- Part of the soundness -/

theorem unsat_of_closed_and {Γ Δ} (i : and_instance Γ Δ) (h : unsatisfiable Δ) : unsatisfiable Γ :=
by cases i; { apply unsat_and_of_unsat_split, repeat {assumption} }

theorem unsat_of_closed_and_seqt {Γ Δ} (i : and_instance_seqt Γ Δ) (h : unsatisfiable (Δ.main++Δ.hdld)) : unsatisfiable (Γ.main++Γ.hdld) :=
begin
cases i, {apply unsat_and_of_unsat_split_seqt, repeat {assumption} }
end

theorem unsat_of_closed_or_seqt {Γ₁ Γ₂ Δ : seqt} (i : or_instance_seqt Δ Γ₁ Γ₂)
(h₁ : unsatisfiable (Γ₁.main++Γ₁.hdld))
(h₂ : unsatisfiable (Γ₂.main++Γ₂.hdld)) :
unsatisfiable (Δ.main++Δ.hdld) :=
begin
cases i, {apply unsat_or_of_unsat_split_seqt, repeat {assumption}}
end

/- Tree models -/

inductive batch_sat_seqt : list model → list seqt → Prop
| bs_nil : batch_sat_seqt [] []
| bs_cons (m) (Γ:seqt) (l₁ l₂) : sat builder m (Γ.main++Γ.hdld) →
                                 batch_sat_seqt l₁ l₂ →
                                 batch_sat_seqt (m::l₁) (Γ::l₂)

open batch_sat_seqt

theorem bs_ex_seqt : Π l Γ,
batch_sat_seqt l Γ → ∀ m ∈ l, ∃ i ∈ Γ, sat builder m (seqt.main i ++ i.hdld)
| l Γ bs_nil := λ m hm, by simpa using hm
| l Γ (bs_cons m Δ l₁ l₂ h hbs) :=
begin
  intros n hn,
  cases hn,
  {split, swap, exact Δ, split, simp, rw hn, exact h},
  {have : ∃ (i : seqt) (H : i ∈ l₂), sat builder n (i.main ++ i.hdld),
     {apply bs_ex_seqt, exact hbs, exact hn},
  {rcases this with ⟨w, hw, hsat⟩, split, swap, exact w, split,
   {simp [hw]}, {exact hsat} } }
end

theorem bs_forall_seqt : Π l Γ,
batch_sat_seqt l Γ → ∀ i ∈ Γ, ∃ m ∈ l, sat builder m (seqt.main i ++ i.hdld)
| l Γ bs_nil := λ m hm, by simpa using hm
| l Γ (bs_cons m Δ l₁ l₂ h hbs) :=
begin
  intros i hi,
  cases hi, {split, swap, exact m, split, simp, rw hi, exact h},
  {have : ∃ (n : model) (H : n ∈ l₁), sat builder n (seqt.main i ++ i.hdld),
     {apply bs_forall_seqt, exact hbs, exact hi},
  {rcases this with ⟨w, hw, hsat⟩, split, swap, exact w, split,
   {simp [hw]}, {exact hsat} } }
end

theorem sat_of_batch_sat_main : Π l Γ (h : modal_applicable Γ),
batch_sat_seqt l (unmodal_seqt Γ) →
sat builder (cons h.v l) (Γ.main) :=
begin
  intros l Γ h hbs,
  intros φ hφ,
  cases hfml : φ,
  case nnf.var : n
  {rw hfml at hφ, simp, rw ←h.hv,
   exact hφ },
  case nnf.box : ψ
  {exfalso, rw hfml at hφ, apply h.no_box_main, exact hφ},
  case nnf.dia : ψ
  {dsimp,
   let se : seqt :=
{main := ψ :: (unbox (Γ.main ++ Γ.hdld)), hdld := [],
 pmain := begin intros v hv φ hsat hin hall, exfalso, apply list.not_mem_nil, exact hin end,
 phdld := box_only_nil},
   have := bs_forall_seqt l (unmodal_seqt Γ) hbs se _, swap,
   {dsimp [unmodal_seqt], apply list.mem_map_of_mem (λ φ, (⟨φ :: unbox (Γ.main++Γ.hdld),_,_,_⟩:seqt)), rw ←undia_iff, rw ←hfml, simp [hφ] },
   {rcases this with ⟨w, hw, hsat⟩, split, swap, exact w, split,
    {simp [hw]}, {apply hsat, simp} } },
  case nnf.neg : n
  {dsimp, rw hfml at hφ, have : var n ∉ Γ.main,
   {intro hin, have := h.no_contra_main, have := this hin, contradiction},
    simp, rw ←h.hv, exact this },
  case nnf.and : φ ψ
  {rw hfml at hφ, have := h.satu.no_and, have := @this φ ψ, contradiction},
  case nnf.or : φ ψ
  {rw hfml at hφ, have := h.satu.no_or, have := @this φ ψ, contradiction}
end

theorem sat_of_batch_sat_box : Π l Γ (h : modal_applicable Γ),
batch_sat_seqt l (unmodal_seqt Γ) → ∀ m∈l, ∀ φ, box φ ∈ Γ.hdld → force builder m φ :=
begin
  intros l Γ h hbs m hm φ hφ,
  have := bs_ex_seqt _ _ hbs _ hm,
  rcases this with ⟨i,hin,hi⟩,
  have := unmodal_mem_box _ _ hin φ,
  apply hi,
  rw list.mem_append, left,
  apply this, simp [hφ]
end

theorem sat_of_batch_sat : Π l Γ (h : modal_applicable Γ),
batch_sat_seqt l (unmodal_seqt Γ) →
sat builder (cons h.v l) (Γ.main++Γ.hdld) :=
begin
  intros l Γ h hbs,
  apply sat_append,
  {apply sat_of_batch_sat_main, assumption},
  {intros φ hφ, have := box_only_ex Γ.phdld hφ,
   cases this with w hw,
   rw hw, dsimp, intros s' hs',
   have := mem_of_mrel_tt hs', cases this,
   {apply sat_of_batch_sat_box, exact h, exact hbs, exact this, rw hw at hφ, exact hφ},
   { rw ←this, apply Γ.pmain,
     apply sat_of_batch_sat_main, exact hbs, rw hw at hφ, exact hφ,
     { intros, apply sat_of_batch_sat_box, repeat {assumption} } }
}
end


import Lib.Data.Traversable
import Lib.Data.List.Basic

namespace List

instance : Traversable List where
  map := Functor.map
  traverse := List.mapA
  mapM := List.mapM
  foldl := List.foldl
  foldr := List.foldr
  toList := id
  length := List.length

@[simp]
theorem foldMap_nil [Monoid ω] (f : α → ω) :
  Foldable.foldMap f [] = One.one := rfl

@[simp]
theorem foldMap_cons [Monoid ω] (f : α → ω) x xs :
  Foldable.foldMap f (x :: xs) =
  Foldable.foldMap f xs * f x := by
simp [Foldable.foldMap, Foldable.foldl, foldl]
symmetry
apply foldl_sim (SIM := (. * f x = .))
. simp
intros; simp [*]

instance : LawfulFoldable List where
  foldl_sim :=  by
    intros; apply List.foldl_sim <;> auto
  toArray_toList := sorry
  length_toList := by
    intros; simp [Array.toList]; refl
  foldl_toList := by
    intros; simp [Array.toList]; refl
  foldr_eq_foldMap := by
    intros; simp [Foldable.foldr]
    next f x x₀ =>
    induction x generalizing x₀ <;> simp [foldr, *]

open Traversable

instance : LawfulTraversable List where
  map_eq_traverse := by
    intros; simp [(.<$>.), traverse];
    next x =>
    induction x <;> simp [List.map, List.mapA, *, Seq.seq]
     <;> refl
  traverse_eq_mapM := by
    intros; simp [traverse, mapM]
    next x =>
    induction x <;>
      simp [*, List.mapM, List.mapA, seq_eq_bind, map_eq_pure_bind, Traversable.mapM]
  map_const := by intros; ext; next x =>
    simp [(.∘.), (.<$>.)];
    induction x <;> simp [*, List.map, Functor.mapConst]
  id_map := by intros; simp [(.<$>.)]; next x =>
    induction x <;> simp [List.map, *]
  comp_map := by intros; simp [(.<$>.)]; next x =>
    induction x <;> simp [List.map, *]
  comp_traverse := by
    intros; simp [traverse]
    next x f g => admit
    -- induction x <;> simp [*, List.mapA, comp_lam]
    -- rw [Comp.run_seq]
    -- rw [Comp.run_map, ← comp_map]
    -- simp [*, (.∘.), seq_assoc]; congr
  foldl_eq_traverse := by
    intros; simp [Foldable.foldl, traverse]
    next x x₀ =>
    induction x generalizing x₀
    <;> simp [List.foldl, List.mapA, *]
    admit
  traverse_sim := by
    intros; next x R f g h =>
    simp [traverse]
    induction x <;> simp [List.mapA] <;> auto

end List


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

Supplementary theorems about the `char` type.
-/

instance : linear_order char :=
{ le_refl := λ a, @le_refl ℕ _ _,
  le_trans := λ a b c, @le_trans ℕ _ _ _ _,
  le_antisymm := λ a b h₁ h₂,
    char.eq_of_veq $ le_antisymm h₁ h₂,
  le_total := λ a b, @le_total ℕ _ _ _,
  lt_iff_le_not_le := λ a b, @lt_iff_le_not_le ℕ _ _ _,
  decidable_le := char.decidable_le,
  decidable_eq := char.decidable_eq,
  decidable_lt := char.decidable_lt,
  ..char.has_le, ..char.has_lt }

lemma char.of_nat_to_nat {c : char} (h : is_valid_char c.to_nat) :
  char.of_nat c.to_nat = c :=
begin
  rw [char.of_nat, dif_pos h],
  cases c,
  simp [char.to_nat]
end


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.module.basic
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Prod instances for module and multiplicative actions

This file defines instances for binary product of modules
-/

namespace prod

protected instance has_scalar {α : Type u_1} {β : Type u_2} {γ : Type u_3} [has_scalar α β]
    [has_scalar α γ] : has_scalar α (β × γ) :=
  has_scalar.mk fun (a : α) (p : β × γ) => (a • fst p, a • snd p)

@[simp] theorem smul_fst {α : Type u_1} {β : Type u_2} {γ : Type u_3} [has_scalar α β]
    [has_scalar α γ] (a : α) (x : β × γ) : fst (a • x) = a • fst x :=
  rfl

@[simp] theorem smul_snd {α : Type u_1} {β : Type u_2} {γ : Type u_3} [has_scalar α β]
    [has_scalar α γ] (a : α) (x : β × γ) : snd (a • x) = a • snd x :=
  rfl

@[simp] theorem smul_mk {α : Type u_1} {β : Type u_2} {γ : Type u_3} [has_scalar α β]
    [has_scalar α γ] (a : α) (b : β) (c : γ) : a • (b, c) = (a • b, a • c) :=
  rfl

protected instance semimodule {α : Type u_1} {β : Type u_2} {γ : Type u_3} {r : semiring α}
    [add_comm_monoid β] [add_comm_monoid γ] [semimodule α β] [semimodule α γ] :
    semimodule α (β × γ) :=
  semimodule.mk sorry sorry

end Mathlib


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.interactive
import Mathlib.PostPort

namespace Mathlib

/-!
# `dec_trivial` tactic

The `dec_trivial` tactic tries to use decidability to prove a goal.
It is basically a glorified wrapper around `exact dec_trivial`.

There is an extra option to make it a little bit smarter:
`dec_trivial!` will revert all hypotheses on which the target depends,
before it tries `exact dec_trivial`.
-/

/-- `dec_trivial` tries to use decidability to prove a goal
(i.e., using `exact dec_trivial`).
The variant `dec_trivial!` will revert all hypotheses on which the target depends,
before it tries `exact dec_trivial`.

Example:
```lean
example (n : ℕ) (h : n < 2) : n = 0 ∨ n = 1 :=
by dec_trivial!
```
-/


example (P : Prop) : ∀ {p : P}, P := by
  exact fun {p} => p

example (P : Prop) : ∀ {p : P}, P := by
  intro h; exact h

example (P : Prop) : ∀ {p : P}, P := by
  exact @id _

example (P : Prop) : ∀ {p : P}, P := by
  exact no_implicit_lambda% id

macro "exact'" x:term : tactic => `(tactic| exact no_implicit_lambda% $x)

example (P : Prop) : ∀ {p : P}, P := by
  exact' id

example (P : Prop) : ∀ {p : P}, P := by
  apply id

example (P : Prop) : ∀ p : P, P := by
  have : _ := 1
  apply id

example (P : Prop) : ∀ {p : P}, P := by
  refine no_implicit_lambda% (have : _ := 1; ?_)
  apply id

example (P : Prop) : ∀ {p : P}, P := by
  have : _ := 1
  apply id


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.encodable.basic
import Mathlib.data.finset.basic
import Mathlib.data.set.disjointed
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Lattice operations on encodable types

Lemmas about lattice and set operations on encodable types

## Implementation Notes

This is a separate file, to avoid unnecessary imports in basic files.

Previously some of these results were in the `measure_theory` folder.
-/

namespace encodable

theorem supr_decode2 {α : Type u_1} {β : Type u_2} [encodable β] [complete_lattice α] (f : β → α) :
    (supr fun (i : ℕ) => supr fun (b : β) => supr fun (H : b ∈ decode2 β i) => f b) =
        supr fun (b : β) => f b :=
  sorry

theorem Union_decode2 {α : Type u_1} {β : Type u_2} [encodable β] (f : β → set α) :
    (set.Union fun (i : ℕ) => set.Union fun (b : β) => set.Union fun (H : b ∈ decode2 β i) => f b) =
        set.Union fun (b : β) => f b :=
  supr_decode2 f

theorem Union_decode2_cases {α : Type u_1} {β : Type u_2} [encodable β] {f : β → set α}
    {C : set α → Prop} (H0 : C ∅) (H1 : ∀ (b : β), C (f b)) {n : ℕ} :
    C (set.Union fun (b : β) => set.Union fun (H : b ∈ decode2 β n) => f b) :=
  sorry

theorem Union_decode2_disjoint_on {α : Type u_1} {β : Type u_2} [encodable β] {f : β → set α}
    (hd : pairwise (disjoint on f)) :
    pairwise
        (disjoint on
          fun (i : ℕ) => set.Union fun (b : β) => set.Union fun (H : b ∈ decode2 β i) => f b) :=
  sorry

end encodable

namespace finset

theorem nonempty_encodable {α : Type u_1} (t : finset α) :
    Nonempty (encodable (Subtype fun (i : α) => i ∈ t)) :=
  sorry

end Mathlib


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Johan Commelin, Bhavik Mehta
-/
import category_theory.equivalence

/-!
# Adjunctions between functors

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

`F ⊣ G` represents the data of an adjunction between two functors
`F : C ⥤ D` and `G : D ⥤ C`. `F` is the left adjoint and `G` is the right adjoint.

We provide various useful constructors:
* `mk_of_hom_equiv`
* `mk_of_unit_counit`
* `left_adjoint_of_equiv` / `right_adjoint_of equiv`
  construct a left/right adjoint of a given functor given the action on objects and
  the relevant equivalence of morphism spaces.
* `adjunction_of_equiv_left` / `adjunction_of_equiv_right` witness that these constructions
  give adjunctions.

There are also typeclasses `is_left_adjoint` / `is_right_adjoint`, carrying data witnessing
that a given functor is a left or right adjoint.
Given `[is_left_adjoint F]`, a right adjoint of `F` can be constructed as `right_adjoint F`.

`adjunction.comp` composes adjunctions.

`to_equivalence` upgrades an adjunction to an equivalence,
given witnesses that the unit and counit are pointwise isomorphisms.
Conversely `equivalence.to_adjunction` recovers the underlying adjunction from an equivalence.
-/

namespace category_theory
open category

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ u₁ u₂ u₃

local attribute [elab_simple] whisker_left whisker_right

variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D]

/--
`F ⊣ G` represents the data of an adjunction between two functors
`F : C ⥤ D` and `G : D ⥤ C`. `F` is the left adjoint and `G` is the right adjoint.

To construct an `adjunction` between two functors, it's often easier to instead use the
constructors `mk_of_hom_equiv` or `mk_of_unit_counit`. To construct a left adjoint,
there are also constructors `left_adjoint_of_equiv` and `adjunction_of_equiv_left` (as
well as their duals) which can be simpler in practice.

Uniqueness of adjoints is shown in `category_theory.adjunction.opposites`.

See <https://stacks.math.columbia.edu/tag/0037>.
-/
structure adjunction (F : C ⥤ D) (G : D ⥤ C) :=
(hom_equiv : Π (X Y), (F.obj X ⟶ Y) ≃ (X ⟶ G.obj Y))
(unit : 𝟭 C ⟶ F.comp G)
(counit : G.comp F ⟶ 𝟭 D)
(hom_equiv_unit' : Π {X Y f}, (hom_equiv X Y) f = (unit : _ ⟶ _).app X ≫ G.map f . obviously)
(hom_equiv_counit' : Π {X Y g}, (hom_equiv X Y).symm g = F.map g ≫ counit.app Y . obviously)

infix ` ⊣ `:15 := adjunction

/-- A class giving a chosen right adjoint to the functor `left`. -/
class is_left_adjoint (left : C ⥤ D) :=
(right : D ⥤ C)
(adj : left ⊣ right)

/-- A class giving a chosen left adjoint to the functor `right`. -/
class is_right_adjoint (right : D ⥤ C) :=
(left : C ⥤ D)
(adj : left ⊣ right)

/-- Extract the left adjoint from the instance giving the chosen adjoint. -/
def left_adjoint (R : D ⥤ C) [is_right_adjoint R] : C ⥤ D :=
is_right_adjoint.left R
/-- Extract the right adjoint from the instance giving the chosen adjoint. -/
def right_adjoint (L : C ⥤ D) [is_left_adjoint L] : D ⥤ C :=
is_left_adjoint.right L

/-- The adjunction associated to a functor known to be a left adjoint. -/
def adjunction.of_left_adjoint (left : C ⥤ D) [is_left_adjoint left] :
  adjunction left (right_adjoint left) :=
is_left_adjoint.adj
/-- The adjunction associated to a functor known to be a right adjoint. -/
def adjunction.of_right_adjoint (right : C ⥤ D) [is_right_adjoint right] :
  adjunction (left_adjoint right) right :=
is_right_adjoint.adj

namespace adjunction

restate_axiom hom_equiv_unit'
restate_axiom hom_equiv_counit'
attribute [simp, priority 10] hom_equiv_unit hom_equiv_counit

section

variables {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) {X' X : C} {Y Y' : D}

lemma hom_equiv_id (X : C) : adj.hom_equiv X _ (𝟙 _) = adj.unit.app X := by simp

lemma hom_equiv_symm_id (X : D) : (adj.hom_equiv _ X).symm (𝟙 _) = adj.counit.app X := by simp

@[simp, priority 10] lemma hom_equiv_naturality_left_symm (f : X' ⟶ X) (g : X ⟶ G.obj Y) :
  (adj.hom_equiv X' Y).symm (f ≫ g) = F.map f ≫ (adj.hom_equiv X Y).symm g :=
by rw [hom_equiv_counit, F.map_comp, assoc, adj.hom_equiv_counit.symm]

@[simp] lemma hom_equiv_naturality_left (f : X' ⟶ X) (g : F.obj X ⟶ Y) :
  (adj.hom_equiv X' Y) (F.map f ≫ g) = f ≫ (adj.hom_equiv X Y) g :=
by rw [← equiv.eq_symm_apply]; simp [-hom_equiv_unit]

@[simp, priority 10] lemma hom_equiv_naturality_right (f : F.obj X ⟶ Y) (g : Y ⟶ Y') :
  (adj.hom_equiv X Y') (f ≫ g) = (adj.hom_equiv X Y) f ≫ G.map g :=
by rw [hom_equiv_unit, G.map_comp, ← assoc, ←hom_equiv_unit]

@[simp] lemma hom_equiv_naturality_right_symm (f : X ⟶ G.obj Y) (g : Y ⟶ Y') :
  (adj.hom_equiv X Y').symm (f ≫ G.map g) = (adj.hom_equiv X Y).symm f ≫ g :=
by rw [equiv.symm_apply_eq]; simp [-hom_equiv_counit]

@[simp] lemma left_triangle :
  (whisker_right adj.unit F) ≫ (whisker_left F adj.counit) = nat_trans.id _ :=
begin
  ext, dsimp,
  erw [← adj.hom_equiv_counit, equiv.symm_apply_eq, adj.hom_equiv_unit],
  simp
end

@[simp]

@[simp, reassoc] lemma left_triangle_components :
  F.map (adj.unit.app X) ≫ adj.counit.app (F.obj X) = 𝟙 (F.obj X) :=
congr_arg (λ (t : nat_trans _ (𝟭 C ⋙ F)), t.app X) adj.left_triangle

@[simp, reassoc] lemma right_triangle_components {Y : D} :
  adj.unit.app (G.obj Y) ≫ G.map (adj.counit.app Y) = 𝟙 (G.obj Y) :=
congr_arg (λ (t : nat_trans _ (G ⋙ 𝟭 C)), t.app Y) adj.right_triangle

@[simp, reassoc] lemma counit_naturality {X Y : D} (f : X ⟶ Y) :
  F.map (G.map f) ≫ (adj.counit).app Y = (adj.counit).app X ≫ f :=
adj.counit.naturality f

@[simp, reassoc] lemma unit_naturality {X Y : C} (f : X ⟶ Y) :
  (adj.unit).app X ≫ G.map (F.map f) = f ≫ (adj.unit).app Y :=
(adj.unit.naturality f).symm

lemma hom_equiv_apply_eq {A : C} {B : D} (f : F.obj A ⟶ B) (g : A ⟶ G.obj B) :
  adj.hom_equiv A B f = g ↔ f = (adj.hom_equiv A B).symm g :=
⟨λ h, by {cases h, simp}, λ h, by {cases h, simp}⟩

lemma eq_hom_equiv_apply {A : C} {B : D} (f : F.obj A ⟶ B) (g : A ⟶ G.obj B) :
  g = adj.hom_equiv A B f ↔ (adj.hom_equiv A B).symm g = f :=
⟨λ h, by {cases h, simp}, λ h, by {cases h, simp}⟩

end

end adjunction

namespace adjunction

/--
This is an auxiliary data structure useful for constructing adjunctions.
See `adjunction.mk_of_hom_equiv`.
This structure won't typically be used anywhere else.
-/
@[nolint has_nonempty_instance]
structure core_hom_equiv (F : C ⥤ D) (G : D ⥤ C) :=
(hom_equiv : Π (X Y), (F.obj X ⟶ Y) ≃ (X ⟶ G.obj Y))
(hom_equiv_naturality_left_symm' : Π {X' X Y} (f : X' ⟶ X) (g : X ⟶ G.obj Y),
  (hom_equiv X' Y).symm (f ≫ g) = F.map f ≫ (hom_equiv X Y).symm g . obviously)
(hom_equiv_naturality_right' : Π {X Y Y'} (f : F.obj X ⟶ Y) (g : Y ⟶ Y'),
  (hom_equiv X Y') (f ≫ g) = (hom_equiv X Y) f ≫ G.map g . obviously)

namespace core_hom_equiv

restate_axiom hom_equiv_naturality_left_symm'
restate_axiom hom_equiv_naturality_right'
attribute [simp, priority 10] hom_equiv_naturality_left_symm hom_equiv_naturality_right

variables {F : C ⥤ D} {G : D ⥤ C} (adj : core_hom_equiv F G) {X' X : C} {Y Y' : D}

@[simp] lemma hom_equiv_naturality_left (f : X' ⟶ X) (g : F.obj X ⟶ Y) :
  (adj.hom_equiv X' Y) (F.map f ≫ g) = f ≫ (adj.hom_equiv X Y) g :=
by rw [← equiv.eq_symm_apply]; simp

@[simp] lemma hom_equiv_naturality_right_symm (f : X ⟶ G.obj Y) (g : Y ⟶ Y') :
  (adj.hom_equiv X Y').symm (f ≫ G.map g) = (adj.hom_equiv X Y).symm f ≫ g :=
by rw [equiv.symm_apply_eq]; simp

end core_hom_equiv

/--
This is an auxiliary data structure useful for constructing adjunctions.
See `adjunction.mk_of_unit_counit`.
This structure won't typically be used anywhere else.
-/
@[nolint has_nonempty_instance]
structure core_unit_counit (F : C ⥤ D) (G : D ⥤ C) :=
(unit : 𝟭 C ⟶ F.comp G)
(counit : G.comp F ⟶ 𝟭 D)
(left_triangle' : whisker_right unit F ≫ (functor.associator F G F).hom ≫ whisker_left F counit =
  nat_trans.id (𝟭 C ⋙ F) . obviously)
(right_triangle' : whisker_left G unit ≫ (functor.associator G F G).inv ≫ whisker_right counit G =
  nat_trans.id (G ⋙ 𝟭 C) . obviously)

namespace core_unit_counit

restate_axiom left_triangle'
restate_axiom right_triangle'
attribute [simp] left_triangle right_triangle

end core_unit_counit

variables {F : C ⥤ D} {G : D ⥤ C}

/-- Construct an adjunction between `F` and `G` out of a natural bijection between each
`F.obj X ⟶ Y` and `X ⟶ G.obj Y`. -/
@[simps]
def mk_of_hom_equiv (adj : core_hom_equiv F G) : F ⊣ G :=
{ unit :=
  { app := λ X, (adj.hom_equiv X (F.obj X)) (𝟙 (F.obj X)),
    naturality' :=
    begin
      intros,
      erw [← adj.hom_equiv_naturality_left, ← adj.hom_equiv_naturality_right],
      dsimp, simp -- See note [dsimp, simp].
    end },
  counit :=
  { app := λ Y, (adj.hom_equiv _ _).inv_fun (𝟙 (G.obj Y)),
    naturality' :=
    begin
      intros,
      erw [← adj.hom_equiv_naturality_left_symm, ← adj.hom_equiv_naturality_right_symm],
      dsimp, simp
    end },
  hom_equiv_unit' := λ X Y f, by erw [← adj.hom_equiv_naturality_right]; simp,
  hom_equiv_counit' := λ X Y f, by erw [← adj.hom_equiv_naturality_left_symm]; simp,
  .. adj }

/-- Construct an adjunction between functors `F` and `G` given a unit and counit for the adjunction
satisfying the triangle identities. -/
@[simps]
def mk_of_unit_counit (adj : core_unit_counit F G) : F ⊣ G :=
{ hom_equiv := λ X Y,
  { to_fun := λ f, adj.unit.app X ≫ G.map f,
    inv_fun := λ g, F.map g ≫ adj.counit.app Y,
    left_inv := λ f, begin
      change F.map (_ ≫ _) ≫ _ = _,
      rw [F.map_comp, assoc, ←functor.comp_map, adj.counit.naturality, ←assoc],
      convert id_comp f,
      have t := congr_arg (λ t : nat_trans _ _, t.app _) adj.left_triangle,
      dsimp at t,
      simp only [id_comp] at t,
      exact t,
    end,
    right_inv := λ g, begin
      change _ ≫ G.map (_ ≫ _) = _,
      rw [G.map_comp, ←assoc, ←functor.comp_map, ←adj.unit.naturality, assoc],
      convert comp_id g,
      have t := congr_arg (λ t : nat_trans _ _, t.app _) adj.right_triangle,
      dsimp at t,
      simp only [id_comp] at t,
      exact t,
  end },
  .. adj }

/-- The adjunction between the identity functor on a category and itself. -/
def id : 𝟭 C ⊣ 𝟭 C :=
{ hom_equiv := λ X Y, equiv.refl _,
  unit := 𝟙 _,
  counit := 𝟙 _ }

-- Satisfy the inhabited linter.
instance : inhabited (adjunction (𝟭 C) (𝟭 C)) := ⟨id⟩

/-- If F and G are naturally isomorphic functors, establish an equivalence of hom-sets. -/
@[simps]
def equiv_homset_left_of_nat_iso
  {F F' : C ⥤ D} (iso : F ≅ F') {X : C} {Y : D} :
  (F.obj X ⟶ Y) ≃ (F'.obj X ⟶ Y) :=
{ to_fun := λ f, iso.inv.app _ ≫ f,
  inv_fun := λ g, iso.hom.app _ ≫ g,
  left_inv := λ f, by simp,
  right_inv := λ g, by simp }

/-- If G and H are naturally isomorphic functors, establish an equivalence of hom-sets. -/
@[simps]
def equiv_homset_right_of_nat_iso
  {G G' : D ⥤ C} (iso : G ≅ G') {X : C} {Y : D} :
  (X ⟶ G.obj Y) ≃ (X ⟶ G'.obj Y) :=
{ to_fun := λ f, f ≫ iso.hom.app _,
  inv_fun := λ g, g ≫ iso.inv.app _,
  left_inv := λ f, by simp,
  right_inv := λ g, by simp }

/-- Transport an adjunction along an natural isomorphism on the left. -/
def of_nat_iso_left
  {F G : C ⥤ D} {H : D ⥤ C} (adj : F ⊣ H) (iso : F ≅ G) :
  G ⊣ H :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y, (equiv_homset_left_of_nat_iso iso.symm).trans (adj.hom_equiv X Y) }

/-- Transport an adjunction along an natural isomorphism on the right. -/
def of_nat_iso_right
  {F : C ⥤ D} {G H : D ⥤ C} (adj : F ⊣ G) (iso : G ≅ H) :
  F ⊣ H :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y, (adj.hom_equiv X Y).trans (equiv_homset_right_of_nat_iso iso) }

/-- Transport being a right adjoint along a natural isomorphism. -/
def right_adjoint_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [r : is_right_adjoint F] :
  is_right_adjoint G :=
{ left := r.left,
  adj := of_nat_iso_right r.adj h }

/-- Transport being a left adjoint along a natural isomorphism. -/
def left_adjoint_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [r : is_left_adjoint F] : is_left_adjoint G :=
{ right := r.right,
  adj := of_nat_iso_left r.adj h }

section
variables {E : Type u₃} [ℰ : category.{v₃} E] {H : D ⥤ E} {I : E ⥤ D}

/--
Composition of adjunctions.

See <https://stacks.math.columbia.edu/tag/0DV0>.
-/
def comp (adj₁ : F ⊣ G) (adj₂ : H ⊣ I) : F ⋙ H ⊣ I ⋙ G :=
{ hom_equiv := λ X Z, equiv.trans (adj₂.hom_equiv _ _) (adj₁.hom_equiv _ _),
  unit := adj₁.unit ≫
  (whisker_left F $ whisker_right adj₂.unit G) ≫ (functor.associator _ _ _).inv,
  counit := (functor.associator _ _ _).hom ≫
    (whisker_left I $ whisker_right adj₁.counit H) ≫ adj₂.counit }

/-- If `F` and `G` are left adjoints then `F ⋙ G` is a left adjoint too. -/
instance left_adjoint_of_comp {E : Type u₃} [ℰ : category.{v₃} E] (F : C ⥤ D) (G : D ⥤ E)
  [Fl : is_left_adjoint F] [Gl : is_left_adjoint G] : is_left_adjoint (F ⋙ G) :=
{ right := Gl.right ⋙ Fl.right,
  adj := Fl.adj.comp Gl.adj }

/-- If `F` and `G` are right adjoints then `F ⋙ G` is a right adjoint too. -/
instance right_adjoint_of_comp {E : Type u₃} [ℰ : category.{v₃} E] {F : C ⥤ D} {G : D ⥤ E}
  [Fr : is_right_adjoint F] [Gr : is_right_adjoint G] : is_right_adjoint (F ⋙ G) :=
{ left := Gr.left ⋙ Fr.left,
  adj := Gr.adj.comp Fr.adj }

end

section construct_left
-- Construction of a left adjoint. In order to construct a left
-- adjoint to a functor G : D → C, it suffices to give the object part
-- of a functor F : C → D together with isomorphisms Hom(FX, Y) ≃
-- Hom(X, GY) natural in Y. The action of F on morphisms can be
-- constructed from this data.
variables {F_obj : C → D} {G}
variables (e : Π X Y, (F_obj X ⟶ Y) ≃ (X ⟶ G.obj Y))
variables (he : ∀ X Y Y' g h, e X Y' (h ≫ g) = e X Y h ≫ G.map g)
include he

private lemma he' {X Y Y'} (f g) : (e X Y').symm (f ≫ G.map g) = (e X Y).symm f ≫ g :=
by intros; rw [equiv.symm_apply_eq, he]; simp

/-- Construct a left adjoint functor to `G`, given the functor's value on objects `F_obj` and
a bijection `e` between `F_obj X ⟶ Y` and `X ⟶ G.obj Y` satisfying a naturality law
`he : ∀ X Y Y' g h, e X Y' (h ≫ g) = e X Y h ≫ G.map g`.
Dual to `right_adjoint_of_equiv`. -/
@[simps]
def left_adjoint_of_equiv : C ⥤ D :=
{ obj := F_obj,
  map := λ X X' f, (e X (F_obj X')).symm (f ≫ e X' (F_obj X') (𝟙 _)),
  map_comp' := λ X X' X'' f f', begin
    rw [equiv.symm_apply_eq, he, equiv.apply_symm_apply],
    conv { to_rhs, rw [assoc, ←he, id_comp, equiv.apply_symm_apply] },
    simp
  end }

/-- Show that the functor given by `left_adjoint_of_equiv` is indeed left adjoint to `G`. Dual
to `adjunction_of_equiv_right`. -/
@[simps]
def adjunction_of_equiv_left : left_adjoint_of_equiv e he ⊣ G :=
mk_of_hom_equiv
{ hom_equiv := e,
  hom_equiv_naturality_left_symm' :=
  begin
    intros,
    erw [← he' e he, ← equiv.apply_eq_iff_eq],
    simp [(he _ _ _ _ _).symm]
  end }

end construct_left

section construct_right
-- Construction of a right adjoint, analogous to the above.
variables {F} {G_obj : D → C}
variables (e : Π X Y, (F.obj X ⟶ Y) ≃ (X ⟶ G_obj Y))
variables (he : ∀ X' X Y f g, e X' Y (F.map f ≫ g) = f ≫ e X Y g)
include he

private lemma he' {X' X Y} (f g) : F.map f ≫ (e X Y).symm g = (e X' Y).symm (f ≫ g) :=
by intros; rw [equiv.eq_symm_apply, he]; simp

/-- Construct a right adjoint functor to `F`, given the functor's value on objects `G_obj` and
a bijection `e` between `F.obj X ⟶ Y` and `X ⟶ G_obj Y` satisfying a naturality law
`he : ∀ X Y Y' g h, e X' Y (F.map f ≫ g) = f ≫ e X Y g`.
Dual to `left_adjoint_of_equiv`. -/
@[simps]
def right_adjoint_of_equiv : D ⥤ C :=
{ obj := G_obj,
  map := λ Y Y' g, (e (G_obj Y) Y') ((e (G_obj Y) Y).symm (𝟙 _) ≫ g),
  map_comp' := λ Y Y' Y'' g g', begin
    rw [← equiv.eq_symm_apply, ← he' e he, equiv.symm_apply_apply],
    conv { to_rhs, rw [← assoc, he' e he, comp_id, equiv.symm_apply_apply] },
    simp
  end }

/-- Show that the functor given by `right_adjoint_of_equiv` is indeed right adjoint to `F`. Dual
to `adjunction_of_equiv_left`. -/
@[simps]
def adjunction_of_equiv_right : F ⊣ right_adjoint_of_equiv e he :=
mk_of_hom_equiv
{ hom_equiv := e,
  hom_equiv_naturality_left_symm' := by intros; rw [equiv.symm_apply_eq, he]; simp,
  hom_equiv_naturality_right' :=
  begin
    intros X Y Y' g h,
    erw [←he, equiv.apply_eq_iff_eq, ←assoc, he' e he, comp_id, equiv.symm_apply_apply]
  end }

end construct_right

/--
If the unit and counit of a given adjunction are (pointwise) isomorphisms, then we can upgrade the
adjunction to an equivalence.
-/
@[simps]
noncomputable
def to_equivalence (adj : F ⊣ G) [∀ X, is_iso (adj.unit.app X)] [∀ Y, is_iso (adj.counit.app Y)] :
  C ≌ D :=
{ functor := F,
  inverse := G,
  unit_iso := nat_iso.of_components (λ X, as_iso (adj.unit.app X)) (by simp),
  counit_iso := nat_iso.of_components (λ Y, as_iso (adj.counit.app Y)) (by simp) }

/--
If the unit and counit for the adjunction corresponding to a right adjoint functor are (pointwise)
isomorphisms, then the functor is an equivalence of categories.
-/
@[simps]
noncomputable
def is_right_adjoint_to_is_equivalence [is_right_adjoint G]
  [∀ X, is_iso ((adjunction.of_right_adjoint G).unit.app X)]
  [∀ Y, is_iso ((adjunction.of_right_adjoint G).counit.app Y)] :
  is_equivalence G :=
is_equivalence.of_equivalence_inverse (adjunction.of_right_adjoint G).to_equivalence

end adjunction

open adjunction

namespace equivalence

/-- The adjunction given by an equivalence of categories. (To obtain the opposite adjunction,
simply use `e.symm.to_adjunction`. -/
def to_adjunction (e : C ≌ D) : e.functor ⊣ e.inverse :=
mk_of_unit_counit ⟨e.unit, e.counit,
  by { ext, dsimp, simp only [id_comp], exact e.functor_unit_comp _, },
  by { ext, dsimp, simp only [id_comp], exact e.unit_inverse_comp _, }⟩

@[simp] lemma as_equivalence_to_adjunction_unit {e : C ≌ D} :
  e.functor.as_equivalence.to_adjunction.unit = e.unit :=
rfl

@[simp] lemma as_equivalence_to_adjunction_counit {e : C ≌ D} :
  e.functor.as_equivalence.to_adjunction.counit = e.counit :=
rfl

end equivalence

namespace functor

/-- An equivalence `E` is left adjoint to its inverse. -/
def adjunction (E : C ⥤ D) [is_equivalence E] : E ⊣ E.inv :=
(E.as_equivalence).to_adjunction

/-- If `F` is an equivalence, it's a left adjoint. -/
@[priority 10]
instance left_adjoint_of_equivalence {F : C ⥤ D} [is_equivalence F] : is_left_adjoint F :=
{ right := _,
  adj := functor.adjunction F }

@[simp]
lemma right_adjoint_of_is_equivalence {F : C ⥤ D} [is_equivalence F] : right_adjoint F = inv F :=
rfl

/-- If `F` is an equivalence, it's a right adjoint. -/
@[priority 10]
instance right_adjoint_of_equivalence {F : C ⥤ D} [is_equivalence F] : is_right_adjoint F :=
{ left := _,
  adj := functor.adjunction F.inv }

@[simp]
lemma left_adjoint_of_is_equivalence {F : C ⥤ D} [is_equivalence F] : left_adjoint F = inv F :=
rfl

end functor

end category_theory


open tactic

-- meta def extract_equals (e : expr) : option (expr × expr) :=
-- match e with
-- | expr.app f x := sorry
-- end

meta def extract_equals : expr → tactic (option (expr × expr))
| (expr.app (expr.app f x) y) :=
  do e ← mk_const `eq,
     trace e,
     trace f,
     if f = e then
       return (some (x, y))
     else
       return none
| _ := none

meta def extract_equals' : expr → option (expr × expr)
| `(%%a = %%b) := some (a, b)
| _ := none

meta def swp : tactic unit :=
do t ← target,
   r ← extract_equals t,
   trace r,
   trace "hello world",
   trace t

meta def swp' : tactic unit :=
do t ← target,
   (a, b) ← extract_equals' t,
   ng ← to_expr ``(%%b = %%a),
   trace (a, b),
   eqs ← to_expr ``(eq.symm),
   apply eqs,
   skip

#check expr
-- set_option pp.all true

lemma foo : 1 + 1 = 3 :=
begin
  symmetry,
  swp',
end


/-
  Second argument of the ring lemma.

  We show that the map R[1/fᵢ] → R[1/fᵢfⱼ] inverts fᵢ/1 * fⱼ/1.
-/

import ring_theory.localization
import to_mathlib.localization.localization_alt
import spectrum_of_a_ring.structure_presheaf
import spectrum_of_a_ring.structure_presheaf_localization
import spectrum_of_a_ring.structure_presheaf_res
import spectrum_of_a_ring.structure_sheaf_locality

universe u

local attribute [instance] classical.prop_decidable

noncomputable theory

section structure_presheaf

open topological_space
open classical
open localization
open localization_alt

variables {R : Type u} [comm_ring R]
variables {U V W : opens (Spec R)}
variables (BU : U ∈ D_fs R) (BV : V ∈ D_fs R) (BW : W ∈ D_fs R)
variables (HVU : V ⊆ U) (HWU : W ⊆ U)

def BVW : V ∩ W ∈ D_fs R := (D_fs_standard_basis R).2 BV BW
def HVWU : V ∩ W ⊆ U := set.subset.trans (set.inter_subset_left V W) HVU

def structure_presheaf_on_basis.res_to_inter
: localization R (S U) → localization R (S (V ∩ W)) :=
structure_presheaf_on_basis.res BU (BVW BV BW) (HVWU HVU)

def structure_presheaf_on_basis.res_to_inter_left
: localization R (S V) → localization R (S (V ∩ W)) :=
structure_presheaf_on_basis.res BV (BVW BV BW) (set.inter_subset_left V W)

def structure_presheaf_on_basis.res_to_inter_right
: localization R (S W) → localization R (S (V ∩ W)) :=
structure_presheaf_on_basis.res BW (BVW BV BW) (set.inter_subset_right V W)

instance structure_presheaf_on_basis.res_to_inter.is_ring_hom
: is_ring_hom (structure_presheaf_on_basis.res_to_inter BU BV BW HVU) :=
by simp [structure_presheaf_on_basis.res_to_inter, structure_presheaf_on_basis.res];
by apply_instance

instance structure_presheaf_on_basis.res_to_inter_to_inter_left.is_ring_hom
: is_ring_hom (structure_presheaf_on_basis.res_to_inter_left BV BW) :=
by simp [structure_presheaf_on_basis.res_to_inter_left, structure_presheaf_on_basis.res];
by apply_instance

instance structure_presheaf_on_basis.res_to_inter_to_inter_right.is_ring_hom
: is_ring_hom (structure_presheaf_on_basis.res_to_inter_right BV BW) :=
by simp [structure_presheaf_on_basis.res_to_inter_right, structure_presheaf_on_basis.res];
by apply_instance

-- (f' g')^e = a * (fg)'

include BU HVU

lemma pow_eq.fmulg : ∃ a : R, ∃ e : ℕ, ((some BV) * (some BW))^e = a * (some (BVW BV BW)) :=
begin
  let f := some BV,
  let g := some BW,
  let fg := some (BVW BV BW),
  -- D(f*g) ⊆ D(fg).
  have HDfg : Spec.D'(f*g) ⊆ Spec.D'(fg),
    rw Spec.D'.product_eq_inter,
    show Spec.DO R f ∩ Spec.DO R g ⊆ Spec.DO R fg,
    rw [←some_spec BV, ←some_spec BW, ←some_spec (BVW BV BW)],
    exact set.subset.refl _,
  -- Hence (f*g)^e = a * fg.
  exact pow_eq.of_Dfs_subset HDfg,
end

lemma pow_eq.fg : ∃ a : R, ∃ e : ℕ, (some (BVW BV BW))^e = a * ((some BV) * (some BW)) :=
begin
  let f := some BV,
  let g := some BW,
  let fg := some (BVW BV BW),
  -- D(fg) ⊆ D(f*g).
  have HDfg : Spec.D'(fg) ⊆ Spec.D'(f*g),
    rw Spec.D'.product_eq_inter,
    show Spec.DO R fg ⊆ Spec.DO R f ∩ Spec.DO R g,
    rw [←some_spec BV, ←some_spec BW, ←some_spec (BVW BV BW)],
    exact set.subset.refl _,
  -- Hence (f*g)^e = a * fg.
  exact pow_eq.of_Dfs_subset HDfg,
end

lemma structure_presheaf.res_to_inter.inverts_data
: inverts_data
    (powers ((of (some BV)) * (of (some BW))))
    (structure_presheaf_on_basis.res_to_inter BU BV BW HVU) :=
begin
  rcases (indefinite_description _ (pow_eq.fg BU BV BW HVU)) with ⟨a, Ha⟩,
  rcases (indefinite_description _ Ha) with ⟨e, Hea⟩,
  clear Ha,
  let f := some BV,
  let g := some BW,
  let fg := some (BVW BV BW),
  -- Using structure_presheaf.res.inverts_data
  rintros ⟨s, Hs⟩,
  rcases (indefinite_description _ Hs) with ⟨n, Hn⟩,
  have Hans : s * (of (a^n)) ∈ powers ((of : R → localization R (S U)) fg),
    rw is_semiring_hom.map_pow (of : R → localization R (S U)),
    rw [←Hn,  ←mul_pow],
    iterate 2 { rw ←is_ring_hom.map_mul (of : R → localization R (S U)), },
    rw [mul_comm, ←Hea, is_semiring_hom.map_pow (of : R → localization R (S U)), ←pow_mul],
    exact ⟨e * n, rfl⟩,
  rcases (structure_presheaf.res.inverts_data BU (BVW BV BW) (HVWU HVU) ⟨s * (of (a^n)), Hans⟩) with ⟨w, Hw⟩,
  rw ←is_ring_hom.map_mul (of : R → localization R (S U)) at Hn,
  rw ←is_semiring_hom.map_pow (of : R → localization R (S U)) at Hn,
  dsimp [structure_presheaf_on_basis.res_to_inter],
  dsimp only [subtype.coe_mk] at Hw,
  rw ←Hn,
  rw ←Hn at Hw,
  rw is_ring_hom.map_mul (structure_presheaf_on_basis.res BU (BVW BV BW) (HVWU HVU)) at Hw,
  use [(structure_presheaf_on_basis.res BU (BVW BV BW) (HVWU HVU) (of (a^n))) * w],
  rw ←mul_assoc,
  exact Hw,
end

lemma structure_presheaf.res_to_inter.has_denom_data
: has_denom_data
    (powers ((of (some BV)) * (of (some BW))))
    (structure_presheaf_on_basis.res_to_inter BU BV BW HVU) :=
begin
  rcases (indefinite_description _ (pow_eq.fmulg BU BV BW HVU)) with ⟨a, Ha⟩,
  rcases (indefinite_description _ Ha) with ⟨e, Hea⟩,
  clear Ha,
  let f := some BV,
  let g := some BW,
  let fg := some (BVW BV BW),
  -- Using structure_presheaf.res.has_denom
  -- This gives us ( fg^n, y ∈ R[1/S(U)] )
  -- We have (f*g)^(n*e) = (fg)^n * a^n
  -- So let x = y * (of a)^n.
  intros x,
  rcases (structure_presheaf.res.has_denom_data BU (BVW BV BW) (HVWU HVU) x) with ⟨⟨⟨q, Hq⟩, p⟩, Hpq⟩,
  dsimp only [subtype.coe_mk] at Hpq,
  rcases (indefinite_description _ Hq) with ⟨n, Hn⟩,
  use [⟨⟨(of f * of g)^(e * n), ⟨e * n, rfl⟩⟩, p * (of a)^n⟩],
  dsimp [structure_presheaf_on_basis.res_to_inter],
  rw ←is_ring_hom.map_mul (of : R → localization R (S U)),
  rw ←is_semiring_hom.map_pow (of : R → localization R (S U)),
  rw [pow_mul, Hea],
  rw is_semiring_hom.map_pow (of : R → localization R (S U)),
  rw is_ring_hom.map_mul (of : R → localization R (S U)),
  rw [mul_pow, Hn, mul_comm p],
  iterate 2 { rw is_ring_hom.map_mul (structure_presheaf_on_basis.res BU (BVW BV BW) (HVWU HVU)), },
  rw [←Hpq, ←mul_assoc],
end

lemma structure_presheaf.res_to_inter.ker_le
: ker (structure_presheaf_on_basis.res_to_inter BU BV BW HVU)
≤ submonoid_ann (powers ((of (some BV)) * (of (some BW)))) :=
begin
  rcases (indefinite_description _ (pow_eq.fmulg BU BV BW HVU)) with ⟨a, Ha⟩,
  rcases (indefinite_description _ Ha) with ⟨e, Hea⟩,
  clear Ha,
  let f := some BV,
  let g := some BW,
  let fg := some (BVW BV BW),
  -- Using structure_presheaf.res.ker_le
  intros x Hx,
  dsimp [structure_presheaf_on_basis.res_to_inter] at Hx,
  replace Hx := (structure_presheaf.res.ker_le BU (BVW BV BW) (HVWU HVU)) Hx,
  rcases Hx with ⟨⟨⟨u, ⟨v, ⟨n, Hv⟩⟩⟩, Hxfgn⟩, Hx⟩,
  dsimp at Hx,
  dsimp at Hxfgn,
  rw [Hx, ←Hv] at Hxfgn; clear Hx; clear Hv,
  let fgne : localization R (S U) := (of f * of g)^(e * n),
  have Hfgne : fgne ∈ (powers (of f * of g) : set (localization R (S U))) := ⟨e * n, rfl⟩,
  have Hxfgne : x * fgne = 0,
    dsimp [fgne],
    rw ←is_ring_hom.map_mul (of : R → localization R (S U)),
    rw ←is_semiring_hom.map_pow (of : R → localization R (S U)),
    rw [pow_mul, Hea],
    rw is_semiring_hom.map_pow (of : R → localization R (S U)),
    rw is_ring_hom.map_mul (of : R → localization R (S U)),
    rw [mul_pow, mul_comm ((of a)^n), ←mul_assoc, Hxfgn, zero_mul],
  use ⟨⟨x, ⟨fgne, Hfgne⟩⟩, Hxfgne⟩,
end

lemma structure_presheaf.res_to_inter.localization
: is_localization_data
    (powers ((of (some BV)) * (of (some BW))))
    (structure_presheaf_on_basis.res_to_inter BU BV BW HVU) :=
{ inverts := structure_presheaf.res_to_inter.inverts_data BU BV BW HVU,
  has_denom := structure_presheaf.res_to_inter.has_denom_data BU BV BW HVU,
  ker_le := structure_presheaf.res_to_inter.ker_le BU BV BW HVU }

end structure_presheaf


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl
-/

section sigma
variables {α : Type*} {β : α → Type*}

instance [inhabited α] [inhabited (β (default α))] : inhabited (sigma β) :=
⟨⟨default α, default (β (default α))⟩⟩

instance [h₁ : decidable_eq α] [h₂ : ∀a, decidable_eq (β a)] : decidable_eq (sigma β)
| ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ := match a₁, b₁, a₂, b₂, h₁ a₁ a₂ with
  | _, b₁, _, b₂, is_true (eq.refl a) :=
    match b₁, b₂, h₂ a b₁ b₂ with
    | _, _, is_true (eq.refl b) := is_true rfl
    | b₁, b₂, is_false n := is_false (assume h, sigma.no_confusion h (λe₁ e₂, n $ eq_of_heq e₂))
    end
  | a₁, _, a₂, _, is_false n := is_false (assume h, sigma.no_confusion h (λe₁ e₂, n e₁))
  end

@[simp] theorem sigma.mk.inj_iff {a₁ a₂ : α} {b₁ : β a₁} {b₂ : β a₂} :
  sigma.mk a₁ b₁ = ⟨a₂, b₂⟩ ↔ (a₁ = a₂ ∧ b₁ == b₂) :=
⟨sigma.mk.inj, λ ⟨h₁, h₂⟩, by congr; assumption⟩

@[simp] theorem sigma.forall {p : (Σ a, β a) → Prop} :
  (∀ x, p x) ↔ (∀ a b, p ⟨a, b⟩) :=
⟨assume h a b, h ⟨a, b⟩, assume h ⟨a, b⟩, h a b⟩

@[simp] theorem sigma.exists {p : (Σ a, β a) → Prop} :
  (∃ x, p x) ↔ (∃ a b, p ⟨a, b⟩) :=
⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩

variables {α₁ : Type*} {α₂ : Type*} {β₁ : α₁ → Type*} {β₂ : α₂ → Type*}

/-- Map the left and right components of a sigma -/
def sigma.map (f₁ : α₁ → α₂) (f₂ : Πa, β₁ a → β₂ (f₁ a)) : sigma β₁ → sigma β₂
| ⟨a, b⟩ := ⟨f₁ a, f₂ a b⟩

end sigma

section psigma
variables {α : Sort*} {β : α → Sort*}

instance [inhabited α] [inhabited (β (default α))] : inhabited (psigma β) :=
⟨⟨default α, default (β (default α))⟩⟩

instance [h₁ : decidable_eq α] [h₂ : ∀a, decidable_eq (β a)] : decidable_eq (psigma β)
| ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ := match a₁, b₁, a₂, b₂, h₁ a₁ a₂ with
  | _, b₁, _, b₂, is_true (eq.refl a) :=
    match b₁, b₂, h₂ a b₁ b₂ with
    | _, _, is_true (eq.refl b) := is_true rfl
    | b₁, b₂, is_false n := is_false (assume h, psigma.no_confusion h (λe₁ e₂, n $ eq_of_heq e₂))
    end
  | a₁, _, a₂, _, is_false n := is_false (assume h, psigma.no_confusion h (λe₁ e₂, n e₁))
  end

theorem psigma.mk.inj_iff {a₁ a₂ : α} {b₁ : β a₁} {b₂ : β a₂} :
  @psigma.mk α β a₁ b₁ = @psigma.mk α β a₂ b₂ ↔ (a₁ = a₂ ∧ b₁ == b₂) :=
iff.intro psigma.mk.inj $
  assume ⟨h₁, h₂⟩, match a₁, a₂, b₁, b₂, h₁, h₂ with _, _, _, _, eq.refl a, heq.refl b := rfl end

variables {α₁ : Sort*} {α₂ : Sort*} {β₁ : α₁ → Sort*} {β₂ : α₂ → Sort*}

/-- Map the left and right components of a sigma -/
def psigma.map (f₁ : α₁ → α₂) (f₂ : Πa, β₁ a → β₂ (f₁ a)) : psigma β₁ → psigma β₂
| ⟨a, b⟩ := ⟨f₁ a, f₂ a b⟩

end psigma


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

Tuples are lists of a fixed size.
It is implemented as a subtype.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.list.default
import Mathlib.Lean3Lib.init.data.subtype.default
import Mathlib.Lean3Lib.init.meta.interactive
import Mathlib.Lean3Lib.init.data.fin.default

universes u u_1 v w

namespace Mathlib

def vector (α : Type u) (n : ℕ) :=
  Subtype fun (l : List α) => list.length l = n

namespace vector

protected instance decidable_eq {α : Type u} {n : ℕ} [DecidableEq α] : DecidableEq (vector α n) :=
  eq.mpr sorry fun (a b : Subtype fun (l : List α) => list.length l = n) => subtype.decidable_eq a b

def nil {α : Type u} : vector α 0 :=
  { val := [], property := sorry }

def cons {α : Type u} {n : ℕ} : α → vector α n → vector α (Nat.succ n) :=
  sorry

def length {α : Type u} {n : ℕ} (v : vector α n) : ℕ :=
  n

def head {α : Type u} {n : ℕ} : vector α (Nat.succ n) → α :=
  sorry

theorem head_cons {α : Type u} {n : ℕ} (a : α) (v : vector α n) : head (cons a v) = a := sorry

def tail {α : Type u} {n : ℕ} : vector α n → vector α (n - 1) :=
  sorry

theorem tail_cons {α : Type u} {n : ℕ} (a : α) (v : vector α n) : tail (cons a v) = v := sorry

@[simp] theorem cons_head_tail {α : Type u} {n : ℕ} (v : vector α (Nat.succ n)) : cons (head v) (tail v) = v := sorry

def to_list {α : Type u} {n : ℕ} (v : vector α n) : List α :=
  subtype.val v

def nth {α : Type u} {n : ℕ} (v : vector α n) : fin n → α :=
  sorry

def append {α : Type u} {n : ℕ} {m : ℕ} : vector α n → vector α m → vector α (n + m) :=
  sorry

def elim {α : Type u_1} {C : {n : ℕ} → vector α n → Sort u} (H : (l : List α) → C { val := l, property := elim._proof_1 l }) {n : ℕ} (v : vector α n) : C v :=
  sorry

/- map -/

def map {α : Type u} {β : Type v} {n : ℕ} (f : α → β) : vector α n → vector β n :=
  sorry

@[simp] theorem map_nil {α : Type u} {β : Type v} (f : α → β) : map f nil = nil :=
  rfl

theorem map_cons {α : Type u} {β : Type v} {n : ℕ} (f : α → β) (a : α) (v : vector α n) : map f (cons a v) = cons (f a) (map f v) := sorry

def map₂ {α : Type u} {β : Type v} {φ : Type w} {n : ℕ} (f : α → β → φ) : vector α n → vector β n → vector φ n :=
  sorry

def repeat {α : Type u} (a : α) (n : ℕ) : vector α n :=
  { val := list.repeat a n, property := list.length_repeat a n }

def drop {α : Type u} {n : ℕ} (i : ℕ) : vector α n → vector α (n - i) :=
  sorry

def take {α : Type u} {n : ℕ} (i : ℕ) : vector α n → vector α (min i n) :=
  sorry

def remove_nth {α : Type u} {n : ℕ} (i : fin n) : vector α n → vector α (n - 1) :=
  sorry

def of_fn {α : Type u} {n : ℕ} : (fin n → α) → vector α n :=
  sorry

def map_accumr {α : Type u} {β : Type v} {n : ℕ} {σ : Type} (f : α → σ → σ × β) : vector α n → σ → σ × vector β n :=
  sorry

def map_accumr₂ {n : ℕ} {α : Type} {β : Type} {σ : Type} {φ : Type} (f : α → β → σ → σ × φ) : vector α n → vector β n → σ → σ × vector φ n :=
  sorry

protected theorem eq {α : Type u} {n : ℕ} (a1 : vector α n) (a2 : vector α n) : to_list a1 = to_list a2 → a1 = a2 := sorry

protected theorem eq_nil {α : Type u} (v : vector α 0) : v = nil :=
  vector.eq v nil (list.eq_nil_of_length_eq_zero (subtype.property v))

@[simp] theorem to_list_mk {α : Type u} {n : ℕ} (v : List α) (P : list.length v = n) : to_list { val := v, property := P } = v :=
  rfl

@[simp] theorem to_list_nil {α : Type u} : to_list nil = [] :=
  rfl

@[simp] theorem to_list_length {α : Type u} {n : ℕ} (v : vector α n) : list.length (to_list v) = n :=
  subtype.property v

@[simp] theorem to_list_cons {α : Type u} {n : ℕ} (a : α) (v : vector α n) : to_list (cons a v) = a :: to_list v :=
  subtype.cases_on v
    fun (v_val : List α) (v_property : list.length v_val = n) =>
      Eq.refl (to_list (cons a { val := v_val, property := v_property }))

@[simp] theorem to_list_append {α : Type u} {n : ℕ} {m : ℕ} (v : vector α n) (w : vector α m) : to_list (append v w) = to_list v ++ to_list w := sorry

@[simp] theorem to_list_drop {α : Type u} {n : ℕ} {m : ℕ} (v : vector α m) : to_list (drop n v) = list.drop n (to_list v) :=
  subtype.cases_on v
    fun (v_val : List α) (v_property : list.length v_val = m) =>
      Eq.refl (to_list (drop n { val := v_val, property := v_property }))

@[simp] theorem to_list_take {α : Type u} {n : ℕ} {m : ℕ} (v : vector α m) : to_list (take n v) = list.take n (to_list v) :=
  subtype.cases_on v
    fun (v_val : List α) (v_property : list.length v_val = m) =>
      Eq.refl (to_list (take n { val := v_val, property := v_property }))