--import data.real.nnreal
import ring_theory.valuation.basic
import number_theory.padics.padic_numbers
import analysis.special_functions.pow
import with_top

noncomputable theory

open function multiplicative

variables {R : Type*} [ring R] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]

lemma mult_with_top_R_zero : multiplicative.of_add (order_dual.to_dual ⊤) =
  (0 : multiplicative (with_top ℝ)ᵒᵈ) := rfl

class is_rank_one (v : valuation R Γ₀) : Prop :=
(rank_le_one : ∃ f : Γ₀ →*₀ multiplicative (order_dual (with_top ℝ)), strict_mono f)
--(rank_le_one : ∃ f : Γ₀ →* nnreal, strict_mono f)
(nontrivial : ∃ r : R, v r ≠ 0 ∧ v r ≠ 1)

def is_rank_one_hom (v : valuation R Γ₀) [hv : is_rank_one v] :
  Γ₀ →*₀ multiplicative (order_dual (with_top ℝ)) :=
classical.some hv.rank_le_one

lemma is_rank_one_strict_mono (v : valuation R Γ₀) [hv : is_rank_one v] :
  strict_mono (is_rank_one_hom v) :=
classical.some_spec hv.rank_le_one

lemma is_rank_one_hom_zero (v : valuation R Γ₀) [hv : is_rank_one v] {x : Γ₀}
 (hx : is_rank_one_hom v x = multiplicative.of_add (order_dual.to_dual ⊤)) : x = 0 :=
begin
  have hx0 : 0 ≤ x := zero_le',
  cases le_iff_lt_or_eq.mp hx0 with h_lt h_eq,
  { have hs := is_rank_one_strict_mono v h_lt,
    rw [map_zero, hx, mult_with_top_R_zero] at hs,
    exact absurd hs not_lt_zero', },
  { exact h_eq.symm }
end

structure is_discrete (v : valuation R Γ₀) : Prop :=
(rank_le_one : ∃ f : Γ₀ →* with_zero (multiplicative ℤ), strict_mono f)
(nontrivial : ∃ r : R, v r ≠ 0 ∧ v r ≠ 1)

variables {G H : Type*} [group G] [group H] (f : G →* H) [decidable_eq (with_zero G)]

def with_zero.some {x : with_zero G} (hx : x ≠ 0) : G :=
classical.some (with_zero.ne_zero_iff_exists.mp hx)

def with_zero.some_spec {x : with_zero G} (hx : x ≠ 0) : ↑(with_zero.some hx) = x :=
classical.some_spec (with_zero.ne_zero_iff_exists.mp hx)

@[simp] lemma with_zero.some_coe {g : G} : with_zero.some (@with_zero.coe_ne_zero G g) = g :=
with_zero.coe_inj.mp
  (classical.some_spec (with_zero.ne_zero_iff_exists.mp (@with_zero.coe_ne_zero G g)))

def with_zero.some_mul {x y : with_zero G} (hxy : x * y ≠ 0) :
  with_zero.some hxy = with_zero.some (left_ne_zero_of_mul hxy) *
    with_zero.some (right_ne_zero_of_mul hxy) :=
by rw [← with_zero.coe_inj, with_zero.coe_mul, with_zero.some_spec, with_zero.some_spec,
  with_zero.some_spec]

def with_zero.coe_monoid_hom : with_zero G →* with_zero H :=
{ to_fun := λ x, if hx : x = 0 then 0 else f (with_zero.some hx),
  map_one' :=
  begin
    have h1 : (1 : with_zero G) ≠ 0 := one_ne_zero,
    have h := (classical.some_spec (with_zero.ne_zero_iff_exists.mp h1)),
    rw dif_neg h1,
    simp_rw ← with_zero.coe_one at h ⊢,
    rw [with_zero.coe_inj, with_zero.some_coe, f.map_one],
  end,
  map_mul' := λ x y,
  begin
    by_cases hxy : x * y = 0,
    { rw dif_pos hxy,
      cases zero_eq_mul.mp (eq.symm hxy) with hx hy,
      { rw [dif_pos hx, zero_mul] },
      { rw [dif_pos hy, mul_zero] }},
    { rw [dif_neg hxy, dif_neg (left_ne_zero_of_mul hxy),
        dif_neg (right_ne_zero_of_mul hxy), ← with_zero.coe_mul,
        with_zero.coe_inj, ← f.map_mul, with_zero.some_mul hxy] }
  end }

instance : linear_ordered_comm_monoid_with_zero nnreal := infer_instance
open_locale classical

def val_p (p : ℕ) [fact p.prime] : valuation ℚ_[p] (multiplicative (order_dual (with_top ℤ))) :=
padic.add_valuation.valuation

def int.mulcast_hom_R :
  multiplicative (order_dual (with_top ℤ)) →*₀ multiplicative (order_dual (with_top ℝ)) :=
mulcast' (int.cast_add_hom ℝ)

lemma int.cast_add_strict_mono : strict_mono (int.cast_add_hom ℝ) := λ x y hxy,
by { rw [int.coe_cast_add_hom, int.cast_lt], exact hxy }

lemma bar {p : ℕ} [hp : fact p.prime] : is_rank_one (val_p p) :=
{ rank_le_one := ⟨int.mulcast_hom_R,
    λ  x y hxy, (mulcast_lt_mulcast int.cast_add_strict_mono x y).mpr hxy⟩,
  nontrivial :=
  begin
    have h0 : (p : ℚ_[p]) ≠ 0 := nat.cast_ne_zero.mpr hp.elim.ne_zero,
    use p,
    refine ⟨(valuation.ne_zero_iff _).mpr h0, _⟩,
    rw [val_p, padic.add_valuation.valuation_apply, ne.def, of_add_eq_one,
      padic.add_valuation.apply h0, padic.valuation_p, with_top.coe_one],
    exact one_ne_zero,
  end }

lemma ne_dual_top_iff_exists {α : Type*} {x : order_dual (with_top α)} :
  order_dual.of_dual x ≠ ⊤ ↔ ∃ (a : α), ↑a = order_dual.of_dual x :=
option.ne_none_iff_exists

def mult_with_top_R_to_nnreal (e : nnreal)  :
  multiplicative (order_dual (with_top ℝ)) → nnreal := λ x,
if hx : order_dual.of_dual (to_add x : order_dual (with_top ℝ)) = ⊤ then 0
  else e^(classical.some (ne_dual_top_iff_exists.mp hx))

lemma mult_with_top_apply (r : ℝ) :
 classical.some (ne_dual_top_iff_exists.mp (@with_top.coe_ne_top ℝ r)) = r :=
begin
  rw ← with_bot.coe_eq_coe,
  exact classical.some_spec (with_top.ne_top_iff_exists.mp (@with_top.coe_ne_top ℝ r)),
end

lemma with_top.of_dual_eq_top_iff {α : Type*} {x : order_dual (with_top α)} :
  order_dual.of_dual x = ⊤ ↔ x = ⊥ := iff.rfl

lemma mult_with_top_R_to_nnreal_strict_mono {e : nnreal} (he0 : 0 < e) (he1 : e < 1) :
  strict_mono (mult_with_top_R_to_nnreal e) :=
begin
  intros x y hxy,
  simp only [mult_with_top_R_to_nnreal],
  by_cases hy  : order_dual.of_dual (y.to_add) = ⊤,
    { have hxy' : x.to_add < y .to_add := hxy,
      have hy' : y.to_add = ⊥ := hy,
      simp only [hy', not_lt_bot] at hxy',
      exfalso,
      exact hxy' },
    { by_cases hx : order_dual.of_dual (x.to_add) = ⊤,
      { rw [dif_neg hy, dif_pos hx],
        exact nnreal.rpow_pos he0, },
      { have hxy' : x.to_add < y .to_add := hxy,
        rw [dif_neg hx, dif_neg hy],
        apply nnreal.rpow_lt_rpow_of_exponent_gt he0 he1,
        have hx' := classical.some_spec (with_bot.ne_bot_iff_exists.mp hx),
        rw [← with_top.coe_lt_coe,
          classical.some_spec (with_bot.ne_bot_iff_exists.mp hx),
          classical.some_spec (with_bot.ne_bot_iff_exists.mp hy)],
        exact hxy }},
end

def mult_with_top_R_to_nnreal_monoid_hom {e : nnreal} (he : 0 ≠ e) :
  multiplicative (order_dual (with_top ℝ)) →* nnreal :=
{ to_fun   := mult_with_top_R_to_nnreal e,
  map_one' := begin
    simp only [mult_with_top_R_to_nnreal, to_add_one],
    erw [dif_neg with_bot.coe_ne_bot, mult_with_top_apply (0 : ℝ)],
    exact nnreal.rpow_zero e,
  end,
  map_mul' := λ x y,
  begin
    simp only [mult_with_top_R_to_nnreal],
    by_cases  hx : order_dual.of_dual (x.to_add) = ⊤,
    { have hxy : order_dual.of_dual ((x * y).to_add) = ⊤,
      { rw [with_top.of_dual_eq_top_iff, to_add_mul, with_top.of_dual_eq_top_iff.mp hx,
          with_bot.bot_add] },
      rw [dif_pos hx, dif_pos hxy, zero_mul] },
    { by_cases hy : order_dual.of_dual (y.to_add) = ⊤,
      { have hxy : order_dual.of_dual ((x * y).to_add) = ⊤,
      { rw [with_top.of_dual_eq_top_iff, to_add_mul, with_top.of_dual_eq_top_iff.mp hy,
          with_bot.add_bot] },
        rw [dif_pos hy, dif_pos hxy, mul_zero] },
      { have hxy : order_dual.of_dual ((x * y).to_add) ≠ ⊤,
        { rw [ne.def, with_top.of_dual_eq_top_iff, to_add_mul, with_bot.add_eq_bot],
          exact not_or hx hy, },
        rw [dif_neg hx, dif_neg hy, dif_neg hxy, ← nnreal.rpow_add (ne.symm he)],
        apply congr_arg,
        rw [← with_bot.coe_eq_coe, with_bot.coe_add],
        rw [classical.some_spec (with_bot.ne_bot_iff_exists.mp hx),
          classical.some_spec (with_bot.ne_bot_iff_exists.mp hy),
          classical.some_spec (with_bot.ne_bot_iff_exists.mp hxy), to_add_mul],
        refl,
        }},
  end, }

def mult_with_top_R_to_R (e : ℝ) :
  multiplicative (order_dual (with_top ℝ)) → ℝ := λ x,
if hx : order_dual.of_dual (to_add x : order_dual (with_top ℝ)) = ⊤ then 0
  else e^(classical.some (ne_dual_top_iff_exists.mp hx))

--#print mult_with_top_R_to_R
lemma mult_with_top_apply' (r : ℝ) :
 classical.some (ne_dual_top_iff_exists.mp (@with_top.coe_ne_top ℝ r)) = r :=
begin
  rw ← with_bot.coe_eq_coe,
  let s := (order_dual.of_dual (some r) : with_top ℝ),
  exact classical.some_spec (with_top.ne_top_iff_exists.mp (@with_top.coe_ne_top ℝ r)),
end

lemma mult_with_top_R_to_R_strict_mono {e : ℝ} (he0 : 0 < e) (he1 : e < 1) :
  strict_mono (mult_with_top_R_to_R e) :=
begin
  intros x y hxy,
  simp only [mult_with_top_R_to_R],
  by_cases hy  : order_dual.of_dual (y.to_add) = ⊤,
    { have hxy' : x.to_add < y .to_add := hxy,
      have hy' : y.to_add = ⊥ := hy,
      simp only [hy', not_lt_bot] at hxy',
      exfalso,
      exact hxy' },
    { by_cases hx : order_dual.of_dual (x.to_add) = ⊤,
      { rw [dif_neg hy, dif_pos hx],
        exact real.rpow_pos_of_pos he0 _, },
      { have hxy' : x.to_add < y .to_add := hxy,
        rw [dif_neg hx, dif_neg hy],
        apply real.rpow_lt_rpow_of_exponent_gt he0 he1,
        have hx' := classical.some_spec (with_bot.ne_bot_iff_exists.mp hx),
        rw [← with_top.coe_lt_coe,
          classical.some_spec (with_bot.ne_bot_iff_exists.mp hx),
          classical.some_spec (with_bot.ne_bot_iff_exists.mp hy)],
        exact hxy, }},
end

def mult_with_top_R_to_R_monoid_with_zero_hom {e : ℝ} (he : 0 < e) :
  multiplicative (order_dual (with_top ℝ)) →*₀ ℝ :=
{ to_fun    := mult_with_top_R_to_R e,
  map_one'  := begin
    simp only [mult_with_top_R_to_R, to_add_one],
    erw [dif_neg with_bot.coe_ne_bot, mult_with_top_apply (0 : ℝ)],
    exact real.rpow_zero e,
  end,
  map_zero' := begin
    rw [mult_with_top_R_to_R, ← mult_with_top_R_zero],
    simp only [order_dual.to_dual_top, to_add_of_add, order_dual.of_dual_bot, dif_pos],
  end,
  map_mul'  := λ x y,
  begin
    simp only [mult_with_top_R_to_R],
    by_cases  hx : order_dual.of_dual (x.to_add) = ⊤,
    { have hxy : order_dual.of_dual ((x * y).to_add) = ⊤,
      { rw [with_top.of_dual_eq_top_iff, to_add_mul, with_top.of_dual_eq_top_iff.mp hx,
          with_bot.bot_add] },
      rw [dif_pos hx, dif_pos hxy, zero_mul] },
    { by_cases hy : order_dual.of_dual (y.to_add) = ⊤,
      { have hxy : order_dual.of_dual ((x * y).to_add) = ⊤,
      { rw [with_top.of_dual_eq_top_iff, to_add_mul, with_top.of_dual_eq_top_iff.mp hy,
          with_bot.add_bot] },
        rw [dif_pos hy, dif_pos hxy, mul_zero] },
      { have hxy : order_dual.of_dual ((x * y).to_add) ≠ ⊤,
        { rw [ne.def, with_top.of_dual_eq_top_iff, to_add_mul, with_bot.add_eq_bot],
          exact not_or hx hy, },
        rw [dif_neg hx, dif_neg hy, dif_neg hxy, ← real.rpow_add he],
        apply congr_arg,
        rw [← with_bot.coe_eq_coe, with_bot.coe_add],
        rw [classical.some_spec (with_bot.ne_bot_iff_exists.mp hx),
          classical.some_spec (with_bot.ne_bot_iff_exists.mp hy),
          classical.some_spec (with_bot.ne_bot_iff_exists.mp hxy), to_add_mul],
        refl, }},
  end, }


example (P Q R S T U: Type)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U :=
begin
have q : Q := h(p),
have t : T := j(q),
have u : U := l(t),
exact u,
end


/-
Copyright (c) 2022 Yuma Mizuno. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yuma Mizuno
-/
import category_theory.eq_to_hom
import category_theory.bicategory.basic

/-!
# Strict bicategories

A bicategory is called `strict` if the left unitors, the right unitors, and the associators are
isomorphisms given by equalities.

## Implementation notes

In the literature of category theory, a strict bicategory (usually called a strict 2-category) is
often defined as a bicategory whose left unitors, right unitors, and associators are identities.
We cannot use this definition directly here since the types of 2-morphisms depend on 1-morphisms.
For this reason, we use `eq_to_iso`, which gives isomorphisms from equalities, instead of
identities.
-/

namespace category_theory

open_locale bicategory

universes w v u

variables (B : Type u) [bicategory.{w v} B]

/--
A bicategory is called `strict` if the left unitors, the right unitors, and the associators are
isomorphisms given by equalities.
-/
class bicategory.strict : Prop :=
(id_comp' : ∀ {a b : B} (f : a ⟶ b), 𝟙 a ≫ f = f . obviously)
(comp_id' : ∀ {a b : B} (f : a ⟶ b), f ≫ 𝟙 b = f . obviously)
(assoc' : ∀ {a b c d : B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d),
  (f ≫ g) ≫ h = f ≫ (g ≫ h) . obviously)
(left_unitor_eq_to_iso' : ∀ {a b : B} (f : a ⟶ b),
  λ_ f = eq_to_iso (id_comp' f) . obviously)
(right_unitor_eq_to_iso' : ∀ {a b : B} (f : a ⟶ b),
  ρ_ f = eq_to_iso (comp_id' f) . obviously)
(associator_eq_to_iso' : ∀ {a b c d : B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d),
  α_ f g h = eq_to_iso (assoc' f g h) . obviously)

restate_axiom bicategory.strict.id_comp'
restate_axiom bicategory.strict.comp_id'
restate_axiom bicategory.strict.assoc'
restate_axiom bicategory.strict.left_unitor_eq_to_iso'
restate_axiom bicategory.strict.right_unitor_eq_to_iso'
restate_axiom bicategory.strict.associator_eq_to_iso'
attribute [simp]
  bicategory.strict.id_comp bicategory.strict.left_unitor_eq_to_iso
  bicategory.strict.comp_id bicategory.strict.right_unitor_eq_to_iso
  bicategory.strict.assoc bicategory.strict.associator_eq_to_iso

/-- Category structure on a strict bicategory -/
@[priority 100] -- see Note [lower instance priority]
instance strict_bicategory.category [bicategory.strict B] : category B :=
{ id_comp' := λ a b, bicategory.strict.id_comp,
  comp_id' := λ a b, bicategory.strict.comp_id,
  assoc' := λ a b c d, bicategory.strict.assoc }

namespace bicategory

variables {B}

@[simp]
lemma whisker_left_eq_to_hom {a b c : B} (f : a ⟶ b) {g h : b ⟶ c} (η : g = h) :
  f ◁ eq_to_hom η = eq_to_hom (congr_arg2 (≫) rfl η) :=
by { cases η, simp only [whisker_left_id, eq_to_hom_refl] }

@[simp]
lemma eq_to_hom_whisker_right {a b c : B} {f g : a ⟶ b} (η : f = g) (h : b ⟶ c) :
  eq_to_hom η ▷ h = eq_to_hom (congr_arg2 (≫) η rfl) :=
by { cases η, simp only [whisker_right_id, eq_to_hom_refl] }

end bicategory

end category_theory


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

/-! # Semiquotients

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

A data type for semiquotients, which are classically equivalent to
nonempty sets, but are useful for programming; the idea is that
a semiquotient set `S` represents some (particular but unknown)
element of `S`. This can be used to model nondeterministic functions,
which return something in a range of values (represented by the
predicate `S`) but are not completely determined.
-/

/-- A member of `semiquot α` is classically a nonempty `set α`,
  and in the VM is represented by an element of `α`; the relation
  between these is that the VM element is required to be a member
  of the set `s`. The specific element of `s` that the VM computes
  is hidden by a quotient construction, allowing for the representation
  of nondeterministic functions. -/
structure {u} semiquot (α : Type*) := mk' ::
(s : set α)
(val : trunc ↥s)

namespace semiquot
variables {α : Type*} {β : Type*}

instance : has_mem α (semiquot α) := ⟨λ a q, a ∈ q.s⟩

/-- Construct a `semiquot α` from `h : a ∈ s` where `s : set α`. -/
def mk {a : α} {s : set α} (h : a ∈ s) : semiquot α :=
⟨s, trunc.mk ⟨a, h⟩⟩

theorem ext_s {q₁ q₂ : semiquot α} : q₁ = q₂ ↔ q₁.s = q₂.s :=
begin
  refine ⟨congr_arg _, λ h, _⟩,
  cases q₁,
  cases q₂,
  cc,
end

theorem ext {q₁ q₂ : semiquot α} : q₁ = q₂ ↔ ∀ a, a ∈ q₁ ↔ a ∈ q₂ :=
ext_s.trans set.ext_iff

theorem exists_mem (q : semiquot α) : ∃ a, a ∈ q :=
let ⟨⟨a, h⟩, h₂⟩ := q.2.exists_rep in ⟨a, h⟩

theorem eq_mk_of_mem {q : semiquot α} {a : α} (h : a ∈ q) :
  q = @mk _ a q.1 h := ext_s.2 rfl

theorem nonempty (q : semiquot α) : q.s.nonempty := q.exists_mem

/-- `pure a` is `a` reinterpreted as an unspecified element of `{a}`. -/
protected def pure (a : α) : semiquot α := mk (set.mem_singleton a)

@[simp] theorem mem_pure' {a b : α} : a ∈ semiquot.pure b ↔ a = b :=
set.mem_singleton_iff

/-- Replace `s` in a `semiquot` with a superset. -/
def blur' (q : semiquot α) {s : set α} (h : q.s ⊆ s) : semiquot α :=
⟨s, trunc.lift (λ a : q.s, trunc.mk ⟨a.1, h a.2⟩)
  (λ _ _, trunc.eq _ _) q.2⟩

/-- Replace `s` in a `q : semiquot α` with a union `s ∪ q.s` -/
def blur (s : set α) (q : semiquot α) : semiquot α :=
blur' q (set.subset_union_right s q.s)

theorem blur_eq_blur' (q : semiquot α) (s : set α) (h : q.s ⊆ s) :
  blur s q = blur' q h :=
by unfold blur; congr; exact set.union_eq_self_of_subset_right h

@[simp] theorem mem_blur' (q : semiquot α) {s : set α} (h : q.s ⊆ s)
  {a : α} : a ∈ blur' q h ↔ a ∈ s := iff.rfl

/-- Convert a `trunc α` to a `semiquot α`. -/
def of_trunc (q : trunc α) : semiquot α :=
⟨set.univ, q.map (λ a, ⟨a, trivial⟩)⟩

/-- Convert a `semiquot α` to a `trunc α`. -/
def to_trunc (q : semiquot α) : trunc α :=
q.2.map subtype.val

/-- If `f` is a constant on `q.s`, then `q.lift_on f` is the value of `f`
at any point of `q`. -/
def lift_on (q : semiquot α) (f : α → β) (h : ∀ a b ∈ q, f a = f b) : β :=
trunc.lift_on q.2 (λ x, f x.1) (λ x y, h _ x.2 _ y.2)

theorem lift_on_of_mem (q : semiquot α)
  (f : α → β) (h : ∀ a b ∈ q, f a = f b)
  (a : α) (aq : a ∈ q) : lift_on q f h = f a :=
by revert h; rw eq_mk_of_mem aq; intro; refl

/-- Apply a function to the unknown value stored in a `semiquot α`. -/
def map (f : α → β) (q : semiquot α) : semiquot β :=
⟨f '' q.1, q.2.map (λ x, ⟨f x.1, set.mem_image_of_mem _ x.2⟩)⟩

@[simp] theorem mem_map (f : α → β) (q : semiquot α) (b : β) :
  b ∈ map f q ↔ ∃ a, a ∈ q ∧ f a = b := set.mem_image _ _ _

/-- Apply a function returning a `semiquot` to a `semiquot`. -/
def bind (q : semiquot α) (f : α → semiquot β) : semiquot β :=
⟨⋃ a ∈ q.1, (f a).1,
 q.2.bind (λ a, (f a.1).2.map (λ b, ⟨b.1, set.mem_bUnion a.2 b.2⟩))⟩

@[simp] theorem mem_bind (q : semiquot α) (f : α → semiquot β) (b : β) :
  b ∈ bind q f ↔ ∃ a ∈ q, b ∈ f a := set.mem_Union₂

instance : monad semiquot :=
{ pure := @semiquot.pure,
  map := @semiquot.map,
  bind := @semiquot.bind }

@[simp] lemma map_def {β} : ((<$>) : (α → β) → semiquot α → semiquot β) = map := rfl
@[simp] lemma bind_def {β} : ((>>=) : semiquot α → (α → semiquot β) → semiquot β) = bind := rfl

@[simp]

theorem mem_pure_self (a : α) : a ∈ (pure a : semiquot α) :=
set.mem_singleton a

@[simp] theorem pure_inj {a b : α} : (pure a : semiquot α) = pure b ↔ a = b :=
ext_s.trans set.singleton_eq_singleton_iff

instance : is_lawful_monad semiquot :=
{ pure_bind  := λ α β x f, ext.2 $ by simp,
  bind_assoc := λ α β γ s f g, ext.2 $ by simp; exact
    λ c, ⟨λ ⟨b, ⟨a, as, bf⟩, cg⟩, ⟨a, as, b, bf, cg⟩,
          λ ⟨a, as, b, bf, cg⟩, ⟨b, ⟨a, as, bf⟩, cg⟩⟩,
  id_map     := λ α q, ext.2 $ by simp,
  bind_pure_comp_eq_map := λ α β f s, ext.2 $ by simp [eq_comm] }

instance : has_le (semiquot α) := ⟨λ s t, s.s ⊆ t.s⟩

instance : partial_order (semiquot α) :=
{ le := λ s t, ∀ ⦃x⦄, x ∈ s → x ∈ t,
  le_refl := λ s, set.subset.refl _,
  le_trans := λ s t u, set.subset.trans,
  le_antisymm := λ s t h₁ h₂, ext_s.2 (set.subset.antisymm h₁ h₂) }

instance : semilattice_sup (semiquot α) :=
{ sup := λ s, blur s.s,
  le_sup_left := λ s t, set.subset_union_left _ _,
  le_sup_right := λ s t, set.subset_union_right _ _,
  sup_le := λ s t u, set.union_subset,
  ..semiquot.partial_order }

@[simp] theorem pure_le {a : α} {s : semiquot α} : pure a ≤ s ↔ a ∈ s :=
set.singleton_subset_iff

/-- Assert that a `semiquot` contains only one possible value. -/
def is_pure (q : semiquot α) : Prop := ∀ a b ∈ q, a = b

/-- Extract the value from a `is_pure` semiquotient. -/
def get (q : semiquot α) (h : q.is_pure) : α := lift_on q id h

theorem get_mem {q : semiquot α} (p) : get q p ∈ q :=
let ⟨a, h⟩ := exists_mem q in
by unfold get; rw lift_on_of_mem q _ _ a h; exact h

theorem eq_pure {q : semiquot α} (p) : q = pure (get q p) :=
ext.2 $ λ a, by simp; exact
⟨λ h, p _ h _ (get_mem _), λ e, e.symm ▸ get_mem _⟩

@[simp] theorem pure_is_pure (a : α) : is_pure (pure a)
| b ab c ac := by { rw [mem_pure] at ab ac, cc }

theorem is_pure_iff {s : semiquot α} : is_pure s ↔ ∃ a, s = pure a :=
⟨λ h, ⟨_, eq_pure h⟩, λ ⟨a, e⟩, e.symm ▸ pure_is_pure _⟩

theorem is_pure.mono {s t : semiquot α}
  (st : s ≤ t) (h : is_pure t) : is_pure s
| a as b bs := h _ (st as) _ (st bs)

theorem is_pure.min {s t : semiquot α} (h : is_pure t) : s ≤ t ↔ s = t :=
⟨λ st, le_antisymm st $ by rw [eq_pure h, eq_pure (h.mono st)]; simp;
   exact h _ (get_mem _) _ (st $ get_mem _),
 le_of_eq⟩

theorem is_pure_of_subsingleton [subsingleton α] (q : semiquot α) : is_pure q
| a b aq bq := subsingleton.elim _ _

/-- `univ : semiquot α` represents an unspecified element of `univ : set α`. -/
def univ [inhabited α] : semiquot α :=
mk $ set.mem_univ default

instance [inhabited α] : inhabited (semiquot α) := ⟨univ⟩

@[simp] theorem mem_univ [inhabited α] : ∀ a, a ∈ @univ α _ :=
@set.mem_univ α

@[congr] theorem univ_unique (I J : inhabited α) : @univ _ I = @univ _ J :=
ext.2 $ by simp

@[simp] theorem is_pure_univ [inhabited α] : @is_pure α univ ↔ subsingleton α :=
⟨λ h, ⟨λ a b, h a trivial b trivial⟩, λ ⟨h⟩ a _ b _, h a b⟩

instance [inhabited α] : order_top (semiquot α) :=
{ top := univ,
  le_top := λ s, set.subset_univ _ }

end semiquot


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume (i j : ℤ) (hneq : i ≠ j),
    -- If this were not true, then
    assume hfalse : int.fract (α * ↑i) = int.fract (α * ↑j),
    -- $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
    have h2 : (α * ↑i) - (int.floor (α * ↑i)) = int.fract (α * ↑i), from by {rw ← int.fract_eq_of_nonneg (α * ↑i), ring},
    have h3 : (α * ↑j) - (int.floor (α * ↑j)) = int.fract (α * ↑j), from by {rw ← int.fract_eq_of_nonneg (α * ↑j), ring},
    have h4 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑j) - (int.floor (α * ↑j)), from by {rw [h2,h3,hfalse]},
    -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
    have h5 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by {rw [h4,int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.fract_eq_of_nonneg (α * ↑i),int.fract_eq_of_nonneg (α * ↑j),int.
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j : ℤ,
    assume hneq : i ≠ j,
    assume hfracteq : int.fract (α * ↑i) = int.fract (α * ↑j),
    -- then
    -- $$
    -- i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
    -- $$
    have h2 : (α * ↑i) - (int.floor (α * ↑i)) = int.fract (α * ↑i), from by {rw ← hfracteq, rw int.fract_eq_of_nonneg (le_of_lt (int.floor_lt_iff.mpr (int.lt_of_mul_lt_mul_left (int.coe_nat_lt.mpr (nat.succ_pos _)) (int.coe_nat_pos.mpr (nat.succ_pos _)))))},
    have h3 : (α * ↑j) - (int.floor (α * ↑j)) = int.fract (α * ↑j), from by {rw ← hfracteq, rw int.fract_eq_of_nonneg (le_of_lt (int.floor_lt_iff.mpr (int.lt_of_mul_lt_mul_left (int.coe_nat_lt.mpr (nat.succ_pos _)) (int.coe_nat_pos.mpr (nat.succ_pos _)))))},
    -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
    have h4 : α = ((int.floor (α * ↑i)) - (int.floor (α * ↑j))) / (i - j), from by {rw [h2,h3,int.sub_sub_cancel], ring},
    have h5 : α ∈ ℚ, from by {apply quotient.exact, rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat, ← int.cast_coe_nat], rw [← int.cast_coe_nat, ←
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
    assume (i j : ℤ) (hij : i ≠ j),
    have h2 : α ≠ (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from
      assume h3 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j),
      have h4 : (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j) ∈ ℚ, from by {
        apply quotient.exact,
        rw [h3, ← int.coe_nat_eq_coe_nat_iff],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_sub, int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_sub, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,
        rw [int.coe_nat_mul, int.coe_nat_mul],
        apply int.coe_nat_dvd,

end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2021 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou, Adam Topaz, Johan Commelin
-/

import algebra.homology.additive
import algebraic_topology.Moore_complex
import algebra.big_operators.fin

/-!

# The alternating face map complex of a simplicial object in a preadditive category

We construct the alternating face map complex, as a
functor `alternating_face_map_complex : simplicial_object C ⥤ chain_complex C ℕ`
for any preadditive category `C`. For any simplicial object `X` in `C`,
this is the homological complex `... → X_2 → X_1 → X_0`
where the differentials are alternating sums of faces.

We also construct the natural transformation
`inclusion_of_Moore_complex : normalized_Moore_complex A ⟶ alternating_face_map_complex A`
when `A` is an abelian category.

## References
* https://stacks.math.columbia.edu/tag/0194
* https://ncatlab.org/nlab/show/Moore+complex

-/

open category_theory category_theory.limits category_theory.subobject
open category_theory.preadditive category_theory.category
open opposite

open_locale big_operators
open_locale simplicial

noncomputable theory

namespace algebraic_topology

namespace alternating_face_map_complex

/-!
## Construction of the alternating face map complex
-/

variables {C : Type*} [category C] [preadditive C]
variables (X : simplicial_object C)
variables (Y : simplicial_object C)

/-- The differential on the alternating face map complex is the alternate
sum of the face maps -/
@[simp]
def obj_d (n : ℕ) : X _[n+1] ⟶ X _[n] :=
∑ (i : fin (n+2)), (-1 : ℤ)^(i : ℕ) • X.δ i

/--
## The chain complex relation `d ≫ d`
-/
lemma d_squared (n : ℕ) : obj_d X (n+1) ≫ obj_d X n = 0 :=
begin
  /- we start by expanding d ≫ d as a double sum -/
  dsimp,
  rw comp_sum,
  let d_l := λ (j : fin (n+3)), (-1 : ℤ)^(j : ℕ) • X.δ j,
  let d_r := λ (i : fin (n+2)), (-1 : ℤ)^(i : ℕ) • X.δ i,
  rw [show (λ i , (∑ j : fin (n+3), d_l j) ≫ d_r i) =
    (λ i, ∑ j : fin (n+3), (d_l j ≫ d_r i)), by { ext i, rw sum_comp, }],
  rw ← finset.sum_product',
  /- then, we decompose the index set P into a subet S and its complement Sᶜ -/
  let P := fin (n+2) × fin (n+3),
  let S := finset.univ.filter (λ (ij : P), (ij.2 : ℕ) ≤ (ij.1 : ℕ)),
  let term := λ (ij : P), d_l ij.2 ≫ d_r ij.1,
  erw [show ∑ (ij : P), term ij =
    (∑ ij in S, term ij) + (∑ ij in Sᶜ, term ij), by rw finset.sum_add_sum_compl],
  rw [← eq_neg_iff_add_eq_zero, ← finset.sum_neg_distrib],
  /- we are reduced to showing that two sums are equal, and this is obtained
  by constructing a bijection φ : S -> Sᶜ, which maps (i,j) to (j,i+1),
  and by comparing the terms -/
  let φ : Π (ij : P), ij ∈ S → P := λ ij hij,
    (fin.cast_lt ij.2
      (lt_of_le_of_lt (finset.mem_filter.mp hij).right (fin.is_lt ij.1)), ij.1.succ),
  apply finset.sum_bij φ,
  { -- φ(S) is contained in Sᶜ
    intros ij hij,
    simp only [finset.mem_univ, finset.compl_filter, finset.mem_filter, true_and,
      fin.coe_succ, fin.coe_cast_lt] at hij ⊢,
    linarith, },
  { /- identification of corresponding terms in both sums -/
    rintro ⟨i, j⟩ hij,
    simp only [term, d_l, d_r, φ, comp_zsmul, zsmul_comp, ← neg_smul, ← mul_smul,
      pow_add, neg_mul, mul_one, fin.coe_cast_lt,
      fin.coe_succ, pow_one, mul_neg, neg_neg],
    let jj : fin (n+2) := (φ (i,j) hij).1,
    have ineq : jj ≤ i, { rw ← fin.coe_fin_le, simpa using hij, },
    rw [category_theory.simplicial_object.δ_comp_δ X ineq, fin.cast_succ_cast_lt, mul_comm] },
  { -- φ : S → Sᶜ is injective
    rintro ⟨i, j⟩ ⟨i', j'⟩ hij hij' h,
    rw [prod.mk.inj_iff],
    refine ⟨by simpa using congr_arg prod.snd h, _⟩,
    have h1 := congr_arg fin.cast_succ (congr_arg prod.fst h),
    simpa [fin.cast_succ_cast_lt] using h1 },
  { -- φ : S → Sᶜ is surjective
    rintro ⟨i', j'⟩ hij',
    simp only [true_and, finset.mem_univ, finset.compl_filter, not_le,
      finset.mem_filter] at hij',
    refine ⟨(j'.pred _, fin.cast_succ i'), _, _⟩,
    { intro H,
      simpa only [H, nat.not_lt_zero, fin.coe_zero] using hij' },
    { simpa only [true_and, finset.mem_univ, fin.coe_cast_succ, fin.coe_pred,
        finset.mem_filter] using nat.le_pred_of_lt hij', },
    { simp only [prod.mk.inj_iff, fin.succ_pred, fin.cast_lt_cast_succ],
      split; refl }, },
end

/-!
## Construction of the alternating face map complex functor
-/

/-- The alternating face map complex, on objects -/
def obj : chain_complex C ℕ := chain_complex.of (λ n, X _[n]) (obj_d X) (d_squared X)

@[simp]
lemma obj_X (X : simplicial_object C) (n : ℕ) :
  (alternating_face_map_complex.obj X).X n = X _[n] := rfl

@[simp]
lemma obj_d_eq (X : simplicial_object C) (n : ℕ) :
  (alternating_face_map_complex.obj X).d (n+1) n =
  ∑ (i : fin (n+2)), (-1 : ℤ)^(i : ℕ) • X.δ i :=
by apply chain_complex.of_d

variables {X} {Y}

/-- The alternating face map complex, on morphisms -/
def map (f : X ⟶ Y) : obj X ⟶ obj Y :=
chain_complex.of_hom _ _ _ _ _ _
  (λ n, f.app (op [n]))
  (λ n,
    begin
      dsimp,
      rw [comp_sum, sum_comp],
      apply finset.sum_congr rfl (λ x h, _),
      rw [comp_zsmul, zsmul_comp],
      apply congr_arg,
      erw f.naturality,
      refl,
    end)

@[simp]
lemma map_f (f : X ⟶ Y) (n : ℕ) : (map f).f n = f.app (op [n]) := rfl

end alternating_face_map_complex

variables (C : Type*) [category C] [preadditive C]

/-- The alternating face map complex, as a functor -/
def alternating_face_map_complex : simplicial_object C ⥤ chain_complex C ℕ :=
{ obj := alternating_face_map_complex.obj,
  map := λ X Y f, alternating_face_map_complex.map f }

variable {C}

@[simp]
lemma alternating_face_map_complex_obj_X (X : simplicial_object C) (n : ℕ) :
  ((alternating_face_map_complex C).obj X).X n = X _[n] := rfl

@[simp]
lemma alternating_face_map_complex_obj_d (X : simplicial_object C) (n : ℕ) :
  ((alternating_face_map_complex C).obj X).d (n+1) n =
  alternating_face_map_complex.obj_d X n :=
by apply chain_complex.of_d

@[simp]
lemma alternating_face_map_complex_map_f {X Y : simplicial_object C} (f : X ⟶ Y) (n : ℕ) :
  ((alternating_face_map_complex C).map f).f n = f.app (op [n]) := rfl

lemma map_alternating_face_map_complex {D : Type*} [category D] [preadditive D]
  (F : C ⥤ D) [F.additive] :
  alternating_face_map_complex C ⋙ F.map_homological_complex _ =
  (simplicial_object.whiskering C D).obj F ⋙ alternating_face_map_complex D :=
begin
  apply category_theory.functor.ext,
  { intros X Y f,
    ext n,
    simp only [functor.comp_map, homological_complex.comp_f,
      alternating_face_map_complex_map_f, functor.map_homological_complex_map_f,
      homological_complex.eq_to_hom_f, eq_to_hom_refl, comp_id, id_comp,
      simplicial_object.whiskering_obj_map_app], },
  { intro X,
    apply homological_complex.ext,
    { intros i j hij,
      have h : j+1 = i := hij,
      subst h,
      dsimp only [functor.comp_obj],
      simpa only [functor.map_homological_complex_obj_d, alternating_face_map_complex_obj_d,
        eq_to_hom_refl, id_comp, comp_id, alternating_face_map_complex.obj_d,
        functor.map_sum, functor.map_zsmul], },
    { ext n,
      refl, }, },
end

/-!
## Construction of the natural inclusion of the normalized Moore complex
-/

variables {A : Type*} [category A] [abelian A]

/-- The inclusion map of the Moore complex in the alternating face map complex -/
def inclusion_of_Moore_complex_map (X : simplicial_object A) :
  (normalized_Moore_complex A).obj X ⟶ (alternating_face_map_complex A).obj X :=
chain_complex.of_hom _ _ _ _ _ _
  (λ n, (normalized_Moore_complex.obj_X X n).arrow)
  (λ n,
    begin
      /- we have to show the compatibility of the differentials on the alternating
         face map complex with those defined on the normalized Moore complex:
         we first get rid of the terms of the alternating sum that are obviously
         zero on the normalized_Moore_complex -/
      simp only [alternating_face_map_complex.obj_d],
      rw comp_sum,
      let t := λ (j : fin (n+2)), (normalized_Moore_complex.obj_X X (n+1)).arrow ≫
        ((-1 : ℤ)^(j : ℕ) • X.δ j),
      have def_t : (∀ j : fin (n+2), t j = (normalized_Moore_complex.obj_X X (n+1)).arrow ≫
        ((-1 : ℤ)^(j : ℕ) • X.δ j)) := by { intro j, refl, },
      rw [fin.sum_univ_succ t],
      have null : ∀ j : fin (n+1), t j.succ = 0,
      { intro j,
        rw [def_t, comp_zsmul, ← zsmul_zero ((-1 : ℤ)^(j.succ : ℕ))],
        apply congr_arg,
        rw normalized_Moore_complex.obj_X,
        rw ← factor_thru_arrow _ _
          (finset_inf_arrow_factors finset.univ _ j (by simp only [finset.mem_univ])),
        slice_lhs 2 3 { erw kernel_subobject_arrow_comp (X.δ j.succ), },
        simp only [comp_zero], },
      rw [fintype.sum_eq_zero _ null],
      simp only [add_zero],
      /- finally, we study the remaining term which is induced by X.δ 0 -/
      let eq := def_t 0,
      rw [show (-1 : ℤ)^((0 : fin (n+2)) : ℕ) = 1, by ring] at eq,
      rw one_smul at eq,
      rw eq,
      cases n; dsimp; simp,
    end)

@[simp]
lemma inclusion_of_Moore_complex_map_f (X : simplicial_object A) (n : ℕ) :
  (inclusion_of_Moore_complex_map X).f n = (normalized_Moore_complex.obj_X X n).arrow :=
chain_complex.of_hom_f _ _ _ _ _ _ _ _ n

variables (A)

/-- The inclusion map of the Moore complex in the alternating face map complex,
as a natural transformation -/
@[simps]
def inclusion_of_Moore_complex :
  (normalized_Moore_complex A) ⟶ (alternating_face_map_complex A) :=
{ app := inclusion_of_Moore_complex_map, }

end algebraic_topology


-- functional.lean
-- variability-aware functional programming
import .variability
--import data.fintype
--import data.finset
--import tactic.basic
--import order.boolean_algebra
--import order.bounded_lattice

namespace functional

variables {α β : Type}

section func

--instance fin_fin_power {α : Type} [t : fintype α]: fintype (finset (finset α)) :=
--{ elems := finset.powerset (finset.univ.powerset) ,
--  complete :=
--  begin
--    intros, apply finset.subset_univ, apply finset.mem_univ
--  end}

--def allProducts := allConfigs Feature L

open variability

open variability.PC

--@[simp]
def disjoint {Feature : Type} [fintype Feature] [decidable_eq Feature]
    (pc₁ pc₂: @PC Feature) : Prop := ⟦And pc₁ pc₂⟧ = ∅

lemma conj_preserves_disjoint {Feature : Type} [fintype Feature] [decidable_eq Feature] :
    ∀ (pc₁ : @PC Feature) (pc₂ : PC) (c : PC), disjoint pc₁ pc₂ → disjoint (And c pc₁) (And c pc₂) :=
    begin
        --simp,   -- ∀ (pc₁ pc₂ c : PC), semantics (And pc₁ pc₂) = ∅ →
                -- semantics (And (And c pc₁) (And c pc₂)) = ∅
        intros pc₁ pc₂ c h, -- semantics (And (And c pc₁) (And c pc₂)) = ∅
        unfold disjoint, unfold disjoint at h,
        unfold semantics, -- semantics c ∩ semantics pc₁ ∩ (semantics c ∩ semantics pc₂) = ∅
        unfold semantics at h, -- a : semantics pc₁ ∩ semantics pc₂ = ∅
        simp,
        rw finset.inter_comm _ (semantics pc₂),
        rw← finset.inter_assoc (semantics pc₁),
        rw h,
        rw finset.empty_inter, simp
    end

--@[simp]
def disjointList {Feature : Type} [t : fintype Feature] [decidable_eq Feature]
    (vs : list (@PC Feature)) : Prop :=
    ∀ (x y : PC) , x ∈ vs → y ∈ vs → x ≠ y → disjoint x y

def cover {Feature : Type} [t : fintype Feature] [d : decidable_eq Feature]
    (v : list (@PC Feature)) :=
    semantics(list.foldr Or None v)

/-
lemma disj_cover {Feature : Type} [t : fintype Feature] [d : decidable_eq Feature] :
    ∀ (l₁ l₂ : list (@PC Feature)) (x y : PC),
        x ∈ l₁ → y ∈ l₂ → cover l₁ ∩ cover l₂ = ∅ → disjoint x y :=
begin
    intros l₁ l₂ x y h₁ h₂ h₃, unfold disjoint, unfold semantics,
    induction l₁,
    simp at h₁, by_contradiction, exact h₁,
    apply l₁_ih, simp at h₁,
end -/

structure PCPartition {Feature: Type} [t : fintype Feature] [decidable_eq Feature] :=
    (pcs  : list (@PC Feature))
    (disj : disjointList pcs)
    (comp : cover pcs = allConfigs)

def getPC {Feature: Type} [t : fintype Feature] [d: decidable_eq Feature]
    (c : @Config Feature t) : (list (@PC Feature)) → @PC Feature
| [] := None
| (x :: xs) := ite (c ∈ ⟦x⟧) x (getPC xs)

def pRel {Feature: Type} [t : fintype Feature] [d: decidable_eq Feature] (p : @PCPartition Feature t d)
    (c₁ : @Config Feature t) (c₂ : @Config Feature t) : Prop :=
getPC c₁ p.pcs = getPC c₂ p.pcs

lemma pRelReflexive {Feature: Type} [t : fintype Feature] [d: decidable_eq Feature] (p : @PCPartition Feature t d) :
    ∀ (c : Config), pRel p c c :=
begin
    intros c, unfold pRel
end

lemma pRelSymmetric {Feature: Type} [t : fintype Feature] [d: decidable_eq Feature] (p : @PCPartition Feature t d) :
    symmetric (pRel p) :=
begin
    unfold symmetric, intros c₁ c₂ h, unfold pRel, unfold pRel at h, rw h
end

lemma pRelTransitive {Feature: Type} [t : fintype Feature] [d: decidable_eq Feature] (p : @PCPartition Feature t d) :
    ∀ (c₁ c₂ c₃: Config), pRel p c₁ c₂ → pRel p c₂ c₃ → pRel p c₁ c₃  :=
begin
    intros c₁ c₂ c₃ h₁ h₂, unfold pRel, unfold pRel at h₁, unfold pRel at h₂,
    rw h₁, rw← h₂
end

lemma pRelEquiv {Feature: Type} [t : fintype Feature] [d: decidable_eq Feature] (p : @PCPartition Feature t d) :
    equivalence (pRel p) :=
⟨pRelReflexive p, ⟨pRelSymmetric p, pRelTransitive p⟩⟩

structure Lifted {Feature: Type} [t : fintype Feature] [decidable_eq Feature] (α : Type) :=
    (s : list (@Var Feature t α))
    (nonEmpty : ¬s.empty)
    (disj : disjointList s)
    (comp : cover s = allConfigs)

postfix `↑`:(max+1) := Lifted

--lemma exists_config {Feature: Type} [t : fintype Feature] [d : decidable_eq Feature] (α : Type) :
--    ∀ (x : @Lifted Feature t d α) (c : @Config Feature t), ∃ (v : @Var Feature t α), v ∈ x.s → c ∈ ⟦v.pc⟧ :=
--begin
--    intros,
--end

def index' {Feature: Type} [t : fintype Feature] [decidable_eq Feature] {α : Type}
    (x : α↑) (c : Config) : list (@Var Feature t α) :=
let xs := list.filter (λ (y : @Var Feature t α), c ∈ ⟦y.pc⟧) x.s in xs

#print equivalence
lemma unique_index' {Feature: Type} [t : fintype Feature] [decidable_eq Feature] {α : Type} :
    ∀ (x : α↑) (c : @Config Feature t), list.length (index' x c) = 1 :=
begin
    --intros x c,
    unfold index', simp, intros x c,
    -- base case
    simp, apply x.nonEmpty,
end

--@[simp]
def apply_single {Feature : Type} [t: fintype Feature] [d: decidable_eq Feature] {α β : Type}
    (f : @Var Feature t (α → β)) (u : α↑) : list (@Var Feature t β) :=
    let sat := list.filter (λ(v : Var), ⟦And f.pc v.pc⟧ ≠ ∅) u.s in
    list.map (λ(v':Var), Var.mk (f.v v'.v) (And f.pc  v'.pc)) sat

lemma apply_single_disj {Feature : Type} [t: fintype Feature] [d: decidable_eq Feature] {α β : Type} :
    ∀ (f : @Var Feature t (α → β)) (u : @Lifted Feature t d α), disjointList (apply_single f u) :=
begin
    unfold apply_single, simp,
    intros f u, unfold disjointList, simp, intros x y x₁ h₁ h₂ h₃ x₂ h₄ h₅ h₆ h₇,
    rw[←h₃,←h₆], simp, apply conj_preserves_disjoint,
    apply u.disj, exact h₁, exact h₄,
    rw [←h₃, ←h₆] at h₇, simp at h₇, apply h₇
end

section
open classical

lemma apply_single_cover {Feature : Type} [t : fintype Feature] [d: decidable_eq Feature] {α β : Type} :
    ∀ (f : @Var Feature t (α → β)) (u : @Lifted Feature t d α),
    cover (apply_single f u) = ⟦f.pc⟧ ∩ cover u.s :=
begin
    intros, unfold apply_single,
    induction u.s,
    -- base case
    simp, unfold cover, simp, unfold semantics, simp,
    -- induction
    simp, unfold list.filter,
    --unfold cover, simp,
    -- we need excluded middle.. this will be a classical proof
    cases decidable.em (semantics (PC.And (f.pc) (hd.pc)) = ∅) with hEmpty hNEmpty,
    {
        rw← hEmpty, simp, rw hEmpty, simp at ih, rw ih, unfold cover, simp,
        unfold semantics, rw finset.inter_distrib_left, unfold semantics at hEmpty,
        rw hEmpty, rw finset.empty_union
    },
    {
        rw (if_pos hNEmpty), simp at ih, simp, unfold cover, simp, unfold cover at ih,
        unfold semantics, unfold semantics at ih, simp at ih, rw ih,
        rw finset.inter_distrib_left
    }

end -- section
#print

lemma apply_single_append {Feature : Type} [t : fintype Feature] [d: decidable_eq Feature] {α β : Type} :
    ∀ (f₁ f₂ : @Var Feature t (α → β)) (u : @Lifted Feature t d α),
    disjoint f₁.pc f₂.pc → disjointList (apply_single f₁ u) → disjointList (apply_single f₂ u) →
    disjointList (list.append (apply_single f₁ u) (apply_single f₂ u)) :=
begin
    intros f₁ f₂ u,
    generalize : (apply_single f₁ u) = l₁,
    intros h₁ h₂ h₃,
    induction l₁,
    -- base case
    simp, apply h₃,
    -- induction
    simp, unfold disjointList at h₂,
end

@[simp]
def apply_inner {Feature : Type} [t: fintype Feature] [d: decidable_eq Feature]
    (f : @Lifted Feature t d (α → β)) (v : @Lifted Feature t d α) : list (@Var Feature t β) :=
    list.foldr list.append [] (list.map (λ x, apply_single x v) f.s

lemma disjoint_append {Feature : Type} [t: fintype Feature] [d: decidable_eq Feature] {α β : Type} :
    ∀ (l₁ l₂ : list (@Var Feature t Feature)), cover l₁ ∩ cover l₂ = ∅ → disjointList l₁ → disjointList l₂ → disjointList (l₁ ++ l₂) :=
begin
    intros l₁ l₂ h₁ h₂ h₃,
    unfold disjointList, intros x y h₄ h₅ h₆,
    simp at h₄, simp at h₅,
    apply or.elim h₄,
    -- assume x ∈ l₁
    intro h₇, apply or.elim h₅,
    -- and assume y ∈ l₁
    intro h₈, unfold disjointList at h₂,
    apply h₂, exact h₇, exact h₈, exact h₆,
    -- now assume y ∈ l₂
    intro h₈,
    -- base case
    simp, exact h₃,
    -- induction
    simp, unfold disjointList, intros x y h₄ h₅ h₆,
    simp at h₄, apply or.elim h₄,
    -- case 1
    intro h₇,
end

lemma apply_inner_disjoint {Feature : Type} [t: fintype Feature] [d: decidable_eq Feature] {α β : Type} :
    ∀ (f : @Lifted Feature t d (α → β)) (v : @Lifted Feature t d α),
    disjointList(apply_inner f v) :=
begin
    unfold apply_inner, intros, induction f.s,
    -- base case
    unfold disjointList, simp,
    -- induction step
    unfold list.map, unfold list.foldr,
    unfold disjointList, intros,
end

lemma cover_append {Feature : Type} [t: fintype Feature] [d: decidable_eq Feature] {α : Type} :
    ∀ (l₁ l₂ : list (@Var Feature t α)),
    cover (list.append l₁ l₂) = cover l₁ ∪ cover l₂ :=
begin
    intros, induction l₁,
    -- base case
    simp, unfold cover, simp, unfold semantics, simp,
    -- induction
    unfold cover, simp, unfold semantics, unfold cover at l₁_ih, simp at l₁_ih,
    rw l₁_ih, rw← finset.union_assoc, cc
end
--#print finset.has_lift.lift
#check finset.inter_univ

lemma interAll {α : Type} {c: finset α} [d: decidable_eq α] [t: fintype α]:
    (c ∩ finset.univ) = c :=
begin
    intros, --lift finset.univ to (set α) using finset.lift,
    --finish[set.inter_eq_self_of_subset_left],
    apply finset.inter_univ
end

lemma apply_inner_complete {Feature : Type} [t: fintype Feature] [d: decidable_eq Feature] {α β : Type} :
    ∀ (f : @Lifted Feature t d (α → β)) (v : @Lifted Feature t d α),
    cover (apply_inner f v) = cover f.s :=
begin
    intros, unfold apply_inner, induction f.s,
    -- base case
    simp, refl,
    -- induction,
    simp, rw cover_append, simp at ih, rw ih, rw apply_single_cover, rw v.comp,
    simp, unfold cover, simp, unfold semantics
end

def apply {Feature : Type} [t: fintype Feature] [d: decidable_eq Feature]
    (f : @Lifted Feature t d (α → β)) (v : @Lifted Feature t d α) : @Lifted Feature t d β :=
    ⟨apply_inner f v,
     _,
     apply_inner_complete⟩

end func

end functional


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Heather Macbeth.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.calculus.times_cont_diff
import Mathlib.topology.local_homeomorph
import Mathlib.topology.metric_space.contracting
import Mathlib.PostPort

universes u_1 u_2 u_3 u_6 u_7 u_8

namespace Mathlib

/-!
# Inverse function theorem

In this file we prove the inverse function theorem. It says that if a map `f : E → F`
has an invertible strict derivative `f'` at `a`, then it is locally invertible,
and the inverse function has derivative `f' ⁻¹`.

We define `has_strict_deriv_at.to_local_homeomorph` that repacks a function `f`
with a `hf : has_strict_fderiv_at f f' a`, `f' : E ≃L[𝕜] F`, into a `local_homeomorph`.
The `to_fun` of this `local_homeomorph` is `defeq` to `f`, so one can apply theorems
about `local_homeomorph` to `hf.to_local_homeomorph f`, and get statements about `f`.

Then we define `has_strict_fderiv_at.local_inverse` to be the `inv_fun` of this `local_homeomorph`,
and prove two versions of the inverse function theorem:

* `has_strict_fderiv_at.to_local_inverse`: if `f` has an invertible derivative `f'` at `a` in the
  strict sense (`hf`), then `hf.local_inverse f f' a` has derivative `f'.symm` at `f a` in the
  strict sense;

* `has_strict_fderiv_at.to_local_left_inverse`: if `f` has an invertible derivative `f'` at `a` in
  the strict sense and `g` is locally left inverse to `f` near `a`, then `g` has derivative
  `f'.symm` at `f a` in the strict sense.

In the one-dimensional case we reformulate these theorems in terms of `has_strict_deriv_at` and
`f'⁻¹`.

We also reformulate the theorems in terms of `times_cont_diff`, to give that `C^k` (respectively,
smooth) inputs give `C^k` (smooth) inverses.  These versions require that continuous
differentiability implies strict differentiability; this is false over a general field, true over
`ℝ` or `ℂ` and implemented here assuming `is_R_or_C 𝕂`.

Some related theorems, providing the derivative and higher regularity assuming that we already know
the inverse function, are formulated in `fderiv.lean`, `deriv.lean`, and `times_cont_diff.lean`.

## Notations

In the section about `approximates_linear_on` we introduce some `local notation` to make formulas
shorter:

* by `N` we denote `∥f'⁻¹∥`;
* by `g` we denote the auxiliary contracting map `x ↦ x + f'.symm (y - f x)` used to prove that
  `{x | f x = y}` is nonempty.

## Tags

derivative, strictly differentiable, continuously differentiable, smooth, inverse function
-/

/-!
### Non-linear maps approximating close to affine maps

In this section we study a map `f` such that `∥f x - f y - f' (x - y)∥ ≤ c * ∥x - y∥` on an open set
`s`, where `f' : E ≃L[𝕜] F` is a continuous linear equivalence and `c < ∥f'⁻¹∥`. Maps of this type
behave like `f a + f' (x - a)` near each `a ∈ s`.

If `E` is a complete space, we prove that the image `f '' s` is open, and `f` is a homeomorphism
between `s` and `f '' s`. More precisely, we define `approximates_linear_on.to_local_homeomorph` to
be a `local_homeomorph` with `to_fun = f`, `source = s`, and `target = f '' s`.

Maps of this type naturally appear in the proof of the inverse function theorem (see next section),
and `approximates_linear_on.to_local_homeomorph` will imply that the locally inverse function
exists.

We define this auxiliary notion to split the proof of the inverse function theorem into small
lemmas. This approach makes it possible

- to prove a lower estimate on the size of the domain of the inverse function;

- to reuse parts of the proofs in the case if a function is not strictly differentiable. E.g., for a
  function `f : E × F → G` with estimates on `f x y₁ - f x y₂` but not on `f x₁ y - f x₂ y`.
-/

/-- We say that `f` approximates a continuous linear map `f'` on `s` with constant `c`,
if `∥f x - f y - f' (x - y)∥ ≤ c * ∥x - y∥` whenever `x, y ∈ s`.

This predicate is defined to facilitate the splitting of the inverse function theorem into small
lemmas. Some of these lemmas can be useful, e.g., to prove that the inverse function is defined
on a specific set. -/
def approximates_linear_on {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] (f : E → F) (f' : continuous_linear_map 𝕜 E F) (s : set E) (c : nnreal) :=
  ∀ (x : E), x ∈ s → ∀ (y : E), y ∈ s → norm (f x - f y - coe_fn f' (x - y)) ≤ ↑c * norm (x - y)

namespace approximates_linear_on

/-! First we prove some properties of a function that `approximates_linear_on` a (not necessarily
invertible) continuous linear map. -/

theorem mono_num {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_map 𝕜 E F} {s : set E} {c : nnreal} {c' : nnreal} (hc : c ≤ c') (hf : approximates_linear_on f f' s c) : approximates_linear_on f f' s c' :=
  fun (x : E) (hx : x ∈ s) (y : E) (hy : y ∈ s) =>
    le_trans (hf x hx y hy) (mul_le_mul_of_nonneg_right hc (norm_nonneg (x - y)))

theorem mono_set {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_map 𝕜 E F} {s : set E} {t : set E} {c : nnreal} (hst : s ⊆ t) (hf : approximates_linear_on f f' t c) : approximates_linear_on f f' s c :=
  fun (x : E) (hx : x ∈ s) (y : E) (hy : y ∈ s) => hf x (hst hx) y (hst hy)

theorem lipschitz_sub {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_map 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f f' s c) : lipschitz_with c fun (x : ↥s) => f ↑x - coe_fn f' ↑x := sorry

protected theorem lipschitz {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_map 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f f' s c) : lipschitz_with (nnnorm f' + c) (set.restrict f s) := sorry

protected theorem continuous {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_map 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f f' s c) : continuous (set.restrict f s) :=
  lipschitz_with.continuous (approximates_linear_on.lipschitz hf)

protected theorem continuous_on {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_map 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f f' s c) : continuous_on f s :=
  iff.mpr continuous_on_iff_continuous_restrict (approximates_linear_on.continuous hf)

/-!
From now on we assume that `f` approximates an invertible continuous linear map `f : E ≃L[𝕜] F`.

We also assume that either `E = {0}`, or `c < ∥f'⁻¹∥⁻¹`. We use `N` as an abbreviation for `∥f'⁻¹∥`.
-/

protected theorem antilipschitz {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) : antilipschitz_with (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹ - c⁻¹) (set.restrict f s) := sorry

protected theorem injective {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) : function.injective (set.restrict f s) :=
  antilipschitz_with.injective (approximates_linear_on.antilipschitz hf hc)

protected theorem inj_on {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) : set.inj_on f s :=
  iff.mpr set.inj_on_iff_injective (approximates_linear_on.injective hf hc)

/-- A map approximating a linear equivalence on a set defines a local equivalence on this set.
Should not be used outside of this file, because it is superseded by `to_local_homeomorph` below.

This is a first step towards the inverse function. -/
def to_local_equiv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) : local_equiv E F :=
  set.inj_on.to_local_equiv f s (approximates_linear_on.inj_on hf hc)

/-- The inverse function is continuous on `f '' s`. Use properties of `local_homeomorph` instead. -/
theorem inverse_continuous_on {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) : continuous_on (⇑(local_equiv.symm (to_local_equiv hf hc))) (f '' s) := sorry

/-!
Now we prove that `f '' s` is an open set. This follows from the fact that the restriction of `f`
on `s` is an open map. More precisely, we show that the image of a closed ball $$\bar B(a, ε) ⊆ s$$
under `f` includes the closed ball $$\bar B\left(f(a), \frac{ε}{∥{f'}⁻¹∥⁻¹-c}\right)$$.

In order to do this, we introduce an auxiliary map $$g_y(x) = x + {f'}⁻¹ (y - f x)$$. Provided that
$$∥y - f a∥ ≤ \frac{ε}{∥{f'}⁻¹∥⁻¹-c}$$, we prove that $$g_y$$ contracts in $$\bar B(a, ε)$$ and `f`
sends the fixed point of $$g_y$$ to `y`.
-/

/-- Iterations of this map converge to `f⁻¹ y`. The formula is very similar to the one
used in Newton's method, but we use the same `f'.symm` for all `y` instead of evaluating
the derivative at each point along the orbit. -/
def inverse_approx_map {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] (f : E → F) (f' : continuous_linear_equiv 𝕜 E F) (y : F) (x : E) : E :=
  x + coe_fn (continuous_linear_equiv.symm f') (y - f x)

theorem inverse_approx_map_sub {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} (y : F) (x : E) (x' : E) : inverse_approx_map f f' y x - inverse_approx_map f f' y x' =
  x - x' - coe_fn (continuous_linear_equiv.symm f') (f x - f x') := sorry

theorem inverse_approx_map_dist_self {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} (y : F) (x : E) : dist (inverse_approx_map f f' y x) x =
  dist (coe_fn (continuous_linear_equiv.symm f') (f x)) (coe_fn (continuous_linear_equiv.symm f') y) := sorry

theorem inverse_approx_map_dist_self_le {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} (y : F) (x : E) : dist (inverse_approx_map f f' y x) x ≤ ↑(nnnorm ↑(continuous_linear_equiv.symm f')) * dist (f x) y := sorry

theorem inverse_approx_map_fixed_iff {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} (y : F) {x : E} : inverse_approx_map f f' y x = x ↔ f x = y := sorry

theorem inverse_approx_map_contracts_on {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} (y : F) (hf : approximates_linear_on f (↑f') s c) {x : E} {x' : E} (hx : x ∈ s) (hx' : x' ∈ s) : dist (inverse_approx_map f f' y x) (inverse_approx_map f f' y x') ≤
  ↑(nnnorm ↑(continuous_linear_equiv.symm f')) * ↑c * dist x x' := sorry

theorem inverse_approx_map_maps_to {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} {y : F} {ε : ℝ} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) {b : E} (hb : b ∈ s) (hε : metric.closed_ball b ε ⊆ s) (hy : y ∈ metric.closed_ball (f b) ((↑(nnnorm ↑(continuous_linear_equiv.symm f'))⁻¹ - ↑c) * ε)) : set.maps_to (inverse_approx_map f f' y) (metric.closed_ball b ε) (metric.closed_ball b ε) := sorry

theorem surj_on_closed_ball {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} {ε : ℝ} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) {b : E} (ε0 : 0 ≤ ε) (hε : metric.closed_ball b ε ⊆ s) : set.surj_on f (metric.closed_ball b ε)
  (metric.closed_ball (f b) ((↑(nnnorm ↑(continuous_linear_equiv.symm f'))⁻¹ - ↑c) * ε)) := sorry

/-- Given a function `f` that approximates a linear equivalence on an open set `s`,
returns a local homeomorph with `to_fun = f` and `source = s`. -/
def to_local_homeomorph {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] (f : E → F) {f' : continuous_linear_equiv 𝕜 E F} (s : set E) {c : nnreal} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) (hs : is_open s) : local_homeomorph E F :=
  local_homeomorph.mk (to_local_equiv hf hc) hs sorry sorry (inverse_continuous_on hf hc)

@[simp] theorem to_local_homeomorph_coe {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) (hs : is_open s) : ⇑(to_local_homeomorph f s hf hc hs) = f :=
  rfl

@[simp] theorem to_local_homeomorph_source {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) (hs : is_open s) : local_equiv.source (local_homeomorph.to_local_equiv (to_local_homeomorph f s hf hc hs)) = s :=
  rfl

@[simp] theorem to_local_homeomorph_target {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) (hs : is_open s) : local_equiv.target (local_homeomorph.to_local_equiv (to_local_homeomorph f s hf hc hs)) = f '' s :=
  rfl

theorem closed_ball_subset_target {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {s : set E} {c : nnreal} {ε : ℝ} (hf : approximates_linear_on f (↑f') s c) (hc : subsingleton E ∨ c < (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹)) (hs : is_open s) {b : E} (ε0 : 0 ≤ ε) (hε : metric.closed_ball b ε ⊆ s) : metric.closed_ball (f b) ((↑(nnnorm ↑(continuous_linear_equiv.symm f'))⁻¹ - ↑c) * ε) ⊆
  local_equiv.target (local_homeomorph.to_local_equiv (to_local_homeomorph f s hf hc hs)) :=
  set.surj_on.mono hε
    (set.subset.refl (metric.closed_ball (f b) ((↑(nnnorm ↑(continuous_linear_equiv.symm f'))⁻¹ - ↑c) * ε)))
    (surj_on_closed_ball hf hc ε0 hε)

end approximates_linear_on

/-!
### Inverse function theorem

Now we prove the inverse function theorem. Let `f : E → F` be a map defined on a complete vector
space `E`. Assume that `f` has an invertible derivative `f' : E ≃L[𝕜] F` at `a : E` in the strict
sense. Then `f` approximates `f'` in the sense of `approximates_linear_on` on an open neighborhood
of `a`, and we can apply `approximates_linear_on.to_local_homeomorph` to construct the inverse
function. -/

namespace has_strict_fderiv_at

/-- If `f` has derivative `f'` at `a` in the strict sense and `c > 0`, then `f` approximates `f'`
with constant `c` on some neighborhood of `a`. -/
theorem approximates_deriv_on_nhds {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_map 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f f' a) {c : nnreal} (hc : subsingleton E ∨ 0 < c) : ∃ (s : set E), ∃ (H : s ∈ nhds a), approximates_linear_on f f' s c := sorry

theorem approximates_deriv_on_open_nhds {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : ∃ (s : set E),
  ∃ (hs : a ∈ s ∧ is_open s), approximates_linear_on f (↑f') s (nnnorm ↑(continuous_linear_equiv.symm f')⁻¹ / bit0 1) := sorry

/-- Given a function with an invertible strict derivative at `a`, returns a `local_homeomorph`
with `to_fun = f` and `a ∈ source`. This is a part of the inverse function theorem.
The other part `has_strict_fderiv_at.to_local_inverse` states that the inverse function
of this `local_homeomorph` has derivative `f'.symm`. -/
def to_local_homeomorph {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] (f : E → F) {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : local_homeomorph E F :=
  approximates_linear_on.to_local_homeomorph f (classical.some (approximates_deriv_on_open_nhds hf)) sorry sorry sorry

@[simp] theorem to_local_homeomorph_coe {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : ⇑(to_local_homeomorph f hf) = f :=
  rfl

theorem mem_to_local_homeomorph_source {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : a ∈ local_equiv.source (local_homeomorph.to_local_equiv (to_local_homeomorph f hf)) :=
  and.left (Exists.fst (classical.some_spec (approximates_deriv_on_open_nhds hf)))

theorem image_mem_to_local_homeomorph_target {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : f a ∈ local_equiv.target (local_homeomorph.to_local_equiv (to_local_homeomorph f hf)) :=
  local_homeomorph.map_source (to_local_homeomorph f hf) (mem_to_local_homeomorph_source hf)

theorem map_nhds_eq {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : filter.map f (nhds a) = nhds (f a) :=
  local_homeomorph.map_nhds_eq (to_local_homeomorph f hf) (mem_to_local_homeomorph_source hf)

/-- Given a function `f` with an invertible derivative, returns a function that is locally inverse
to `f`. -/
def local_inverse {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] (f : E → F) (f' : continuous_linear_equiv 𝕜 E F) (a : E) (hf : has_strict_fderiv_at f (↑f') a) : F → E :=
  ⇑(local_homeomorph.symm (to_local_homeomorph f hf))

theorem local_inverse_def {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : local_inverse f f' a hf = ⇑(local_homeomorph.symm (to_local_homeomorph f hf)) :=
  rfl

theorem eventually_left_inverse {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : filter.eventually (fun (x : E) => local_inverse f f' a hf (f x) = x) (nhds a) :=
  local_homeomorph.eventually_left_inverse (to_local_homeomorph f hf) (mem_to_local_homeomorph_source hf)

@[simp] theorem local_inverse_apply_image {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : local_inverse f f' a hf (f a) = a :=
  filter.eventually.self_of_nhds (eventually_left_inverse hf)

theorem eventually_right_inverse {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : filter.eventually (fun (y : F) => f (local_inverse f f' a hf y) = y) (nhds (f a)) :=
  local_homeomorph.eventually_right_inverse' (to_local_homeomorph f hf) (mem_to_local_homeomorph_source hf)

theorem local_inverse_continuous_at {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : continuous_at (local_inverse f f' a hf) (f a) :=
  local_homeomorph.continuous_at_symm (to_local_homeomorph f hf) (image_mem_to_local_homeomorph_target hf)

theorem local_inverse_tendsto {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : filter.tendsto (local_inverse f f' a hf) (nhds (f a)) (nhds a) :=
  local_homeomorph.tendsto_symm (to_local_homeomorph f hf) (mem_to_local_homeomorph_source hf)

theorem local_inverse_unique {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) {g : F → E} (hg : filter.eventually (fun (x : E) => g (f x) = x) (nhds a)) : filter.eventually (fun (y : F) => g y = local_inverse f f' a hf y) (nhds (f a)) :=
  filter.eventually_eq_of_left_inv_of_right_inv hg (eventually_right_inverse hf)
    (local_homeomorph.tendsto_symm (to_local_homeomorph f hf) (mem_to_local_homeomorph_source hf))

/-- If `f` has an invertible derivative `f'` at `a` in the sense of strict differentiability `(hf)`,
then the inverse function `hf.local_inverse f` has derivative `f'.symm` at `f a`. -/
theorem to_local_inverse {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) : has_strict_fderiv_at (local_inverse f f' a hf) (↑(continuous_linear_equiv.symm f')) (f a) := sorry

/-- If `f : E → F` has an invertible derivative `f'` at `a` in the sense of strict differentiability
and `g (f x) = x` in a neighborhood of `a`, then `g` has derivative `f'.symm` at `f a`.

For a version assuming `f (g y) = y` and continuity of `g` at `f a` but not `[complete_space E]`
see `of_local_left_inverse`.  -/
theorem to_local_left_inverse {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [cs : complete_space E] {f : E → F} {f' : continuous_linear_equiv 𝕜 E F} {a : E} (hf : has_strict_fderiv_at f (↑f') a) {g : F → E} (hg : filter.eventually (fun (x : E) => g (f x) = x) (nhds a)) : has_strict_fderiv_at g (↑(continuous_linear_equiv.symm f')) (f a) :=
  congr_of_eventually_eq (to_local_inverse hf)
    (filter.eventually.mono (local_inverse_unique hf hg) fun (_x : F) => Eq.symm)

end has_strict_fderiv_at

/-- If a function has an invertible strict derivative at all points, then it is an open map. -/
theorem open_map_of_strict_fderiv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [complete_space E] {f : E → F} {f' : E → continuous_linear_equiv 𝕜 E F} (hf : ∀ (x : E), has_strict_fderiv_at f (↑(f' x)) x) : is_open_map f :=
  iff.mpr is_open_map_iff_nhds_le fun (x : E) => eq.ge (has_strict_fderiv_at.map_nhds_eq (hf x))

/-!
### Inverse function theorem, 1D case

In this case we prove a version of the inverse function theorem for maps `f : 𝕜 → 𝕜`.
We use `continuous_linear_equiv.units_equiv_aut` to translate `has_strict_deriv_at f f' a` and
`f' ≠ 0` into `has_strict_fderiv_at f (_ : 𝕜 ≃L[𝕜] 𝕜) a`.
-/

namespace has_strict_deriv_at

/-- A function that is inverse to `f` near `a`. -/
def local_inverse {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] [cs : complete_space 𝕜] (f : 𝕜 → 𝕜) (f' : 𝕜) (a : 𝕜) (hf : has_strict_deriv_at f f' a) (hf' : f' ≠ 0) : 𝕜 → 𝕜 :=
  has_strict_fderiv_at.local_inverse f (coe_fn (continuous_linear_equiv.units_equiv_aut 𝕜) (units.mk0 f' hf')) a
    (has_strict_fderiv_at_equiv hf hf')

theorem map_nhds_eq {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] [cs : complete_space 𝕜] {f : 𝕜 → 𝕜} {f' : 𝕜} {a : 𝕜} (hf : has_strict_deriv_at f f' a) (hf' : f' ≠ 0) : filter.map f (nhds a) = nhds (f a) :=
  has_strict_fderiv_at.map_nhds_eq (has_strict_fderiv_at_equiv hf hf')

theorem to_local_inverse {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] [cs : complete_space 𝕜] {f : 𝕜 → 𝕜} {f' : 𝕜} {a : 𝕜} (hf : has_strict_deriv_at f f' a) (hf' : f' ≠ 0) : has_strict_deriv_at (local_inverse f f' a hf hf') (f'⁻¹) (f a) :=
  has_strict_fderiv_at.to_local_inverse (has_strict_fderiv_at_equiv hf hf')

theorem to_local_left_inverse {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] [cs : complete_space 𝕜] {f : 𝕜 → 𝕜} {f' : 𝕜} {a : 𝕜} (hf : has_strict_deriv_at f f' a) (hf' : f' ≠ 0) {g : 𝕜 → 𝕜} (hg : filter.eventually (fun (x : 𝕜) => g (f x) = x) (nhds a)) : has_strict_deriv_at g (f'⁻¹) (f a) :=
  has_strict_fderiv_at.to_local_left_inverse (has_strict_fderiv_at_equiv hf hf') hg

end has_strict_deriv_at

/-- If a function has a non-zero strict derivative at all points, then it is an open map. -/
theorem open_map_of_strict_deriv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] [complete_space 𝕜] {f : 𝕜 → 𝕜} {f' : 𝕜 → 𝕜} (hf : ∀ (x : 𝕜), has_strict_deriv_at f (f' x) x) (h0 : ∀ (x : 𝕜), f' x ≠ 0) : is_open_map f :=
  iff.mpr is_open_map_iff_nhds_le fun (x : 𝕜) => eq.ge (has_strict_deriv_at.map_nhds_eq (hf x) (h0 x))

/-!
### Inverse function theorem, smooth case

-/

namespace times_cont_diff_at

/-- Given a `times_cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible
derivative at `a`, returns a `local_homeomorph` with `to_fun = f` and `a ∈ source`. -/
def to_local_homeomorph {𝕂 : Type u_6} [is_R_or_C 𝕂] {E' : Type u_7} [normed_group E'] [normed_space 𝕂 E'] {F' : Type u_8} [normed_group F'] [normed_space 𝕂 F'] [complete_space E'] (f : E' → F') {f' : continuous_linear_equiv 𝕂 E' F'} {a : E'} {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (↑f') a) (hn : 1 ≤ n) : local_homeomorph E' F' :=
  has_strict_fderiv_at.to_local_homeomorph f sorry

@[simp] theorem to_local_homeomorph_coe {𝕂 : Type u_6} [is_R_or_C 𝕂] {E' : Type u_7} [normed_group E'] [normed_space 𝕂 E'] {F' : Type u_8} [normed_group F'] [normed_space 𝕂 F'] [complete_space E'] {f : E' → F'} {f' : continuous_linear_equiv 𝕂 E' F'} {a : E'} {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (↑f') a) (hn : 1 ≤ n) : ⇑(to_local_homeomorph f hf hf' hn) = f :=
  rfl

theorem mem_to_local_homeomorph_source {𝕂 : Type u_6} [is_R_or_C 𝕂] {E' : Type u_7} [normed_group E'] [normed_space 𝕂 E'] {F' : Type u_8} [normed_group F'] [normed_space 𝕂 F'] [complete_space E'] {f : E' → F'} {f' : continuous_linear_equiv 𝕂 E' F'} {a : E'} {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (↑f') a) (hn : 1 ≤ n) : a ∈ local_equiv.source (local_homeomorph.to_local_equiv (to_local_homeomorph f hf hf' hn)) :=
  has_strict_fderiv_at.mem_to_local_homeomorph_source (has_strict_fderiv_at' hf hf' hn)

theorem image_mem_to_local_homeomorph_target {𝕂 : Type u_6} [is_R_or_C 𝕂] {E' : Type u_7} [normed_group E'] [normed_space 𝕂 E'] {F' : Type u_8} [normed_group F'] [normed_space 𝕂 F'] [complete_space E'] {f : E' → F'} {f' : continuous_linear_equiv 𝕂 E' F'} {a : E'} {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (↑f') a) (hn : 1 ≤ n) : f a ∈ local_equiv.target (local_homeomorph.to_local_equiv (to_local_homeomorph f hf hf' hn)) :=
  has_strict_fderiv_at.image_mem_to_local_homeomorph_target (has_strict_fderiv_at' hf hf' hn)

/-- Given a `times_cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible derivative
at `a`, returns a function that is locally inverse to `f`. -/
def local_inverse {𝕂 : Type u_6} [is_R_or_C 𝕂] {E' : Type u_7} [normed_group E'] [normed_space 𝕂 E'] {F' : Type u_8} [normed_group F'] [normed_space 𝕂 F'] [complete_space E'] {f : E' → F'} {f' : continuous_linear_equiv 𝕂 E' F'} {a : E'} {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (↑f') a) (hn : 1 ≤ n) : F' → E' :=
  has_strict_fderiv_at.local_inverse f f' a sorry

theorem local_inverse_apply_image {𝕂 : Type u_6} [is_R_or_C 𝕂] {E' : Type u_7} [normed_group E'] [normed_space 𝕂 E'] {F' : Type u_8} [normed_group F'] [normed_space 𝕂 F'] [complete_space E'] {f : E' → F'} {f' : continuous_linear_equiv 𝕂 E' F'} {a : E'} {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (↑f') a) (hn : 1 ≤ n) : local_inverse hf hf' hn (f a) = a :=
  has_strict_fderiv_at.local_inverse_apply_image (has_strict_fderiv_at' hf hf' hn)

/-- Given a `times_cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible derivative
at `a`, the inverse function (produced by `times_cont_diff.to_local_homeomorph`) is
also `times_cont_diff`. -/
theorem to_local_inverse {𝕂 : Type u_6} [is_R_or_C 𝕂] {E' : Type u_7} [normed_group E'] [normed_space 𝕂 E'] {F' : Type u_8} [normed_group F'] [normed_space 𝕂 F'] [complete_space E'] {f : E' → F'} {f' : continuous_linear_equiv 𝕂 E' F'} {a : E'} {n : with_top ℕ} (hf : times_cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (↑f') a) (hn : 1 ≤ n) : times_cont_diff_at 𝕂 n (local_inverse hf hf' hn) (f a) := sorry