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
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from assume i j h,
  begin
    assume h2,
    have h3 : α = (int.fract (α * ↑i) - int.fract (α * ↑j)) / (i - j), from by {
      rw [← int.fract_add_int (α * ↑i), ← int.fract_add_int (α * ↑j), ← int.fract_mul α i, ← int.fract_mul α j, ← int.fract_add_int (α * ↑i), ← int.fract_add_int (α * ↑j), int.fract_eq_of_eq h2],
      ring,
    },
    have h4 : (i - j) ≠ 0, from by {
      assume h5,
      rw [h5, sub_self] at h3,
      have h6 : α = 0, from by {
        rw [← int.fract_eq_of_eq h3, int.fract_zero],
      },
      exact absurd h6 hα_irrat,
    },
    have h7 : (i - j) ∈ @set.univ ℤ, from by {
      rw [set.mem_univ],
    },
    have h8 : (i - j) ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)), from by {
      rw [set.mem_range],
      use (int.fract (α * ↑(i - j))),
      rw [← int.fract_mul α (i - j), ← int.fract_add_int (α * ↑i), ← int.fract_add_int (α * ↑j), int.fract_eq_of_eq h3, int.fract_zero],
      ring,
    },
    have h9 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h10 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h11 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h12 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h13 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h14 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h15 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h16 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h17 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h18 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h19 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h20 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h21 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h22 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h23 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h24 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h25 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h26 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h27 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h28 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h29 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h30 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h31 : (i - j) ∈ (set.range (λ (m : ℤ), int.fract (α * ↑m))) ∩ set.univ, from by {
      split,
      exact h8,
      exact h7,
    },
    have h32 : (i -
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  --Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by {
    assume i j : ℤ,
    assume h2 : i ≠ j,
    assume h3 : (int.fract (α * ↑i)) = (int.fract (α * ↑j)),
    have h4 : α = (α * ↑i - int.floor (α * ↑i)) / ↑(i - j), from by {
      rw [← h3, int.fract_eq_iff_eq_or_eq_add_one],
      rw [← int.fract_eq_iff_eq_or_eq_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [int.fract_add_one, int.fract_add_one],
      rw [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
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
  begin
    assume i j h,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α = (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) / (i - j), from by {
      rw [h2, int.fract_add_nat_abs, int.nat_abs_of_nonneg (le_of_lt (mul_pos hα_irrat (int.coe_nat_pos.2 (nat.zero_lt_succ 0)))), int.coe_nat_mul, int.coe_nat_mul],
      rw [int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add],
      rw [int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add],
      rw [int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add, int.coe_nat_add],
    },
    have h4 : α ∈ ℚ, from by {
      apply int.coe_nat_ne_zero_iff_pos.1,
      assume h5 : i - j = 0,
      have h6 : i = j, from by {rw h5, ring},
      contradiction,
    },
    exact hα_irrat h4,
  end,

  -- 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}$.
  have h2 : ∀ i j : ℤ, i ≠ j → α ≠ (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j), from
  begin
    assume i j h,
    assume h3 : α = (int.nat_abs (α * ↑i) - int.nat_abs (α * ↑j)) / (i - j),
    have h4 : α ∈ ℚ, from by {
      apply int.coe_nat_ne_zero_iff_pos.1,
      assume h5 : i - j = 0,
      have h6 : i = j, from by {rw h5, ring},
      contradiction,
    },
    exact hα_irrat h4,
  end,

  -- Hence,
  -- $$
  -- S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  -- $$
  -- is an infinite subset of $\left[0,1\right]$.
  have h3 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))) = ff, from
  begin
    apply set.finite_iff_fintype.2,
    apply set.fintype_range_int_fract,
  end,
  have h4 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))), from by {
    rw h3,
  },
  have h5 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))) = tt, from by {
    apply set.finite_iff_fintype.1,
    apply set.fintype_range_int_fract,
  },
  have h6 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))), from by {
    rw h5,
  },
  have h7 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))), from by {
    rw h4,
  },
  have h8 : (set.range (λ m : ℤ, int.fract (α * ↑m))) ≠ ∅, from by {
    apply set.nonempty_range_int_fract,
    exact hα_irrat,
  },
  have h9 : set.finite (set.range (λ m : ℤ, int.fract (α * ↑m))), from by {
    rw h4,
  },

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h10 : ∃ x : ℝ, x ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)) ∧ x ∈ closure (set.range (λ (m : ℤ), int.fract (α * ↑m))), from by {
    apply set.exists_mem_of_ne_empty,
    apply h8,
    have h11 : set.range (λ (m : ℤ), int.fract (α * ↑m)) ⊆ set.Icc 0 1, from by {
      rintros x h12,
      rcases h12 with ⟨m, h13⟩,
      rw h13,
      rw int.fract_lt_one,
    },
    apply set.subset_closure,
    exact h11,
  },
  cases h10 with x h11,
  cases h11 with h12 h13,

  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h14 : ∀ ε > 0, ∃ (x y : ℤ), x ≠ y ∧ int.fract (α * ↑x) ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)) ∧ int.fract (α * ↑y) ∈ set.range (λ (m : ℤ), int.fract (α * ↑m)) ∧ abs (int.fract (α * ↑x) - int.fract (α * ↑y)) < ε, from
  begin
    assume ε h15,
    cases h13 ε h15 with N h16,
    use (N+1),
    use N,
    split,
    exact nat.succ_ne_self N,
    split,
    exact h16 (nat.succ_le_of_lt (nat.lt_succ_self N)),
    split,
    exact h16 (nat.le_refl N),
    have h17 : int.fract (α * ↑(N+1)) - int.fract (α * ↑N) = α * ↑(N+1) - (α * ↑N - int.nat_abs (α * ↑N)), from by {
      rw int.fract_add_nat_abs,
      rw int.nat_abs_of_nonneg (le_of_lt (mul_pos hα_irrat (int.coe_nat_pos.2 (nat.zero_lt_succ 0)))),
      ring,
    },
    have h18 : int.fract (α * ↑(N+1)) - int.fract (α * ↑N) = α - int.nat_abs (α * ↑N), from
end --Needs more than 2000 tokens!

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

  --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]$.
  have h2 : ∀ (i : ℤ), int.fract (α * ↑i) ∈ set.Icc 0 1, from by {
    assume i : ℤ,
    have h3 : int.fract (α * ↑i) ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
      use i, rw set.mem_univ,
    },
    show int.fract (α * ↑i) ∈ set.Icc 0 1, from by {
      apply set.mem_Icc.2,
      split; linarith,
    },
  },

  have h3 : ∀ (i : ℤ), int.fract (α * ↑i) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    assume i : ℤ,
    rw closure_eq_nhds,
    use i,
    use (int.fract (α * ↑i)),
    split,
    exact h2 i,
    use 1,
    split,
    linarith,
    linarith,
  },

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h4 : ∃ (x : ℝ), x ∈ set.Icc 0 1 ∧ x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    apply set.compact_Icc.exists_mem_of_finite_subcover,
    have h5 : ∀ (i : ℤ), ∃ (ε : ℝ), ε > 0 ∧ ∀ (x : ℝ), x ∈ set.Icc 0 1 ∧ |x - int.fract (α * ↑i)| < ε → x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
      assume i : ℤ,
      use 1,
      split,
      linarith,
      assume x : ℝ,
      assume h6 : x ∈ set.Icc 0 1 ∧ |x - int.fract (α * ↑i)| < 1,
      have h7 : x ∈ (λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
        use i,
        split,
        rw set.mem_univ,
        rw h6.right,
      },
      show x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
        rw closure_eq_nhds,
        use i,
        use x,
        split,
        exact h7,
        use 1,
        split,
        linarith,
        linarith,
      },
    },
    have h8 : ∀ (i : ℤ), ∃ (ε : ℝ), ε > 0 ∧ ∀ (x : ℝ), x ∈ set.Icc 0 1 ∧ |x - int.fract (α * ↑i)| < ε → x ∈ set.Icc 0 1, from by {
      assume i : ℤ,
      use 1,
      split,
      linarith,
      assume x : ℝ,
      assume h9 : x ∈ set.Icc 0 1 ∧ |x - int.fract (α * ↑i)| < 1,
      show x ∈ set.Icc 0 1, from by {
        exact h9.left,
      },
    },
    use h8,
    intros i h10,
    cases h5 i with ε h11,
    use ε,
    split,
    exact h11.left,
    exact h11.right,
  },

  cases h4 with x h5,

  --One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h6 : ∀ (ε : ℝ), ε > 0 → ∃ (y : ℝ), y ∈ set.Icc 0 1 ∧ y ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ |x - y| < ε, from by {
    assume ε : ℝ,
    assume h6 : ε > 0,
    cases h5.right ε h6 with y h7,
    use y,
    split,
    exact h7.left,
    split,
    exact h7.right,
    exact h7.right_1,
  },

  --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$.
  have h8 : 0 ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    rw closure_eq_nhds,
    use x,
    use 0,
    split,
    exact h5.left,
    use 1,
    split,
    linarith,
    linarith,
  },

  --To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  have h9 : ∀ (y : ℝ), y ∈ set.Icc 0 1 → ∀ (ε : ℝ), ε > 0 → ∃ (x : ℝ), x ∈ set.Icc 0 1 ∧ x ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ |y - x| < ε, from by {
    assume (y : ℝ) (h10 : y ∈ set.Icc 0 1),
    assume (ε : ℝ) (h11 : ε > 0),
    cases h6 ε h11 with x h12,
    use x,

end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  --Let $\alpha$ be an irrational number.
  assume α,
  --Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by {
    assume i j h,
    have h2 : (α * ↑i) - (int.floor (α * ↑i)) = int.fract (α * ↑i), from by {
      rw int.fract_eq_sub_floor,
    },
    have h3 : (α * ↑j) - (int.floor (α * ↑j)) = int.fract (α * ↑j), from by {
      rw int.fract_eq_sub_floor,
    },
    have h4 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑j) - (int.floor (α * ↑j)), from by {
      rw [h2,h3],
    },
    have h5 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by {
      rw [←int.cast_div,←int.cast_sub,←int.cast_mul,←int.cast_mul,←int.cast_mul,←int.cast_mul,←int.cast_mul,←int.cast_mul],
      rw [mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub,mul_sub
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number.
  assume α : ℝ,
  assume hα_irrat : irrational α,

  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from
  begin
    assume i j h,
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α = (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) / (i - j), from by {
      rw [int.fract_add_nat_abs_of_nonneg, h2, int.fract_add_nat_abs_of_nonneg],
      rw [int.mul_sub, int.mul_sub, int.mul_sub],
      rw [mul_comm α i, mul_comm α j],
      ring,
    },
    have h4 : (int.fract (α * ↑i) + int.nat_abs (α * ↑i)) / (i - j) ∈ ℚ, from by {
      rw h3,
    },
    have h5 : irrational α, from hα_irrat,
    have h6 : ¬(α ∈ ℚ), from h5,
    show false, from h6 h4,
  end,

  -- 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}$.
  have h7 : ∀ i j : ℤ, i ≠ j → α ≠ (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from
  begin
    assume i j h,
    assume h2 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j),
    have h3 : int.fract (α * ↑i) = int.fract (α * ↑j), from by {
      rw [int.fract_add_nat_abs_of_nonneg, int.fract_add_nat_abs_of_nonneg],
      rw [int.mul_sub, int.mul_sub, int.mul_sub],
      rw [mul_comm α i, mul_comm α j],
      rw h2,
      ring,
    },
    have h4 : i ≠ j, from h,
    have h5 : int.fract (α * ↑i) ≠ int.fract (α * ↑j), from h1 i j h4,
    show false, from h5 h3,
  end,

  -- Hence,
  -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  -- is an infinite subset of $\left[0,1\right]$.
  have h8 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by {
    assume x h,
    cases h with m hm,
    rw ←hm,
    rw int.fract_mul,
    rw int.fract_lt_one,
    rw int.fract_lt_one,
  },
  have h9 : infinite ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    have h10 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from h1,
    have h11 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) i ≠ (λ m : ℤ, int.fract (α * ↑m)) j, from by {
      assume i j h,
      rw [←int.fract_mul, ←int.fract_mul],
      exact h10 i j h,
    },
    have h12 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) i ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
      assume i j h,
      use i,
      refl,
    },
    have h13 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) j ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
      assume i j h,
      use j,
      refl,
    },
    have h14 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) i ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∧ (λ m : ℤ, int.fract (α * ↑m)) j ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by {
      assume i j h,
      split,
      exact h12 i j h,
      exact h13 i j h,
    },
    have h15 : ∀ i j : ℤ, i ≠ j → (λ m : ℤ, int.fract (α * ↑m)) i ≠ (λ m : ℤ, int.fract (α * ↑m)) j, from by {
      assume i j h,
      exact h11 i j h,
    },
    exact set.infinite_of_injective_of_ne_of_ne (λ m : ℤ, int.fract (α * ↑m)) h15 h14,
  },

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h16 : ∃ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by {
    exact set.bounded_has_sup_of_ne_empty h8,
  },

  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h17 : ∀ ε > 0, ∃ x y : ℝ, x ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∧ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∧ abs (x - y) < ε, from by {
    assume ε h,
    cases h16 with x hx,
    have h18 : ∃ y : ℝ, y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∧ abs (x - y) < ε, from by {
      have h19 : ∃ y : ℝ, y ∈ set.Icc 0 1 ∧ abs (x - y) < ε, from by {
        have h20 : ∃ y : ℝ, y ∈ set.Icc 0 1 ∧ abs (x - y) < ε, from by {
          have h21 : ∃ y : ℝ, y ∈
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

/--`theorem`
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) (ε),

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by
  {
    intro x0,
    have h6 : |x0 - l| < ε ↔ ((x0 - l) < ε) ∧ ((l - x0) < ε),
    from abs_sub_lt_iff, rw h6,
    split,
    rintro ⟨ S_1, S_2 ⟩,
    split; linarith,
    rintro ⟨ S_3, S_4 ⟩,
    split; linarith,
    },

  --Let $\epsilon > 0$.
  assume (h7 : ε > 0),

  --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$
  cases h2 ε h7 with N1 h8,

  --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$
  cases h3 ε h7 with N2 h9,

  --Let $N = \max \set {N_1, N_2}$.
  let N := max N1 N2,
  use N,

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by {
    assume n h,
    split,
    exact lt_of_le_of_lt (le_max_left N1 N2) h,
    exact lt_of_le_of_lt (le_max_right N1 N2) h,
  },

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\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$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by {
    intros n h12,
    split,
    {

      have h13 := (h8 n (h10 n h12).left), rw h5 (y n) at h13,
      split,
      exact h13.left,
      exact (h4 n).left,
    },
    {
      have h14 := (h9 n (h10 n h12).right),rw h5 (z n) at h14,
      split,
      exact (h4 n).right,
      exact h14.right,
    },

  },

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by {
    intros n1 h16, cases (h11 n1 h16);
    split; linarith,
  },

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by {
    intros n h17,
    cases h5 (x n) with h18 h19,
    apply h19, exact h15 n h17,
  },
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)-/


structure A :=
(x : Nat := 0)

def foo : A :=
{}

theorem ex1 : foo = { x := 0 } :=
rfl

theorem ex2 : foo.x = 0 :=
rfl

instance : EmptyCollection A :=
⟨{ x := 10 }⟩

def boo : A :=
{}  -- this is ambiguous


-- The young boys are playing outdoors and the man is smiling nearby
-- The kids are playing outdoors near a man with a smile
-- ENTAILMENT

/-
SENT: The young boys are playing outdoors and the man is smiling nearby

<
h1,e3:PROP:PRES:INDICATIVE:+:-,{
h4:_the_q<0:3>(x7:3:PL:+, h6, h5),
h8:_young_a_1<4:9>(e9:PROP:UNTENSED:INDICATIVE:BOOL:-, x7),
h8:_boy_n_1<10:14>(x7),
h2:_play_v_1<19:26>(e10:PROP:PRES:INDICATIVE:+:-, x7, i11),
h2:loc_nonsp<27:35>(e12:PROP:UNTENSED:INDICATIVE:-:-, e10, x13:3:SG),
h14:place_n<27:35>(x13),
h15:def_implicit_q<27:35>(x13, h16, h17),
h14:_outdoors_a_1<27:35>(e18:PROP:UNTENSED:INDICATIVE:-:-, x13),
h2:_and_c<36:39>(e3, e10, e19:PROP:PRES:INDICATIVE:+:-),
h20:_the_q<40:43>(x23:3:SG, h22, h21),h24:_man_n_1<44:47>(x23),
h2:_smile_v_1<51:58>(e19, x23, i25),
h2:_nearby_p<59:65>(e26:PROP:UNTENSED:INDICATIVE:-:-, e19)},
{h1 qeq h2,h6 qeq h8,h16 qeq h14,h22 qeq h24}
>

_the_q(x7, _young_a_1(e9, x7) /\ _boy_n_1(x7),
	   def_implicit_q(x13,
			  place_n(x13) /\ _outdoors_a_1(e18, x13),
			  _the_q(x23, _man_n_1(x23),
				      _play_v_1(e10, x7, i11) /\
				      loc_nonsp(e12, e10, x13) /\
				      _and_c(e3, e10, e19) /\
				      _smile_v_1(e19, x23, i25) /\
				      _nearby_p(e26, e19))))

SENT: The kids are playing outdoors near a man with a smile

<
h1,e3:PROP:PRES:INDICATIVE:+:-,{
h4:_the_q<0:3>(x7:3:PL:+, h6, h5),
h8:_kid_n_1<4:8>(x7),
h2:_play_v_1<13:20>(e3, x7, i9),
h2:loc_nonsp<21:29>(e10:PROP:UNTENSED:INDICATIVE:-:-, e3, x11:3:SG),
h12:place_n<21:29>(x11),
h13:def_implicit_q<21:29>(x11, h14, h15),
h12:_outdoors_a_1<21:29>(e16:PROP:UNTENSED:INDICATIVE:-:-, x11),
h2:_near_p_state<30:34>(e17:PROP:UNTENSED:INDICATIVE:-:-, e3, x18:3:SG:+),
h19:_a_q<35:36>(x18, h21, h20),
h22:_man_n_1<37:40>(x18),
h22:_with_p<41:45>(e23:PROP:UNTENSED:INDICATIVE:-:-, x18, x24:3:SG:+),
h25:_a_q<46:47>(x24, h27, h26),
h28:_smile_n_1<48:53>(x24)},
{h1 qeq h2,h6 qeq h8,h14 qeq h12,h21 qeq h22,h27 qeq h28}>

_the_q(x7, _kid_n_1(x7),
	   def_implicit_q(x11, place_n(x11) /\ _outdoors_a_1(e16, x11),
			       _a_q(x18, _a_q(x24, _smile_n_1(x24),
						   _man_n_1(x18) /\
						   _with_p(e23, x18, x24)),
					 _play_v_1(e3, x7, i9) /\
					 loc_nonsp(e10, e3, x11) /\
					 _near_p_state(e17, e3, x18))))

-/

section TFL

 constant x : Type
 constant e : Type
 constant i : Type
 constant h : Type
 constant _young_a_1 : e → x → Prop
 constant _boy_n_1 : x → Prop
 constant _kid_n_1 : x → Prop
 constant _smile_n_1 : x → Prop
 constant _man_n_1 : x → Prop
 constant place_n : x → Prop
 constant _outdoors_a_1 : e → x → Prop
 constant _play_v_1 : e → x → i → Prop
 constant loc_nonsp : e → e → x → Prop
 constant _smile_v_1 : e → x → i → Prop
 constant _nearby_p : e → e → Prop
 constant _and_c : e → e → e → Prop
 constant _with_p : e → x → x → Prop
 constant _near_p_state : e → e → x → Prop

 def h₁ : Prop := ∃ i11 i25 e10 e26 e12 e3 e19 e9 e18,
  ∃ x7, (_young_a_1 e9 x7 ∧ _boy_n_1 x7) ∧
   (∃ x13, (place_n x13 ∧ _outdoors_a_1 e18 x13) ∧
    (∃ x23, _man_n_1 x23 ∧
            (_play_v_1 e10 x7 i11 ∧ loc_nonsp e12 e10 x13 ∧ _and_c e3 e10 e19 ∧ _smile_v_1 e19 x23 i25 ∧ _nearby_p e26 e19)))

 def h₂ : Prop := ∃ i9 e3 e23 e16 e10 e17,
  ∃ x7, _kid_n_1 x7 ∧
   (∃ x11, (place_n x11 ∧ _outdoors_a_1 e16 x11) ∧
    (∃ x18, (∃ x24, _smile_n_1 x24 ∧ _man_n_1 x18 ∧ _with_p e23 x18 x24) ∧ (_play_v_1 e3 x7 i9 ∧ loc_nonsp e10 e3 x11 ∧ _near_p_state e17 e3 x18)))

theorem my : h₁ → h₂ := by
 unfold h₁
 unfold h₂
 intro h

end TFL


/-
Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.l1_space
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Density of simple functions

Show that each Borel measurable function can be approximated,
both pointwise and in `L¹` norm, by a sequence of simple functions.

## Main definitions

* `measure_theory.simple_func.nearest_pt (e : ℕ → α) (N : ℕ) : α →ₛ ℕ`: the `simple_func` sending
  each `x : α` to the point `e k` which is the nearest to `x` among `e 0`, ..., `e N`.
* `measure_theory.simple_func.approx_on (f : β → α) (hf : measurable f) (s : set α) (y₀ : α)
  (h₀ : y₀ ∈ s) [separable_space s] (n : ℕ) : β →ₛ α` : a simple function that takes values in `s`
  and approximates `f`. If `f x ∈ s`, then `measure_theory.simple_func.approx_on f hf s y₀ h₀ n x`
  tends to `f x` as `n` tends to `∞`. If `α` is a `normed_group`, `f x - y₀`
  is `measure_theory.integrable`, and `f x ∈ s` for a.e. `x`, then
  `simple_func.approx_on f hf s y₀ h₀ n` tends to `f` in `L₁`. The main use case is `s = univ`,
  `y₀ = 0`.

## Notations

* `α →ₛ β` (local notation): the type of simple functions `α → β`.
-/

namespace measure_theory

namespace simple_func

/-- `nearest_pt_ind e N x` is the index `k` such that `e k` is the nearest point to `x` among the
points `e 0`, ..., `e N`. If more than one point are at the same distance from `x`, then
`nearest_pt_ind e N x` returns the least of their indexes. -/
def nearest_pt_ind {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) : ℕ → simple_func α ℕ :=
  sorry

/-- `nearest_pt e N x` is the nearest point to `x` among the points `e 0`, ..., `e N`. If more than
one point are at the same distance from `x`, then `nearest_pt e N x` returns the point with the
least possible index. -/
def nearest_pt {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) (N : ℕ) : simple_func α α :=
  map e (nearest_pt_ind e N)

@[simp] theorem nearest_pt_ind_zero {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) : nearest_pt_ind e 0 = const α 0 :=
  rfl

@[simp] theorem nearest_pt_zero {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) : nearest_pt e 0 = const α (e 0) :=
  rfl

theorem nearest_pt_ind_succ {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) (N : ℕ) (x : α) : coe_fn (nearest_pt_ind e (N + 1)) x =
  ite (∀ (k : ℕ), k ≤ N → edist (e (N + 1)) x < edist (e k) x) (N + 1) (coe_fn (nearest_pt_ind e N) x) := sorry

theorem nearest_pt_ind_le {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) (N : ℕ) (x : α) : coe_fn (nearest_pt_ind e N) x ≤ N := sorry

theorem edist_nearest_pt_le {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] (e : ℕ → α) (x : α) {k : ℕ} {N : ℕ} (hk : k ≤ N) : edist (coe_fn (nearest_pt e N) x) x ≤ edist (e k) x := sorry

theorem tendsto_nearest_pt {α : Type u_1} [measurable_space α] [emetric_space α] [opens_measurable_space α] {e : ℕ → α} {x : α} (hx : x ∈ closure (set.range e)) : filter.tendsto (fun (N : ℕ) => coe_fn (nearest_pt e N) x) filter.at_top (nhds x) := sorry

/-- Approximate a measurable function by a sequence of simple functions `F n` such that
`F n x ∈ s`. -/
def approx_on {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] (f : β → α) (hf : measurable f) (s : set α) (y₀ : α) (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (n : ℕ) : simple_func β α :=
  comp (nearest_pt (fun (k : ℕ) => nat.cases_on k y₀ (coe ∘ topological_space.dense_seq ↥s)) n) f hf

@[simp] theorem approx_on_zero {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (x : β) : coe_fn (approx_on f hf s y₀ h₀ 0) x = y₀ :=
  rfl

theorem approx_on_mem {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (n : ℕ) (x : β) : coe_fn (approx_on f hf s y₀ h₀ n) x ∈ s :=
  (fun (n_1 : ℕ) => nat.cases_on n_1 h₀ fun (n : ℕ) => subtype.mem (topological_space.dense_seq (↥s) n))
    (coe_fn (nearest_pt_ind (fun (k : ℕ) => nat.cases_on k y₀ (coe ∘ topological_space.dense_seq ↥s)) n) (f x))

@[simp] theorem approx_on_comp {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {γ : Type u_3} [measurable_space γ] {f : β → α} (hf : measurable f) {g : γ → β} (hg : measurable g) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (n : ℕ) : approx_on (f ∘ g) (measurable.comp hf hg) s y₀ h₀ n = comp (approx_on f hf s y₀ h₀ n) g hg :=
  rfl

theorem tendsto_approx_on {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] {x : β} (hx : f x ∈ closure s) : filter.tendsto (fun (n : ℕ) => coe_fn (approx_on f hf s y₀ h₀ n) x) filter.at_top (nhds (f x)) := sorry

theorem edist_approx_on_le {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (x : β) (n : ℕ) : edist (coe_fn (approx_on f hf s y₀ h₀ n) x) (f x) ≤ edist y₀ (f x) :=
  id (edist_nearest_pt_le (Nat.rec y₀ fun (n : ℕ) (ih : α) => ↑(topological_space.dense_seq (↥s) n)) (f x) (zero_le n))

theorem edist_approx_on_y0_le {α : Type u_1} {β : Type u_2} [measurable_space α] [emetric_space α] [opens_measurable_space α] [measurable_space β] {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (x : β) (n : ℕ) : edist y₀ (coe_fn (approx_on f hf s y₀ h₀ n) x) ≤ edist y₀ (f x) + edist y₀ (f x) :=
  le_trans (edist_triangle_right y₀ (coe_fn (approx_on f hf s y₀ h₀ n) x) (f x))
    (add_le_add_left (edist_approx_on_le hf h₀ x n) (edist y₀ (f x)))

theorem norm_approx_on_zero_le {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [opens_measurable_space E] {f : β → E} (hf : measurable f) {s : set E} (h₀ : 0 ∈ s) [topological_space.separable_space ↥s] (x : β) (n : ℕ) : norm (coe_fn (approx_on f hf s 0 h₀ n) x) ≤ norm (f x) + norm (f x) := sorry

theorem tendsto_approx_on_l1_edist {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [opens_measurable_space E] {f : β → E} (hf : measurable f) {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] {μ : measure β} (hμ : filter.eventually (fun (x : β) => f x ∈ closure s) (measure.ae μ)) (hi : has_finite_integral fun (x : β) => f x - y₀) : filter.tendsto (fun (n : ℕ) => lintegral μ fun (x : β) => edist (coe_fn (approx_on f hf s y₀ h₀ n) x) (f x))
  filter.at_top (nhds 0) := sorry

theorem integrable_approx_on {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [borel_space E] {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f) {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [topological_space.separable_space ↥s] (hi₀ : integrable fun (x : β) => y₀) (n : ℕ) : integrable ⇑(approx_on f fmeas s y₀ h₀ n) := sorry

theorem tendsto_approx_on_univ_l1_edist {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [opens_measurable_space E] [topological_space.second_countable_topology E] {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f) : filter.tendsto
  (fun (n : ℕ) => lintegral μ fun (x : β) => edist (coe_fn (approx_on f fmeas set.univ 0 trivial n) x) (f x))
  filter.at_top (nhds 0) := sorry

theorem integrable_approx_on_univ {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [borel_space E] [topological_space.second_countable_topology E] {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f) (n : ℕ) : integrable ⇑(approx_on f fmeas set.univ 0 trivial n) :=
  integrable_approx_on fmeas hf trivial (integrable_zero β E μ) n

theorem tendsto_approx_on_univ_l1 {β : Type u_2} {E : Type u_4} [measurable_space β] [measurable_space E] [normed_group E] [borel_space E] [topological_space.second_countable_topology E] {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f) : filter.tendsto
  (fun (n : ℕ) => l1.of_fun (⇑(approx_on f fmeas set.univ 0 trivial n)) (integrable_approx_on_univ fmeas hf n))
  filter.at_top (nhds (l1.of_fun f hf)) :=
  iff.mpr tendsto_iff_edist_tendsto_0 (tendsto_approx_on_univ_l1_edist fmeas hf)


import topology.basic analysis.complex.exponential
import tactic.core data.list.defs
open real set

----------------------
/- Use `refine` alongside `apply` -/
namespace sin_sin
open tactic
meta def refine_list_expr : list expr → tactic unit
| []     := do {trace "fail", fail "no matching rule"}
| (h::t) := do {trace "refine, initial goals:",
                gs ← get_goals,
                mmap infer_type gs >>= trace,
                (refine ``(%%h _ _)),
                trace (format!" REFINE: {h}"),
                trace "refine, final goals:",
                gs ← get_goals,
                mmap infer_type gs >>= trace,
                pure() <|> refine_list_expr t }

meta def exact_list_expr : list expr → tactic unit
| []     := do {trace "fail", fail "no matching rule"}
| (h::t) := do {trace "exact, initial goals:",
                gs ← get_goals,
                mmap infer_type gs >>= trace,
                trace (format!" EXACT: {h}"),
                -- Some problem here at first...
                exact h,
                trace "exact, final goals:",
                gs ← get_goals,
                mmap infer_type gs >>= trace,
                pure() <|> exact_list_expr t }

meta def apply_list_expr : list expr → tactic unit
| []     := fail "no matching rule"
| (h::t) := do { trace "apply, initial goals:",
                 gs ← get_goals,
                 mmap infer_type gs >>= trace,
                 trace (format!" APPLY: {h}") ,
                 interactive.concat_tags (apply h),
                 trace "apply, final goals:",
                 gs ← get_goals,
                 mmap infer_type gs >>= trace,
                 pure() <|> apply_list_expr t }

open nat

-- these were adjusted so that I could get the counter to print out
meta def iterate_at_most_on_all_goals' : nat → tactic unit → tactic unit
| 0        tac := trace "All goals: maximal iterations reached"
| (succ n) tac := tactic.all_goals $ (do tac, trace (format!"All goals:{n}"), iterate_at_most_on_all_goals' n tac) <|> skip

meta def iterate_at_most_on_subgoals' : nat → tactic unit → tactic unit
| 0        tac := trace "Subgoals: maximal iterations reached"
| (succ n) tac := focus1 (do tac, trace (format!"Subgoals:{n}"), iterate_at_most_on_all_goals' n tac)

meta def apply_rules_with_refine (apps : list pexpr) (refs : list pexpr) (exas : list pexpr) (n : nat) : tactic unit :=
do a ← build_list_expr_for_apply apps,
   r ← build_list_expr_for_apply refs,
   e ← build_list_expr_for_apply exas,
   iterate_at_most_on_subgoals' n (assumption
                                    <|> (do t ← tactic.target,
                                          let a := expr.app_arg t,
                                          if (band (expr.is_lambda a)
                                                   (bnot (eq a `(λ (x : ℝ), x))))
                                          then refine_list_expr r
                                          else fail "can't refine")
                                    <|> (sin_sin.apply_list_expr a)),
   -- this doesn't work if run inside the loop, above, for some reason
   sin_sin.exact_list_expr e,
   pure()

end sin_sin
----------------------

namespace tactic
namespace interactive
open lean
open lean.parser
open interactive interactive.types expr

meta def apply_rules_with_refine_interactive (as : parse pexpr_list_or_texpr)
                                             (rs : parse pexpr_list_or_texpr)
                                             (es : parse pexpr_list_or_texpr)
                                             (n : nat := 50) : tactic unit :=
sin_sin.apply_rules_with_refine as rs es n

end interactive
end tactic

-- * sin(sin(x)) and friends are continuous on ℝ

open real

lemma continuous_sin_sin : continuous (λ x : ℝ, sin(sin(sin(sin(sin(sin x)))))) :=
begin
-- Chris Hughes helped me figure out that we need "@continuous_id ℝ _" rather than "continuous_id" here
apply_rules_with_refine_interactive [continuous_sin] [continuous.comp] [@continuous_id ℝ _] 7,
end

#print continuous_sin_sin


import .rule

open tactic expr

namespace hp

/-- A lemma of the form `∀ (..ps) x y (..qs), inner_rel x y → outer_rel (F[X]) (F[Y])` for some expression path `F`.
The idea here is to generalise congruence and monotonicity lemmas. -/
meta structure congruence :=
(pf : name) -- takes the form `∀ (..ps) x y (..qs), inner_rel x y → outer_rel (F[X]) (F[Y])
            -- from which the following members can be computed.
(path : expr.zipper.path)
(outer_rel : rel_inst)
(inner_rel : rel_inst)
(key : name) -- head symbol of F.

namespace congruence

meta def of_pf : name → tactic congruence
| pf := do
  e ← resolve_name pf >>= pure ∘ pexpr.mk_explicit >>= to_expr,
  y ← infer_type e,
  ⟨⟨_,_,i_p⟩ :: ctx, o_p⟩ ← pure $ telescope.of_pis y,
  key ← pure $ expr_table.get_key o_p,
  ⟨i_rel, (expr.var i_lhs), (expr.var i_rhs)⟩ ← tactic.relation_lhs_rhs i_p,
  ⟨o_rel, o_lhs, o_rhs⟩ ← tactic.relation_lhs_rhs o_p,
  i_dir ← pure $ to_bool $ i_lhs < i_rhs,
  ⟨o_lhs_z, o_rhs_z, o_dir ⟩ ← (do
      [o_lhs_z] ← pure $ zipper.find_var (zipper.zip o_lhs) i_lhs,
      [o_rhs_z] ← pure $ zipper.find_var (zipper.zip o_rhs) i_rhs,
      pure (o_lhs_z, o_rhs_z, ff)
  ) <|> (do
      [o_lhs_z] ← pure $ zipper.find_var (zipper.zip o_lhs) i_rhs,
      [o_rhs_z] ← pure $ zipper.find_var (zipper.zip o_rhs) i_lhs,
      pure (o_lhs_z, o_rhs_z, tt)
  ) <|> fail "given declaration is not a congruence / monotonicity lemma",
  guard (o_lhs_z.get_path = o_rhs_z.get_path),
  pure $ {
    pf := pf,
    path := o_lhs_z.get_path,
    outer_rel := ⟨o_rel, o_dir⟩,
    inner_rel := ⟨i_rel, i_dir⟩,
    key := key
    }

end congruence

end hp


namespace Foo

scoped syntax "foo!" term:max : term

macro_rules
  | `(foo! $x) => `($x + 1)

#check foo! 20

theorem ex1 : foo! 20 = 21 := rfl

end Foo

#check foo! 10 -- Error

def foo! := 10

theorem ex2 : foo! = 10 := rfl

#check foo!

open Foo

#check foo! 20

theorem ex3 : foo! 10 = 11 := rfl

namespace Bla

scoped syntax "bla!" term:max : term

macro_rules
  | `(bla! $x) => `($x * 2)

theorem ex2 : bla! 3 = 6 := rfl

end Bla

def bla! := 20

theorem ex4 : bla! = 20 := rfl


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
-/
import ring_theory.localization.at_prime
import ring_theory.localization.basic
import ring_theory.localization.fraction_ring

/-!
# Localizations of localizations

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/
variables {R : Type*} [comm_ring R] (M : submonoid R) {S : Type*} [comm_ring S]
variables [algebra R S] {P : Type*} [comm_ring P]

open function
open_locale big_operators

namespace is_localization

section localization_localization

variable (M)

variables (N : submonoid S) (T : Type*) [comm_ring T] [algebra R T]

section

variables [algebra S T] [is_scalar_tower R S T]

/--
Localizing wrt `M ⊆ R` and then wrt `N ⊆ S = M⁻¹R` is equal to the localization of `R` wrt this
module. See `localization_localization_is_localization`.
-/
-- This should only be defined when `S` is the localization `M⁻¹R`, hence the nolint.
@[nolint unused_arguments]
def localization_localization_submodule : submonoid R :=
(N ⊔ M.map (algebra_map R S)).comap (algebra_map R S)

variables {M N}
@[simp]
lemma mem_localization_localization_submodule {x : R} :
  x ∈ localization_localization_submodule M N ↔
    ∃ (y : N) (z : M), algebra_map R S x = y * algebra_map R S z :=
begin
  rw [localization_localization_submodule, submonoid.mem_comap, submonoid.mem_sup],
  split,
  { rintros ⟨y, hy, _, ⟨z, hz, rfl⟩, e⟩, exact ⟨⟨y, hy⟩, ⟨z, hz⟩ ,e.symm⟩ },
  { rintros ⟨y, z, e⟩, exact ⟨y, y.prop, _, ⟨z, z.prop, rfl⟩, e.symm⟩ }
end

variables (M N) [is_localization M S]

lemma localization_localization_map_units [is_localization N T]
  (y : localization_localization_submodule M N) : is_unit (algebra_map R T y) :=
begin
  obtain ⟨y', z, eq⟩ := mem_localization_localization_submodule.mp y.prop,
  rw [is_scalar_tower.algebra_map_apply R S T, eq, ring_hom.map_mul, is_unit.mul_iff],
  exact ⟨is_localization.map_units T y',
    (is_localization.map_units _ z).map (algebra_map S T)⟩,
end

lemma localization_localization_surj [is_localization N T] (x : T) :
  ∃ (y : R × localization_localization_submodule M N),
    x * (algebra_map R T y.2) = algebra_map R T y.1 :=
begin
  rcases is_localization.surj N x with ⟨⟨y, s⟩, eq₁⟩, -- x = y / s
  rcases is_localization.surj M y with ⟨⟨z, t⟩, eq₂⟩, -- y = z / t
  rcases is_localization.surj M (s : S) with ⟨⟨z', t'⟩, eq₃⟩, -- s = z' / t'
  dsimp only at eq₁ eq₂ eq₃,
  use z * t', use z' * t, -- x = y / s = (z * t') / (z' * t)
  { rw mem_localization_localization_submodule,
    refine ⟨s, t * t', _⟩,
    rw [ring_hom.map_mul, ← eq₃, mul_assoc, ← ring_hom.map_mul, mul_comm t, submonoid.coe_mul] },
  { simp only [subtype.coe_mk, ring_hom.map_mul, is_scalar_tower.algebra_map_apply R S T,
      ← eq₃, ← eq₂, ← eq₁],
    ring },
end

lemma localization_localization_eq_iff_exists [is_localization N T] (x y : R) :
  algebra_map R T x = algebra_map R T y ↔
    ∃ (c : localization_localization_submodule M N), ↑c * x = ↑c * y :=
begin
  rw [is_scalar_tower.algebra_map_apply R S T, is_scalar_tower.algebra_map_apply R S T,
      is_localization.eq_iff_exists N T],
  split,
  { rintros ⟨z, eq₁⟩,
    rcases is_localization.surj M (z : S) with ⟨⟨z', s⟩, eq₂⟩,
    dsimp only at eq₂,
    obtain ⟨c, eq₃ :  ↑c * (x * z') = ↑c * (y * z')⟩ := (is_localization.eq_iff_exists M S).mp _,
    swap,
    { rw [map_mul, map_mul, ←eq₂, ←mul_assoc, ←mul_assoc, mul_comm _ ↑z, eq₁, mul_comm _ ↑z] },
    use c * z',
    { rw mem_localization_localization_submodule,
      refine ⟨z, c * s, _⟩,
      rw [map_mul, ← eq₂, submonoid.coe_mul, map_mul, mul_left_comm] },
    { rwa [mul_comm _ z', mul_comm _ z', ←mul_assoc, ←mul_assoc] at eq₃ } },
  { rintro ⟨⟨c, hc⟩, eq₁ : c * x = c * y⟩,
    rw mem_localization_localization_submodule at hc,
    rcases hc with ⟨z₁, z, eq₂⟩,
    use z₁,
    refine (is_localization.map_units S z).mul_right_inj.mp _,
    rw [←mul_assoc, mul_comm _ ↑z₁, ←eq₂, ←map_mul, eq₁, map_mul, eq₂, ←mul_assoc, mul_comm _ ↑z₁] }
end

/--
Given submodules `M ⊆ R` and `N ⊆ S = M⁻¹R`, with `f : R →+* S` the localization map, we have
`N ⁻¹ S = T = (f⁻¹ (N • f(M))) ⁻¹ R`. I.e., the localization of a localization is a localization.
-/
lemma localization_localization_is_localization [is_localization N T] :
  is_localization (localization_localization_submodule M N) T :=
{ map_units := localization_localization_map_units M N T,
  surj := localization_localization_surj M N T,
  eq_iff_exists := localization_localization_eq_iff_exists M N T }

include M

/--
Given submodules `M ⊆ R` and `N ⊆ S = M⁻¹R`, with `f : R →+* S` the localization map, if
`N` contains all the units of `S`, then `N ⁻¹ S = T = (f⁻¹ N) ⁻¹ R`. I.e., the localization of a
localization is a localization.
-/
lemma localization_localization_is_localization_of_has_all_units
  [is_localization N T] (H : ∀ (x : S), is_unit x → x ∈ N) :
  is_localization (N.comap (algebra_map R S)) T :=
begin
  convert localization_localization_is_localization M N T,
  symmetry,
  rw sup_eq_left,
  rintros _ ⟨x, hx, rfl⟩,
  exact H _ (is_localization.map_units _ ⟨x, hx⟩),
end

/--
Given a submodule `M ⊆ R` and a prime ideal `p` of `S = M⁻¹R`, with `f : R →+* S` the localization
map, then `T = Sₚ` is the localization of `R` at `f⁻¹(p)`.
-/
lemma is_localization_is_localization_at_prime_is_localization (p : ideal S) [Hp : p.is_prime]
  [is_localization.at_prime T p] :
  is_localization.at_prime T (p.comap (algebra_map R S)) :=
begin
  apply localization_localization_is_localization_of_has_all_units M p.prime_compl T,
  intros x hx hx',
  exact (Hp.1 : ¬ _) (p.eq_top_of_is_unit_mem hx' hx),
end

instance (p : ideal (localization M)) [p.is_prime] : algebra R (localization.at_prime p) :=
localization.algebra

instance (p : ideal (localization M)) [p.is_prime] :
  is_scalar_tower R (localization M) (localization.at_prime p) :=
is_scalar_tower.of_algebra_map_eq' rfl

instance localization_localization_at_prime_is_localization (p : ideal (localization M))
  [p.is_prime] : is_localization.at_prime (localization.at_prime p) (p.comap (algebra_map R _)) :=
is_localization_is_localization_at_prime_is_localization M _ _

/--
Given a submodule `M ⊆ R` and a prime ideal `p` of `M⁻¹R`, with `f : R →+* S` the localization
map, then `(M⁻¹R)ₚ` is isomorphic (as an `R`-algebra) to the localization of `R` at `f⁻¹(p)`.
-/
noncomputable
def localization_localization_at_prime_iso_localization (p : ideal (localization M)) [p.is_prime] :
  localization.at_prime (p.comap (algebra_map R (localization M))) ≃ₐ[R] localization.at_prime p :=
is_localization.alg_equiv (p.comap (algebra_map R (localization M))).prime_compl _ _

end

variables (S)

/-- Given submonoids `M ≤ N` of `R`, this is the canonical algebra structure
of `M⁻¹S` acting on `N⁻¹S`. -/
noncomputable
def localization_algebra_of_submonoid_le
  (M N : submonoid R) (h : M ≤ N) [is_localization M S] [is_localization N T] :
  algebra S T :=
(is_localization.lift (λ y, (map_units T ⟨↑y, h y.prop⟩ : _)) : S →+* T).to_algebra

/-- If `M ≤ N` are submonoids of `R`, then the natural map `M⁻¹S →+* N⁻¹S` commutes with the
localization maps -/
lemma localization_is_scalar_tower_of_submonoid_le
  (M N : submonoid R) (h : M ≤ N) [is_localization M S] [is_localization N T] :
  @@is_scalar_tower R S T _ (localization_algebra_of_submonoid_le S T M N h).to_has_smul _ :=
begin
  letI := localization_algebra_of_submonoid_le S T M N h,
  exact is_scalar_tower.of_algebra_map_eq' (is_localization.lift_comp _).symm
end

noncomputable
instance (x : ideal R) [H : x.is_prime] [is_domain R] :
  algebra (localization.at_prime x) (localization (non_zero_divisors R)) :=
localization_algebra_of_submonoid_le _ _ x.prime_compl (non_zero_divisors R)
  (by { intros a ha, rw mem_non_zero_divisors_iff_ne_zero, exact λ h, ha (h.symm ▸ x.zero_mem) })

/-- If `M ≤ N` are submonoids of `R`, then `N⁻¹S` is also the localization of `M⁻¹S` at `N`. -/
lemma is_localization_of_submonoid_le
  (M N : submonoid R) (h : M ≤ N) [is_localization M S] [is_localization N T]
  [algebra S T] [is_scalar_tower R S T] :
  is_localization (N.map (algebra_map R S)) T :=
{ map_units := begin
    rintro ⟨_, ⟨y, hy, rfl⟩⟩,
    convert is_localization.map_units T ⟨y, hy⟩,
    exact (is_scalar_tower.algebra_map_apply _ _ _ _).symm
  end,
  surj := λ y, begin
    obtain ⟨⟨x, s⟩, e⟩ := is_localization.surj N y,
    refine ⟨⟨algebra_map _ _ x, _, _, s.prop, rfl⟩, _⟩,
    simpa [← is_scalar_tower.algebra_map_apply] using e
  end,
  eq_iff_exists := λ x₁ x₂, begin
    obtain ⟨⟨y₁, s₁⟩, e₁⟩ := is_localization.surj M x₁,
    obtain ⟨⟨y₂, s₂⟩, e₂⟩ := is_localization.surj M x₂,
    refine iff.trans _ (set.exists_image_iff (algebra_map R S) N (λ c, c * x₁ = c * x₂)).symm,
    dsimp only at e₁ e₂ ⊢,
    suffices : algebra_map R T (y₁ * s₂) = algebra_map R T (y₂ * s₁) ↔
      ∃ (a : N), algebra_map R S (a * (y₁ * s₂)) = algebra_map R S (a * (y₂ * s₁)),
    { have h₁ := (is_localization.map_units T ⟨_, h s₁.prop⟩).mul_left_inj,
      have h₂ := (is_localization.map_units T ⟨_, h s₂.prop⟩).mul_left_inj,
      simp only [is_scalar_tower.algebra_map_apply R S T, subtype.coe_mk] at h₁ h₂,
      simp only [is_scalar_tower.algebra_map_apply R S T, map_mul, ← e₁, ← e₂, ← mul_assoc,
        mul_right_comm _ (algebra_map R S s₂),
        mul_right_comm _ (algebra_map S T (algebra_map R S s₂)),
        (is_localization.map_units S s₁).mul_left_inj,
        (is_localization.map_units S s₂).mul_left_inj] at this,
      rw [h₂, h₁] at this,
      simpa only [mul_comm] using this },
    simp_rw [is_localization.eq_iff_exists N T, is_localization.eq_iff_exists M S],
    split,
    { rintro ⟨a, e⟩, exact ⟨a, 1, by { convert e using 1; simp; ring }⟩ },
    { rintro ⟨a, b, e⟩, exact ⟨a * (⟨_, h b.prop⟩ : N), by { convert e using 1; simp; ring }⟩ }
  end }

/-- If `M ≤ N` are submonoids of `R` such that `∀ x : N, ∃ m : R, m * x ∈ M`, then the
localization at `N` is equal to the localizaton of `M`. -/
lemma is_localization_of_is_exists_mul_mem (M N : submonoid R) [is_localization M S] (h : M ≤ N)
    (h' : ∀ x : N, ∃ m : R, m * x ∈ M) : is_localization N S :=
{ map_units := λ y, begin
    obtain ⟨m, hm⟩ := h' y,
    have := is_localization.map_units S ⟨_, hm⟩,
    erw map_mul at this,
    exact (is_unit.mul_iff.mp this).2
  end,
  surj := λ z, by { obtain ⟨⟨y, s⟩, e⟩ := is_localization.surj M z, exact ⟨⟨y, _, h s.prop⟩, e⟩ },
  eq_iff_exists := λ x₁ x₂, begin
    rw is_localization.eq_iff_exists M,
    refine ⟨λ ⟨x, hx⟩, ⟨⟨_, h x.prop⟩, hx⟩, _⟩,
    rintros ⟨x, h⟩,
    obtain ⟨m, hm⟩ := h' x,
    refine ⟨⟨_, hm⟩, _⟩,
    simp [h, mul_assoc],
  end }

end localization_localization

end is_localization

namespace is_fraction_ring

open is_localization

variable (M)

lemma is_fraction_ring_of_is_localization (S T : Type*) [comm_ring S] [comm_ring T]
  [algebra R S] [algebra R T] [algebra S T] [is_scalar_tower R S T]
  [is_localization M S] [is_fraction_ring R T] (hM : M ≤ non_zero_divisors R) :
  is_fraction_ring S T :=
begin
  have := is_localization_of_submonoid_le S T M (non_zero_divisors R) _,
  refine @@is_localization_of_is_exists_mul_mem _ _ _ _ _ _ this _ _,
  { exact map_non_zero_divisors_le M S },
  { rintro ⟨x, hx⟩,
    obtain ⟨⟨y, s⟩, e⟩ := is_localization.surj M x,
    use algebra_map R S s,
    rw [mul_comm, subtype.coe_mk, e],
    refine set.mem_image_of_mem (algebra_map R S) _,
    intros z hz,
    apply is_localization.injective S hM,
    rw map_zero,
    apply hx,
    rw [← (map_units S s).mul_left_inj, mul_assoc, e, ← map_mul, hz, map_zero, zero_mul] },
  { exact hM }
end

lemma is_fraction_ring_of_is_domain_of_is_localization [is_domain R] (S T : Type*)
  [comm_ring S] [comm_ring T] [algebra R S] [algebra R T] [algebra S T]
  [is_scalar_tower R S T] [is_localization M S] [is_fraction_ring R T] : is_fraction_ring S T :=
begin
  haveI := is_fraction_ring.nontrivial R T,
  haveI := (algebra_map S T).domain_nontrivial,
  apply is_fraction_ring_of_is_localization M S T,
  intros x hx,
  rw mem_non_zero_divisors_iff_ne_zero,
  intro hx',
  apply @zero_ne_one S,
  rw [← (algebra_map R S).map_one, ← @mk'_one R _ M, @comm _ eq, mk'_eq_zero_iff],
  exact ⟨⟨x, hx⟩, by simp [hx'] ⟩,
end

end is_fraction_ring


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
  split,
  {
    assume h1 : G.colorable 2,
    have h2 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
      have h3 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
        have h4 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
          have h5 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
            have h6 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
              have h7 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                have h8 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                  have h9 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                    have h10 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                      have h11 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                        have h12 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                          have h13 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                            have h14 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                              have h15 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                have h16 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                  have h17 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                    have h18 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                      have h19 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                        have h20 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                          have h21 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                            have h22 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                              have h23 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                have h24 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                  have h25 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                    have h26 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                      have h27 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                        have h28 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                          have h29 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                            have h30 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                              have h31 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                                have h32 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                                  have h33 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                                    have h34 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                                      have h35 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                                        have h36 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                                          have h37 : ∃ (A B : Type*) (h : (A ⊕ B) = V), G ≤ cast (congr_arg _ h) (complete_bipartite_graph A B), from by {
                                                                            have h38 : ∃ (A B : Type*) (
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 {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

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

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

/--`theorem`
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)-/