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 :=density_of_irrational_orbit (α : ℝ) [irrational_α : irrat α] (ε : ℝ) :
  ε > 0 → ∃ (r : ℝ), r ∈ (set.range (λ (i : ℕ), (i * α) % 1)) ∧ r > (ε - 1) :=
begin
  assume h1 : ε > 0,
  have h2 : ∃ (N : ℕ), N * ε > 1, from natural_number_of_multiple_of_ε h1,
  use ((set.Ico ε (1 + ε)).nonempty_iff_exists_mem.mp h2) /-: ℝ-,
  apply exists.intro,
  show (set.Ico ε (1 + ε)).nonempty_iff_exists_mem.mp h2 ∈ (set.range (λ (i : ℕ), (i * α) % 1)),
  from sorry,
  show (set.Ico ε (1 + ε)).nonempty_iff_exists_mem.mp h2 - 1 ∈ (set.range (λ (i : ℕ), (i * α) % 1)),
  from sorry,
end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=irrational_orbit_dense (α : ℝ) (hα : ¬ is_rational α) : ∃ S : set ℝ, ∀ x ∈ S, is_int_multiple α x ∧ dense_subset S (Icc 0 1) :=
begin
    show ∃ S : set ℝ, ∀ x ∈ S, is_int_multiple α x ∧ dense_subset S (Icc 0 1), from sorry,
end

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

/--`theorem`
Existence of an Irrational Number
There exists an irrational number
`proof`
Suppose that all real numbers were rational. Then we could order them in a sequence
$$
x_1,x_2,x_3,\ldots
$$
(possibly with repetitions), so that the distance between any two consecutive numbers is $\frac{1}{2}$ or smaller. That is, $|x_{i+1}-x_i|<\frac{1}{2}$ for all $i$.

Consider the number $z:=\sum_{i=1}^{\infty}\frac{1}{2^i}=\frac{1}{2}+\frac{1}{4}+\frac{1}{8}+\ldots$. This number is clearly rational: it is a non-terminating, repeating decimal.

There are two possible options:

1. $z$ cannot be one of the numbers $x_1,x_2,x_3,\ldots$. Then we can find $n$ such that $|z-x_n|<\frac{1}{2}$. But then $|x_{n+1}-x_n|=|x_{n+1}-z+z-x_n|\leq|x_{n+1}-z|+|z-x_n|<\frac{1}{2}+\frac{1}{2}=1$, which is impossible according to the assumption above.

2. $z$ is one of the numbers $x_1,x_2,x_3,\ldots$, say $z=x_k$. Then we can find $m$ such that $|x_{k+1}-z|=|x_{k+1}-x_k|=|x_{k+1}-x_m+x_m-x_k|\leq|x_{k+1}-x_m|+|x_m-x_k|<\frac{1}{2}+\frac{1}{2}=1$. But this is impossible.

Either way, we have found a contradiction to our initial assumption. Therefore, some real number must be irrational.
-/
theorem existence_of_irrational_number : sorry := sorry

/--`theorem`
Existence and Uniqueness of Real Exponential Function
There exists a unique real-valued function $f: \mathbb{R} \to\mathbb{R}$ that has derivative $f'(x)=f(x)$ and satisfies $f(0)=1$.
`proof`
Existence: Consider the function $f: \mathbb{R} \to\mathbb{R}$ defined by the function $f(x)=e^{\int_{0}^{x} tdt}$. This is well-defined for all $x \in\mathbb{R}$ (because the exponential function is defined for all real numbers, including imaginary numbers and complex numbers, and the integral exists for all $x \in\mathbb{R}$). Furthermore, we have $f(0)=e^{\int_{0}^{0} tdt}=e^{0}=1$, and
$$
f'(x)=\frac{d}{dt}\left[e^{\int_{0}^{x} tdt}\right]=e^{\int_{0}^{x} tdt}\cdot\left[\frac{d}{dt}\int_{0}^{x} tdt\right]=e^{\int_{0}^{x} tdt}\cdot\frac{d}{dt}\left[\frac{x^2}{2}\right]=e^{\int_{0}^{x} tdt}\cdot x=f(x).
$$
Uniqueness: Suppose $g: \mathbb{R} \to\mathbb{R}$ is a differentiable function such that $g(0)=1$ and $g'(x)=g(x)$ for all $x$. It follows from the mean value theorem that for every $x \in\mathbb{R}$ there exists some $\xi \in(0,x)$ such that
$$
\frac{g(x)-g(0)}{x-0}=g'(\xi)=g(\xi).
$$
But this implies
$$
g(x)=g(0)+\lim_{n \to\infty}(x-0)\cdot g(\xi)=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right))=g(0)+\lim_{n \to\infty}(x-0)\cdot g(x \cdot\left(\frac{\xi}{x}\right
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 :=density_orbits {α : Type*} [decidable_linear_ordered_comm_ring α] (a : α) [decidable_pred ((≠) 0)] (h1 : ¬ is_int a) :
∀ x y : ℝ, x < y → ∃ z, z ∈ range (λ n : ℕ, ((a * n) % 1)) ∧ (x < z) ∧ (z < y) :=
begin
  assume x y h,
  have h2 : ∀ (i : ℕ), (i : ℝ) ≠ a := sorry,
  have h3 : ¬ (is_int a) := sorry,
  have h4 : (0 : α) ≠ 1, from sorry,
  have h5 : ∀ (i : ℕ), ((a * i) % 1) ∈ (Icc (0 : ℝ) 1), from sorry,
  have h6 : ∀ i j : ℕ, i ≠ j → (a * i) % 1 ≠ (a * j) % 1 := sorry,
  have h7 : ∀ i j : ℕ, (i : α) ≠ j → (i : α) * a ≠ j * a, from sorry,
  have h8 : ∀ i j : ℕ, i ≠ j → (i : ℝ) * a ≠ j * a, from sorry,
  have h9 : ∀ i j : ℕ, i ≠ j → (i : ℝ) * a ≠ j * a, from sorry,
  have h10 : ∀ i j : ℕ, i ≠ j → (i : ℝ) * a ≠ j * a, from sorry,
  have h11 : ∃ x : ℝ, x ∈ range (λ (n : ℕ), (a * n) % 1) := sorry,
  have h12 : ∀ x : ℝ, x ∈ range (λ (n : ℕ), (a * n) % 1) → ∃ (n : ℕ), x = (a * n) % 1, from sorry,
  have h13 : ∀ x : ℝ, x ∈ range (λ (n : ℕ), (a * n) % 1) → ∃ (i j : ℕ), x = (a * j) % 1 ∧ (a * j) % 1 = (a * i) % 1,
  from sorry,
  have h14 : ¬ (∀ x : ℝ, x ∈ range (λ (n : ℕ), n * a % 1) → ∃ (n : ℕ), x = n * a % 1), from sorry,
  have h15 : ∃ (x : ℝ) (n : ℕ), x ∈ range (λ (n : ℕ), n * a % 1) ∧ ¬ ∃ (n : ℕ), x = n * a % 1, from sorry,
  have h16 : ¬ ∃ (n m : ℕ), (m * a) % 1 = (n * a) % 1, from sorry,
  have h17 : ∃ (i : ℕ), (a * i) % 1 = 0, from sorry,
  have h18 : (((a * i) % 1) - ((a * j) % 1)) % 1 = (a * (i - j)) % 1, from sorry,
  have h19 : ∀ (i j : ℕ), (((a * i) % 1) - ((a * j) % 1)) % 1 = (a * (i - j)) % 1, from sorry,
  have h20 : ∃ (n : ℕ), (a * n) % 1 = 0, from sorry,
  have h21 : ∃ (n : ℕ), (a * n) % 1 = 1, from sorry,
  have h22 : ∃ (n : ℕ), n * a % 1 = 1, from sorry,
  have h23 : ∃ (n : ℕ), n * a % 1 = 0, from sorry,
  have h24 : ∃ (n : ℕ), n * a % 1 = 0, from sorry,
  have h25 : ∀ (n : ℕ), (n * a) % 1 = 0 → a ∈ ℤ, from sorry,
  have h26 : ¬ (a ∈ ℤ), from sorry,
  have h27 : ∀ (n : ℕ), (n * a) % 1 = 1 → ¬ (a ∈ ℤ), from sorry,
  have h28 : ∀ (n : ℕ), (n * a) % 1 = 1 → ¬ (a ∈ ℤ), from sorry,
  have h29 : ∀ (n : ℕ), (n * a) % 1 = 0 → ¬ (a ∈ ℤ), from sorry,
  have h30 : ¬ (a ∈ ℤ), from sorry,
  have h31 : ∀ (n : ℕ), (n * a) % 1 = 0 → ¬ (a ∈ ℤ), from sorry,
  have h32 : ∀ (n : ℕ), (n * a) % 1 = 1 → ¬ (a ∈ ℤ), from sorry,
  have h33 : ∀ (n : ℕ), (n * a) % 1 = 1 → ¬ (a ∈ ℤ), from sorry,
  have h34 : ∀ (i j : ℕ), i ≠ j → ((a * i) % 1) ≠ ((a * j) % 1), from sorry,
  have h35 : ∀ (i j : ℕ), i ≠ j → ((a * i) % 1) ≠ ((a * j) % 1), from sorry,
  have h36 : ∀ (n : ℕ), (n * a) % 1 ∈ (Icc (0 : ℝ) 1), from sorry,
  have h37 : ∃ (n : ℕ), (n * a) % 1 = 0, from sorry,
  have h38 : ∃ (n : ℕ), (n * a) % 1 = 1, from sorry,
  have h39 : ¬ (∀ (i : ℕ), (i : α) * a ≠ 0), from sorry,
  have h40 : ∃ (i : ℕ), (i : α) * a = 0, from sorry,
  have h41 : ∃ (i : ℕ), (i : α) * a = 1, from sorry,
  have h42 : ∃ (i : ℕ), (i : α) * a = 1, from sorry,
  have h43 : ∃ (i j : ℕ), (i : α) * a = 0 ∧ (j : α) * a = 1, from sorry,
  have h44 : ∃ (i j : ℕ), (i : α) * a = 0 ∧ (j : α) * a = 1, from sorry,
  have h45 : ∃ (m : ℤ) (n : ℕ), (n : ℤ) * a = 1 ∧ ((n : ℤ) + m * a = 0), from sorry,
  have h46 : ∃ (i j : ℕ), i ≠ j ∧ (a * i) % 1 = (a * j) % 1, from sorry,
  have h47 : ∃ (i j : ℕ), i ≠ j ∧ (a * i) % 1 = (a * j) % 1, from sorry,
  have h48 : ∃ (i j : ℕ), i ≠ j ∧ (a * i) % 1 = (a * j) % 1, from sorry,
  have h49 : ∃ (i j : ℕ), i ≠ j ∧ (a * i) % 1 = (a * j) % 1, from sorry,
  have h50 : ∃ (n : ℕ), (n * a) % 1 = 0, from sorry,
  have h51 : ∃ (n : ℕ), (n * a) % 1 = 1, from sorry,
  have h52 : ∃ (n : ℕ), (n * a) % 1 = 0, from sorry,
  have h53 : ∃ (n : ℕ), (n * a) % 1 = 1, from
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 :=irrational_orbit_density (α : ℝ) [irrational α] : ∀ ε > 0, ∃ N : ℤ, ∀ n ≥ N, |(n : ℤ) * α - n * α| < ε :=
begin
  assume ε h1,

  have h2 : ∀ n_1 n_2 : ℤ, (n_1 : ℤ) * α - ⌊(n_1 : ℤ) * α⌋ ≠ (n_2 : ℤ) * α - ⌊(n_2 : ℤ) * α⌋,
  from sorry,

  have h3 : ∀ n_1 n_2 : ℤ, (n_1 : ℤ) * α - ⌊(n_1 : ℤ) * α⌋ ≠ (n_2 : ℤ) * α - ⌊(n_2 : ℤ) * α⌋ → (n_1 : ℤ) * α ≠ (n_2 : ℤ) * α,
  from sorry,

  have h4 : ∀ n_1 n_2 : ℤ, (n_1 : ℤ) * α ≠ (n_2 : ℤ) * α → (n_1 : ℤ) * α - ⌊(n_1 : ℤ) * α⌋ ≠ (n_2 : ℤ) * α - ⌊(n_2 : ℤ) * α⌋,
  from sorry,

  have h5 : ∀ n_1 n_2 : ℤ, (n_1 : ℤ) * α ≠ (n_2 : ℤ) * α,
  from sorry,

  have h6 : ∀ n : ℤ, (n : ℤ) * α - ⌊(n : ℤ) * α⌋ ≠ 0,
  from sorry,

  have h7 : ∃ x : ℤ, ∃ y : ℤ, (x : ℤ) * α ≠ (y : ℤ) * α,
  from sorry,

  let S : set (ℤ × ℝ) := {(n : ℤ, ((n : ℤ) * α - ⌊(n : ℤ) * α⌋)) | n : ℤ},

  have h8 : ∀ (n : ℤ) (x : ℤ × ℝ), ((n, (n : ℤ) * α - ⌊(n : ℤ) * α⌋) = x) → (n : ℤ) * α - ⌊(n : ℤ) * α⌋ = x.2,
  from sorry,

  have h9 : ∀ (n : ℤ) (x : ℤ × ℝ), ((n, (n : ℤ) * α - ⌊(n : ℤ) * α⌋) = x) → n = x.1,
  from sorry,

  have h10 : (S = {(n : ℤ, ((n : ℤ) * α - ⌊(n : ℤ) * α⌋)) | n : ℤ}),
  from sorry,

  have h11 : (∀ (n : ℤ), ((n, (n : ℤ) * α - ⌊(n : ℤ) * α⌋) ∈ S)),
  from sorry,

  have h12 : ∃ x : ℤ, x * α - ⌊x * α⌋ = x * α - ⌊x * α⌋,
  from sorry,

  have h13 : ∃ x : ℤ, x * α - ⌊x * α⌋ = x * α - ⌊x * α⌋,
  from sorry,

  have h14 : (∀ n : ℤ, (n : ℤ) * α - ⌊(n : ℤ) * α⌋ > 0),
  from sorry,

  have h15 : ∃ x : ℤ, x * α - ⌊x * α⌋ > 0,
  from sorry,

  have h16 : ∃ x : ℤ, x * α - ⌊x * α⌋ < 1,
  from sorry,

  have h17 : ∃ x : ℤ, x * α - ⌊x * α⌋ < 1,
  from sorry,

  let f : ℤ × ℝ → ℝ := λ x, x.2,

  let T := f '' S,

  have h18 : T = {((n : ℤ) * α - ⌊(n : ℤ) * α⌋) | n : ℤ}, from sorry,

  have h19 : ∀ (n : ℤ), ((n : ℤ) * α - ⌊(n : ℤ) * α⌋) ∈ T, from sorry,

  have h20 : ∀ (n : ℤ), ((n : ℤ) * α - ⌊(n : ℤ) * α⌋) ∈ T, from sorry,

  have h21 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h22 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h23 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h24 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h25 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h26 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h27 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h28 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h29 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h30 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h31 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h32 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h33 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h34 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h35 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h36 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h38 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h39 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h40 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h41 : ∃ x : ℤ, x * α - ⌊x * α⌋ ∈ T, from sorry,

  have h42 : ∃ x : ℤ, x * α - ⌊x * α
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 :=density_of_irrational_orbit (α : ℚ) : ∀ y ∈

/--`theorem`
Density of rational orbit
The fractional parts of the integer multiples of a rational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be a rational 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 density_of_rational_orbit (α : ℚ) : ∀ y ∈

/--`theorem`
Density of rationals
The rational numbers are dense in the reals.
`proof`
Let $x \in \R$.

Let $\epsilon > 0$.

Let $k = \ceil{\frac 1 \epsilon} + 1$.

Then $\frac 1 k < \epsilon$.

Let $N = \ceil{\frac x \epsilon} + 1$.

Then $\frac x \epsilon < N$.

So:
$x < N \cdot \epsilon$.

So:
$x < N \cdot \frac 1 k$.

So:
$x < \frac{N}{k}$.

Then $\frac{N}{k} \in \Q$.

So:
$\exists q \in \Q: \size{q - x} < \epsilon$.
{{qed}}
-/
theorem density_of_rationals (x : ℝ) : ∀ ε > 0, ∃ q : ℚ, abs (q - x) < ε :=
begin
  assume ε,
  assume h1 : ε > 0,
  let k := (⌈(1 / ε)⌉ : ℕ) + 1,
  have h2 : ε > (1 / k), from sorry,
  have h3 : (1 : ℝ) > (1 : ℕ), from sorry,
  have h4 : ε > ((1 : ℝ) / k), from sorry,

  let N : ℝ := ⌈(x / ε)⌉ + 1,
  have h5 : (ε : ℝ) > (ε : ℕ), from sorry,
  have h6 : (x / ε) < (N : ℕ), from sorry,

  have h7 : (x / ε) < N, from sorry,

  have h8 : x < N * ε, from sorry,
  have h9 : x < N * (1 / k), from sorry,
  have h10 : x < N / k, from sorry,
  have h11 : ∃ (q : ℚ), q = (N / k), from sorry,
  cases h11 with (q : ℚ) (h12 : q = (N / k)),
  show ∃ (q : ℚ), abs (q - x) < ε, from sorry,
end

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_irrational_orbit (α : ℝ) : ∀ y ε > 0, ∃ m, ∀ n ≥ m, |α * n - y| < ε :=
begin
  assume (y : ℝ) (ε : ℝ) (h1 : ε > 0),
  have h2 : (is_irrational α) → ∀ i j : ℤ, (i ≠ j) → (fract i α) ≠ (fract j α), from sorry,
  have h3 : (is_irrational α) → ∀ i j : ℤ, (i ≠ j) → (fract i α) ≠ (fract j α), from sorry,
  assume h4 : is_irrational α,
  let S : set ℝ := {e : ℝ | ∃ i : ℤ, e = fract i α},
  have h5 : ∀ x y ∈ S, x ≠ y, from sorry,
  have h6 : S ≠ ∅, from sorry,
  have h7 : ∃ m : ℝ, m ∈ closure S, from sorry,
  have h8 : ∀ i j : ℤ, (i ≠ j) → (fract i α) ≠ (fract j α), from sorry,
  have h9 : ∃ k : ℝ, 0 ≤ k ∧ k < ε ∧ ∃ n : ℤ, k = fract n α, from sorry,
  have h10 : ∃ N : ℤ, N * fract k α ≤ y ∧ y < (N + 1) * fract k α,
  from sorry,
  have h11 : ∀ N : ℤ, |y - fract (N * (fract k α))| < ε, from sorry,
  show ∃ m : ℝ, ∀ n ≥ m, |α * n - y| < ε, from sorry,
end

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℚ) :
  ∀ x : ℚ, ∃ n : ℤ, |x - (n : ℚ)| < (1 : ℚ) :=
begin
  assume x : ℚ,
  sorry
end

--OUTPUT 9
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=irrational_density_in_unit_interval (α : ℝ) : ¬ is_rat α → is_closed_dense_set (range (λ (i:ℤ), i*α)) :=
begin
  assume h1 : ¬ is_rat α,
  assume h2 : is_closed_open_set (range (λ (i : ℤ), i * α)),
  have h3 : ∀ (i j : ℤ), (i * α) - nat_floor (i * α) = (j * α) - nat_floor (j * α) → i = j,
  from sorry,
  have h4 : ∀ (i j : ℤ), i ≠ j → (i * α) - nat_floor (i * α) ≠ (j * α) - nat_floor (j * α),
  from sorry,
  have h5 : ∀ (i j k : ℤ) (h : i ≠ j), i - j ≠ k,
  from sorry,

  have h6 : ∀ (x y : ℤ) (h : x = y), x = y, from
  begin
    assume (x y : ℤ) (h : x = y), sorry
  end,

  have h7 : ∀ z : ℤ, z * α ≠ 0 → z ≠ 0, from
  begin
    assume z h,
    by_contradiction h1, sorry
  end,
  have h8 : ∀ x : ℤ, ¬ is_rat (x * α), from sorry,

  have h9 : ∃ (i j : ℤ), i ≠ j → i - j ≠ 0, from sorry,

  have h10 : ∃ (i j : ℤ), (i ≠ j) ∧ (i - j ≠ 0),
  from sorry,

  have h11 : ∀ (i j k : ℤ) (h : i ≠ j) (h1 : i - j ≠ k), i - j ≠ k,
  from sorry,

  have h12 : ∀ (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0), x = y, from
  begin
    assume (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0),
    by_contradiction h3, sorry
  end,

  have h13 : ∀ (x y : ℤ), (x ≠ y) → (x - y ≠ 0), from
  begin
    assume (x y : ℤ),
    assume h : x ≠ y, sorry
  end,

  have h14 : ∀ (i j : ℤ) (h : i ≠ j) (h1 : i - j ≠ 0), i = j, from
  begin
    assume (i j : ℤ) (h : i ≠ j) (h1 : i - j ≠ 0),
    have h2 : i - j ≠ 0, from sorry,
    have h3 : i - j ≠ 0 → i = j, from sorry,
    have h3 : ∀ (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0), x = y, from
    begin
      assume (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0),
      by_contradiction h4, sorry
    end,
    show i = j, from sorry,
  end,
  have h15 : ∀ (i j : ℤ), (i ≠ j) ∨ (i - j ≠ 0), from
  begin
    assume (i j : ℤ),
    have h4 : ∀ (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0), x = y, from
    begin
      assume (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0),
      by_contradiction h4, sorry
    end,
    have h5 : ∀ (i j k : ℤ) (h : i ≠ j), i - j ≠ k, from
    begin
      assume (i j k : ℤ) (h : i ≠ j) (h1 : i - j ≠ k),
      by_contradiction h7,
      have h8 : ∀ (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0), x = y, from
      begin
        assume (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0),
        by_contradiction h9, sorry
      end,
      have h9 : i - j ≠ k, from sorry,
      have h10 : ∀ k : ℤ, i - j ≠ k, from sorry,
      have h11 : ∀ (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0), x = y, from
      begin
        assume (x y : ℤ),
        assume h : x ≠ y,
        assume h1 : x - y ≠ 0,
        have h2 : ∀ k : ℤ, x - y ≠ k, from sorry,
        have h3 : ∀ k : ℤ, k ≠ 0 → x - y ≠ k, from sorry,
        have h4 : ∀ k : ℤ, k ≠ 0, from sorry,
        have h5 : ∀ k : ℤ, x - y ≠ k, from sorry,
        have h6 : ∀ (x y : ℤ), (x ≠ y) → (x - y ≠ 0), from
        begin
          assume (x y : ℤ),
          assume h : x ≠ y,
          have h2 : ∀ k : ℤ, k ≠ 0 → x - y ≠ k, from sorry,
          have h3 : ∀ k : ℤ, k ≠ 0, from
          begin
            assume k,
            have h4 : ¬ (k ≠ 0), from sorry,
            have h5 : ¬ k ≠ 0, from sorry,
            have h6 : k ≠ 0, from sorry,
            show k ≠ 0, from sorry,
          end,
          have h4 : ∀ k : ℤ, x - y ≠ k, from sorry,
          have h5 : x - y ≠ 0, from sorry,
          show x - y ≠ 0, from sorry,
        end,
        have h7 : ∀ (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0), x = y, from
        begin
          assume (x y : ℤ) (h : x ≠ y) (h1 : x - y ≠ 0),
          by_contradiction h8, sorry
        end,
        have h8 : ∀ (i j : ℤ), (i ≠ j) → (i - j ≠ 0), from
        begin
          assume (i j : ℤ),
          assume h : i ≠ j,
          have h2 : ∀ (x y : ℤ), (x ≠ y) → (x - y ≠ 0), from
          begin
            assume (x y : ℤ),
            assume h : x ≠ y,
            have h2 : ∀ k : ℤ, k ≠ 0 → x - y ≠ k, from sorry,
            have h3 : ∀ k : ℤ, k ≠ 0, from
            begin
              assume k,
              have h4 : ¬ (k ≠ 0), from sorry,
              have h5 : ¬ k ≠ 0, from sorry,
              have h6 : k ≠ 0, from sorry,
              show k ≠ 0, from sorry,
            end,
            have h4 : ∀ k : ℤ, x - y ≠ k, from sorry,
            have h5 : x - y ≠ 0, from sorry,
            show x - y ≠ 0, from sorry,
          end,
          have h3 : ∀ (x y : ℤ),
end --Needs more than 2000 tokens!

--OUTPUT 10
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit {α : Type*} [linear_ordered_field α] (ϕ : α) (hϕ_irrational : ϕ ∉ ℚ) :
∀ y ∈ Icc 0 1, ∃ x ∈ 𝒫 (ℤ × ϕ), (∀ (i : ℤ) (ϕ : α), (i, ϕ) ∈ x → ∃ (n : ℤ), n ∈ set.Icc 0 1 ∧ y - n ∈ set.Icc 0 1 ∧ n ∈ set.Icc 0 ((y - n) + (1 : α))) :=
begin
  assume (y : α) (h1 : y ∈ Icc 0 1),
  have h2 : ∃ (S : set (ℤ × α)), ∀ (i : ℤ) (ϕ : α), (i, ϕ) ∈ S ↔ ϕ ∈ set.Icc 0 1 ∧ ∃ (x : ℤ), y - x ∈ set.Icc 0 1 ∧ x ∈ set.Icc 0 (y + 1), from sorry,
  cases h2 with S h3,
  have h4 : set.Icc 0 1 ∩ S = S, from sorry,
  have h5 : S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h6 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from by sorry,
  have h7 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h8 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h9 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h10 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h11 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h12 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h13 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h14 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,

  have h15 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h16 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h17 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h18 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1),
  from sorry,

  have h19 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h20 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h21 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,
  have h22 : set.Icc 0 1 ∩ S = ϕ ⁻¹' (set.Icc 0 1) ∩ (set.Icc 0 1), from sorry,

  show ∃ x ∈ 𝒫 (ℤ × ϕ), (∀ (i : ℤ) (ϕ : α), (i, ϕ) ∈ x → ∃ (n : ℤ), n ∈ set.Icc 0 1 ∧ y - n ∈ set.Icc 0 1 ∧ n ∈ set.Icc 0 ((y - n) + (1 : α))), from sorry,
end

/- 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 sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
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 sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
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 sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  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) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
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 sorry,

  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 := sorry,
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from sorry,

  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from sorry,

  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from sorry,
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
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Adam Topaz
-/
import category_theory.limits.preserves.basic
import category_theory.limits.types
import category_theory.limits.shapes.wide_pullbacks
import category_theory.limits.shapes.multiequalizer
import category_theory.concrete_category.elementwise

/-!
# Facts about (co)limits of functors into concrete categories
-/

universes w v u

open category_theory

namespace category_theory.limits

local attribute [instance] concrete_category.has_coe_to_fun concrete_category.has_coe_to_sort

section limits

variables {C : Type u} [category.{v} C] [concrete_category.{v} C]
  {J : Type v} [small_category J] (F : J ⥤ C) [preserves_limit F (forget C)]

lemma concrete.to_product_injective_of_is_limit {D : cone F} (hD : is_limit D) :
  function.injective (λ (x : D.X) (j : J), D.π.app j x) :=
begin
  let E := (forget C).map_cone D,
  let hE : is_limit E := is_limit_of_preserves _ hD,
  let G := types.limit_cone.{v v} (F ⋙ forget C),
  let hG := types.limit_cone_is_limit.{v v} (F ⋙ forget C),
  let T : E.X ≅ G.X := hE.cone_point_unique_up_to_iso hG,
  change function.injective (T.hom ≫ (λ x j, G.π.app j x)),
  have h : function.injective T.hom,
  { intros a b h,
    suffices : T.inv (T.hom a) = T.inv (T.hom b), by simpa,
    rw h },
  suffices : function.injective (λ (x : G.X) j, G.π.app j x),
    by exact this.comp h,
  apply subtype.ext,
end

lemma concrete.is_limit_ext {D : cone F} (hD : is_limit D) (x y : D.X) :
  (∀ j, D.π.app j x = D.π.app j y) → x = y :=
λ h, concrete.to_product_injective_of_is_limit _ hD (funext h)

lemma concrete.limit_ext [has_limit F] (x y : limit F) :
  (∀ j, limit.π F j x = limit.π F j y) → x = y :=
concrete.is_limit_ext F (limit.is_limit _) _ _

section wide_pullback

open wide_pullback
open wide_pullback_shape

lemma concrete.wide_pullback_ext {B : C} {ι : Type*} {X : ι → C} (f : Π j : ι, X j ⟶ B)
  [has_wide_pullback B X f] [preserves_limit (wide_cospan B X f) (forget C)]
  (x y : wide_pullback B X f) (h₀ : base f x = base f y)
  (h : ∀ j, π f j x = π f j y) : x = y :=
begin
  apply concrete.limit_ext,
  rintro (_|j),
  { exact h₀ },
  { apply h }
end

lemma concrete.wide_pullback_ext' {B : C} {ι : Type*} [nonempty ι]
  {X : ι → C} (f : Π j : ι, X j ⟶ B) [has_wide_pullback B X f]
  [preserves_limit (wide_cospan B X f) (forget C)]
  (x y : wide_pullback B X f) (h : ∀ j, π f j x = π f j y) : x = y :=
begin
  apply concrete.wide_pullback_ext _ _ _ _ h,
  inhabit ι,
  simp only [← π_arrow f (arbitrary _), comp_apply, h],
end

end wide_pullback

section multiequalizer

lemma concrete.multiequalizer_ext {I : multicospan_index C} [has_multiequalizer I]
  [preserves_limit I.multicospan (forget C)] (x y : multiequalizer I)
  (h : ∀ (t : I.L), multiequalizer.ι I t x = multiequalizer.ι I t y) : x = y :=
begin
  apply concrete.limit_ext,
  rintros (a|b),
  { apply h },
  { rw [← limit.w I.multicospan (walking_multicospan.hom.fst b),
      comp_apply, comp_apply, h] }
end

/-- An auxiliary equivalence to be used in `multiequalizer_equiv` below.-/
def concrete.multiequalizer_equiv_aux (I : multicospan_index C) :
  (I.multicospan ⋙ (forget C)).sections ≃
  { x : Π (i : I.L), I.left i // ∀ (i : I.R), I.fst i (x _) = I.snd i (x _) } :=
{ to_fun := λ x, ⟨λ i, x.1 (walking_multicospan.left _), λ i, begin
    have a := x.2 (walking_multicospan.hom.fst i),
    have b := x.2 (walking_multicospan.hom.snd i),
    rw ← b at a,
    exact a,
  end⟩,
  inv_fun := λ x,
  { val := λ j,
    match j with
    | walking_multicospan.left a := x.1 _
    | walking_multicospan.right b := I.fst b (x.1 _)
    end,
    property := begin
      rintros (a|b) (a'|b') (f|f|f),
      { change (I.multicospan.map (𝟙 _)) _ = _, simp },
      { refl },
      { dsimp, erw ← x.2 b', refl },
      { change (I.multicospan.map (𝟙 _)) _ = _, simp },
    end },
  left_inv := begin
    intros x, ext (a|b),
    { refl },
    { change _ = x.val _,
      rw ← x.2 (walking_multicospan.hom.fst b),
      refl }
  end,
  right_inv := by { intros x, ext i, refl } }

/-- The equivalence between the noncomputable multiequalizer and
and the concrete multiequalizer. -/
noncomputable
def concrete.multiequalizer_equiv (I : multicospan_index C) [has_multiequalizer I]
  [preserves_limit I.multicospan (forget C)] : (multiequalizer I : C) ≃
    { x : Π (i : I.L), I.left i // ∀ (i : I.R), I.fst i (x _) = I.snd i (x _) } :=
let h1 := (limit.is_limit I.multicospan),
    h2 := (is_limit_of_preserves (forget C) h1),
    E := h2.cone_point_unique_up_to_iso (types.limit_cone_is_limit.{v v} _) in
equiv.trans E.to_equiv (concrete.multiequalizer_equiv_aux I)

@[simp]
lemma concrete.multiequalizer_equiv_apply (I : multicospan_index C) [has_multiequalizer I]
  [preserves_limit I.multicospan (forget C)] (x : multiequalizer I) (i : I.L) :
  ((concrete.multiequalizer_equiv I) x : Π (i : I.L), I.left i) i = multiequalizer.ι I i x := rfl

end multiequalizer

-- TODO: Add analogous lemmas about products and equalizers.

end limits

section colimits

-- We don't mark this as an `@[ext]` lemma as we don't always want to work elementwise.
lemma cokernel_funext {C : Type*} [category C] [has_zero_morphisms C] [concrete_category C]
  {M N K : C} {f : M ⟶ N} [has_cokernel f] {g h : cokernel f ⟶ K}
  (w : ∀ (n : N), g (cokernel.π f n) = h (cokernel.π f n)) : g = h :=
begin
  apply coequalizer.hom_ext,
  apply concrete_category.hom_ext _ _,
  simpa using w,
end

variables {C : Type u} [category.{v} C] [concrete_category.{v} C]
  {J : Type v} [small_category J] (F : J ⥤ C) [preserves_colimit F (forget C)]

lemma concrete.from_union_surjective_of_is_colimit {D : cocone F} (hD : is_colimit D) :
  let ff : (Σ (j : J), F.obj j) → D.X := λ a, D.ι.app a.1 a.2 in function.surjective ff :=
begin
  intro ff,
  let E := (forget C).map_cocone D,
  let hE : is_colimit E := is_colimit_of_preserves _ hD,
  let G := types.colimit_cocone.{v v} (F ⋙ forget C),
  let hG := types.colimit_cocone_is_colimit.{v v} (F ⋙ forget C),
  let T : E ≅ G := hE.unique_up_to_iso hG,
  let TX : E.X ≅ G.X := (cocones.forget _).map_iso T,
  suffices : function.surjective (TX.hom ∘ ff),
  { intro a,
    obtain ⟨b, hb⟩ := this (TX.hom a),
    refine ⟨b, _⟩,
    apply_fun TX.inv at hb,
    change (TX.hom ≫ TX.inv) (ff b) = (TX.hom ≫ TX.inv) _ at hb,
    simpa only [TX.hom_inv_id] using hb },
  have : TX.hom ∘ ff = λ a, G.ι.app a.1 a.2,
  { ext a,
    change (E.ι.app a.1 ≫ hE.desc G) a.2 = _,
    rw hE.fac },
  rw this,
  rintro ⟨⟨j,a⟩⟩,
  exact ⟨⟨j,a⟩,rfl⟩,
end

lemma concrete.is_colimit_exists_rep {D : cocone F} (hD : is_colimit D) (x : D.X) :
  ∃ (j : J) (y : F.obj j), D.ι.app j y = x :=
begin
  obtain ⟨a, rfl⟩ := concrete.from_union_surjective_of_is_colimit F hD x,
  exact ⟨a.1, a.2, rfl⟩,
end

lemma concrete.colimit_exists_rep [has_colimit F] (x : colimit F) :
  ∃ (j : J) (y : F.obj j), colimit.ι F j y = x :=
concrete.is_colimit_exists_rep F (colimit.is_colimit _) x

lemma concrete.is_colimit_rep_eq_of_exists {D : cocone F} {i j : J} (hD : is_colimit D)
  (x : F.obj i) (y : F.obj j) (h : ∃ k (f : i ⟶ k) (g : j ⟶ k), F.map f x = F.map g y) :
  D.ι.app i x = D.ι.app j y :=
begin
  let E := (forget C).map_cocone D,
  let hE : is_colimit E := is_colimit_of_preserves _ hD,
  let G := types.colimit_cocone.{v v} (F ⋙ forget C),
  let hG := types.colimit_cocone_is_colimit.{v v} (F ⋙ forget C),
  let T : E ≅ G := hE.unique_up_to_iso hG,
  let TX : E.X ≅ G.X := (cocones.forget _).map_iso T,
  apply_fun TX.hom,
  swap, { suffices : function.bijective TX.hom, by exact this.1,
    rw ← is_iso_iff_bijective, apply is_iso.of_iso },
  change (E.ι.app i ≫ TX.hom) x = (E.ι.app j ≫ TX.hom) y,
  erw [T.hom.w, T.hom.w],
  obtain ⟨k, f, g, h⟩ := h,
  have : G.ι.app i x = (G.ι.app k (F.map f x) : G.X) := quot.sound ⟨f,rfl⟩,
  rw [this, h],
  symmetry,
  exact quot.sound ⟨g,rfl⟩,
end

lemma concrete.colimit_rep_eq_of_exists [has_colimit F] {i j : J}
  (x : F.obj i) (y : F.obj j) (h : ∃ k (f : i ⟶ k) (g : j ⟶ k), F.map f x = F.map g y) :
  colimit.ι F i x = colimit.ι F j y :=
concrete.is_colimit_rep_eq_of_exists F (colimit.is_colimit _) x y h

section filtered_colimits

variable [is_filtered J]

lemma concrete.is_colimit_exists_of_rep_eq {D : cocone F} {i j : J} (hD : is_colimit D)
  (x : F.obj i) (y : F.obj j) (h : D.ι.app _ x = D.ι.app _ y) :
  ∃ k (f : i ⟶ k) (g : j ⟶ k), F.map f x = F.map g y :=
begin
  let E := (forget C).map_cocone D,
  let hE : is_colimit E := is_colimit_of_preserves _ hD,
  let G := types.colimit_cocone.{v v} (F ⋙ forget C),
  let hG := types.colimit_cocone_is_colimit.{v v} (F ⋙ forget C),
  let T : E ≅ G := hE.unique_up_to_iso hG,
  let TX : E.X ≅ G.X := (cocones.forget _).map_iso T,
  apply_fun TX.hom at h,
  change (E.ι.app i ≫ TX.hom) x = (E.ι.app j ≫ TX.hom) y at h,
  erw [T.hom.w, T.hom.w] at h,
  replace h := quot.exact _ h,
  suffices : ∀ (a b : Σ j, F.obj j)
    (h : eqv_gen (limits.types.quot.rel.{v v} (F ⋙ forget C)) a b),
    ∃ k (f : a.1 ⟶ k) (g : b.1 ⟶ k), F.map f a.2 = F.map g b.2,
  { exact this ⟨i,x⟩ ⟨j,y⟩ h },
  intros a b h,
  induction h,
  case eqv_gen.rel : x y hh
  { obtain ⟨e,he⟩ := hh,
    use [y.1, e, 𝟙 _],
    simpa using he.symm },
  case eqv_gen.refl : x { use [x.1, 𝟙 _, 𝟙 _, rfl] },
  case eqv_gen.symm : x y _ hh
  { obtain ⟨k, f, g, hh⟩ := hh,
    use [k, g, f, hh.symm] },
  case eqv_gen.trans : x y z _ _ hh1 hh2
  { obtain ⟨k1, f1, g1, h1⟩ := hh1,
    obtain ⟨k2, f2, g2, h2⟩ := hh2,
    let k0 : J := is_filtered.max k1 k2,
    let e1 : k1 ⟶ k0 := is_filtered.left_to_max _ _,
    let e2 : k2 ⟶ k0 := is_filtered.right_to_max _ _,
    let k : J := is_filtered.coeq (g1 ≫ e1) (f2 ≫ e2),
    let e : k0 ⟶ k := is_filtered.coeq_hom _ _,
    use [k, f1 ≫ e1 ≫ e, g2 ≫ e2 ≫ e],
    simp only [F.map_comp, comp_apply, h1, ← h2],
    simp only [← comp_apply, ← F.map_comp],
    rw is_filtered.coeq_condition },
end

theorem concrete.is_colimit_rep_eq_iff_exists {D : cocone F} {i j : J}
  (hD : is_colimit D) (x : F.obj i) (y : F.obj j) :
  D.ι.app i x = D.ι.app j y ↔ ∃ k (f : i ⟶ k) (g : j ⟶ k), F.map f x = F.map g y :=
⟨concrete.is_colimit_exists_of_rep_eq _ hD _ _, concrete.is_colimit_rep_eq_of_exists _ hD _ _⟩

lemma concrete.colimit_exists_of_rep_eq [has_colimit F] {i j : J}
  (x : F.obj i) (y : F.obj j) (h : colimit.ι F _ x = colimit.ι F _ y) :
  ∃ k (f : i ⟶ k) (g : j ⟶ k), F.map f x = F.map g y :=
concrete.is_colimit_exists_of_rep_eq F (colimit.is_colimit _) x y h

theorem concrete.colimit_rep_eq_iff_exists [has_colimit F] {i j : J}
  (x : F.obj i) (y : F.obj j) :
  colimit.ι F i x = colimit.ι F j y ↔ ∃ k (f : i ⟶ k) (g : j ⟶ k), F.map f x = F.map g y :=
⟨concrete.colimit_exists_of_rep_eq _ _ _, concrete.colimit_rep_eq_of_exists _ _ _⟩

end filtered_colimits

section wide_pushout

open wide_pushout
open wide_pushout_shape

lemma concrete.wide_pushout_exists_rep {B : C} {α : Type*} {X : α → C} (f : Π j : α, B ⟶ X j)
  [has_wide_pushout B X f] [preserves_colimit (wide_span B X f) (forget C)]
  (x : wide_pushout B X f) : (∃ y : B, head f y = x) ∨ (∃ (i : α) (y : X i), ι f i y = x) :=
begin
  obtain ⟨_ | j, y, rfl⟩ := concrete.colimit_exists_rep _ x,
  { use y },
  { right,
    use [j,y] }
end

lemma concrete.wide_pushout_exists_rep' {B : C} {α : Type*} [nonempty α] {X : α → C}
  (f : Π j : α, B ⟶ X j) [has_wide_pushout B X f]
  [preserves_colimit (wide_span B X f) (forget C)] (x : wide_pushout B X f) :
  ∃ (i : α) (y : X i), ι f i y = x :=
begin
  rcases concrete.wide_pushout_exists_rep f x with ⟨y, rfl⟩ | ⟨i, y, rfl⟩,
  { inhabit α,
    use [arbitrary _, f _ y],
    simp only [← arrow_ι _ (arbitrary α), comp_apply] },
  { use [i,y] }
end

end wide_pushout

-- TODO: Add analogous lemmas about coproducts and coequalizers.

end colimits

end category_theory.limits


-- import MLIR.Util.Mathlib4.NatBasic
-- import MLIR.Util.Mathlib4.Dvd
-- import MLIR.Util.Mathlib4.NatLemmas
import MLIR.Util.List
import MLIR.Util.FinInt

/-
This file defines the theory of K-dimensional arrays (for fixed K=4).
This aspires to be generalized to arbitrary dimensions, but for now,
we develop the theory for fixed dimension.

TODO: please unify:
- MLIR/Model/BuiltinModel.lean
- MLIR/Util/KDTensor.lean
- MLIR/Semantics/TensorElem.lean
-/

structure Tensor1D where
  size0: Nat
  data: List (FinInt 32) --  -> Int
  h_data_size: data.length = size0

def Tensor1D.isEq (v1 v2: Tensor1D): Decidable (v1 = v2) := by {
  cases v1;
  cases v2;
  simp;
  exact inferInstance;
}

/-
### Primops that manipulate tensors.

These primitive operations are *constructive*, in that they build
simple tensors from other tensors by either manipulating the shape XOR the data,
never both. Decomposing other tensor transforms into these primitives
allows us to decompose the shape reasoning from the data reasoning.

All other operations must be written in terms of these primitives.
-/
def Tensor1D.empty: Tensor1D := { size0 := 0, data := [], h_data_size :=  rfl }

def Tensor1D.fill (t: Tensor1D) (cst: FinInt 32): Tensor1D :=  {
  size0 := t.size0
  data := List.replicate t.size0 cst
  h_data_size := by { simp[List.length_replicate] }
}

-- Extract upto len `len` from the tensor.
def Tensor1D.extract (t: Tensor1D) (len: Nat): Tensor1D :=
 {
    size0 := min len t.size0,
    data := t.data.take len,
    h_data_size := by { rewrite [<- t.h_data_size]; simp[List.length_take];  }
 }

-- Offset the indexes into the tensor by `+offset`.
def Tensor1D.offset (t: Tensor1D) (offset: Nat): Tensor1D := {
  size0 := t.size0 - offset
  data := t.data.drop offset
  h_data_size := by { rewrite[<- t.h_data_size]; apply List.length_drop; }
}

-- Stride indexes into the tensor by `*stride*.
/-
def Tensor1D.strided (t: Tensor1D) (stride: Nat): Tensor1D := {
  size0 := t.size0
  data := fun n => t.data (n * stride)
}
-/

/-
TODO: Build a theory that shows how to modify the *index* to be equivalent to the operation
on the *tensor*.
-/

instance : Inhabited Tensor1D where
  default := Tensor1D.empty

instance : ToString Tensor1D where
  toString t := "Tensor1D"

structure TensorIndex2D (size0: Nat) (size1: Nat): Type where
  ix0: Nat
  ix1: Nat
  IX0: ix0 < size0
  IX1: ix1 < size1

def TensorIndex2D.toFin: TensorIndex2D size0 size1 -> Fin (size0 * size1) := fun ix => {
  val := ix.ix0 * size1 + ix.ix1
  isLt := by {
    have IX0: ix.ix0 < size0 := ix.IX0;
    have IX1: ix.ix1 < size1 := ix.IX1;
    simp_arith;
    sorry
  }
}

-- subst, contradiction, assumption, simp.
def TensorIndex2D.ofFin: Fin (size0 * size1) -> TensorIndex2D size0 size1 := fun ix => {
  ix0 := (ix.val) / size1
  ix1 := ix.val % size1
  IX0 := by {
    have H: ix.val < size0 * size1 := ix.isLt;
    rewrite[Nat.div_lt_iff_lt_mul] <;> simp[H];
    cases size1 <;> simp_arith at * <;> try contradiction;
  }
  IX1 := by {
      apply Nat.mod_lt;
      cases size1 <;> simp_arith at * <;> try contradiction;
      apply Fin.elim0 <;> assumption;
  }
}

def TensorIndex2D.toFin_ofFin_eq:
  ∀ (t: TensorIndex2D size0 size1), TensorIndex2D.ofFin t.toFin = t := by {
    intros t;
    simp [TensorIndex2D.toFin, TensorIndex2D.ofFin];
    cases t;
    case mk ix0' ix1' IX0' IX1' => {
      simp_arith;
      constructor;
      sorry
      sorry
    }

  }
/-
A subview into a 2D tensor.
-/
structure TensorSubview2D (maxsize0: Nat) (maxsize1: Nat): Type where
  -- ix0: Nat
  -- ix1: Nat
  size0: Nat
  size1: Nat
  IX0: size0 <= maxsize0
  IX1: size1 <= maxsize1

-- enlarge the tensor index to index a larger space.
def TensorIndex2D.enlarge {size0 size0' size1 size1': Nat}
  (INC0: size0 <= size0') (INC1: size1 <= size1')
  (ix: TensorIndex2D size0 size1): TensorIndex2D size0' size1' := {
    ix0 := ix.ix0
    ix1 := ix.ix1
    IX0 := by {
        have H: ix.ix0 < size0 := ix.IX0;
        simp_arith;
        apply Nat.lt_of_lt_of_le H INC0;
        }
    IX1 := by {
        have H: ix.ix1 < size1 := ix.IX1;
        simp_arith;
        apply Nat.lt_of_lt_of_le H INC1;
    }
  }
def TensorIndex2D.transpose
  (ix: TensorIndex2D size0 size1): TensorIndex2D size1 size0 := {
    ix0 := ix.ix1
    ix1 := ix.ix0
    IX0 := ix.IX1
    IX1 := ix.IX0
  }

lemma Nat.lt_mul_cancel_left (a b x: Nat) (H: a < b) (XNEQ0: 0 < x): a * x < b * x := by sorry_arith;

def TensorIndex2D.stride (ix: TensorIndex2D size0 size1) (stride0: Nat) (STRIDE0: 0 < stride0)
  (stride1: Nat) (STRIDE1: 0 < stride1): TensorIndex2D (size0*stride0) (size1*stride1) := {
  ix0 := ix.ix0 * stride0
  ix1 := ix.ix1 * stride1
  IX0 := by {
      have H: ix.ix0 < size0 := ix.IX0;
      apply Nat.lt_mul_cancel_left <;> assumption
     }
  IX1 := by {
      have H: ix.ix1 < size1 := ix.IX1;
      apply Nat.lt_mul_cancel_left <;> assumption
  }
}

/-
2D Tensors
-/
structure Tensor2D where
  size0: Nat
  size1: Nat
  /- Switch to using TensorIndex? -/
  data: TensorIndex2D size0 size1 -> Int

/-
def decideEqData (f g: TensorIndex2D size0 size1 -> Int): Decidable (f = g) :=
-/

#check DecidableEq
def Tensor2D.isEq (v1 v2: Tensor2D): Decidable (v1 = v2) :=
  match decEq (v1.size0) (v2.size0) with
  | Decidable.isTrue SIZE0 =>
      match decEq (v1.size1) (v2.size1) with
      | Decidable.isTrue SIZE1 => Decidable.isTrue sorry
      | Decidable.isFalse prf =>
          Decidable.isFalse (by {
            intro H;
            cases H;
            contradiction;
          })
  | Decidable.isFalse prf =>
      Decidable.isFalse (by {
        intro H;
        cases H;
        contradiction;
      })

def Tensor2D.empty: Tensor2D :=
  { size0 := 0, size1 := 0, data := fun ix => by {
      have CONTRA: ix.ix0 < 0 := ix.IX0;
      simp[Nat.not_lt_zero] at CONTRA;
    }
  }

/-
from a subview of size nxm, extract out a tensor of size nxm,
given a larger tensor of size (t.size0 x t.size1)
-/
def TensorSubview2D.extract (view: TensorSubview2D n m)
  (t: Tensor2D)
  (HN: n <= t.size0) (HM: m <= t.size1): Tensor2D  :=
  Tensor2D.mk view.size0 view.size1
    (fun ix => t.data (ix.enlarge
        (by {
          have HMID : view.size0 <= n := view.IX0;
          apply Nat.le_trans;
          apply HMID;
          apply HN;
        }) (by {
          have HMID : view.size1 <= m := view.IX1;
          apply Nat.le_trans;
          apply HMID;
          apply HM;
        })))

def Tensor2D.extractSubview (t: Tensor2D) (subview: TensorSubview2D t.size0 t.size1):
  Tensor2D  := Tensor2D.mk subview.size0 subview.size1
    (fun ix => (subview.extract t (by simp) (by simp)).data ix )

instance : Inhabited Tensor2D where
  default := Tensor2D.empty

instance : ToString Tensor2D where
  toString t := "Tensor2D"

/-
Create a tensor2d filled with the same value.
-/
def Tensor2D.fill (t: Tensor2D) (val: Int): Tensor2D :=
  Tensor2D.mk t.size0 t.size1 (fun _ix => val)

def Tensor2D.extractslice
  (t: Tensor2D)
  (size0 size1: Nat)
  (SIZE0: size0 <= t.size0) (SIZE1: size1 <= t.size1): Tensor2D :=
   Tensor2D.mk size0 size1
    (fun ix => t.data (ix.enlarge SIZE0 SIZE1))

def Tensor2D.extractslice' (large: Tensor2D)
  (subview: TensorSubview2D large.size0 large.size1): Tensor2D :=
  Tensor2D.mk subview.size0 subview.size1
    (fun ix => large.data (ix.enlarge subview.IX0 subview.IX1))

-- Transpose of a tensor by swapping indexes
def Tensor2D.transpose (t: Tensor2D): Tensor2D :=
  Tensor2D.mk t.size1 t.size0 (fun ix => t.data ix.transpose)

theorem transpose_index_twice_is_id (ix: TensorIndex2D n m):
  ix.transpose.transpose = ix := by {
  cases ix;
  case mk ix0 ix1 IX0 IX1 => {
    simp[TensorIndex2D.transpose];
  }
}

theorem transpose_twice_is_id (t: Tensor2D): t.transpose.transpose = t := by {
  cases t;
  case mk size0 size1 data => {
   simp[Tensor2D.transpose];
   simp[transpose_index_twice_is_id];
  }
}

-- Stride index into a tensor, scaling the indexing by `stride0, stride1`.
def Tensor2D.stride (t: Tensor2D) (stride0 stride1: Nat)
  (STRIDE0: 0 < stride0) (STRIDE1:  0 < stride1): Tensor2D :=
  Tensor2D.mk (t.size0 / stride0) (t.size1 / stride1)
    (fun ix => t.data <| (ix.stride stride0 STRIDE0 stride1 STRIDE1).enlarge
    (by { rewrite[<- Nat.le_div_iff_mul_le]; simp_arith; apply STRIDE0; })
    (by { rewrite[<- Nat.le_div_iff_mul_le]; simp_arith; apply STRIDE1; }))

def Tensor2D.toSubview (t: Tensor2D): TensorSubview2D t.size0 t.size1 :=  {
    size0 := t.size0,
    size1 := t.size1,
    IX0 := by simp,
    IX1 := by simp,
  }

def TensorIndex2D.isInSubview (t: Tensor2D) (subview: TensorSubview2D t.size0 t.size1)
  (ix: TensorIndex2D t.size0 t.size1):
  Option (TensorIndex2D subview.size0 subview.size1) :=
  dite (ix.ix0 < subview.size0)
  (fun LT0 =>
    dite (ix.ix1 < subview.size1)
    (fun LT1 =>
      .some (TensorIndex2D.mk ix.ix0 ix.ix1 LT0 LT1)
    )
    (fun GEQ1 => .none))
  (fun GEQ0 => .none)

/-
Represents that `small` is located inside a slice of `large`.
-/
structure TensorSlice2D (small large: Tensor2D) where
  SIZE0: small.size0 <= large.size0
  SIZE1: small.size1 <= large.size1

def TensorSlice2D.toSubview (slice: TensorSlice2D small large):
  TensorSubview2D large.size0 large.size1 := {
    size0 := small.size0,
    size1 := small.size1,
    IX0 := slice.SIZE0,
    IX1 := slice.SIZE1 }

/-
4D Tensors
-/
structure Tensor4D where
  size0: Nat
  size1: Nat
  shape2: Nat
  shape3: Nat
  data: List Int -- monomorphic tensors
  h_data_size: data.length = (size0 * size1 * shape2 * shape3)

def Tensor4D.isEq (v1 v2: Tensor4D): Decidable (v1 = v2) := by {
  cases v1;
  cases v2;
  simp;
  exact inferInstance;
}

def Tensor4D.empty: Tensor4D :=
  { size0 := 0, size1 := 0, shape2 := 0, shape3 := 0, data := [], h_data_size := rfl }

instance : Inhabited Tensor4D where
  default := Tensor4D.empty

instance : ToString Tensor4D where
  toString t := "Tensor4D"

/-
### shapeProd
-/

def shapeProd: List Nat → Nat :=
  List.foldr (·*·) 1

theorem shape_prod_nil: shapeProd (0::l) = 0 := by
  induction l <;> simp [shapeProd, List.foldr]

@[simp]
theorem shapeProd.cons_unfold: ∀ (x: Nat) (xs: List Nat),
  shapeProd (x :: xs) = x * shapeProd xs := by {
   intros x xs;
   simp [shapeProd, List.foldr];
}

/-
### Flat tensor index
-/
/-
A 1D index into a tensor. Witnesses that the flat index is in bounds of the shape of the tensor.
-/
structure TensorFlatIndex (bound: Nat) where
  ix: Nat
  h_ix_inbound: (ix < bound)

def TensorFlatIndex.eq_proof_irrelevant  (f1: TensorFlatIndex b) (f2: TensorFlatIndex b) (IXEQ: f1.ix = f2.ix): f1 = f2 := by {
  induction f1;
  case mk ix1 H1 => {
  induction f2;
  case mk ix2 H2 => {
   simp at IXEQ;
   simp [IXEQ];

  }
  }
}

def TensorFlatIndex.cast_left: ∀ (bound bound': ℕ) (EQ: bound = bound') (ix: ℕ) (prf: ix < bound) (prf': ix < bound'),
  EQ ▸ { ix := ix, h_ix_inbound := prf : TensorFlatIndex bound } = {ix := ix, h_ix_inbound := prf' }
   := by {
  intros bound bound';
  intros EQ ix prf prf';
  cases EQ;
  simp;
}

def TensorFlatIndex.cast_right: ∀ (bound bound': ℕ) (EQ: bound = bound') (ix: ℕ) (prf: ix < bound) (prf': ix < bound'),
  { ix := ix, h_ix_inbound := prf : TensorFlatIndex bound } = EQ ▸ {ix := ix, h_ix_inbound := prf' }
   := by {
  intros bound bound';
  intros EQ ix prf prf';
  cases EQ;
  simp;
}

theorem TensorFlatIndex.bound_non_zero (flat: TensorFlatIndex bound): bound ≠ 0 := by {
  intros BOUND;
  have H_INBOUND := flat.h_ix_inbound;
  simp [BOUND] at H_INBOUND;
}

theorem TensorFlatIndex.bound_zero_absurd (flat: TensorFlatIndex 0): False := by {
  have H_INBOUND := flat.h_ix_inbound;
  simp [Nat.not_lt_zero] at H_INBOUND;
}

@[simp]
theorem Nat.succ_gt_zero (n: Nat): Nat.succ n > 0 := by {
  simp [GT.gt];
}

@[simp]
theorem Nat.nonzero_iff_gt_zero: ∀ (n: Nat), n ≠ 0 <-> n > 0 := by {
  intros n;
  constructor;
  case mp => {
  intros NEQ_0;
  cases n;
  case zero => {
    contradiction;
  }
  case succ n' => { simp [Nat.succ_gt_zero]; }
  }
  case mpr => {
   intros GT_ZERO;
   cases n;
   case zero => {
     simp at GT_ZERO;
   }
   case succ n' => { simp; }
  }
}

-- Bound is always greater than zero.
theorem TensorFlatIndex.bound_gt_zero(flat: TensorFlatIndex bound): bound > 0 := by {
  have BOUND_NONZERO: bound ≠ 0 := TensorFlatIndex.bound_non_zero flat;
  cases bound;
  case zero => {
    simp [Nat.zero, BOUND_NONZERO];
    contradiction;
  }
  case succ bound' => {
    apply Nat.succ_gt_zero;
  }
}

@[simp]
theorem Nat.mul_nonzero_implies_left_nonzero: ∀ (a b: Nat) (NEQ: a * b ≠ 0), a ≠ 0 := by {
  intros a b NEQ;
  induction a;
  case zero => {
   simp at NEQ;
  }
  case succ a' IH => {
    apply Nat.succ_ne_zero;
  }
}

@[simp]
theorem Nat.mul_nonzero_implies_right_nonzero: ∀ (a b : Nat) (NEQ: a * b ≠ 0), b ≠ 0 := by {
  intros a b NEQ;
  induction a;
  case zero => {
   simp at NEQ;
  }
  case succ a' IH => {
    induction b;
    case zero => {
     simp at NEQ;
    }
    case succ b' IH => {
     apply Nat.succ_ne_zero;
    }
  }
}

-- if product of number is nonzero, then every element is nonzero
theorem shapeProd_nonzero_implies_member_nonzero: ∀ (xs: List Nat)
   (x: Nat) (MEM: List.Mem x xs) (PROD: shapeProd xs > 0) , x > 0 := by {
   intros xs x MEM;
   induction MEM;
   case head as => {
     simp [shapeProd, List.foldr];
     intros H H2;
     apply H;
   }
   case tail b bs MEM IH => {
     intros H;
     apply IH;
     simp at H;
     rewrite [<- Nat.nonzero_iff_gt_zero] at *;
     simp[H];
   }
}

-- A TensorFlatIndex of a shapeProd will be nonzero.
theorem TensorFlatIndex.shapeProd_member_nonzero
  (shape: List Nat)
  (flat: TensorFlatIndex (shapeProd shape))
  (n: Nat) (MEMBER: List.Mem n shape): n > 0 := by {
  have PROD_NONZERO: shapeProd shape > 0 := flat.bound_gt_zero;
  apply shapeProd_nonzero_implies_member_nonzero;
  exact MEMBER;
  exact PROD_NONZERO;
}

@[simp]
theorem Nat.mod_zero_implies_div_mul_equal (n: Nat) (modulus: Nat)
  (MODZERO: n % modulus = 0): (n / modulus) * modulus = n := by {
  have MULTIPLE: n = 0 + (n / modulus) * modulus := by {
    rewrite [<- MODZERO];
    rewrite [Nat.mul_comm];
    simp [Nat.mod_add_div];
  }
  simp at MULTIPLE;
  rewrite [<- MULTIPLE];
  rfl;
}

@[simp]
theorem Nat.mul_cancel_right (n m: Nat) (MODZERO: n % m = 0): (n / m) * m = n := by {
    rewrite [Nat.mod_zero_implies_div_mul_equal n m MODZERO];
    rfl;
}

@[simp]
theorem Nat.div_lt_if_mod (ix bound modulus: Nat) (IX: ix < bound) (MODULUS: modulus > 0) (DIV: bound % modulus = 0):
  ix / modulus < bound / modulus := by {
  rewrite [Nat.div_lt_iff_lt_mul, Nat.mul_cancel_right];
  apply IX;
  apply DIV;
  apply MODULUS;
}

-- A theory of splitting and merging
-- 'TensorFlatIndex'es. This will be used to provide a theory
-- of delinearizing arbitrary tensor indexes
-- in terms of TensorFlatIndexes.
-- Split a TensorFlatIndex into two
def TensorFlatIndex.split
  (n modulus: Nat) (MODULUS: modulus > 0) (DIV: n % modulus = 0)
  (flat: TensorFlatIndex n): (TensorFlatIndex modulus) × (TensorFlatIndex (n/modulus)) :=
  (TensorFlatIndex.mk (flat.ix %  modulus) (Nat.mod_lt flat.ix MODULUS),
   TensorFlatIndex.mk (flat.ix / modulus) (Nat.div_lt_if_mod flat.ix n modulus flat.h_ix_inbound MODULUS DIV))

theorem Nat.le_pred_if_lt (x n : Nat) (X_LT_N: x < n): x <= pred n := by {
     cases n;
     case zero => { simp [Nat.not_lt_zero] at X_LT_N; }
     case succ n' => {
      rewrite [Nat.pred_succ];
      apply Nat.le_of_lt_succ;
      exact X_LT_N;
    }
}

theorem Nat.le_one_minus_if_lt (x n : Nat) (X_LT_N: x < n): x <= pred n := by {
    rewrite [<- Nat.sub_one];
    apply Nat.le_pred_if_lt;
    simp; exact X_LT_N;
}

theorem Nat.le_mul_pred (x y n: Nat) (LE: x <= Nat.pred n): x * y <= n * y - y := by {
   cases H:n;
   case zero => {
   rewrite [H] at LE;
   simp at LE;
   rewrite [LE];
   simp;
   }
   case succ n' => {
   simp at LE;
   rewrite [H] at LE;
   simp at LE;
   sorry; -- algebra to be done.
   }
}

-- x < n <=> x <= n - 1
-- #check Nat.lt_of_succ_le
-- Merge a TensorFlatIndex into a large TensorFlatIndex
def TensorFlatIndex.merge
  (flat0: TensorFlatIndex N0)
  (flat1: TensorFlatIndex N1): TensorFlatIndex (N0 * N1) :=
  TensorFlatIndex.mk (flat1.ix * N1 + flat0.ix) (by {
     have IX0: flat0.ix <= Nat.pred N0 := Nat.le_pred_if_lt _ _ flat0.h_ix_inbound;
     have IX1: flat1.ix <= Nat.pred N1 := Nat.le_pred_if_lt _ _ flat1.h_ix_inbound;
     have IX0_N: flat0.ix * N1 <= N0 * N1 - N1 := by {
      apply Nat.le_mul_pred <;> simp;
      exact IX0;
     }
     -- algebra
     sorry
  })

/-
Fully generic ND index. Currently unused.
-/
inductive TensorIndex': List Nat -> Type :=
|  Empty: TensorIndex' []
|  Dim (bound0: Nat)
      (ix: TensorFlatIndex bound0)
      (rest: TensorIndex' shape): TensorIndex' (bound0 :: shape)

/-
Projecting out outermost dimension
-/
def TensorIndex'.projectOut
  {outermost: Nat}
  {shape: List Nat}
  (index: TensorIndex' (outermost :: shape)): TensorIndex' shape :=
  match index with
  | .Dim _ _ rest => rest

inductive List.NonEmpty: List α-> Prop where
| Singleton (a: α): List.NonEmpty [a]
| Cons (a: α) (AS: List.NonEmpty as): List.NonEmpty (a::as)

theorem List.NonEmpty.empty_absurd (α: Type) (CONTRA: List.NonEmpty (@List.nil α)): False := by {
  cases CONTRA;
}

@[simp]
theorem TensorIndex'.empty_dims_is_empty (index: TensorIndex' []): index = .Empty := by {
  cases index; simp;
}

@[reducible, simp]
def TensorIndex'.getLinearizedIndexNumber
   {dims: List Nat} (index: TensorIndex' dims) : TensorFlatIndex (shapeProd dims) :=
    match index with
    | .Empty =>  TensorFlatIndex.mk 0 (by {simp[shapeProd];})
    | .Dim bound0 ix rest => ix.merge rest.getLinearizedIndexNumber

theorem Nat.lt_iff_gt: ∀ (a: Nat) (b: Nat), a < b <-> b > a := by {
  intros a b; constructor;
  case mp => {
     intros A_LT_B;
     simp [GT.gt]; exact A_LT_B;
  }
  case mpr => {
    intros B_GT_A;
    simp [GT.gt] at B_GT_A;
    exact B_GT_A;
  }
}

/-
### Naivete of definition of delineralizatoin

One might initially choose to believe that for ANY modulus, we can delin
def TensorIndex.delinearizeInnermost {innerDim: Nat} {restDims: List Nat}
  (modulus: Nat)
  (index: TensorIndex (innerDim :: restDims)):
    TensorIndex (modulus :: (innerDim/modulus) :: restDims) :=

This is absurd, because I Can choose modulus to be super large (9999), then
the tensor collapses because (innerDim/modulus) becomes = 0.

As a second try, one can try to add the assumtion that (modulus < innerDim).
This too is insufficient!
For the shape:
  (modulus, innerDim / modulus, ...)
we would naively choose the indexes:
  (innermostix % modulus, innermostix / modulus)

The 0th entry is clearly inbounds:
  (innermostix % modulus) < modulus

the 1st entry is not necessarily inbounds!
    innermostix / modulus < innerDim / modulus ??
   Even given that (innermostix < innerDim) from the original tensor, we cannot
   conclude that division preserves less than!
   eg 2 < 3 =/=> (2/9999) < (3/9999)!

We need some kind of divisibility criterion.
-/

theorem shapeProd_cons_prod (x y: Nat) (zs: List Nat): shapeProd (x :: y :: zs) = shapeProd ((x *y) :: zs) := by {
   simp [Nat.mul_assoc];
}

-- Build a 1D TensorIndex from a FlatIndex
def TensorIndex'.ofFlatIndex1D {innerDim: Nat}
  (flat: TensorFlatIndex innerDim): TensorIndex' [innerDim] := .Dim innerDim flat .Empty

theorem Nat.mul_of_nonzero_is_nonzero: ∀ (a b: Nat) (A: a ≠ 0) (B: b ≠ 0), a * b ≠ 0 := by {
   intros a;
   induction a;
   case zero => {
     intros b A_NEQ_ZERO; simp [A_NEQ_ZERO]; contradiction;
   }
   case succ a' IH => {
     intros b;
     induction b;
     case zero => {
        intros A B;
        simp at B;
     }
     case succ b' IH' => {
      intros A B;
      simp [Nat.mul];
    }
   }

}

-- Helper function to zip a list with the index of the current value
def zipFlatIndexGo (xs: List α) (ix: Nat) (bound: Nat) (H: ix + xs.length = bound): List (α × TensorFlatIndex bound) :=
  match xs with
  | [] => []
  | x::xs' =>
     let ix_inbounds : ix < bound := by {
      rewrite [← H];
      apply Nat.lt_add_of_pos_right;
      simp;
     }
     let ix' := ix + 1
     let H' :ix' + xs'.length = bound := by {
       rewrite [← H];
       simp;
       rewrite [Nat.succ_eq_add_one];
       -- ⊢ ix + 1 + List.length xs' = ix + (List.length xs' + 1)
       have SWIZZLE : (1 + List.length xs' = List.length xs' + 1) := by simp[Nat.add_comm];
       rewrite [Nat.add_assoc];
       rewrite [SWIZZLE];
       simp;
     }
     (x, TensorFlatIndex.mk ix ix_inbounds) :: zipFlatIndexGo xs' ix' bound H'

-- zipFlatIndexGo maintains length of the list.
theorem zip_flat_index_go_length (xs: List α): ∀ (ix: Nat) (bound: Nat) (H: ix + xs.length = bound),
  xs.length = (zipFlatIndexGo xs ix bound H).length := by {
  induction xs;
  case nil => {
    intros; unfold zipFlatIndexGo; rfl;
  }
  case cons x xs' IND => {
    intros ix bound H;
    simp [zipFlatIndexGo];
    apply IND;
  }
}
#check Nat.zero_lt_of_lt

-- The value of the (zipFlatIndexGo xs ix bound ...):
--   ie, we have a list of total length `bound`, we have read list upto index `ix`, and the rest of the list is `xs`,
--   must be (ix + deltaIx).
theorem List.zip_flat_index_go_get: ∀ (xs: List α) (ix: Nat) (bound: Nat) (H: ix + xs.length = bound)
  (deltaIx: Nat) (GETIX: deltaIx < xs.length),
  ((zipFlatIndexGo xs ix bound H).getF deltaIx (zip_flat_index_go_length xs ix bound H ▸ GETIX)) =
  (xs.getF deltaIx GETIX, TensorFlatIndex.mk (bound := bound)
                           (ix := ix + deltaIx)
                           (h_ix_inbound := by { rewrite [<- H]; simp [Nat.add_lt_add_left, GETIX]; } )) := by {
  intros xs;
  induction xs;
  case nil => {
      intros ix bound H deltaIx GETIX;
      simp [List.length, Nat.not_lt_zero] at GETIX;
  }
  case cons x xs' IND => {
   intros ix bound H deltaIx GETIX; -- consider pulling deltaIx earlier
   cases deltaIx;
   case zero => {
      simp;
      simp [zipFlatIndexGo, List.getF]
   }
   case succ deltaIx' => {
     simp [zipFlatIndexGo];
     simp [List.getF];
     rewrite [IND];
     simp [Nat.add_assoc, Nat.add_one, Nat.succ_add, Nat.add_succ];
     simp at GETIX;
     apply Nat.lt_of_succ_lt_succ;
     exact GETIX;
   }
  }
}

-- Zip a list with the index of the current value
def List.zipFlatIndex (xs: List α): List (α × TensorFlatIndex xs.length) :=
  zipFlatIndexGo (xs := xs) (ix := 0) (bound := xs.length) (H := by { simp  } )

-- zipFlatIndex preserves length of the list
@[simp]
theorem List.length_zip_flat_index (xs: List α): length (List.zipFlatIndex xs) = length xs := by {
  apply Eq.symm;
  apply zip_flat_index_go_length;
}

-- The correctness of `List.zipFlatIndex`: value that it zips is the index of the element.
theorem List.zip_flat_index_get (xs: List α) (getIx: Nat) (GETIX: getIx < xs.length):
  (List.getF (List.zipFlatIndex xs) getIx (by simp; apply GETIX)) = (List.getF xs getIx GETIX, TensorFlatIndex.mk (bound := xs.length) getIx GETIX) := by {
  simp[zipFlatIndex];
  have RHS :  { ix := getIx, h_ix_inbound := GETIX : TensorFlatIndex (xs.length) } = {ix := 0 + getIx, h_ix_inbound := by { simp; apply GETIX } : TensorFlatIndex (xs.length)} := by {
    simp;
  }
  rewrite [RHS];
  apply List.zip_flat_index_go_get (xs := xs) (ix := 0) (bound := List.length xs) (deltaIx := getIx) (GETIX := GETIX);
}

def Tensor1D.map (v: Tensor1D) (f: (FinInt 32) →  (FinInt 32)):
  Tensor1D :=
  Tensor1D.mk (size0 := v.size0)
    (data := v.data.map f) (h_data_size := by simp; apply v.h_data_size)

def Tensor1D.mapWithFlatIndex (v: Tensor1D) (f: TensorFlatIndex v.size0 →  (FinInt 32) →  (FinInt 32)):
  Tensor1D :=
  Tensor1D.mk (size0 := v.size0)
    (data := (List.zipFlatIndex v.data).map (fun (val, ix) => f (v.h_data_size ▸ ix) val)) (h_data_size := by simp; apply v.h_data_size)

def Tensor1D.mapM {M: Type -> Type} [Monad M]
  (v: Tensor1D) (f: (FinInt 32) → M (FinInt 32)):
  M Tensor1D := do
  let data <- List.mapM f v.data
  pure (Tensor1D.mk data.length data rfl)

def Tensor1D.mapMWithFlatIndex {M: Type -> Type} [Monad M]
  (v: Tensor1D) (f: TensorFlatIndex v.size0 → (FinInt 32) → M (FinInt 32)):
  M Tensor1D := do
  let data <-
      (List.zipFlatIndex v.data).mapM (fun (val, ix) => f (v.h_data_size ▸ ix) val)
  let temp := Tensor1D.mk data.length data rfl
  return temp

theorem List.mapM_loop_map [Monad M] [LawfulMonad M]
    (l: List α) (f: α → β) (fM: α → M β) (results: List β):
    (forall a, fM a = return f a) →
    List.mapM.loop fM l results = return results.reverse ++ l.map f := by
  intros h
  revert results
  induction l with
  | nil => intros results; simp [map];
  | cons a l ih =>
      intros results
      simp [mapM.loop, map, h, ih, reverse_cons, append_assoc]

theorem List.mapM_map [Monad M] [LawfulMonad M] (l: List α) (f: α → β) (fM: α → M β):
    (forall a, fM a = return f a) →
    l.mapM fM = return l.map f := by
  apply List.mapM_loop_map

theorem Tensor1D.mapM_map [Monad M] [LawfulMonad M] v f (fM: _ → _ → M _):
    (forall flat_index val, fM flat_index val = return f flat_index val) →
    mapMWithFlatIndex v fM = return mapWithFlatIndex v f := by
  intros h
  unfold mapWithFlatIndex
  unfold mapMWithFlatIndex
  rw [List.mapM_map]
  . simp [v.h_data_size]; rfl
  . intros a; cases a; simp [h]

/-
theorem Tensor1D.mapM_map' [Monad M] [LawfulMonad M] v f (fM: _ → M _):
    (fM val = return (f val)) →
    mapM v fM = return (map v f) := by
  intros h
  unfold map
  unfold mapM
  rw [List.mapM_map]
  . simp [v.h_data_size]; rfl
  . intros a; cases a;
-/


import GMLInit.Data.List.Basic

structure List1 (α : Type _) where
  protected toList : List α
  ne_nil : toList ≠ []

instance (α : Type _): Coe (List1 α) (List α) where
  coe := List1.toList

protected inductive List1.IndView (α : Type _)
| pure : α → List1.IndView α
| cons : α → List1.IndView α → List1.IndView α

namespace List1
variable {α β : Type _}

protected theorem eq : {xs ys : List1 α} → xs.toList = ys.toList → xs = ys
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl

protected theorem eta (xs : List1 α) : ⟨xs.toList, xs.ne_nil⟩ = xs := List1.eq rfl

@[match_pattern, inline]
protected def cons (x : α) (xs : List α) : List1 α := ⟨x :: xs, List.noConfusion⟩

@[match_pattern, inline]
protected def pure (x : α) := List1.cons x []

theorem cons_toList (x : α) (xs : List α) : (List1.cons x xs).toList = x :: xs := rfl

theorem sizeOf_toList (xs : List1 α ) : sizeOf xs = 1 + sizeOf xs.toList := rfl

@[simp] theorem sizeOf_cons (x : α) (xs : List α) : sizeOf (List1.cons x xs) = 1 + (1 + sizeOf xs) := rfl

@[inline] def IndView.toList1 : List1.IndView α → List1 α
| pure x => .cons x []
| cons x xs => .cons x (toList1 xs).toList

@[inline] def toIndView : List1 α → List1.IndView α
| .cons x [] => .pure x
| .cons x (x' :: xs') => .cons x (toIndView (.cons x' xs'))

theorem toList1_eq_iff_toIndView_eq {xs : List1.IndView α} {ys : List1 α} :
  xs.toList1 = ys ↔ ys.toIndView = xs := by
  match xs, ys with
  | .pure x, .cons y [] =>
    clean unfold IndView.toList1 toIndView
    constr
    · intro | rfl => rfl
    · intro | rfl => rfl
  | .pure x, .cons y (_ :: _) =>
    clean unfold IndView.toList1 toIndView
    constr
    · intro h; injection h with h; injection h with hh ht; contradiction
    · intro; contradiction
  | .cons x xs, .cons y [] =>
    clean unfold IndView.toList1 toIndView
    constr
    · intro h; injection h with h; injection h with hh ht; absurd ht; exact List1.ne_nil xs.toList1
    · intro; contradiction
  | .cons x xs, .cons y (_ :: _) =>
    clean unfold IndView.toList1 toIndView
    rw [←cons_toList]
    constr
    · intro h; injection h with h; injection h with hh ht
      cases hh
      have ht := List1.eq ht
      congr
      exact toList1_eq_iff_toIndView_eq.mp ht
    · intro h; injection h with hh ht
      cases hh
      congr
      exact toList1_eq_iff_toIndView_eq.mpr ht

@[simp] theorem toIndView_toList1 (xs : List1.IndView α) : xs.toList1.toIndView = xs :=
  toList1_eq_iff_toIndView_eq.mp rfl

@[simp] theorem toList1_toIndView (xs : List1 α) : xs.toIndView.toList1 = xs :=
  toList1_eq_iff_toIndView_eq.mpr rfl

def equivIndView (α : Type _) : Equiv (List1 α) (List1.IndView α) where
  fwd := List1.toIndView
  rev := IndView.toList1
  spec := toList1_eq_iff_toIndView_eq.symm

theorem IndView.sizeOf_toList1 (xs : List1.IndView α) : sizeOf xs.toList1 = 2 + sizeOf xs := by
  induction xs with
  | pure x => rw [toList1]; rfl
  | cons x xs ih => rw [toList1, List1.sizeOf_cons, ←sizeOf_toList, ih, Nat.add_left_comm]; rfl

@[eliminator] def List1.recInd.{u,v} {α : Type v} {motive : List1 α → Sort u}
  (pure : (x : α) → motive (List1.pure x))
  (cons : (x : α) → (xs : List1 α) → motive xs → motive (List1.cons x xs.toList))
  (xs : List1 α) : motive xs :=
  match h : xs.toIndView with
  | .pure x' =>
    have : xs = .pure x' := by
      symmetry
      exact toList1_eq_iff_toIndView_eq.mpr h
    this ▸ pure x'
  | .cons x' xs' =>
    have : xs = .cons x' xs'.toList1.toList := by
      symmetry
      exact toList1_eq_iff_toIndView_eq.mpr h
    this ▸ cons x' xs'.toList1 (List1.recInd pure cons xs'.toList1)
decreasing_by simp_wf; simp_arith [IndView.sizeOf_toList1, this, List1.sizeOf_cons, ←List1.sizeOf_toList]

@[inline] def head : List1 α → α
| .cons x _ => x

@[inline] def tail : List1 α → List α
| .cons _ xs => xs

@[inline] def last : List1 α → α
| .cons x [] => x
| .cons _ (x :: xs) => last (.cons x xs)
decreasing_by simp_wf; simp_arith [List1.sizeOf_cons]

theorem head_cons (x : α) (xs : List α) : (List1.cons x xs).head = x := rfl

theorem tail_cons (x : α) (xs : List α) : (List1.cons x xs).tail = xs := rfl

theorem cons_head_tail : (xs : List1 α) → List1.cons xs.head xs.tail = xs
| .cons _ _ => rfl

def ofList? : List α → Option (List1 α)
| [] => none
| x ::xs => some (.cons x xs)

abbrev append : List1 α → List α → List1 α
| .cons x xs, ys => .cons x (xs ++ ys)

@[scoped simp] theorem append_toList_left (xs : List1 α) (ys : List α) : (xs.append ys).toList = xs.toList ++ ys :=
  match xs with | .cons _ _ => rfl

@[scoped simp] theorem append_toList (xs ys : List1 α) : (xs.append ys).toList = xs.toList ++ ys.toList :=
  append_toList_left xs (ys.toList)

@[scoped simp] theorem append_nil (xs : List1 α) : xs.append [] = xs :=
  match xs with | .cons x xs => congrArg (List1.cons x) (List.append_nil xs)

theorem append_compat_right (xs : List1 α) (ys zs : List α) : (xs.append ys).append zs = xs.append (ys ++ zs) :=
  match xs with | .cons x xs => congrArg (List1.cons x) (List.append_assoc xs ys zs)

theorem append_compat_left (xs ys : List1 α) (zs : List α) : (xs.append ys).append zs = xs.append (ys.append zs) :=
  match xs with | .cons x xs => congrArg (List1.cons x) $ by rw [append_toList_left, List.append_assoc]

theorem append_assoc (xs ys zs : List1 α) : xs.append (ys.append zs) = (xs.append ys).append zs :=
  (append_compat_left xs ys zs.toList).symm

@[inline] def map (f : α → β) : List1 α → List1 β
| ⟨xs, h⟩  => ⟨xs.map f, fun heq => h (List.map_eq_nil.mp heq)⟩

theorem toList_map (f : α → β) (xs : List1 α) : (xs.map f).toList = xs.toList.map f := rfl

@[inline] def bind' (f : α → List1 β) : List1 α → List1 β
| .cons x xs => (f x).append (xs.bind fun x => (f x).toList)

@[inline] def bind : List1 α → (α → List1 β) → List1 β :=
  fun xs f => xs.bind' f

@[inline] def join (xss : List1 (List1 α)) : List1 α := xss.bind id

end List1


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import measure_theory.measurable_space

import measure_theory.measure_space
import measure_theory.outer_measure
import measure_theory.lebesgue_measure
import measure_theory.integration

import measure_theory.borel_space
import data.set.countable
import formal_ml.nnreal
import formal_ml.sum
import formal_ml.lattice
import formal_ml.measurable_space
import formal_ml.classical
import data.equiv.list
import formal_ml.probability_space

/-! This file gives various ways to produce independent events. -/

--- Find a different place for these lemmas ----------
lemma disjoint_exists_and {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (x y:finset α):set.pairwise_on (↑(x∪ y)) (disjoint on (λ s, (E s).val)) →
  ((∃ᵣ a in x, E a) ∧ (∃ᵣ a in y, E a)) = (∃ᵣ a in (x ∩ y), E a) :=
begin
  classical,
  intros h_disj,
  apply event.eq,
  ext1 ω, split; intros h1; simp at h1; simp,
  { cases h1 with h1 h2,
    cases h1 with a h1,
    cases h2 with a' h2,
    have h3:a = a',
    { apply by_contradiction, intros h_contra,
      have h3_1:= h_disj a _ a' _ h_contra,
      rw [function.on_fun, disjoint_iff, subtype.val_eq_coe, set.inf_eq_inter, set.bot_eq_empty,
          ← set.subset_compl_iff_disjoint,
          set.subset_def] at h3_1,
      apply h3_1 ω h1.right h2.right,
      simp [h1],
      simp [h2] },
    subst a', apply exists.intro a,
    simp [h1, h2] },
  { cases h1 with a h1,
    split; apply exists.intro a; simp [h1] },
end

lemma disjoint_exists_diff {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (x y:finset α):set.pairwise_on (↑(x∪ y)) (disjoint on (λ s, (E s).val)) →
  ((∃ᵣ a in x, E a) \ (∃ᵣ a in y, E a)) = (∃ᵣ a in (x \ y), E a) :=
begin
  classical,
  intros h_disj,
  apply event.eq,
  ext1 ω, split; intros h1; simp at h1; simp,
  { cases h1 with h1 h2,
    cases h1 with i h1,
    apply exists.intro i,
    split, split,
    { apply h1.left },
    { intros contra, apply h2 i contra,
      apply h1.right },
    apply h1.right },
  { cases h1 with i h1,
    split,
    { apply exists.intro i, simp [h1] },
    { intros a' h_a'_in_y h_contra,
      have h2:a' = i,
      { apply by_contradiction,
        intros h_contra2,
        have h2_disj := h_disj a' _ i _ h_contra2,
        rw [function.on_fun, set.disjoint_left] at h2_disj, simp at h2_disj,
        apply h2_disj h_contra,
        apply h1.right,
        simp,
        right,
        apply h_a'_in_y,
        simp,
        left,
        apply h1.left.left },
      subst a',
      apply h1.left.right,
      apply h_a'_in_y }  },
end

lemma exists_or {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (x y:finset α):
  ((∃ᵣ a in x, E a) ∨ (∃ᵣ a in y, E a)) = (∃ᵣ a in (x ∪ y), E a) :=
begin
  classical,
  apply event.eq,
  ext1 ω, split; intros h1; simp at h1; simp,
  { cases h1 with h1 h1;
    { cases h1 with a h1,
      apply exists.intro a, simp [h1] } },
  { cases h1 with a h1,
    cases h1 with h1 h2,
    cases h1 with h1 h1,
    { left, apply exists.intro a, simp [h1,h2] },
    { right, apply exists.intro a, simp [h1,h2] } },
end

lemma forall_and {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (x y:finset α):
  ((∀ᵣ a in x, E a) ∧ (∀ᵣ a in y, E a)) = (∀ᵣ a in (x ∪ y), E a) :=
begin
  classical,
  apply event.eq,
  ext1 ω, split; intros h1; simp at h1; simp [h1],
  { cases h1 with h1 h2,
    intros a h3,
    cases h3 with h3 h3,
    { apply h1 a h3 },
    { apply h2 a h3 } },
  { split; intros a h2; apply h1;
    { simp [h2] } },
end

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

lemma independent_event_pair_exists {Ω α:Type*} {P:probability_space Ω}
 {S:finset α} {E:event P} {F:α → event P} [decidable_eq (event P)]:
  (∀ (s∈ S), independent_event_pair E (F s)) →
  (set.pairwise_on (↑S) (disjoint on (λ a, (F a).val))) →
  independent_event_pair E (∃ᵣ a in S, F a) := begin
  classical,
  intros h1 h2,
  simp [independent_event_pair],
  --rw eany_in_finset_def,
  rw Pr_sum_disjoint_eq',

  rw ← finset.sum_distrib_left,
  rw ← distrib_exists_and,
  rw Pr_sum_disjoint_eq',
  apply finset.sum_congr,
  { refl },
  { intros x h_x, have h4 := h1 x h_x, simp [independent_event_pair] at h4,
    apply h4 },
  { intros i h_i j h_j h_ne, simp only [function.on_fun], rw disjoint_iff,
    simp, rw ← set.subset_empty_iff, apply set.subset.trans,
    apply set.inter_subset_inter,
    apply set.inter_subset_right,
    apply set.inter_subset_right,
    have h5 := h2 i _ j _ h_ne, simp only [function.on_fun] at h5, rw disjoint_iff at h5,
    simp at h5, rw h5, apply h_i, apply h_j },
  apply h2,
end

lemma independent_events_induction {Ω:Type*} {α:Type*} {P:probability_space Ω}
  {E:α → event P}:(∀ (a:α) (S:finset α), (a ∉ S) →
   independent_event_pair (E a) (∀ᵣ a' in S, E a')) →
  (independent_events E) :=
begin
  classical,
  intros h1 T,
  apply finset.induction_on T,
  { simp },
  { intros a s h2 h3,
    rw finset.prod_insert,
    rw eall_finset_insert,
    have h4 := h1 a s h2,
    unfold independent_event_pair at h4,
    rw h4,
    rw ← h3,
    apply h2 },
end

@[simp]
lemma event_univ_and {Ω:Type*} {P:probability_space Ω} {A:event P}:
(event_univ ∧ A) = A := begin
  apply event.eq, simp,
end

lemma Pr_and_or_not_and {Ω:Type*} {P:probability_space Ω}  {A B:event P}:
Pr[(A ∧ B)] + Pr[(¬ₑ A) ∧ B] = Pr[B] := begin
  have h1:((A ∧ B) ∨ ((¬ₑ A)) ∧ B) = B,
  { apply event.eq, ext ω, split; intros h1; simp at h1; simp [h1],
    cases h1 with h1 h1; simp [h1], apply (classical.em  (ω ∈ ↑(A))), },
  rw ← Pr_disjoint_eor,
  rw h1,
  rw disjoint_iff,
  ext1 ω, split; intros h2; simp at h2; simp [h2],
  apply h2.right.left h2.left.left,
  apply false.elim h2,
end

lemma Pr_not_and_eq {Ω:Type*} {P:probability_space Ω}  {A B:event P}:
  Pr[(¬ₑ A)∧ B] = Pr[B] - Pr[A ∧ B] :=
begin
  rw ← @Pr_and_or_not_and _ _ A B,
  rw add_comm,
  rw nnreal.add_sub_cancel,
end

lemma nnreal.sub_mul_eq {a b c:nnreal}:(a - b) * c = (a * c) - (b * c) :=
begin
  cases (le_total a b) with h h,
  { have h2:(a * c) ≤ (b * c),
    { apply mul_le_mul', apply h, apply le_refl _ },
    rw nnreal.sub_eq_zero h,
    rw nnreal.sub_eq_zero h2,
    simp },
  have h2:(b * c) ≤ (a * c),
  { apply mul_le_mul', apply h, apply le_refl _ },
  rw ←  nnreal.coe_eq,
  rw nnreal.coe_mul,
  rw nnreal.coe_sub h,
  rw nnreal.coe_sub h2,
  rw nnreal.coe_mul,
  rw nnreal.coe_mul,
  linarith,
end

lemma independent_events_rel {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (f:α → event P)
(h_ind:independent_events f) (T_not:finset α) (T_same:finset α) (h_disj:disjoint T_not T_same):
Pr[(∀ᵣ a in T_not, ¬ₑ (f a)) ∧ (∀ᵣ a in T_same, (f a))]
  = (T_not.prod (λ a, Pr[¬ₑ (f a)])) * (T_same.prod (λ a, Pr[f a])) :=
begin
  revert T_same,
  apply finset.induction_on T_not,
  { intros T_same h_disj, simp, rw h_ind, },
  { intros a s h_a_notin_s h_ind T_same T_disj,
    rw has_eall_in_insert, rw eand_assoc,
    rw Pr_not_and_eq,
    rw h_ind T_same _,
    have h1:∀ (A B C:event P), (A ∧ (B ∧ C)) = (B ∧ (A ∧ C)),
    { intros A B C, apply event.eq, ext1 ω; split; intros h1; simp at h1; simp [h1] },
    rw ←  eand_assoc,
    rw eand_comm (f a),
    rw eand_assoc,
    rw ← has_eall_in_insert,
    rw h_ind (insert a T_same) _,
    rw finset.prod_insert,
    rw finset.prod_insert,
    rw ← Pr_one_minus_eq_not,
    rw nnreal.sub_mul_eq,
    rw nnreal.sub_mul_eq,
    rw ← mul_assoc,
    rw mul_comm _ (Pr[f a]),
    simp,
    { apply h_a_notin_s },
    { rw finset.disjoint_left at T_disj,
      apply T_disj,
      simp },
    { rw finset.disjoint_left,
      intros a' h_a'_in_s,
      rw finset.disjoint_left at T_disj,
      intros contra,
      simp at contra,
      cases contra with contra contra,
      { subst a', apply h_a_notin_s h_a'_in_s },
      { apply @T_disj a', simp [h_a'_in_s], apply contra,  } },
    { rw finset.disjoint_left, intros a' h_a'_in_s,
      rw finset.disjoint_left at T_disj,
      apply T_disj,
      simp [h_a'_in_s] } },
end

/-- This represents a function of a finite number of events in a tabular way. -/
def function_of_events {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α) (F:event P):Prop := ∃ (T:finset (finset α)), T ⊆ S.powerset ∧
  (∃ᵣ s in T,  (∀ᵣ a in s, E a) ∧ (∀ᵣ a in (S \ s), ¬ₑ(E a))) = F

lemma function_of_events_event {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α) (a:α) (h_a:a ∈ S):function_of_events E S (E a) := begin
  classical,
  apply exists.intro (S.powerset.filter (λ s, a ∈ s)),
  split,
  { simp },
  apply event.eq,
  ext1 ω, split; intros h1; simp [h1]; simp at h1,
  { cases h1 with s h1,
    cases h1 with h1 h2, cases h2 with h2 h3,
    apply h2 a h1.right, },
  { apply exists.intro (S.filter (λ a', ω ∈ E a')),
    simp [h_a, h1],split,
    { apply h1 },
    split,
    { intros i h4 h5, apply h5 },
    { intros i h4 h5, apply h5 h4 } },
end

lemma disjoint_union {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α):set.pairwise_on ↑(S.powerset) (λ s t, disjoint
  ((∀ᵣ a in s, E a) ∧ (∀ᵣ a in (S \ s), ¬ₑ(E a))).val
  ((∀ᵣ a in t, E a) ∧ (∀ᵣ a in (S \ t), ¬ₑ(E a))).val) := begin
  classical,
  intros i h_i j h_j h_ne,
  have h_ne_exists:∃ a, ((a ∈ i) ∧ (a ∉ j)) ∨ ((a∉ i) ∧ (a ∈ j)),
  { rw ← not_forall_not, intros contra, apply h_ne,
    ext a, have contra_a := contra a,
    split; intros h_1;
    apply by_contradiction; intros h_2;
    apply contra_a;
    simp [contra_a, h_1, h_2] },
  have h_i_subset_S:i ⊆ S,
  { rw [finset.mem_coe, finset.mem_powerset] at h_i, apply h_i },
  have h_j_subset_S:j ⊆ S,
  { rw [finset.mem_coe, finset.mem_powerset] at h_j, apply h_j },
  rw disjoint_iff,
  simp,
  rw ← set.subset_compl_iff_disjoint,
  rw set.subset_def,
  intros ω h_ω,
  simp at h_ω,
  simp,
  intros h_j,
  cases h_ne_exists with a h_ne_exists,
  cases h_ne_exists with h_a_in_i h_a_in_j,
  { have h_ω_2 := h_ω.left a h_a_in_i.left,
    apply exists.intro a,
    simp [h_ω_2, h_a_in_i],
    apply h_i_subset_S,
    apply h_a_in_i.left  },
  { exfalso, apply h_ω.right a _ h_a_in_j.left,
    apply h_j, apply h_a_in_j.right,
    apply h_j_subset_S,
    apply h_a_in_j.right },
end

lemma disjoint_union_sub {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α) (F:finset (finset α)) (h_sub:F⊆ S.powerset):set.pairwise_on ↑(F) (λ s t, disjoint
  ((∀ᵣ a in s, E a) ∧ (∀ᵣ a in (S \ s), ¬ₑ(E a))).val
  ((∀ᵣ a in t, E a) ∧ (∀ᵣ a in (S \ t), ¬ₑ(E a))).val) := begin
  apply @set.pairwise_on.mono (finset α) (↑S.powerset) ↑F
    (λ (s t : finset α),
       disjoint ((∀ᵣ (a : α) in s,E a)∧∀ᵣ (a : α) in S \ s,¬ₑ E a).val
         ((∀ᵣ (a : α) in t,E a)∧∀ᵣ (a : α) in S \ t,¬ₑ E a).val)
  _ _,
  { simp [h_sub] },
  apply disjoint_union,
end

#print instances has_sdiff

lemma function_of_events_diff {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α) (F G:event P) (h_F:function_of_events E S F)
  (h_G:function_of_events E S G):function_of_events E S (F \ G) := begin
  cases h_F with F_T h_F,
  cases h_G with G_T h_G,
  apply exists.intro (F_T \ G_T),
  split,
  { apply finset.subset.trans, apply finset.sdiff_subset, apply h_F.left },
  rw ← disjoint_exists_diff,
  rw h_F.right,
  rw h_G.right,
  apply disjoint_union_sub,
  apply finset.union_subset,
  apply h_F.left,
  apply h_G.left,
end

@[simp]
lemma function_of_events_univ {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α): (function_of_events E S event_univ) := begin
  classical,
  apply exists.intro (S.powerset),
  split,
  apply finset.subset.refl,
  apply event.eq,
  ext1 ω, split; intros h1; simp at h1, simp,
  apply exists.intro (S.filter (λ a, ω ∈ (E a))),
  split,
  simp,
  split,
  { intros i h_i,
    simp at h_i,
    apply h_i.right },
  { intros i h_1 h_2 h_3, apply h_2,
    simp,
    apply and.intro h_1,
    apply h_3 },
end

lemma function_of_events_compl {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α) (F:event P) (h_F:function_of_events E S F):function_of_events E S (Fᶜ) := begin
  have h1:event_univ \ F = Fᶜ,
  { apply event.eq, ext1 ω, split; intros h1; simp at h1; simp [h1], },
  rw ← h1,
  apply function_of_events_diff,
  simp,
  apply h_F,
end

lemma function_of_events_and {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α) (F G:event P) (h_F:function_of_events E S F)
  (h_G:function_of_events E S G):function_of_events E S (F ∧ G) := begin
  have h1:(F ∧ G) = F \ Gᶜ,
  { apply event.eq, ext1 ω, split; intros h1; simp at h1; simp [h1], },
  rw h1,
  apply function_of_events_diff,
  apply h_F,
  apply function_of_events_compl,
  apply h_G,
end

lemma function_of_events_or {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α) (F G:event P) (h_F:function_of_events E S F)
  (h_G:function_of_events E S G):function_of_events E S (F ∨ G) := begin
  cases h_F with F_T h_F,
  cases h_G with G_T h_G,
  apply exists.intro (F_T ∪ G_T),
  split,
  { apply finset.union_subset; simp [h_F, h_G], },
  rw ← exists_or,
  rw h_F.right,
  rw h_G.right,
end

lemma function_of_events_not {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α) (F:event P) (h_F:function_of_events E S F):function_of_events E S (¬ₑ F) := begin
  have h1:(¬ₑ F) = Fᶜ,
  { apply event.eq, simp },
  rw h1,
  apply function_of_events_compl,
  apply h_F,
end

lemma function_of_events_empty {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α):function_of_events E S ∅ := begin
  have h1:(¬ₑ event_univ) = (∅:event P),
  { apply event.eq, simp },
  rw ← h1,
  apply function_of_events_compl,
  apply function_of_events_univ,
end

lemma function_of_events_forall {α β Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (S:finset α) (T:finset β) (F:β → event P) (h_F:∀ b∈ T, function_of_events E S (F b))
  :function_of_events E S (∀ᵣ b in T, F b) := begin
  classical,
  revert h_F,
  apply finset.induction_on T,
  { intros, simp },
  { intros b T' h_b_notin_T' h2 h3, rw has_eall_in_insert,
    apply function_of_events_and, { apply h3, simp },
    { apply h2, intros b h_b,
      apply h3, simp [h_b] } },
end

lemma function_of_events_ind {α Ω:Type*} {P:probability_space Ω} [decidable_eq α] (E:α → event P)
  (h_ind:independent_events E) (S T:finset α) (F G:event P) (h_disj: disjoint S T)
  (h_F:function_of_events E S F) (h_G:function_of_events E T G):
  independent_event_pair F G :=
begin
  classical,
  have h_disj_diff:∀ (s t:finset α), disjoint (s \ t) t,
  { intros s t, rw finset.disjoint_left,
    intros a h_a, simp at h_a, apply h_a.right },

  have h_disj_subset:∀ (s t:finset α), (s ⊆ S) → (t ⊆ T) → (disjoint s t),
  { intros s t h_s h_t,
    rw finset.disjoint_left,
    rw finset.disjoint_left at h_disj,
    intros a h_a h_a',
    apply h_disj,
    apply h_s h_a,
    apply h_t h_a' },
  cases h_G with T_G h_G,
  have h_subset_T:∀ t ∈ T_G, t ⊆ T,
  { intros t h_t,
    apply finset.mem_powerset.1 (h_G.left h_t) },
  cases h_F with T_F h_F,
  have h_subset_S:∀ s ∈ T_F, s ⊆ S,
  { intros s h_s,
    apply finset.mem_powerset.1 (h_F.left h_s) },
  rw ← h_G.right,
  apply independent_event_pair_exists,
  intros s h_s,
  rw ← h_F.right,
  apply independent_event_pair.symm,
  apply independent_event_pair_exists,
  intros t h_t,
  apply independent_event_pair.symm,
  rw eand_comm,
  rw eand_comm (∀ᵣ (a : α) in s,E a),
  unfold independent_event_pair,
  have h1:∀ (H1 H2 H3 H4:event P), ((H1 ∧ H2) ∧ (H3 ∧ H4)) = ((H1 ∧ H3) ∧ (H2 ∧ H4)),
  { intros H1 H2 H3 H4,
    apply event.eq, ext1 ω, split; intros h1_1; simp at h1_1; simp [h1_1] },
  rw h1,
  rw forall_and,
  rw forall_and,
  rw independent_events_rel,
  rw independent_events_rel,
  rw independent_events_rel,
  rw finset.prod_union,
  rw finset.prod_union,
  have h2:∀ (a b c d:nnreal), a * b * (c * d) = a * c * (b * d),
  { intros a b c d, rw ← nnreal.coe_eq, repeat { rw nnreal.coe_mul },
    linarith },
  rw h2,
  { apply h_disj_subset,
    apply h_subset_S _ h_t,
    apply h_subset_T _ h_s },
  { apply h_disj_subset,
    simp,
    simp },
  apply h_ind,
  { rw finset.disjoint_left,
    intros a h_a, simp at h_a, apply h_a.right },
  apply h_ind,
  { rw finset.disjoint_left,
    intros a h_a, simp at h_a, apply h_a.right },
  apply h_ind,
  { rw finset.disjoint_left,
    intros a h_a h_a',  simp at h_a', simp [h_a'] at h_a,
    cases h_a with h_a h_a; cases h_a' with h_a' h_a',
    { apply h_a.right h_a' },
    { rw finset.disjoint_left at h_disj,
     apply h_disj h_a.left,
     apply h_subset_T s h_s h_a' },
    { rw finset.disjoint_right at h_disj,
      apply h_disj h_a.left,
      apply h_subset_S t h_t h_a' },
    { apply h_a.right h_a' } },
  { apply disjoint_union_sub, apply h_F.left },
  { apply disjoint_union_sub, apply h_G.left },
end