/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import data.set.lattice
import order.zorn

/-!
# Extend a partial order to a linear order

This file constructs a linear order which is an extension of the given partial order, using Zorn's
lemma.
-/

universes u
open set classical
open_locale classical

/--
Any partial order can be extended to a linear order.
-/
theorem extend_partial_order {α : Type u} (r : α → α → Prop) [is_partial_order α r] :
  ∃ (s : α → α → Prop) [is_linear_order α s], r ≤ s :=
begin
  let S := {s | is_partial_order α s},
  have hS : ∀ c, c ⊆ S → zorn.chain (≤) c → ∀ y ∈ c, (∃ ub ∈ S, ∀ z ∈ c, z ≤ ub),
  { rintro c hc₁ hc₂ s hs,
    haveI := (hc₁ hs).1,
    refine ⟨Sup c, _, λ z hz, le_Sup hz⟩,
    refine { refl := _, trans := _, antisymm := _ }; simp_rw binary_relation_Sup_iff,
    { intro x,
      exact ⟨s, hs, refl x⟩ },
    { rintro x y z ⟨s₁, h₁s₁, h₂s₁⟩ ⟨s₂, h₁s₂, h₂s₂⟩,
      haveI : is_partial_order _ _ := hc₁ h₁s₁,
      haveI : is_partial_order _ _ := hc₁ h₁s₂,
      cases hc₂.total_of_refl h₁s₁ h₁s₂,
      { exact ⟨s₂, h₁s₂, trans (h _ _ h₂s₁) h₂s₂⟩ },
      { exact ⟨s₁, h₁s₁, trans h₂s₁ (h _ _ h₂s₂)⟩ } },
    { rintro x y ⟨s₁, h₁s₁, h₂s₁⟩ ⟨s₂, h₁s₂, h₂s₂⟩,
      haveI : is_partial_order _ _ := hc₁ h₁s₁,
      haveI : is_partial_order _ _ := hc₁ h₁s₂,
      cases hc₂.total_of_refl h₁s₁ h₁s₂,
      { exact antisymm (h _ _ h₂s₁) h₂s₂ },
      { apply antisymm h₂s₁ (h _ _ h₂s₂) } } },
  obtain ⟨s, hs₁ : is_partial_order _ _, rs, hs₂⟩ := zorn.zorn_nonempty_partial_order₀ S hS r ‹_›,
  resetI,
  refine ⟨s, { total := _ }, rs⟩,
  intros x y,
  by_contra h,
  push_neg at h,
  let s' := λ x' y', s x' y' ∨ s x' x ∧ s y y',
  rw ←hs₂ s' _ (λ _ _, or.inl) at h,
  { apply h.1 (or.inr ⟨refl _, refl _⟩) },
  { refine
      { refl := λ x, or.inl (refl _),
        trans := _,
        antisymm := _ },
    { rintro a b c (ab | ⟨ax : s a x, yb : s y b⟩) (bc | ⟨bx : s b x, yc : s y c⟩),
      { exact or.inl (trans ab bc), },
      { exact or.inr ⟨trans ab bx, yc⟩ },
      { exact or.inr ⟨ax, trans yb bc⟩ },
      { exact or.inr ⟨ax, yc⟩ } },
    { rintro a b (ab | ⟨ax : s a x, yb : s y b⟩) (ba | ⟨bx : s b x, ya : s y a⟩),
      { exact antisymm ab ba },
      { exact (h.2 (trans ya (trans ab bx))).elim },
      { exact (h.2 (trans yb (trans ba ax))).elim },
      { exact (h.2 (trans yb bx)).elim } } },
end

/-- A type alias for `α`, intended to extend a partial order on `α` to a linear order. -/
def linear_extension (α : Type u) : Type u := α

noncomputable instance {α : Type u} [partial_order α] : linear_order (linear_extension α) :=
{ le := (extend_partial_order ((≤) : α → α → Prop)).some,
  le_refl := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.1.1.1,
  le_trans := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.1.2.1,
  le_antisymm := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.2.1,
  le_total := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.2.1,
  decidable_le := classical.dec_rel _ }

/-- The embedding of `α` into `linear_extension α` as a relation homomorphism. -/
def to_linear_extension {α : Type u} [partial_order α] :
  ((≤) : α → α → Prop) →r ((≤) : linear_extension α → linear_extension α → Prop) :=
{ to_fun := λ x, x,
  map_rel' := λ a b, (extend_partial_order ((≤) : α → α → Prop)).some_spec.some_spec _ _ }

instance {α : Type u} [inhabited α] : inhabited (linear_extension α) :=
⟨(default _ : α)⟩


import data.finset.card
import data.fintype.basic
import algebra.big_operators.basic
import data.fin.basic
import combinatorics.pigeonhole
import tactic

def arithprog(a b c:ℕ):Prop:=∃ k:ℕ, (b=a+k) ∧ (c=b+k)

def vdW_prop (N : ℕ) (r : ℕ) : Prop := ∀ f : ℕ → fin r, ∃ (a b c : fin N), (arithprog a b c) ∧ (f a = f b) ∧ (f b = f c)

--def is_lt (n:ℕ )(a : fin n) : (a : ℕ) < n := a.2

--def cast_lt (n m:ℕ )(i : fin n) (h : i.1 < m) : fin m := ⟨i.1, h⟩

--def cast_le (n m:ℕ )(h : n ≤ m) : fin n ↪o fin m :=
--order_embedding.of_strict_mono (λ a, cast_lt a (lt_of_lt_of_le a.2 h)) $ λ a b h, h

lemma vdW_monotone : ∀ n r, vdW_prop n r → ∀ m, n ≤ m → vdW_prop m r :=
begin
intros,
unfold vdW_prop,
intro,
unfold vdW_prop at ᾰ,
have abc: ∃ (a b c : fin n), arithprog ↑a ↑b ↑c ∧ f ↑a = f ↑b ∧ f ↑b = f ↑c,
apply ᾰ,
rcases abc with ⟨x, y, z, xyz_h⟩,
use [⟨x, lt_of_lt_of_le x.2 ᾰ_1⟩, ⟨y, lt_of_lt_of_le y.2 ᾰ_1⟩, ⟨z, lt_of_lt_of_le z.2 ᾰ_1⟩],
apply xyz_h,
end

lemma pick_one {α : Type} {s : finset α} [decidable_eq α] : 0 < s.card → ∃ (a : α) (t : finset α), (t.card = s.card.pred) ∧ (a ∉ t) ∧ (insert a t = s) :=
begin
intro sp,
have scard: s.card = s.card.pred +1,
have bb:= nat.eq_zero_or_eq_succ_pred s.card,
cases bb,
-- bb in "or"
rw bb at sp,
cases sp,
exact bb,
rw finset.card_eq_succ at scard,
rcases scard with ⟨ a,t,x ⟩ ,
use [a,t],
--tauto,
rcases x with ⟨ x1,x2,x3⟩ ,
-- x in "and"
-- rcases split more than two assumptions
split,
exact x3,
split,
exact x1,
exact x2,
end

example : ∀ f : fin 5 → fin 2, ∃ a b c, (a ≠ b) ∧ (b ≠ c) ∧ (a ≠ c) ∧ (f a = f b) ∧ (f b = f c) :=
begin
intros,

--2*2<5
have inq : fintype.card (fin 2) • 2 < ↑(fintype.card (fin 5)),
{simp,
linarith,},

--exist y<2 st. the set of x st. f(x)=y have cardinality >2
have fh' := fintype.exists_lt_card_fiber_of_mul_lt_card f inq,
cases fh' with y fh'',

--so cardinality >0 (so that we can use pick one lemma)
have fh''_1:0<(finset.filter (λ (x : fin 5), f x = y) finset.univ).card,
{
transitivity 2,
simp,
assumption,
},

--pick one lemma, want to show {a}+t is the orginal set
rcases (pick_one fh''_1) with ⟨a,t,tcard,anotint,insert⟩,

--try to prove tcard>0 so that we can use pick one lemma again
have tcard1:1<t.card,
{rw tcard,
exact nat.lt_pred_iff.mpr fh'',},

have tcard0:0<t.card,
{
transitivity 1,
simp,
assumption
},

--try to prove {b}+t2=t
rcases (pick_one tcard0) with ⟨b,t2,t2card,bnotin2,insert2⟩,

have t2card0:0<t2.card,
{rw t2card,
exact nat.lt_pred_iff.mpr tcard1, },

--try to prove {c}+t3=t2
rcases (pick_one t2card0) with ⟨c,t3,t3card,cnotin3,insert3⟩,

--we have already pick abc, use abc and try to show they are not equal
use [a,b,c],
repeat {split},

--a!=b
{by_contra,
simp [h, ← insert2] at anotint,
assumption,},

--b!=c
{by_contra,
simp [h, ← insert3] at bnotin2,
assumption,},

--a!=c
{by_contra,
have fact1:=finset.mem_insert_self c t3,
rw insert3 at fact1,
have fact2:=finset.subset_insert b t2,
rw insert2 at fact2,
have fact3 := finset.mem_of_subset fact2 fact1,
rw ← h at fact3,--cases anotint fact3,
contradiction,},

--f(a)=f(b)
{have amember :=  finset.mem_insert_self a t,
simp [insert] at amember,
have b_in_t := finset.mem_insert_self b t2,
rw insert2 at b_in_t,
have bmember := finset.mem_of_subset (finset.subset_insert a t)(b_in_t),
simp [insert] at bmember,
rw [amember, bmember],},

--f(b)=f(c)
{have b_in_t := finset.mem_insert_self b t2,
rw insert2 at b_in_t,
have bmember := finset.mem_of_subset (finset.subset_insert a t)(b_in_t),
simp [insert] at bmember,
have c_in_t₂ := finset.mem_insert_self c t3,
rw insert3 at c_in_t₂,
have c_in_t := finset.mem_of_subset (finset.subset_insert b t2) c_in_t₂,
rw insert2 at c_in_t,
have cmember := finset.mem_of_subset (finset.subset_insert a t)(c_in_t),
simp [insert] at cmember,
rw [bmember, cmember],},

end

lemma pick_one_lo {α : Type} {s : finset α} [linear_order α] : 0 < s.card → ∃ (a : α) (t : finset α), (t.card = s.card.pred) ∧ (∀ a' ∈ t, a < a') ∧ (insert a t = s) :=
begin

intro sp,
rw finset.card_pos at sp,
let a := s.min' sp,
let t := s.erase a,
use [a,t],

have a_in_s := s.min'_mem sp,
repeat {split},

{simp [a,t],
apply finset.card_erase_of_mem,
apply a_in_s,},

{intro a1,
intro a1_in_t,
apply s.min'_lt_of_mem_erase_min' sp a1_in_t,},

apply finset.insert_erase a_in_s,

end

example : ∀ f : fin 5 → fin 2, ∃ a b c, (a < b) ∧ (b < c) ∧ (f a = f b) ∧ (f b = f c) :=

begin
intros,

--2*2<5
have inq : fintype.card (fin 2) • 2 < ↑(fintype.card (fin 5)),
{simp,
linarith,},

--exist y<2 st. the set of x st. f(x)=y have cardinality >2
have fh' := fintype.exists_lt_card_fiber_of_mul_lt_card f inq,
cases fh' with y fh'',

--so cardinality >0 (so that we can use pick one lemma)
have fh''_1:0<(finset.filter (λ (x : fin 5), f x = y) finset.univ).card,
{
transitivity 2,
simp,
assumption,
},

--pick one lemma, want to show {a}+t is the orginal set
rcases (pick_one_lo fh''_1) with ⟨a,t,tcard,anotint,insert1⟩,

--try to prove tcard>0 so that we can use pick one lemma again
have tcard1:1<t.card,
{rw tcard,
exact nat.lt_pred_iff.mpr fh'',},

have tcard0:0<t.card,
{
transitivity 1,
simp,
assumption
},

--try to prove {b}+t2=t
rcases (pick_one_lo tcard0) with ⟨b,t2,t2card,bnotin2,insert2⟩,

have t2card0:0<t2.card,
{rw t2card,
exact nat.lt_pred_iff.mpr tcard1, },

--try to prove {c}+t3=t2
rcases (pick_one_lo t2card0) with ⟨c,t3,t3card,cnotin3,insert3⟩,

-- Work around a strange unification problem between different versions of insert
rw finset.ext_iff at *,

--we have already pick abc, use abc and try to show they are not equal
use [a,b,c],
repeat {split},

--a < b
{by_contra,
simp [h, ← insert2] at anotint,
assumption,},

--b < c
{by_contra,
simp [h, ← insert3] at bnotin2,
assumption,},

--f(a)=f(b)
{
-- a ∈ t ∪ {a} => f(a) = y
rw finset.ext_iff at insert1,
have amember :=  insert1 a,
rw finset.mem_insert at amember,
simp at amember,
-- b ∈ t ∪ {a} => f(b) = y
rw finset.ext_iff at insert2,
have b_in_t := insert2 b,
rw finset.mem_insert at b_in_t,
simp at b_in_t,
have bmember := insert1 b,
simp [finset.mem_of_subset (finset.subset_insert a t)(b_in_t)] at bmember,
simp [b_in_t] at bmember,
rw [amember, bmember],},

{rw finset.ext_iff at insert1,
rw finset.ext_iff at insert2,
rw finset.ext_iff at insert3,

-- b ∈ t ∪ {a} => f(b) = y
have b_in_t := insert2 b,
rw finset.mem_insert at b_in_t,
simp at b_in_t,
have bmember := insert1 b,
simp [finset.mem_of_subset (finset.subset_insert a t)(b_in_t)] at bmember,
simp [b_in_t] at bmember,

-- c ∈ t₂
have c_in_t₂ := insert3 c,
rw finset.mem_insert at c_in_t₂,
simp at c_in_t₂,

-- c ∈ t
have c_in_t := insert2 c,
rw finset.mem_insert at c_in_t,
simp [c_in_t₂]at c_in_t,

-- c ∈ t ∪ {a} => f(c) = y
have cmember := insert1 c,
simp [finset.mem_of_subset (finset.subset_insert a t)(c_in_t)] at cmember,
simp [c_in_t] at cmember,
rw [bmember,cmember],},

end


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.asymptotics.asymptotics
import analysis.normed_space.ordered
import analysis.normed_space.bounded_linear_maps

/-!
# Asymptotic equivalence

In this file, we define the relation `is_equivalent u v l`, which means that `u-v` is little o of
`v` along the filter `l`.

Unlike `is_[oO]` relations, this one requires `u` and `v` to have the same codomaine `β`. While the
definition only requires `β` to be a `normed_group`, most interesting properties require it to be a
`normed_field`.

## Notations

We introduce the notation `u ~[l] v := is_equivalent u v l`, which you can use by opening the
`asymptotics` locale.

## Main results

If `β` is a `normed_group` :

- `_ ~[l] _` is an equivalence relation
- Equivalent statements for `u ~[l] const _ c` :
  - If `c ≠ 0`, this is true iff `tendsto u l (𝓝 c)` (see `is_equivalent_const_iff_tendsto`)
  - For `c = 0`, this is true iff `u =ᶠ[l] 0` (see `is_equivalent_zero_iff_eventually_zero`)

If `β` is a `normed_field` :

- Alternative characterization of the relation (see `is_equivalent_iff_exists_eq_mul`) :

  `u ~[l] v ↔ ∃ (φ : α → β) (hφ : tendsto φ l (𝓝 1)), u =ᶠ[l] φ * v`

- Provided some non-vanishing hypothesis, this can be seen as `u ~[l] v ↔ tendsto (u/v) l (𝓝 1)`
  (see `is_equivalent_iff_tendsto_one`)
- For any constant `c`, `u ~[l] v` implies `tendsto u l (𝓝 c) ↔ tendsto v l (𝓝 c)`
  (see `is_equivalent.tendsto_nhds_iff`)
- `*` and `/` are compatible with `_ ~[l] _` (see `is_equivalent.mul` and `is_equivalent.div`)

If `β` is a `normed_linear_ordered_field` :

- If `u ~[l] v`, we have `tendsto u l at_top ↔ tendsto v l at_top`
  (see `is_equivalent.tendsto_at_top_iff`)

-/

namespace asymptotics

open filter function
open_locale topological_space

section normed_group

variables {α β : Type*} [normed_group β]

/-- Two functions `u` and `v` are said to be asymptotically equivalent along a filter `l` when
    `u x - v x = o(v x)` as x converges along `l`. -/
def is_equivalent (u v : α → β) (l : filter α) := is_o (u - v) v l

localized "notation u ` ~[`:50 l:50 `] `:0 v:50 := asymptotics.is_equivalent u v l" in asymptotics

variables {u v w : α → β} {l : filter α}

lemma is_equivalent.is_o (h : u ~[l] v) : is_o (u - v) v l := h

lemma is_equivalent.is_O (h : u ~[l] v) : is_O u v l :=
(is_O.congr_of_sub h.is_O.symm).mp (is_O_refl _ _)

lemma is_equivalent.is_O_symm (h : u ~[l] v) : is_O v u l :=
begin
  convert h.is_o.right_is_O_add,
  ext,
  simp
end

@[refl] lemma is_equivalent.refl : u ~[l] u :=
begin
  rw [is_equivalent, sub_self],
  exact is_o_zero _ _
end

@[symm] lemma is_equivalent.symm (h : u ~[l] v) : v ~[l] u :=
(h.is_o.trans_is_O h.is_O_symm).symm

@[trans] lemma is_equivalent.trans (huv : u ~[l] v) (hvw : v ~[l] w) : u ~[l] w :=
(huv.is_o.trans_is_O hvw.is_O).triangle hvw.is_o

lemma is_equivalent.congr_left {u v w : α → β} {l : filter α} (huv : u ~[l] v)
  (huw : u =ᶠ[l] w) : w ~[l] v :=
is_o.congr' (huw.sub (eventually_eq.refl _ _)) (eventually_eq.refl _ _) huv

lemma is_equivalent.congr_right {u v w : α → β} {l : filter α} (huv : u ~[l] v)
  (hvw : v =ᶠ[l] w) : u ~[l] w :=
(huv.symm.congr_left hvw).symm

lemma is_equivalent_zero_iff_eventually_zero : u ~[l] 0 ↔ u =ᶠ[l] 0 :=
begin
  rw [is_equivalent, sub_zero],
  exact is_o_zero_right_iff
end

lemma is_equivalent_const_iff_tendsto {c : β} (h : c ≠ 0) : u ~[l] const _ c ↔ tendsto u l (𝓝 c) :=
begin
  rw [is_equivalent, is_o_const_iff h],
  split; intro h;
  [ { have := h.sub tendsto_const_nhds, rw zero_sub (-c) at this },
    { have := h.sub tendsto_const_nhds, rw ← sub_self c} ];
  convert this; try { ext }; simp
end

lemma is_equivalent.tendsto_const {c : β} (hu : u ~[l] const _ c) : tendsto u l (𝓝 c) :=
begin
  rcases (em $ c = 0) with ⟨rfl, h⟩,
  { exact (tendsto_congr' $ is_equivalent_zero_iff_eventually_zero.mp hu).mpr tendsto_const_nhds },
  { exact (is_equivalent_const_iff_tendsto h).mp hu }
end

lemma is_equivalent.tendsto_nhds_iff {c : β} (huv : u ~[l] v) :
  tendsto u l (𝓝 c) ↔ tendsto v l (𝓝 c) := ⟨huv.tendsto_nhds, huv.symm.tendsto_nhds⟩

lemma is_equivalent.add_is_o (huv : u ~[l] v) (hwv : is_o w v l) : (w + u) ~[l] v :=
begin
  rw is_equivalent at *,
  convert hwv.add huv,
  ext,
  simp [add_sub],
end

lemma is_o.is_equivalent (huv : is_o (u - v) v l) : u ~[l] v := huv

lemma is_equivalent.neg (huv : u ~[l] v) : (λ x, - u x) ~[l] (λ x, - v x) :=
begin
  rw is_equivalent,
  convert huv.is_o.neg_left.neg_right,
  ext,
  simp,
end

end normed_group

open_locale asymptotics

section normed_field

variables {α β : Type*} [normed_field β] {t u v w : α → β} {l : filter α}

lemma is_equivalent_iff_exists_eq_mul : u ~[l] v ↔
  ∃ (φ : α → β) (hφ : tendsto φ l (𝓝 1)), u =ᶠ[l] φ * v :=
begin
  rw [is_equivalent, is_o_iff_exists_eq_mul],
  split; rintros ⟨φ, hφ, h⟩; [use (φ + 1), use (φ - 1)]; split,
  { conv in (𝓝 _) { rw ← zero_add (1 : β) },
    exact hφ.add (tendsto_const_nhds) },
  { convert h.add (eventually_eq.refl l v); ext; simp [add_mul] },
  { conv in (𝓝 _) { rw ← sub_self (1 : β) },
    exact hφ.sub (tendsto_const_nhds) },
  { convert h.sub (eventually_eq.refl l v); ext; simp [sub_mul] }
end

lemma is_equivalent.exists_eq_mul (huv : u ~[l] v) :
  ∃ (φ : α → β) (hφ : tendsto φ l (𝓝 1)), u =ᶠ[l] φ * v :=
is_equivalent_iff_exists_eq_mul.mp huv

lemma is_equivalent_of_tendsto_one (hz : ∀ᶠ x in l, v x = 0 → u x = 0)
  (huv : tendsto (u/v) l (𝓝 1)) : u ~[l] v :=
begin
  rw is_equivalent_iff_exists_eq_mul,
  refine ⟨u/v, huv, hz.mono $ λ x hz', (div_mul_cancel_of_imp hz').symm⟩,
end

lemma is_equivalent_of_tendsto_one' (hz : ∀ x, v x = 0 → u x = 0) (huv : tendsto (u/v) l (𝓝 1)) :
  u ~[l] v :=
is_equivalent_of_tendsto_one (eventually_of_forall hz) huv

lemma is_equivalent_iff_tendsto_one (hz : ∀ᶠ x in l, v x ≠ 0) :
  u ~[l] v ↔ tendsto (u/v) l (𝓝 1) :=
begin
  split,
  { intro hequiv,
    have := hequiv.is_o.tendsto_0,
    simp only [pi.sub_apply, sub_div] at this,
    have key : tendsto (λ x, v x / v x) l (𝓝 1),
    { exact (tendsto_congr' $ hz.mono $ λ x hnz, @div_self _ _ (v x) hnz).mpr tendsto_const_nhds },
    convert this.add key,
    { ext, simp },
    { norm_num } },
  { exact is_equivalent_of_tendsto_one (hz.mono $ λ x hnvz hz, (hnvz hz).elim) }
end

end normed_field

section smul

lemma is_equivalent.smul {α E 𝕜 : Type*} [normed_field 𝕜] [normed_group E]
  [normed_space 𝕜 E] {a b : α → 𝕜} {u v : α → E} {l : filter α} (hab : a ~[l] b) (huv : u ~[l] v) :
  (λ x, a x • u x) ~[l] (λ x, b x • v x) :=
begin
  rcases hab.exists_eq_mul with ⟨φ, hφ, habφ⟩,
  have : (λ (x : α), a x • u x) - (λ (x : α), b x • v x) =ᶠ[l] λ x, b x • ((φ x • u x) - v x),
  { convert (habφ.comp₂ (•) $ eventually_eq.refl _ u).sub (eventually_eq.refl _ (λ x, b x • v x)),
    ext,
    rw [pi.mul_apply, mul_comm, mul_smul, ← smul_sub] },
  refine (is_o_congr this.symm $ eventually_eq.rfl).mp ((is_O_refl b l).smul_is_o _),

  rcases huv.is_O.exists_pos with ⟨C, hC, hCuv⟩,
  rw is_equivalent at *,
  rw is_o_iff at *,
  rw is_O_with at hCuv,
  simp only [metric.tendsto_nhds, dist_eq_norm] at hφ,
  intros c hc,
  specialize hφ ((c/2)/C) (div_pos (by linarith) hC),
  specialize huv (show 0 < c/2, by linarith),
  refine hφ.mp (huv.mp $ hCuv.mono $ λ x hCuvx huvx hφx, _),

  have key :=
    calc ∥φ x - 1∥ * ∥u x∥
            ≤ (c/2) / C * ∥u x∥ : mul_le_mul_of_nonneg_right hφx.le (norm_nonneg $ u x)
        ... ≤ (c/2) / C * (C*∥v x∥) : mul_le_mul_of_nonneg_left hCuvx (div_pos (by linarith) hC).le
        ... = c/2 * ∥v x∥ : by {field_simp [hC.ne.symm], ring},

  calc ∥((λ (x : α), φ x • u x) - v) x∥
          = ∥(φ x - 1) • u x + (u x - v x)∥ : by simp [sub_smul, sub_add]
      ... ≤ ∥(φ x - 1) • u x∥ + ∥u x - v x∥ : norm_add_le _ _
      ... = ∥φ x - 1∥ * ∥u x∥ + ∥u x - v x∥ : by rw norm_smul
      ... ≤ c / 2 * ∥v x∥ + ∥u x - v x∥ : add_le_add_right key _
      ... ≤ c / 2 * ∥v x∥ + c / 2 * ∥v x∥ : add_le_add_left huvx _
      ... = c * ∥v x∥ : by ring,
end

end smul

section mul_inv

variables {α β : Type*} [normed_field β] {t u v w : α → β} {l : filter α}

lemma is_equivalent.mul (htu : t ~[l] u) (hvw : v ~[l] w) : t * v ~[l] u * w :=
htu.smul hvw

lemma is_equivalent.inv (huv : u ~[l] v) : (λ x, (u x)⁻¹) ~[l] (λ x, (v x)⁻¹) :=
begin
  rw is_equivalent_iff_exists_eq_mul at *,
  rcases huv with ⟨φ, hφ, h⟩,
  rw ← inv_one,
  refine ⟨λ x, (φ x)⁻¹, tendsto.inv' hφ (by norm_num) , _⟩,
  convert h.inv,
  ext,
  simp [mul_inv']
end

lemma is_equivalent.div (htu : t ~[l] u) (hvw : v ~[l] w) :
  (λ x, t x / v x) ~[l] (λ x, u x / w x) :=
by simpa only [div_eq_mul_inv] using htu.mul hvw.inv

end mul_inv

section normed_linear_ordered_field

variables {α β : Type*} [normed_linear_ordered_field β] {u v : α → β} {l : filter α}

lemma is_equivalent.tendsto_at_top [order_topology β] (huv : u ~[l] v) (hu : tendsto u l at_top) :
  tendsto v l at_top :=
let ⟨φ, hφ, h⟩ := huv.symm.exists_eq_mul in
tendsto.congr' h.symm ((mul_comm u φ) ▸ (hu.at_top_mul zero_lt_one hφ))

lemma is_equivalent.tendsto_at_top_iff [order_topology β] (huv : u ~[l] v) :
  tendsto u l at_top ↔ tendsto v l at_top := ⟨huv.tendsto_at_top, huv.symm.tendsto_at_top⟩

lemma is_equivalent.tendsto_at_bot [order_topology β] (huv : u ~[l] v) (hu : tendsto u l at_bot) :
  tendsto v l at_bot :=
begin
  convert tendsto_neg_at_top_at_bot.comp
    (huv.neg.tendsto_at_top $ tendsto_neg_at_bot_at_top.comp hu),
  ext,
  simp
end

lemma is_equivalent.tendsto_at_bot_iff [order_topology β] (huv : u ~[l] v) :
  tendsto u l at_bot ↔ tendsto v l at_bot := ⟨huv.tendsto_at_bot, huv.symm.tendsto_at_bot⟩

end normed_linear_ordered_field

end asymptotics

open filter asymptotics
open_locale asymptotics

variables {α β : Type*} [normed_group β]

lemma filter.eventually_eq.is_equivalent {u v : α → β} {l : filter α} (h : u =ᶠ[l] v) : u ~[l] v :=
is_o.congr' h.sub_eq.symm (eventually_eq.refl _ _) (is_o_zero v l)


/-
Tests for norm_cast
-/

import Mathlib.Tactic.NormCast
import Mathlib.Tactic.Ring
import Mathlib.Data.Option.Defs
import Mathlib.Data.Rat.Cast
-- import data.complex.basic -- ℕ, ℤ, ℚ, ℝ, ℂ
-- import data.real.ennreal

-- set_option trace.Tactic.norm_cast true
-- set_option trace.Meta.Tactic.simp true

variable (an bn cn dn : ℕ) (az bz cz dz : ℤ)
variable (aq bq cq dq : ℚ)
-- variable (ar br cr dr : ℝ) (ac bc cc dc : ℂ)

example : (an : ℤ) = bn → an = bn := by intro h; exact_mod_cast h
example : an = bn → (an : ℤ) = bn := by intro h; exact_mod_cast h
example : az = bz ↔ (az : ℚ) = bz := by norm_cast

-- example : (aq : ℝ) = br ↔ (aq : ℂ) = br := by norm_cast
-- example : (an : ℚ) = bz ↔ (an : ℂ) = bz := by norm_cast
-- example : (((an : ℤ) : ℚ) : ℝ) = bq ↔ ((an : ℚ) : ℂ) = (bq : ℝ) :=
-- by norm_cast

example : (an : ℤ) < bn ↔ an < bn := by norm_cast
-- example : (an : ℚ) < bz ↔ (an : ℝ) < bz := by norm_cast
-- example : ((an : ℤ) : ℝ) < bq ↔ (an : ℚ) < bq := by norm_cast
example : (an : ℤ) ≠ (bn : ℤ) ↔ an ≠ bn := by norm_cast

-- zero and one cause special problems
-- example : 0 < (bq : ℝ) ↔ 0 < bq := by norm_cast
example : az > (1 : ℕ) ↔ az > 1 := by norm_cast
example : az > (0 : ℕ) ↔ az > 0 := by norm_cast
example : (an : ℤ) ≠ 0 ↔ an ≠ 0 := by norm_cast
example : aq < (1 : ℕ) ↔ (aq : ℚ) < (1 : ℤ) := by norm_cast
-- example : aq < (1 : ℕ) ↔ (aq : ℝ) < (1 : ℤ) := by norm_cast

example : (an : ℤ) + bn = (an + bn : ℕ) := by norm_cast
-- example : (an : ℂ) + bq = ((an + bq) : ℚ) := by norm_cast
-- example : (((an : ℤ) : ℚ) : ℝ) + bn = (an + (bn : ℤ)) := by norm_cast

example (h : ((an + bn : ℕ) : ℤ) = (an : ℤ) + (bn : ℤ)) : True := by
  push_cast at h
  guard_hyp h : (an : ℤ) + (bn : ℤ) = (an : ℤ) + (bn : ℤ)
  trivial

example (h : ((an * bn : ℕ) : ℤ) = (an : ℤ) * (bn : ℤ)) : True := by
  push_cast at h
  guard_hyp h : (an : ℤ) * (bn : ℤ) = (an : ℤ) * (bn : ℤ)
  trivial

-- example : (((((an : ℚ) : ℝ) * bq) + (cq : ℝ) ^ dn) : ℂ) = (an : ℂ) * (bq : ℝ) + cq ^ dn :=
-- by norm_cast
-- example : ((an : ℤ) : ℝ) < bq ∧ (cr : ℂ) ^ 2 = dz ↔ (an : ℚ) < bq ∧ ((cr ^ 2) : ℂ) = dz :=
-- by norm_cast

--testing numerals
example : ((42 : ℕ) : ℤ) = 42 := by norm_cast
-- example : ((42 : ℕ) : ℂ) = 42 := by norm_cast
example : ((42 : ℤ) : ℚ) = 42 := by norm_cast
-- example : ((42 : ℚ) : ℝ) = 42 := by norm_cast

structure p (n : ℤ)
example : p 42 := by
  norm_cast
  -- TODO: guard_target_mod_implicit
  -- guard_target = p 42
  exact ⟨⟩

-- example (h : (an : ℝ) = 0) : an = 0 := by exact_mod_cast h
-- example (h : (an : ℝ) = 42) : an = 42 := by exact_mod_cast h
-- example (h : (an + 42) ≠ 42) : (an : ℝ) + 42 ≠ 42 := by exact_mod_cast h

example (n : ℤ) (h : n + 1 > 0) : ((n + 1 : ℤ) : ℚ) > 0 := by exact_mod_cast h

-- testing the heuristic
example (h : bn ≤ an) : an - bn = 1 ↔ (an - bn : ℤ) = 1 :=
by norm_cast
-- example (h : (cz : ℚ) = az / bz) : (cz : ℝ) = az / bz :=
-- by assumption_mod_cast

namespace hidden

def WithZero (α) := Option α

@[coe]
def WithZero.of (a : α) : WithZero α := some a

instance : CoeTail α (WithZero α) := ⟨WithZero.of⟩

instance : Zero (WithZero α) := ⟨none⟩

instance [One α] : One (WithZero α) := ⟨some 1⟩

instance [Mul α] : MulZeroClass (WithZero α) where
  mul o₁ o₂ := o₁.bind fun a => o₂.map fun b => a * b
  zero_mul a := rfl
  mul_zero a := by cases a <;> rfl

@[norm_cast] lemma coe_one [One α] : ((1 : α) : WithZero α) = 1 := rfl

@[norm_cast] lemma coe_inj {a b : α} : (a : WithZero α) = b ↔ a = b :=
  Option.some_inj

@[norm_cast] lemma mul_coe [Mul α] (a b : α) :
  ((a * b : α) : WithZero α) = (a : WithZero α) * b := rfl

example [Mul α] [One α] (x y : α) (h : (x : WithZero α) * y = 1) : x * y = 1 := by
  exact_mod_cast h

end hidden

example (k : ℕ) {x y : ℕ} :
  (x * x + y * y : ℤ) - ↑((x * y + 1) * k) = ↑y * ↑y - ↑k * ↑x * ↑y + (↑x * ↑x - ↑k) :=
by
  push_cast
  ring

example (k : ℕ) {x y : ℕ} (h : ((x + y + k : ℕ) : ℤ) = 0) : x + y + k = 0 := by
  push_cast at h
  -- TODO: guard_hyp_mod_implicit
  -- guard_hyp h : (x : ℤ) + y + k = 0
  assumption_mod_cast

example (a b : ℕ) (h2 : ((a + b + 0 : ℕ) : ℤ) = 10) :
  ((a + b : ℕ) : ℤ) = 10 :=
by
  push_cast
  push_cast [Int.add_zero] at h2
  exact h2

-- example {x : ℚ} : ((x + 42 : ℚ) : ℝ) = x + 42 := by push_cast

namespace ennreal

-- --TODO: debug
-- lemma half_lt_self_bis {a : ℝ≥0∞} (hz : a ≠ 0) (ht : a ≠ ⊤) : a / 2 < a :=
-- begin
--   lift a to nnreal using ht,
--   have h : (2 : ℝ≥0∞) = ((2 : nnreal) : ℝ≥0∞), from rfl,
--   have h' : (2 : nnreal) ≠ 0, from _root_.two_ne_zero',
--   rw [h, ← coe_div h', coe_lt_coe], -- `norm_cast` fails to apply `coe_div`
--   norm_cast at hz,
--   exact nnreal.half_lt_self hz
-- end

end ennreal

lemma b (h g : true) : true ∧ true := by
  constructor
  assumption_mod_cast
  assumption_mod_cast


import ..lovelib

/-! # LoVe Homework 8: Logical Foundations of Mathematics

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (9 points): Multisets as a Quotient Type

A multiset (or bag) is a collection of elements that allows for multiple
(but finitely many) occurrences of its elements. For example, the multiset
`{2, 7}` is equal to the multiset `{7, 2}` but different from `{2, 7, 7}`.

Finite multisets can be defined as a quotient over lists. We start with the
type `list α` of finite lists and consider only the number of occurrences of
elements in the lists, ignoring the order in which elements occur. Following
this scheme, `[2, 7, 7]`, `[7, 2, 7]`, and `[7, 7, 2]` would be three equally
valid representations of the multiset `{2, 7, 7}`.

The `list.count` function returns the number of occurrences of an element in a
list. Since it uses equality on elements of type `α`, it requires `α` to belong
to the `decidable_eq` type class. For this reason, the definitions and lemmas
below all take `[decidable_eq α]` as type class argument.

1.1 (1 point). Provide the missing proof below. -/

@[instance] def multiset.rel (α : Type) [decidable_eq α] : setoid (list α) :=
{ r     := λas bs, ∀x, list.count x as = list.count x bs,
  iseqv :=
    sorry }

/-! 1.2 (1 point). Define the type of multisets as the quotient over the
relation `multiset.rel`. -/

def multiset (α : Type) [decidable_eq α] : Type :=
sorry

/-! 1.3 (3 points). Now we have a type `multiset α` but no operations on it.
Basic operations on multisets include the empty multiset (`∅`), the singleton
multiset (`{x} `for any element `x`), and the sum (or union) of two multisets
(`A ⊎ B` for any multisets `A` and `B`). The sum should be defined so that the
multiplicities of elements are added; thus, `{2} ⊎ {2, 2} = {2, 2, 2}`.

Fill in the `sorry` placeholders below to implement the basic multiset
operations. -/

def multiset.empty {α : Type} [decidable_eq α] : multiset α :=
sorry

def multiset.singleton {α : Type} [decidable_eq α] (a : α) : multiset α :=
sorry

def multiset.union {α : Type} [decidable_eq α] :
  multiset α → multiset α → multiset α :=
quotient.lift₂
  sorry
  sorry

/-! 1.4 (4 points). Prove that `multiset.union` is commutative and associative,
and has `multiset.empty` as identity element. -/

lemma multiset.union_comm {α : Type} [decidable_eq α] (A B : multiset α) :
  multiset.union A B = multiset.union B A :=
sorry

lemma multiset.union_assoc {α : Type} [decidable_eq α] (A B C : multiset α) :
  multiset.union (multiset.union A B) C =
  multiset.union A (multiset.union B C) :=
sorry

lemma multiset.union_iden_left {α : Type} [decidable_eq α] (A : multiset α) :
  multiset.union multiset.empty A = A :=
sorry

lemma multiset.union_iden_right {α : Type} [decidable_eq α] (A : multiset α) :
  multiset.union A multiset.empty = A :=
sorry

/-! ## Question 2 (4 points + 1 bonus point): Strict Positivity

So far, we've seen a few ways Lean prevents us from breaking the soundness of
its underlying logic: requiring well-founded recursion, using type universes to
avoid Girard's Paradox, and disallowing large elimination from `Prop`. In this
problem, we'll explore another logical "safety feature": *strict positivity* of
inductive definitions.

Strict positivity requires that in any constructor definition for an inductive
type `t`, if any argument to the constructor has a `Π` type (i.e., a
`∀`-quantified type or a function type), then `t` may only appear as the
"result" (i.e., on the right-hand side) in that `Π` type. Such an occurrence of
`t` is known as a *positive* occurrence.

As an example, `legal` obeys strict positivity:

  inductive legal : Type
  | mk : (unit → legal) → legal

But `illegal` does not (this would not compile):

  inductive illegal : Type
  | mk : (illegal → unit) → illegal

In this question, we'll exemplify why Lean must require strict positivity.

**Note**: In order to declare and use the illegal type `self` in this problem,
we must use the `meta` keyword for our declarations, which disables safety
features like positivity checking. Be careful: `meta` disables *many* safety
checks, including well-founded recursion checks. This means that Lean won't
complain if, for instance, you write `meta def uh_oh : false := uh_oh`. However,
when grading your code, we will require that all declarations (besides `self`)
be "safe" Lean declarations -- i.e., if you removed the `meta` keywords and
somehow persuaded Lean to accept `self` as a legal inductive definition, all of
your declarations should compile without errors (in particular, you shouldn't
have any infinite recursion!).

We define `self`, an inductive type that does not obey strict positivity,
below. -/

meta inductive self (α : Type) : Type
| mk : (self → α) → self

/-! 2.1 (1 point). Complete the definition below that produces a value of type
`empty` given a value of type `self empty`. -/

meta def empty_of_self_empty : self empty → empty :=
sorry

/-! 2.2 (2 points). Construct a value of type `self empty` below.

Remember not to accidentally refer to `self_empty` itself in your definition! -/

meta def self_empty : self empty :=
sorry

/-! 2.3 (1 point). Use the preceding declarations to prove `false`.

Hint: recall `empty.elim`. -/

meta def uh_oh : false :=
sorry

/-! 2.4 (1 bonus point). In fact, we can use `self` to define a
*fixpoint combinator*, which allows us to write recursive functions without
relying on Lean's built-in recursive function support (which checks for things
like well-founded recursion). This should immediately raise red flags from a
soundness perspective: if we can write recursive functions without ensuring
well-founded recursion, then we can define functions satisfying, e.g.,
`f 0 = f 0 + 1`, which we have previously shown to enable a proof of `false`.

Formally, a fixpoint combinator is a function `fixp` such that for any function
`f` (if `f` has a fixed point, which we can assume it does), we have
`fixp f = f (fixp f)` (i.e., for all `x`, `fixp f x = f (fixp f) x`).

Below, use `self` to implement a *non-recursive* function `fixp` that behaves as
a fixpoint combinator. To check your work, provide a *non-recursive* function
`fib_nr` such that `fixp fib_nr` is the Fibonacci function. (Remember to make
both of these non-recursive -- otherwise, you're just relying on Lean's built-in
recursion support.)

If you don't have prior familiarity with fixpoint combinators, we recommend you
read the overview below before proceeding. If you are already familiar with the
concept, feel free to skip over the rest of this comment.

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

Intuitively, a fixpoint combinator allows us to make non-recursive functions
recursive. In order to do so, we define our non-recursive functions with an
extra argument that we treat as a "recursive reference" to our function and use
in our function body wherever we want to make a recursive call. Then, our
fixpoint combinator "fills in" that argument with an actual reference to the
function itself. We'll illustrate how this works by defining the factorial
function using a fixpoint combinator below:

* First, we define a non-recursive function `fact_nr`:

  `def fact_nr : (ℕ → ℕ) → ℕ → ℕ := λ f n, if n = 0 then 1 else f (n - 1)`

  Notice that this function is *not* recursive! Instead, we take an extra
  argument `f` that we treat as though it were a recursive reference to `fact`
  (without the initial function argument). The job of the fixpoint combinator is
  to make this assumption valid!

* Next, supposing we have access to a fixpoint combinator

  `fixp : ∀ {α β : Type}, ((α → β) → α → β) → α → β`

  (think about why this is the right type!), we define

  `def fact := fixp fact_nr`

  Since this is a partial application, we have `fact : ℕ → ℕ` (you should think
  through the types yourself to verify this). Notice that `fixp` has somehow
  "filled in" the first argument `f` to `fact_nr` -- in particular, since we
  assume `fixp` is correct, it somehow manages to fill in that argument with a
  reference back to `fact` itself.

Recall that we formally defined a fixpoint combinator `fixp` as satisfying
`fixp f = f (fixp f)`. In the above, we said that `fixp fact` is essentially the
result of taking `fact` and "filling in" the first argument with a reference to
an "already-recursive" version of `fact`. So then `fact (fixp fact)` is the
result of calling `fact` with its first argument being an "already-recursive"
version of `fact`. (Why is `fixp fact` "already recursive?" Recall that its
first argument has been filled in with a recursive reference, so any time it
invokes that first argument -- which we treat as a "recursive call" -- it is in
fact recursing!) Thus, `fixp fact = fact (fixp fact)`, so this agrees with our
formal definition! -/

meta def fixp {α β : Type} : ((α → β) → α → β) → (α → β) :=
sorry

meta def fixp_fib : (ℕ → ℕ) → ℕ → ℕ :=
sorry

-- This should compute the Fibonacci sequence (you can use `#eval` to check
-- your work).
meta def fib : ℕ → ℕ := fixp fixp_fib

end LoVe


import plane_separation_world.level08 --hide
open IncidencePlane --hide

/-
# Plane Separation World

## Level 9: the Pasch's Axiom in action... (final level)

Welcome to the final level of The Euclid Game! This is perhaps the most challenging level with difference. For this reason, you will be provided with
a very rigorous proof in paper. In case you want to see a possible solution to this level, click on "View source" (located on the top right corner of the
game screen). Have fun, and let maths be with you!

## Next version of The Euclid Game

In the next version of The Euclid Game, it would be nice to extend the Plane Separation World with more levels and add the Congruence World.

## What's next?

If you liked the game and want to learn more, look here for more ideas about what to do next.

## Step by step proof in paper...

**Claim:** Given three non-collinear points A, B, C and a line ℓ, if A and B are on the same side of
ℓ and B and C are on the same side of ℓ, then A and C are on the same side of ℓ.

**Proof:**

Let us assume that A and B are on the same side of ℓ and that B and C are on the same side of ℓ. Then, we have to prove that A and C are on the same side of ℓ.
Now, we proceed with the proof by contradiction. That is, let us assume that that A and C are on the same side of ℓ.

**(i)** By the lemma `not_same_side_intersection`, since we have assumed that A and C are on the same side of ℓ, then there exists a point P such that
`P ∈ pts (A⬝C) ∧ P ∈ ℓ`. Let that point P be called D. Then, there exists a point D such that `D ∈ pts (A⬝C) ∧ D ∈ ℓ`. That is, `(D = A ∨ D = C ∨ A*D*C) ∧ D ∈ ℓ`.

**(ii)** By the lemma `not_same_side_point_in_between`, since A and B are on the same side of ℓ, B and C are on the same side of ℓ, and `(D = A ∨ D = C ∨ A*D*C) ∧ D ∈ ℓ`,
then D satisfies that `A * D * C`.

**(iii)** By the lemma `noncollinear_ne_line`, since A, B and C are not collinear, then `B ∉ line_through A C`.

**(iv)** By the lemma `same_side_of_noncollinear_ne_line`, since A and B are on the same side of ℓ, and B and C are on the same side of ℓ, then
`A ∉ ℓ ∧ B ∉ ℓ ∧ C ∉ ℓ`.

**(v)** By the Pasch's Axiom, since `A ∉ ℓ ∧ B ∉ ℓ ∧ C ∉ ℓ` (proved in (i)), and `D ∈ ℓ` and `A * D * C` (proved in (ii)), then there exists a point E, such that
`E ∈ ℓ`, and either E satisfies that `A * E * B` or `C * E * B`. Now, we proceed with (vi) by cases.

**(v.A)** Let us assume that there exists a point E, such that `E ∈ ℓ` and `A * E * B`. Because `pts (A⬝B) ∩ ↑ℓ = ∅`, the point E has to satisfy that
`A * E * B` and `E ∉ ℓ`. By contradiction with the Pasch's Axiom, there cannot exist a point E such that `A * E * B` and `E ∈ ℓ`.

**(v.B)** Let us assume that there exists a point E, such that `E ∈ ℓ` and `C * E * B`. By the first axiom of order `between_symmetric`, let `C * E * B` be
equivalent to `B * E * C`. Because `pts (B⬝C) ∩ ↑ℓ = ∅`, the point E has to satisfy that `B * E * C` and `E ∉ ℓ`. By contradiction with the Pasch's Axiom,
there cannot exist a point E such that `B * E * C` and `E ∈ ℓ`.

Because we have shown that there cannot exist a point E such that `E ∈ ℓ` and either `A * E * B` or `B * E * C`, then the segment `A·B` is on the same side of ℓ and
the segment `B·C` is on the same side of ℓ. Therefore, we prove, as a consequence, that the segment `A·C` is on the same side of ℓ.
-/

/- Hint : Click here for a hint, in case you get stuck.
To solve this level, we have used high levels tactics which weren't taught in the Tutorial World. In case you are bewildered, do not hesitate
to click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B C P Q R : Ω} --hide
variables {ℓ r s t : Line Ω} --hide

/- Lemma :
Given three non-collinear points A, B, C and a line ℓ, if A and B are on the same side of
ℓ and B and C are on the same side of ℓ, then A and C are on the same side of ℓ.
-/
lemma same_side_trans_of_noncollinear (hCol : ¬ collinear ({A, C, B} : set Ω)):
    same_side ℓ A B → same_side ℓ B C → same_side ℓ A C :=
begin
intros p q,
by_contradiction,
have h' := not_same_side_intersection h,
cases h' with D hPAC,
simp at hPAC,
have x := not_same_side_point_in_between p q hPAC,
have a1 := noncollinear_ne_line hCol,
have c := same_side_of_noncollinear_ne_line p q,
have fact := pasch a1 c.1 c.2.2 c.2.1 hPAC.2 x,
cases fact,
{
  unfold same_side at p,
  cases fact.1 with E,
  simp [set.eq_empty_iff_forall_not_mem] at p,
  replace p := p.2.2 E h_1.2,
  apply p,
  exact h_1.1,
},
{
  unfold same_side at q,
  cases fact.1 with F,
  simp [set.eq_empty_iff_forall_not_mem] at q,
  rw between_symmetric at h_1,
  replace q := q.2.2 F h_1.2,
  apply q,
  exact h_1.1,
},
end


-- Pruebas_de_equivalencia_de_definiciones_de_inversa.lean
-- Pruebas de equivalencia de definiciones de inversa
-- José A. Alonso Jiménez
-- Sevilla, 11 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean, está definida la función
--    reverse : list α → list α
-- tal que (reverse xs) es la lista obtenida invirtiendo el orden de los
-- elementos de xs. Por ejemplo,
--    reverse  [3,2,5,1] = [1,5,2,3]
-- Su definición es
--    def reverse_core : list α → list α → list α
--    | []     r := r
--    | (a::l) r := reverse_core l (a::r)
--
--    def reverse : list α → list α :=
--    λ l, reverse_core l []
--
-- Una definición alternativa es
--    def inversa : list α → list α
--    | []        := []
--    | (x :: xs) := inversa xs ++ [x]
--
-- Demostrar que las dos definiciones son equivalentes; es decir,
--    reverse xs = inversa xs
-- ---------------------------------------------------------------------

import data.list.basic
open list

variable  {α : Type*}
variable  (x : α)
variables (xs ys : list α)

-- Definición y reglas de simplificación de inversa
-- ================================================

def inversa : list α → list α
| []        := []
| (x :: xs) := inversa xs ++ [x]

@[simp]
lemma inversa_nil :
  inversa ([] : list α) = [] :=
rfl

@[simp]
lemma inversa_cons :
  inversa (x :: xs) = inversa xs ++ [x] :=
rfl

-- Reglas de simplificación de reverse_core
-- ========================================

@[simp]
lemma reverse_core_nil :
  reverse_core [] ys = ys :=
rfl

@[simp]
lemma reverse_core_cons :
  reverse_core (x :: xs) ys = reverse_core xs (x :: ys) :=
rfl

-- Lema auxiliar: reverse_core xs ys = (inversa xs) ++ ys
-- ======================================================

-- 1ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { calc reverse_core [] ys
         = ys                        : reverse_core_nil ys
     ... = [] ++ ys                  : (nil_append ys).symm
     ... = inversa [] ++ ys          : congr_arg2 (++) inversa_nil.symm rfl, },
  { calc reverse_core (a :: as) ys
         = reverse_core as (a :: ys) : reverse_core_cons a as ys
     ... = inversa as ++ (a :: ys)   : (HI (a :: ys))
     ... = inversa as ++ ([a] ++ ys) : congr_arg2 (++) rfl singleton_append
     ... = (inversa as ++ [a]) ++ ys : (append_assoc (inversa as) [a] ys).symm
     ... = inversa (a :: as) ++ ys   : congr_arg2 (++) (inversa_cons a as).symm rfl},
end

-- 2ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { calc reverse_core [] ys
         = ys                        : by rw reverse_core_nil
     ... = [] ++ ys                  : by rw nil_append
     ... = inversa [] ++ ys          : by rw inversa_nil },
  { calc reverse_core (a :: as) ys
         = reverse_core as (a :: ys) : by rw reverse_core_cons
     ... = inversa as ++ (a :: ys)   : by rw (HI (a :: ys))
     ... = inversa as ++ ([a] ++ ys) : by rw singleton_append
     ... = (inversa as ++ [a]) ++ ys : by rw append_assoc
     ... = inversa (a :: as) ++ ys   : by rw inversa_cons },
end

-- 3ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { calc reverse_core [] ys
         = ys                        : rfl
     ... = [] ++ ys                  : rfl
     ... = inversa [] ++ ys          : rfl },
  { calc reverse_core (a :: as) ys
         = reverse_core as (a :: ys) : rfl
     ... = inversa as ++ (a :: ys)   : (HI (a :: ys))
     ... = inversa as ++ ([a] ++ ys) : rfl
     ... = (inversa as ++ [a]) ++ ys : by rw append_assoc
     ... = inversa (a :: as) ++ ys   : rfl },
end

-- 3ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { calc reverse_core [] ys
         = ys                        : by simp
     ... = [] ++ ys                  : by simp
     ... = inversa [] ++ ys          : by simp },
  { calc reverse_core (a :: as) ys
         = reverse_core as (a :: ys) : by simp
     ... = inversa as ++ (a :: ys)   : (HI (a :: ys))
     ... = inversa as ++ ([a] ++ ys) : by simp
     ... = (inversa as ++ [a]) ++ ys : by simp
     ... = inversa (a :: as) ++ ys   : by simp },
end

-- 4ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { by simp, },
  { calc reverse_core (a :: as) ys
         = reverse_core as (a :: ys) : by simp
     ... = inversa as ++ (a :: ys)   : (HI (a :: ys))
     ... = inversa (a :: as) ++ ys   : by simp },
end

-- 5ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { simp, },
  { simp [HI (a :: ys)], },
end

-- 6ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
by induction xs generalizing ys ; simp [*]

-- 7ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { rw reverse_core_nil,
    rw inversa_nil,
    rw nil_append, },
  { rw reverse_core_cons,
    rw (HI (a :: ys)),
    rw inversa_cons,
    rw append_assoc,
    rw singleton_append, },
end

-- 8ª demostración  del lema auxiliar
@[simp]
lemma inversa_equiv :
  ∀ xs : list α, ∀ ys, reverse_core xs ys = (inversa xs) ++ ys
| []         := by simp
| (a :: as)  := by simp [inversa_equiv as]

-- Demostraciones del lema principal
-- =================================

-- 1ª demostración
example : reverse xs = inversa xs :=
calc reverse xs
     = reverse_core xs [] : rfl
 ... = inversa xs ++ []   : by rw inversa_equiv
 ... = inversa xs         : by rw append_nil

-- 2ª demostración
example : reverse xs = inversa xs :=
by simp [inversa_equiv, reverse]

-- 3ª demostración
example : reverse xs = inversa xs :=
by simp [reverse]


/-- A `Quiver` `G` on a type `V` of vertices assigns to every pair `a b : V` of vertices
    a type `a ⟶ b` of arrows from `a` to `b`.

    It is a common generalisation of multigraphs and categories.
    This definition is taken from `mathlib`:
    https://leanprover-community.github.io/mathlib_docs/combinatorics/quiver/basic.html#quiver. -/
class Quiver (V : Sort _) where
  hom : V → V → Sort _

infixr:10 " ⟶ " => Quiver.hom -- type using `\-->` or `\hom`

/-- A pre-functor is a morphism of quivers. -/
structure Quiver.PreFunctor {V V' : Sort _} (Q : Quiver V) (Q' : Quiver V') where
  obj : V → V'
  map : {X Y : V} → (X ⟶ Y) → (obj X ⟶ obj Y)

namespace Quiver.PreFunctor

/-- The identity morphism between quivers. -/
@[simp] protected def id (V : Sort _) [Q : Quiver V] : PreFunctor Q Q :=
{ obj := id, map := id }

instance (V : Sort _) [Q : Quiver V] : Inhabited (PreFunctor Q Q) := ⟨PreFunctor.id V⟩

/-- Composition of morphisms between quivers. -/
@[simp] def comp {U V W : Sort _} {QU : Quiver U} {QV : Quiver V} {QW : Quiver W}
  (F : PreFunctor QU QV) (G : PreFunctor QV QW) : PreFunctor QU QW :=
  { obj := G.obj ∘ F.obj, map := G.map ∘ F.map }

end Quiver.PreFunctor

/-- Paths in a quiver. -/
inductive Path {V : Sort _} [Quiver V] : V → V → Sort _
  | nil : {A : V} → Path A A
  | cons : {A B C : V} → (A ⟶ B) → Path B C → Path A C

def Quiver.toPath {V : Sort _} [Quiver V] {A B : V} (e : A ⟶ B) : Path A B :=
  .cons e .nil

namespace Path

variable {V : Sort _} [Quiver V] {A B C D : V}

@[match_pattern] abbrev nil' (A : V) : Path A A := Path.nil
@[match_pattern] abbrev cons' (A B C : V) :
  (A ⟶ B) → Path B C → Path A C := Path.cons

/-- Concatenate an edge to the end of a path. -/
@[match_pattern]
abbrev snoc : {A B C : V} → Path A B → (B ⟶ C) → Path A C
  | _, _, _, .nil, e => .cons e .nil
  | _, _, _, .cons e p', e' => .cons e (snoc p' e')

@[match_pattern]
abbrev snoc' (A B C : V) : Path A B → (B ⟶ C) → Path A C := Path.snoc

/-- Concatenation of paths. -/
def append : {A B C : V} → Path A B → Path B C → Path A C
  | _, _, _, .nil, p => p
  | _, _, _, .cons e p', p => cons e (append p' p)

/-- The length of a path. -/
def length : {A B : V} → Path A B → Nat
  | _, _, .nil => .zero
  | _, _, .cons _ p => .succ (length p)

@[simp] theorem nil_append (p : Path A B) : .append .nil p = p := rfl

@[simp] theorem append_nil (p : Path A B) : .append p .nil = p := by
  induction p
  · case nil => rfl
  · case cons =>
      simp only [append]
      apply congrArg
      assumption

theorem snoc_cons (e : A ⟶ B) (p : Path B C) (e' : C ⟶ D) :
  snoc (cons e p) e' = cons e (snoc p e') := by cases p <;> simp

theorem append_snoc (p : Path A B) (p' : Path B C) (e : C ⟶ D) :
    append p (snoc p' e) = snoc (append p p') e := by
  induction p
  · case nil => rfl
  · case cons ih => simp [append, ih p', snoc_cons]

theorem append_cons (p : Path A B) (e : B ⟶ C) (p' : Path C D) :
    append p (cons e p') = append (snoc p e) p' := by
  induction p
  · case nil => rfl
  · case cons ih => dsimp [append]; rw [ih]

theorem append_assoc (p : Path A B) (q : Path B C) (r : Path C D) :
    append (append p q) r = append p (append q r) := by
  induction p
  · case nil => rfl
  · case cons ih => simp [append]; apply ih

-- TODO Rephrase this to work for general paths, not just loops
theorem nil_length {A : V} : (p : Path A A) → p.length = .zero ↔ p = .nil' A
  | .nil => ⟨λ _ => rfl, λ _ => rfl⟩
  | .cons _ p => by apply Iff.intro <;> (intro; simp [length] at *)

theorem snoc_length {A B C : V} : (p : Path A B) → (e : B ⟶ C) → length (.snoc p e) = .succ (length p)
  | .nil, e => rfl
  | .cons _ p', e => by
    rw [snoc_cons]
    dsimp only [length]
    apply congrArg
    apply snoc_length

theorem length_append {A B C : V} : (p : Path A B) → (q : Path B C) → (append p q).length = p.length + q.length
  | .nil, q => by rw [Nat.add_comm]; rfl
  | .cons _ p', q => by
    dsimp [append, length]
    rw [Nat.succ_add]
    apply congrArg
    apply length_append

/-- The end-point of the first edge in the path. -/
def first : Path A B → V
  | .nil' v => v
  | .cons' _ v _ _ _ => v

/-- The source of the last end in the path. -/
def last : {A B : V} → Path A B → V
  | _, _, .nil' v => v
  | .(v), _, .cons' v _ _ _ .nil => v
  | _, _, .cons' _ _ _ _ (.cons e p) => last (.cons e p)

theorem first_cons (A B C : V) (e : A ⟶ B) (p : Path B C) : first (cons e p) = B := rfl

theorem last_snoc : (A B C : V) → (p : Path A B) → (e : B ⟶ C) → last (snoc p e) = B
  | _, _, _, .nil, _ => rfl
  | _, _, _, .cons' _ _ _ _ .nil, _ => by rw [snoc_cons]; rfl
  | _, _, _, .cons' _ _ _ _ (.cons _ _), _ => by rw [snoc_cons, snoc, last, ← snoc_cons]; apply last_snoc

end Path

abbrev Loop {V : Sort _} [Quiver V] (A : V) := Path A A

namespace Loop

variable {V : Sort _} [Quiver V] (A : V)

def toPath : Loop A → Path A A := id

abbrev nil : Loop A := Path.nil

abbrev next : Loop A → V := Path.first

abbrev concat : Loop A → Loop A → Loop A := Path.append

end Loop


/-
Copyright (c) 2022 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller

! This file was ported from Lean 3 source module combinatorics.simple_graph.acyclic
! leanprover-community/mathlib commit 832f7b9162039c28b9361289c8681f155cae758f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.SimpleGraph.Connectivity

/-!

# Acyclic graphs and trees

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

This module introduces *acyclic graphs* (a.k.a. *forests*) and *trees*.

## Main definitions

* `simple_graph.is_acyclic` is a predicate for a graph having no cyclic walks
* `simple_graph.is_tree` is a predicate for a graph being a tree (a connected acyclic graph)

## Main statements

* `simple_graph.is_acyclic_iff_path_unique` characterizes acyclicity in terms of uniqueness of
  paths between pairs of vertices.
* `simple_graph.is_acyclic_iff_forall_edge_is_bridge` characterizes acyclicity in terms of every
  edge being a bridge edge.
* `simple_graph.is_tree_iff_exists_unique_path` characterizes trees in terms of existence and
  uniqueness of paths between pairs of vertices from a nonempty vertex type.

## References

The structure of the proofs for `simple_graph.is_acyclic` and `simple_graph.is_tree`, including
supporting lemmas about `simple_graph.is_bridge`, generally follows the high-level description
for these theorems for multigraphs from [Chou1994].

## Tags

acyclic graphs, trees
-/

universe u v

namespace SimpleGraph

variable {V : Type u} (G : SimpleGraph V)

#print SimpleGraph.IsAcyclic /-
/-- A graph is *acyclic* (or a *forest*) if it has no cycles. -/
def IsAcyclic : Prop :=
  ∀ (v : V) (c : G.Walk v v), ¬c.IsCycle
#align simple_graph.is_acyclic SimpleGraph.IsAcyclic
-/

#print SimpleGraph.IsTree /-
/-- A *tree* is a connected acyclic graph. -/
@[mk_iff, protect_proj]
structure IsTree : Prop where
  is_connected : G.Connected
  IsAcyclic : G.IsAcyclic
#align simple_graph.is_tree SimpleGraph.IsTree
-/

variable {G}

#print SimpleGraph.isAcyclic_iff_forall_adj_isBridge /-
theorem isAcyclic_iff_forall_adj_isBridge :
    G.IsAcyclic ↔ ∀ ⦃v w : V⦄, G.Adj v w → G.IsBridge ⟦(v, w)⟧ :=
  by
  simp_rw [is_bridge_iff_adj_and_forall_cycle_not_mem]
  constructor
  · intro ha v w hvw
    apply And.intro hvw
    intro u p hp
    exact absurd hp (ha _ p)
  · rintro hb v (_ | @⟨_, _, _, ha, p⟩) hp
    · exact hp.not_of_nil
    · specialize hb ha
      apply hb.2 _ hp
      rw [walk.edges_cons]
      apply List.mem_cons_self
#align simple_graph.is_acyclic_iff_forall_adj_is_bridge SimpleGraph.isAcyclic_iff_forall_adj_isBridge
-/

/- warning: simple_graph.is_acyclic_iff_forall_edge_is_bridge -> SimpleGraph.isAcyclic_iff_forall_edge_isBridge is a dubious translation:
lean 3 declaration is
  forall {V : Type.{u1}} {G : SimpleGraph.{u1} V}, Iff (SimpleGraph.IsAcyclic.{u1} V G) (forall {{e : Sym2.{u1} V}}, (Membership.Mem.{u1, u1} (Sym2.{u1} V) (Set.{u1} (Sym2.{u1} V)) (Set.hasMem.{u1} (Sym2.{u1} V)) e (coeFn.{succ u1, succ u1} (OrderEmbedding.{u1, u1} (SimpleGraph.{u1} V) (Set.{u1} (Sym2.{u1} V)) (SimpleGraph.hasLe.{u1} V) (Set.hasLe.{u1} (Sym2.{u1} V))) (fun (_x : RelEmbedding.{u1, u1} (SimpleGraph.{u1} V) (Set.{u1} (Sym2.{u1} V)) (LE.le.{u1} (SimpleGraph.{u1} V) (SimpleGraph.hasLe.{u1} V)) (LE.le.{u1} (Set.{u1} (Sym2.{u1} V)) (Set.hasLe.{u1} (Sym2.{u1} V)))) => (SimpleGraph.{u1} V) -> (Set.{u1} (Sym2.{u1} V))) (RelEmbedding.hasCoeToFun.{u1, u1} (SimpleGraph.{u1} V) (Set.{u1} (Sym2.{u1} V)) (LE.le.{u1} (SimpleGraph.{u1} V) (SimpleGraph.hasLe.{u1} V)) (LE.le.{u1} (Set.{u1} (Sym2.{u1} V)) (Set.hasLe.{u1} (Sym2.{u1} V)))) (SimpleGraph.edgeSetEmbedding.{u1} V) G)) -> (SimpleGraph.IsBridge.{u1} V G e))
but is expected to have type
  forall {V : Type.{u1}} {G : SimpleGraph.{u1} V}, Iff (SimpleGraph.IsAcyclic.{u1} V G) (forall {{e : Sym2.{u1} V}}, (Membership.mem.{u1, u1} (Sym2.{u1} V) (Set.{u1} (Sym2.{u1} V)) (Set.instMembershipSet.{u1} (Sym2.{u1} V)) e (SimpleGraph.edgeSet.{u1} V G)) -> (SimpleGraph.IsBridge.{u1} V G e))
Case conversion may be inaccurate. Consider using '#align simple_graph.is_acyclic_iff_forall_edge_is_bridge SimpleGraph.isAcyclic_iff_forall_edge_isBridgeₓ'. -/
theorem isAcyclic_iff_forall_edge_isBridge :
    G.IsAcyclic ↔ ∀ ⦃e⦄, e ∈ G.edgeSetEmbedding → G.IsBridge e := by
  simp [is_acyclic_iff_forall_adj_is_bridge, Sym2.forall]
#align simple_graph.is_acyclic_iff_forall_edge_is_bridge SimpleGraph.isAcyclic_iff_forall_edge_isBridge

#print SimpleGraph.IsAcyclic.path_unique /-
theorem IsAcyclic.path_unique {G : SimpleGraph V} (h : G.IsAcyclic) {v w : V} (p q : G.Path v w) :
    p = q := by
  obtain ⟨p, hp⟩ := p
  obtain ⟨q, hq⟩ := q
  simp only
  induction' p with u pu pv pw ph p ih generalizing q
  · rw [walk.is_path_iff_eq_nil] at hq
    exact hq.symm
  · rw [is_acyclic_iff_forall_adj_is_bridge] at h
    specialize h ph
    rw [is_bridge_iff_adj_and_forall_walk_mem_edges] at h
    replace h := h.2 (q.append p.reverse)
    simp only [walk.edges_append, walk.edges_reverse, List.mem_append, List.mem_reverse'] at h
    cases h
    · cases q
      · simpa [walk.is_path_def] using hp
      · rw [walk.cons_is_path_iff] at hp hq
        simp only [walk.edges_cons, List.mem_cons, Sym2.eq_iff] at h
        obtain (⟨h, rfl⟩ | ⟨rfl, rfl⟩) | h := h
        · rw [ih hp.1 _ hq.1]
        · simpa using hq
        · exact absurd (walk.fst_mem_support_of_mem_edges _ h) hq.2
    · rw [walk.cons_is_path_iff] at hp
      exact absurd (walk.fst_mem_support_of_mem_edges _ h) hp.2
#align simple_graph.is_acyclic.path_unique SimpleGraph.IsAcyclic.path_unique
-/

#print SimpleGraph.isAcyclic_of_path_unique /-
theorem isAcyclic_of_path_unique (h : ∀ (v w : V) (p q : G.Path v w), p = q) : G.IsAcyclic :=
  by
  intro v c hc
  simp only [walk.is_cycle_def, Ne.def] at hc
  cases c
  · exact absurd rfl hc.2.1
  · simp only [walk.cons_is_trail_iff, not_false_iff, walk.support_cons, List.tail_cons,
      true_and_iff] at hc
    specialize h _ _ ⟨c_p, by simp only [walk.is_path_def, hc.2]⟩ (path.singleton (G.symm c_h))
    simp only [path.singleton] at h
    simpa [-Quotient.eq', Sym2.eq_swap, h] using hc
#align simple_graph.is_acyclic_of_path_unique SimpleGraph.isAcyclic_of_path_unique
-/

#print SimpleGraph.isAcyclic_iff_path_unique /-
theorem isAcyclic_iff_path_unique : G.IsAcyclic ↔ ∀ ⦃v w : V⦄ (p q : G.Path v w), p = q :=
  ⟨IsAcyclic.path_unique, isAcyclic_of_path_unique⟩
#align simple_graph.is_acyclic_iff_path_unique SimpleGraph.isAcyclic_iff_path_unique
-/

#print SimpleGraph.isTree_iff_existsUnique_path /-
theorem isTree_iff_existsUnique_path :
    G.IsTree ↔ Nonempty V ∧ ∀ v w : V, ∃! p : G.Walk v w, p.IsPath := by
  classical
    rw [is_tree_iff, is_acyclic_iff_path_unique]
    constructor
    · rintro ⟨hc, hu⟩
      refine' ⟨hc.nonempty, _⟩
      intro v w
      let q := (hc v w).some.toPath
      use q
      simp only [true_and_iff, path.is_path]
      intro p hp
      specialize hu ⟨p, hp⟩ q
      exact subtype.ext_iff.mp hu
    · rintro ⟨hV, h⟩
      refine' ⟨connected.mk _, _⟩
      · intro v w
        obtain ⟨p, hp⟩ := h v w
        exact p.reachable
      · rintro v w ⟨p, hp⟩ ⟨q, hq⟩
        simp only [ExistsUnique.unique (h v w) hp hq]
#align simple_graph.is_tree_iff_exists_unique_path SimpleGraph.isTree_iff_existsUnique_path
-/

end SimpleGraph


import .productes
import data.real.ereal
-- import analysis.special_functions.trigonometric -- for sin and cos

open set
open topological_space

noncomputable theory

/- We can now work with topological spaces like this. -/
example (X : Type) [topological_space X] (U V W : set X) (hU : is_open U) (hV : is_open V)
  (hW : is_open W) : is_open (U ∩ V ∩ W) :=
begin
  apply inter _ _ _ hW,
  exact inter _ _ hU hV,
end

/- Defining a basic topology now works like so: -/
def discrete (X : Type) : topological_space X :=
{ is_open := λ U, true, -- everything is open
  univ_mem := trivial,
  union := λ _ _, by trivial,
  inter := λ _ _ _ _, by trivial }

/-- The indiscrete topology is the coarsest possible one. -/
def indiscrete (X : Type) : topological_space X := generate_from ∅

/- The union of a family of sets containing univ is univ -/
lemma sUnion_univ_of_mem_univ {X : Type} {I : set (set X)} (h : univ ∈ I) : ⋃₀ I = univ :=
begin
  rw sUnion_eq_univ_iff,
  intros x,
  use univ,
  exact ⟨h, mem_univ x⟩,
end

/-- The only opens in the indiscrete topology are ∅ and univ -/
lemma indiscrete_is_open_iff {X : Type} (U : set X) :
@is_open _ (indiscrete X) U ↔ U = ∅ ∨ U = univ :=
begin
  split,
  {
    intro h,
    induction h with _ _ I hI hI' W1 W2 hW1 hW2 hW1' hW2',
    { tauto },
    { tauto },
    {
      by_cases H : univ ∈ I,
      { exact or.inr (sUnion_univ_of_mem_univ H) },
      {
        left,
        rw sUnion_eq_empty,
        finish,
      }
    },
    {
      cases hW1',
      {
        left,
        rw [inter_comm, hW1'],
        apply inter_empty,
      },
      subst hW1',
      simpa,
    },
  },
  {
    intro h,
    cases h,
    all_goals {rw h, simp },
  }
end

/-- A map from a discrete topology is always continuous. -/
lemma is_continuous_from_discrete {X Y: Type} [topological_space Y]
(f: X → Y) : @is_continuous _ _ (discrete X) _ f :=
begin
  intros V hV,
  tauto,
end

/-- A map to an indiscrete topology is always continuous. -/
lemma is_continuous_to_indiscrete {X Y: Type} [topological_space X]
(f: X → Y) : @is_continuous _ _ _ (indiscrete Y) f :=
begin
  intros V hV,
  rw indiscrete_is_open_iff at hV,
  cases hV; rw hV,
  {
    apply is_open_empty,
  },
  {
    apply univ_mem,
  }
end

/-
Show that {∅, univ, (-∞, a) : a : ℝ} is a topology on ℝ
-/
open real
open ereal

def left_ray : ereal → (set ℝ) := λ a , (ite (a = ⊥) ∅ (ite (a = ⊤) univ {x : ℝ | (x : ereal) < a}))

@[simp]
lemma left_ray_top_def : left_ray ⊤ = univ :=
begin
  unfold left_ray,
  simp,
  tauto,
end

@[simp]
lemma left_ray_bot_def : left_ray ⊥ = ∅ :=
begin
  unfold left_ray,
  simp,
end

@[simp]
lemma left_ray_eq_Iio (x : ℝ) : left_ray (x : ereal) = Iio x :=
begin
  unfold left_ray,
  have xnetop : (x : ereal) ≠ ⊤ := dec_trivial,
  have xnebot : (x : ereal) ≠ ⊥ := dec_trivial,
  simp [xnetop, xnebot, Iio_def],
end

@[simp]
lemma left_ray_mem (x : ℝ) (y : ereal) : x ∈ left_ray y ↔ (x : ereal) < y :=
begin
  by_cases ht : y = ⊤,
  { simp [ht] },
  by_cases hb : y = ⊥,
  { simp [hb] },
  let z := y.to_real,
  rw ←coe_to_real ht hb,
  simp,
end

lemma left_ray_def (x : ereal) : left_ray x = {y : ℝ | (y : ereal) < x } :=
begin
  ext,
  simp,
end

@[simp]
lemma left_ray_univ_iff (b : ereal) : left_ray b = univ ↔ b = ⊤ :=
begin
  split,
  {
    intro h,
    unfold left_ray at h,
    by_contradiction hc,
    simp [hc] at h,
    by_cases ht : b = ⊥,
    {
      subst ht,
      simp at h,
      exact empty_ne_univ h,
    },
    let z := b.to_real,
    rw ←coe_to_real hc ht at *,
    simp [ht] at h,
    specialize h (z+1),
    linarith [h],
  },
  exact λ h, by simp [h],
end

@[simp]
lemma left_ray_empty_iff (b : ereal) : left_ray b = ∅ ↔ b = ⊥ :=
begin
  split,
  {
    intro h,
    unfold left_ray at h,
    by_contradiction hc,
    simp [hc] at h,
    by_cases ht : b = ⊤,
    { simpa [ht] using h },
    { simp [ht] at h,
      --obtain ⟨z, hz⟩ := ereal.to_real' hc ht,
      have hz := (coe_to_real ht hc),
      rw ←hz at h,
      simp only [ereal.coe_le_coe_iff] at h,
      specialize h (b.to_real-1),
      linarith [h] },
  },
  exact λ h, by simp [h],
end

@[simp]
lemma left_ray_subset_iff (a b : ereal) : left_ray a ⊆ left_ray b ↔ a ≤ b :=
begin
  by_cases ha1 : a = ⊥,
  { simp [ha1] },
  by_cases ha2 : a = ⊤,
  { simp [ha2, univ_subset_iff] },
  by_cases hb1 : b = ⊥,
  { simp [hb1, subset_empty_iff] },
  by_cases hb2 : b = ⊤,
  { simp [hb2] },
  { simp [left_ray_def],
    let r := a.to_real,
    let s := b.to_real,
    rw ←coe_to_real ha2 ha1 at *,
    rw ←coe_to_real hb2 hb1 at *,
    simp,
    exact forall_lt_iff_le },
end

@[simp]
lemma left_ray_inter (a b : ereal) :
  left_ray a ∩ left_ray b = left_ray (min a b) :=
begin
  by_cases a ≤ b,
  {
    rw min_eq_left h,
    apply inter_eq_self_of_subset_left,
    simp [h],
  },
  {
    push_neg at h,
    replace h := le_of_lt h,
    rw min_eq_right h,
    apply inter_eq_self_of_subset_right,
    simp [h],
  }
end

lemma union_of_intervals {α : set ℝ} (hne : α.nonempty) (hbd : bdd_above α) :
  (⋃ a ∈ α, Iio a) = Iio (Sup α) :=
begin
  simp only [←Iio_def],
  ext,
  simp only [exists_prop, mem_Union, mem_set_of_eq],
  exact ⟨λ ⟨y,⟨hy1, hy2⟩⟩, lt_cSup_of_lt hbd hy1 hy2,
  λ h, bex_def.mp (exists_lt_of_lt_cSup hne h)⟩
end

lemma bUnion_left_ray {α : set ereal} :
  (⋃ a ∈ α, left_ray a) = left_ray (Sup α) :=
begin
  apply eq_of_subset_of_subset,
  {
    apply bUnion_subset,
    exact λ _ hx, by simp [le_Sup hx],
  },
  {
    intros x hx,
    rw mem_bUnion_iff,
    have hx' : (x : ereal) < Sup α, by simpa using hx,
    obtain ⟨y, hy⟩ := lt_Sup_iff.1 hx',
    exact ⟨y, by simp [hy]⟩,
  }
end

def left_ray_topology : topological_space ℝ := {
  is_open := left_ray '' univ,
  univ_mem := ⟨⊤, by tauto⟩,
  union :=
  begin
    intros Y hY,
    use Sup (left_ray⁻¹' Y),
    simp [←bUnion_left_ray, sUnion_eq_bUnion],
    ext1,
    simp,
    split,
    { rintro ⟨a, ha⟩,
      exact ⟨left_ray a, by simp [ha]⟩ },
    {
      rintro ⟨B, hB⟩,
      obtain ⟨i, ⟨hi1, hi2⟩⟩ := hY B hB.1,
      use i,
      rw [←left_ray_mem, hi2],
      exact hB,
    }
  end,
  inter :=
  begin
    rintros A B ⟨a, _, haA⟩ ⟨b, _, hbB⟩,
    subst haA, subst hbB,
    exact ⟨min a b, by simp⟩,
  end
}

/-
Define the family of intervals of the form [a, b)
-/
def Icos := {B : set ℝ | ∃ a b : ℝ, B = Ico a b }

lemma mem_Icos {a b : ℝ} : Ico a b ∈ Icos :=  ⟨a, ⟨b, rfl⟩⟩

example : basis_condition Icos :=
begin
  split,
  {
    intros x,
    use Ico x (x+1),
    split; simp [mem_Icos, zero_lt_one],
  },
  {
    intros U V hU hV x,
    rcases hU with ⟨Ua, ⟨Ub , Uab_h⟩⟩,
    rcases hV with ⟨Va, ⟨Vb , Vab_h⟩⟩,
    subst Uab_h, subst Vab_h,
    intro hx,
    use Ico (max Ua Va) (min Ub Vb),
    split,
    { simp [mem_Icos], },
    split,
    {
      simp [mem_Ico] at hx,
      simp [hx],
    },
    {
      unfold Ico,
      norm_num,
      split;
      { intros,
        simp * },
    },
  },
end

--finset, set.finite, fintype

def three_point_topology_0 : topological_space (fin 3) := generate_from ∅

def three_point_topology_1 : topological_space (fin 3) := generate_from {{0}, {0,1}, {0,2}}

def three_point_topology_2 : topological_space (fin 3) := generate_from {{1}, {2}, {3}}

def three_point_topology_3 (n : ℕ) [has_one (fin n)] : topological_space (fin n) :=
  generate_from {{1}, {2,3}}

/-- A topology where all opens are around a given point x -/
def distinguished_point_topology {X : Type} (x : X) : topological_space X := {
  is_open := λ (A : set X), A = ∅ ∨ x ∈ A,
  univ_mem := by tauto,
  union :=
  begin
    intros 𝒴 h,
    by_cases H : ∃ A ∈ 𝒴, A ≠ ∅,
    { right,
      obtain ⟨A, ⟨hA1, hA2⟩⟩ := H,
      use A,
      split,
      { assumption },
      specialize h A hA1,
      tauto },
    { push_neg at H,
      left,
      exact sUnion_eq_empty.mpr H }
  end,
  inter :=
  begin
    intros A B hA hB,
    cases hA,
    {
      left,
      subst hA,
      exact empty_inter B,
    },
    {
      cases hB,
      {
        left,
        subst hB,
        exact inter_empty A,
      },
      {
        right,
        exact mem_inter hA hB,
      }
    }
  end }

namespace Moebius
open topological_space
def Ioos := {B : set ℝ | ∃ a b : ℝ, B = Ico a b }

instance ordinary_topology: topological_space ℝ := generate_from Ioos

instance open_interval(a b: ℝ): topological_space (Ioo a b) := top_induced (Ioo a b) ℝ (λ x, ↑x)

/-- Kuratowski's problem -/
example {X : Type} [topological_space X] (A : set X) : closure (interior (closure( interior A))) = closure (interior A) :=
begin
  apply subset.antisymm,
  { apply subset_closed_inclusion_closure' (closure_is_closed (interior A)),
    apply interior_subset_self (closure (interior A)) },
  { apply subset_closed_inclusion_closure'  (closure_is_closed (interior (closure (interior A)))),
    suffices : interior A ⊆ interior (closure (interior A)),
      by exact subset.trans this (closure_supset_self (interior (closure (interior A)))),
    have H : interior A ⊆ closure (interior A) := closure_supset_self (interior A),
    apply interior_maximal,
    { exact interior_is_open A },
    { exact H } }
end

lemma aux_in_interval (x : ℝ) : x / (1 + abs x) ∈ Ioo (-1 : ℝ) 1 :=
begin
  have h1: 0 < 1 + abs x := by linarith [abs_nonneg x],
  split;
  {
    simp [lt_div_iff h1, div_lt_iff h1],
    linarith [abs_add_nonneg x, le_abs_self x],
  }
end

example : (Ioo (- 1: ℝ) 1) ≅ ℝ :=
{ to_fun := (λ x, ↑x / (1- abs(↑x))),
  inv_fun := λ x, ⟨x / (1 + abs x), aux_in_interval x⟩,
  left_inv :=
  begin
    rintro ⟨x, hx⟩,
    have h : 1 - abs x ≠ 0,
    {
      unfold Ioo at hx,
      simp at hx,
      by_cases habs : 0 ≤ x,
      {
        simp [abs_eq_self.2 habs],
        linarith
      },
      {
        push_neg at habs,
        replace habs := le_of_lt habs,
        rw abs_of_nonpos habs,
        linarith,
      }
    },
    simp,
    by_cases H : 0 ≤ x,
    {
      rw abs_eq_self.2 H,
      have hh : 0 < 1 -x, by linarith [hx.2],
      have : 1 -x ≠ 0, by linarith,
      rw abs_eq_self.2 (div_nonneg H (le_of_lt hh)),
      field_simp,
    },
    {
      push_neg at H,
      rw abs_of_neg H,
      norm_num,
      have hh: 0 < 1 + x, by linarith [hx.1],
      have hh' : 1 + x ≠ 0 := ne_of_gt hh,
      have h' : x / (1+x) < 0,
      {
        apply div_neg_iff.2,
        tauto,
      },
      rw abs_of_neg h',
      norm_num,
      field_simp,
    },
  end,
  right_inv :=
  begin
    intro x,
    simp,
    by_cases 0 ≤ x,
    {
      rw abs_eq_self.mpr h,
      have : 0 < 1+x,
      {
        calc 0 < 1 : zero_lt_one
        ... ≤ 1 + x : le_add_of_nonneg_right h
      },
      have h' : 0 ≤ x / (1+x),
      {
        have h'' : 0 ≤ 1 + x :=le_of_lt this,
        rw div_nonneg_iff,
        left,
        split; assumption,
      },
      rw abs_eq_self.mpr h',
      have : 1+x ≠ 0 := ne_of_gt this,
      field_simp,
    },
    {
      by_cases hz : x = 0, by simp [hz],
      have hx : x < 0 := not_le.mp h,
      rw abs_eq_neg_self.mpr (le_of_lt hx),
      ring_nf,
      have : 0 < 1 - x, by linarith,
      have h' : x / (1-x) < 0,
      {
        rw div_neg_iff,
        right,
        split; assumption,
      },
      rw abs_eq_neg_self.mpr (le_of_lt h'),
      have : 1-x ≠ 0 := ne_of_gt this,
      field_simp,
    }
  end,
  continuous_to_fun := sorry,
  continuous_inv_fun := sorry }

/-- Square [0,1] × [0,1] used to construct quotients. -/
def unit_square := (((Icc (0: ℝ) 1): Type) × (Icc (0: ℝ) 1))
instance :has_lift_t unit_square (ℝ × ℝ) :=
begin
  fconstructor,
  rintros ⟨x, y⟩,
  exact ⟨x, y⟩,
end
instance open_square: topological_space unit_square  :=
  top_induced unit_square (ℝ × ℝ) (λ x, ↑x)

/-- The Möbius strip, defined as a quotient of [0,1) × [0,1) -/
instance Moebius_quot: topological_space (((Icc (0: ℝ) 1): Type) × (Ico (0: ℝ) 1)) :=
begin
  apply top_quotient unit_square (( (Icc (0:ℝ) 1) :  Type) × (Ico (0:ℝ) 1)) _,
  intro xy,
  cases xy with x y,
  by_cases h: y.1 = (1: ℝ),{
    split,
    { use 1-x,
      cases x,
      norm_num,
      finish },
    { use 0,
      norm_num },
  },
  {
    split,
    { use x },
    cases y with y hy,
    use y,
    cases hy,
    norm_num at h;
    split,
    {
      linarith,
    },
    exact (ne.le_iff_lt h).mp hy_right,
  },
end

/-- The torus, defined as a quotient in [0,1) × [0,1) -/
def torus: topological_space (((Ico (0: ℝ) 1): Type) × (Ico (0: ℝ) 1)) :=
begin
  apply top_quotient (ℝ × ℝ)  (( (Ico (0:ℝ) 1) :  Type) × (Ico (0:ℝ) 1)) _,
  intro xy,
  cases xy with x y,
  split,
  use fract x,
  exact ⟨fract_nonneg _,fract_lt_one _⟩,
  use fract y,
  exact ⟨fract_nonneg _,fract_lt_one _⟩,
end

notation `ℝ³` := ℝ × ℝ × ℝ
open real

/- No se com importar sin i cos...

def φ(u v: ℝ) : ℝ³ := ⟨(1+v*cos (u/2))*cos v, ⟨(1+v*cos (u/2))*sin u, v*sin(u/2)⟩⟩

def Moebius :=  {x: ℝ³ // ∃ u v : ℝ, x = φ u v}
-- Es pot fer d'aluna manera semblant a això?
-- def Moebius' := φ '' univ
-- #check Moebius'

instance Moebius.lift : has_lift_t Moebius ℝ³:=
begin
  fconstructor,
  rintros ⟨x, hx⟩,
  exact x,
end

/-- Möbius stip as a subspace of ℝ³ -/
instance Moebius_sub: topological_space Moebius :=
   top_induced Moebius ℝ³ (λ x, ↑x)

lemma Moebius_equivalent: (((Icc (0: ℝ) 1): Type) × (Ico (0: ℝ) 1))  ≅ Moebius :=
{ to_fun :=
  begin
    rintros ⟨⟨u, hu⟩, ⟨v, hv⟩⟩,
    sorry,
  end,
  inv_fun :=
  begin
    rintros ⟨⟨x, y,z⟩, hxyz⟩,
    sorry,
  end,
  left_inv := sorry,
  right_inv := sorry,
  continuous_to_fun := sorry,
  continuous_inv_fun := sorry }
-/

end Moebius


import tactic
-- import order (netreba)

universe u

class modular_lattice(α : Type u) extends lattice α :=
  (modular_law: ∀ (x u v : α ), (x ≤ u) → u ⊓ (v ⊔ x) = (u ⊓ v) ⊔ x )

theorem modular_lattice_isomorphism { α: Type u } [ modular_lattice α ] { u v w x y : α}:
  x ≤ u →
  x ≥ v →
  x ≥ u ⊓ v →
  x ≤ u ⊔ v →
  u ⊓ ( v ⊔ x ) = x ∧ (u ⊓ x) ⊔ v = x
  :=
  begin
    intros h1 h2 h3 h4,
    split,
    {
      rw modular_lattice.modular_law,
      exact sup_eq_right.mpr h3,
      exact h1
    },
    {
      rw inf_comm,
      rw ← modular_lattice.modular_law,
      exact inf_eq_left.mpr h4,
      exact h2
    }
  end


import data.nat.factorization.basic
import algebra.group.basic
import data.nat.basic
import data.nat.prime
import tactic

lemma add_cancel_thing (n m k : ℕ ) : n + m = n + k → m = k :=
begin
  refine nat.add_left_cancel,
end

lemma inequality_thing (a : ℕ ) (ha : a ≥ 2) : 2*a^2 + 1 ≥ (a + 1)^2 :=
begin
  have h1 : a^2 + 2*a + 1 = (a + 1)^2,
  {
    ring_nf,
  },
  have h2 : a^2 ≥ 2*a,
  {
    simp,
    have h3 := nat.mul_le_mul_right a ha,
    ring_nf at h3,
    refine h3,
  },
  have h3 : a^2 + a^2 = 2*a^2,
  {
    ring_nf,
  },
  rw ← h3,
  rw ← h1,
  have h4 := nat.add_le_add_left h2 (a^2),
  have h5 := nat.add_le_add_right h4 1,
  simp,
  refine h2,
end

lemma a_dvd_b_2 (a b : ℕ ) (hd : a ∣ b^3) (hcfree : ∀ (p : ℕ) , p.prime → p ∣ a → ¬ (p^3 ∣ a)) (hap : a > 0) (hbp : b > 0):
  a ∣ b^2 :=
begin
  have hdb : ∀ (p : ℕ) , p.prime → p ∣ b → p^2 ∣ b^2,
  {
    rintro p,
    rintro hp,
    rintro hd,
    cases hd with k key,
    use k^2,
    rw key,
    ring_nf,
  },
  cases nat.dvd_iff_prime_pow_dvd_dvd (b^2) a with h1 h2,
  apply h2,
  rintro p k,
  rintro hp,
  rintro hpka,
  have hane0 : a ≠ 0,
  {
    linarith,
  },
  have hbne0 : b^2 ≠ 0,
  {
    have h1 := nat.one_le_pow 2 b hbp,
    linarith,
  },
  have hle2 : k ≤ 2,
  {
    by_cases hk : k ≥ 1,
    {
      have hc := hcfree(p),
      have hc1 := hc hp,
      have hpa := nat.dvd_of_pow_dvd hk hpka,
      have hc2 := hc1 hpa,
      by_contradiction,
      have hk3 : k ≥ 3,
      {
        linarith,
      },
      have hp3 : 3 ≤ a.factorization p,
      {
        cases nat.prime.pow_dvd_iff_le_factorization hp hane0 with h3 h4,
        have h5 := h3 hpka,
        linarith,
      },
      have hp3a : p^3 ∣ a,
      {
        cases nat.prime.pow_dvd_iff_le_factorization hp hane0 with h3 h4,
        refine h4 hp3,
      },
      have hf := hc2 hp3a,
      refine false.elim hf,
    },
    {
      linarith,
    },
  },
  by_cases hk : k > 0,
  {
    have hva : 1 ≤ a.factorization p,
    {
      cases nat.prime.pow_dvd_iff_le_factorization hp hane0 with h3 h4,
      have h5 := h3 hpka,
      linarith,
    },
    have ha : p^1 ∣ a,
    {
      cases nat.prime.pow_dvd_iff_le_factorization hp hane0 with h3 h4,
      have h5 := h4 hva,
      refine h5,
    },
    have hb : p ∣ b,
    {
      cases nat.dvd_iff_prime_pow_dvd_dvd (b^3) a with h3 h4,
      have h5 := h3 hd,
      have h5p := h5 p 1,
      have h6 := h5p hp,
      have h7 := h6 ha,
      have hpexp : p^1 = p,
      {
        simp,
      },
      rw hpexp at h7,
      have h8 := nat.prime.dvd_of_dvd_pow hp h7,
      refine h8,
    },
    have hdp := hdb(p),
    have h1 := hdp hp,
    have h2 := h1 hb,
    have hvpkb : k ≤ (b^2).factorization p,
    {
      cases nat.prime.pow_dvd_iff_le_factorization hp hbne0 with h3 h4,
      have h5 := h3 h2,
      linarith,
    },
    cases nat.prime.pow_dvd_iff_le_factorization hp hbne0 with h6 h7,
    refine h7 hvpkb,
  },
  {
    have hk : k = 0,
    {
      linarith,
    },
    have hp1 : p^k = 1,
    {
      rw hk,
      simp,
    },
    rw hp1,
    norm_num,
  },
end

theorem ISL_2021_N1 (a b n : ℕ) (hap : a > 0) (hbp : b > 0) (hnp : n > 0)
  (hcfree : ∀ (p : ℕ) , p.prime → ¬ (p^3 ∣ a^2 + b + 3))
    (hn : n * (a^2 + b + 3) = a*b + 3*b + 8) : n = 2 :=
begin

have hd1 : a^2+b+3 ∣ a*b+3*b+8,
use n,
rw ← hn,
rw mul_comm n (a^2+b+3),
have hd2 : a^2+b+3 ∣ (a+3)*(a^2+b+3),
use a + 3,
rw mul_comm,
have hexpand : (a + 3) * (a^2  + b + 3) = a^3 + a*b + 3*a + 3 * a^2 + 3 * b + 9,
{
  ring_nf,
},
have h1 : a^3 + a*b + 3*a + 3*a^2 + 3*b + 9 = (a*b + 3*b + 8) + a^3 + 3*a^2 + 3*a + 1,
{
  ring_nf,
},
have h2 : a*b + 3*b + 8 + (a^3 + 3*a^2 + 3*a + 1) - (a*b + 3*b + 8) = a^3 + 3*a^2 + 3*a + 1,
{
  refine nat.add_sub_cancel_left (a*b + 3*b + 8) (a^3 + 3*a^2 + 3*a + 1),
},
have h3 : a*b + 3*b + 8 + a^3 + 3*a^2 + 3*a + 1 - (a*b + 3*b + 8) = a*b + 3*b + 8 + (a^3 + 3*a^2 + 3*a + 1) - (a*b + 3*b + 8),
{
  ring_nf,
},
have hdcube : (a + 3) * (a^2 + b + 3) - (a*b + 3*b + 8) = a^3 + 3*a^2 + 3*a + 1,
{
  rw hexpand,
  rw h1,
  rw ← h3 at h2,
  rw h2,
},
have hsimpcube : a^3 + 3*a^2 + 3*a + 1 = (a + 1)^3,
{
  ring_nf,
},
have hcube : (a + 3) * (a^2 + b + 3) - (a*b + 3*b + 8) = (a + 1)^3,
{
  rw hdcube,
  rw hsimpcube,
},
have hineq : a*b + 3*b + 8 ≤ (a + 3) * (a^2 + b + 3),
{
  linarith,
},
have hd3 : a^2 + b + 3 ∣ (a + 1)^3,
{
  have h3 := nat.dvd_sub hineq,
  have h4 := h3 hd2,
  have h5 := h4 hd1,
  rw hcube at h5,
  refine h5,
},
have ha2 : a^2 > 0,
{
  refine nat.one_le_pow 2 a hap,
},
have hp1 : a^2 + b + 3 > 0,
{
  linarith,
},
have hp2 : a + 1 > 0,
{
  linarith,
},
have hdsquare := a_dvd_b_2 (a^2 + b + 3) (a + 1) hd3 hcfree hp1 hp2,
cases hdsquare with c hc,
have hc1 : c = 1,
{
  by_contradiction,
  by_cases hc0 : c = 0,
  {
    rw hc0 at hc,
    linarith,
  },
  {
    have hcge2: c ≥ 2,
    {
      cases nat.one_lt_iff_ne_zero_and_ne_one with h3 h4,
      have h5 := h4 ⟨hc0, h⟩,
      linarith,
    },
    have hc2 : (a + 1)^2 ≥ 2 * (a^2 + b + 3),
    {
      rw hc,
      have hr := nat.mul_le_mul_right (a^2 + b + 3) hcge2,
      linarith,
    },
    have hc3 : 2 * a^2 + 6 < 2 * (a^2 + b + 3),
    {
      linarith,
    },
    have hc4 : 2*a^2 + 6 > (a + 1)^2,
    {
      by_cases ha1 : a = 1,
      {
        linarith,
      },
      {
        have hage2 : a ≥ 2,
        {
          linarith,
        },
        have hi := inequality_thing a hage2,
        linarith,
      },
    },
    have hc5 : 2*(a^2 + b + 3) > (a + 1)^2,
    {
      linarith,
    },
    have hc6 : ¬ (a + 1)^2 ≥ 2*(a^2 + b + 3),
    {
      linarith,
    },
    have hc7 := hc6 hc2,
    refine false.elim hc7,
  },

},
have ha : a^2 + 2*a + 1 = (a + 1)^2,
{
  ring_nf,
},
rw hc1 at hc,
rw ← ha at hc,
simp at hc,
have hb1 := add_cancel_thing (a^2) (2*a + 1) (b + 3) hc,
have haineq : 3 ≤ 2*a + 1,
{
  linarith,
},
cases nat.sub_eq_iff_eq_add haineq with hsub hadd,
have hb2 := hadd hb1,
simp at hb2,
rw ha at hc,
rw ← hc at hn,
rw ← hb2 at hn,
have ha4 : 2*a - 2 = 2*(a - 1),
{
  linarith,
},
have h248 : 2*4 = 8,
{
  norm_num,
},
have ha3 : a*(2*a - 2) + 3*(2*a - 2) + 8 = 2*(a + 1)^2,
{
  rw ← nat.right_distrib a 3 (2*a - 2),
  rw mul_comm,
  rw ha4,
  rw ← h248,
  rw mul_assoc,
  rw ← nat.left_distrib 2 ((a - 1)*(a + 3)) 4,
  have ha5 : (a - 1)*(a + 3) = a^2 + 2*a - 3,
  {
    rw nat.left_distrib (a - 1) a 3,
    rw nat.mul_sub_right_distrib a 1 a,
    rw nat.mul_sub_right_distrib a 1 3,
    simp,
    rw ← sq,
    have ha6 : a^2 - a + (a*3 - 3) = a^2 + 2*a - 3,
    {
      have hi1 : 3 ≤ a*3,
      {
        linarith,
      },
      have hi2 : a ≤ a^2,
      {
        have hi3 := nat.le_mul_self a,
        rw ← sq at hi3,
        refine hi3,
      },
      rw ← nat.add_sub_assoc hi1 (a^2 - a),
      have ha7 : a^2 - a + a*3 - 3 = a^2 + 2*a - 3,
      {
        rw mul_comm,
        have ha8 : a^2 - a + 3*a = a^2 + 2*a,
        {
          rw ← nat.sub_add_comm hi2,
          ring_nf,
          have ha9 := nat.mul_pred_left (a + 3) a,
          rw ← ha9,
          rw nat.pred_eq_sub_one,
          simp,
        },
        rw ha8,
      },
      rw ha7,
    },
    rw ha6,
  },
  rw ha5,
  simp,
  have ha10 : a^2 + 2*a - 3 + 4 = a^2 + 2*a + 1,
  {
    have ha11 : 3 ≤ 2*a,
    {
      linarith,
    },
    have ha12 : 2*a - 3 + 4 = 2*a + 1,
    {
      rw ← nat.sub_add_comm ha11,
      simp,
    },
    cases add_right_inj (a^2) with ha13 ha14,
    have ha15 := ha14 ha12,
    rw ← add_assoc at ha15,
    rw ← nat.add_sub_assoc ha11 (a^2) at ha15,
    refine ha15,
  },
  rw ha10,
  rw ha,
},
rw ha3 at hn,
have ha1p : 0 < (a + 1)^2,
{
  refine nat.one_le_pow 2 (a + 1) hp2,
},
cases nat.mul_left_inj ha1p with h24 h25,
refine h24 hn,
end


namespace Ex1

def f (n : Nat) : Option { r : Nat // r ≤ n } :=
  match n with
  | 0   => some ⟨0, Nat.le_refl _⟩
  | n+1 => match f n with
    | some ⟨m, h₁⟩ =>
      have : m < n+1 := Nat.lt_of_le_of_lt h₁ (Nat.lt_succ_self _)
      match f m with
      | some ⟨r, h₂⟩ => some ⟨r, Nat.le_trans h₂ (Nat.le_trans h₁ (Nat.le_succ _))⟩
      | none => none
    | none => none

end Ex1

namespace Ex2

def f (n : Nat) : Option { r : Nat // r ≤ n } :=
  if h : n = 0 then
    some ⟨0, h ▸ Nat.le_refl _⟩
  else
    match f (n-1) with
    | some ⟨m, h₁⟩ =>
      have : m < n := Nat.lt_of_le_of_lt h₁ (Nat.pred_lt h)
      match f m with
      | some ⟨r, h₂⟩ => some ⟨r, Nat.le_trans h₂ (Nat.le_trans h₁ (Nat.pred_le _))⟩
      | none => none
    | none => none

end Ex2

namespace Ex3

def f' (n : Nat) : Option { r : Nat // r ≤ n } :=
  match n with
  | 0   => some ⟨0, Nat.le_refl _⟩
  | n+1 => match f' n with
    | some ⟨m, h₁⟩ =>
      have : m < n+1 := Nat.lt_of_le_of_lt h₁ (Nat.lt_succ_self _)
      match f' m with
      | some ⟨r, h₂⟩ => some ⟨r, Nat.le_trans h₂ (Nat.le_trans h₁ (Nat.le_succ _))⟩
      | none => none
    | none => none

theorem f'_ne_none (n : Nat) : f' n ≠ none := by
  match n with
  | 0   => simp [f']
  | n+1 =>
    simp [f']
    have ih₁ := f'_ne_none n
    split
    next m h₁ he =>
      have : m < n+1 := Nat.lt_of_le_of_lt h₁ (Nat.lt_succ_self _)
      have ih₂ := f'_ne_none m
      split
      next => simp
      next h => contradiction
    next => contradiction

def f (n : Nat) : Option Nat :=
  match f' n with
  | some r => some r.1
  | none => none

theorem f_eq (n : Nat) :
        f n = match n with
          | 0 => some 0
          | n => match f (n - 1) with
            | some m => f m
            | none => none := by
  unfold f
  split
  next r h =>
    revert h
    split <;> simp [f']
    next => intro h; subst h; simp
    next hne =>
      cases n <;> simp [f']
      next => contradiction
      next n _ =>
       have : Nat.succ n - 1 = n := rfl
       rw [this]
       split <;> simp
       next r hrn h₁ =>
         split <;> simp
         next => intro he; subst he; simp [*]
  next h_eq_none =>
    have hne := f'_ne_none n
    contradiction

end Ex3


import analysis.specific_limits

open set finset filter
open_locale big_operators topological_space

noncomputable theory

def series (u : ℕ → ℝ) := λ n, (∑ i in range n, u i)

def converges {α : Type*} [topological_space α] (u : ℕ → α) := ∃ l, tendsto u at_top (𝓝 l)

lemma tendsto_geom_series_at_top_of_nonneg_of_lt_one (r : ℝ) (hr₀ : 0 ≤ r) (hr₁ : r < 1) :
  tendsto (geom_series r) at_top (𝓝 $ 1/(1-r)) :=
begin
  rw tendsto_congr (geom_sum hr₁.ne),
  conv in (𝓝 _) {congr, rw [← neg_div_neg_eq, neg_sub, ← zero_sub]},
  exact ((tendsto_pow_at_top_nhds_0_of_lt_1 hr₀ hr₁).sub tendsto_const_nhds).div_const
end

lemma tendsto_geom_series_at_top_of_one_le (r : ℝ) (hr : 1 ≤ r) :
  tendsto (geom_series r) at_top at_top :=
begin
  by_cases h : r = 1,
  { rw h,
     },
  { have : 1 < r,
    { change _ ≠ _ at h,
      linarith [lt_of_le_of_ne hr h.symm] },
    rw [tendsto_congr (geom_sum h), sub_eq_add_neg],
    refine tendsto_at_top_div (by rwa [← sub_eq_add_neg, sub_pos])
      (tendsto_at_top_add_const_right _ _ $ tendsto_pow_at_top_at_top_of_one_lt this) }
end

lemma converges_geom_series_iff_of_nonneg (r : ℝ) (hr : 0 < r) :
  converges (geom_series r) ↔ r < 1 :=
begin

end


/-
Copyright (c) 2021 Arthur Paulino. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Arthur Paulino, Kyle Miller
-/

import combinatorics.simple_graph.subgraph
import data.nat.lattice
import data.setoid.partition
import order.antichain

/-!
# Graph Coloring

This module defines colorings of simple graphs (also known as proper
colorings in the literature). A graph coloring is the attribution of
"colors" to all of its vertices such that adjacent vertices have
different colors. A coloring can be represented as a homomorphism into
a complete graph, whose vertices represent the colors.

## Main definitions

* `G.coloring α` is the type of `α`-colorings of a simple graph `G`,
  with `α` being the set of available colors. The type is defined to
  be homomorphisms from `G` into the complete graph on `α`, and
  colorings have a coercion to `V → α`.

* `G.colorable n` is the proposition that `G` is `n`-colorable, which
  is whether there exists a coloring with at most *n* colors.

* `G.chromatic_number` is the minimal `n` such that `G` is
  `n`-colorable, or `0` if it cannot be colored with finitely many
  colors.

* `C.color_class c` is the set of vertices colored by `c : α` in the
  coloring `C : G.coloring α`.

* `C.color_classes` is the set containing all color classes.

## Todo:

  * Gather material from:
    * https://github.com/leanprover-community/mathlib/blob/simple_graph_matching/src/combinatorics/simple_graph/coloring.lean
    * https://github.com/kmill/lean-graphcoloring/blob/master/src/graph.lean

  * Lowerbound for cliques

  * Trees

  * Planar graphs

  * Chromatic polynomials

  * develop API for partial colorings, likely as colorings of subgraphs (`H.coe.coloring α`)
-/

universes u v

namespace simple_graph
variables {V : Type u} (G : simple_graph V)

/--
An `α`-coloring of a simple graph `G` is a homomorphism of `G` into the complete graph on `α`.
This is also known as a proper coloring.
-/
abbreviation coloring (α : Type v) := G →g (⊤ : simple_graph α)

variables {G} {α : Type v} (C : G.coloring α)

lemma coloring.valid {v w : V} (h : G.adj v w) : C v ≠ C w :=
C.map_rel h

/--
Construct a term of `simple_graph.coloring` using a function that
assigns vertices to colors and a proof that it is as proper coloring.

(Note: this is a definitionally the constructor for `simple_graph.hom`,
but with a syntactically better proper coloring hypothesis.)
-/
@[pattern] def coloring.mk
  (color : V → α)
  (valid : ∀ {v w : V}, G.adj v w → color v ≠ color w) :
  G.coloring α := ⟨color, @valid⟩

/--
The color class of a given color.
-/
def coloring.color_class (c : α) : set V := {v : V | C v = c}

/-- The set containing all color classes. -/
def coloring.color_classes : set (set V) := (setoid.ker C).classes

lemma coloring.mem_color_class (v : V) :
  v ∈ C.color_class (C v) := by exact rfl

lemma coloring.color_classes_is_partition :
  setoid.is_partition C.color_classes :=
setoid.is_partition_classes (setoid.ker C)

lemma coloring.mem_color_classes {v : V} : C.color_class (C v) ∈ C.color_classes :=
⟨v, rfl⟩

lemma coloring.color_classes_finite_of_fintype [fintype α] : C.color_classes.finite :=
by { rw set.finite_def, apply setoid.nonempty_fintype_classes_ker, }

lemma coloring.card_color_classes_le [fintype α] [fintype C.color_classes] :
  fintype.card C.color_classes ≤ fintype.card α :=
setoid.card_classes_ker_le C

lemma coloring.not_adj_of_mem_color_class {c : α} {v w : V}
  (hv : v ∈ C.color_class c) (hw : w ∈ C.color_class c) :
  ¬G.adj v w :=
λ h, C.valid h (eq.trans hv (eq.symm hw))

lemma coloring.color_classes_independent (c : α) :
  is_antichain G.adj (C.color_class c) :=
λ v hv w hw h, C.not_adj_of_mem_color_class hv hw

-- TODO make this computable
noncomputable
instance [fintype V] [fintype α] : fintype (coloring G α) :=
begin
  classical,
  change fintype (rel_hom G.adj (⊤ : simple_graph α).adj),
  apply fintype.of_injective _ rel_hom.coe_fn_injective,
  apply_instance,
end

variables (G)

/-- Whether a graph can be colored by at most `n` colors. -/
def colorable (n : ℕ) : Prop := nonempty (G.coloring (fin n))

/-- The coloring of an empty graph. -/
def coloring_of_is_empty [is_empty V] : G.coloring α :=
coloring.mk is_empty_elim (λ v, is_empty_elim)

lemma colorable_of_is_empty [is_empty V] (n : ℕ) : G.colorable n :=
⟨G.coloring_of_is_empty⟩

lemma is_empty_of_colorable_zero (h : G.colorable 0) : is_empty V :=
begin
  split,
  intro v,
  obtain ⟨i, hi⟩ := h.some v,
  exact nat.not_lt_zero _ hi,
end

/-- The "tautological" coloring of a graph, using the vertices of the graph as colors. -/
def self_coloring : G.coloring V :=
coloring.mk id (λ v w, G.ne_of_adj)

/-- The chromatic number of a graph is the minimal number of colors needed to color it.
If `G` isn't colorable with finitely many colors, this will be 0. -/
noncomputable def chromatic_number : ℕ :=
Inf { n : ℕ | G.colorable n }

/-- Given an embedding, there is an induced embedding of colorings. -/
def recolor_of_embedding {α β : Type*} (f : α ↪ β) : G.coloring α ↪ G.coloring β :=
{ to_fun := λ C, (embedding.complete_graph.of_embedding f).to_hom.comp C,
  inj' := begin -- this was strangely painful; seems like missing lemmas about embeddings
    intros C C' h,
    dsimp only at h,
    ext v,
    apply (embedding.complete_graph.of_embedding f).inj',
    change ((embedding.complete_graph.of_embedding f).to_hom.comp C) v = _,
    rw h,
    refl,
  end }

/-- Given an equivalence, there is an induced equivalence between colorings. -/
def recolor_of_equiv {α β : Type*} (f : α ≃ β) : G.coloring α ≃ G.coloring β :=
{ to_fun := G.recolor_of_embedding f.to_embedding,
  inv_fun := G.recolor_of_embedding f.symm.to_embedding,
  left_inv := λ C, by { ext v, apply equiv.symm_apply_apply },
  right_inv := λ C, by { ext v, apply equiv.apply_symm_apply } }

/-- There is a noncomputable embedding of `α`-colorings to `β`-colorings if
`β` has at least as large a cardinality as `α`. -/
noncomputable def recolor_of_card_le {α β : Type*} [fintype α] [fintype β]
  (hn : fintype.card α ≤ fintype.card β) :
  G.coloring α ↪ G.coloring β :=
G.recolor_of_embedding $ (function.embedding.nonempty_of_card_le hn).some

variables {G}

lemma colorable.of_le {n m : ℕ} (hc : G.colorable n) (h : n ≤ m) : G.colorable m :=
⟨G.recolor_of_card_le (by simp [h]) hc.some⟩

lemma coloring.to_colorable [fintype α] (C : G.coloring α) :
  G.colorable (fintype.card α) :=
⟨G.recolor_of_card_le (by simp) C⟩

lemma colorable_of_fintype (G : simple_graph V) [fintype V] :
  G.colorable (fintype.card V) :=
G.self_coloring.to_colorable

/-- Noncomputably get a coloring from colorability. -/
noncomputable def colorable.to_coloring [fintype α] {n : ℕ} (hc : G.colorable n)
  (hn : n ≤ fintype.card α) :
  G.coloring α :=
begin
  rw ←fintype.card_fin n at hn,
  exact G.recolor_of_card_le hn hc.some,
end

lemma colorable_iff_exists_bdd_nat_coloring (n : ℕ) :
  G.colorable n ↔ ∃ (C : G.coloring ℕ), ∀ v, C v < n :=
begin
  split,
  { rintro hc,
    have C : G.coloring (fin n) := hc.to_coloring (by simp),
    let f := embedding.complete_graph.of_embedding (fin.coe_embedding n).to_embedding,
    use f.to_hom.comp C,
    intro v,
    cases C with color valid,
    exact fin.is_lt (color v), },
  { rintro ⟨C, Cf⟩,
    refine ⟨coloring.mk _ _⟩,
    { exact λ v, ⟨C v, Cf v⟩, },
    { rintro v w hvw,
      simp only [complete_graph_eq_top, top_adj, subtype.mk_eq_mk, ne.def],
      exact C.valid hvw, } }
end

lemma colorable_set_nonempty_of_colorable {n : ℕ} (hc : G.colorable n) :
  {n : ℕ | G.colorable n}.nonempty :=
⟨n, hc⟩

lemma chromatic_number_bdd_below : bdd_below {n : ℕ | G.colorable n} :=
⟨0, λ _ _, zero_le _⟩

lemma chromatic_number_le_of_colorable {n : ℕ} (hc : G.colorable n) :
  G.chromatic_number ≤ n :=
begin
  rw chromatic_number,
  apply cInf_le chromatic_number_bdd_below,
  fsplit,
  exact classical.choice hc,
end

lemma chromatic_number_le_card [fintype α] (C : G.coloring α) :
  G.chromatic_number ≤ fintype.card α :=
cInf_le chromatic_number_bdd_below C.to_colorable

lemma colorable_chromatic_number {m : ℕ} (hc : G.colorable m) :
  G.colorable G.chromatic_number :=
begin
  dsimp only [chromatic_number],
  rw nat.Inf_def,
  apply nat.find_spec,
  exact colorable_set_nonempty_of_colorable hc,
end

lemma colorable_chromatic_number_of_fintype (G : simple_graph V) [fintype V] :
  G.colorable G.chromatic_number :=
colorable_chromatic_number G.colorable_of_fintype

lemma chromatic_number_le_one_of_subsingleton (G : simple_graph V) [subsingleton V] :
  G.chromatic_number ≤ 1 :=
begin
  rw chromatic_number,
  apply cInf_le chromatic_number_bdd_below,
  fsplit,
  refine coloring.mk (λ _, 0) _,
  intros v w,
  rw subsingleton.elim v w,
  simp,
end

lemma chromatic_number_eq_zero_of_isempty (G : simple_graph V) [is_empty V] :
  G.chromatic_number = 0 :=
begin
  rw ←nonpos_iff_eq_zero,
  apply cInf_le chromatic_number_bdd_below,
  apply colorable_of_is_empty,
end

lemma is_empty_of_chromatic_number_eq_zero (G : simple_graph V) [fintype V]
  (h : G.chromatic_number = 0) : is_empty V :=
begin
  have h' := G.colorable_chromatic_number_of_fintype,
  rw h at h',
  exact G.is_empty_of_colorable_zero h',
end

lemma zero_lt_chromatic_number [nonempty V] {n : ℕ} (hc : G.colorable n) :
  0 < G.chromatic_number :=
begin
  apply le_cInf (colorable_set_nonempty_of_colorable hc),
  intros m hm,
  by_contra h',
  simp only [not_le, nat.lt_one_iff] at h',
  subst h',
  obtain ⟨i, hi⟩ := hm.some (classical.arbitrary V),
  exact nat.not_lt_zero _ hi,
end

lemma colorable_of_le_colorable {G' : simple_graph V} (h : G ≤ G') (n : ℕ)
  (hc : G'.colorable n) : G.colorable n :=
⟨hc.some.comp (hom.map_spanning_subgraphs h)⟩

lemma chromatic_number_le_of_forall_imp {G' : simple_graph V}
  {m : ℕ} (hc : G'.colorable m)
  (h : ∀ n, G'.colorable n → G.colorable n) :
  G.chromatic_number ≤ G'.chromatic_number :=
begin
  apply cInf_le chromatic_number_bdd_below,
  apply h,
  apply colorable_chromatic_number hc,
end

lemma chromatic_number_le_of_le_colorable (G' : simple_graph V)
  {m : ℕ} (hc : G'.colorable m) (h : G ≤ G') :
  G.chromatic_number ≤ G'.chromatic_number :=
begin
  apply chromatic_number_le_of_forall_imp hc,
  exact colorable_of_le_colorable h,
end

lemma chromatic_number_eq_card_of_forall_surj [fintype α] (C : G.coloring α)
  (h : ∀ (C' : G.coloring α), function.surjective C') :
  G.chromatic_number = fintype.card α :=
begin
  apply le_antisymm,
  { apply chromatic_number_le_card C, },
  { by_contra hc,
    rw not_le at hc,
    obtain ⟨n, cn, hc⟩ := exists_lt_of_cInf_lt
      (colorable_set_nonempty_of_colorable C.to_colorable) hc,
    rw ←fintype.card_fin n at hc,
    have f := (function.embedding.nonempty_of_card_le (le_of_lt hc)).some,
    have C' := cn.some,
    specialize h (G.recolor_of_embedding f C'),
    change function.surjective (f ∘ C') at h,
    have h1 : function.surjective f := function.surjective.of_comp h,
    have h2 := fintype.card_le_of_surjective _ h1,
    exact nat.lt_le_antisymm hc h2, },
end

lemma chromatic_number_bot [nonempty V] :
  (⊥ : simple_graph V).chromatic_number = 1 :=
begin
  let C : (⊥ : simple_graph V).coloring (fin 1) :=
    coloring.mk (λ _, 0) (λ v w h, false.elim h),
  apply le_antisymm,
  { exact chromatic_number_le_card C, },
  { exact zero_lt_chromatic_number C.to_colorable, },
end

lemma chromatic_number_complete_graph [fintype V] :
  (⊤ : simple_graph V).chromatic_number = fintype.card V :=
begin
  apply chromatic_number_eq_card_of_forall_surj (self_coloring _),
  intro C,
  rw ←fintype.injective_iff_surjective,
  intros v w,
  contrapose,
  intro h,
  exact C.valid h,
end

/-- The bicoloring of a complete bipartite graph using whether a vertex
is on the left or on the right. -/
def complete_bipartite_graph.bicoloring (V W : Type*) :
  (complete_bipartite_graph V W).coloring bool :=
coloring.mk (λ v, v.is_right) begin
  intros v w,
  cases v; cases w; simp,
end

lemma complete_bipartite_graph.chromatic_number {V W : Type*} [nonempty V] [nonempty W] :
  (complete_bipartite_graph V W).chromatic_number = 2 :=
begin
  apply chromatic_number_eq_card_of_forall_surj (complete_bipartite_graph.bicoloring V W),
  intros C b,
  have v := classical.arbitrary V,
  have w := classical.arbitrary W,
  have h : (complete_bipartite_graph V W).adj (sum.inl v) (sum.inr w) := by simp,
  have hn := C.valid h,
  by_cases he : C (sum.inl v) = b,
  { exact ⟨_, he⟩ },
  { by_cases he' : C (sum.inr w) = b,
    { exact ⟨_, he'⟩ },
    { exfalso,
      cases b;
      simp only [eq_tt_eq_not_eq_ff, eq_ff_eq_not_eq_tt] at he he';
      rw [he, he'] at hn;
      contradiction }, },
end

end simple_graph


import data.list.basic
open list
universe u
variables {α : Type} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs

theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
  by simp [mk_symm]

attribute [simp] reverse_mk_symm

example (xs ys : list ℕ) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
  by simp

example (xs ys : list ℕ) (p : list ℕ → Prop) (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
  by simp at h; assumption