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

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ (i j : ℤ), (i ≠ j) → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by auto [int.fract_eq_iff, hα_irrat],

  -- 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.fract (α * ↑i)) = (int.fract (α * ↑j)) → α ∈ ℚ, from by auto [int.fract_eq_iff, hα_irrat, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int.coe_nat_le_coe_nat_iff, int.coe_nat_lt_coe_nat_iff, int
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  -- If this were not true, then
  -- $$
  -- 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 h1 : ∀ i j : ℤ, (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)) → i ≠ j, from
  begin
    assume (i j : ℤ) (h2 : int.fract (α * ↑i) ≠ int.fract (α * ↑j)),
    assume h3 : i = j,
    have h4 : (α * ↑i) - (int.floor (α * ↑i)) = int.fract (α * ↑i), from by auto [int.fract_eq_of_nonneg, int.fract_nonneg],
    have h5 : (α * ↑j) - (int.floor (α * ↑j)) = int.fract (α * ↑j), from by auto [int.fract_eq_of_nonneg, int.fract_nonneg],
    have h6 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑j) - (int.floor (α * ↑j)), from by auto [h3, h4, h5],
    have h7 : α = (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j), from by auto [mul_sub, sub_eq_iff_eq_add, add_sub_cancel, sub_sub, mul_sub_left_distrib, mul_sub_right_distrib, mul_assoc, mul_comm, sub_mul, sub_sub, sub_eq_add_neg, neg_sub, sub_self, add_zero, mul_zero, div_eq_iff_mul_eq, mul_comm, mul_eq_zero, eq_comm, h6, h2, h3],
    have h8 : (int.floor (α * ↑i) - int.floor (α * ↑j)) / (i - j) ∈ ℚ, from by auto [rat.mk_eq_div, int.cast_coe_nat, int.cast_coe_int, int.cast_coe_nat, int.cast_coe_int, int.cast_coe_nat, int.cast_coe_int],
    have h9 : α ∈ ℚ, from by auto [h7, h8],
    have h10 : irrational α, from hα_irrat,
    show false, from by auto [h10, h9],
  end,
  have h2 : ∀ i j : ℤ, (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)) ↔ i ≠ j, from by auto [h1],
  have h3 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from by auto [h2],
  have h4 : ∀ i : ℤ, (int.fract (α * ↑i)) ∈ set.Icc 0 1, from by auto [int.fract_nonneg, int.fract_lt_one],
  have h5 : ∀ i : ℤ, (int.fract (α * ↑i)) ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by auto [h4],
  have h6 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h7 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h8 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h9 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h10 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h11 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h12 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h13 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h14 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h15 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h16 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h17 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h18 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h19 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h20 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h21 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h22 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h23 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have h24 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h4],
  have
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\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j),
  from by auto [int.fract_eq_iff_eq, hα_irrat, int.fract_mul],

  -- 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 auto [int.fract_nonneg, int.fract_lt_one],
  have h3 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h2],
  have h4 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ≠ ∅, from by auto [set.univ_ne_empty],
  have h5 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [h2],
  have h6 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ≠ ∅, from by auto [set.univ_ne_empty],
  have h7 : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from by auto [closure_eq_of_is_closed, is_closed_Icc, h5, h6],
  show closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from by auto [h7],
end

--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\}$. 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 h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j),
  from by auto [int.fract_eq_iff_of_ne_zero, hα_irrat],

  -- Hence,
  -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  -- is an infinite subset of $\left[0,1\right]$.
  have h2 : (λ m : ℤ, int.fract (α * ↑m)) '' univ ⊆ set.Icc 0 1,
  from by auto [int.fract_nonneg, int.fract_lt_one],

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h3 : ∃ x, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)),
  from by auto [closure_eq_of_is_closed, is_closed_Icc],

  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h4 : ∀ ε > 0, ∃ x y, x ≠ y ∧ x ∈ (λ m : ℤ, int.fract (α * ↑m)) '' univ ∧ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' univ ∧ |x - y| < ε,
  from by auto [h3, closure_eq_of_is_closed, is_closed_Icc],

  -- 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 h5 : ∀ ε > 0, ∃ x, x ∈ (λ m : ℤ, int.fract (α * ↑m)) '' univ ∧ |0 - x| < ε,
  from by auto [h4, abs_of_nonneg, int.fract_nonneg],

  -- 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$.
  have h6 : ∀ y ∈ set.Icc 0 1, ∀ ε > 0, ∃ x, x ∈ (λ m : ℤ, int.fract (α * ↑m)) '' univ ∧ |y - x| < ε,
  from by auto [h5, int.fract_nonneg, int.fract_lt_one, int.fract_add, int.fract_mul],

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

--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. 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 auto [irrational.def, int.fract_eq_iff_of_int_mul_eq_int],

  -- 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) → (∀ (x : ℤ), (int.fract (α * ↑i) = int.fract (α * ↑j)) → (α = (int.fract (α * ↑i) + ↑x) / ↑(i - j) → irrational α)),
  from by auto [irrational.def, int.fract_eq_iff_of_int_mul_eq_int, int.fract_add_int_div],

  -- Hence,
  -- $$
  -- S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
  -- $$
  -- is an infinite subset of $\left[0,1\right]$.
  have h3 : ∃ (x : ℤ), (int.fract (α * ↑x) ∈ ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ))),
  from by auto [int.fract_eq_iff_of_int_mul_eq_int],

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h4 : ∃ (x : ℤ), (int.fract (α * ↑x) ∈ closure ((λ (m : ℤ), int.fract (α * ↑m)) '' (@set.univ ℤ))),
  from by auto [int.fract_eq_iff_of_int_mul_eq_int, closure_eq_nhds_of_is_closed, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_open_Iic, is_closed_Iio, is_open_Iio, is_closed_Iic, is_
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. 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]$.
  have h1 : ∀ i j : ℤ, i ≠ j → (int.fract (α * ↑i)) ≠ (int.fract (α * ↑j)), from
  begin
    assume (i : ℤ) (j : ℤ) (hij : i ≠ j),
    assume h2 : int.fract (α * ↑i) = int.fract (α * ↑j),
    have h3 : α = (((int.fract (α * ↑i)) + (int.floor (α * ↑i))) - ((int.fract (α * ↑j)) + (int.floor (α * ↑j)))) / (i - j),
    from by auto [h2, int.fract_add],
    have h4 : (i - j) ≠ 0, from by auto [hij],
    have h5 : (α * ↑i) - (int.floor (α * ↑i)) = (α * ↑j) - (int.floor (α * ↑j)), from by auto [h3, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, mul_sub, 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!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

/--`theorem`
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 auto [abs_sub_lt_iff] using [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 auto [lt_of_le_of_lt, le_max_left, le_max_right],

  --$\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 auto [h8, h10, h5, h9],

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

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by auto [h5, h15],

end

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

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

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

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


import graph

section
  variable tw : bool
  variable G : graph

  def prism_graph.nodes := bool × G.nodes
  def prism_graph.edges := (bool × G.edges) ⊕ G.nodes

  def prism_graph.srctrg (b : bool) : prism_graph.edges G → prism_graph.nodes G
  | (sum.inl (b', e)) := (b', G.srctrg (bxor (band b' tw) b) e)
  | (sum.inr v)       := (b, v)

  lemma prism_graph.edge_ext :
          ∀ (tw : bool) (G : graph) (e e' : prism_graph.edges G),
            (∀ b, prism_graph.srctrg tw G b e = prism_graph.srctrg tw G b e') →
          e = e'
  | tw G (sum.inl (ff, e)) (sum.inl (ff, e')) p :=
       begin congr, apply G.edge_ext e e',
             cases tw, all_goals { simp [prism_graph.srctrg] at p, assumption,},
       end
  | tw G (sum.inl (ff, e)) (sum.inl (tt, e')) p :=
       begin simp [prism_graph.srctrg] at p, contradiction, end
  | tw G (sum.inl (tt, e)) (sum.inl (ff, e')) p :=
       begin simp [prism_graph.srctrg] at p, contradiction, end
  | tw G (sum.inl (tt, e)) (sum.inl (tt, e')) p :=
       begin
         congr, apply G.edge_ext e e',
         cases tw, { simp [prism_graph.srctrg] at p, assumption,},
         simp [prism_graph.srctrg] at p,
         intro b, cases b, exact p tt, exact p ff,
       end
  | tw G (sum.inl (b, e)) (sum.inr v')        p :=
       begin let pnb := p (not b), cases b,
             all_goals { simp [prism_graph.srctrg] at pnb, contradiction}, end
  | tw G (sum.inr v)      (sum.inl (b', e'))  p :=
       begin let pnb := p (not b'), cases b',
             all_goals { simp [prism_graph.srctrg] at pnb, contradiction}, end
  | tw G (sum.inr v)      (sum.inr v')        p :=
       begin simp [prism_graph.srctrg] at p, congr, assumption, end

  def prism_graph : graph :=
    { nodes    := prism_graph.nodes G
    , edges    := prism_graph.edges G
    , srctrg   := prism_graph.srctrg tw G
    , edge_ext := prism_graph.edge_ext tw G
    }

end

def cube_graph (tw : bool) : ℕ → graph
| 0      := graph.singleton_reflexive
| (n +1) := prism_graph tw (cube_graph n)

section
  variable tw : bool
  variable n : ℕ

  def cube_graph_alt.nodes := bitvec n
  def cube_graph_alt.edges := bitvec n ⊕ (fin n × bitvec (nat.pred n))

  def cube_graph_alt.num_zeros_is_odd :
        Π {n : ℕ} (i : fin (n +1)) (v : bitvec n), bool
  | 0      _ _ := ff
  | (n +1) i v := fin.maybe_pred_rec ff (λ i',
                    bxor (v.head) (cube_graph_alt.num_zeros_is_odd i' v.tail)) i

  def cube_graph_alt.srctrg (b : bool) :
        cube_graph_alt.edges n → cube_graph_alt.nodes n
  | (sum.inl v)      := v
  | (sum.inr (i, v)) := match n, i, v with
                        | 0,      i, v := i.elim0
                        | (_ +1), i, v :=
                            let tw_bit := cube_graph_alt.num_zeros_is_odd i v
                             in vector.insert_nth (bxor (band tw tw_bit) b) i v
                        end

  private lemma cube_graph_alt.edge_ext_helper :
    ∀ (n : ℕ) (i : fin (n +1)) (v : bitvec n) (v' : bitvec (n +1)),
      (∀ b, v.insert_nth b i = v') → false
  | 0       i          v v' p :=
      begin
        replace p := p (bnot v'.head),
        cases i, cases i_val, swap,
        { exact nat.not_succ_le_zero i_val (nat.le_of_lt_succ i_is_lt),},
        rw [fin.to_zero, vector.insert_nth_zero] at p,
        replace p := (vector.cons_injection p).1, simp at p,
        exact bnot_self p,
      end
  | (n +1) ⟨0,    pz⟩  v v' p :=
      begin
        replace p := p (bnot v'.head),
        simp [fin.to_zero, vector.insert_nth_zero] at p,
        replace p := (vector.cons_injection p).1, simp at p,
        exact bnot_self p,
      end
  | (n +1) ⟨i +1, psi⟩ v v' p :=
      begin
        let fin_i := fin.mk_from_succ i psi,
        refine cube_graph_alt.edge_ext_helper n fin_i v.tail v'.tail _,
        intro b, replace p := congr_arg vector.tail (p b),
        rwa [fin.to_succ, vector.insert_nth_succ] at p,
      end

  lemma cube_graph_alt.edge_ext :
          ∀ (tw : bool) (n : ℕ) (e e' : cube_graph_alt.edges n),
            (∀ b, cube_graph_alt.srctrg tw n b e
                = cube_graph_alt.srctrg tw n b e') →
          e = e'
  | tw n      (sum.inl v)                (sum.inl v')                  p :=
      begin simp [cube_graph_alt.srctrg] at p, congr, assumption, end
  | tw (n +1) (sum.inl v)                (sum.inr (i',            v')) p :=
      begin
        exfalso, simp [cube_graph_alt.srctrg] at p,
        refine cube_graph_alt.edge_ext_helper n i' v' v _, intro b, symmetry,
        replace p := p (bxor(band tw (cube_graph_alt.num_zeros_is_odd i' v'))b),
        rwa [bxor_comm, bxor_bxor_id] at p,
      end
  | tw (n +1) (sum.inr (i,           v)) (sum.inl v')                  p :=
      begin
        exfalso, simp [cube_graph_alt.srctrg] at p,
        refine cube_graph_alt.edge_ext_helper n i v v' _, intro b,
        replace p := p (bxor (band tw (cube_graph_alt.num_zeros_is_odd i v)) b),
        rwa [bxor_comm, bxor_bxor_id] at p,
      end
  | tw (n +1) (sum.inr (⟨0,    pi⟩,  v)) (sum.inr (⟨0,     pi'⟩,  v')) p :=
      begin
        simp [cube_graph_alt.srctrg, vector.insert_nth, list.insert_nth] at p,
        congr, exact subtype.eq (p tt).2
      end
  | tw 1      (sum.inr (⟨0,    pz⟩,  v)) (sum.inr (⟨i' +1, psi'⟩, v')) p :=
      begin exfalso, exact nat.not_lt_zero i' (nat.pred_le_pred psi') end
  | tw 1      (sum.inr (⟨i +1, psi⟩, v)) (sum.inr (⟨0,     pz'⟩,  v')) p :=
      begin exfalso, exact nat.not_lt_zero i  (nat.pred_le_pred psi)  end
  | tw 1      (sum.inr (⟨i +1, psi⟩, v)) (sum.inr (⟨i' +1, psi'⟩, v')) p :=
      begin exfalso, exact nat.not_lt_zero i  (nat.pred_le_pred psi)  end
  | tw (n +2) (sum.inr (⟨0,    pz⟩,  v)) (sum.inr (⟨i' +1, psi'⟩, v')) p :=
      begin
        exfalso, replace p := p (bnot v'.head),
        simp [cube_graph_alt.srctrg, fin.to_succ, fin.to_zero] at p,
        rw [vector.insert_nth_succ, vector.insert_nth_zero] at p,
        simp [vector.insert_nth, list.insert_nth] at p,
        replace p := (vector.cons_injection p).1,
        simp [fin.zero, cube_graph_alt.num_zeros_is_odd] at p,
        exact bnot_self p,
      end
  | tw (n +2) (sum.inr (⟨i +1, psi⟩, v)) (sum.inr (⟨0,     pz'⟩,  v')) p :=
      begin
        exfalso, replace p := p (bnot v.head),
        simp [cube_graph_alt.srctrg, fin.to_succ, fin.to_zero] at p,
        rw [vector.insert_nth_succ, vector.insert_nth_zero] at p,
        simp [vector.insert_nth, list.insert_nth] at p,
        replace p := (vector.cons_injection p).1,
        simp [fin.zero, cube_graph_alt.num_zeros_is_odd] at p,
        exact bnot_self (eq.symm p),
      end
  | tw (n +2) (sum.inr (⟨i +1, psi⟩, v)) (sum.inr (⟨i' +1, psi'⟩, v')) p :=
      begin
        let fin_i  := fin.mk_from_succ i  psi,
        let fin_i' := fin.mk_from_succ i' psi',
        simp [fin.to_succ] at p,
        suffices : ∀ b, v.head = v'.head ∧
            cube_graph_alt.srctrg tw (n + 1) b (sum.inr (fin_i,  v.tail)) =
            cube_graph_alt.srctrg tw (n + 1) b (sum.inr (fin_i', v'.tail)),
        { let e_eq := cube_graph_alt.edge_ext tw (n + 1)
                        (sum.inr (fin_i, v.tail)) (sum.inr (fin_i', v'.tail))
                        (λ b, (this b).2),
          injection e_eq with e_eq',
          injection e_eq' with i_i'_fin_eq v_v'_tail_eq,
          congr, {injection i_i'_fin_eq,},
          rw [←v.cons_head_tail, ←v'.cons_head_tail],
          rw [(this tt).1, v_v'_tail_eq],},
        suffices : ∀ (fin_i : fin (n +1)) (v : bitvec (n +1)) (b : bool),
            cube_graph_alt.srctrg tw (n + 2) b
              (sum.inr (fin_i.succ, v)) =
            v.head :: cube_graph_alt.srctrg tw (n + 1) (bxor (band tw v.head) b)
              (sum.inr (fin_i, v.tail)),
        { intro b,
          replace p := p (bxor (band tw v.head) b),
          rw [this, this] at p,
          let p' := vector.cons_injection p, simp at p',
          rw [←p'.1, bxor_bxor_id] at p, rw [←p'.1] at |-,
          exact vector.cons_injection p,},
        clear p fin_i fin_i' psi psi' i i' v v',
        intros fin_i v b,
        simp [cube_graph_alt.srctrg],
        rw ←vector.insert_nth_succ,
        cases tw, {simp,}, simp,
        suffices : cube_graph_alt.num_zeros_is_odd fin_i.succ v
                 = bxor (vector.head v)
                     (cube_graph_alt.num_zeros_is_odd fin_i (vector.tail v)),
          {rw this,},
        rw ←vector.cons_head_tail v,
        cases fin_i with i pi,
        simp [fin.succ, cube_graph_alt.num_zeros_is_odd],
        refl,
      end

  def cube_graph_alt : graph :=
    { nodes    := cube_graph_alt.nodes n
    , edges    := cube_graph_alt.edges n
    , srctrg   := cube_graph_alt.srctrg tw n
    , edge_ext := cube_graph_alt.edge_ext tw n
    }
end

namespace cg_to_cg'
section
  variable tw : bool

  def nodes_map : Π (n : ℕ), (cube_graph tw n).nodes
                           → (cube_graph_alt tw n).nodes
  | 0      _      := vector.nil
  | (n +1) (b, v) := b :: (nodes_map n v)

  def edges_map : Π (n : ℕ), (cube_graph tw n).edges
                           → (cube_graph_alt tw n).edges
  | 0      _                := sum.inl vector.nil
  | (n +1) (sum.inl (b, e)) :=
      match edges_map n e with
      | sum.inl v      := sum.inl (b :: v)
      | sum.inr (i, v) := match n, i, v with
                          | 0,      i, v := i.elim0
                          | (_ +1), i, v := sum.inr (i.succ, b :: v)
                          end
      end
  | (n +1) (sum.inr v)      := sum.inr (fin.zero, nodes_map tw n v)

  lemma srctrg_map (n : ℕ) (b : bool) (e : (cube_graph tw n).edges)
          : nodes_map tw n ((cube_graph tw n).srctrg b e)
          = (cube_graph_alt tw n).srctrg b (edges_map tw n e) :=
    begin
      revert b, induction n with n IH, { intro, refl,}, intro b,
      cases e with be v,
      { cases be with b' e,
        dsimp [cube_graph, prism_graph, prism_graph.srctrg,
               nodes_map, edges_map],
        rw [IH], dsimp [cube_graph_alt],
        cases edges_map tw n e with v iv,
        { dsimp [edges_map._match_1, cube_graph_alt.srctrg], refl,},
        { cases n, { cases iv with i, exact i.elim0,},
          cases iv with i v,
          dsimp [edges_map._match_1, edges_map._match_2, cube_graph_alt.srctrg],
          rw vector.insert_nth_succ,
          cases tw, {simp,}, simp,
          suffices : cube_graph_alt.num_zeros_is_odd i.succ (b' :: v)
                   = bxor b' (cube_graph_alt.num_zeros_is_odd i v), rw this,
          cases i with i_val i_p, cases v with v_l v_p,
          simp [fin.succ, vector.cons, cube_graph_alt.num_zeros_is_odd],
          refl,},},
      { transitivity (b :: nodes_map tw n v), refl,
        have : (edges_map tw (n +1) (sum.inr v)
                 : (cube_graph_alt tw (n +1)).edges)
             = (sum.inr (fin.zero, nodes_map tw n v)), refl, rw this,
        transitivity cube_graph_alt.srctrg tw (n +1) b
                       (sum.inr (fin.zero, nodes_map tw n v)),
        swap, {refl,},
        simp [cube_graph_alt.srctrg], rw [vector.insert_nth_zero], congr,
        induction n with n IH, {simp [cube_graph_alt.num_zeros_is_odd],},
        simp [fin.zero, cube_graph_alt.num_zeros_is_odd],},
    end
end
end cg_to_cg'

def cg_to_cg' (tw : bool) (n : ℕ)
      : graph_cat.hom (cube_graph tw n) (cube_graph_alt tw n) :=
  { nodes_map  := cg_to_cg'.nodes_map tw n
  , edges_map  := cg_to_cg'.edges_map tw n
  , srctrg_map := cg_to_cg'.srctrg_map tw n
  }

namespace cg'_to_cg
section
  variable tw : bool

  def nodes_map : Π (n : ℕ), (cube_graph_alt tw n).nodes
                           → (cube_graph tw n).nodes
  | 0      _ := unit.star
  | (n +1) v := (v.head, nodes_map n v.tail)

  def edges_map : Π (n : ℕ), (cube_graph_alt tw n).edges
                           → (cube_graph tw n).edges
  | 0      _                := unit.star
  | (n +1) (sum.inl v)      := sum.inl (v.head, edges_map n (sum.inl v.tail))
  | (n +1) (sum.inr (i, v)) := fin.maybe_pred_rec (sum.inr (nodes_map tw n v))
      (λ i' : fin n, sum.inl (match n, i', v with
                              | 0,      i', _ := i'.elim0
                              | (_ +1), _,  v := v.head
                              end, edges_map n (sum.inr (i', v.tail)))) i

  lemma srctrg_map : ∀ (n : ℕ) (b : bool) (e : (cube_graph_alt tw n).edges),
          nodes_map tw n ((cube_graph_alt tw n).srctrg b e) =
          (cube_graph tw n).srctrg b (edges_map tw n e)
  | 0      b e                          := rfl
  | (n +1) b (sum.inl v)                :=
      begin
        dsimp [cube_graph_alt, cube_graph_alt.srctrg],
        cases v with b'l p, cases b'l with b' l, {simp at p, contradiction,},
        simp [nodes_map, edges_map, vector.head, vector.tail],
        dunfold cube_graph, dunfold prism_graph, simp [prism_graph.srctrg],
        rw ←srctrg_map, congr,
      end
  | 1      b (sum.inr (i, v)) :=
      begin
        cases i with i_val i_is_lt, cases i_val with i'_val,
        swap, { exfalso,
          exact nat.not_succ_le_zero i'_val (nat.le_of_lt_succ i_is_lt),},
        dsimp [cube_graph_alt, cube_graph_alt.srctrg],
        rw [vector.eq_nil v, fin.to_zero, vector.insert_nth_zero],
        simp [nodes_map, fin.zero, cube_graph_alt.num_zeros_is_odd],
        simp [edges_map, fin.zero],
        dsimp [cube_graph, prism_graph, prism_graph.srctrg, nodes_map], refl,
      end
  | (n +2) b (sum.inr (⟨0,    pz⟩,  v)) :=
      begin
        dsimp [cube_graph_alt, cube_graph_alt.srctrg],
        rw [fin.to_zero, vector.insert_nth_zero],
        simp [nodes_map, fin.zero, cube_graph_alt.num_zeros_is_odd],
        unfold1 edges_map, simp [fin.zero, edges_map._match_1],
        dsimp [cube_graph, prism_graph, prism_graph.srctrg, nodes_map], refl,
      end
  | (n +2) b (sum.inr (⟨i +1, psi⟩, v)) :=
      begin
        dsimp [cube_graph_alt, cube_graph_alt.srctrg],
        rw [fin.to_succ, vector.insert_nth_succ],
        unfold1 nodes_map, simp [vector.head, fin.succ],
        simp [cube_graph_alt.num_zeros_is_odd], symmetry,
        unfold1 edges_map, simp [edges_map._match_1],
        dsimp [cube_graph, prism_graph, prism_graph.srctrg], congr,
        transitivity (cube_graph tw (n +1)).srctrg (bxor (vector.head v && tw) b)
          (edges_map tw (n + 1) (sum.inr (⟨i, _⟩, vector.tail v))), refl,
        rw ←srctrg_map, dsimp [cube_graph_alt, cube_graph_alt.srctrg], simp,
        have : ∀ a b c, bxor (band a b) (band a c) = band a (bxor b c),
        { intros a b c, cases a, refl, simp,}, rw this,
      end
end
end cg'_to_cg

def cg'_to_cg (tw : bool) (n : ℕ)
      : graph_cat.hom (cube_graph_alt tw n) (cube_graph tw n) :=
  { nodes_map  := cg'_to_cg.nodes_map tw n
  , edges_map  := cg'_to_cg.edges_map tw n
  , srctrg_map := cg'_to_cg.srctrg_map tw n
  }

section
  variable tw : bool

  lemma cg_cg'_cg_eq_id.nodes_map_eq :
          ∀ (n : ℕ) (v : (cube_graph tw n).nodes),
            cg'_to_cg.nodes_map tw n (cg_to_cg'.nodes_map tw n v) = v
  | 0      v      := begin cases v, refl end
  | (n +1) (b, v) := begin simp [cg_to_cg'.nodes_map, cg'_to_cg.nodes_map],
                           exact cg_cg'_cg_eq_id.nodes_map_eq n v end

  lemma cg'_cg_cg'_eq_id.nodes_map_eq :
          ∀ (n : ℕ)(v : (cube_graph_alt tw n).nodes),
            cg_to_cg'.nodes_map tw n (cg'_to_cg.nodes_map tw n v) = v
  | 0      v := begin change vector bool 0 at v, rw vector.eq_nil v,
                      simp [cg'_to_cg.nodes_map, cg_to_cg'.nodes_map], end
  | (n +1) v := begin simp [cg'_to_cg.nodes_map, cg_to_cg'.nodes_map],
                      rw cg'_cg_cg'_eq_id.nodes_map_eq, simp, end

  lemma cg_cg'_cg_eq_id.edges_map_eq : ∀ (n : ℕ) (e : (cube_graph tw n).edges),
          cg'_to_cg.edges_map tw n (cg_to_cg'.edges_map tw n e) = e
  | 0      e                := begin cases e, refl end
  | (n +1) (sum.inl (b, e)) :=
       begin
         transitivity sum.inl (b, cg'_to_cg.edges_map tw n
                                    (cg_to_cg'.edges_map tw n e)), swap,
         { congr, exact cg_cg'_cg_eq_id.edges_map_eq n e,},
         set e' := cg_to_cg'.edges_map tw n e with ←e'_prop,
         unfold cg_to_cg'.edges_map,
         rcases cg_to_cg'.edges_map tw n e with ⟨v⟩ | ⟨i, v⟩,
         { intro e'_prop,
           unfold cg_to_cg'.edges_map._match_1, unfold cg'_to_cg.edges_map,
           rw [vector.head_cons, vector.tail_cons], congr, assumption,},
         intro e'_prop, unfold cg_to_cg'.edges_map._match_1,
         cases n with n, {exact i.elim0,}, unfold cg_to_cg'.edges_map._match_2,
         cases i, unfold fin.succ, unfold1 cg'_to_cg.edges_map,
         unfold fin.maybe_pred_rec,
         congr, { unfold cg'_to_cg.edges_map._match_1, simp,}, simpa,
       end
  | (n +1) (sum.inr v)      :=
       begin
         simp [cg_to_cg'.edges_map, cg'_to_cg.edges_map, fin.zero],
         exact cg_cg'_cg_eq_id.nodes_map_eq tw n v,
       end

  lemma cg'_cg_cg'_eq_id.edges_map_eq (n : ℕ) (e : (cube_graph_alt tw n).edges) :
          cg_to_cg'.edges_map tw n (cg'_to_cg.edges_map tw n e) = e :=
    begin
      induction n with n IH,
      { dsimp [cg'_to_cg.edges_map, cg_to_cg'.edges_map],
        rcases e with ⟨⟩ | ⟨i, v⟩, {congr,}, exact i.elim0,},
      rcases e with ⟨v⟩ | ⟨i, v⟩,
      { rcases v with ⟨bl, p⟩, rcases bl with ⟨⟩ | ⟨b, l⟩, {contradiction,},
        dsimp [cg'_to_cg.edges_map, vector.head, vector.tail,
               cg_to_cg'.edges_map],
        rw IH, unfold cg_to_cg'.edges_map._match_1, refl,},
      cases i, rcases i_val with ⟨⟩ | ⟨i'_val⟩,
      { dsimp [cg'_to_cg.edges_map, fin.maybe_pred_rec, cg_to_cg'.edges_map],
        congr, apply cg'_cg_cg'_eq_id.nodes_map_eq,},
      cases n,
      { exfalso, exact nat.not_succ_le_zero i'_val (nat.le_of_lt_succ i_is_lt)},
      rcases v with ⟨bl, p⟩, rcases bl with ⟨⟩ | ⟨b, l⟩, {contradiction,},
      unfold1 cg'_to_cg.edges_map, unfold1 cg'_to_cg.edges_map._match_1,
      unfold1 fin.maybe_pred_rec,
      simp [vector.head, vector.tail, cg_to_cg'.edges_map], rw IH,
      simp [cg_to_cg'.edges_map._match_1, cg_to_cg'.edges_map._match_2],
      split, {refl,}, refl,
    end

  lemma cg_cg'_cg_eq_id (n : ℕ) :
          graph_cat.comp (cg_to_cg' tw n) (cg'_to_cg tw n) =
          graph_cat.id (cube_graph tw n) :=
    graph_cat.hom.eq (funext (cg_cg'_cg_eq_id.nodes_map_eq tw n))
                     (funext (cg_cg'_cg_eq_id.edges_map_eq tw n))

  lemma cg'_cg_cg'_eq_id (n : ℕ) :
          graph_cat.comp (cg'_to_cg tw n) (cg_to_cg' tw n) =
          graph_cat.id (cube_graph_alt tw n) :=
    graph_cat.hom.eq (funext (cg'_cg_cg'_eq_id.nodes_map_eq tw n))
                     (funext (cg'_cg_cg'_eq_id.edges_map_eq tw n))

  def cg_iso_cg' (n : ℕ) :
        graph_cat.iso (cube_graph tw n) (cube_graph_alt tw n) :=
    { dir     := cg_to_cg' tw n
    , inv     := cg'_to_cg tw n
    , dir_inv := cg_cg'_cg_eq_id tw n
    , inv_dir := cg'_cg_cg'_eq_id tw n
    }

  def cube_graph_cat : category :=
    { obj   := ℕ
    , hom   := λ m n, graph_cat.hom (cube_graph tw m) (cube_graph tw n)
    , id    := λ n, graph_cat.id (cube_graph tw n)
    , comp  := λ {n n' n''}, @graph_cat.comp
                   (cube_graph tw n) (cube_graph tw n') (cube_graph tw n'')
    , id_l  := λ {m n}, @graph_cat.id_l (cube_graph tw m) (cube_graph tw n)
    , id_r  := λ {m n}, @graph_cat.id_r (cube_graph tw m) (cube_graph tw n)
    , assoc := λ {n n' n'' n'''}, @graph_cat.assoc (cube_graph tw n)
                   (cube_graph tw n') (cube_graph tw n'') (cube_graph tw n''')
}

end


import data.fin.basic
import data.fintype.basic
import data.list
import ..automata_typeclass

variables {Sigma : Type} [decidable_eq Sigma]

inductive star_lang (P : lang Sigma) : lang Sigma
| empty_star : star_lang []
| extend : ∀ u w, P u → star_lang w
    → star_lang (u ++ w)

def star_ε_nfa {Sigma : Type*} [decidable_eq Sigma] (A : ε_nfa Sigma) : ε_nfa Sigma :=
  {
    Q := A.Q ⊕ fin 2,
    finQ := @sum.fintype A.Q (fin 2) A.finQ (fin.fintype 2),
    decQ := @sum.decidable_eq A.Q A.decQ (fin 2) (fin.decidable_eq 2),
    inits := λ q, q = sum.inr 0,
    decI := begin
      assume a,
      cases a with q z,
      have f : ¬(λ (q : A.Q ⊕ fin 2), q = sum.inr 0) (sum.inl q),
      {
        assume h, cases h,
      },
      exact is_false f,
      unfold_coes, simp at *,
      have t := fin.decidable_eq 2,
      dsimp [decidable_eq] at t,
      dsimp [decidable_rel] at t,
      solve_by_elim,
    end,
    final := λ q, q = sum.inr 1,
    decF := begin
      assume a,
      cases a with q z,
      have f : ¬(λ (q : A.Q ⊕ fin 2), q = sum.inr 1) (sum.inl q),
      {
        assume h, cases h,
      },
      exact is_false f,
      unfold_coes, simp at *,
      have t:= fin.decidable_eq 2,
      dsimp [decidable_eq, decidable_rel] at t,
      solve_by_elim,
    end,
    δ := λ a x b, match a, x, b with
          | (sum.inl a), x, (sum.inl b) := A.δ a x b ∨ A.final a ∧ x = none ∧ A.inits b
          | (sum.inr a), x, (sum.inl b) := x = none ∧ A.inits b ∧ a = 0
          | (sum.inl a), x, (sum.inr b) := x = none ∧ A.final a ∧ b = 1
          | (sum.inr a), x, (sum.inr b) := x = none ∧ a = 0 ∧ b = 1
        end,
    decD := begin
      assume a,
      cases a with ax b, cases ax with a x,
      cases a; cases b; dsimp [sigma.uncurry],
      {
        letI dF := A.decF,
        letI decQ := @sum.decidable_eq A.Q A.decQ (fin 2) (fin.decidable_eq 2),
        letI dI := A.decI,
        letI dD := A.decD,
        unfold_aux,
        cases dD ⟨⟨a, x⟩, b⟩,
        {
          cases dF a with n y,
          {
            have f : ¬(A.δ a x b ∨ A.final a ∧ x = none ∧ A.inits b),
              assume nn, cases nn, dsimp [sigma.uncurry] at h,
              exact h nn,
              exact n (and.elim_left nn),
            exact is_false f,
          },
          {
            have eq := @option.decidable_eq_none Sigma x,
            cases eq,
            have f : ¬(A.δ a x b ∨ A.final a ∧ x = none ∧ A.inits b),
              assume nn, cases nn, dsimp [sigma.uncurry] at h,
              exact h nn, exact eq (and.elim_left $ and.elim_right $ nn),
            exact is_false f,
            cases dI b with n2 y2,
            have f : ¬(A.δ a x b ∨ A.final a ∧ x = none ∧ A.inits b),
              assume nn, cases nn, dsimp [sigma.uncurry] at h,
              exact h nn, exact n2 (and.elim_right $ and.elim_right $ nn),
            exact is_false f,
            have t : (A.δ a x b ∨ A.final a ∧ x = none ∧ A.inits b),
              right, constructor, exact y, constructor, exact eq, exact y2,
            exact is_true t,
          }
        },
        {
          have t : (A.δ a x b ∨ A.final a ∧ x = none ∧ A.inits b),
            left, dsimp [sigma.uncurry] at h, exact h,
          exact is_true t,
        }
      },
      {
        letI dF := A.decF,
        letI decQ := @sum.decidable_eq A.Q A.decQ (fin 2) (fin.decidable_eq 2),
        unfold_aux,
        apply_instance,
      },
      {
        letI dI := A.decI,
        letI decQ := @sum.decidable_eq A.Q A.decQ (fin 2) (fin.decidable_eq 2),
        unfold_aux,
        apply_instance,
      },
      {
        letI decQ := @sum.decidable_eq A.Q A.decQ (fin 2) (fin.decidable_eq 2),
        unfold_aux,
        apply_instance,
      }
    end
  }

def state_lang (A : ε_nfa Sigma) : A.Q → lang Sigma :=
  λ q w, ∃ q' : A.Q, ε_nfa_δ_star A q w q' ∧ A.final q'

def lang1 (A : ε_nfa Sigma) : lang Sigma :=
  λ r , ∃ q : A.Q, A.inits q ∧ state_lang A q r

lemma star_lem : ∀ A : ε_nfa Sigma, ∀ q0 q1 : (star_ε_nfa A).Q, ∀ w : word Sigma,
  ε_nfa_δ_star (star_ε_nfa A) q0 w q1 ∧ (star_ε_nfa A).final q1 →
  (w = [] ∧ (q0 = sum.inr 1 ∨ q0 = sum.inr 0 ∨ ∃ q0' : A.Q, q0 = sum.inl q0' ∧ A.final q0'))
  ∨ (q0 = sum.inr 0 ∧ ∃ v r : word Sigma, w = v ++ r ∧ ε_nfa_lang A v ∧ star_lang (ε_nfa_lang A) r)
  ∨ (∃ q0' : A.Q, q0 = sum.inl q0' ∧ A.final q0' ∧ ∃ v r : word Sigma, w = v ++ r ∧ ε_nfa_lang A v ∧ star_lang (ε_nfa_lang A) r)
  ∨ (∃ q0' : A.Q, q0 = sum.inl q0' ∧ ∃ v r : word Sigma, w = v ++ r ∧ ∃ q1' : A.Q, A.final q1' ∧ ε_nfa_δ_star A q0' v q1' ∧ star_lang (ε_nfa_lang A) r)
:=
begin
  assume A q0 q1 w h,
  cases h with h Afinal,
  induction h,
  case ε_nfa_δ_star.empty : q
  {
    left, simp, left, cases Afinal, refl,
  },
  case ε_nfa_δ_star.step : q00 q11 q22 x w h0 h1 ih
  {
    have ih := ih Afinal,
    cases ih with ih ih,
    {
      cases ih with wnil ih,
      cases ih with tofinal ih,
      {
        simp, right,
        rw wnil at *, rw tofinal at *,
        cases h1; cases q00,
        repeat {
          cases h0 with f _, cases f,
        },
      },
      cases ih with fromstart Afinal,
      {
        cases Afinal,
        rw fromstart at *,
        simp,
        cases q00, repeat {cases h0 with f _, cases f},
      },
      {
        rw wnil, simp,
        right, right,
        cases q00,
        {
          existsi q00, simp,
          existsi [[x], []], simp,
          cases Afinal with q1' Afinal,
          existsi q1',
          constructor, exact (and.elim_right Afinal),
          constructor,
          {
            fconstructor,
            exact q1', rw (and.elim_left Afinal) at h0, cases h0, exact h0, cases (and.elim_left $ and.elim_right $ h0),
            constructor,
          },
          constructor,
        },
        cases q11, cases h0 with f _, cases f,
        cases h0 with f _, cases f,
      }
    },
    cases ih with ih ih,
    {
      simp,
      cases ih with eq ih, cases ih with v ih, cases ih with r ih,
      rw eq at h0, cases q00,
      repeat {cases h0 with f _, cases f,},
    },
    cases ih with ih ih,
    {
      cases ih with q0' ih, cases ih with eq ih,
      cases ih with finalq0' ih, cases ih with v ih,
      cases ih with r ih, cases ih with wvr ih,
      cases ih with ALang starLang, simp,
      rw eq at *,
      right, right,
      cases q00,
      {
        existsi q00, simp,
        existsi [[x], v ++ r],
        rw wvr, constructor, refl,
        cases q11,
        {
          existsi q11,
          injection eq with eq,
          constructor, rw eq, exact finalq0',
          constructor,
          {
            fconstructor,
            exact q11, cases h0, rw eq, exact h0, cases (and.elim_left $ and.elim_right $ h0),
            cases ALang, constructor,
          },
          constructor, exact ALang, exact starLang,
        },
        cases eq,
      },
      cases h0 with f _, cases f,
    },
    {
      cases ih with q0' ih, cases ih with eq ih,
      cases ih with v ih, cases ih with r ih,
      cases ih with wvr ih, cases ih with q1' ih,
      cases ih with finalq1' ih, cases ih with q0'vq1' starLang,
      simp, right, right,
      cases q00,
      {
        existsi q00, simp,
        existsi [(x :: v), r], rw wvr, constructor, refl,
        existsi q1', constructor, exact finalq1',
        constructor,
        {
          cases q11,
          {
            fconstructor,
            exact q11, cases h0, exact h0, cases (and.elim_left $ and.elim_right $ h0),
            injection eq with eq, rw eq, exact q0'vq1',
          },
          cases eq,
        },
        exact starLang,
      },
      cases q11,
      repeat {cases h0 with f _, cases f,},
    }
  },
  case ε_nfa_δ_star.epsilon : q00 q11 q22 w h0 h1 ih
  {
    have ih := ih Afinal,
    cases ih with ih ih,
    {
      cases ih with wnil ih,
      cases ih with tofinal ih,
      {
        left, constructor, exact wnil,
        rw tofinal at *, right,
        cases q00,
        {
          right,
          existsi q00, simp,
          cases h0 with _ h0, exact (and.elim_left h0),
        },
        {
          left,
          cases h0 with _ h0, rw (and.elim_left h0),
        }
      },
      cases ih with fromstart Afinal,
      {
        left, constructor, exact wnil,
        rw fromstart at *,
        cases q00,
        {
          cases h0 with _ h0, right, right,
          existsi q00, constructor, refl, exact (and.elim_left h0),
        },
        {
          cases h0 with _ h0, cases h0 with _ f,
          cases f,
        },
      },
      {
        cases Afinal with q0' Afinal, cases Afinal with eq finalq0',
        rw eq at *, cases q00,
        {
          right, right,
          cases h0,
          {
            right,
            existsi q00, constructor, refl,
            existsi [[], []], constructor, exact wnil,
            existsi q0', constructor, exact finalq0',
            constructor,
            {
              fconstructor,
              exact q0', exact h0, constructor,
            },
            constructor,
          },
          {
            left,
            existsi q00, constructor, refl,
            constructor, exact (and.elim_left h0),
            existsi [[], []], constructor, exact wnil,
            constructor,
            {
              existsi [q0', q0'], constructor, exact (and.elim_right $ and.elim_right $ h0),
              constructor, constructor, exact finalq0',
            },
            constructor,
          }
        },
        {
          cases h0 with _ h0,
          left, constructor, exact wnil,
          right, left, apply congr_arg, exact (and.elim_right h0),
        }
      },
    },
    cases ih with ih ih,
    {
      cases ih with eq ih, cases ih with v ih,
      cases ih with r ih, cases ih with wvr ih,
      cases ih with ALang starLang,
      right,
      cases q00,
      {
        right,
        cases q11,
        {
          cases eq,
        },
        {
          rw eq at h0, cases h0 with _ h0,
          cases (and.elim_right h0),
        }
      },
      {
        cases q11,
        {
          cases eq,
        },
        {
          cases h0 with _ h0, cases h0 with q00eq0 q11eq1,
          left, constructor, apply congr_arg, exact q00eq0,
          existsi [v, r], constructor, exact wvr,
          constructor, exact ALang, exact starLang,
        }
      }
    },
    cases ih with ih ih,
    {
      cases ih with q0' ih, cases ih with eq ih,
      cases ih with finalq0' ih, cases ih with v ih,
      cases ih with r ih, cases ih with wvr ih,
      cases ih with ALang starLang,
      right,
      cases q00,
      {
        rw eq at h0, right,
        cases h0,
        {
          right,
          existsi q00, simp,
          existsi [[], v ++ r], constructor, exact wvr,
          existsi q0', constructor, exact finalq0',
          constructor,
          {
            fconstructor, exact q0',
            exact h0, constructor,
          },
          constructor, exact ALang, exact starLang,
        },
        {
          left,
          cases h0 with finalq00 h0, cases h0 with _ initsq0',
          existsi q00, simp, constructor, exact finalq00,
          existsi [v, r], constructor, exact wvr,
          constructor, exact ALang, exact starLang,
        }
      },
      {
        rw eq at h0, cases h0 with _ h0,
        cases h0 with initsq0' q00eq0,
        left, constructor, apply congr_arg, exact q00eq0,
        existsi [v, r], constructor, exact wvr,
        constructor, exact ALang, exact starLang,
      }
    },
    {
      cases ih with q0' ih, cases ih with eq ih,
      cases ih with v ih, cases ih with r ih,
      cases ih with wvr ih, cases ih with q1' ih,
      cases ih with finalq1' ih, cases ih with q0'vq1' starLang,
      right, rw eq at h0,
      cases q00,
      {
        right,
        cases h0,
        {
          right, existsi q00,
          simp, existsi [v, r],
          constructor, exact wvr,
          existsi q1', constructor, exact finalq1',
          constructor,
          {
            fconstructor,
            exact q0', exact h0, exact q0'vq1',
          },
          exact starLang,
        },
        {
          left, existsi q00,
          simp, constructor, exact (and.elim_left h0),
          existsi [v, r], constructor, exact wvr,
          constructor,
          {
            existsi [q0', q1'],
            constructor, exact (and.elim_right $ and.elim_right $ h0),
            constructor, exact q0'vq1', exact finalq1',
          },
          exact starLang,
        }
      },
      {
        cases h0 with _ h0, cases h0 with initq0' q00eq0,
        left, constructor, apply congr_arg, exact q00eq0,
        existsi [v, r], constructor, exact wvr,
        constructor,
        {
          existsi [q0', q1'], constructor, exact initq0',
          constructor, exact q0'vq1', exact finalq1',
        },
        exact starLang,
      }
    }
  }
end

lemma star_lemᵣ₁ : ∀ A : ε_nfa Sigma, ∀ q1 q2 : A.Q, ∀ u v : word Sigma,
  ε_nfa_δ_star A q1 u q2 ∧ A.final q2 → ε_nfa_lang (star_ε_nfa A) v →
  ε_nfa_δ_star (star_ε_nfa A) (sum.inl q1) (u ++ v) (sum.inr 1) :=
begin
  assume A q1 q2 u v h0 h1,
  cases h0 with q1uq2 finalq2,
  cases h1 with q1' h1, cases h1 with q2' h1,
  cases h1 with init h1, cases h1 with q1'vq2' finalq2',
  cases finalq2',
  cases init,
  induction q1uq2,
  case ε_nfa_δ_star.empty : q
  {
    simp,
    induction q1'vq2',
    case ε_nfa_δ_star.empty ε_nfa_δ_star.empty : q'
    {
      fconstructor, exact (sum.inr 1),
      constructor, refl, simp, exact finalq2,
      cases finalq2', constructor,
    },
    case ε_nfa_δ_star.step : q00 q11 q22 x w h00 h11 ih
    {
      fconstructor, exact q11,
      {
        cases init, cases q11, cases h00 with f _, cases f,
        cases h00 with f _, cases f,
      },
      exact h11,
    },
    case ε_nfa_δ_star.epsilon : q00 q11 q22 w h00 h11 ih
    {
      cases q00,
      {
        cases init,
      },
      {
        cases q11, cases h00 with _ h00, cases h00 with init q00eq0,
        fconstructor, exact (sum.inl q11), right, simp,
        exact (and.intro finalq2 init), exact h11,
        cases h00 with _ h00, cases h00 with q00eq0 q11eq1,
        cases finalq2', rw q11eq1 at *,
        cases h11,
          fconstructor, exact (sum.inr 1), constructor, refl, simp, exact finalq2,
          exact h11,
          cases h11_q1, cases h11_ᾰ with f _, cases f,
          cases h11_ᾰ with f _, cases f,
          cases h11_q1, cases h11_ᾰ with _ f, cases f with _ f, cases f,
          cases h11_ᾰ with _ f, cases f with f _, cases f,
      }
    },
  },
  case ε_nfa_δ_star.step : q00 q11 q22 x w h00 h11 ih
  {
    fconstructor,
    exact (sum.inl q11), left, exact h00,
    apply ih, exact finalq2,
  },
  case ε_nfa_δ_star.epsilon : q00 q11 q22 w h00 h11 ih
  {
    fconstructor,
    exact (sum.inl q11), left, exact h00,
    apply ih, exact finalq2,
  }
end

lemma star_ε_nfa_lang : ∀ A : ε_nfa Sigma, ∀ w : word Sigma,
  ε_nfa_lang (star_ε_nfa A) w ↔ star_lang (ε_nfa_lang A) w :=
begin
  assume A w,
  constructor,
  {
    assume h,
    dsimp [ε_nfa_lang] at h,
    cases h with q0 h, cases h with q1 h,
    cases h with init h, cases h with trans final,
    have g := star_lem A q0 q1 w (and.intro trans final),
    cases g,
    {
      rw (and.elim_left g), constructor,
    },
    cases g,
    {
      cases g with _ g, cases g with v g,
      cases g with r g, cases g with wvr g,
      cases g with ALang starLang, rw wvr,
      constructor, exact ALang, exact starLang,
    },
    cases g,
    {
      cases g with _ g, cases g with _ g,
      cases g with _ g, cases g with v g,
      cases g with r g, cases g with wvr g,
      cases g with ALang starLang, rw wvr,
      constructor, exact ALang, exact starLang,
    },
    {
      cases g with q0' g, cases g with eq g,
      cases init, cases eq,
    }
  },
  {
    assume h,
    --dsimp [ε_nfa_lang],
    induction h,
    case star_lang.empty_star
    {
      dsimp [ε_nfa_lang, star_ε_nfa],
      fconstructor, exact (sum.inr 0),
      fconstructor, exact (sum.inr 1),
      simp, fconstructor,
      exact (sum.inr 1),
      constructor, simp, simp,
      constructor,
    },
    case star_lang.extend : u v h0 h1 ih
    {
      fconstructor, exact (sum.inr 0),
      fconstructor, exact (sum.inr 1),
      constructor, constructor,
      constructor,
      {
        cases h0 with q0 h0, cases h0 with q1 h0,
        cases h0 with initq0 h0, cases h0 with Astar finalq1,
        cases ih with q0' ih, cases ih with q1' ih,
        cases ih with initq0' ih, cases ih with starAstar finalq1',
        fconstructor, exact (sum.inl q0),
        constructor, refl, simp, exact initq0,
        induction Astar,
        case ε_nfa_δ_star.empty : q
        {
          simp, fconstructor,
          exact (sum.inl q), right,
          constructor, exact finalq1, constructor, refl, exact initq0,

          cases initq0', cases finalq1',
          cases starAstar,
          {
            cases starAstar_q1;
            cases starAstar_ᾰ with f _; cases f,
          },
          {
            cases starAstar_q1,
            cases starAstar_ᾰ with _ h, cases h with init _,
            fconstructor, exact sum.inl starAstar_q1, right,
            constructor, exact finalq1, constructor, refl, exact init,
            exact starAstar_ᾰ_1,
            cases starAstar_ᾰ with _ h, cases h with _ h, rw h at *,
            cases starAstar_ᾰ_1,
            {
              fconstructor, exact (sum.inr 1), constructor, refl,
              constructor, exact finalq1, refl,
              exact starAstar_ᾰ_1,
            },
            {
              cases starAstar_ᾰ_1_q1;
              cases starAstar_ᾰ_1_ᾰ with f _; cases f,
            },
            {
              cases starAstar_ᾰ_1_q1, cases starAstar_ᾰ_1_ᾰ with _ f,
              cases f with _ f, cases f,
              cases starAstar_ᾰ_1_ᾰ with _ f,
              cases f with f _, cases f,
            }
          }
        },
        case ε_nfa_δ_star.step : q00 q11 q22 x w h00 h11 ih
        {
          fconstructor, exact (sum.inl q11),
          left, exact h00,
          apply star_lemᵣ₁,
          exact (and.intro h11 finalq1), existsi [q0', q1'],
          constructor, exact initq0',
          constructor, exact starAstar, exact finalq1',
        },
        case ε_nfa_δ_star.epsilon : q00 q11 q22 w h00 h11 ih
        {
          fconstructor, exact (sum.inl q11),
          constructor, exact h00,
          apply star_lemᵣ₁,
          exact (and.intro h11 finalq1), existsi [q0', q1'],
          constructor, exact initq0',
          constructor, exact starAstar, exact finalq1',
        }
      },
      constructor,
    },
  }
end


import algebra.ring.units

/--
Test division of units in a commutative ring.
Used to cause `simp` (i.e. instance resolution) to time out.
-/
example (R : Type*) [comm_ring R] (a b : Rˣ) : a * (b / a) = b :=
by simp
-- Or: `rw mul_div_cancel'_right`


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.nat.cast.basic
import algebra.group.prod

/-!
# The product of two `add_monoid_with_one`s.

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

variables {α β : Type*}

namespace prod
variables [add_monoid_with_one α] [add_monoid_with_one β]

instance : add_monoid_with_one (α × β) :=
{ nat_cast := λ n, (n, n),
  nat_cast_zero := congr_arg2 prod.mk nat.cast_zero nat.cast_zero,
  nat_cast_succ := λ n, congr_arg2 prod.mk (nat.cast_succ _) (nat.cast_succ _),
  .. prod.add_monoid, .. prod.has_one }

@[simp] lemma fst_nat_cast (n : ℕ) : (n : α × β).fst = n :=
by induction n; simp *

@[simp] lemma snd_nat_cast (n : ℕ) : (n : α × β).snd = n :=
by induction n; simp *

end prod