/-
File: signature_recover_public_key_assert_nn_soundness.lean

Autogenerated file.
-/
import starkware.cairo.lean.semantics.soundness.hoare
import .signature_recover_public_key_code
import ..signature_recover_public_key_spec
open tactic

open starkware.cairo.common.math

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]
variable  mem : F → F
variable  σ : register_state F

/- starkware.cairo.common.math.assert_nn autogenerated soundness theorem -/

theorem auto_sound_assert_nn
    -- arguments
    (range_check_ptr a : F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_assert_nn σ.pc)
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 4))
    (hin_a : a = mem (σ.fp - 3))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      τ.ap = σ.ap + 1 ∧
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 4)) (mem $ τ.ap - 1)
        (spec_assert_nn mem κ range_check_ptr a (mem (τ.ap - 1)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_assert_nn at h_mem with ⟨hpc0, hpc1, hpc2, hpc3⟩,
  -- assert eq
  step_assert_eq hpc0 with temp0,
  have a0: a = mem (range_check_ptr), {
    apply assert_eq_reduction temp0,
    try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
  },
  try { dsimp at a0 }, try { arith_simps at a0 },
  clear temp0,
  -- let
  generalize' hl_rev_range_check_ptr₁: (range_check_ptr + 1 : F) = range_check_ptr₁,
  have hl_range_check_ptr₁ := hl_rev_range_check_ptr₁.symm, clear hl_rev_range_check_ptr₁,
  try { dsimp at hl_range_check_ptr₁ }, try { arith_simps at hl_range_check_ptr₁ },
  -- return
  step_assert_eq hpc1 hpc2 with hret0,
  step_ret hpc3,
  -- finish
  step_done, use_only [rfl, rfl],
  split, refl,
  -- range check condition
  use_only (1+0+0), split,
  linarith [],
  split,
  { arith_simps, try { simp only [hret0] },
    try { arith_simps, refl <|> norm_cast }, try { refl } },
  intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
  have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
  -- Final Proof
  -- user-provided reduction
  suffices auto_spec: auto_spec_assert_nn mem _ range_check_ptr a _,
  { apply sound_assert_nn, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_assert_nn],
  try { norm_num1 }, try { arith_simps },
  use_only [a0],
  cases rc_h_range_check_ptr' (0) (by norm_num1) with n hn, arith_simps at hn,
  use_only [n], { simp only [a0, hin_range_check_ptr], arith_simps, exact hn },
  have rc_h_range_check_ptr₁ := range_checked_offset' rc_h_range_check_ptr,
  have rc_h_range_check_ptr₁' := range_checked_add_right rc_h_range_check_ptr₁,try { norm_cast at rc_h_range_check_ptr₁' },
  use_only [range_check_ptr₁, hl_range_check_ptr₁],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hl_range_check_ptr₁] }, },
  try { arith_simps }, try { simp only [hret0] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.affine_space.affine_map
import Mathlib.algebra.invertible
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5 l u_6 u_7 u_8 u_9 u_10

namespace Mathlib

/-!
# Affine equivalences

In this file we define `affine_equiv k P₁ P₂` (notation: `P₁ ≃ᵃ[k] P₂`) to be the type of affine
equivalences between `P₁` and `P₂, i.e., equivalences such that both forward and inverse maps are
affine maps.

We define the following equivalences:

* `affine_equiv.refl k P`: the identity map as an `affine_equiv`;

* `e.symm`: the inverse map of an `affine_equiv` as an `affine_equiv`;

* `e.trans e'`: composition of two `affine_equiv`s; note that the order follows `mathlib`'s
  `category_theory` convention (apply `e`, then `e'`), not the convention used in function
  composition and compositions of bundled morphisms.

## Tags

affine space, affine equivalence
-/

/-- An affine equivalence is an equivalence between affine spaces such that both forward
and inverse maps are affine.

We define it using an `equiv` for the map and a `linear_equiv` for the linear part in order
to allow affine equivalences with good definitional equalities. -/
structure affine_equiv (k : Type u_1) (P₁ : Type u_2) (P₂ : Type u_3) {V₁ : Type u_4} {V₂ : Type u_5} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂]
extends P₁ ≃ P₂
where
  linear : linear_equiv k V₁ V₂
  map_vadd' : ∀ (p : P₁) (v : V₁), coe_fn _to_equiv (v +ᵥ p) = coe_fn linear v +ᵥ coe_fn _to_equiv p

protected instance affine_equiv.has_coe_to_fun (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) {V2 : Type u_4} (P2 : Type u_5) [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] : has_coe_to_fun (affine_equiv k P1 P2) :=
  has_coe_to_fun.mk (fun (e : affine_equiv k P1 P2) => P1 → P2)
    fun (e : affine_equiv k P1 P2) => equiv.to_fun (affine_equiv.to_equiv e)

namespace linear_equiv

/-- Interpret a linear equivalence between modules as an affine equivalence. -/
def to_affine_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_comm_group V₂] [semimodule k V₂] (e : linear_equiv k V₁ V₂) : affine_equiv k V₁ V₂ :=
  affine_equiv.mk (to_equiv e) e sorry

@[simp] theorem coe_to_affine_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_comm_group V₂] [semimodule k V₂] (e : linear_equiv k V₁ V₂) : ⇑(to_affine_equiv e) = ⇑e :=
  rfl

end linear_equiv

namespace affine_equiv

/-- Identity map as an `affine_equiv`. -/
def refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] : affine_equiv k P₁ P₁ :=
  mk (equiv.refl P₁) (linear_equiv.refl k V₁) sorry

@[simp] theorem coe_refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] : ⇑(refl k P₁) = id :=
  rfl

theorem refl_apply (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) : coe_fn (refl k P₁) x = x :=
  rfl

@[simp] theorem to_equiv_refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] : to_equiv (refl k P₁) = equiv.refl P₁ :=
  rfl

@[simp] theorem linear_refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] : linear (refl k P₁) = linear_equiv.refl k V₁ :=
  rfl

@[simp] theorem map_vadd {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (p : P₁) (v : V₁) : coe_fn e (v +ᵥ p) = coe_fn (linear e) v +ᵥ coe_fn e p :=
  map_vadd' e p v

@[simp] theorem coe_to_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : ⇑(to_equiv e) = ⇑e :=
  rfl

/-- Reinterpret an `affine_equiv` as an `affine_map`. -/
def to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : affine_map k P₁ P₂ :=
  affine_map.mk (⇑e) (↑(linear e)) (map_vadd' e)

@[simp] theorem coe_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : ⇑(to_affine_map e) = ⇑e :=
  rfl

@[simp] theorem to_affine_map_mk {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (f : P₁ ≃ P₂) (f' : linear_equiv k V₁ V₂) (h : ∀ (p : P₁) (v : V₁), coe_fn f (v +ᵥ p) = coe_fn f' v +ᵥ coe_fn f p) : to_affine_map (mk f f' h) = affine_map.mk (⇑f) (↑f') h :=
  rfl

@[simp] theorem linear_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : affine_map.linear (to_affine_map e) = ↑(linear e) :=
  rfl

theorem injective_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] : function.injective to_affine_map := sorry

@[simp] theorem to_affine_map_inj {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂} {e' : affine_equiv k P₁ P₂} : to_affine_map e = to_affine_map e' ↔ e = e' :=
  function.injective.eq_iff injective_to_affine_map

theorem ext {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂} {e' : affine_equiv k P₁ P₂} (h : ∀ (x : P₁), coe_fn e x = coe_fn e' x) : e = e' :=
  injective_to_affine_map (affine_map.ext h)

theorem injective_coe_fn {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] : function.injective fun (e : affine_equiv k P₁ P₂) (x : P₁) => coe_fn e x := sorry

@[simp] theorem coe_fn_inj {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂} {e' : affine_equiv k P₁ P₂} : ⇑e = ⇑e' ↔ e = e' :=
  function.injective.eq_iff injective_coe_fn

theorem injective_to_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] : function.injective to_equiv :=
  fun (e e' : affine_equiv k P₁ P₂) (H : to_equiv e = to_equiv e') => ext (iff.mp equiv.ext_iff H)

@[simp] theorem to_equiv_inj {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂} {e' : affine_equiv k P₁ P₂} : to_equiv e = to_equiv e' ↔ e = e' :=
  function.injective.eq_iff injective_to_equiv

/-- Construct an affine equivalence by verifying the relation between the map and its linear part at
one base point. Namely, this function takes an equivalence `e : P₁ ≃ P₂`, a linear equivalece
`e' : V₁ ≃ₗ[k] V₂`, and a point `p` such that for any other point `p'` we have
`e p' = e' (p' -ᵥ p) +ᵥ e p`. -/
def mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : P₁ ≃ P₂) (e' : linear_equiv k V₁ V₂) (p : P₁) (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) : affine_equiv k P₁ P₂ :=
  mk e e' sorry

@[simp] theorem coe_mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : P₁ ≃ P₂) (e' : linear_equiv k V₁ V₂) (p : P₁) (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) : ⇑(mk' e e' p h) = ⇑e :=
  rfl

@[simp] theorem to_equiv_mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : P₁ ≃ P₂) (e' : linear_equiv k V₁ V₂) (p : P₁) (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) : to_equiv (mk' e e' p h) = e :=
  rfl

@[simp] theorem linear_mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : P₁ ≃ P₂) (e' : linear_equiv k V₁ V₂) (p : P₁) (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) : linear (mk' e e' p h) = e' :=
  rfl

/-- Inverse of an affine equivalence as an affine equivalence. -/
def symm {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : affine_equiv k P₂ P₁ :=
  mk (equiv.symm (to_equiv e)) (linear_equiv.symm (linear e)) sorry

@[simp] theorem symm_to_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : equiv.symm (to_equiv e) = to_equiv (symm e) :=
  rfl

@[simp] theorem symm_linear {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : linear_equiv.symm (linear e) = linear (symm e) :=
  rfl

protected theorem bijective {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : function.bijective ⇑e :=
  equiv.bijective (to_equiv e)

protected theorem surjective {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : function.surjective ⇑e :=
  equiv.surjective (to_equiv e)

protected theorem injective {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : function.injective ⇑e :=
  equiv.injective (to_equiv e)

@[simp] theorem range_eq {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : set.range ⇑e = set.univ :=
  function.surjective.range_eq (affine_equiv.surjective e)

@[simp] theorem apply_symm_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (p : P₂) : coe_fn e (coe_fn (symm e) p) = p :=
  equiv.apply_symm_apply (to_equiv e) p

@[simp] theorem symm_apply_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (p : P₁) : coe_fn (symm e) (coe_fn e p) = p :=
  equiv.symm_apply_apply (to_equiv e) p

theorem apply_eq_iff_eq_symm_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) {p₁ : P₁} {p₂ : P₂} : coe_fn e p₁ = p₂ ↔ p₁ = coe_fn (symm e) p₂ :=
  equiv.apply_eq_iff_eq_symm_apply (to_equiv e)

@[simp] theorem apply_eq_iff_eq {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) {p₁ : P₁} {p₂ : P₁} : coe_fn e p₁ = coe_fn e p₂ ↔ p₁ = p₂ :=
  equiv.apply_eq_iff_eq (to_equiv e)

@[simp] theorem symm_refl {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] : symm (refl k P₁) = refl k P₁ :=
  rfl

/-- Composition of two `affine_equiv`alences, applied left to right. -/
def trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4} {P₁ : Type u_6} {P₂ : Type u_7} {P₃ : Type u_8} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] [add_comm_group V₃] [semimodule k V₃] [add_torsor V₃ P₃] (e : affine_equiv k P₁ P₂) (e' : affine_equiv k P₂ P₃) : affine_equiv k P₁ P₃ :=
  mk (equiv.trans (to_equiv e) (to_equiv e')) (linear_equiv.trans (linear e) (linear e')) sorry

@[simp] theorem coe_trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4} {P₁ : Type u_6} {P₂ : Type u_7} {P₃ : Type u_8} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] [add_comm_group V₃] [semimodule k V₃] [add_torsor V₃ P₃] (e : affine_equiv k P₁ P₂) (e' : affine_equiv k P₂ P₃) : ⇑(trans e e') = ⇑e' ∘ ⇑e :=
  rfl

theorem trans_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4} {P₁ : Type u_6} {P₂ : Type u_7} {P₃ : Type u_8} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] [add_comm_group V₃] [semimodule k V₃] [add_torsor V₃ P₃] (e : affine_equiv k P₁ P₂) (e' : affine_equiv k P₂ P₃) (p : P₁) : coe_fn (trans e e') p = coe_fn e' (coe_fn e p) :=
  rfl

theorem trans_assoc {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4} {V₄ : Type u_5} {P₁ : Type u_6} {P₂ : Type u_7} {P₃ : Type u_8} {P₄ : Type u_9} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] [add_comm_group V₃] [semimodule k V₃] [add_torsor V₃ P₃] [add_comm_group V₄] [semimodule k V₄] [add_torsor V₄ P₄] (e₁ : affine_equiv k P₁ P₂) (e₂ : affine_equiv k P₂ P₃) (e₃ : affine_equiv k P₃ P₄) : trans (trans e₁ e₂) e₃ = trans e₁ (trans e₂ e₃) :=
  ext fun (_x : P₁) => rfl

@[simp] theorem trans_refl {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : trans e (refl k P₂) = e :=
  ext fun (_x : P₁) => rfl

@[simp] theorem refl_trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : trans (refl k P₁) e = e :=
  ext fun (_x : P₁) => rfl

@[simp] theorem trans_symm {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : trans e (symm e) = refl k P₁ :=
  ext (symm_apply_apply e)

@[simp] theorem symm_trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : trans (symm e) e = refl k P₂ :=
  ext (apply_symm_apply e)

@[simp] theorem apply_line_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (a : P₁) (b : P₁) (c : k) : coe_fn e (coe_fn (affine_map.line_map a b) c) = coe_fn (affine_map.line_map (coe_fn e a) (coe_fn e b)) c :=
  affine_map.apply_line_map (to_affine_map e) a b c

protected instance group {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] : group (affine_equiv k P₁ P₁) :=
  group.mk (fun (e e' : affine_equiv k P₁ P₁) => trans e' e) sorry (refl k P₁) trans_refl refl_trans symm
    (div_inv_monoid.div._default (fun (e e' : affine_equiv k P₁ P₁) => trans e' e) sorry (refl k P₁) trans_refl refl_trans
      symm)
    trans_symm

theorem one_def {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] : 1 = refl k P₁ :=
  rfl

@[simp] theorem coe_one {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] : ⇑1 = id :=
  rfl

theorem mul_def {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (e : affine_equiv k P₁ P₁) (e' : affine_equiv k P₁ P₁) : e * e' = trans e' e :=
  rfl

@[simp] theorem coe_mul {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (e : affine_equiv k P₁ P₁) (e' : affine_equiv k P₁ P₁) : ⇑(e * e') = ⇑e ∘ ⇑e' :=
  rfl

theorem inv_def {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (e : affine_equiv k P₁ P₁) : e⁻¹ = symm e :=
  rfl

/-- The map `v ↦ v +ᵥ b` as an affine equivalence between a module `V` and an affine space `P` with
tangent space `V`. -/
def vadd_const (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) : affine_equiv k V₁ P₁ :=
  mk (equiv.vadd_const b) (linear_equiv.refl k V₁) sorry

@[simp] theorem linear_vadd_const (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) : linear (vadd_const k b) = linear_equiv.refl k V₁ :=
  rfl

@[simp] theorem vadd_const_apply (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) (v : V₁) : coe_fn (vadd_const k b) v = v +ᵥ b :=
  rfl

@[simp] theorem vadd_const_symm_apply (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) (p : P₁) : coe_fn (symm (vadd_const k b)) p = p -ᵥ b :=
  rfl

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (p : P₁) : affine_equiv k P₁ V₁ :=
  mk (equiv.const_vsub p) (linear_equiv.neg k) sorry

@[simp] theorem coe_const_vsub (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (p : P₁) : ⇑(const_vsub k p) = has_vsub.vsub p :=
  rfl

@[simp] theorem coe_const_vsub_symm (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (p : P₁) : ⇑(symm (const_vsub k p)) = fun (v : V₁) => -v +ᵥ p :=
  rfl

/-- The map `p ↦ v +ᵥ p` as an affine automorphism of an affine space. -/
def const_vadd (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) : affine_equiv k P₁ P₁ :=
  mk (equiv.const_vadd P₁ v) (linear_equiv.refl k V₁) sorry

@[simp] theorem linear_const_vadd (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) : linear (const_vadd k P₁ v) = linear_equiv.refl k V₁ :=
  rfl

@[simp] theorem const_vadd_apply (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (p : P₁) : coe_fn (const_vadd k P₁ v) p = v +ᵥ p :=
  rfl

@[simp] theorem const_vadd_symm_apply (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (p : P₁) : coe_fn (symm (const_vadd k P₁ v)) p = -v +ᵥ p :=
  rfl

/-- Point reflection in `x` as a permutation. -/
def point_reflection (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) : affine_equiv k P₁ P₁ :=
  trans (const_vsub k x) (vadd_const k x)

theorem point_reflection_apply (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) (y : P₁) : coe_fn (point_reflection k x) y = x -ᵥ y +ᵥ x :=
  rfl

@[simp] theorem point_reflection_symm (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) : symm (point_reflection k x) = point_reflection k x :=
  injective_to_equiv (equiv.point_reflection_symm x)

@[simp] theorem to_equiv_point_reflection (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) : to_equiv (point_reflection k x) = equiv.point_reflection x :=
  rfl

@[simp] theorem point_reflection_self (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) : coe_fn (point_reflection k x) x = x :=
  vsub_vadd x x

theorem point_reflection_involutive (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) : function.involutive ⇑(point_reflection k x) :=
  equiv.point_reflection_involutive x

/-- `x` is the only fixed point of `point_reflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
theorem point_reflection_fixed_iff_of_injective_bit0 (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] {x : P₁} {y : P₁} (h : function.injective bit0) : coe_fn (point_reflection k x) y = y ↔ y = x :=
  equiv.point_reflection_fixed_iff_of_injective_bit0 h

theorem injective_point_reflection_left_of_injective_bit0 (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (h : function.injective bit0) (y : P₁) : function.injective fun (x : P₁) => coe_fn (point_reflection k x) y :=
  equiv.injective_point_reflection_left_of_injective_bit0 h y

theorem injective_point_reflection_left_of_module (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [invertible (bit0 1)] (y : P₁) : function.injective fun (x : P₁) => coe_fn (point_reflection k x) y := sorry

theorem point_reflection_fixed_iff_of_module (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [invertible (bit0 1)] {x : P₁} {y : P₁} : coe_fn (point_reflection k x) y = y ↔ y = x :=
  iff.trans (function.injective.eq_iff' (injective_point_reflection_left_of_module k y) (point_reflection_self k y))
    eq_comm

end affine_equiv

namespace affine_map

theorem line_map_vadd {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (v' : V₁) (p : P₁) (c : k) : coe_fn (line_map v v') c +ᵥ p = coe_fn (line_map (v +ᵥ p) (v' +ᵥ p)) c :=
  affine_equiv.apply_line_map (affine_equiv.vadd_const k p) v v' c

theorem line_map_vsub {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (p₁ : P₁) (p₂ : P₁) (p₃ : P₁) (c : k) : coe_fn (line_map p₁ p₂) c -ᵥ p₃ = coe_fn (line_map (p₁ -ᵥ p₃) (p₂ -ᵥ p₃)) c :=
  affine_equiv.apply_line_map (affine_equiv.symm (affine_equiv.vadd_const k p₃)) p₁ p₂ c

theorem vsub_line_map {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (p₁ : P₁) (p₂ : P₁) (p₃ : P₁) (c : k) : p₁ -ᵥ coe_fn (line_map p₂ p₃) c = coe_fn (line_map (p₁ -ᵥ p₂) (p₁ -ᵥ p₃)) c :=
  affine_equiv.apply_line_map (affine_equiv.const_vsub k p₁) p₂ p₃ c

theorem vadd_line_map {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (p₁ : P₁) (p₂ : P₁) (c : k) : v +ᵥ coe_fn (line_map p₁ p₂) c = coe_fn (line_map (v +ᵥ p₁) (v +ᵥ p₂)) c :=
  affine_equiv.apply_line_map (affine_equiv.const_vadd k P₁ v) p₁ p₂ c

theorem homothety_neg_one_apply {V₁ : Type u_2} {P₁ : Type u_6} [add_comm_group V₁] [add_torsor V₁ P₁] {R' : Type u_10} [comm_ring R'] [semimodule R' V₁] (c : P₁) (p : P₁) : coe_fn (homothety c (-1)) p = coe_fn (affine_equiv.point_reflection R' c) p := sorry


import tactic.interactive

example : ¬ ∀ (α : Type) (r : Prop), r → (∃ x : α, r) :=
begin
  intro h,
  cases h empty _ true.intro with w,
  cases w
end

example (α : Type) [inhabited α] (r : Prop) : r → (∃ x : α, r) :=
λ h, ⟨inhabited.default α, h⟩

#print foo


import new.ordered.C_o
import algebra.homology.homological_complex
import algebra.category.Group.abelian
import algebra.homology.homology
import topology.sheaves.sheaf_condition.unique_gluing
-- import new.refinement

noncomputable theory

section

open topological_space Top Top.sheaf
open category_theory
open category_theory.limits
open opposite
open nat

open_locale big_operators

universe u
variables {X : Top.{u}} (𝓕 : sheaf Ab X) (U V : X.oc)

section

variables {U}

def vec_o.single (i : U.ι) : vec_o U 1 :=
{ to_fun := λ _, i,
  is_strict_mono := λ ⟨i, hi⟩ ⟨j, hj⟩ (h : i < j), by linarith }

def vec_o.double {i j : U.ι} (h : i < j) :
  vec_o U 2 :=
{ to_fun := ![i, j],
  is_strict_mono := begin
    intros m n ineq,
    fin_cases m;
    fin_cases n,
    { exfalso, exact lt_irrefl _ ineq, },
    { exact h },
    { have triv : ¬ 1 < 0,
      { rw not_lt,
        linarith, },
      exfalso, exact triv ineq, },
    { exfalso, exact lt_irrefl _ ineq, },
  end }

lemma vec_o.double_apply0 {i j : U.ι} (h : i < j) :
  vec_o.double h 0 = i :=
begin
  change ![i, j] 0 = i,
  simp only [matrix.cons_val_zero],
end

lemma vec_o.double_apply1 {i j : U.ι} (h : i < j) :
  vec_o.double h 1 = j :=
begin
  change ![i, j] 1 = j,
  simp only [matrix.cons_val_one, matrix.head_cons],
end

lemma vec_o.double_ignore0 {i j : U.ι} (h : i < j) :
  ignore_o (vec_o.double h) 0 = vec_o.single j :=
sorry

lemma vec_o.double_ignore1 {i j : U.ι} (h : i < j) :
  ignore_o (vec_o.double h) 1 = vec_o.single i :=
sorry

lemma face.vec_o_single (i : U.ι) :
  face_o (vec_o.single i) = U.cover i :=
begin
  change face (vec_o.single i) = _,
  ext,
  split;
  intros hx;
  rw opens.mem_coe at hx ⊢,
  { erw opens.fintype_infi at hx,
    specialize hx 0,
    convert hx,  },
  { erw opens.fintype_infi,
    rintros ⟨i, hi⟩,
    interval_cases i,
    convert hx, },
end

lemma face.double_le_single1 {i j : U.ι} (h : i < j) :
  face_o (vec_o.double h) ≤ face_o (vec_o.single i) := sorry

lemma face.double_le_single2 {i j : U.ι} (h : i < j) :
  face_o (vec_o.double h) ≤ face_o (vec_o.single j) := sorry

end

def d_o_from_to (i j : ℕ) : C_o 𝓕 U i ⟶ C_o 𝓕 U j :=
dite (j = i + 1)
(λ h, d_o 𝓕 U i ≫ eq_to_hom (by rw h))
(λ h, 0)

lemma d_o_to_succ {i : ℕ} (f α) :
  d_o_from_to 𝓕 U i (i + 1) f α = d_o 𝓕 U i f α :=
begin
  rw [d_o_from_to],
  rw dif_pos rfl,
  rw comp_apply,
  refl,
end

lemma d_o_to_succ' (i : ℕ) :
  d_o_from_to 𝓕 U i (i + 1) = d_o 𝓕 U i :=
begin
  ext f α,
  rw d_o_from_to,
  rw dif_pos rfl,
  refl,
end

lemma d_o_not_to_succ {i j : ℕ} (h : j ≠ i + 1) (f α) :
  d_o_from_to 𝓕 U i j f α = 0 :=
begin
  rw [d_o_from_to, dif_neg h],
  refl,
end

def Cech_complex_wrt_cover_ordered : cochain_complex Ab.{u} ℕ :=
{ X := λ n, C_o 𝓕 U (n + 1),
  d := λ i j, d_o_from_to 𝓕 U _ _,
  shape' := λ i j h, begin
    ext f α,
    rw d_o_not_to_succ,
    rw [add_monoid_hom.zero_apply, pi.zero_apply],
    simp only [complex_shape.up_rel] at h,
    contrapose! h,
    symmetry,
    simpa [add_left_inj] using h,
  end,
  d_comp_d' := λ i j k h1 h2, begin
    simp only [complex_shape.up_rel] at h1 h2,
    subst' h2,
    subst' h1,
    ext f α,
    rw comp_apply,
    rw d_o_to_succ,
    rw d_o_to_succ',
    simp only [AddCommGroup.zero_apply, pi.zero_apply],
    rw dd_o_eq_zero,
  end }

lemma Cech_complex_wrt_cover_ordered.d_to_rel
  (n : ℕ) (m) (h : (complex_shape.up ℕ).prev n = some m) :
  (Cech_complex_wrt_cover_ordered 𝓕 U).d m.1 n =
  d_o 𝓕 U (m.1 + 1) ≫ eq_to_hom begin
    have := m.2,
    simp only [complex_shape.up_rel] at this,
    rw this,
    refl,
  end :=
begin
  change d_o_from_to 𝓕 U _ _ = _,
  rw [d_o_from_to, dif_pos],
  refl,
  rw add_left_inj,
  exact m.2.symm,
end

def Cech_Cohomology_Group_wrt_cover_ordered_nth (n : ℕ) : Ab :=
@homological_complex.homology ℕ Ab _ _ (complex_shape.up ℕ) (abelian.has_zero_object) _ _ _
  (Cech_complex_wrt_cover_ordered 𝓕 U) n

section zeroth

def ex1 :
  Cech_Cohomology_Group_wrt_cover_ordered_nth 𝓕 U 0 ≅
  kernel ((Cech_complex_wrt_cover_ordered 𝓕 U).d 0 1) :=
begin
  refine homology_iso_cokernel_image_to_kernel' _ _ _ ≪≫ _,
  change cokernel (kernel.lift _ _ _) ≅ _,

  simp only [image.ι_zero', homological_complex.d_to_eq_zero, cochain_complex.prev_nat_zero, eq_self_iff_true, kernel.lift_zero],
  refine cokernel_zero_iso_target ≪≫ _,
  refine AddCommGroup.kernel_iso_ker _ ≪≫ _,
  refine _ ≪≫ (AddCommGroup.kernel_iso_ker (d_o 𝓕 U _)).symm,
  refine { hom := _, inv := _, hom_inv_id' := _, inv_hom_id' := _ },
  { refine { to_fun := _, map_zero' := _, map_add' := _ },
    { intros x,
      refine ⟨x.1, _⟩,
      rw add_monoid_hom.mem_ker,
      have := x.2,
      rw add_monoid_hom.mem_ker at this,
      have eq1 := homological_complex.d_from_eq (Cech_complex_wrt_cover_ordered 𝓕 U) (show 1 = 0 + 1, from rfl),
      generalize_proofs h1 h2 at eq1,
      change _ = d_o _ _ _ ≫ _ at eq1,
      have eq2 : homological_complex.d_from (Cech_complex_wrt_cover_ordered 𝓕 U) 0 x.1 = (d_o 𝓕 _ _ ≫ (homological_complex.X_next_iso (Cech_complex_wrt_cover_ordered 𝓕 U) h1).inv) x.1,
      { apply congr_fun,
        simpa only [fun_like.coe_fn_eq] using eq1, },
      apply_fun (homological_complex.X_next_iso (Cech_complex_wrt_cover_ordered 𝓕 U) h1).hom at eq2,
      rw comp_apply at eq2,
      rw this at eq2,
      simp only [map_zero, coe_inv_hom_id] at eq2,
      rw ←eq2,
      },
    { rw subtype.ext_iff_val,
      refl, },
    { intros x1 x2,
      rw subtype.ext_iff_val,
      refl, } },
  { refine { to_fun := _, map_zero' := _, map_add' := _ },
    { intros x,
      refine ⟨x.1, _⟩,
      have := x.2,
      rw add_monoid_hom.mem_ker at this ⊢,
      have eq1 := homological_complex.d_from_eq (Cech_complex_wrt_cover_ordered 𝓕 U) (show 1 = 0 + 1, from rfl),
      erw eq1,
      rw comp_apply,
      generalize_proofs h1 h2,
      apply_fun (homological_complex.X_next_iso (Cech_complex_wrt_cover_ordered 𝓕 U) h1).hom,
      simp only [coe_inv_hom_id, map_zero],
      convert this,
      apply function.bijective.injective,
      rw function.bijective_iff_has_inverse,
      use (homological_complex.X_next_iso (Cech_complex_wrt_cover_ordered 𝓕 U) h1).inv,
      refine ⟨_, _⟩,
      intros x,
      rw coe_hom_inv_id,
      intros x,
      rw coe_inv_hom_id, },
    { rw subtype.ext_iff_val,
      refl },
    { intros x y,
      rw subtype.ext_iff_val,
      refl, } },
  { ext1 σ,
    simp only [comp_apply, subtype.val_eq_coe, add_subgroup.coe_mk, add_monoid_hom.coe_mk, set_like.eta, id_apply] },
  { ext1 σ,
    simp only [comp_apply, subtype.val_eq_coe, add_subgroup.coe_mk, add_monoid_hom.coe_mk, set_like.eta, id_apply] },
end

def ex2 :
  kernel ((Cech_complex_wrt_cover_ordered 𝓕 U).d 0 1) ≅
  kernel (d_o 𝓕 U 1) :=
eq_to_iso rfl

def ex3 :
  kernel (d_o 𝓕 U 1) ≅
  AddCommGroup.of (add_monoid_hom.ker (d_o 𝓕 U 1)) :=
AddCommGroup.kernel_iso_ker _

lemma ex41.forward.aux1 {i j : U.ι} {f : C_o 𝓕 U 1}
  (h : d_o _ _ _ f = 0) :
  𝓕.1.map ((U.cover i).inf_le_left (U.cover j) ≫ eq_to_hom begin
    rw ← face.vec_o_single,
    refl,
  end).op (f (vec_o.single i)) =
  𝓕.1.map (hom_of_le begin
    convert inf_le_left,
    rw ← face.vec_o_single,
    refl,
  end).op (f (vec_o.single i)) :=
begin
  congr,
end

lemma ex41.forward.aux1' {i j : U.ι} {f : C_o 𝓕 U 1}
  (h : d_o _ _ _ f = 0) :
  𝓕.1.map ((U.cover i).inf_le_right (U.cover j) ≫ eq_to_hom begin
    rw ← face.vec_o_single,
    refl,
  end).op (f (vec_o.single j)) =
  𝓕.1.map (hom_of_le begin
    convert inf_le_right,
    rw ← face.vec_o_single,
    refl,
  end).op (f (vec_o.single j)) :=
begin
  congr,
end

lemma ex41.forward.aux2 {i j : U.ι} {f : C_o 𝓕 U 1}
  (h : d_o _ _ _ f = 0) :
  𝓕.1.map ((U.cover i).inf_le_right (U.cover j) ≫ eq_to_hom begin
    rw ← face.vec_o_single,
    refl,
  end).op (f (vec_o.single j)) =
  𝓕.1.map (hom_of_le begin
    convert inf_le_right,
    rw ← face.vec_o_single,
    refl,
  end).op (f (vec_o.single j)) :=
begin
  congr,
end

lemma ex41.forward.aux2' {i j : U.ι} {f : C_o 𝓕 U 1}
  (h : d_o _ _ _ f = 0) :
  𝓕.1.map ((U.cover i).inf_le_left (U.cover j) ≫ eq_to_hom begin
    rw ← face.vec_o_single,
    refl,
  end).op (f (vec_o.single i)) =
  𝓕.1.map (hom_of_le begin
    convert inf_le_left,
    rw ← face.vec_o_single,
    refl,
  end).op (f (vec_o.single i)) :=
begin
  congr,
end

lemma ex41.forward.aux3 {i j : U.ι} (ineq : i < j) (f : C_o 𝓕 U 1) :
  𝓕.1.map (hom_of_le (face.le_ignore_o _ _)).op (f (ignore_o (vec_o.double ineq) 0)) =
  𝓕.1.map ((hom_of_le (face.double_le_single2 ineq))).op (f (vec_o.single j)) :=
begin
  generalize_proofs _ h1 h2,
  rw map_congr.vec_o_eq f (vec_o.double_ignore0 ineq),
  rw [← comp_apply, ← 𝓕.1.map_comp],
  congr,
end

lemma ex41.forward.aux3' {i j : U.ι} (ineq : j < i) (f : C_o 𝓕 U 1) :
  𝓕.1.map (hom_of_le (face.le_ignore_o _ _)).op
  (f (ignore_o (vec_o.double ineq) 0)) =
  𝓕.1.map
  (hom_of_le (face.double_le_single2 ineq)).op
  (f (vec_o.single i))
  :=
begin
  generalize_proofs _ h1 h2 h3 h4 h5,
  rw map_congr.vec_o_eq f (vec_o.double_ignore0 ineq),
  rw [← comp_apply, ← 𝓕.1.map_comp],
  congr,
end

lemma ex41.forward.aux4 {i j : U.ι} (ineq : i < j) (f : C_o 𝓕 U 1) :
  𝓕.1.map (hom_of_le (face.le_ignore_o _ _)).op (f (ignore_o (vec_o.double ineq) 1)) =
  𝓕.1.map (hom_of_le (face.double_le_single1 ineq)).op (f (vec_o.single i))
  :=
begin
  generalize_proofs _ h1 h2,
  rw map_congr.vec_o_eq f (vec_o.double_ignore1 ineq),
  rw [← comp_apply, ← 𝓕.1.map_comp],
  congr,
end

lemma ex41.forward.aux4' {i j : U.ι} (ineq : j < i) (f : C_o 𝓕 U 1) :
  𝓕.1.map (hom_of_le (face.le_ignore_o _ _)).op
  (f (ignore_o (vec_o.double ineq) 1)) =
  𝓕.1.map
  (hom_of_le (face.double_le_single1 ineq)).op
  (f (vec_o.single j))
  :=
begin
  generalize_proofs _ h1 h2,
  rw map_congr.vec_o_eq f (vec_o.double_ignore1 ineq),
  rw [← comp_apply, ← 𝓕.1.map_comp],
  congr,
end

lemma ex41.forward.aux5 (f : C_o 𝓕 U 1)
  (o1 o2 o3 o4 : opens X)
  (oop2 : 𝓕.val.obj (op o2))
  (oop3 : 𝓕.val.obj (op o3))
-- o1 : face ij
-- o2 : face i
-- o3 : face j
-- o4 : cover i ⊓ cover j
  (h12 : o1 ≤ o2)
  (h13 : o1 ≤ o3)
  (h42 : o4 ≤ o2)
  (h43 : o4 ≤ o3)
  (h14 : o4 ≤ o1)
  (eq1 : 𝓕.1.map (hom_of_le h12).op oop2 = 𝓕.1.map (hom_of_le h13).op oop3) :
  𝓕.1.map (hom_of_le h42).op oop2 = 𝓕.1.map (hom_of_le h43).op oop3 :=
begin
  have : hom_of_le h42 = hom_of_le h14 ≫ hom_of_le h12,
  { ext, },
  rw this,
  have : hom_of_le h43 = hom_of_le h14 ≫ hom_of_le h13,
  { ext },
  rw this,
  rw [op_comp, category_theory.functor.map_comp, op_comp, category_theory.functor.map_comp],
  rw [comp_apply, comp_apply, eq1],
end

lemma ker_compatible (f : add_monoid_hom.ker (d_o 𝓕 U 1)) :
  presheaf.is_compatible 𝓕.1 U.cover
  (λ i, begin
    refine 𝓕.1.map (eq_to_hom _).op (f.1 (vec_o.single i)),
    rw ← face.vec_o_single,
    refl,
  end) :=
begin
  intros i j,
  have := f.2,
  rw add_monoid_hom.mem_ker at this,

  rcases @trichotomous U.ι (<) _ i j with ineq|ineq|ineq,
  { dsimp only,
    change (𝓕.1.map _ ≫ _) _ = (𝓕.1.map _ ≫ _) _,
    rw [← category_theory.functor.map_comp, ← category_theory.functor.map_comp, ← op_comp, ← op_comp],
    rw ex41.forward.aux1 _ _ this,
    rw ex41.forward.aux2 _ _ this,

    have eq1 : d_o _ _ _ f.1 (vec_o.double ineq) = 0,
    { rw this, simp, },
    simp only [d_o_small.d_o.one_apply] at eq1,
    rw sub_eq_zero at eq1,
    rw ex41.forward.aux3 at eq1,
    have eq2 := eq.trans eq1 (ex41.forward.aux4 𝓕 U ineq f.1),

    refine ex41.forward.aux5 𝓕 U f.1 (face_o (vec_o.double ineq))
      (face_o (vec_o.single i))
      (face_o (vec_o.single j))
      (U.cover i ⊓ U.cover j)
      (f.val (vec_o.single i))
      (f.val (vec_o.single j))
      _ _ _ _ _ _,
    { apply face.double_le_single1, },
    { apply face.double_le_single2, },
    { intros p hp,
      rcases hp with ⟨hp1, hp2⟩,
      rw opens.mem_coe at hp1 hp2 ⊢,
      erw opens.fintype_infi,
      intros k,
      fin_cases k,
      { rwa vec_o.double_apply0, },
      { rwa vec_o.double_apply1, }, },
    { exact eq2.symm, }, },
  { subst ineq, refl, },
  { dsimp only,
    change (𝓕.1.map _ ≫ _) _ = (𝓕.1.map _ ≫ _) _,
    rw [← category_theory.functor.map_comp, ← category_theory.functor.map_comp, ← op_comp, ← op_comp],
    rw ex41.forward.aux1' _ _ this,
    rw ex41.forward.aux2' _ _ this,

    have eq1 : d_o _ _ _ f.1 (vec_o.double ineq) = 0,
    { rw this, simp, },
    simp only [d_o_small.d_o.one_apply] at eq1,
    change _ - _ = _ at eq1,
    rw sub_eq_zero at eq1,
    dsimp only at eq1,
    rw ex41.forward.aux3' at eq1,
    have eq2 := eq.trans eq1 (ex41.forward.aux4' 𝓕 U ineq f.1),

    refine ex41.forward.aux5 𝓕 U f.1
      (face_o (vec_o.double ineq))
      (face_o (vec_o.single i))
      (face_o (vec_o.single j))
      (U.cover i ⊓ U.cover j)
      (f.val (vec_o.single i))
      (f.val (vec_o.single j))
      _ _ _ _ _ _,
    { apply face.double_le_single2, },
    { apply face.double_le_single1, },
    { intros p hp,
      rcases hp with ⟨hp1, hp2⟩,
      rw opens.mem_coe at hp1 hp2 ⊢,
      erw opens.fintype_infi,
      intros k,
      fin_cases k,
      { rwa vec_o.double_apply0, },
      { rwa vec_o.double_apply1, }, },
    { convert eq2, }, },
end

lemma unique_gluing_prop
  (f : add_monoid_hom.ker (d_o 𝓕 U 1)) :
  ∃! (s : 𝓕.val.obj (op ⊤)),
  ∀ (i : U.ι),
    (𝓕.val.map (hom_of_le le_top).op) s =
    (𝓕.val.map (eq_to_hom (by rw ← face.vec_o_single : U.cover i = (face_o (vec_o.single i)))).op)
      (f.val (vec_o.single i)) :=
sheaf.exists_unique_gluing'
  𝓕 U.cover ⊤
  (λ i, hom_of_le le_top)
  begin
    rw U.is_cover,
    exact le_refl _,
  end
  (λ i, begin
    refine 𝓕.1.map (eq_to_hom _).op (f.1 (vec_o.single i)),
    rw ← face.vec_o_single,
    refl,
  end)
  (ker_compatible 𝓕 U f)

def unique_gluing (f : add_monoid_hom.ker (d_o 𝓕 U 1)) :
  𝓕.1.obj (op ⊤) :=
classical.some (unique_gluing_prop _ _ f)

lemma unique_gluing_is_glueing
  (f : add_monoid_hom.ker (d_o 𝓕 U 1))
  (i : U.ι) :
  𝓕.1.map (hom_of_le le_top).op (unique_gluing _ _ f) =
  𝓕.1.map (eq_to_hom (begin
    rw ← face.vec_o_single,
    refl,
  end : U.cover i = _)).op (f.1 (vec_o.single i)) :=
begin
  have := classical.some_spec (unique_gluing_prop _ _ f),
  dsimp only at this,
  rcases this with ⟨h1, h2⟩,
  exact h1 i,
end

lemma unique_gluing_is_unique
  (f : add_monoid_hom.ker (d_o 𝓕 U 1))
  (s : 𝓕.1.obj (op ⊤))
  (is_glue : ∀ (i : U.ι),
    𝓕.1.map (hom_of_le le_top).op s =
    𝓕.1.map (eq_to_hom (begin
      rw ← face.vec_o_single,
      refl,
    end : U.cover i = _)).op (f.1 (vec_o.single i))) :
  (unique_gluing _ _ f) = s :=
begin
  have := classical.some_spec (unique_gluing_prop _ _ f),
  dsimp only at this,
  rcases this with ⟨h1, h2⟩,
  symmetry,
  apply h2,
  assumption,
end

def ex41.forward :
  (AddCommGroup.of $ add_monoid_hom.ker (d_o 𝓕 U 1)) ⟶ 𝓕.1.obj (op ⊤) :=
{ to_fun := λ f, unique_gluing _ _ f,
  map_zero' := begin
    apply unique_gluing_is_unique,
    intros i,
    simp,
  end,
  map_add' := λ f g, begin
    apply unique_gluing_is_unique,
    intros i,
    rw map_add,
    erw map_add,
    congr;
    apply unique_gluing_is_glueing,
  end }

lemma inj :
  function.injective (ex41.forward 𝓕 U) :=
begin
  intros f g h,
  change unique_gluing _ _ f = unique_gluing _ _ g at h,
  have h1 := unique_gluing_is_glueing _ _ f,
  rw subtype.ext_iff_val,
  ext σ,
  -- have eq1 : ∃ i, σ.to_finset = {i},
  -- { have := σ.card_eq,
  --   simp only [nat.pred_succ] at this,
  --   rwa finset.card_eq_one at this, },
  -- rcases eq1 with ⟨i, hi⟩,
  specialize h1 (σ 0),

  have h2 := unique_gluing_is_glueing _ _ g,
  specialize h2 (σ 0),

  rw [eq_to_hom_op, eq_to_hom_map] at h1 h2,
  rw h at h1,
  rw h1 at h2,

  have eq2 : σ = vec_o.single (σ 0),
  { ext, rcases x with ⟨x, hx⟩, interval_cases x, refl, },
  rw eq2,
  generalize_proofs _ h3 at h2,
  suffices : function.injective (eq_to_hom h3),
  apply this,
  exact h2,

  intros x y h,
  apply_fun (eq_to_hom h3.symm) at h,
  change (eq_to_hom h3 ≫ eq_to_hom h3.symm) x = (eq_to_hom h3 ≫ eq_to_hom h3.symm) y at h,
  rw [eq_to_hom_trans, eq_to_hom_refl] at h_1,
  simpa only using h_1,
end

lemma surj :
  function.surjective (ex41.forward 𝓕 U) :=
begin
  rw function.surjective_iff_has_right_inverse,
  fconstructor,
  { intros s,
    refine ⟨λ σ, _, _⟩,
    exact 𝓕.1.map (hom_of_le le_top).op s,
    rw add_monoid_hom.mem_ker,
    ext σ,
    rw pi.zero_apply,
    rw d_o_small.d_o.one_apply,
    rw sub_eq_zero,
    dsimp only,
    change (𝓕.1.map _ ≫ 𝓕.1.map _) _ = (𝓕.1.map _ ≫ 𝓕.1.map _) _,
    rw [← 𝓕.1.map_comp,  ← 𝓕.1.map_comp, ← op_comp],
    refl, },
  { intros s,
    apply unique_gluing_is_unique,
    intros i,
    dsimp only,
    change _ = (𝓕.1.map _ ≫ 𝓕.1.map _) _,
    congr' 1,
    rw ← 𝓕.1.map_comp,
    rw ← op_comp,
    congr' 1,
  },
end

def ex41 :
  (AddCommGroup.of $ add_monoid_hom.ker (d_o 𝓕 U 1)) ≃+
  𝓕.1.obj (op ⊤) :=
add_equiv.of_bijective (ex41.forward _ _) ⟨inj _ _, surj _ _⟩

def zeroth_Cech_Cohomology :
  (Cech_Cohomology_Group_wrt_cover_ordered_nth 𝓕 U 0) ≅
  𝓕.1.obj (op ⊤) :=
ex1 𝓕 U ≪≫ ex2 𝓕 U ≪≫ ex3 𝓕 U ≪≫
{ hom := (ex41 _ _).to_add_monoid_hom,
  inv := (ex41 _ _).symm.to_add_monoid_hom,
  hom_inv_id' := begin
    ext f σ,
    simp only [comp_apply, add_equiv.coe_to_add_monoid_hom, add_equiv.symm_apply_apply, id_apply],
  end,
  inv_hom_id' := begin
    ext f σ,
    simp only [comp_apply, add_equiv.coe_to_add_monoid_hom, add_equiv.apply_symm_apply, id_apply],
  end }

end zeroth

end


theorem eq_of_isEqvAux [DecidableEq α] (a b : Array α) (hsz : a.size = b.size) (i : Nat) (hi : i ≤ a.size) (heqv : Array.isEqvAux a b hsz (fun x y => x = y) i) : ∀ (j : Nat) (hl : i ≤ j) (hj : j < a.size), a.get ⟨j, hj⟩ = b.get ⟨j, hsz ▸ hj⟩ := by
  intro j low high
  by_cases h : i < a.size
  · unfold Array.isEqvAux at heqv
    simp [h] at heqv
    have hind := eq_of_isEqvAux a b hsz (i+1) (Nat.succ_le_of_lt h) heqv.2
    by_cases heq : i = j
    · subst heq; exact heqv.1
    · exact hind j (Nat.succ_le_of_lt (Nat.lt_of_le_of_ne low heq)) high
  · have heq : i = a.size := Nat.le_antisymm hi (Nat.ge_of_not_lt h)
    subst heq
    exact absurd (Nat.lt_of_lt_of_le high low) (Nat.lt_irrefl j)
termination_by _ => a.size - i

@[simp] def f (x y : Nat) : Nat → Nat :=
  if h : x > 0 then
    fun z => f (x - 1) (y + 1) z + 1
  else
    (· + y)
termination_by
  f x y => x

#check f._eq_1


import for_mathlib.derived.K_projective
import for_mathlib.homological_complex_op
import for_mathlib.homology_iso_Ab

noncomputable theory

universes v u

open category_theory category_theory.limits category_theory.preadditive

variables {C : Type u} {ι : Type*} [category.{v} C] [abelian C] {c : complex_shape ι}

def homotopy_category.quotient_map_hom (A B : homological_complex C c) :
  (A ⟶ B) →+ ((homotopy_category.quotient C c).obj A ⟶ (homotopy_category.quotient C c).obj B) :=
add_monoid_hom.mk' (λ f, (homotopy_category.quotient C c).map f) $ λ f g, rfl

lemma quot.mk_surjective {X : Type*} (r : X → X → Prop) :
  function.surjective (quot.mk r) :=
λ x, quot.induction_on x $ λ x, ⟨x, rfl⟩

noncomputable
def homotopy.to_single [decidable_eq ι] [decidable_rel c.rel] {X : homological_complex C c} {B : C}
  {i j : ι} (r : c.rel i j)
  (f g : X ⟶ (homological_complex.single C c i).obj B) (h : X.X j ⟶ B)
  (H : f.f i = X.d i j ≫ h ≫ eq_to_hom (if_pos rfl).symm + g.f i) :
  homotopy f g :=
{ hom := λ i₁ i₂, if r' : c.rel i₂ i₁ then if e : i₂ = i then
    (X.X_eq_to_iso (c.next_eq (e ▸ r' : c.rel i i₁) r)).hom ≫ h ≫ eq_to_hom (if_pos e).symm
    else 0 else 0,
  zero' := λ _ _ e, dif_neg e,
  comm := λ k, begin
    dsimp,
    by_cases hki : k = i,
    swap, { apply is_zero.eq_of_tgt, dsimp, rw if_neg hki, exact is_zero_zero _ },
    subst hki,
    rw [← d_next_eq_d_from_from_next, ← prev_d_eq_to_prev_d_to,
      d_next_eq _ r, dif_pos r, dif_pos rfl, X.X_eq_to_iso_refl, category.id_comp, H],
    nth_rewrite_lhs 0 ← add_monoid.add_zero (X.d k j ≫ h ≫ eq_to_hom _),
    congr,
    by_cases aux : c.rel (c.prev k) k,
    { rw [prev_d_eq _ aux, dif_pos aux],
      by_cases hk : c.prev k = k,
      { rw [dif_pos hk, eq_comm], apply comp_zero },
      { rw [dif_neg hk, zero_comp], refl, } },
    { delta prev_d, dsimp only [add_monoid_hom.mk'_apply],
      rw [dif_neg aux, zero_comp], refl }
  end }

lemma homotopic_to_single_iff [decidable_eq ι] {X : homological_complex C c}
  {B : C} {i j : ι} (r : c.rel i j)
  (f g : X ⟶ (homological_complex.single C c i).obj B) :
  homotopic _ _ f g ↔
    ∃ (h : X.X j ⟶ B), f.f i = X.d i j ≫ h ≫ eq_to_hom (if_pos rfl).symm + g.f i :=
begin
  haveI : decidable_rel c.rel := λ _ _, classical.dec _,
  refine ⟨_, λ ⟨h, H⟩, ⟨homotopy.to_single r f g h H⟩⟩,
  rintro ⟨h⟩,
  use h.hom j i ≫ eq_to_hom (if_pos rfl),
  rw [category.assoc, eq_to_hom_trans, eq_to_hom_refl, category.comp_id, ← add_zero (_ ≫ _)],
  have := h.comm i,
  rw [d_next_eq _ r] at this,
  convert this,
  delta prev_d, dsimp only [add_monoid_hom.mk'_apply],
  rw eq_comm, apply comp_zero,
end

instance : decidable_rel (complex_shape.up ℤ).rel :=
λ i j, show decidable (i + 1 = j), by apply_instance

@[simps] noncomputable
def homological_complex.hom_single_iso
  (P : cochain_complex C ℤ) (B : C) (i : ℤ) :
  (P ⟶ (homological_complex.single C (complex_shape.up ℤ) i).obj B) ≃+
    (add_monoid_hom.ker ((((preadditive_yoneda.obj B).map_homological_complex
      (complex_shape.up ℤ).symm).obj P.op).d i (i - 1))) :=
{ to_fun := λ f, begin
    refine ⟨f.f i ≫ eq_to_hom (if_pos rfl), _⟩,
    change P.d (i - 1) i ≫ f.f i ≫ eq_to_hom _ = 0,
    rw ← f.comm_assoc,
    dsimp,
    rw [zero_comp, comp_zero],
  end,
  inv_fun := λ f, begin
    refine ⟨λ j, if e : j = i then
      (P.X_eq_to_iso $ e).hom ≫ f.1 ≫ eq_to_hom (if_pos e).symm else 0, _⟩,
    rintros j k (rfl : j + 1 = k),
    dsimp,
    rw comp_zero,
    split_ifs,
    { have := eq_sub_iff_add_eq.mpr h, subst this,
      rw [P.X_d_eq_to_iso_assoc, ← category.assoc, ← subtype.val_eq_coe,
        show P.d (i - 1) i ≫ f.1 = 0, from f.2, zero_comp] },
    { exact comp_zero.symm }
  end,
  left_inv := begin
    intro f,
    ext j,
    dsimp,
    split_ifs,
    { subst h, simp },
    { apply is_zero.eq_of_tgt, rw if_neg h, exact is_zero_zero _ }
  end,
  right_inv := λ f, by { ext, dsimp, simp },
  map_add' := λ f g, subtype.ext (preadditive.add_comp _ _ _ _ _ _) }

namespace bounded_homotopy_category

namespace hom_single_iso_setup

def hom_complex
  (P : bounded_homotopy_category C) (B : C) :=
((preadditive_yoneda.obj B).map_homological_complex _).obj P.val.as.op

def map_hom_complex
  {P₁ P₂ : bounded_homotopy_category C} (f : P₁ ⟶ P₂) (B : C) :
  hom_complex P₂ B ⟶ hom_complex P₁ B :=
(((preadditive_yoneda.obj B).map_homological_complex _).map
  (homological_complex.op_functor.map f.out.op))

def map_hom_complex'
  (P : bounded_homotopy_category C) {B₁ B₂ : C} (f : B₁ ⟶ B₂) :
  hom_complex P B₁ ⟶ hom_complex P B₂ :=
(nat_trans.map_homological_complex (preadditive_yoneda.map f) _).app _

def aux₁
  (P : bounded_homotopy_category C) (B : C) (i : ℤ) :
  homology
    ((hom_complex P B).d (i+1) i)
    ((hom_complex P B).d i (i-1))
    ((hom_complex P B).d_comp_d _ _ _) ≅
  (hom_complex P B).homology i :=
(homology_iso' (hom_complex P B) (i+1) i (i-1) (by simp) (by simp)).symm

def map_homology
  {P₁ P₂ : bounded_homotopy_category C} (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  homology ((hom_complex P₂ B).d (i + 1) i) ((hom_complex P₂ B).d i (i - 1))
    ((hom_complex _ B).d_comp_d _ _ _) ⟶
  homology ((hom_complex P₁ B).d (i + 1) i) ((hom_complex P₁ B).d i (i - 1))
    ((hom_complex _ B).d_comp_d _ _ _) :=
homology.map _ _
(arrow.hom_mk $ (map_hom_complex f B).comm _ _)
(arrow.hom_mk $ (map_hom_complex f B).comm _ _)
rfl

lemma aux₁_naturality
  (P₁ P₂ : bounded_homotopy_category C) (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  (aux₁ P₂ B i).hom ≫ (homology_functor _ _ _).map (map_hom_complex f B) =
  (map_homology f _ _) ≫ (aux₁ P₁ B i).hom :=
begin
  dsimp only [map_homology, aux₁, homology_iso', iso.symm_hom, homology.map_iso,
    homology_functor_map],
  rw homology.map_eq_desc'_lift_left,
  rw homology.map_eq_lift_desc'_left,
  rw homology.map_eq_desc'_lift_left,
  rw homology.map_eq_lift_desc'_left,
  apply homology.hom_from_ext, apply homology.hom_to_ext,
  simp only [homology.π'_desc', category.assoc, homology.π'_desc'_assoc,
    homology.lift_ι, homology.lift_ι_assoc],
  let t := _, change t ≫ _ = _,
  have ht : t = kernel.lift _ (kernel.ι _) _ ≫ homology.π' _ _ _,
  rotate 2,
  { rw homological_complex.d_from_eq,
    rw [kernel.condition_assoc, zero_comp],
    simp, },
  { apply homology.hom_to_ext,
    simp, dsimp, simp },
  rw ht, clear ht, clear t,
  simp only [kernel.lift_ι_assoc, category.assoc, arrow.hom_mk_left, arrow.iso_mk_inv_left,
    iso.refl_inv, homological_complex.hom.sq_from_left, homology.π'_desc'],
  let t := _, change _ = _ ≫ t,
  have ht : t = homology.ι _ _ _ ≫ cokernel.desc _ (cokernel.π _) _,
  rotate 2,
  { have := (hom_complex P₁ B).d_to_eq (by simp : (complex_shape.up ℤ).symm.rel (i+1) i),
    rw ← iso.inv_comp_eq at this,
    rw [← this, category.assoc, cokernel.condition, comp_zero] },
  { apply homology.hom_from_ext,
    simp, dsimp, simp },
  rw ht, clear ht, clear t,
  simp only [category.assoc, cokernel.π_desc, homology.lift_ι_assoc],
end

def aux₂
  (P : bounded_homotopy_category C) (B : C) (i : ℤ) :
  homology
    ((hom_complex P B).d (i+1) i)
    ((hom_complex P B).d i (i-1))
    (homological_complex.d_comp_d _ _ _ _) ≅
  AddCommGroup.homology ((hom_complex P B).d (i+1) i) ((hom_complex P B).d i (i-1)) :=
(AddCommGroup.homology_iso _ _ _)

def ker_hom
  {P₁ P₂ : bounded_homotopy_category C} (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  ((hom_complex P₂ B).d i (i - 1)).ker →+
  ((hom_complex P₁ B).d i (i - 1)).ker :=
{ to_fun := λ x, ⟨(map_hom_complex f B).f _ ↑x, begin
    change _ = _,
    have : _ = _ := x.2,
    dsimp [hom_complex, map_hom_complex] at *,
    rw [← category.assoc, ← f.out.comm, category.assoc, this, comp_zero],
  end⟩,
  map_zero' := by { ext, simp },
  map_add' := begin
    intros x y, ext, dsimp [map_hom_complex], simp,
  end }

def map_explicit_homology
  {P₁ P₂ : bounded_homotopy_category C} (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  AddCommGroup.homology ((hom_complex P₂ B).d (i+1) i) ((hom_complex P₂ B).d i (i-1)) ⟶
  AddCommGroup.homology ((hom_complex P₁ B).d (i+1) i) ((hom_complex P₁ B).d i (i-1)) :=
quotient_add_group.lift _
(add_monoid_hom.comp (quotient_add_group.mk' _) $ ker_hom f _ _)
begin
  rintros ⟨x,(hx : _ = _)⟩ hh,
  dsimp [ker_hom, map_hom_complex],
  rw quotient_add_group.eq_zero_iff,
  rw add_subgroup.mem_comap at *, dsimp at *,
  change ∃ e, _,
  obtain ⟨e,he⟩ := hh,
  dsimp [hom_complex] at *,
  use f.out.f _ ≫ e,
  rw [← category.assoc, ← f.out.comm, category.assoc, he],
end

--TODO: This relates the above construction to AddcommGroup.homology_map
-- the above def has more convenient defeq properties for some of the proofs below, but
-- the `AddCommGroup.homology_map` is better suited for `aux₂_naturality`.
lemma map_explicit_homology_eq
  {P₁ P₂ : bounded_homotopy_category C} (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  map_explicit_homology f B i =
  AddCommGroup.homology_map
    ((hom_complex P₂ B).d_comp_d _ _ _)
    ((hom_complex P₁ B).d_comp_d _ _ _)
    (commsq.of_eq $ ((map_hom_complex f B).comm (i+1) i).symm)
    (commsq.of_eq $ ((map_hom_complex f B).comm i (i-1)).symm) :=
begin
  ext ⟨t⟩,
  symmetry, apply AddCommGroup.homology_map_apply_mk,
end

lemma aux₂_naturality
  (P₁ P₂ : bounded_homotopy_category C) (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  (aux₂ P₂ B i).hom ≫ map_explicit_homology f _ _ =
  map_homology f _ _ ≫ (aux₂ P₁ B i).hom :=
begin
  rw map_explicit_homology_eq,
  dsimp [aux₂],
  dsimp [AddCommGroup.homology_iso, AddCommGroup.homology_map, map_homology],
  generalize_proofs _ _ w _ w',
  apply (homology.has _ _ w).ext_π,
  apply (AddCommGroup.has_homology _ _ w').ext_ι,
  rw has_homology.homology_map_eq,
  simp only [has_homology.π_map, category.assoc, has_homology.π_map_assoc,
    has_homology.map_ι, has_homology.map_ι_assoc],
  let t := _, change t ≫ _ = _,
  have ht : t = kernel.lift _ (kernel.ι _) _ ≫ (AddCommGroup.has_homology _ _ w).π,
  rotate 2,
  { apply kernel.condition },
  { apply (AddCommGroup.has_homology _ _ w).ext_ι,
    simp [has_homology.π_ι] },
  rw ht, clear ht, clear t,
  let t := _, change _ = _ ≫ t,
  have ht : t = (homology.has _ _ w').ι ≫ cokernel.desc _ (cokernel.π _) _,
  rotate 2,
  { apply cokernel.condition },
  { apply (homology.has _ _ w').ext_π,
    rw [← category.assoc, has_homology.π_ι],
    simp },
  rw ht, clear ht, clear t,
  simp,
end

lemma aux₂_naturality_inv
  (P₁ P₂ : bounded_homotopy_category C) (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  map_explicit_homology f _ _ ≫ (aux₂ P₁ B i).inv =
  (aux₂ P₂ B i).inv ≫  map_homology f _ _ :=
by rw [iso.comp_inv_eq, category.assoc, iso.eq_inv_comp, aux₂_naturality]

def aux₃
  (P : bounded_homotopy_category C) (B : C) (i : ℤ) :
  (P ⟶ (single C i).obj B) ≃+
  AddCommGroup.homology ((hom_complex P B).d (i+1) i) ((hom_complex P B).d i (i-1)) :=
begin
  refine add_equiv.surjective_congr (homological_complex.hom_single_iso P.val.as B i)
    (homotopy_category.quotient_map_hom _ _)
    (quotient_add_group.mk' _) (quot.mk_surjective _) (quot.mk_surjective _) _,
  ext f,
  dsimp,
  simp only [homotopy_category.quotient_map_hom, quotient_add_group.ker_mk,
    add_equiv.coe_to_add_monoid_hom, add_monoid_hom.mem_ker, add_subgroup.mem_comap,
    add_subgroup.coe_subtype, add_monoid_hom.mk'_apply, add_subgroup.coe_mk,
    add_equiv.coe_mk, add_monoid_hom.mem_range],
  rw ← (homotopy_category.quotient _ _).map_zero,
  any_goals { apply_instance },
  erw quotient.functor_map_eq_iff,
  rw homotopic_to_single_iff (show (complex_shape.up ℤ).rel i (i+1), from rfl),
  apply exists_congr,
  intro g,
  simp only [add_zero, quiver.hom.unop_op, linear_map.to_add_monoid_hom_coe,
    preadditive_yoneda_obj_map_apply, homological_complex.zero_f_apply,
    homological_complex.hom_single_iso_apply_coe],
  rw [← is_iso.comp_inv_eq, eq_comm],
  split,
  { intro h,
    rw [h, is_iso.comp_inv_eq, category.assoc, category.assoc, eq_to_hom_trans,
      eq_to_hom_refl, category.comp_id],
    refl },
  { intro h,
    rw [h, is_iso.eq_comp_inv, category.assoc, category.assoc, eq_to_hom_trans,
      eq_to_hom_refl, category.comp_id],
    refl }
end

lemma aux₃_apply
  (P : bounded_homotopy_category C) (B : C) (i : ℤ)
  (f : P ⟶ (single C i).obj B) :
  aux₃ P B i f = quotient_add_group.mk ⟨f.out.f i ≫ eq_to_hom (if_pos rfl), begin
    change _ = _, dsimp [hom_complex],
    rw [← category.assoc, ← f.out.comm, category.assoc],
    convert zero_comp,
    apply is_zero.eq_of_tgt, convert is_zero_zero _,
    dsimp [single], rw if_neg, simp,
  end⟩ := rfl

lemma aux₃_naturality
  (P₁ P₂ : bounded_homotopy_category C) (f : P₁ ⟶ P₂) (B : C) (i : ℤ) :
  (map_explicit_homology f B i).comp (aux₃ P₂ B i).to_add_monoid_hom =
  add_monoid_hom.comp (aux₃ P₁ B i).to_add_monoid_hom ((preadditive_yoneda.obj _).map f.op) :=
begin
  ext ⟨x⟩,
  dsimp, simp_rw aux₃_apply,
  dsimp [map_explicit_homology, ker_hom, map_hom_complex],
  rw ← sub_eq_zero,
  erw quotient_add_group.eq_zero_iff,
  rw [add_subgroup.mem_comap],
  dsimp [hom_complex],
  -- now we need to use a homotopy...
  simp_rw [← category.assoc, ← homological_complex.comp_f],
  let t := _, let s := _,
  change ∃ _, _ = homological_complex.hom.f t i ≫ _ - homological_complex.hom.f s i ≫ _,
  let hh : homotopy t s := begin
    apply homotopy_category.homotopy_of_eq,
    simpa,
  end,
  let e := hh.hom (i+1) i,
  use e ≫ eq_to_hom (if_pos rfl),
  rw [← preadditive.sub_comp _ _ (eq_to_hom _), ← category.assoc],
  congr' 1,
  erw hh.comm i,
  simp only [homological_complex.cochain_complex_d_next,
    homological_complex.cochain_complex_prev_d, add_sub_cancel,
    self_eq_add_right],
  exact comp_zero,
end

lemma comp_add_equiv_iso_AddcommGroup_iso_eq_comp
  (X X' B : AddCommGroup.{u}) (e' : X' ≃+ B) (f : X ⟶ X') :
  f ≫ (add_equiv_iso_AddCommGroup_iso.hom e').hom =
  e'.to_add_monoid_hom.comp f := rfl

def hom_mk {A B : Type u} [add_comm_group A] [add_comm_group B] (f : A →+ B) :
  (AddCommGroup.of A) ⟶ (AddCommGroup.of B) := f

end hom_single_iso_setup

open hom_single_iso_setup

noncomputable
def hom_single_iso
  (P : bounded_homotopy_category C) (B : C) (i : ℤ) :
  AddCommGroup.of (P ⟶ (bounded_homotopy_category.single C i).obj B) ≅
  (((preadditive_yoneda.obj B).map_homological_complex _).obj P.val.as.op).homology i :=
begin
  refine _ ≪≫ aux₁ P B i,
  refine add_equiv_iso_AddCommGroup_iso.hom _ ≪≫ (aux₂ P B i).symm,
  exact aux₃ P B i,
end

.

open opposite

variables {X Y Z : cochain_complex C ℤ} (f : X ⟶ Y) (g : Y ⟶ Z)

def of' (X : cochain_complex C ℤ)
  [homotopy_category.is_bounded_above ((homotopy_category.quotient _ _).obj X)] :
  bounded_homotopy_category C :=
of $ (homotopy_category.quotient _ _).obj X

def of_hom (f : X ⟶ Y)
  [homotopy_category.is_bounded_above ((homotopy_category.quotient _ _).obj X)]
  [homotopy_category.is_bounded_above ((homotopy_category.quotient _ _).obj Y)] :
  of' X ⟶ of' Y :=
(homotopy_category.quotient _ _).map f

instance val_as_bdd_above (P : bounded_homotopy_category C) :
  ((homotopy_category.quotient C (complex_shape.up ℤ)).obj P.val.as).is_bounded_above :=
by { rcases P with ⟨P, ⟨a, ha⟩⟩, use a, intros i hi, exact ha i hi }

lemma hom_single_iso_naturality
  (P₁ P₂ : bounded_homotopy_category C) (B : C) (i : ℤ)
  (f : P₁ ⟶ P₂) :
  (preadditive_yoneda.obj _).map f.op ≫ (hom_single_iso P₁ B i).hom =
  (hom_single_iso P₂ B i).hom ≫
  (((preadditive_yoneda.obj B).right_op.map_homological_complex _ ⋙
      homological_complex.unop_functor.right_op ⋙
      (_root_.homology_functor _ _ _).op).map f.out).unop :=
begin
  dsimp only [hom_single_iso, iso.trans_hom, iso.symm_hom, functor.comp_map, functor.op_map,
    functor.right_op_map, quiver.hom.unop_op],
  simp_rw [← category.assoc, comp_add_equiv_iso_AddcommGroup_iso_eq_comp],
  rw ← aux₃_naturality,
  rw [category.assoc],

  let t := hom_mk (aux₃ P₂ B i).to_add_monoid_hom,
  change (t ≫ (map_explicit_homology f B i)) ≫ _ ≫ _ = _,
  slice_lhs 2 3
  { rw aux₂_naturality_inv },
  simp_rw category.assoc,
  rw ← aux₁_naturality,
  refl,
end

lemma hom_single_iso_naturality'
  (P₁ P₂ : bounded_homotopy_category C) (B : C) (i : ℤ)
  (f : P₁.val.as ⟶ P₂.val.as) :
  (preadditive_yoneda.obj ((single C i).obj B)).map (of_hom f).op ≫ (hom_single_iso P₁ B i).hom =
  (hom_single_iso P₂ B i).hom ≫
  (((preadditive_yoneda.obj B).right_op.map_homological_complex _ ⋙
      homological_complex.unop_functor.right_op ⋙
      (_root_.homology_functor _ _ _).op).map f).unop :=
begin
  erw hom_single_iso_naturality P₁ P₂ B i (of_hom f),
  refine congr_arg2 _ rfl _,
  apply homology_map_eq_of_homotopy,
  let h := (preadditive_yoneda.obj B).right_op.map_homotopy (homotopy_category.homotopy_out_map f),
  refine ⟨λ i j, (h.hom j i).unop, _, _⟩,
  { intros i j hij, rw [h.zero, unop_zero], exact hij },
  { intros i,
    conv_rhs { congr, rw add_comm, },
    exact congr_arg quiver.hom.unop (h.comm i), },
end

def map_hom_complex_homology
  (P : bounded_homotopy_category C) {B₁ B₂ : C} (i : ℤ) (f : B₁ ⟶ B₂) (w₁ w₂) :
  homology ((hom_complex P B₁).d (i + 1) i) ((hom_complex P B₁).d i (i - 1)) w₁ ⟶
  homology ((hom_complex P B₂).d (i + 1) i) ((hom_complex P B₂).d i (i - 1)) w₂ :=
homology.map _ _
  (arrow.hom_mk ((map_hom_complex' _ f).comm _ _))
  (arrow.hom_mk ((map_hom_complex' _ f).comm _ _)) rfl

end bounded_homotopy_category


import unitb.models.nondet
import unitb.refinement.basic

namespace superposition

open stream
open temporal
open predicate
open unitb nondet

universe variable u

section defs

parameters {α α' β : Type}
parameters abs : α' → α

structure evt_ref (lbl : Type) (mc : program α') (ea : event α) (ecs : lbl → event α') : Type :=
  (witness : lbl → α' → Prop)
  (witness_fis : ⦃ ∃∃ e, witness e ⦄)
  (sim : ∀ ec, ⟦ (ecs ec).step_of ⟧ ⟹ ⟦ ea.step_of on abs ⟧)
  (delay : ∀ ec, witness ec ⋀ (ea.coarse_sch ⋀ ea.fine_sch) ∘ abs ↦ witness ec ⋀ (ecs ec).coarse_sch in mc)
  (stable : ∀ ec, unless_except mc (witness ec ⋀ (ecs ec).coarse_sch) (-(ea.coarse_sch ∘ abs))
                                   { e | ∃ l, ecs l = e })
  (resched : ∀ ec, (ea.coarse_sch ⋀ ea.fine_sch) ∘ abs ⋀ witness ec ↦ (ecs ec).fine_sch in mc)

structure evt_ref_wk (lbl : Type) (mc : program α') (ea : event α) (ecs : lbl → event α')
: Type :=
  (witness : lbl → α' → Prop)
  (sim : ∀ ec, ⟦ (ecs ec).step_of ⟧ ⟹ ⟦ ea.step_of on abs ⟧)
  (delay : (ea.coarse_sch ⋀ ea.fine_sch) ∘ abs
            >~>
           -(ea.coarse_sch ∘ abs)
            ⋁ ∃∃ ec, witness ec ⋀ (ecs ec).coarse_sch in mc)
  (stable : ∀ ec, unless_except mc (witness ec ⋀ (ecs ec).coarse_sch) (-(ea.coarse_sch ∘ abs))
                                   { e | ∃ l, ecs l = e })
  (resched : ∀ ec, (ea.coarse_sch ⋀ ea.fine_sch) ∘ abs ⋀ witness ec ⋀ (ecs ec).coarse_sch
                    >~>
                   (ecs ec).fine_sch in mc)

lemma evt_ref_wk_of_evt_ref
  (lbl : Type) (mc : program α')
  (ea : event α)
  (ecs : lbl → event α')
  (H : evt_ref lbl mc ea ecs)
: evt_ref_wk lbl mc ea ecs :=
begin
  apply evt_ref_wk.mk H.witness,
  { apply H.sim },
  { have Hsch : ∀ ec, H.witness ec ⋀ (ea.coarse_sch ⋀ ea.fine_sch) ∘ abs
               ↦
              -(ea.coarse_sch ∘ abs)
              ⋁ H.witness ec ⋀ (ecs ec).coarse_sch in mc,
    { intro ec,
      have H' := H.delay ec, revert H',
      apply leads_to.mono_right,
      apply p_or_intro_right },
    have Hsch' := leads_to.gen_disj' Hsch,
    have H₀ : (∃∃ (ec : lbl), H.witness ec ⋀ (ea.coarse_sch ∘ abs ⋀ ea.fine_sch ∘ abs))
            = (ea.coarse_sch ⋀ ea.fine_sch) ∘ abs,
    { rw [← p_and_over_p_exists_right,ew_eq_true H.witness_fis],
      simp },
    simp [H₀] at Hsch',
    simp [p_or_over_p_exists_left _ _ H.witness_fis],
    apply often_imp_often.basis,
    apply Hsch', },
  { apply H.stable },
  { intro ce,
    have P₀ := H.resched ce,
    apply often_imp_often.basis,
    revert P₀,
    apply leads_to.antimono_left,
    apply p_and_elim_left }
end

parameters (ma : program α) (mc : program α')

structure refined : Type :=
  (sim_init : mc^.first ⟹ ma^.first∘abs)
  (ref : option mc.lbl → option ma.lbl → Prop)
  (evt_sim : ∀ ec, ⟦ mc.step_of ec ⟧
               ⟹ ∃∃ ea : { ea // ref ec ea }, ⟦ ma.step_of ea.val on abs ⟧)
  (events : ∀ ae, evt_ref_wk { ec // ref ec ae } mc (ma.event ae) (λ ec, mc.event ec.val) )

parameters {ma mc}

lemma refined.sim
  (R : refined)
: ⟦ is_step mc ⟧ ⟹ ⟦ is_step ma on abs ⟧ :=
begin
  simp [is_step_exists_event'],
  intro τ,
  simp,
  intros ce H,
  apply exists_imp_exists' subtype.val _ (R.evt_sim ce τ H),
  intro, apply id,
end

end defs

section soundness

parameters {α α' β : Type}
parameters {abs : α' → α}
parameter {ma : program α}
parameter {mc : program α'}

open temporal

parameter R : refined abs ma mc
parameter {τ : stream α'}
parameter M₁ : system_sem.ex mc τ

section schedules

parameter e : option ma.lbl
@[reducible]
def imp_lbl := { ec : option mc.lbl // R.ref ec e }

def AC := (program.event ma e).coarse_sch ∘ abs
def AF := (program.event ma e).fine_sch ∘ abs
def W (e' : imp_lbl) := (R.events e).witness e'
def CC (e' : option mc.lbl) := mc.coarse_sch_of e'
def CF (e' : option mc.lbl) := mc.fine_sch_of e'

parameter abs_coarse : (◇◻(•AC ⋀ -⟦ ma.step_of e on abs ⟧)) τ

parameter abs_fine : (◻◇•AF) τ

include M₁
include abs_coarse
include abs_fine

lemma abs_coarse_and_fine
: (◻◇(•AC ⋀ •AF)) τ :=
begin
  apply coincidence,
  { apply stable_entails_stable _ _ abs_coarse,
    apply λ _, and.left },
  { apply abs_fine },
end

include R

lemma evt_ref_wk.delay_sem
: ◻◇(∃∃ ce, •W ce ⋀ •CC ce.val) $ τ :=
begin
  have Hdelay := (R.events e).delay,
  have H := system_sem.often_imp_often_sem' _ M₁ Hdelay
                (abs_coarse_and_fine M₁ e abs_coarse abs_fine),
  clear Hdelay,
  rw [init_p_or,inf_often_p_or,← p_not_p_imp,not_henceforth,not_eventually] at H,
  rw [not_init,p_not_p_not_iff_self] at H,
  have Hc := stable_entails_stable (λ _, and.left) τ abs_coarse,
  apply H Hc,
end
-- lemma conc_coarse : ∃ e', (◇◻(• W e' ⋀ • CC e'.val) ) τ :=

lemma conc_event : ∃ e' : imp_lbl, (◇◻• CC e'.val ⋀ ◻◇•CF e'.val ) τ :=
begin
  have H : ((∃∃ e', ◇◻(• W R e e' ⋀ • CC e'.val))
                   ⋁ ◻◇((-•AC  e) ⋁ ∃∃ e' : imp_lbl R e, ⟦ mc.step_of e'.val ⟧)) τ,
  { rw exists_action,
    apply p_or_p_imp_p_or_right _ (unless_sem_exists' M₁.safety (R.events e).stable _),
    { apply inf_often_entails_inf_often,
      apply p_or_p_imp_p_or_right' _,
      apply action_entails_action,
      intros σ σ',
      simp [mem_set_of,imp_lbl],
      intros ec H x H' H₂,
      existsi x,
      cases H with H₀ H,
      cases H with H₁ STEP,
      unfold program.step_of,
      simp [H',event.step_of,STEP,H₀,H₁,H₂], },
    have H' := (R.events e).delay,
    have H'' := system_sem.often_imp_often_sem' _ M₁ H' , clear H',
    rw [init_p_or, inf_often_p_or,shunting,init_exists] at H'',
    apply evt_ref_wk.delay_sem R M₁ e abs_coarse abs_fine },
  cases H with H H,
  { apply exists_imp_exists _ H,
    intros ce Hcc,
    simp, split,
    { revert Hcc,
      apply stable_entails_stable,
      apply p_and_elim_right },
    have Hc := stable_and_of_stable_of_stable Hcc abs_coarse,
    have Ha := coincidence Hc abs_fine,
    apply system_sem.often_imp_often_sem' _ M₁ ((R.events e).resched ce),
    revert Ha,
    apply inf_often_entails_inf_often,
    intro, simp [init_p_and,W,CC,AC,AF,W,program.coarse_sch_of],
    generalize : ((•(program.event ma e).coarse_sch ∘ abs) i)  = X₀,
    generalize : ((•(program.event ma e).fine_sch ∘ abs) i)    = X₁,
    generalize : ((•(program.event mc (ce.val)).coarse_sch) i) = X₂,
    generalize : ((•(R.events e).witness ce) i) = X₃,
    begin [smt] by_cases X₀ end, },
  { exfalso,
    revert abs_coarse,
    change ¬ _,
    rw [p_not_eq_not,not_eventually,not_henceforth,p_not_p_and,p_not_p_not_iff_self],
    revert H,
    apply inf_often_entails_inf_often,
    apply p_or_p_imp_p_or_right',
    rw p_exists_entails_eq_p_forall_entails,
    intros ec,
    apply (R.events e).sim _ , },
end

end schedules

include M₁
include R

theorem soundness : system_sem.ex ma (map abs τ) :=
begin
  apply nondet.program.ex.mk,
  { apply R.sim_init,
    apply M₁.init },
  { intro i,
    rw [drop_map],
    rw [comp_map_app_eq_map ⟦ step ma ⟧, ← action_trading ],
    apply R.sim abs,
    apply M₁.safety },
  { intros e COARSE₀ FINE₀,
    apply assume_neg _, intro ACT,
    have COARSE₁ :  (◇◻(•AC e ⋀ -⟦program.step_of ma e on abs⟧)) τ,
    { rw [← inf_often_trace_action_trading] at ACT,
      rw [← stable_trace_init_trading] at COARSE₀,
      rw [p_not_eq_not,not_henceforth,not_eventually] at ACT,
      apply stable_and_of_stable_of_stable COARSE₀ ACT },
    clear COARSE₀ ACT,
    cases conc_event R M₁ _ COARSE₁ FINE₀ with e' C_EVT,
    cases C_EVT with C_COARSE C_FINE,
    rw [← inf_often_trace_trading,← action_trading],
    apply inf_often_entails_inf_often _ _ (M₁.liveness _ C_COARSE C_FINE),
    have H := (R.events e).sim e',
    apply H, },
end

end soundness

end superposition


/-
File: signature_recover_public_key_assert_le_soundness.lean

Autogenerated file.
-/
import starkware.cairo.lean.semantics.soundness.hoare
import .signature_recover_public_key_code
import ..signature_recover_public_key_spec
import .signature_recover_public_key_assert_nn_soundness
open tactic

open starkware.cairo.common.math

variables {F : Type} [field F] [decidable_eq F] [prelude_hyps F]
variable  mem : F → F
variable  σ : register_state F

/- starkware.cairo.common.math.assert_le autogenerated soundness theorem -/

theorem auto_sound_assert_le
    -- arguments
    (range_check_ptr a b : F)
    -- code is in memory at σ.pc
    (h_mem : mem_at mem code_assert_le σ.pc)
    -- all dependencies are in memory
    (h_mem_0 : mem_at mem code_assert_nn (σ.pc  - 4))
    -- input arguments on the stack
    (hin_range_check_ptr : range_check_ptr = mem (σ.fp - 5))
    (hin_a : a = mem (σ.fp - 4))
    (hin_b : b = mem (σ.fp - 3))
    -- conclusion
  : ensures_ret mem σ (λ κ τ,
      τ.ap = σ.ap + 5 ∧
      ∃ μ ≤ κ, rc_ensures mem (rc_bound F) μ (mem (σ.fp - 5)) (mem $ τ.ap - 1)
        (spec_assert_le mem κ range_check_ptr a b (mem (τ.ap - 1)))) :=
begin
  apply ensures_of_ensuresb, intro νbound,
  have h_mem_rec := h_mem,
  unpack_memory code_assert_le at h_mem with ⟨hpc0, hpc1, hpc2, hpc3, hpc4⟩,
  -- function call
  step_assert_eq hpc0 with arg0,
  step_assert_eq hpc1 with arg1,
  step_sub hpc2 (auto_sound_assert_nn mem _ range_check_ptr (b - a) _ _ _),
  { rw hpc3, norm_num2, exact h_mem_0 },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b] },
    try { arith_simps }, try { simp only [arg0, (eq_sub_of_eq_add arg1)] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  { try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b] },
    try { arith_simps }, try { simp only [arg0, (eq_sub_of_eq_add arg1)] },
    try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } }, },
  intros κ_call4 ap4 h_call4,
  rcases h_call4 with ⟨h_call4_ap_offset, h_call4⟩,
  rcases h_call4 with ⟨rc_m4, rc_mle4, hl_range_check_ptr₁, h_call4⟩,
  generalize' hr_rev_range_check_ptr₁: mem (ap4 - 1) = range_check_ptr₁,
  have htv_range_check_ptr₁ := hr_rev_range_check_ptr₁.symm, clear hr_rev_range_check_ptr₁,
  try { simp only [arg0 ,arg1] at hl_range_check_ptr₁ },
  rw [←htv_range_check_ptr₁, ←hin_range_check_ptr] at hl_range_check_ptr₁,
  try { simp only [arg0 ,arg1] at h_call4 },
  rw [hin_range_check_ptr] at h_call4,
  clear arg0 arg1,
  -- return
  step_ret hpc4,
  -- finish
  step_done, use_only [rfl, rfl],
  split,
  { try { simp only [h_call4_ap_offset] },
    try { arith_simps }, try { refl } },
  -- range check condition
  use_only (rc_m4+0+0), split,
  linarith [rc_mle4],
  split,
  { arith_simps,
    rw [←htv_range_check_ptr₁, hl_range_check_ptr₁, hin_range_check_ptr],
    try { arith_simps, refl <|> norm_cast }, try { refl } },
  intro rc_h_range_check_ptr, repeat { rw [add_assoc] at rc_h_range_check_ptr },
  have rc_h_range_check_ptr' := range_checked_add_right rc_h_range_check_ptr,
  -- Final Proof
  -- user-provided reduction
  suffices auto_spec: auto_spec_assert_le mem _ range_check_ptr a b _,
  { apply sound_assert_le, apply auto_spec },
  -- prove the auto generated assertion
  dsimp [auto_spec_assert_le],
  try { norm_num1 }, try { arith_simps },
  use_only [κ_call4],
  use_only [range_check_ptr₁],
  have rc_h_range_check_ptr₁ := range_checked_offset' rc_h_range_check_ptr,
  have rc_h_range_check_ptr₁' := range_checked_add_right rc_h_range_check_ptr₁, try { norm_cast at rc_h_range_check_ptr₁' },
  have spec4 := h_call4 rc_h_range_check_ptr',
  rw [←hin_range_check_ptr, ←htv_range_check_ptr₁] at spec4,
  try { dsimp at spec4, arith_simps at spec4 },
  use_only [spec4],
  try { split, linarith },
  try { ensures_simps; try { simp only [add_neg_eq_sub, hin_range_check_ptr, hin_a, hin_b, htv_range_check_ptr₁] }, },
  try { simp only [h_call4_ap_offset] },
  try { arith_simps; try { split }; triv <|> refl <|> simp <|> abel; try { norm_num } },
end


import DijkstraMonad.Basic
open EffectObservation
open OrderedMonad

universe u v w
#print ExceptT

instance
  {ε : Type u}
  {W:Type u → Type v}
  [Monad W] [OrderedMonad W]
  : OrderedMonad (ExceptT ε W) where

  leW := by
    simp [ExceptT]
    intro α e1 e2
    apply leW e1 e2

  trans := by
    intro α a b c h1 h2
    simp [ExceptT] at a b c
    apply trans a b c h1 h2

  refl := by
    intro α a
    simp [ExceptT] at a
    apply refl a

  bindW := by
    intro α β w w' f f' h1 h2
    simp [ExceptT] at w w' f f'
    simp at h1 h2
    apply bindW <;> try assumption
    simp [ExceptT.bindCont]
    intro x
    cases x <;> simp
    . case a.error x =>
      apply refl
    . case a.ok x =>
      apply h2

#check θ
#check bindθ

theorem fun_apply_same_args {α:Type u} {β:Type v} : (f:α→β) → (x y:α) → x = y → f x = f y := by
  intro f x y h
  induction h
  rfl

instance
  {ε:Type u}
  {M:Type u → Type v}
  {W:Type u → Type w}
  [Monad M] [Monad W]
  [OrderedMonad W]
  [EffectObservation M W]
  : EffectObservation (ExceptT ε M) (ExceptT ε W) where

  θ {α:Type u} (x:ExceptT ε M α) : ExceptT ε W α :=
    @θ M _ _ _ _ _ (Except ε α) x

  bindθ := by
    intro α β m f
    simp [ExceptT] at m f
    simp [bind, ExceptT.bind, ExceptT.bindCont, ExceptT.mk]
    simp [bindθ]
    apply fun_apply_same_args
    simp [Function.comp]
    apply funext
    intro x
    cases x
    . simp [pureθ]
    . simp

  pureθ := by
    intro α x
    simp
    apply pureθ