import «09_lib»

set_option pp.beta true
set_option pp.coercions false

/-
Le bouquet final

Cette feuille utilise tout le cours de Math 114 pour démontrer de nombreux
théorèmes parmi les plus subtils de Math 101 : la caractérisation
séquentielle des bornes supérieures, l'équivalence entre continuité
séquentielle et continuité, le fait que toute fonction continue sur un segment
est majorée et atteint son maximum, et enfin le théorème des valeurs
intermédiaires.

Il est inutile d'aborder cette feuille sans être à l'aise avec les feuilles
précédentes (à l'exception de la feuille 7bis facultative). Réviser les
feuilles précédentes et poser des questions est toujours une bonne idée.

On commence par un échauffement, une variante du

  lim_le (hu : limite_suite u x) (ineg : ∀ n, u n ≤ y) : x ≤ y

de la feuille 8, avec l'autre inégalité et seulement à partir d'un certain rang.

On rappelle qu'on a la commande linarith' qui est une version légèrement
améliorée de linarith (cf. feuille 8).

On pourra aussi utiliser les lemmes habituels :

  abs_inferieur_ssi (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

  superieur_max_ssi (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

  inferieur_max_gauche p q : p ≤ max p q

  inferieur_max_droite p q : q ≤ max p q

ainsi que le lemme

  inferieur_si_inferieur_plus_eps : (∀ ε > 0, y ≤ x + ε) →  y ≤ x

démontré dans la feuille 8
-/

-- Si u tend vers x et y ≤ u_n pour n assez grand n alors y ≤ x.
lemma le_lim {x y : ℝ} {u : ℕ → ℝ} (hu : limite_suite u x)
  (ineg : ∃ N, ∀ n ≥ N, y ≤ u n) : y ≤ x :=
begin
  sorry
end

/-
Le premier objectif sérieux de cette feuille est de démontrer la caractérisation
séquentielle des bornes supérieures. Pour cela, et pour les objectifs suivants,
nous aurons besoin de pas mal de choses des feuilles précédentes, et de
quelques extras.

Nous avons démontré dans la feuille 5 qu'une suite constante converge vers
sa valeur :

  lim_constante (x : ℝ) : limite_suite (λ n, x) x

et le théorème des gendarmes :

  gendarmes (lim_u : limite_suite u l) (lim_w : limite_suite w l)
    (hu : ∀ n, u n ≤ v n) (hw : ∀ n, v n ≤ w n)  : limite_suite v l

Dans la feuille 8, nous avons introduit les deux définitions :

  Le réel x est un majorant de l'ensemble de réels A :
  def majorant (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

  Le réel x est une  borne supérieure de l'ensemble de réels A :
  def borne_sup (A : set ℝ) (x : ℝ) := majorant A x ∧ ∀ y, majorant A y → x ≤ y

et montré que si un réel x est borne supérieure d'un ensemble de réels A alors,
pour tout y, si y < x alors il existe a dans A strictement plus grand que y.

  lt_sup (hx : borne_sup A x) : ∀ y, y < x → ∃ a ∈ A, y < a :=

Dans les exercices suivants, on pourra aussi utiliser les lemmes

  inv_succ_pos : ∀ n : ℕ, 1/(n + 1 : ℝ) > 0

  limite_inv_succ :  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε

et les conséquences faciles suivantes de limite_inv_succ :

  limite_si_inferieur_un_sur (h : ∀ n, |u n - x| ≤ 1/(n+1)) : limite_suite u x

  lim_plus_un_sur (x : ℝ) : limite_suite (λ n, x + 1/(n+1)) x

  lim_moins_un_sur (x : ℝ) : limite_suite (λ n, x - 1/(n+1)) x

La structure de la démonstration est offerte. Les accolades servent à
délimiter les objectifs intermédiaires, tout en faisant provisoirement
disparaître l'affichage des objectifs en attente. Il ne faut surtout pas
les supprimer, sous peine de se perdre irrémédiablement.

Enfin on notera l'apparition dans la structure de démonstration ci-dessous
de la commande « choose ». Cette commande est décrite dans la dernière section
du chapitre 3 du cours, intitulée « Utilisation d'un ∀x, ∃y et axiome du choix »
(qu'il convient donc de relire ou de lire), mais n'était pas encore apparue
dans les exercices.
-/

-- Un réel x est borne supérieure d'un ensemble de réels A ssi il est
-- majorant de A et il existe une suite d'éléments de A qui tend vers x.
lemma borne_sup_ssi (A : set ℝ) (x : ℝ) :
(borne_sup A x) ↔ (majorant A x ∧ ∃ u : ℕ → ℝ, limite_suite u x ∧ ∀ n, u n ∈ A ) :=
begin
  split,
  { intro h,
    split,
    {
      sorry
    },
    { have : ∀ n : ℕ, ∃ a ∈ A, x - 1/(n+1) < a,
      { intros n,
        have : 1/(n+1 : ℝ) > 0,
          exact inv_succ_pos n,
        sorry
      },
      choose u hu using this,
      sorry
  } },
  { rintro ⟨maj, u, limu, u_in⟩, -- Cette syntaxe regroupe intro et trois cases :
  -- intro h, cases h with maj min, cases min with u hu, cases hu with limu u_in,
    sorry
  },
end

/-
Les autres exercices de cette feuille utiliseront la définition de la
continuité d'une fonction de ℝ dans ℝ en un point de ℝ.
-/

/-- La fonction `f` est continue en `x₀`. -/
def continue_en (f : ℝ → ℝ) (x₀ : ℝ) : Prop :=
∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - f x₀| ≤ ε

-- Dans la suite, f désignera une fonction de ℝ dans ℝ, x₀ un réel et u
-- une suite de réels
variables {f : ℝ → ℝ} {x₀ : ℝ} {u : ℕ → ℝ}

/-
On commence par un échauffement concernant définition de la continuité.
-/

/-- Une fonction continue en x₀ est séquentiellement continue en x₀ -/
lemma seq_continue_si_continue (hf : continue_en f x₀)
  (hu : limite_suite u x₀) : limite_suite (f ∘ u) (f x₀) :=
begin
  sorry
end

/-
La réciproque de du lemme précédent est vraie aussi :
La continuité séquentielle en x₀ implique la continuité en x₀.
Mais la démonstration est moins courte. On pourra s'inspirer de
la démonstration de borne_sup_ssi (et du poly de math 101 !).
-/
example :
  (∀ u : ℕ → ℝ, limite_suite u x₀ → limite_suite (f ∘ u) (f x₀)) →
  continue_en f x₀ :=
begin
  sorry
end

/-
Dans la suite, étant donnés deux réels,
on utilise la notation habituelle [a, b] pour désigner le segment [a, b].
Attention, si par malheur b < a alors ce segment est vide. C'est un peu
une question de convention, mais notre définition d'un segment assure le
lemme suivant (dont l'utilisation est rarement nécessaire vu qu'il ne fait que
déplier une définition).
-/

lemma dans_segment {a b x : ℝ}  : x ∈ [a, b] ↔ a ≤ x ∧ x ≤ b :=
iff.rfl -- cette ligne signifie : « C'est équivalent par définition. »

/-
Nous avons vu dans la feuille 6 les définitions et le lemme :

Une extraction est une fonction strictement croissante de ℕ dans ℕ :

  def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m

Un réel a est valeur d'adhérence d'une suite u s'il
existe une suite extraite de u qui tend vers a.

  def valeur_adherence (u : ℕ → ℝ) (a : ℝ) :=
    ∃ φ, extraction φ ∧ limite_suite (u ∘ φ) a

Toute extraction est supérieure à l'identité :

  extraction_superieur_id : extraction φ → ∀ n, n ≤ φ n

Et dans la feuille 8 la définition et le lemme :

La suite u tend vers +∞.

  def limite_infinie_suite (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

Si u tend vers +∞ alors u ne tend vers aucune limite finie

  limite_infinie_pas_finie : limite_infinie_suite u → ∀ l, ¬ limite_suite u l
-/

-- Dans la suite, φ sera une fonction de ℕ dans ℕ
variables {φ : ℕ → ℕ}

/-- Si `u` tend vers `+∞` alors toutes ses suites extraites tendent vers `+∞`. -/
lemma limite_infinie_extraction_si_limite
  (h : limite_infinie_suite u) (hφ : extraction φ) :
limite_infinie_suite (u ∘ φ) :=
begin
  sorry
end

lemma limite_infinie_gendarme {u v : ℕ → ℝ} (hu : limite_infinie_suite u)
(huv : ∀ n, u n ≤ v n) : limite_infinie_suite v :=
begin
  sorry
end

/-
Dans la suite, on pourra aussi utiliser le théorème de Bolzano-Weirstrass :

Toute suite à valeur dans un segment [a, b] admet une valeur d'adhérence
dans [a, b].

  bolzano_weierstrass (h : ∀ n, u n ∈ [a, b]) :
    ∃ c ∈ [a, b], valeur_adherence u c

Ce théorème se démontre à partir du théorème de la borne supérieure, mais il
faut construire une suite par récurrence, ce que nous n'avons pas appris à
faire dans Lean.

On pourra utiliser aussi le lemme suivant, qui lui est évident

  limite_suite_id : limite_infinie_suite (λ n, n)
-/

-- Toute fonction continue sur un segment y est majorée.
lemma majoree_segment {f : ℝ → ℝ} {a b : ℝ} (hf : ∀ x ∈ [a, b], continue_en f x) :
∃ M, ∀ x ∈ [a, b], f x ≤ M :=
begin
  sorry
end

/-
Pour l'exercice suivant, on pourra utiliser le lemme

  abs_neg x : |-x| = |x|
-/

-- Si f est continue en x₀ alors -f est aussi continue en x₀
lemma continue_opposee {f : ℝ → ℝ} {x₀ : ℝ} (h : continue_en f x₀) :
  continue_en (λ x, -f x) x₀ :=
begin
  sorry
end

-- Toute fonction continue sur un segment y est minorée.
lemma minoree_segment {f : ℝ → ℝ} {a b : ℝ} (hf : ∀ x ∈ [a, b], continue_en f x) :
∃ m, ∀ x ∈ [a, b], m ≤ f x :=
begin
  have : ∃ M, ∀ x ∈ [a, b], -f x ≤ M,
  {
    sorry
  },
  sorry
end

/-
Nous avons démontré dans la feuille 5 qu'une suite a au plus une limite :

 unicite_limite : limite_suite u l → limite_suite u l' → l = l'

et démontré dans la feuille 6 que,si u tend vers l alors toutes ses suites
extraites tendent vers l :

  limite_extraction_si_limite (h : limite_suite u l) (hφ : extraction φ) :
    limite_suite (u ∘ φ) l

On admet une version du théorème de la borne supérieure (qu'on ne peut pas
démontrer sans construire les nombres réels ou admettre un autre théorème
aussi fort) :

sup_segment {a b : ℝ} {A : set ℝ} (hnonvide : ∃ x, x ∈ A) (h : A ⊆ [a, b]) :
  ∃ x ∈ [a, b], borne_sup A x

Dans l'exercice suivant, il peut être utile de démontrer une inclusion
entre ensembles A et B de nombres réels.
Par définition, A ⊆ B signifie : ∀ x, x ∈ A → x ∈ B.
On peut donc commencer la démonstration de A ⊆ B par « intros x x_dans_A »
qui fait apparaître « x : ℝ » et « x_dans_A : x ∈ A  » dans le contexte,
puis démontrer x ∈ B.

On remarquera aussi l'utilisation de la notation
  {x | P x}
qui désigne l'ensemble des x vérifiant le prédicat P.
Par exemple, la définition du segment [a, b] est :
[a, b] = { x | a ≤ x ∧ x ≤ b }

Ainsi l'énoncé x' ∈ { x | P x} signifie P x', par définition.

La structure de la démonstration suivante vous est offerte. On notera aussi
au passage (mais sans nécessairement essayer de les retenir) l'apparition
de plusieurs commandes Lean permettant de rassembler en une ligne une
fastidieuse série de intros et cases. Toutes ces démonstrations peuvent
se faire sans commande nouvelle, mais leur complexité justifie d'investir
dans des raccourcis.
-/

/-- Toute fonction continue sur un segment non vide y admet un maximum. -/
example {a b : ℝ} (hab : a ≤ b) (hf : ∀ x ∈ [a, b], continue_en f x) :
∃ x₀ ∈ [a, b], ∀ x ∈ [a, b], f x ≤ f x₀ :=
begin
  cases minoree_segment hf with m hm,
  cases majoree_segment hf with M hM,
  let A := {y | ∃ x ∈ [a, b], y = f x}, -- A est l'image de [a, b] par f
  -- La commande obtain n'est pas à retenir, c'est un raccourci
  -- pour un have et deux cases
  obtain ⟨y₀, y_dans, y_sup⟩ : ∃ y₀ ∈ [m, M], borne_sup A y₀,
  {
    sorry
  }, -- Bien observer le contexte après ce obtain
  rw borne_sup_ssi at y_sup,
  -- encore un raccourci pour remplacer trois cases
  rcases y_sup with ⟨y_maj, u, lim_u, u_dans⟩,
  choose v hv using u_dans,
  -- Et un dernier raccourci pour la route
  cases forall_and_distrib.mp hv with v_dans hufv,
  -- On reformule l'hypothèse hufv par une dernière commande exotique
  replace hufv : u = f ∘ v := funext hufv,
  sorry
end

-- Malheureusement linarith ne fait pas tout seul le lemme suivant
lemma stupide {a b x : ℝ} (h : x ∈ [a, b]) (h' : x ≠ b) : x < b :=
lt_of_le_of_ne h.right h'

/-
Et maintenant le boss final...
-/

/-- Le théorème des valeurs intermédiaires -/
example (f : ℝ → ℝ) (hf : ∀ x, continue_en f x) (h₀ : f 0 < 0) (h₁ : f 1 > 0) :
∃ x₀ ∈ [0, 1], f x₀ = 0 :=
begin
  let A := { x | x ∈ [0, 1] ∧ f x < 0},
  have ex_x₀ : ∃ x₀ ∈ [0, 1], borne_sup A x₀,
  {
    sorry
  },
  rcases ex_x₀ with ⟨x₀, x₀_dans, x₀_sup⟩,
  use [x₀, x₀_dans],
  have : f x₀ ≤ 0,
  {
    sorry
  },
  have x₀_1: x₀ < 1,
  {
    sorry
  },
  have : f x₀ ≥ 0,
  { have dans : ∃ N : ℕ, ∀ n ≥ N, x₀ + 1/(n+1) ∈ [0, 1],
    { have : ∃ N : ℕ, ∀ n≥ N, 1/(n+1 : ℝ) ≤ (1-x₀)/2,
      {
        sorry
      },
      sorry
    },
    have pas_dans : ∀ n : ℕ, x₀ + 1/(n+1) ∉ A,
    -- Par définition, x ∉ A signifie « non (x ∈ A) ».
    {
      sorry
    },
    dsimp [A] at pas_dans, -- il est inutile de retenir cette commande
    sorry
  },
  linarith,
end


import tactic.induction
import data.nat.prime
import data.nat.modeq
import logic.function.iterate

noncomputable theory
open_locale classical

def get_some {α : Type} [inhabited α] (P : α → Prop) : α :=
if h : ∃ (x : α), P x then h.some else default

def reduce {α : Type} [inhabited α] (f : α → α) (x : α) : α := get_some
(λ (r : α), ∃ (n : ℕ), (f^[n]) x = r ∧ (f^[n + 1]) x = r)

def digits (n : ℕ) : list ℕ := get_some
(λ (ds : list ℕ), (∀ (d ∈ ds), d ≤ 9) ∧ ds.foldl (λ a d, a * 10 + d) 0 = n)

def digits_sum (n : ℕ) : ℕ := (digits n).sum
def digital_root (n : ℕ) : ℕ := reduce digits_sum n

lemma digital_root_eq {n : ℕ} :
  digital_root n = ite (n % 9 = 0) 9 (n % 9) :=
begin
  sorry
end

lemma num_3_dvd_of_mod_9_eq_3_or_6 {n : ℕ}
  (h : n % 9 = 3 ∨ n % 9 = 6) : 3 ∣ n :=
begin
  have h₁ : n % 9 % 3 = 0, { cases h; rw h; dec_trivial },
  rw nat.mod_mod_of_dvd at h₁, swap, { dec_trivial },
  exact nat.dvd_of_mod_eq_zero h₁,
end

lemma num_3_dvd_of_mod_9_eq_3 {n : ℕ} (h : n % 9 = 3) : 3 ∣ n :=
num_3_dvd_of_mod_9_eq_3_or_6 (or.inl h)

lemma num_3_dvd_of_mod_9_eq_6 {n : ℕ} (h : n % 9 = 6) : 3 ∣ n :=
num_3_dvd_of_mod_9_eq_3_or_6 (or.inr h)

lemma prime_mod_9 {n : ℕ}
  (h₁ : 3 < n)
  (h₂ : prime n) :
  n % 9 ∈ ({1, 2, 4, 5, 7, 8} : set ℕ) :=
begin
  rw ←nat.prime_iff at h₂, replace h₂ := h₂.2,
  obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_lt h₁,
  let k := n + 4, replace h₁ : 3 + n + 1 = k, { rw [add_comm 3, add_assoc] },
  generalize hm : k % 9 = m, rw h₁ at h₂ ⊢, rw hm, replace h₁ : m < 9,
  { rw ←hm, exact nat.mod_lt _ dec_trivial }, cases m,
  { specialize h₂ 3 (k / 3), have h₃ : 3 * 3 ∣ k := nat.dvd_of_mod_eq_zero hm,
    have h₄ : k / 3 * 3 = k := nat.div_mul_cancel (dvd_of_mul_left_dvd h₃),
    rw mul_comm at h₄, specialize h₂ h₄.symm, simp at h₂, rw h₂ at h₄,
    rw ←h₄ at h₃, contrapose h₃, dec_trivial },
  cases m, { simp }, cases m, { simp }, cases m,
  { specialize h₂ 3 (k / 3), have h₃ : 3 ∣ k := num_3_dvd_of_mod_9_eq_3 hm,
    have h₄ : k / 3 * 3 = k := nat.div_mul_cancel h₃, rw mul_comm at h₄,
    specialize h₂ h₄.symm, simp at h₂, rw h₂ at h₄, cases h₄ },
  cases m, { simp }, cases m, { simp }, cases m,
  { specialize h₂ 3 (k / 3), have h₃ : 3 ∣ k := num_3_dvd_of_mod_9_eq_6 hm,
    have h₄ : k / 3 * 3 = k := nat.div_mul_cancel h₃, rw mul_comm at h₄,
    specialize h₂ h₄.symm, simp at h₂,rw h₂ at h₄, cases h₄ },
  cases m, { simp }, cases m, { simp },
  change m + 9 < 9 at h₁, contrapose! h₁, exact le_add_self,
end

example {n : ℕ}
  (h₁ : 3 < n)
  (h₂ : prime n)
  (h₃ : prime (n + 2)) :
  digital_root (n * (n + 2)) = 8 :=
begin
  rw digital_root_eq,
  split_ifs with hx,
  {
    exfalso,
    rw [nat.mul_mod, ←nat.dvd_iff_mod_eq_zero] at hx,
    cases hx with x hx,
    sorry
  },
  sorry;{ rw [nat.mul_mod, nat.add_mod],
    have hn : 3 < n + 2 := lt_trans h₁ (lt_add_of_pos_right n dec_trivial),
    replace h₂ := prime_mod_9 h₁ h₂, replace h₃ := prime_mod_9 hn h₃,
    rw nat.add_mod at h₃, rcases h₂ with h | h | h | h | h | h; change _ = _ at h;
    { rw h at h₃, contrapose h₃, simp, try { dec_trivial }} <|>
    { rw h, dec_trivial }},
end


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : (G.colorable 2) → (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)), from
  begin
    assume h2 : (G.colorable 2),
    -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
    have h3 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from
    begin
      -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
      have h4 : ∀ (A B : Type*) (h : (A ⊕ B) = V), (G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (∀ (a b : A), ¬ (G.adj a b)), from
      begin
        assume (A B : Type*) (h : (A ⊕ B) = V) (h5 : (G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B))),
        assume (a b : A),
        assume h6 : (G.adj a b),
        have h7 : (cast (congr_arg _ h) (complete_bipartite_graph A B)).adj a b, from by auto [h5, h6],
        have h8 : (complete_bipartite_graph A B).adj a b, from by auto [h7],
        have h9 : (complete_bipartite_graph A B).adj a b = ff, from by auto [h8],
        have h10 : (cast (congr_arg _ h) (complete_bipartite_graph A B)).adj a b = ff, from by auto [h9],
        have h11 : (G.adj a b) = ff, from by auto [h10, h7],
        show false, from by auto [h11, h6],
      end,
      have h12 : ∀ (A B : Type*) (h : (A ⊕ B) = V), (G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (∀ (a b : B), ¬ (G.adj a b)), from
      begin
        assume (A B : Type*) (h : (A ⊕ B) = V) (h13 : (G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B))),
        assume (a b : B),
        assume h14 : (G.adj a b),
        have h15 : (cast (congr_arg _ h) (complete_bipartite_graph A B)).adj a b, from by auto [h13, h14],
        have h16 : (complete_bipartite_graph A B).adj a b, from by auto [h15],
        have h17 : (complete_bipartite_graph A B).adj a b = ff, from by auto [h16],
        have h18 : (cast (congr_arg _ h) (complete_bipartite_graph A B)).adj a b = ff, from by auto [h17],
        have h19 : (G.adj a b) = ff, from by auto [h18, h15],
        show false, from by auto [h19, h14],
      end,
      -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
      have h20 : ∀ (A B : Type*) (h : (A ⊕ B) = V), (G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (∀ (a b : A ⊕ B), (G.adj a b) → (∃ (a' b' : A ⊕ B), (a = a') ∧ (b = b') ∧ (a' ∈ A) ∧ (b' ∈ B))), from
      begin
        assume (A B : Type*) (h : (A ⊕ B) = V) (h21 : (G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B))),
        assume (a b : A ⊕ B),
        assume h22 : (G.adj a b),
        have h23 : (cast (congr_arg _ h) (complete_bipartite_graph A B)).adj a b, from by auto [h21, h22],
        have h24 : (complete_bipartite_graph A B).adj a b, from by auto [h23],
        have h25 : (complete_bipartite_graph A B).adj a b = tt, from by auto [h24],
        have h26 : (cast (congr_arg _ h) (complete_bipartite_graph A B)).adj a b = tt, from by auto [h25],
        have h27 : (G.adj a b) = tt, from by auto [h26, h23],
        have h28 : (a ∈ A ⊕ B) ∧ (b ∈ A ⊕ B), from by auto [h22, h27],
        have h29 : (a ∈ A) ∨ (a ∈ B), from by auto [h28.left],
        have h30 : (b ∈ A) ∨ (b ∈ B), from by auto [h28.right],
        have h31 : (a ∈ A) ∧ (b ∈ B), from by auto [h29, h30, h4, h12, h21],
        have h32 : (a ∈ A) ∧ (b ∈ B) → (∃ (a' b' : A ⊕ B), (a = a') ∧ (b = b') ∧ (a' ∈ A) ∧ (b' ∈ B)), from by auto [h31],
        show (∃ (a' b' : A ⊕ B), (a = a') ∧ (b = b') ∧ (a' ∈ A) ∧ (b' ∈ B)), from by auto [h32],
      end,
      have h33 : ∀ (A B : Type*) (h : (A ⊕ B) = V), (G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) → (∀ (a b : A ⊕ B), (G.adj a b) → (∃ (a' b' : A ⊕ B), (a = a') ∧ (b = b') ∧ (a' ∈ B) ∧ (b' ∈ A))), from
      begin
        assume (A B : Type*) (h : (A ⊕ B) = V) (h34 : (G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B))),
        assume (a b : A ⊕ B),
        assume h35 : (G.adj a b),
        have h36 : (cast (congr_arg _ h) (complete_bipartite_graph A B)).adj a b, from by auto [h34, h35],
        have h37 : (complete_bipartite_graph A B).adj a b, from by auto [h36],
        have h38 : (complete_bipartite_graph A B).adj a b = tt, from by auto [h37],
        have h39 : (cast (congr_arg _ h) (complete_bipartite_graph A B)).adj a b = tt, from by auto [h38],
        have h40 : (G.adj a b) = tt, from by auto [h39, h36],
        have h41 : (a ∈ A ⊕ B) ∧ (b ∈ A ⊕ B), from by auto [h35, h40],
        have h42 : (a ∈ A) ∨ (a ∈ B
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem  bipartite_iff_two_colorable {V : Type*} (G : simple_graph V) [fintype V] : (G.colorable 2) ↔ (∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import topology.constructions

open topological_space

lemma pi_induced_induced {ι : Sort*} {X Y : ι → Type*} [t : Π i : ι, topological_space $ Y i]
 (f : Π i, X i → Y i) : @Pi.topological_space ι X (λ i, induced (f i) (t i)) =
  induced (λ (x : Π i, X i), (λ j,  f j (x j) : Π i, Y i)) Pi.topological_space :=
begin
  dsimp [Pi.topological_space],
  rw induced_infi,
  simp [induced_compose]
end


import linear_algebra.span

namespace linear_map
open submodule

variables {R : Type*} {R₂ : Type*} [semiring R] [semiring R₂] {M : Type*} {M₂ : Type*}
{τ₁₂ : R →+* R₂}

section comap

variables [add_comm_monoid M] [module R M] [add_comm_monoid M₂] [module R₂ M₂]
(f : M →ₛₗ[τ₁₂] M₂) {p p' : submodule R M} {q q' : submodule R₂ M₂}

lemma ker_eq_comap : f.ker = comap f ⊥ := rfl

lemma ker_le_comap {f : M →ₛₗ[τ₁₂] M₂} : f.ker ≤ comap f q := comap_mono bot_le

section ring_hom_surjective

variable [ring_hom_surjective τ₁₂]

-- This should not be primed (to match the map equivalent).

lemma comap_le_comap_iff' : comap f q ≤ comap f q' ↔ f.range ⊓ q ≤ q' :=
by rw [← map_le_iff_le_comap, map_comap_eq]

lemma comap_range : comap f (f.range) = ⊤ := submodule.eq_top_iff'.mpr (λ _, ⟨_, rfl⟩)

lemma comap_eq_comap_range_inf : comap f q = comap f (f.range ⊓ q) :=
by rw [comap_inf, comap_range, top_inf_eq]

lemma comap_le_ker_iff : comap f q ≤ f.ker ↔ f.range ⊓ q = ⊥ :=
by rw [ker_eq_comap, comap_le_comap_iff', le_bot_iff]

lemma comap_eq_ker_iff : comap f q = f.ker ↔ f.range ⊓ q = ⊥ :=
⟨ λ h, (comap_le_ker_iff _).mp (le_of_eq h),
  λ h, le_antisymm ((comap_le_ker_iff _).mpr h) ker_le_comap⟩

end ring_hom_surjective

-- comap_map_eq and comap_map_eq_self are in the wrong file (should be in basic).

end comap

section map
variables [ring_hom_surjective τ₁₂]
section monoids

variables [add_comm_monoid M] [module R M] [add_comm_monoid M₂] [module R₂ M₂]
(f : M →ₛₗ[τ₁₂] M₂) {p p' : submodule R M} {q q' : submodule R₂ M₂}

lemma map_ker : map f (f.ker) = ⊥ := (submodule.eq_bot_iff _).mpr
(λ x h, by rcases (mem_map.mp h) with ⟨_, p, l⟩; exact l ▸ (mem_ker.mp p) )

lemma map_eq_map_sup_ker : map f p = map f (p ⊔ f.ker) :=
by rw [map_sup, map_ker, sup_bot_eq]

end monoids

section group
variables [add_comm_group M] [module R M] [add_comm_group M₂] [module R₂ M₂]
(f : M →ₛₗ[τ₁₂] M₂) {p p' : submodule R M} {q q' : submodule R₂ M₂}

lemma range_le_map_iff : f.range ≤ map f p ↔ p ⊔ f.ker = ⊤ :=
by rw [range_eq_map, linear_map.map_le_map_iff, top_le_iff]

-- map_eq_top_iff is just a special case of this.
lemma range_eq_map_iff : f.range = map f p ↔ p ⊔ f.ker = ⊤ :=
⟨ λ h, (range_le_map_iff _).mp (le_of_eq h),
  λ h, le_antisymm ((range_le_map_iff _).mpr h) map_le_range⟩
end group

-- map_le_map_iff and map_le_map_iff' should be in basic also.

end map

section cmptble
variables
[add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module R₂ M₂]
{f : M →ₛₗ[τ₁₂] M₂} (p p' : submodule R M) (q q' : submodule R₂ M₂)

def compatible (f : M →ₛₗ[τ₁₂] M₂) (p) (q) : Prop := p ≤ comap f q

lemma cmptble_def {p q} : f.compatible p q ↔ p ≤ comap f q := by refl

lemma cmptble_comap : f.compatible (comap f q) q := le_refl _

lemma cmptble_bot_ker : f.compatible f.ker ⊥ := le_refl _

lemma cmptble_of_cmptble_of_dom_le {p p' q}
(hp : p' ≤ p) (hf : f.compatible p q) : f.compatible p' q := λ _ hx, hf (hp hx)

lemma cmptble_of_cmptble_of_cod_le {p q q'}
(hq : q ≤ q') (hf : f.compatible p q) : f.compatible p q' := λ _ hx, hq (hf hx)

lemma cmptble_of_cmptble_of_dom_le_of_cod_le {p q p' q'}
(hp : p' ≤ p) (hq : q ≤ q') (hf : f.compatible p q) : f.compatible p' q' :=
cmptble_of_cmptble_of_cod_le hq (cmptble_of_cmptble_of_dom_le hp hf)

lemma cmptble_dom_cod_top : f.compatible ⊤ ⊤ :=
cmptble_of_cmptble_of_dom_le (le_refl _) (cmptble_comap ⊤)

lemma cmptble_cod_top {p} : f.compatible p ⊤ :=
cmptble_of_cmptble_of_dom_le le_top cmptble_dom_cod_top

lemma cmptble_cod_bot_iff {p} : f.compatible p ⊥ ↔ p ≤ f.ker :=
by rw cmptble_def; refl

section ring_hom_surjective
variables [ring_hom_surjective τ₁₂]

lemma cmptble_def' {p q} : f.compatible p q ↔ map f p ≤ q :=
(gc_map_comap _ _ _).symm

lemma cmptble_map : f.compatible p (map f p) :=
cmptble_def'.mpr (le_refl _)

lemma cmptble_top_range : f.compatible ⊤ f.range :=
by rw ←map_top; exact cmptble_of_cmptble_of_cod_le (le_refl _) (cmptble_map ⊤)

lemma cmptble_dom_top_iff {q} : f.compatible ⊤ q ↔ f.range ≤ q :=
by rw [cmptble_def', map_top f]

end ring_hom_surjective

lemma cmptble_iff_map_mem_of_mem {p q}: f.compatible p q ↔ ∀ x, x ∈ p → f x ∈ q := by refl

lemma cmptble_dom_top_iff' {q} : f.compatible ⊤ q ↔ ∀ x, f x ∈ q :=
⟨λ h _, h mem_top, λ h x _, h x⟩

lemma cmptble_cod_bot_iff' {p} : f.compatible p ⊥ ↔ ∀ x ∈ p, f x = 0 :=
by rw cmptble_cod_bot_iff; refl

-- Should be equivalent to the existing restrict.
def restrict' (f : M →ₛₗ[τ₁₂] M₂) {p} {q} (hf : f.compatible p q) : p →ₛₗ[τ₁₂] q := {
  to_fun := λ x, ⟨f x, hf x.2⟩,
  map_add' := by { simp_rw [  subtype.ext_iff, submodule.coe_add,
                              map_add, submodule.coe_mk], exact λ _ _, rfl},
  map_smul' := by { simp_rw [ subtype.ext_iff, submodule.coe_smul,
                              map_smulₛₗ, submodule.coe_mk], exact λ _ _, rfl} }

lemma restrict'_apply {p} {q} {hf : f.compatible p q} {x} : (f.restrict' hf x : M₂) = f x := rfl

-- Should be equivalent to the existing dom_restrict.
-- Suggestion: linear version should be ldom_restrict? etc.

def dom_restrict'' (f : M →ₛₗ[τ₁₂] M₂) (p : submodule R M) : p →ₛₗ[τ₁₂] M₂ :=
top_equiv.to_linear_map.comp (f.restrict' cmptble_cod_top)

lemma dom_restrict''_apply {f : M →ₛₗ[τ₁₂] M₂} {p} {x} : f.dom_restrict'' p x = f x := rfl

lemma dom_restrict''_cmptble_top_of_cmptble {p q} (hf : f.compatible p q) :
(f.dom_restrict'' p).compatible ⊤ q :=
by rw cmptble_dom_top_iff'; exact λ x, hf x.2

def cod_restrict' (f : M →ₛₗ[τ₁₂] M₂) {q} (hf : f.compatible ⊤ q) : M →ₛₗ[τ₁₂] q :=
(f.restrict' hf).comp top_equiv.symm.to_linear_map

lemma cod_restrict'_apply {q} {hq : f.compatible ⊤ q} {x} : (f.cod_restrict' hq x : M₂) = f x :=
rfl

lemma restrict'_eq_cod_restrict_dom_restrict' {p q} {hf : f.compatible p q} :
f.restrict' hf = (f.dom_restrict'' p).cod_restrict' (dom_restrict''_cmptble_top_of_cmptble hf) :=
rfl

lemma restrict'_eq_dom_restrict_cod_restrict' {p q} {hf : f.compatible ⊤ q} :
f.restrict' (cmptble_of_cmptble_of_dom_le le_top hf) = (f.cod_restrict' hf).dom_restrict'' p :=
rfl

end cmptble

-- To add:
/-
(_ ⧸ (p ⊓ f.ker).comap p.subtype) ≃ₗ[R] p.map f
rank f.range ⊔ q + rank q.comap f = rank M + rank q
(?) corank q = corank q.comap f + corank (f.range ⊔ q)

Should link "compatible" with the corresponding stuff in the quotient space.

-/

end linear_map


import topology.basic
import topology.metric_space.basic
import topology.continuous_function.basic
import topology.homotopy.fundamental_groupoid
import analysis.normed_space.basic
import analysis.special_functions.trigonometric.basic

import .pointed_space

def disk : set (ℝ × ℝ) := metric.closed_ball (0 : ℝ × ℝ) 1
def circle : set (ℝ × ℝ) := metric.sphere (0 : ℝ × ℝ) 1
def pt : ℝ × ℝ := (1, 0)

noncomputable def disk.pointed_space : pointed_space disk :=
pointed_space.mk
  (subtype.mk pt (by simp [pt, disk, norm]))

noncomputable def circle.pointed_space : pointed_space circle :=
pointed_space.mk
  (subtype.mk pt (by simp [pt, circle, norm]))

instance inhabited.disk : inhabited disk :=
⟨subtype.mk pt (by simp [pt, disk, norm])⟩

lemma frontier_disk_eq_circle : frontier disk = circle :=
begin
  simp [disk, circle],
  rw frontier_closed_ball,
  linarith,
end

/--
Defines the identity homeomorphism between the boundary of the disk and the circle.
-/
noncomputable def frontier_disk_homeo_circle : frontier disk ≃ₜ circle := {
  to_fun := λx, subtype.mk (↑x) (begin rw ← frontier_disk_eq_circle, simp, end),
  inv_fun := λx, subtype.mk (↑x) (begin rw frontier_disk_eq_circle, simp, end),
  left_inv :=
    begin
      intro x,
      simp,
    end,
  right_inv :=
    begin
      intro x,
      simp,
    end,
}

lemma frontier_subset_closed_set {α : Type} [topological_space α] (X : set α) :
  is_closed X → frontier X ⊆ X :=
begin
  intro hclosed,
  have hfx_sub_fxd : frontier X ⊆ X \ interior X :=
    by rw is_closed.frontier_eq hclosed,
  have hfxd_sub_x : X \ interior X ⊆ X :=
    set.diff_subset X (interior X),
  apply has_subset.subset.trans hfx_sub_fxd hfxd_sub_x,
end

lemma frontier_disk_subset_disk :
  frontier disk ⊆ disk :=
frontier_subset_closed_set disk metric.is_closed_ball

instance has_lift.frontier_disk : has_lift (frontier disk) (disk) := {
  lift := begin
    intro fd,
    cases fd,
    have fd_val_in_disk : fd_val ∈ disk :=
      frontier_disk_subset_disk fd_property,
    exact subtype.mk fd_val fd_val_in_disk,
  end
}

noncomputable def frontier_disk.pointed_space : pointed_space (frontier disk) :=
pointed_space.mk
  (subtype.mk pt (by simp [pt, frontier_disk_eq_circle, circle, norm]))

instance disk.path_connected : path_connected_space disk := {
  nonempty := nonempty_of_pointed_space disk.pointed_space,
  joined :=
    begin
      intros x y,
      apply @nonempty_of_exists _ (λ_, true),
      apply exists.intro,
      tautology,

      sorry,
      -- exact {
      --   to_fun := sorry, --λt, (↑x) + t * (↑(x - y)),
      --   source' := sorry,
      --   target' := sorry,
      -- }
    end,
}

instance circle.path_connected : path_connected_space circle := {
  nonempty := nonempty_of_pointed_space circle.pointed_space,
  joined :=
    begin
      intros x y,
      apply @nonempty_of_exists _ (λ_, true),
      apply exists.intro,
      tautology,

      let x_ang : ℝ := sorry,
      let y_ang : ℝ := sorry,
      exact {
        to_fun := λt,
          subtype.mk
            (real.cos t, real.sin t)
            sorry,
        source' := sorry,
        target' := sorry,
      },
    end,
}

instance frontier_disk.path_connected : path_connected_space (frontier disk) :=
begin
  rw frontier_disk_eq_circle,
  exact circle.path_connected,
end


import algebraic_geometry.ringed_space
import algebra.homology.exact
import presheaf_of_module
import sheaf_has_zero_morphism
import presheaf_of_module_has_image
import sheaf_has_image

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

-- section free_presentation
-- universe u
-- open Module Module.has_limits category_theory
-- open_locale zero_object

-- variable {R : CommRing.{u}}

-- structure free_presentation (M : Module R) :=
-- (I J : Type u)
-- (f : (∏ function.const I (⟨R⟩ : Module R)) ⟶ (∏ function.const J (⟨R⟩ : Module R)))
-- (g : (∏ function.const J (⟨R⟩ : Module R) ⟶ M))
-- [exact : exact f g]

-- end free_presentation

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

section quasicoherent

open algebraic_geometry Top topological_space category_theory opposite
open_locale zero_object

universe u
variables (X : RingedSpace.{u}) -- (𝓕 : sheaf_of_module X.presheaf)

def sheaf_of_module.as_SheafedSpace {T : Top} {𝓞 : presheaf CommRing T} (𝓕 : sheaf_of_module 𝓞)
  : SheafedSpace Ab :=
{ carrier := T,
  presheaf := 𝓕.self,
  is_sheaf := 𝓕.is_sheaf }

def RingedSpace.sheaf : sheaf CommRing X.carrier := ⟨X.presheaf, X.is_sheaf⟩
def RingedSpace.sheaf_of_Ab : sheaf Ab X.carrier :=
⟨{ obj := λ U, ⟨X.presheaf.obj U⟩,
   map := λ U V inc, X.presheaf.map inc,
   map_id' := sorry,
   map_comp' := sorry }, sorry⟩.

def RingedSpace.SheafedSpace_of_Ab : SheafedSpace Ab :=
{ carrier := X.carrier,
  presheaf := (RingedSpace.sheaf_of_Ab X).1,
  is_sheaf := (RingedSpace.sheaf_of_Ab X).2 }.

def sheaf_of_module.from_sheaf_of_ring {T : Top} (𝓞 : sheaf CommRing T) : sheaf_of_module 𝓞.1 :=
{ self :=
  { obj := λ V, ⟨𝓞.1.obj V⟩,
    map := λ U V inc, 𝓞.1.map inc,
    map_id' := λ V, sorry,
    map_comp' := λ U V W incUV incVW, sorry },
  is_sheaf := sorry,
  compatible := λ U V inc r m, begin
    simp only [smul_eq_mul],
    erw ring_hom.map_mul,
    refl,
  end }.

/--
If `𝓕` is an `𝓞`-module, then we say `𝓕` is quasicoherent if and only if for every `x : X`, there is
an `x ∈ U : opens X` such that there is an exact sequence of sheaves of abelian group of the following:

```
⨁_{i : I} (𝓞|U) ⟶ ⨁_{j : J} (𝓞|U) ⟶ 𝓕|U ⟶ 0
```
-/
variable {X}
structure sheaf_of_module.free_presentation_at (𝓕 : sheaf_of_module X.presheaf) (x : X) :=
(U : opens X)
(mem : x ∈ U)
(I J : Type u)
(f : (∏ function.const I ((SheafedSpace.restrict (RingedSpace.SheafedSpace_of_Ab X) (opens.open_embedding U))).sheaf) ⟶
    (∏ function.const J ((SheafedSpace.restrict (RingedSpace.SheafedSpace_of_Ab X) (opens.open_embedding U))).sheaf))
(g : (∏ function.const J ((SheafedSpace.restrict (RingedSpace.SheafedSpace_of_Ab X) (opens.open_embedding U))).sheaf) ⟶
 (SheafedSpace.restrict (𝓕.as_SheafedSpace) (opens.open_embedding U)).sheaf)
[exact1 : exact f g]
[exact2 : exact g (0 : _ ⟶ 0)].

def sheaf_of_module.is_quasicoherent (𝓕 : sheaf_of_module X.presheaf) : Prop :=
∀ (x : X), nonempty (sheaf_of_module.free_presentation_at 𝓕 x).

variable (X)
structure quasicoherent_sheaf_of_module :=
(sheaf : sheaf_of_module X.presheaf)
(is_quasicoherent : sheaf.is_quasicoherent)

namespace quasicoherent_sheaf_of_module

instance : category (quasicoherent_sheaf_of_module X) :=
{ hom := λ F1 F2, F1.sheaf ⟶ F2.sheaf,
  id := λ F, 𝟙 _,
  comp := λ F1 F2 F3 f12 f23, f12 ≫ f23,
  id_comp' := λ F1 F2 f, by simp,
  comp_id' := λ F1 F2 f, by simp,
  assoc' := λ F1 F2 F3 F4 f12 f23 f34, by simp }.

variable {X}
def zero_morphism (F G : quasicoherent_sheaf_of_module X) : F ⟶ G := (0 : F.sheaf ⟶ G.sheaf)

instance : limits.has_zero_morphisms (quasicoherent_sheaf_of_module X) :=
{ has_zero := λ F G, ⟨zero_morphism F G⟩,
  comp_zero' := λ F G f H, begin
    ext U x,
    simp only [presheaf_of_module.zero, limits.zero_app, AddCommGroup.zero_apply],
    change (f.1.app U ≫ 0) x = 0,
    simp only [limits.comp_zero, AddCommGroup.zero_apply],
  end,
  zero_comp' := λ F G H f, begin
    ext U x,
    simp only [presheaf_of_module.zero, limits.zero_app, AddCommGroup.zero_apply],
    change (0 ≫ f.1.app U) x = 0,
    simp only [limits.zero_comp, AddCommGroup.zero_apply],
  end }.

lemma is_quasicoherent.zero : (0 : sheaf_of_module X.presheaf).is_quasicoherent := λ x, nonempty.intro
{ U := ⊤,
  mem := trivial,
  I := punit,
  J := punit,
  f := 𝟙 _,
  g := 0,
  exact1 := ⟨by ext, ⟨λ F a b h, begin
    refine (@@cancel_epi _ _ begin apply image_to_kernel_epi_of_epi_of_zero,
    end).mp h,
  end⟩⟩,
  exact2 := infer_instance }.

/--
`R --f--> R^2 --g--> R ----> 0`
`f a = (a, 0)`
`g (a, b) = b`
-/
lemma is_quasicoherent.self : (sheaf_of_module.from_sheaf_of_ring ⟨X.presheaf, X.is_sheaf⟩).is_quasicoherent := λ x, nonempty.intro
{ U := ⊤,
  mem := trivial,
  I := punit,
  J := ulift bool,
  f := category_theory.limits.pi.lift
    (λ b, match (ulift.down b) with
    | tt := category_theory.limits.pi.π _ (punit.star)
    | ff := 0
    end),
  g := category_theory.limits.pi.π _ (ulift.up false),
  exact1 := sorry,
  exact2 := sorry, }.

end quasicoherent_sheaf_of_module

end quasicoherent


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

/-!
# Unbundled semiring and ring homomorphisms (deprecated)

This file is deprecated, and is no longer imported by anything in mathlib other than other
deprecated files, and test files. You should not need to import it.

This file defines predicates for unbundled semiring and ring homomorphisms. Instead of using
this file, please use `ring_hom`, defined in `algebra.hom.ring`, with notation `→+*`, for
morphisms between semirings or rings. For example use `φ : A →+* B` to represent a
ring homomorphism.

## Main Definitions

`is_semiring_hom` (deprecated), `is_ring_hom` (deprecated)

## Tags

is_semiring_hom, is_ring_hom

-/

universes u v w

variable {α : Type u}

/-- Predicate for semiring homomorphisms (deprecated -- use the bundled `ring_hom` version). -/
structure is_semiring_hom {α : Type u} {β : Type v} [semiring α] [semiring β] (f : α → β) : Prop :=
(map_zero [] : f 0 = 0)
(map_one [] : f 1 = 1)
(map_add [] : ∀ {x y}, f (x + y) = f x + f y)
(map_mul [] : ∀ {x y}, f (x * y) = f x * f y)

namespace is_semiring_hom

variables {β : Type v} [semiring α] [semiring β]
variables {f : α → β} (hf : is_semiring_hom f) {x y : α}

/-- The identity map is a semiring homomorphism. -/
lemma id : is_semiring_hom (@id α) := by refine {..}; intros; refl

/-- The composition of two semiring homomorphisms is a semiring homomorphism. -/
lemma comp (hf : is_semiring_hom f) {γ} [semiring γ] {g : β → γ} (hg : is_semiring_hom g) :
  is_semiring_hom (g ∘ f) :=
{ map_zero := by simpa [map_zero hf] using map_zero hg,
  map_one := by simpa [map_one hf] using map_one hg,
  map_add := λ x y, by simp [map_add hf, map_add hg],
  map_mul := λ x y, by simp [map_mul hf, map_mul hg] }

/-- A semiring homomorphism is an additive monoid homomorphism. -/
lemma to_is_add_monoid_hom (hf : is_semiring_hom f) : is_add_monoid_hom f :=
{ ..‹is_semiring_hom f› }

/-- A semiring homomorphism is a monoid homomorphism. -/
lemma to_is_monoid_hom (hf : is_semiring_hom f) : is_monoid_hom f :=
{ ..‹is_semiring_hom f› }

end is_semiring_hom

/-- Predicate for ring homomorphisms (deprecated -- use the bundled `ring_hom` version). -/
structure is_ring_hom {α : Type u} {β : Type v} [ring α] [ring β] (f : α → β) : Prop :=
(map_one [] : f 1 = 1)
(map_mul [] : ∀ {x y}, f (x * y) = f x * f y)
(map_add [] : ∀ {x y}, f (x + y) = f x + f y)

namespace is_ring_hom

variables {β : Type v} [ring α] [ring β]

/-- A map of rings that is a semiring homomorphism is also a ring homomorphism. -/
lemma of_semiring {f : α → β} (H : is_semiring_hom f) : is_ring_hom f := {..H}

variables {f : α → β} (hf : is_ring_hom f) {x y : α}

/-- Ring homomorphisms map zero to zero. -/
lemma map_zero (hf : is_ring_hom f) : f 0 = 0 :=
calc f 0 = f (0 + 0) - f 0 : by rw [hf.map_add]; simp
     ... = 0 : by simp

/-- Ring homomorphisms preserve additive inverses. -/
lemma map_neg (hf : is_ring_hom f) : f (-x) = -f x :=
calc f (-x) = f (-x + x) - f x : by rw [hf.map_add]; simp
        ... = -f x : by simp [hf.map_zero]

/-- Ring homomorphisms preserve subtraction. -/
lemma map_sub (hf : is_ring_hom f) : f (x - y) = f x - f y :=
by simp [sub_eq_add_neg, hf.map_add, hf.map_neg]

/-- The identity map is a ring homomorphism. -/
lemma id : is_ring_hom (@id α) := by refine {..}; intros; refl

/-- The composition of two ring homomorphisms is a ring homomorphism. -/
-- see Note [no instance on morphisms]
lemma comp (hf : is_ring_hom f) {γ} [ring γ] {g : β → γ} (hg : is_ring_hom g) :
  is_ring_hom (g ∘ f) :=
{ map_add := λ x y, by simp [map_add hf]; rw map_add hg; refl,
  map_mul := λ x y, by simp [map_mul hf]; rw map_mul hg; refl,
  map_one := by simp [map_one hf]; exact map_one hg }

/-- A ring homomorphism is also a semiring homomorphism. -/
lemma to_is_semiring_hom (hf : is_ring_hom f) : is_semiring_hom f :=
{ map_zero := map_zero hf, ..‹is_ring_hom f› }

lemma to_is_add_group_hom (hf : is_ring_hom f) : is_add_group_hom f := { map_add := hf.map_add }

end is_ring_hom

variables {β : Type v} {γ : Type w} [rα : semiring α] [rβ : semiring β]

namespace ring_hom

section
include rα rβ

/-- Interpret `f : α → β` with `is_semiring_hom f` as a ring homomorphism. -/
def of {f : α → β} (hf : is_semiring_hom f) : α →+* β :=
{ to_fun := f,
  .. monoid_hom.of hf.to_is_monoid_hom,
  .. add_monoid_hom.of hf.to_is_add_monoid_hom }

@[simp] lemma coe_of {f : α → β} (hf : is_semiring_hom f) : ⇑(of hf) = f := rfl

lemma to_is_semiring_hom (f : α →+* β) : is_semiring_hom f :=
{ map_zero := f.map_zero,
  map_one := f.map_one,
  map_add := f.map_add,
  map_mul := f.map_mul }

end

lemma to_is_ring_hom {α γ} [ring α] [ring γ] (g : α →+* γ) : is_ring_hom g :=
is_ring_hom.of_semiring g.to_is_semiring_hom

end ring_hom


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

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 := begin
    ext,
    split,
    {
      assume h,
      cases h with h1 h2,
      rcases h2 with ⟨n, hn⟩,
      use [n, hn],
    },{
      assume h,
      cases h with h1 h2,
      use 0,
      unfold closure,
      use {x : ℤ | (α * x) - ↑x},
      use h2,
      rw ← h1,
      rw set.mem_Icc,
      linarith,
    }
end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j),
  from
    begin
      assume i j hij,
      assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
      have h3 : α * ↑i = α * ↑j, from by auto [int.fract_eq] using [h2],
      have h4 : α = (↑i - ↑j)*⁻¹*(↑i - ↑j), from by auto using [h3, mul_eq_inv_mul_left, zero_ne_one, hα_irrat],
      have h5 : α = (↑j - ↑i)*⁻¹*(↑j - ↑i), from by auto [h4],
      have h6 : α = (↑j - ↑i)*⁻¹*(↑i - ↑j), from by auto [h5, mul_comm],
      have h7 : α = (↑j - ↑i)*⁻¹*(↑i - ↑j), from by auto [h6, h4, mul_comm],
      have h8 : α = (↑j - ↑i)*⁻¹, from by auto [h7, one_mul],
      have h9 : α = (↑i - ↑j)*⁻¹, from by auto [h8, mul_comm],
      have h10 : (↑j - ↑i)*⁻¹ = (↑i - ↑j)*⁻¹, from by auto [h9, h8],
      have h11 : (↑j - ↑i) = (↑i - ↑j), from by auto using [inv_eq_inv],
      rw h11 at hij,
      exact absurd hij dec_trivial,
    end,
  have h2 : ∀ i j ∈ @set.univ ℤ, i ≠ j → int.fract (α * ↑ i) ≠ int.fract (α * ↑ j), from by auto [h1],
  have h3 : ∀ i : ℤ, i ∈ @set.univ ℤ → i ≠ 0, from by auto [eq_zero_iff_iff_neg_eq_zero],

  have h4 : ∀ (x y : ℤ) (hx : x ∈ @set.univ ℤ) (hy : y ∈ @set.univ ℤ), ∃ (n : ℤ), n ≠ 0 ∧ int.fract (n * x) = int.fract (n * y),
  from
    begin
      assume (x y : ℤ) (hx : x ∈ @set.univ ℤ) (hy : y ∈ @set.univ ℤ),
      cases decidable.em (x = y) with hxey hyey,
      { use 1,
        have h2 : int.fract (1 * x) = int.fract (1 * y), from by auto [hxey],
        rwa ← h2 at hxey,
        from and.intro hxey dec_trivial,
      },
      { use 1,
        have h2 : int.fract (1 * x) = int.fract (1 * y), from by auto [int.fract_mul, int.fract_mul],
        rw h2 at hyey,
        from and.intro hyey dec_trivial,
      }
    end,

  have h5 : ∀ i ∈ @set.univ ℤ, ∃ n : ℕ, ∀ j ∈ @set.univ ℤ, j ≠ i → int.fract (↑ n * i) ≠ int.fract (↑ n * j),
  from
    begin
      assume i hi,
      cases nat.find (λ n, ∀ j ∈ @set.univ ℤ, j ≠ i → int.fract (↑n * i) ≠ int.fract (↑n * j)) with h6 h7,
      use h6,
      assume j hj,
      assume h8 : j ≠ i,
      have h9 : ∀ (x y : ℤ) (hx : x ∈ @set.univ ℤ) (hy : y ∈ @set.univ ℤ), ∃ (n : ℤ), n ≠ 0 ∧ int.fract (n * x) = int.fract (n * y), from by auto [h4],
      have h10 : ∃ (n : ℤ), n ≠ 0 ∧ int.fract (n * i) = int.fract (n * j), from by auto [h9, hi, hj, h8],
      cases h10 with n h11,
      have h12 : n ≠ 0, from and.left h11,
      have h13 : int.fract (n * i) = int.fract (n * j), from and.right h11,
      have h14 : int.nat_abs n ≤ h6, from by auto [h12, nat.find_spec, h7, hj, hi, h13, h8],
      rw h13 at h8,
      exact absurd h8 dec_trivial,
    end,

  have h6 : ∀ i j ∈ @set.univ ℤ, i ≠ j → ∃ n : ℕ, ∀ k ∈ @set.univ ℤ, k ≠ i → k ≠ j → int.fract (↑ n * i) ≠ int.fract (↑ n * k),
  from
    begin
      assume i j hi hj hi_ne_hj,
      have h1 := h5 i hi,
      have h2 := h5 j hj,
      have h3 : (λ (k : ℕ), k^2) ∈ set.range (λ (n : ℕ), n^2), from by auto [pow_two],
      have h4 : ∃ (n : ℕ), int.nat_abs (↑n * i - ↑n * j) < int.nat_abs (↑n * i),
      from
        begin
          cases set.never_equal_to_this : (λ (n : ℕ), int.nat_abs (↑n * i - ↑n * j) < int.nat_abs (↑n * i)) with h5 h6,
          { use 1,
            rw h6,
            have h7 : int.nat_abs (↑(1) * i - ↑(1) * j) < int.nat_abs (↑(1) * i), from by auto [hj, hi, hi_ne_hj, int.nat_abs_neg, int.nat_abs_of_nonneg, int.le_add_left],
            rw int.nat_abs_of_nonneg (zero_le _) at h5,
            have h8 : int.nat_abs (↑(1) * i - ↑(1) * j) < int.nat_abs (↑(1) * i), from by auto [hj, hi, hi_ne_hj, int.nat_abs_neg, int.nat_abs_of_nonneg, int.le_add_left],
            rw int.nat_abs_of_nonneg (zero_le _) at h5,
            exact h8,
          },
          { cases h4 with h5 h5,
            have h6 : ∃ (n : ℕ), int.nat_abs (↑n * i - ↑n * j) < int.nat_abs (↑n * i), from by auto [h5],
            exact h6,
          }
        end,
      cases h4 with n h4,
      use (n+1),
      assume k hk,
      assume h7,
      have h8 : int.fract (↑(n+1) * i) ≠ int.fract (↑(n+1) * j),
      from by auto [h1, h2, hk, hj, hi, h7],
      have h9 : int.nat_abs (int.fract (↑(n+1) * i - int.fract (
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have seq_limit : (ℤ → ℝ) → ℝ → Prop :=  λ (u : ℤ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε,

  have h1 : set.Icc 0 1 = (closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ))) ∪ (set.Ioc 0 1),
  from by auto [closure_eq_of_is_closed_compl, is_closed_Icc, is_open_Ioc, set.preimage_univ, compl_eq_univ_diff],
  have h2 : set.Ioc 0 1 ⊆ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)),
  from by auto [h1],

  have h3 : closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1,
  from by auto [h1],

  have h4 : ∀ (i j : ℤ),  i ≠ j → ((λ (m : ℤ), int.fract (α * ↑m)) i) ≠ ((λ (m : ℤ), int.fract (α * ↑m)) j),
  from by auto [hα_irrat.uniq_diff_rat_of_irrat],

  have h5 : ∀ (i j : ℤ),  i ≠ j → 0 ∉ ((λ (m : ℤ), int.fract (α * ↑m)) '' (set.Iio i j)),
  from by auto [h4],

  have h6 : ((λ (m : ℤ), int.fract (α * ↑m)) '' (set.Iio 0 1)) ⊆ ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)),
  from by auto [fractional_parts_rational],

  have h7 : 0 ∉ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (set.Iio 0 1)),
  from by auto [h5, h6],

  have h8 : ∀ {x : ℤ}, (int.fract (α * ↑x)) ∈ set.Iio 0 1,
  from by auto [mul_nonneg, mul_nonpos, int.coe_nat_nonneg, int.coe_nat_nonneg],

  have h9 : ∀ {x : ℤ}, (int.fract (α * ↑x)) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)),
  from by auto [h8, set.mem_closure_iff_nhds],

  have h10 : ∀ {x : ℤ}, (int.fract (α * ↑x)) ∈ set.Ioc 0 1,
  from by auto [h8, set.mem_Ioc_iff],

  have h11 : ∀ {x : ℤ}, (int.fract (α * ↑x)) ∈ set.Icc 0 1,
  from by auto [h10, set.mem_Icc_iff],

  have h12 : ∀ {x : ℤ}, (int.fract (α * ↑x)) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)),
  from by auto [h11, h3],

  have h13 : ∀ {x : ℤ}, (int.fract (α * ↑x)) ∈ set.Icc 0 1,
  from by auto [h12, h3],

  have h14 : closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1,
  from by auto [h13, set.subset.refl],

  have h15 : set.Ioc 0 1 = set.Icc 0 1,
  from by auto [set.Icc_eq_Ioc, h2, h3, set.eq_of_subset_of_subset],

  show set.Icc 0 1 = closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)),
  from by auto [h13, h14, set.eq_of_subset_of_subset, set.eq_of_subset_of_subset, h15],
end

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : ∀ m n, m ≠ n → (λ m : ℤ, int.fract (α * ↑m)) m ≠ (λ m : ℤ, int.fract (α * ↑m)) n,
  from by auto [int.fract_def, irrational_iff_not_rat, irrational_iff_sqrt_not_rat] {precedence := decimal},

  let S : set ℝ := (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ),
  have h2 : ∀ x : ℤ, (λ (m : ℤ), int.fract (α * ↑m)) x ∈ S := by auto [set.mem_image],
  have h3 : ∃! e : S, ∀ a : S, e ∈ closure a → a ⊆ S := by auto [set.separation],

  have h4 : ∀ x : ℤ, ∃ b : S, x ∈ b := by auto [set.mem_image],

  have h5 : infinite S := by auto [set.finite_univ, h1, infinite],
  have h6 : ∃ l : ℝ, is_limit_point S l := by auto [set.finite_univ, h1, is_limit_point.image, is_limit_point_iff_exists_sequence, is_limit_point_iff_exists_sequence_metric, set.mem_image, set.mem_univ],
  have h7 : ∃ (l : ℝ), is_limit_point S l ∧ l ∈ set.Icc 0 1, from by auto [is_limit_point_iff_exists_sequence],
  have h8 : ∃! l : ℝ, is_limit_point S l ∧ l ∈ set.Icc 0 1, from by auto [set.univ_mem_set_of_eq, set.mem_image, exists_unique.exists, exists_unique.unique, is_limit_point.image],

  have h9 : ∀ y ∈ set.Icc 0 1, ∃ (ε : ℝ) > 0, ∀ x, x ∈ S → |x - y| < ε,  from by auto [set.mem_Icc, classical.em, set.mem_image, set.mem_univ, h4, is_limit_point.image, is_limit_point_iff_exists_sequence, is_limit_point_iff_exists_sequence_metric],

  show closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from by auto [h6, is_limit_point_iff_exists_sequence, is_limit_point_iff_exists_sequence_metric, h8, h9]

end

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h0 : ∀ m n : ℤ, m ≠ n → (int.fract (α*↑m)) ≠ (int.fract (α* ↑n)), from by {assume m n h1, assume h2, have h3 : (α*↑m-int.fract (α* ↑m)) ≠ (α* ↑n-int.fract (α* ↑n)), from by auto [int.fract_eq_iff_eq, h1, hα_irrat], linarith [h2]},
  have h1 : ∀ x y : ℤ, (int.fract (α * ↑x)) = (int.fract (α * ↑y)) ↔ x = y, from by {auto [int.fract_eq_iff_eq, hα_irrat]},
  have h2 : (set.Icc (0:ℝ) 1) ∩ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by auto [fract_bounded, int.fract_lt_one, int.fract_nonneg],
  have h3 : (set.Icc (0:ℝ) 1) ⊆ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by auto [fract_bounded, int.fract_lt_one, int.fract_nonneg],
  have h4 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆  (set.Icc (0:ℝ) 1), from by auto [fract_bounded, int.fract_lt_one, int.fract_nonneg],
  have h5 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ closure (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by auto using [set.subset_closure],
  have h6 : ∀₀ m : ℤ, 0 ≤ int.fract (α * ↑m), from by intros m hm;exact int.fract_nonneg (α * ↑m),
  have h6' : ∀₀ m : ℤ, int.fract (α * ↑m) ≤ 1, from by intros m hm;exact int.fract_lt_one (α * ↑m),
  have h7 : submodule.span ℝ (set.range (λ (m : ℤ), int.fract (α * ↑m))) = set.Icc 0 1, from by auto [set.range_subset_iff, h1, h0, h4, h2, h6, h6', int.fract_lt_one, int.fract_nonneg],
  have h8 : closure (submodule.span ℝ (set.range (λ (m : ℤ), int.fract (α * ↑m)))) ⊆ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto using [set.subset_closure],
  have h9 : closure (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) = closure (submodule.span ℝ (set.range (λ (m : ℤ), int.fract (α * ↑m)))), from by auto [closure_span,h7,h5,h8],
  have h10 : closure (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) = set.Icc (0:ℝ) 1, from by auto [h9, closure_Icc],
  show closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, by auto [h10,h3] using [set.subset_closure]
end

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 := sorry

/--`theorem`
Convergence of a geometric progression
$\lim_{n\to\infty}a_n=\frac{a_1}{1-q}$
`proof`
Let $\epsilon>0$.

Since $\lim_{n\to\infty} a_n=\frac{a_1}{1-q}$, there exists $N\in\mathbb{N}$ such that $|a_n-\frac{a_1}{1-q}|<\epsilon$ for all $n>N$.

We shall now prove that $|a_{n+1}-\frac{a_1}{1-q}|<\epsilon$ for $n>N$ by induction on $n$.

It is easy to see that $|a_{N+1}-\frac{a_1}{1-q}|<\epsilon$.

Now suppose that $|a_n-\frac{a_1}{1-q}|<\epsilon$ for some $n>N$. Then we have
$$
|a_{n+1}-\frac{a_1}{1-q}|=|qa_n+a_1-\frac{a_1}{1-q}|=|\frac{-a_1(1-q)}{1-q}+a_n(q-1)|=|a_n-\frac{a_1}{1-q}|<\epsilon,
$$
which establishes the inductive step.

We can now conclude that $|a_n-\frac{a_1}{1-q}|<\epsilon$ for all $n>N$.

QED
-/
theorem geometric_progression_converges {α : ℝ} (q : ℝ) :
  let seq : ℕ → ℝ :=  λ (n : ℕ), (q ^ n)*α in
  ∀ α, ∃ lim : ℝ, seq_limit seq lim :=
  sorry

/--`theorem`
If $x \in \mathbb{Q}$ and $x$ is algebraic, then $x$ is a root of unity.
`proof`
Suppose that $x=\frac{p}{q}$.

Then $qx=p$.

This means that $q \neq 0$ and $x$ is algebraic. Thus $x$ is a root of unity by the theorem $x$ is algebraic implies $x$ is a root of unity.

Since $x \in \mathbb{Q}$, $x$ must be rational.

QED
-/
theorem rational_algebraic_r-of-unity {α : ℝ} (hα_alg : algebraic α) : ∃ n : ℕ, α = n⁻¹ := by sorry

/--`theorem`
If $x$ is a root of unity, then $x$ is algebraic
`proof`
Suppose that $x$ is a root of unity. Then there exists $n \in \mathbb{N} \setminus \{0\}$ such that $x^n=1$.

Now $1=(x-1)x^{n-1}$, which means that $x$ is a root of the polynomial $f(x)=x^n-1$. This means that $x$ is algebraic.

QED
-/
theorem r-of-unity_algebraic {α : ℝ} (hα_root_of_unity : is_root_of_unity α) : algebraic α := sorry

/--`theorem`
If $x$ is a root of unity, then $x$ is rational
`proof`
Suppose that $x$ is a root of unity. Then there exists $n \in \mathbb{N} \setminus \{0\}$ such that $x^n=1$.

Then $\frac{x+1}{1}=\frac{x^2+x}{x}=\frac{x^2+x+\frac{1-x^n}{1-x}}{x}=\frac{x^2+x+\frac{x(1-x)^{n-1}}{1-x}}{x}=\frac{x^2+x+x^{n-1}}{x}=\frac{x(x+1)}{x}=x+1$, which means that $x$ is rational.

QED
-/
theorem r-of-unity_rational {α : ℝ} (hα_root_of_unity : is_root_of_unity α) : ∃ n : ℕ, α = n⁻¹ := by sorry

/--`theorem`
If $x$ is a root of unity, then $x$ is transcendental
`proof`
Suppose that $x$ is a root of unity. Then there exists $n \in \mathbb{N} \setminus \{0\}$ such that $x^n=1$.

If $x$ is not transcendental, then it is algebraic. This means that $x$ is algebraic by the theorem $x$ is a root of unity implies $x$ is algebraic. But this is a contradiction since algebraic numbers are roots of unity.

QED
-/
theorem r-of-unity_transcendental {α : ℝ} (hα_root_of_unity : is_root_of_unity α) : transcendental α :=
begin
  sorry
end

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
    let S : set ℝ := (λ (n : ℤ), (int.fract (α * ↑n)) : ℤ → ℝ) '' (@set.univ ℤ),
    have h1 : S.infinite,
    from by auto [@set.infinite_of_nonempty ℤ] using [set.Ico_nonempty],
    have h2 : ∃ ⦃a b : ℝ⦄, 0 < a ∧ a < b ∧ b < 1 ∧ ∀ ⦃x : ℝ⦄, a < x ∧ x < b → ∃ ⦃m : ℤ⦄, x ∈ S,
    from exists_pair_in_interval_with_common_neighbours h1,
    -- (⌊ x⌋ + 1 ≠ ⌊ b⌋ ∧ ⌊ x⌋ ≠ ⌊ b⌋) →
    have h3 : ∀ (x : ℝ) ⦃a : ℤ⦄, a ∈ set.Ico (int.nat_abs ((b : ℝ) - x) + 1) (int.nat_abs (((b : ℝ) - x) + 2) + 1)
    → ∃ ⦃n : ℤ⦄, 0 < n ∧ n < b - x ∧ (λ (m : ℤ), int.fract (α * ↑m)) a ∈ S,
    from exists_int_in_set h2,
    have h4 : ∀ (x : ℝ) (m1 : ℤ), (∃ ⦃m : ℤ⦄, 0 < m ∧ m < b - x ∧ (λ (m : ℤ), int.fract (α * ↑m)) m1 ∈ S)
    ↔ (0 < m1 ∧ (∃ ⦃n : ℤ⦄, 0 < n ∧ n < b - x ∧ (λ (m : ℤ), int.fract (α * ↑m)) (m1 - n) ∈ S)),
    from exists_neighbour h2,
    have h5 : ∀ (x : ℝ) (m1 : ℤ), (∃ ⦃m : ℤ⦄, 0 < m ∧ m < 1 - x ∧ (λ (m : ℤ), int.fract (α * ↑m)) m1 ∈ S)
    ↔ (0 < m1 ∧ (∃ ⦃n : ℤ⦄, 0 < n ∧ n < 1 - x ∧ (λ (m : ℤ), int.fract (α * ↑m)) (m1 - n) ∈ S)),
    from exists_neighbour_1 h2,
    have h6 : ∀ (x : ℝ) ⦃a : ℤ⦄, a ∈ set.Ico (int.nat_abs (((1 : ℝ) - x) + 2) + 1) (int.nat_abs (((1 : ℝ) - x) + 1) + 1)
    → ∃ ⦃n : ℤ⦄, 0 < n ∧ n < 1 - x ∧ (λ (m : ℤ), int.fract (α * ↑m)) a ∈ S,
    from exists_int_in_set_1 h2,
    have h7 : ∀ (x : ℝ) (m1 : ℤ), (∃ ⦃m : ℤ⦄, 0 < m ∧ m < x ∧ (λ (m : ℤ), int.fract (α * ↑m)) m1 ∈ S)
    ↔ (0 < m1 ∧ (∃ ⦃n : ℤ⦄, 0 < n ∧ n < x ∧ (λ (m : ℤ), int.fract (α * ↑m)) (m1 + n) ∈ S)),
    from exists_neighbour_0 h2,
    have h8 : ∀ (x : ℝ) ⦃a : ℤ⦄, a ∈ set.Ico (int.nat_abs (x + 1) + 1) (int.nat_abs (x + 2) + 1)
    → ∃ ⦃n : ℤ⦄, 0 < n ∧ n < x ∧ (λ (m : ℤ), int.fract (α * ↑m)) a ∈ S,
    from exists_int_in_set_0 h2,
    have h9 : ∀ (x : ℝ) ⦃a : ℤ⦄, a ∈ set.Ico (int.nat_abs ((b : ℝ) - x) + 1) (int.nat_abs (((b : ℝ) - x) + 1) + 1)
    → ∃ ⦃n : ℤ⦄, 0 < n ∧ n < b - x ∧ (λ (m : ℤ), int.fract (α * ↑m)) a ∈ S,
    from exists_int_in_set_3 h2,
    have h10 : ∀ ⦃x : ℝ⦄, x < b → ∀ ⦃a : ℤ⦄, a ∈ set.Ico (int.nat_abs ((b - x) + 1) + 1) (int.nat_abs ((b - x) + 2) + 1)
    → ∃ ⦃n : ℤ⦄, 0 < n ∧ n < b - x ∧ (λ (m : ℤ), int.fract (α * ↑m)) a ∈ S,
    from int_in_set_2 h2,
    have h11 : ∃ ⦃x : ℝ⦄, 0 < x ∧ x < 1 ∧ ∀ ⦃a : ℤ⦄, a ∈ set.Ico (int.nat_abs (x + 1) + 1) (int.nat_abs (x + 2) + 1)
    → ∃ ⦃n : ℤ⦄, 0 < n ∧ n < x ∧ (λ (m : ℤ), int.fract (α * ↑m)) a ∈ S,
    from exists_x_int_in_set_3 h2,
    have h12 : ∃ ⦃x : ℝ⦄, 0 < x ∧ x < 1 ∧ ∀ ⦃a : ℤ⦄, a ∈ set.Ico (int.nat_abs (x + 1) + 1) (int.nat_abs (x + 2) + 1)
    → ∃ ⦃n : ℤ⦄, 0 < n ∧ n < 1 - x ∧ (λ (m : ℤ), int.fract (α * ↑m)) a ∈ S,
    from exists_x_int_in_set_4 h2,
    have h13 : ∃ ⦃x : ℝ⦄, 0 < x ∧ x < 1 ∧ ∀ ⦃a : ℤ⦄, a ∈ set.Ico (int.nat_abs ((x : ℝ) + 1) + 1) (int.nat_abs ((x : ℝ) + 2) + 1)
    → ∃ ⦃n : ℤ⦄, 0 < n ∧ n < x ∧ (λ (m : ℤ), int.fract (α * ↑m)) a ∈ S,
    from exists_x_int_in_set_5 h2,
    have h14 : ∃ ⦃x : ℝ⦄, 0 < x ∧ x < 1 ∧ ∀ ⦃a : ℤ⦄, a ∈ set.Ico (int.nat_abs ((x : ℝ) + 1) + 1) (int.nat_abs ((x : ℝ) + 2) + 1)
    → ∃ ⦃n : ℤ⦄, 0 < n ∧ n < 1 - x ∧ (λ
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  have h1 : (∀ (n m : ℤ), n ≠ m → (int.fract (α * ↑n)) ≠ (int.fract (α * ↑m))),
  from
  begin
    assume (n m : ℤ) (hnm : n ≠ m),
    assume h1 : (int.fract (α * ↑n)) = (int.fract (α * ↑m)),
    rw h1,
    have h2 : α = (int.fract (α * ↑n)) + (int.fract (α * ↑m)),
    from by linarith,
    have h3 : α = (int.fract (α * ↑n)) + (int.fract (α * ↑n)),
    from by linarith,
    have h4 : α = n * α + (int.fract (α * ↑n)),
    from by linarith,
    have h5 : α = m * α + (int.fract (α * ↑n)),
    from by linarith,
    have h6 : α = n * α + m * α,
    from by linarith,
    have h7 : (n - m) * α = 0,
    from by linarith,
    have h8 : (n - m) = 0,
    from by linarith,
    contradiction,
  end,

  have h2 : ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → (int.fract (α^(n+1))) = 0,
  from
  begin
    apply exists.intro (1),
    assume (n : ℕ) (hn : n ≥ 1),
    have h3 : ↑(n + 1) ∈ (set.range (succ)),
    from set.mem_range_self _,
    have h4 : ↑(n + 1) > 0,
    from by linarith [hn],
    have h5 : (int.fract (α^(↑(n + 1)))) = 0,
    from by linarith [h4],
    show (int.fract (α^(n+1))) = 0,
    from by linarith,
  end,

  have h3 : ∃ (n : ℕ), n ≥ 1 ∧ (int.fract (α^(n+1))) = 0,
  from exists.intro 1 (and.intro (nat.le_succ 1) (by linarith)),

  have h4 : ∀ (n : ℕ), n ≥ 1 → (int.fract (α^(n+1))) = 0,
  from
  begin
    assume (n : ℕ) (hn : n ≥ 1),
    cases h2 with N h2,
    cases h2 n with hnN h2,
    show (int.fract (α^(n+1))) = 0,
    from by linarith,
  end,

  have h5 : ∀ (n : ℕ), n ≥ 1 → ∃ (k : ℤ), (int.fract (α^(n+1))) = k,
  from
  begin
    assume (n : ℕ) (hn : n ≥ 1),
    have h6 : (int.fract (α^(n+1))) = 0,
    from by linarith,
    show ∃ (k : ℤ), (int.fract (α^(n+1))) = k,
    from by linarith,
  end,

  have h6 : ∀ (n : ℕ), n ≥ 1 → ∀ (m : ℕ), m ≥ 1 → ∃ (k : ℤ), (int.fract (α^(n+1))) = k,
  from
  begin
    assume (n m : ℕ) (hn : n ≥ 1) (hm : m ≥ 1),
    have h4 : ∃ (k : ℤ), (int.fract (α^(n+1))) = k,
    from by linarith,
    show ∃ (k : ℤ), (int.fract (α^(n+1))) = k,
    from by linarith [h4],
  end,

  have h7 : ∀ (n : ℕ), ∀ (m : ℕ), n ≥ 1 →  m ≥ 1 → ∃ (x y : ℤ), (int.fract (α^(n+1))) = x ∧ ((int.fract (α^(m+1))) = y),
  from
  begin
    assume (n m : ℕ) (hn : n ≥ 1) (hm : m ≥ 1),
    cases h4 n hn with x hx,
    cases h4 m hm with y hy,
    have h6 : ((int.fract (α^(n+1))) = x ∧ ((int.fract (α^(m+1))) = y)),
    from by linarith,
    show ∃ (x y : ℤ), (int.fract (α^(n+1))) = x ∧ ((int.fract (α^(m+1))) = y),
    from by linarith [h6],
  end,

  have h8 : ∀ (n : ℕ), ∃ (x : ℤ), (int.fract (α^(n+1))) = x,
  from
  begin
    assume (n : ℕ),
    cases h7 n n (le_refl n) (le_refl n) with x hx,
    show ∃ (x : ℤ), (int.fract (α^(n+1))) = x,
    from by linarith [hx],
  end,

  have h9 : ∀ (n : ℕ), ∃ (x : ℤ), (int.fract (α^(n+1))) = x,
  from by auto [h8],

  have h10 : ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → (int.fract (α^(n+1))) = 0,
  from by auto [h2],

  have h11 : ∀ (n : ℕ), ∀ (m : ℕ), n ≥ 1 → m ≥ 1 → int.fract (α^(n+1)) ≤ int.fract (α^(m+1)),
  from
  begin
    assume (n m : ℕ) (hn : n ≥ 1) (hm : m ≥ 1),
    cases h10 with N h10,
    cases h10 m with hmN h10,
    cases h10 with k h10,
    cases h7 n m hn hm with x hy,
    cases hy with y hxhy,
    cases h7 n m hn hm with x hx,
    cases hx with y hxhy,
    have h11 : int.fract (α^(n+1)) ≤ k,
    from by linarith,
    show int.fract (α^(n+1)) ≤ int.fract (α^(m+1)),
    from by linarith [hmN, hmN],
  end,

  have h12 : ∀ (n : ℕ), ∃ (m : ℕ), (int.fract (α^(n+1))) = int.fract (α^(m+1)),
  from
  begin
    assume (n : ℕ),
    cases classical.em (n = 0) with hn hn,
    show ∃ (m : ℕ), (int.fract (α^(n+1))) = int.fract (α^(m+1)),
    from by linarith [hn],
    assume hn : n ≠ 0,
    cases h2 with N h2,
    cases h2 n with hnN h2,
    have h13 : int.fract (α^(n+1)) = 0,
    from by linarith,
    have h14 : n + 1 ≥ N + 1,
    from by linarith [nat.succ_le_succ],
    have h15 : int.fract (α^(n+1)) = int.fract ((α ^ (N+1))),
    from by linarith,

end --Needs more than 2000 tokens!

--OUTPUT 9
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
   have h1 : real.sqrt(2) ∉ ℚ, from by simpa,

   have h2 : irrational (real.sqrt 2) := by exact h1,

   have h3 : ∃ a b, a ∈ (λ (m : ℤ), int.fract (sqrt 2 * ↑m)) '' set.univ ∧
   b ∈ (λ (m : ℤ), int.fract (sqrt 2 * ↑m)) '' set.univ ∧ a ≠ b,
   from by auto [h2, int.fract_ne_zero],

   have h4 : closure ((λ (m : ℤ), int.fract (sqrt 2 * ↑m)) '' (@set.univ ℤ)) ≠ ∅,
   from by auto [set.mem_closure_iff, h3],

   have h5 : (λ (m : ℤ), int.fract (sqrt 2 * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1,
   from by auto [int.fract_le_one],

   have h6 : closure ((λ (m : ℤ), int.fract (sqrt 2 * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1,
   from by auto [set.closure_mono],

   have h7 : set.Icc 0 1 ⊆ closure ((λ (m : ℤ), int.fract (sqrt 2 * ↑m)) '' (@set.univ ℤ)),
   from by auto [set.mem_Icc, set.mem_closure_iff],

   have h8 : set.Icc 0 1 = closure ((λ (m : ℤ), int.fract (sqrt 2 * ↑m)) '' (@set.univ ℤ)),
   from by auto [set.subset_iff, h4, h5, h6, h7],

   show closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1,
   from by simp [h8, mul_comm],
end

--OUTPUT 10
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  refine le_antisymm _ (closure_subset_Icc _ _),
  { exact closure_mono _ (set.image_subset_iff.mpr int.fract_int_subset) },
  { apply dense_iff.mpr,
    { exact dense_fractional_part_image_int },
    {
        assume x hx_in,
        have hx_in_int : x ∈ univ,
        from ⟨int.fract_int x, by simp [x]⟩,
        obtain ⟨q₀, hq₀, hq₀_in⟩ : ∃ (q : ℤ), x < q + 1 ∧ q ∈ univ, from exists_nat_one_lt hx_in,
        have hα_pos : 0 < α, from hx_in.2.1,
        have hx_nonneg : 0 ≤ x, from hx_in.2.2,
        obtain ⟨⟨q₁, hq₁_in, hq₁⟩, ⟨q₂, hq₂_in, hq₂⟩⟩ : ∃ (q₁ q₂ : ℤ), x < q₁ ∧ q₁ ∈ univ ∧ q₂ ≤ x ∧ q₂ ∈ univ,
        from exists_nat_add_one_lt hq₀_in,
        have hq₁_nat : 0 < q₁, from hq₁,
        have hq₂_nat : 0 < q₂, from lt_of_le_of_lt hq₂.2 hq₂,
        have hx_nat : 0 < x, from lt_of_le_of_lt hq₂.2 hq₂,
        have hq_pos : 0 < (q₁ + q₂ : ℤ), from add_pos hq₁_nat hq₂_nat,
        have hqpos_nat : 0 < ↑(q₁ + q₂), from hq_pos,
        have hrecip : (↑(q₁ + q₂))⁻¹ > 0, from recip_pos hqpos_nat,
        obtain ⟨N, hN⟩ : ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → |(↑(q₁ + q₂))⁻¹ * α - ↑(q₁ + q₂)⁻¹ * (q₁ + q₂ : ℤ) * ↑n| < 1, from exists_rational_neighbourhood hα_irrat hα_pos,
        have h1 : |(↑(q₁ + q₂))⁻¹ * α - ↑(q₁ + q₂)⁻¹ * (q₁ + q₂ : ℤ) * ↑N| < 1, from hN N (le_refl N),
        have h2 : |(↑(q₁ + q₂))⁻¹ * α - ↑(q₁ + q₂)⁻¹ * (q₁ + q₂ : ℤ) * ↑N| ≤ 1, from h1,
        have h3 : 1 ≤ (↑(q₁ + q₂))⁻¹ * ↑(q₁ + q₂), from by {rw mul_one, exact le_refl _},
        have h4 : ↑(q₁ + q₂)⁻¹ * ↑(q₁ + q₂) ≤ (↑(q₁ + q₂))⁻¹ * ↑(q₁ + q₂), from le_refl _,
        have h5 : (↑(q₁ + q₂))⁻¹ * ↑(q₁ + q₂) ≤ 1, from le_of_le_of_ge h4 h3,
        have h6 : (↑(q₁ + q₂))⁻¹ * ↑(q₁ + q₂) ≤ |(↑(q₁ + q₂))⁻¹ * α - ↑(q₁ + q₂)⁻¹ * (q₁ + q₂ : ℤ) * ↑N|, from le_of_le_of_ge h5 h2,
        have h7 : -((↑(q₁ + q₂))⁻¹ * ↑(q₁ + q₂)) ≤ |(↑(q₁ + q₂))⁻¹ * α - ↑(q₁ + q₂)⁻¹ * (q₁ + q₂ : ℤ) * ↑N|, from le_of_le_of_ge (neg_le_neg_of_le h6) (neg_nonpos_of_nonneg hq_pos),
        have h8 : -((↑(q₁ + q₂))⁻¹ * ↑(q₁ + q₂)) ≤ -1, from le_of_le_of_ge h7 h5,
        have h9 : -((↑(q₁ + q₂))⁻¹ * ↑(q₁ + q₂)) ≤ -1, from h8,
        have h10 : -1 ≤ (↑(q₁ + q₂))⁻¹ * ↑(q₁ + q₂), from le_of_le_of_ge h9 h3,
        have h11 : -1 ≤ (↑(q₁ + q₂))⁻¹ * (q₁ + q₂), from by {rw mul_comm, exact h10},
        have h12 : -((↑(q₁ + q₂))⁻¹) ≤ -((↑(q₁ + q₂))⁻¹ * (q₁ + q₂))⁻¹, from by {rw neg_inv_of_neg_of_pos hq_pos, exact h11},
        have h13 : -((↑(q₁ + q₂))⁻¹) ≤ -((↑(q₁ + q₂))⁻¹ * (q₁ + q₂))⁻¹, from h12,
        have h14 : -((↑(q₁ + q₂))⁻¹) * ((↑(q₁ + q₂))⁻¹ * (q₁ + q₂)) ≤ ((↑(q₁ + q₂))⁻¹ * (q₁ + q₂)) * (-((↑(q₁ + q₂))⁻¹)), from mul_le_mul_of_nonneg_left h13 (le_of_lt hrecip),
        have h15 : -1 ≤ ((↑(q₁ + q₂))⁻¹ * (q₁ + q₂)) * (-((↑(q₁ + q₂))⁻¹)), from h14,
        have h16 : -(↑(q₁ + q₂)⁻¹) ≤ ((↑(q₁ + q₂))⁻¹ * (q₁ + q₂)) * (-((↑(q₁ + q₂))⁻¹)), from h15,
        have h17 : -(↑(q₁ + q₂)⁻¹) ≤ ((↑(q₁ + q₂))⁻¹ * (q₁ + q₂)) * (-1), from h16,
        have h18 : -(↑(q₁ + q₂)⁻¹) ≤ (↑(q₁ + q₂
end --Needs more than 2000 tokens!

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

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

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

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

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

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

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

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

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

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

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

Setting $b = a$, this becomes:

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

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

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

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by auto [abs_sub_lt_iff] using [linarith],

  assume (h7 : ε > 0),

  cases h2 ε h7 with N1 h8,
  cases h3 ε h7 with N2 h9,
  let N := max N1 N2,
  use N,

  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by auto [lt_of_le_of_lt, le_max_left, le_max_right],

  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by auto [h8, h10, h5, h9],

  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by auto [h11] using [linarith],

  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by auto [h5, h15],

end

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

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

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

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


import dialectica

open formula

section

parameters {ι : Type} {gri : ground_interpretation ι}
local notation `𝔽` := formula ι gri
local notation `𝕋` := type ι gri

-- structure majorizability :=
-- (𝕄 : 𝕋 → 𝕋)
-- (𝕄_inh : ∀ {σ : 𝕋}, ∥𝕄 σ∥)
-- (𝕄_𝕆 : 𝕄 𝕆 = 𝕆)
-- (𝕄_app : ∀ (σ τ : 𝕋), 𝕄 (σ ↣ τ) = ((𝕄 σ) ↣ (𝕄 τ)))
-- (majorizable : ∀ {σ : 𝕋}, ∥σ∥ → Prop)
-- (majorizes : ∀ {σ : 𝕋}, ∥σ∥ → ∥𝕄 σ∥ → Prop)
-- (majorizer : ∀ {σ : 𝕋} (x : ∥σ∥), {x' : ∥𝕄 σ∥ // majorizable x → majorizes x x'})
-- (majorizer_app : ∀ (σ τ : 𝕋) (x : σ) (x' : 𝕄 σ) (y : σ ↣ τ) (y' : 𝕄 (σ ↣ τ)), majorizes x x' → majorizes y y' → majorizes (y x) (y' x'))

class maj_type (𝕄 : 𝕋 → 𝕋) :=
(𝕄_𝕆 : 𝕄 𝕆 = 𝕆)
(𝕄_app (σ τ : 𝕋) : 𝕄 (σ ↣ τ) = (𝕄 σ ↣ 𝕄 τ))

attribute [simp] maj_type.𝕄_app

@[simp]
lemma l' {𝕄 : 𝕋 → 𝕋} [maj_type 𝕄] : ∥𝕄 𝕆∥ = ℕ := sorry

@[simp]
lemma l {𝕄 : 𝕋 → 𝕋} [maj_type 𝕄] {σ τ : 𝕋} : ∥𝕄 (σ ↣ τ)∥ = (∥𝕄 σ∥ → ∥𝕄 τ∥) := sorry

instance i {𝕄 : 𝕋 → 𝕋} [maj_type 𝕄] : linear_order ∥𝕄 𝕆∥ := by {
  simp only [l'],
  exact nat.linear_order,
}

structure majorizability (𝕄 : 𝕋 → 𝕋) [maj_type 𝕄] :=
(majorizes : ∀ {σ : 𝕋}, ∥σ∥ → ∥𝕄 σ∥ → Prop)
(majorizes_le : ∀ {x : ∥𝕆∥} {x' : ∥𝕄 𝕆∥}, majorizes x x' → x ≤ type.cast (maj_type.𝕄_𝕆) x')
(majorizes_app : ∀ {σ τ : 𝕋} (x : ∥σ∥) (x' : ∥𝕄 σ∥) (y : ∥σ ↣ τ∥) (y' : ∥𝕄 (σ ↣ τ)∥),
  majorizes x x' → majorizes y y' → majorizes (y x) ((type.cast (maj_type.𝕄_app _ _) y') x'))
(majorizer : Π {σ : 𝕋}, ∥σ∥ → ∥𝕄 σ∥)
(majorizer_majorizes : ∀ {σ : 𝕋} (x : ∥σ∥), majorizes x (majorizer x))
-- attribute [simp, reducible] majorizability.𝕄_𝕆

end

#check maj_type