import tactic
import tactic.induction

import .base .bounded .determinacy .induct

noncomputable theory
open_locale classical

def A_trapped_in_for {pw : ℕ} (a : A pw) (d : D) (B : set Point) :=
all_b a d (λ b, b.A ∈ B)

lemma exi_ma_inf_n_of_exi_A {pw : ℕ} {d : D} {s s' : State} {hs}
  (h₁ : ∀ (n : ℕ), ∃ (a : A pw), ((init_game a d s).play n).act)
  (h₂ : s' = apply_D_move s (d.f s hs).m) :
  ∃ (ma : Valid_A_move pw s'.board),
  {n : ℕ | ∃ (a : A pw) hs' hvm, a.f s' hs' hvm = ma ∧
  ((init_game a d s).play n).act}.infinite :=
begin
  fapply exi_set_infinite_of_forall_exi_P_nat, rintro n,
  obtain ⟨a, h₃⟩ := h₁ n, obtain ⟨a₁, h₄⟩ := h₁ 1, have hs' : s'.act,
  { subst h₂, assumption },
  have hvm : A_has_valid_move pw s'.board,
  { rw [play_1, play_move_at_act] at h₄, swap, { assumption },
    have h₅ : play_D_move_at (init_game a₁ d s) hs = init_game a₁ d s',
    { subst h₂, refl },
    rw [h₅, play_A_move_at] at h₄, clear h₅, split_ifs at h₄ with h₅,
    { exact h₅.2 },
    { cases h₄ }},
  exact ⟨a.f s' hs' hvm, a, hs', hvm, rfl, h₃⟩,
end

lemma exi_A_forall_n_play_act_of_swap {pw : ℕ} {d : D} {s : State}
  (h : ∀ (n : ℕ), ∃ (a : A pw), ((init_game a d s).play n).act) :
  ∃ (a : A pw), ∀ (n : ℕ), ((init_game a d s).play n).act :=
begin
  apply @exi_A_wins_of_invariant (λ s, ∀ (n : ℕ), ∃ (a : A pw),
    ((init_game a d s).play n).act); assumption <|> clear h; dsimp,
  { rintro s h₁, specialize h₁ 0, exact h₁.some_spec },
  { rintro s s' hs h₁ h₂, obtain ⟨ma, hma⟩ := exi_ma_inf_n_of_exi_A h₁ h₂,
    use ma, rintro n, obtain ⟨k, h₃, a, hs', hvm, hh, h₄⟩ := exi_ge_of_set_inf hma,
    use a, convert_to ((init_game a d s).play (n + 1)).act,
    { rw [play_add', play_1], congr, symmetry, ext,
      { exact play_move_at_players_eq.1 },
      { exact play_move_at_players_eq.2 },
      { have h₅ := act_of_act_play h₄, rw play_move_at_act h₅,
        have h₆ : play_D_move_at (init_game a d s) h₅ = init_game a d s',
        { ext; try { refl }, exact h₂.symm },
        rw [h₆, play_A_move_at, dif_pos], clear h₆, swap, { exact ⟨hs', hvm⟩ },
        change apply_A_move s' (a.f s' _ _).m = apply_A_move s' ma.m, congr' }},
    exact act_play_le h₃ h₄ },
end

lemma D_wins_n_of_D_hws {pw : ℕ}
  (h : D_hws pw) :
  ∃ (n : ℕ) (d : D), ∀ (a : A pw),
  D_wins_in a d n :=
begin
  contrapose! h, rw forall_swap at h, change ∀ (d : D) (n : ℕ), _ at h,
  simp_rw [D_wins_in, simulate] at h, push_neg at h, rw [D_hws, D_hws_at],
  push_neg, intro d, specialize h d,
  replace h : ∀ (n : ℕ), ∃ (a : A pw), ((init_game a d state₀).play n).act,
  { intro n, specialize h n, cases h with a h, use a, rcases h with ⟨k, h₁, h₂⟩,
    obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le h₁, apply act_play_le h₁ h₂ },
  simp_rw Game.D_wins, push_neg, exact exi_A_forall_n_play_act_of_swap h,
end

lemma A_bounded_n_pw {pw n k : ℕ} {a : A pw} {d : D}
  (h : k ≤ n) :
  (simulate a d k).s.board.A ∈ bounded (n * pw) :=
begin
  induction k with k ih generalizing n,
  { apply nat.zero_le },
  { rw simulate at ih ⊢, rw play_at_succ',
    let g₁ : Game pw := _, change (init_game a d state₀).play k with g₁ at ih ⊢,
    rw Game.play_move, split_ifs with h₁, swap, { exact ih (nat.le_of_succ_le h) },
    rw play_A_move_at, split_ifs with h₂,
    { let s' := (play_D_move_at g₁ h₁).s,
      change (apply_A_move_b s'.board (g₁.a.f _ _ _).m).A ∈ _,
      rw apply_A_move_b, dsimp, generalize_proofs h₃,
      let ma := g₁.a.f s' h₁ h₃, change ma.m ∈ _, have h₄ := ma.h.2.1,
      have h₅ : s'.board.A = g₁.s.board.A := apply_D_move_A_eq,
      rw h₅ at h₄, clear h₅, cases n, { cases h }, rw nat.succ_le_succ_iff at h,
      specialize ih h, change _ ≤ _ at ih, change _ ≤ _, rw nat.succ_mul,
      transitivity dist ma.m g₁.s.board.A + dist g₁.s.board.A center,
      { exact dist_triangle },
      { rw add_comm, exact add_le_add ih h₄ }},
    { have h₃ : (play_D_move_at g₁ h₁).finish.s.board.A = g₁.s.board.A,
      { exact apply_D_move_A_eq },
      rw h₃, exact ih (nat.le_of_succ_le h) }},
end

lemma lem_2_1 {pw : ℕ}
  (h : D_hws pw) :
  ∃ (N : ℕ) (d : D), ∀ (a : A pw),
  A_trapped_in_for a d (bounded N) :=
begin
  obtain ⟨n, d, h₁⟩ := D_wins_n_of_D_hws h,
  use [n * pw, d], intro a, specialize h₁ a, intro k,
  have h₂ := h₁ _ (le_refl _), by_cases h₃ : n ≤ k,
  { have h₄ := h₁ _ h₃, have h₅ := simulate_eq_of_not_act h₄ h₂,
    rw h₅, clear' k h₁ h₂ h₃ h₄ h₅, exact A_bounded_n_pw (le_refl _) },
  { push_neg at h₃, exact A_bounded_n_pw (le_of_lt h₃) },
end


import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open A) (hA2 : is_covering A),
  have h1 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open Cm ∧ is_covering Cm ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (∀ (x : euclidean_space ℝ (fin n)), x ∈ Cm → ∃ (a : euclidean_space ℝ (fin n)), a ∈ A ∧ x ∈ a) ∧ (
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open_cover A),
  have h1 : ∀ m : ℕ, ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) m)) ∧ U ⊆ (⋃ (V : set (euclidean_space ℝ (fin n))) (hV : V ∈ A), V) ∧ (∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ Cm), U ∩ (ball (0 : euclidean_space ℝ (fin n)) m) ≠ ∅), from sorry,
  have h2 : ∀ m : ℕ, ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) m)) ∧ U ⊆ (⋃ (V : set (euclidean_space ℝ (fin n))) (hV : V ∈ A), V), from sorry,
  have h3 : ∀ m : ℕ, ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) m)), from sorry,
  have h4 : ∀ m : ℕ, ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm, from sorry,
  have h5 : ∀ m : ℕ, ∃ (Cm : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) m)), from sorry,
  have h6 : ∀ m : ℕ, ∃ (Cm : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) m)), from sorry,
  have h7 : ∃ (C : set (euclidean_space ℝ (fin n))), is_open_cover C ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h8 : ∃ (C : set (euclidean_space ℝ (fin n))), is_open_cover C ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h9 : ∃ (C : set (euclidean_space ℝ (fin n))), is_open_cover C, from sorry,
  have h10 : ∃ (C : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h11 : ∃ (C : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h12 : ∃ (C : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h13 : ∃ (C : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h14 : ∃ (C : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h15 : ∃ (C : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h16 : ∃ (C : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h17 : ∃ (C : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h18 : ∃ (C : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,
  have h19 : ∃ (C : set (euclidean_space ℝ (fin n))), ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ C → U ⊆ (euclidean_space ℝ (fin n)) \ (closure (ball (0 : euclidean_space ℝ (fin n)) 0)), from sorry,

end --Needs more than 2000 tokens!

--OUTPUT 3
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open_cover A),
  have h1 : ∀ (m : ℕ), is_compact (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h2 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h3 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h4 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h5 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h6 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h7 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h8 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h9 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h10 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h11 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h12 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h13 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h14 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h15 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h16 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h17 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h18 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h19 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))), is_open_cover Cm ∧ is_finite Cm ∧ ∀ (U : set (euclidean_space ℝ (fin n))), U ∈ Cm → U ⊆ (closed_ball (0 : ℝ^(fin n)) m), from sorry,
  have h20 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))),
end --Needs more than 2000 tokens!

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

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

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

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

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

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

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from 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`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import Qq
open Qq Lean Elab Meta Tactic

elab "print_conjs" : tactic => do
  for ldecl in ← getLCtx do
    if let some ty ← checkTypeQ (u := levelOne) ldecl.type q(Prop) then
      if let ~q($p ∧ $q) := ty then
        logInfo m!"left = {p}, right = {q}"

example (h : true ∧ False) : true := by
  print_conjs
  trivial


import data.cpi.transition.basic

namespace cpi
namespace transition

variables {ℍ : Type} {ω : context}
open_locale congruence

open species.equiv

private def no_rename_zero {Γ} {n} {p : upair (fin n)} {q : upair (name Γ)}
  : upair.map name.extend q ≠ upair.map name.zero p
  := upair.rec_on q

    (λ a b eql, begin
      rcases upair.exists_rep p with ⟨ a', b', ⟨ _ ⟩ ⟩,
      rcases quotient.exact eql with ⟨ l, _ ⟩ | ⟨ l, _ ⟩; cases l
    end)
    (λ a b, function.hfunext (by rw upair.mk.comm) (λ a₂ b₂ _, heq.rfl))

private def on_parallel_assoc₁_left {Γ ℓ} {A B C : species ℍ ω Γ} :
  ∀ {α : label ℍ Γ kind.species} {E : species ℍ ω Γ}
  , (A |ₛ B) [ℓ, α]⟶ (production.species E)
  → Σ' E' (eq : production.species (E |ₛ C) ≈ E')
    , (A |ₛ B |ₛ C) [ℓ, α]⟶ E'
| α E (@com₁ _ _ _ _ x y _ _ a b F G _ _ rfl rfl tf tg) :=
  ⟨ _, production.equiv.species (symm (concretion.pseudo_apply.on_parallel₁ _ _ C)),
   com₁ rfl rfl tf (parL_concretion C tg) ⟩
| α E (parL_species C t) :=
  ⟨ _, production.equiv.species parallel_assoc₁, parL_species _ t ⟩
| α E (parR_species _ t) :=
  ⟨ _, production.equiv.species equiv.parallel_assoc₁, parR_species _ (parL_species _ t) ⟩

private def on_parallel_assoc₁ {Γ ℓ} {A B C : species ℍ ω Γ} :
  ∀ {k} {α : label ℍ Γ k} {E : production ℍ ω Γ k}
  , ((A |ₛ B) |ₛ C) [ℓ, α]⟶ E
  → Σ' E' (eq : E ≈ E'), (A |ₛ B |ₛ C) [ℓ, α]⟶ E'
| k α E (@com₁ _ _ _ _ x y _ _ a b _ G _ _ rfl rfl (parL_concretion D tf) tg) :=
  ⟨ _, production.equiv.species (concretion.pseudo_apply.parallel_shift _ B G),
   com₁ rfl rfl tf (parR_concretion _ tg) ⟩
| k α E (@com₁ _ _ _ _ x y _ _ a b _ G _ _ rfl rfl (parR_concretion D tf) tg) :=
  ⟨ _, production.equiv.species (concretion.pseudo_apply.on_parallel₂' A _ G),
   parR_species A (com₁ rfl rfl tf tg) ⟩
| k α E (parL_species _ t) := on_parallel_assoc₁_left t
| k α E (parL_concretion B (parL_concretion C t)) :=
  ⟨ _, production.equiv.concretion concretion.equiv.parallel_assoc₁, parL_concretion _ t ⟩
| k α E (parL_concretion C (parR_concretion D t)) :=
  ⟨ _, production.equiv.concretion concretion.equiv.parallel_assoc₂, parR_concretion _ (parL_concretion _ t) ⟩
| k α E (parR_species D t) :=
  ⟨ _, production.equiv.species equiv.parallel_assoc₁, parR_species A (parR_species B t) ⟩
| k α E (parR_concretion D t) :=
  ⟨ _, production.equiv.concretion concretion.equiv.parallel_assoc₃, parR_concretion A (parR_concretion B t) ⟩

private def on_parallel_symm {Γ ℓ} {A B : species ℍ ω Γ} :
  ∀ {k} {α : label ℍ Γ k} {E : production ℍ ω Γ k}
  , (A |ₛ B) [ℓ, α]⟶ E
  → Σ' E' (eq : E ≈ E'), (B |ₛ A) [ℓ, α]⟶ E'
| ._ ._ ._ (@com₁ _ _ _ _ x y _ _ a b F G _ _ rfl rfl tf tg) := begin
    rw upair.eq a b,
    from ⟨ _, production.equiv.species (concretion.pseudo_apply.symm F G), com₁ rfl rfl tg tf ⟩
  end
| k α ._ (parL_species _ t) := ⟨ _, production.equiv.species parallel_symm, parR_species B t ⟩
| k α ._ (parL_concretion _ t) := ⟨ _, production.equiv.concretion concretion.equiv.parallel_symm, parR_concretion B t ⟩
| k α ._ (parR_species _ t) := ⟨ _, production.equiv.species parallel_symm, parL_species A t ⟩
| k α ._ (parR_concretion _ t) := ⟨ _, production.equiv.concretion (symm concretion.equiv.parallel_symm), parL_concretion A t ⟩

private def on_parallel_assoc₂_species {Γ ℓ} {A B C : species ℍ ω Γ} :
  ∀ {α : label ℍ Γ kind.species} {E : species ℍ ω Γ}
  , (B |ₛ C) [ℓ, α]⟶ (production.species E)
  → Σ' (E' : production ℍ ω Γ kind.species) (eq : production.species (A |ₛ E) ≈ E')
    , ((A |ₛ B) |ₛ C) [ℓ, α]⟶ E'
| α E (parL_species _ t) :=
  ⟨ _, production.equiv.species equiv.parallel_assoc₂, parL_species _ (parR_species _ t) ⟩
| α E (parR_species _ t) :=
  ⟨ _, production.equiv.species equiv.parallel_assoc₂, parR_species _ t ⟩
| α E (com₁ rfl rfl tf tg) :=
  ⟨ _, production.equiv.species (concretion.pseudo_apply.on_parallel₂' A _ _).symm,
   com₁ rfl rfl (parR_concretion _ tf) tg ⟩

private def on_parallel_assoc₂_concretion {Γ ℓ} {A B C : species ℍ ω Γ} {b y} :
  ∀ {α : label ℍ Γ kind.concretion} {E : concretion ℍ ω Γ b y}
  , (B |ₛ C) [ℓ, α]⟶ (production.concretion E)
  → Σ' (E' : production ℍ ω Γ kind.concretion) (eq : production.concretion (A |₂ E) ≈ E')
    , ((A |ₛ B) |ₛ C) [ℓ, α]⟶ E'
| α E (parL_concretion _ t) :=
  ⟨ _, production.equiv.concretion concretion.equiv.parallel_assoc₂.symm
   , parL_concretion _ (parR_concretion _ t) ⟩
| α E (parR_concretion _ t) :=
  ⟨ _, production.equiv.concretion concretion.equiv.parallel_assoc₃.symm, parR_concretion _ t ⟩

private def on_parallel_assoc₂ {Γ ℓ} {A B C : species ℍ ω Γ} :
  ∀ {k} {α : label ℍ Γ k} {E : production ℍ ω Γ k}
  , (A |ₛ B |ₛ C) [ℓ, α]⟶ E
  → Σ' E' (eq : E ≈ E'), ((A |ₛ B) |ₛ C) [ℓ, α]⟶ E'
| ._ α E (@com₁ _ _ _ _ x y _ _ a b F G _ _ rfl rfl tf (parL_concretion _ tg)) :=
  ⟨ _, production.equiv.species (concretion.pseudo_apply.on_parallel₁ F _ C),
   parL_species _ (com₁ rfl rfl tf tg) ⟩
| ._ α E (@com₁ _ _ _ _ x y _ _ a b F G _ _ rfl rfl tf (parR_concretion _ tg)) :=
  ⟨ _, production.equiv.species (concretion.pseudo_apply.parallel_shift F B _).symm,
    com₁ rfl rfl (parL_concretion _ tf) tg ⟩
| k α ._ (parL_species _ t) :=
  ⟨ _, production.equiv.species equiv.parallel_assoc₂, parL_species _ (parL_species _ t) ⟩
| k α ._ (parL_concretion _ t) :=
  ⟨ _, production.equiv.concretion concretion.equiv.parallel_assoc₁.symm, parL_concretion _ (parL_concretion _ t) ⟩
| k α ._ (parR_species _ t) := on_parallel_assoc₂_species t
| k α ._ (parR_concretion _ t) := on_parallel_assoc₂_concretion t

private def on_choice_swap {Γ ℓ} {As : choices ℍ ω Γ} :
  ∀ {k f g} {α : label ℍ Γ k}
    {π₁ : prefix_expr ℍ Γ f} {π₂ : prefix_expr ℍ Γ g}
    {A : species ℍ ω (f.apply Γ)} {B : species ℍ ω (g.apply Γ)}
    {E : production ℍ ω Γ k}
  , (Σ# whole.cons π₁ A (whole.cons π₂ B As)) [ℓ, α]⟶ E
  → Σ' E' (eq : E ≈ E')
    , (Σ# whole.cons π₂ B (whole.cons π₁ A As)) [ℓ, α]⟶ E'
| ._ α f g π₁ π₂ A B E (choice₁ a b b_len y _ _) := ⟨ _, refl _, ξ_choice (choice₁ a b b_len y _ _) ⟩
| ._ α f g π₁ π₂ A B E (choice₂ k _ _) := ⟨ _, refl _, ξ_choice (choice₂ k _ _) ⟩
| ._ α f g π₁ π₂ A B E (ξ_choice (choice₁ a b b_len y _ _)) := ⟨ _, refl _, choice₁ a b b_len y _ _ ⟩
| ._ α f g π₁ π₂ A B E (ξ_choice (choice₂ k _ _)) := ⟨ _, refl _, choice₂ k _ _ ⟩
| k α f g π₁ π₂ A B E (ξ_choice (ξ_choice t)) := ⟨ _, refl _, ξ_choice (ξ_choice t) ⟩

private def on_ν_parallel₂ {Γ ℓ} {M : affinity ℍ} {A : species ℍ ω Γ} {B : species ℍ ω (context.extend (M.arity) Γ)} :
  ∀ {k} {α : label ℍ Γ k} {E : production ℍ ω Γ k}
  , (A |ₛ ν(M) B) [ℓ, α]⟶ E
  → Σ' E' (eq : E ≈ E'), (ν(M) rename name.extend A |ₛ B) [ℓ, α]⟶ E'
| ._ ._ _ (com₁ rfl rfl tf (ν₁_concretion M rfl tg)) :=
  -- Slighty bizzare, but the separate binding helps this to TC
  let tf' := transition.rename (@name.extend _ M.arity) tf in
  ⟨ _, production.equiv.species (concretion.pseudo_apply.on_restriction _ _ _),
    ν₁_species M rfl (com₁ rfl rfl tf' tg) ⟩
| k α _ (parL_species E t) :=
  let t' := transition.rename (@name.extend _ M.arity) t in
  ⟨ _, production.equiv.species (ν_parallel₂ M), ν₁_species M rfl (parL_species _ t' ) ⟩
| k α _ (parL_concretion E t) :=
  let t' := transition.rename (@name.extend _ M.arity) t in
  ⟨ _, production.equiv.concretion (concretion.equiv.ν_parallel₂ M).symm,
   ν₁_concretion M rfl (parL_concretion _ t' ) ⟩

| k α _ (parR_species A (com₂ M k' ek rfl t)) :=
  ⟨ _, production.equiv.species (ν_parallel₂ M), com₂ M k' ek rfl (parR_species _ t) ⟩
| k α _ (parR_species A (ν₁_species _ rfl t)) :=
  ⟨ _, production.equiv.species (ν_parallel₂ M), ν₁_species M rfl (parR_species _ t) ⟩
| k α _ (parR_concretion A (ν₁_concretion _ rfl t)) :=
  ⟨ _, production.equiv.concretion (concretion.equiv.ν_parallel₁ M).symm,
    ν₁_concretion M rfl (parR_concretion _ t) ⟩

private def upair_extend {n} {Γ} :
  ∀ {p : upair (name Γ)} {a b : name (context.extend n Γ)}
  , upair.map name.extend p = upair.mk a b
  → Σ' (a' b' : name Γ), p = upair.mk a' b' ∧ a = name.extend a' ∧ b = name.extend b'
| p (name.zero _) (name.zero _) e := false.elim (begin
  rcases quot.exists_rep p with ⟨ ⟨ a, b ⟩, ep ⟩, have : upair.mk a b = p := ep, subst this,
  rcases quotient.exact e with ⟨ l, r ⟩ | ⟨ l, r ⟩; contradiction,
end)
| p (name.zero _) (name.extend _) e := false.elim (begin
  rcases quot.exists_rep p with ⟨ ⟨ a, b ⟩, ep ⟩, have : upair.mk a b = p := ep, subst this,
  rcases quotient.exact e with ⟨ l, r ⟩ | ⟨ l, r ⟩; contradiction,
end)
| p (name.extend _) (name.zero _) e := false.elim (begin
  rcases quot.exists_rep p with ⟨ ⟨ a, b ⟩, ep ⟩, have : upair.mk a b = p := ep, subst this,
  rcases quotient.exact e with ⟨ l, r ⟩ | ⟨ l, r ⟩; contradiction,
end)
| p (name.extend a) (name.extend b) e := ⟨ a, b, begin
  have : upair.map name.extend p = upair.map name.extend (upair.mk a b) := e,
  from ⟨ upair.map.inj (@name.extend.inj _ _) this, rfl, rfl ⟩,
end ⟩

private noncomputable def on_ν_parallel₁_species {Γ ℓ} {M : affinity ℍ} {A : species ℍ ω Γ}
  {B : species ℍ ω (context.extend M.arity Γ)} :
  ∀ {A' : species ℍ ω (context.extend (M.arity) Γ)}
    {α' : label ℍ (context.extend M.arity Γ) kind.species}
    {α : label ℍ Γ kind.species}
    {E : species ℍ ω (context.extend M.arity Γ)}
  , (A' |ₛ B) [lookup.rename name.extend ℓ, α']⟶ (production.species E)
  → A' = rename name.extend A → α' = label.rename name.extend α
  → Σ' E' (eq : production.species (ν(M)E) ≈ E')
    , (A |ₛ ν(M) B) [ℓ, α]⟶ E'
| A' α' α E (parL_species _ t) eqA eqα := begin
  subst eqA, subst eqα,
  rcases transition.rename_from name.extend t with ⟨ α₂, ⟨ B ⟩, t₂, eα, eB ⟩,
  cases label.rename.inj (@name.extend.inj _ _) eα,
  rw ← production.species.inj eB,
  from ⟨ _, production.equiv.species (ν_parallel₁ M), parL_species _ t₂ ⟩,
end
| A' α' α E (parR_species _ t) eqA eqα := begin
  subst eqA, subst eqα,
  from ⟨ _, production.equiv.species (ν_parallel₁ M), parR_species _ (ν₁_species M rfl t) ⟩,
end
| A' α' α E (@com₁ _ _ _ _ x y _ _ a b F G _ _ rfl eα tf tg) eqA eqα := begin
  subst eqA, subst eqα,

  cases α with _ _ _ _ _ p,
  case label.spontaneous { cases eα },

  rcases upair_extend (label.of_affinity.inj eα) with ⟨ a, b, ⟨ _ ⟩, ⟨ _ ⟩, ⟨ _ ⟩ ⟩,
  rcases transition.rename_from name.extend tf with ⟨ ⟨ a₂ ⟩, ⟨ F ⟩, tf₂, ⟨ _ ⟩, ⟨ _ ⟩ ⟩,

  from ⟨ _, production.equiv.species (concretion.pseudo_apply.on_restriction _ M _).symm,
    com₁ rfl rfl tf₂ (ν₁_concretion M rfl tg) ⟩,
end

private noncomputable def on_ν_parallel₁_concretion {Γ ℓ} {M : affinity ℍ} {A : species ℍ ω Γ}
  {B : species ℍ ω (context.extend M.arity Γ)} {b y} :
  ∀ {A' : species ℍ ω (context.extend (M.arity) Γ)}
    {α' : label ℍ (context.extend M.arity Γ) kind.concretion}
    {α : label ℍ Γ kind.concretion}
    {E : concretion ℍ ω (context.extend M.arity Γ) b y}
  , (A' |ₛ B) [lookup.rename name.extend ℓ, α']⟶ (production.concretion E)
  → A' = rename name.extend A → α' = label.rename name.extend α
  → Σ' E' (eq : production.concretion (ν'(M)E) ≈ E')
    , (A |ₛ ν(M) B) [ℓ, α]⟶ E'
| A' α' α E (parL_concretion _ t) eqA eqα := begin
  subst eqA, subst eqα,
  rcases transition.rename_from name.extend t with ⟨ α₂, ⟨ B ⟩, t₂, eα, ⟨ _ ⟩ ⟩,
  cases label.rename.inj (@name.extend.inj _ _) eα,
  from ⟨ _, production.equiv.concretion (concretion.equiv.ν_parallel₂ M), parL_concretion _ t₂ ⟩,
end
| A' α' α E (parR_concretion _ t) eqA eqα := begin
  subst eqA, subst eqα,
  from ⟨ _, production.equiv.concretion (concretion.equiv.ν_parallel₁ M), parR_concretion _ (ν₁_concretion M rfl t) ⟩,
end

private noncomputable def on_ν_parallel₁ {Γ ℓ} {M : affinity ℍ} {A : species ℍ ω Γ}
  {B : species ℍ ω (context.extend (M.arity) Γ)} :
  ∀ {k} {α : label ℍ Γ k} {E : production ℍ ω Γ k}
  , (ν(M) rename name.extend A |ₛ B) [ℓ, α]⟶ E
  → Σ' E' (eq : E ≈ E'), (A |ₛ ν(M) B) [ℓ, α]⟶ E'
| k α ._ (ν₁_species M rfl t) := on_ν_parallel₁_species t rfl rfl
| k α ._ (ν₁_concretion M rfl t) := on_ν_parallel₁_concretion t rfl rfl
| ._ α ._ (@com₂ _ _ _ _ M p q _ _ k ek rfl t) := begin
  generalize eqA : species.rename (@name.extend _ M.arity) A = A', rw eqA at t,

  cases t,
  case parL_species : E t {
    subst eqA, exfalso,
    rcases transition.rename_from name.extend t with ⟨ α₂, ⟨ E ⟩, tf₂, eα, eE ⟩, -- Annoying!

    cases α₂; simp only [label.rename] at eα,
    case label.spontaneous { cases eα },
    from absurd eα no_rename_zero,
  },
  case parR_species : E t {
    subst eqA,
    from ⟨ _, production.equiv.species (ν_parallel₁ M), parR_species _ (com₂ M k ek rfl t ) ⟩,
  },
  case com₁ : x y a b F G eF eα tf tg {
    subst eqA, exfalso,

    rcases transition.rename_from name.extend tf with ⟨ α₂, ⟨ E ⟩, tf₂, eα', eE ⟩, -- Annoying!
    cases α₂, simp only [label.rename] at eα', subst eα',

    rcases upair.exists_rep p with ⟨ p₁, p₂, h ⟩, subst h,
    rcases quotient.exact (label.of_affinity.inj eα) with ⟨ l, r ⟩ | ⟨ l, r ⟩; contradiction,
  }
end

private noncomputable def on_ν_drop₁ {Γ ℓ} {M : affinity ℍ} {A : species ℍ ω Γ} :
  ∀ {k} {α : label ℍ Γ k} {E : production ℍ ω Γ k}
  , (ν(M) species.rename name.extend A) [ℓ, α]⟶ E
  → Σ' (E' : production ℍ ω Γ k) (eq : E ≈ E'), A [ℓ, α]⟶ E'
| k α E t := begin
  generalize eqA : species.rename (@name.extend _ M.arity) A = A', rw eqA at t,

  cases t,
  case com₂ : a b B k eqk eqα t' {
    subst eqA, subst eqα, exfalso,

    rcases transition.rename_from name.extend t' with ⟨ α₂, ⟨ E₂ ⟩ , t₂, eqα, eqE ⟩,
    cases α₂; simp only [label.rename] at eqα,
    case label.spontaneous { cases eqα },
    from absurd eqα no_rename_zero,
  },
  case ν₁_species : α₁ α₂ E eα t' {
    subst eqA, subst eα,
    rcases transition.rename_from name.extend t' with ⟨ α₂, ⟨ E₂ ⟩ , t₂, eqα, eqE ⟩,
    cases label.rename.inj (@name.extend.inj _ _) eqα,
    rw ← production.species.inj eqE,
    from ⟨ _, production.equiv.species (ν_drop₁ M), t₂ ⟩,
  },
  case ν₁_concretion : α₁ α₂ b y E eα t' {
    subst eqA, subst eα,
    rcases transition.rename_from name.extend t' with ⟨ α₂, ⟨ E₂ ⟩ , t₂, eqα, ⟨ _ ⟩ ⟩,
    cases label.rename.inj (@name.extend.inj _ _) eqα,
    from ⟨ _, production.equiv.concretion (concretion.equiv.ν_drop M), t₂ ⟩,
  }
end

private def on_ν_drop₂ {Γ ℓ} {M : affinity ℍ} {A : species ℍ ω Γ} :
  ∀ {k} {α : label ℍ Γ k} {E : production ℍ ω Γ k}
  , A [ℓ, α]⟶ E
  → Σ' (E' : production ℍ ω Γ k) (eq : E ≈ E'), (ν(M) species.rename name.extend A) [ℓ, α]⟶ E'
| k α (production.species E) t :=
  let t' := transition.rename (@name.extend _ M.arity) t in
  ⟨ _, production.equiv.species (ν_drop₂ M), ν₁_species M rfl t' ⟩
| k α (production.concretion E) t :=
  let t' := transition.rename (@name.extend _ M.arity) t in
  ⟨ _, production.equiv.concretion (concretion.equiv.ν_drop M).symm, ν₁_concretion M rfl t' ⟩

private def on_ν_swap₁ {Γ ℓ} {M N : affinity ℍ} {A : species ℍ ω (context.extend (N.arity) (context.extend (M.arity) Γ))} :
  ∀ {k} {α : label ℍ Γ k} {E : production ℍ ω Γ k}
    , (ν(M) ν(N) A) [ℓ, α]⟶ E
    → Σ' (E' : production ℍ ω Γ k) (eq : E ≈ E')
      , (ν(N) ν(M) species.rename name.swap A) [ℓ, α]⟶ E'
| ._ α E₁ (ν₁_species _ eα₁ (ν₁_species _ eα₂ t)) := begin
  subst eα₁, subst eα₂,
  have t' := transition.rename name.swap t,
  rw [label.rename_compose, label.rename_compose, name.swap_comp_extend, name.ext_extend, ← label.rename_compose] at t',
  rw [lookup.rename_compose, lookup.rename_compose, name.swap_comp_extend, name.ext_extend, ← lookup.rename_compose] at t',
  from ⟨ _, production.equiv.species (ν_swap₁ M N), ν₁_species N rfl (ν₁_species M rfl t' ) ⟩,
end
| ._ α E₁ (ν₁_species _ eα (com₂ _ k ek rfl t)) := begin
  cases α; simp only [label.rename] at eα,
  case label.of_affinity { contradiction },
  subst eα,

  have t' := transition.rename name.swap t,
  rw [lookup.rename_compose, lookup.rename_compose, name.swap_comp_extend, name.ext_extend, ← lookup.rename_compose] at t',
  refine ⟨ _, production.equiv.species (ν_swap₁ M N), com₂ N k ek rfl (ν₁_species M _ t') ⟩,

  simp only [label.rename, upair.map_compose, function.comp, name.swap],
end
| ._ α E₁ (ν₁_concretion _ rfl (ν₁_concretion _ rfl t)) := begin
  have t' := transition.rename name.swap t,
  rw [label.rename_compose, label.rename_compose, name.swap_comp_extend, name.ext_extend, ← label.rename_compose] at t',
  rw [lookup.rename_compose, lookup.rename_compose, name.swap_comp_extend, name.ext_extend, ← lookup.rename_compose] at t',
  from ⟨ _, production.equiv.concretion (concretion.equiv.ν_swap M N), ν₁_concretion N rfl (ν₁_concretion M rfl t' ) ⟩,
end
| ._ α E₁ (com₂ _ k ek rfl (ν₁_species _ rfl t)) := begin
  have t' := transition.rename name.swap t,
  rw [lookup.rename_compose, lookup.rename_compose, name.swap_comp_extend, name.ext_extend, ← lookup.rename_compose] at t',
  refine ⟨ _, production.equiv.species (ν_swap₁ M N), ν₁_species N rfl (com₂ M k ek _ t') ⟩,

  rw [upair.map_compose, upair.map_compose, name.swap_comp_extend, name.ext_zero],
end

private def on_ν_swap₂ {Γ ℓ} {M N : affinity ℍ} {A : species ℍ ω (context.extend (N.arity) (context.extend (M.arity) Γ))}:
  ∀ {k} {α : label ℍ Γ k} {E : production ℍ ω Γ k}
  , (ν(N) ν(M) species.rename name.swap A) [ℓ, α]⟶ E
  → Σ' (E' : production ℍ ω Γ k) (eq : E ≈ E'), (ν(M) ν(N) A) [ℓ, α]⟶ E'
| k α E₁ t := begin
  rcases on_ν_swap₁ t with ⟨ E', eqE, t' ⟩,
  rw [species.rename_compose, name.swap_swap, species.rename_id] at t',
  from ⟨ E', eqE, t' ⟩,
end

/-- Convert a transition from one species to a transition from another
    equivalent species, with the same label and equivalent production. -/
noncomputable def equivalent_of :
  ∀ {Γ ℓ k} {A : species ℍ ω Γ} {B : species ℍ ω Γ} {α : label ℍ Γ k} {E : production ℍ ω Γ k}
  , species.equivalent A B → A [ℓ, α]⟶ E
  → Σ' (E' : production ℍ ω Γ k) (eq : E ≈ E'), B [ℓ, α]⟶ E'
| Γ₁ ℓ₁ k₁ A₁ B₁ α₁ E₁ equ t₁ := begin
  induction equ generalizing k₁,

  case species.equivalent.refl { from ⟨ E₁, refl _, t₁ ⟩ },
  case species.equivalent.trans : Γ A B C ab bc ih_ab ih_bc {
    rcases ih_ab _ _ α₁ E₁ t₁ with ⟨ E₂, eq₂, t₂ ⟩,
    rcases ih_bc _ _ α₁ E₂ t₂ with ⟨ E₃, eq₃, t₃ ⟩,
    from ⟨ E₃, trans eq₂ eq₃, t₃ ⟩
  },

  case species.equivalent.ξ_parallel₁ : Γ A A' B eq ih {
    cases t₁,
    case com₁ : x y a b F G E' α' eE eα tf tg {
      subst eE, subst eα,
      rcases ih _ _ (#a) _ tf with ⟨ F', equ, tf' ⟩, cases F' with _ b y' F',
      rcases production.equiv.arity equ with ⟨ ⟨ _ ⟩, ⟨ _ ⟩ ⟩,

      from ⟨ _, production.equiv.species (concretion.pseudo_apply.equiv (production.equiv.unwrap_c equ) (refl G)),
             com₁ rfl rfl tf' tg ⟩,
    },
    case parL_species : α' E t {
      rcases ih _ _ _ _ t with ⟨ E', equ, t' ⟩, cases E',
      from ⟨ _, production.equiv.species (ξ_parallel₁ (production.equiv.unwrap_s equ)), parL_species B t' ⟩
    },
    case parL_concretion : α' b y E t {
      rcases ih _ _ _ _ t with ⟨ E', equ, t' ⟩, cases E',
      rcases production.equiv.arity equ with ⟨ ⟨ _ ⟩, ⟨ _ ⟩ ⟩,
      from ⟨ _, production.equiv.concretion (concretion.equiv.ξ_parallel₁ (production.equiv.unwrap_c equ)),
        parL_concretion _ t' ⟩,
    },
    case parR_species : α' E t {
      from ⟨ _, production.equiv.species (ξ_parallel₁ ⟨ eq ⟩), parR_species _ t ⟩,
    },
    case parR_concretion : α' b y E t {
      from ⟨ _, production.equiv.concretion (concretion.equiv.ξ_parallel' ⟨ eq ⟩), parR_concretion _ t ⟩,
    },
  },

  case species.equivalent.ξ_parallel₂ : Γ A B B' eq ih {
    cases t₁,
    case com₁ : x y a b F G E' α' eE eα tf tg {
      subst eE, subst eα,
      rcases ih _ _ (#b) _ tg with ⟨ G', equ, tg' ⟩, cases G' with _ b y' G',
      rcases production.equiv.arity equ with ⟨ ⟨ _ ⟩, ⟨ _ ⟩ ⟩,
      from ⟨ _, production.equiv.species (concretion.pseudo_apply.equiv (refl F) (production.equiv.unwrap_c equ)),
             com₁ rfl rfl tf tg' ⟩,
    },
    case parL_species : α' E t {
      from ⟨ _, production.equiv.species (ξ_parallel₂ ⟨ eq ⟩), parL_species _ t ⟩,
    },
    case parL_concretion : α' b y E t {
      from ⟨ _, production.equiv.concretion (concretion.equiv.ξ_parallel ⟨ eq ⟩), parL_concretion _ t ⟩,
    },
    case parR_species : α' E t {
      rcases ih _ _ _ _ t with ⟨ E', equ, t' ⟩, cases E',
      from ⟨ _, production.equiv.species (ξ_parallel₂ (production.equiv.unwrap_s equ)), parR_species _ t' ⟩
    },
    case parR_concretion : α' b y E t {
      rcases ih _ _ _ _ t with ⟨ E', equ, t' ⟩, cases E',
      rcases production.equiv.arity equ with ⟨ ⟨ _ ⟩, ⟨ _ ⟩ ⟩,
      from ⟨ _, production.equiv.concretion (concretion.equiv.ξ_parallel₂ (production.equiv.unwrap_c equ)),
        parR_concretion _ t' ⟩,
    },
  },

  case species.equivalent.ξ_restriction : Γ M A A' eq ih {
    cases t₁,

    case com₂ : p p' B k ek ep t {
      rcases ih _ _ _ _ t with ⟨ E', equ, t' ⟩,
      cases E' with B',

      from ⟨ _, production.equiv.species (ξ_restriction M (production.equiv.unwrap_s equ)), com₂ M k ek ep t' ⟩,
    },
    case ν₁_species : α α' E eα t {
      rcases ih _ _ _ _ t with ⟨ E', equ, t' ⟩, cases E',
      from ⟨ _, production.equiv.species (ξ_restriction M (production.equiv.unwrap_s equ)),
        ν₁_species M eα t' ⟩,
    },
    case ν₁_concretion : α α' b y E eα t {
      rcases ih _ _ _ _ t with ⟨ E', equ, t' ⟩, cases E',
      rcases production.equiv.arity equ with ⟨ ⟨ _ ⟩, ⟨ _ ⟩ ⟩,
      from ⟨ _, production.equiv.concretion (concretion.equiv.ξ_restriction M (production.equiv.unwrap_c equ)),
        ν₁_concretion M eα t' ⟩,
    },
  },

  case species.equivalent.ξ_choice_here : Γ f π A A' As eq ih {
    cases t₁,
    case ξ_choice : t { refine ⟨ _, refl _, ξ_choice t ⟩ },
    case choice₁ : a n b b_len y {
      from ⟨ _, production.equiv.concretion (concretion.equiv.ξ_apply ⟨ eq ⟩), choice₁ a b b_len y A' As ⟩,
    },
    case choice₂ : k { from ⟨ _, production.equiv.species ⟨ eq ⟩, choice₂ k A' As ⟩ },
  },

  case species.equivalent.ξ_choice_there : Γ f π A As As' eq ih {
    cases t₁,

    case ξ_choice : t {
      rcases ih _ _ α₁ E₁ t with ⟨ E', equ, t' ⟩,
      refine ⟨ _, equ, ξ_choice t' ⟩,
    },
    case choice₁ : a n b b_len y A As { from ⟨ _, refl _, choice₁ a b b_len y A As' ⟩ },
    case choice₂ : k A As { from ⟨ _, refl _, choice₂ k A As' ⟩ },
  },

  case species.equivalent.parallel_nil₁ : Γ A {
    cases t₁,

    -- No such transition for (nil ⟶ _)
    case com₁ : x y a b F G FG α eFG eα tf tg { cases tg },
    case parR_species : α E t { cases t },
    case parR_concretion : α b y E t { cases t },
    case parL_species : α E t { from ⟨ _, production.equiv.species parallel_nil₁, t ⟩ },
    case parL_concretion : α b y E t { from ⟨ _, production.equiv.concretion concretion.equiv.parallel_nil, t ⟩ },
  },

  case species.equivalent.parallel_nil₂ : Γ B {
    cases E₁,
    case production.species { from ⟨ _, production.equiv.species parallel_nil₂, parL_species _ t₁ ⟩ },
    case production.concretion { from ⟨ _, production.equiv.concretion concretion.equiv.parallel_nil.symm, parL_concretion _ t₁ ⟩ },
  },

  case species.equivalent.choice_swap { from on_choice_swap t₁ },

  case species.equivalent.parallel_assoc₁ { from on_parallel_assoc₁ t₁ },
  case species.equivalent.parallel_assoc₂ { from on_parallel_assoc₂ t₁ },

  case species.equivalent.parallel_symm { from on_parallel_symm t₁ },

  case species.equivalent.ν_parallel₁ { from on_ν_parallel₁ t₁ },
  case species.equivalent.ν_parallel₂ { from on_ν_parallel₂ t₁ },
  case species.equivalent.ν_drop₁ { from on_ν_drop₁ t₁ },
  case species.equivalent.ν_drop₂ { from on_ν_drop₂ t₁ },
  case species.equivalent.ν_swap₁ { from on_ν_swap₁ t₁ },
  case species.equivalent.ν_swap₂ { from on_ν_swap₂ t₁ },
end

/-- Drops the congruence restriction from `equivalent_of`. -/
noncomputable def equivalent_of.map {Γ ℓ} {A B : species ℍ ω Γ} (h : species.equivalent A B)
  {k} {α : label ℍ Γ k}
  : (Σ (E : production ℍ ω Γ k), A [ℓ, α]⟶ E)
  → (Σ (E : production ℍ ω Γ k), B [ℓ, α]⟶ E)
| ⟨ E, t ⟩ :=
  let ⟨ E', _, t' ⟩ := equivalent_of h t in
  ⟨ E', t' ⟩

/-- Show that 'equivalent_of' twice yields the same thing. This is not going to
    be fun. -/
axiom equivalent_of.map_map {Γ ℓ} {A B : species ℍ ω Γ} (h : species.equivalent A B)
    {k} {α : label ℍ Γ k} (t : Σ (E : production ℍ ω Γ k), A [ℓ, α]⟶ E)
  : equivalent_of.map h.symm (equivalent_of.map h t) = t

/-- Show that two equivalent species's transition sets are equivalent. -/
noncomputable def equivalent_of.is_equiv {Γ ℓ} {A B : species ℍ ω Γ} (h : species.equivalent A B)
    {k} {α : label ℍ Γ k}
  : (Σ (E : production ℍ ω Γ k), A [ℓ, α]⟶ E) ≃ (Σ (E : production ℍ ω Γ k), B [ℓ, α]⟶ E)
  := { to_fun := equivalent_of.map h,
       inv_fun := equivalent_of.map h.symm,
       left_inv := equivalent_of.map_map h,
       right_inv := λ x, begin
         have this := equivalent_of.map_map h.symm x,
         rw ← species.equivalent.symm_symm h at this,
         from this,
       end }

lemma equivalent_of.map_equiv {Γ ℓ} {A B : species ℍ ω Γ} (h : species.equivalent A B)
    {k} {α : label ℍ Γ k}
    (E : production ℍ ω Γ k) (t : A [ℓ, α]⟶ E)
  : E ≈ (equivalent_of.map h ⟨ E, t ⟩).1 := begin
  unfold equivalent_of.map,
  rcases (equivalent_of h t) with ⟨ E', eqE, t' ⟩,
  from eqE,
end

end transition
end cpi

#lint-


import Mathlib.Tactic.SuccessIfFailWithMsg

example : True := by
  success_if_fail_with_msg "no goals to be solved" trivial; trivial
  trivial

example : Nat → Nat → True := by
  success_if_fail_with_msg "no goals to be solved"
    intro
    intro
    trivial
    trivial
  intros; trivial

def err (t : Bool) := if t then
  "tactic 'rewrite' failed, equality or iff proof expected
  n ≤ Nat.succ n
n : Nat
⊢ True"
  else
    "not that message
⊢ True"

example (n : Nat) : True := by
  success_if_fail_with_msg (err true) rw [Nat.le_succ n]
  trivial

example : True := by
  success_if_fail_with_msg (err false) fail "not that message"
  trivial

/- In the following, we use `success_if_fail_with_msg` to write tests for
`success_if_fail_with_msg`, since the inner one should fail with a certain message. -/

example : True := by
  success_if_fail_with_msg "tactic 'trivial' succeeded, but was expected to fail"
    success_if_fail_with_msg "message" trivial
  trivial

def err₂ := "tactic 'fail \"different message!\"' failed, but got different error message:

different message!
⊢ True"

example : True := by
  success_if_fail_with_msg err₂
    success_if_fail_with_msg "message" fail "different message!"
  trivial

open Lean Meta Mathlib Tactic

def alwaysFails : MetaM Unit := do throwError "I failed!"

def doesntFail : MetaM Unit := do
  try successIfFailWithMessage "I failed!" alwaysFails
  catch _ => throwError "I *really* failed."

#eval doesntFail


import number_theory.bernoulli

--OUTPUT 1
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  {
    unfold polynomial.bernoulli polynomial.eval,
    by_cases (x = 0),
    {
      replace h : x = 0, from h,
      clear h,
      rw h,
      auto [mul_zero, zero_add],
    },
    {
      have h2 : x ≠ 0, from h,
      have h3 : (1 : ℚ) ≠ 0, from by auto [ne.symm h2],
      have h4 : 1 / x ≠ 0, from by auto [div_ne_zero h3],
      have h5 : x ≠ 0, from ne.symm h,
      have h6 : (1 + x) ≠ 0, from by auto [add_ne_zero],
      have h7 : (1 + x) ≠ 0, from h6,
      have h8 : (1 + x) ≠ 0, from by auto [add_ne_zero],
      have h9 : 1 + x ≠ 0, from h8,
      have h10 : (1 + x) ≠ 0, from by auto [add_ne_zero],
      have h11 : (1 + x) ≠ 0, from by auto [add_ne_zero],
      have h12 : ↑(1 + x) ≠ 0, from h11,
      have h13 : (1 : ℚ) ≠ 0, from by auto [ne.symm h2],
      have h14 : 1 ≠ 0, from h13,
      have h15 : (1 : ℚ) ≠ 0, from by auto [ne.symm h2],
      have h16 : (1 : ℚ) ≠ 0, from by auto [ne.symm h2],
      have h17 : (1 : ℚ) ≠ 0, from by auto [ne.symm h2],
      have h18 : (1 : ℚ) ≠ 0, from by auto [ne.symm h2],
      have h19 : (1 : ℚ) ≠ 0, from by auto [ne.symm h2],
      have h20 : (1 : ℚ) ≠ 0, from by auto [ne.symm h2],
      have h21 : 1 + x ≠ 0, from mul_ne_zero (cast h19) (cast h20),
      have h22 : (1 + x) ≠ 0, from h21,
      have h23 : (1 + x) ≠ 0, from h22,
      have h24 : 1 ≠ 0, from ne.symm h2,
      have h25 : 1 + x ≠ 0, from mul_ne_zero (cast h23) (cast h24),
      have h26 : (1 + x) ≠ 0, from h25,
      have h27 : (1 + x) ≠ 0, from by auto [add_ne_zero],
      have h28 : (1 + x) ≠ 0, from h27,
      rw show (1 : ℚ) = 1, from rfl,
      rw show (1 : ℚ) = 1, from rfl,
      rw show (1 : ℚ) = 1, from rfl,
      rw show (1 : ℚ) = 1, from rfl,
      rw show 1 + x = ↑(1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show x = (↑x : ℚ), from rfl,
      rw show ↑(x : ℚ) = (↑x : ℚ), from rfl,
      rw show x = (↑x : ℚ), from rfl,
      rw show ↑(x : ℚ) = (↑x : ℚ), from rfl,
      rw show x = (↑x : ℚ), from rfl,
      rw show ↑(x : ℚ) = (↑x : ℚ), from rfl,
      rw show x = (↑x : ℚ), from rfl,
      rw show ↑(x : ℚ) = (↑x : ℚ), from rfl,
      rw show ↑(x : ℚ) = (↑x : ℚ), from rfl,
      have h29 : (1 + x) ≠ 0, from by auto [add_ne_zero],
      have h30 : (1 + x) ≠ 0, from by auto [add_ne_zero],
      rw show (1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (1 + x), from rfl,
      rw show (1 + x) = (1 + x), from rfl,
      rw show ↑(1 + x) = (
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  apply nat.strong_induction_on n,
  assume d h,
  have h1 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (polynomial.sum (λ (k : ℕ), (polynomial.C (nat.choose (d + 1) k)) * polynomial.X^k)).eval x, from begin
    calc (d + 1) * (1 + x)^d - (d + 1) * x^d =
      (polynomial.sum (λ (k : ℕ), (polynomial.C (nat.choose (d + 1) k)) * polynomial.X^k)).eval (1 + x) - (d + 1) * x^d : by auto [polynomial.eval_sum]
    ... = (polynomial.sum (λ (k : ℕ), (polynomial.C (nat.choose (d + 1) k)) * polynomial.X^k)).eval x : begin
        apply nat.induction_on d,
        repeat {rw ←add_zero},
        simp,
        assume d h,
        rw [nat.add_succ, polynomial.eval_sum],
        have h1 : ∀ k : ℕ, (polynomial.C (nat.choose (d + 1) k)) * polynomial.X^k * (1 + x) =
                            (polynomial.C (nat.choose (d + 1) k)) * (polynomial.X^k * (1 + x)), from by repeat {rw polynomial.mul_one},
        rw h1,
        rw polynomial.eval_mul,
        rw polynomial.eval_X,
        rw polynomial.eval_C,
        rw polynomial.eval_X,
        rw polynomial.eval_C,
        ring,
    end
    ... = (polynomial.sum (λ (k : ℕ), (polynomial.C (nat.choose (d + 1) k)) * polynomial.X^k)).eval x : rfl,
  end,
  have h2 : (polynomial.sum (λ (k : ℕ), (polynomial.C (nat.choose (d + 1) k)) * polynomial.X^k)).eval x = (polynomial.sum (λ (k : ℕ), k * polynomial.X^(k - 1))).eval x, from begin
    rw polynomial.eval_sum,
    apply nat.induction_on d,
    simp,
    assume d h,
    rw [nat.add_succ, polynomial.eval_sum],
    have h1 : ∀ k : ℕ, (polynomial.C (nat.choose (d + 1) k)) * polynomial.X^k =
                            polynomial.C k * polynomial.X^(k - 1), from by auto [polynomial.C_one, nat.choose_one],
    rw h1,
    rw polynomial.eval_mul,
    rw polynomial.eval_X,
    rw polynomial.eval_C,
    rw polynomial.eval_X,
    rw polynomial.eval_C,
    ring,
  end,
  rw h1,
  rw h2,
  rw [nat.add_succ, polynomial.eval_sum],
  have h3 : ∀ k : ℕ, (polynomial.C k * polynomial.X^(k - 1)) * x =
                          k * (polynomial.X^(k - 1) * x), from by auto [polynomial.mul_one],
  rw h3,
  rw polynomial.eval_mul,
  rw polynomial.eval_X,
  rw polynomial.eval_C,
  rw polynomial.eval_X,
  rw polynomial.eval_C,
  ring,
end

--OUTPUT 3
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
induction n with d hd,
{ simp [polynomial.bernoulli, polynomial.eval_add, polynomial.eval_C, polynomial.eval_mul,
  polynomial.eval_X, polynomial.eval_nat_cast, polynomial.eval_sub, polynomial.eval_X_sub_C,
  polynomial.eval_C_sub_X, polynomial.eval_sub_C_C, polynomial.eval_sub_X_C, polynomial.eval_sub_C_X,
  polynomial.eval_sub_X_X, polynomial.eval_pow, polynomial.eval_neg, polynomial.eval_one,
  polynomial.eval_C_add, polynomial.eval_add_C_C],
},
{ simp [polynomial.bernoulli, polynomial.eval_add, polynomial.eval_C, polynomial.eval_mul,
  polynomial.eval_X, polynomial.eval_nat_cast, polynomial.eval_sub, polynomial.eval_X_sub_C,
  polynomial.eval_C_sub_X, polynomial.eval_sub_C_C, polynomial.eval_sub_X_C, polynomial.eval_sub_C_X,
  polynomial.eval_sub_X_X, polynomial.eval_pow, polynomial.eval_neg, polynomial.eval_one,
  polynomial.eval_C_add, polynomial.eval_add_C_C],
}
end

--OUTPUT 4
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  rw[polynomial.eval_add, polynomial.eval_one, polynomial.eval_one],
  have h : ∀ m : ℕ, m ≤ n → (m : ℚ) ≤ n, from λ m hm, by linarith,
  induction n with d hd,
  { calc (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval (x + 1) :  by simp
                      ... = (polynomial.bernoulli 0).eval x + (0 : ℚ) * x^(0 - 1) : by simp [hd (by linarith)]
                      ... = (polynomial.bernoulli 0).eval x + (0 : ℚ) : by simp [polynomial.eval_zero]
                      ... = (polynomial.bernoulli 0).eval x : by simp [zero_add]},
  {calc (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval (x + 1) :  by simp
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d + 1 : ℚ) * x^(d + 1 - 1) : by rw[polynomial.eval_add, polynomial.eval_one, polynomial.eval_one, hd (by linarith)]
                     ... = (polynomial.bernoulli (d + 1)).eval x + d * x^d + x^d : by simp
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d * x^d + x^d) : by simp [polynomial.eval_add, polynomial.eval_one, polynomial.eval_one]
                     ... = (polynomial.bernoulli (d + 1)).eval x + d * x^d + x^d : by simp [polynomial.eval_add, polynomial.eval_one, polynomial.eval_one]
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d * x^d + x^d) : by simp [polynomial.eval_add, polynomial.eval_one, polynomial.eval_one]
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * (x^d + 1) : by simp [ring]
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * ((x + 1)^d) : by simp [polynomial.eval_add, polynomial.eval_one, polynomial.eval_one, polynomial.eval_one]
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * ((x + 1)^d - x^d) : by ring
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * (sum (λ (m : ℕ), (d : ℚ) choose m * x^m) (d - 1)) : by rw[polynomial.eval_one, polynomial.eval_one]
                     ... = (polynomial.bernoulli (d + 1)).eval x + sum (λ (m : ℕ), (d : ℚ) choose m * (d : ℚ) * x^m) (d - 1) : by simp [ring]
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * sum (λ (m : ℕ), m * x^m) (d - 1) : by simp
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * sum (λ (m : ℕ), m * x^m) (d - 1) : by simp
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * sum (λ (m : ℕ), ((m + 1) - 1 : ℚ) * x^m) (d - 1) : by simp
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m - (1 : ℚ) * x^m) (d - 1) : by refl
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m) (d - 1) - (d : ℚ) * sum (λ (m : ℕ), (1 : ℚ) * x^m) (d - 1) : by simp [sum_sub_sum]
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m) (d - 1) - (d : ℚ) * (sum (λ (m : ℕ), (1 : ℚ) * x^m) (d - 1)) : by simp
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m) (d - 1) - (d : ℚ) * (x^(d - 1) + sum (λ (m : ℕ), 1) (d - 2)) : by simp [sum_range_succ]
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m) (d - 2) - (d : ℚ) * x^(d - 1) : by simp [sum_range_succ]
                     ... = (polynomial.bernoulli (d + 1)).eval x + (d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m) (d - 2) - (d : ℚ) * x^(d - 1) : by simp [sum_range_succ]
                     ... = ((d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m) (d - 2) + (polynomial.bernoulli (d + 1)).eval x - (d : ℚ) * x^(d - 1)) : by simp
                     ... = ((d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m) (d - 2) + ((polynomial.bernoulli (d + 1)).eval x - (d : ℚ) * x^(d - 1))) : by refl
                     ... = ((d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m) (d - 2) + ((polynomial.bernoulli (d + 1)).eval x - (d : ℚ) * x^(d - 1))) : by refl
                     ... = (d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m) (d - 2) + (polynomial.bernoulli (d + 1)).eval x - (d : ℚ) * x^(d - 1) : by simp
                     ... = (d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ) * x^m) (d - 2) + (polynomial.bernoulli (d + 1)).eval x - (d : ℚ) * x^(d - 1) : by simp
                     ... = (d : ℚ) * sum (λ (m : ℕ), (m + 1 : ℚ)
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with h hd,
  { simp },
  { have h1 : polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * (polynomial.X : polynomial ℚ)^k) (λ (k : ℕ), k * (polynomial.X : polynomial ℚ)^(k - 1)) =
    (n + 1) * (polynomial.X : polynomial ℚ) ^ n, from by auto [polynomial.sum],
    have h2 : polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * ((polynomial.X : polynomial ℚ)^k)) (λ (k : ℕ), k * ((polynomial.X : polynomial ℚ)^(k - 1))) =
    polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * ((polynomial.X : polynomial ℚ)^k)) (λ (k : ℕ), k * x^(k - 1)), from by auto [polynomial.sum],
    have h3 : n * (1 + x) ^ n - n * x ^ n = polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * ((polynomial.X : polynomial ℚ)^k)) (λ (k : ℕ), k * ((polynomial.X : polynomial ℚ)^(k - 1))), from
      calc n * (1 + x) ^ n - n * x ^ n = polynomial.sum (λ (k : ℕ), n * ↑(choose (n + 1) k) * ((polynomial.X : polynomial ℚ)^k)) (λ (k : ℕ), (k + 1) * ((polynomial.X : polynomial ℚ)^k)) : by auto [polynomial.sum, polynomial.sum, polynomial.sum, polynomial.sum]
    ... = polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * ((polynomial.X : polynomial ℚ)^k)) (λ (k : ℕ), k * ((polynomial.X : polynomial ℚ)^k)) + (n + 1) * ((polynomial.X : polynomial ℚ)^n) : by auto [polynomial.sum]
    ... = (n + 1) * ((polynomial.X : polynomial ℚ)^n) : by auto [polynomial.sum, h1],
    have h4 : (polynomial.bernoulli (n + 1)).eval (1 + x) - (polynomial.bernoulli (n + 1)).eval x =
    polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * ((polynomial.X : polynomial ℚ)^k)) (λ (k : ℕ), k * ((polynomial.X : polynomial ℚ)^(k - 1))), from by auto [polynomial.sum],
    have h5 : (polynomial.bernoulli (n + 1)).eval (1 + x) - (polynomial.bernoulli (n + 1)).eval x =
    polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * ((polynomial.X : polynomial ℚ)^k)) (λ (k : ℕ), k * x^(k - 1)), from by auto [h2],
    have h6 : (polynomial.bernoulli (n + 1)).eval (1 + x) - (polynomial.bernoulli (n + 1)).eval x =
    n * (1 + x) ^ n - n * x ^ n, from by auto [h3, h4],
    have h7 : (polynomial.bernoulli (n + 1)).eval (1 + x) - (polynomial.bernoulli (n + 1)).eval x =
    polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * x^k) (λ (k : ℕ), k * x^(k - 1)), from by auto [h5],
    have h8 : (polynomial.bernoulli (n + 1)).eval (1 + x) - (polynomial.bernoulli (n + 1)).eval x + (n + 1) * x ^ n =
    polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * x^k) (λ (k : ℕ), (k + 1) * x^k), from by auto [polynomial.sum, polynomial.sum, polynomial.sum],
    have h9 : (polynomial.bernoulli (n + 1)).eval (1 + x) =
    polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * x^k) (λ (k : ℕ), (k + 1) * x^k), from by auto [h6, h7, h8],
    have h10 : polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * x^k) (λ (k : ℕ), (k + 1) * x^k) =
    polynomial.sum (λ (k : ℕ), (n + 1) * ↑(choose (n + 1) k) * x^k) (λ (k : ℕ), n * x^(n - 1)), from by auto [polynomial.sum],
    have h11 : (polynomial.bernoulli (n + 1)).eval (1 + x) =
    (n + 1) * x^n + n * x^n, from by auto [h9, h10, polynomial.sum, polynomial.sum],
    show (polynomial.bernoulli (n + 1)).eval (1 + x) = (polynomial.bernoulli (n + 1)).eval x + (n + 1) * x^(n + 1 - 1), from by auto [(n + 1) * x^(n + 1 - 1)],
  },
end

--OUTPUT 6
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
    induction n with l hl,
    rw polynomial.bernoulli,
    simp,
    rw add_zero,
    simp,

    rw polynomial.bernoulli at hl,
    simp [polynomial.eval_sum, polynomial.eval_C],
    rw polynomial.bernoulli,
    simp,
    rw add_comm,
    rw mul_comm (1 + x) x,
    rw add_assoc,
    rw hl,
    rw add_assoc (l * x ^ (l - 1)),
    rw mul_pow,
    rw mul_comm,
    rw add_comm,
    rw mul_comm ((1 + x) * x) x,
    rw ← mul_assoc,
    rw ← mul_comm x,
    rw ← pow_succ,
    rw mul_comm (l + 1) x,
end

--OUTPUT 7
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with n hn generalizing x,
  {
    show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x, from by simp [eval_C],
  },
  {
    have h1 : (polynomial.prod (λ (m : ℕ), C (m + 1) * (X^m + X^(m + 1))) n).eval (1 + x) =
              (polynomial.prod (λ (m : ℕ), C (m + 1) * (X^m + X^(m + 1))) n).eval x, from by auto [eval_prod],
    have h2 : (polynomial.prod (λ (m : ℕ), C (m + 1) * (X^m + X^(m + 1))) n).eval x =
              (polynomial.prod (λ (m : ℕ), C (m + 1) * X^m) n).eval x +
              (polynomial.prod (λ (m : ℕ), C (m + 1) * X^(m + 1)) n).eval x, from by auto [eval_prod, eval_add],
    have h3 : (polynomial.prod (λ (m : ℕ), C (m + 1) * X^m) n).eval x =
              (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x *
              (polynomial.prod (λ (m : ℕ), X^m) n).eval x, from by auto [eval_prod],
    have h4 : (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x =
              (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval 0, from by auto [eval_prod_const],
    have h5 : (polynomial.prod (λ (m : ℕ), X^m) n).eval x =
              polynomial.prod (λ (m : ℕ), X) n, from by auto [eval_prod],
    have h6 : (polynomial.prod (λ (m : ℕ), C (m + 1) * X^(m + 1)) n).eval x =
              (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x *
              (polynomial.prod (λ (m : ℕ), X) n) ^ (n + 1), from by auto [eval_prod],
    have h7 : (polynomial.prod (λ (m : ℕ), C (m + 1) * X^(m + 1)) n).eval x =
              (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x *
              (polynomial.prod (λ (m : ℕ), X) n) *
              (polynomial.prod (λ (m : ℕ), X) n) ^ n, from by auto [eval_prod],
    have h8 : (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x =
              (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval 0, from by auto [eval_prod_const],
    have h9 : (polynomial.prod (λ (m : ℕ), C (m + 1) * X^m) n).eval (1 + x) =
              (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval (1 + x) *
              (polynomial.prod (λ (m : ℕ), X^m) n).eval (1 + x), from by auto [eval_prod],
    have h10 : (polynomial.prod (λ (m : ℕ), C (m + 1) * X^(m + 1)) n).eval (1 + x) =
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval (1 + x) *
               (polynomial.prod (λ (m : ℕ), X) n) *
               (polynomial.prod (λ (m : ℕ), X) n) ^ n, from by auto [eval_prod],
    have h11 : (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval (1 + x) =
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x +
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n) *
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x, from by auto [eval_prod],
    have h12 : (polynomial.prod (λ (m : ℕ), X^m) n).eval (1 + x) =
               (polynomial.prod (λ (m : ℕ), X^m) n).eval x, from by auto [eval_prod],
    have h13 : (polynomial.prod (λ (m : ℕ), X) n) ^ (n + 1) =
               (polynomial.prod (λ (m : ℕ), X) n) * (polynomial.prod (λ (m : ℕ), X) n) ^ n, from by auto [eval_prod],
    have h14 : (polynomial.prod (λ (m : ℕ), C (m + 1)) n) *
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x =
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x *
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n), from by auto [eval_prod, mul_comm],
    have h15 : (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x =
               polynomial.prod (λ (m : ℕ), C (m + 1)) n, from by auto [eval_prod_const],
    have h16 : (polynomial.prod (λ (m : ℕ), C (m + 1)) n) *
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval 0 =
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval 0 *
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n), from by auto [eval_prod, mul_comm],
    have h17 : (polynomial.prod (λ (m : ℕ), C (m + 1)) n) *
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval x *
               (polynomial.prod (λ (m : ℕ), X^m) n).eval x =
               (polynomial.prod (λ (m : ℕ), C (m + 1) * X^m) n).eval x *
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n), from by auto [eval_prod, mul_comm],
    have h18 : (polynomial.prod (λ (m : ℕ), C (m + 1)) n) *
               (polynomial.prod (λ (m : ℕ), C (m + 1)) n).eval 0 *
               (polynomial.prod (λ (m : ℕ), X^m) n).eval x =
               (polynomial.prod (λ (m : ℕ), C (m + 1) * X^m) n).eval 0 *
               (polynomial.prod (λ (m :
end --Needs more than 2000 tokens!

--OUTPUT 8
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  have h1 : ∀ (m : ℕ) (x : ℚ), m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x ^ (m - 1),
  { assume m x h1,
    have h2 : ∀ k : ℕ, k ≤ m → (((C (1+x)) ^ (m - k))),
    { assume k h2,
      have h3 : (1 + x)^m = (C x)^m + m * (C x)^(m-1) * (C (1+x))^1, by simp [C, has_mul.one],
      rw has_pow.pow_eq_pow_of_nat_cast h2 at h3,
      have h4 : (1 + x) ^ (m - k) = (C x) ^ (m - k) + m * (C x) ^ (m - k - 1) * (C (1 + x)) ^ 1, from by simp [C, has_mul.one] at h3,
      exact h4,
    },
    have h3 : (polynomial.bernoulli m).eval (1 + x) = ∑ (k : ℕ) in finset.range m, (((C (1 + x)) ^ k) * C (mchoose k)), from by simp [C, has_mul.one],
    have h4 : (polynomial.bernoulli m).eval x = ∑ (k : ℕ) in finset.range m, ((C x ^ k) * C (mchoose k)), from by auto [C, has_mul.one] at h3,
    have h5 : (polynomial.bernoulli m).eval (1 + x) = ∑ (k : ℕ) in finset.range m, ((C x ^ k) * C (mchoose k) + m * C x ^ (k - 1) * C (mchoose k) * C (1 + x)), from by auto [C, has_mul.one] at h3 using [h2],
    have h6 : ∑ (k : ℕ) in finset.range m, (m * C x ^ (k - 1) * C (mchoose k) * C (1 + x)) = m * ∑ (k : ℕ) in finset.range m, (C x ^ (k - 1) * C (mchoose k) * C (1 + x)), from by auto [finset.sum_mul],
    have h7 : ∑ (k : ℕ) in finset.range m, (C x ^ (k - 1) * C (mchoose k) * C (1 + x)) = x ^ (m - 1), from by simp [C, has_mul.one] at h6,
    have h8 : m * (∑ (k : ℕ) in finset.range m, (C x ^ (k - 1) * C (mchoose k) * C (1 + x))) = m * x ^ (m - 1), from by auto at h7,
    have h9 : finset.sum finset.range m (λ (k : ℕ), C x ^ k * C (mchoose k) + m * C x ^ (k - 1) * C (mchoose k) * C (1 + x)) = finset.sum finset.range m (λ (k : ℕ), C x ^ k * C (mchoose k)) + m * x ^ (m - 1), from by rw finset.sum_add h4 h8,
    exact h9,
  },
  have h2 : ∀ (m : ℕ) (x : ℚ), m < n → (polynomial.bernoulli m).eval x = mchoose m, from by auto using [bernoulli_eval, nat.eq_zero_of_le_zero],
  have h3 : ∀ (m : ℕ) (x : ℚ), m < n →  mchoose m * x^(m - 1) = m * x^(m - 1), from by auto [mul_comm, nat.choose_eq_mul_succ_pred_div_succ, nat.one_mul],
  have h4 : ∀ (m : ℕ) (x : ℚ), m < n → (polynomial.bernoulli m).eval x + m * x ^ (m - 1) = mchoose m + m * x ^ (m - 1), from by auto [h2, h3],
  have h5 : ∀ (m : ℕ) (x : ℚ), m < n → (polynomial.bernoulli m).eval (1 + x) = mchoose m + m * x ^ (m - 1), from by auto [h1, h4],
  by_contradiction h6,
  have h7 : ∀ (m : ℕ) (x : ℚ), m < n → (polynomial.bernoulli m).eval (1 + x) + m * (1 + x) ^ (m - 1) = mchoose m + m * (1 + x) ^ (m - 1) + m * (1 + x) ^ (m - 1), from by auto [h5],
  have h8 : ∀ (m : ℕ) (x : ℚ), m < n → (polynomial.bernoulli m).eval (1 + x) + m * (1 + x) ^ (m - 1) = mchoose m + (1 + m) * (1 + x) ^ (m - 1), from by auto [mul_comm, one_mul, nat.add_comm] at h7,
  have h9 : ∀ (m : ℕ) (x : ℚ), m < n → ((polynomial.bernoulli m).eval (1 + x) + m * (1 + x) ^ (m - 1)) * ((C (1 + x)) ^ n) = (mchoose m + (1 + m) * (1 + x) ^ (m - 1)) * ((C (1 + x)) ^ n), from by auto at h8,
  have h10 : ∀ (m : ℕ) (x : ℚ), m < n → ∑ (k : ℕ) in finset.range m, (polynomial.bernoulli k).eval (1 + x) + k * (1 + x) ^ (k - 1) = (1 + x) ^ (m - 1) * ∑ (k : ℕ) in finset.range m, (1 + k) * (1 + x) ^ (k - 1), from by auto [C, has_mul.one] at h9,
  have h11 : ∀ (m : ℕ) (x : ℚ), m < n → ∑ (k : ℕ) in finset.range m, (polynomial.bernoulli k).eval (1 + x) + k * (1 + x) ^ (k - 1) * (C (1 + x)) ^ n = (1 + x) ^ (m - 1) * ∑ (k : ℕ) in finset.range m, (1 + k) * (1 + x) ^ (k - 1) * (C (1 + x)) ^ n, from by auto [nat.cast_one, one_mul, has_mul.one] at h10,
  have h12 : ∀ (m : ℕ) (x : ℚ), m < n → (1 + x)^m * ∑ (k : ℕ) in finset.range (m + 1), (((C (1 + x)) ^ k) * C (mchoose k)) = (1 + x) ^ (m - 1) * ∑ (k : ℕ) in finset.range m, (1 + k) * (1 + x) ^ (k - 1) * (C (1 + x)) ^ n, from by auto [C, has_mul.one] at h11,
  have h13 : ∀ (m : ℕ) (x : ℚ), m < n → (1 + x)^m * ∑ (k : ℕ) in finset.range (m + 1), ((
end --Needs more than 2000 tokens!

--OUTPUT 9
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  apply nat.strong_induction_on n,
  intros,
  split_ifs with h,
  rw [h, nat.sub_self, pow_zero, add_zero],
  have h2 := polynomial.bernoulli_succ_eq_one_add_eval a x,
  rw [h, diff_pow, diff_pow, h2],
  ring,
  rw [h, pow_one, pow_zero],
  ring,
  rw [h, pow_one, pow_zero, mul_one, add_zero],
  rw polynomial.eval₂_zero,
  rw polynomial.eval₂_zero,
  ring,
  rw [h, pow_zero],
  ring,
  rw polynomial.eval₂_zero,
  ring,
end

--OUTPUT 10
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  rw [nat.zero_eq_zero, polynomial.bernoulli, polynomial.bernoulli, polynomial.eval_C],
  simp,
  assume x rw [nat.one_eq_one, polynomial.bernoulli, polynomial.bernoulli, polynomial.eval_X, polynomial.eval_add, polynomial.eval_C, nat.one_eq_one],
  suffices h :
    polynomial.eval (of_nat (d + 1) * (X^d - X^d)) (1 + x) =
    polynomial.eval (of_nat (d + 1) * (X^d - X^d)) x + d * x ^ (d - 1),
  simp at h,
  exact h,
  rw [polynomial.eval_mul, polynomial.eval_add, polynomial.eval_neg, polynomial.eval_C, polynomial.eval_X],
  have h1 : (1 + x)^d - x^d = (1 - x) * ((1 + x) ^ (d - 1) + (1 + x) ^ (d - 2) * x + ... + x ^ (d - 1)),
  begin
    have h10 : (1 + x) ^ d - x ^ d = (1 + x) ^ (d - 1) * (1 + x - x),
    by simp [polynomial.add_mul, polynomial.mul_C, polynomial.mul_X_pow, polynomial.mul_one],
    have h11 : (1 + x - x) = (1 - x),
    by simp,
    rw [h11] at h10,
    rw h10,
    rw [nat.mul_one, mul_comm, mul_assoc],
    induction d with d hd,
    by simp,
    assume x,
    simp,
    assume x d hd,
    have h11 : x ^ (d - 1) + (1 + x) ^ (d - 1) * x = (1 + x) ^ (d - 1) * (1 + x),
    by rw [← add_mul, polynomial.add_C, polynomial.add_X_pow],
    have h12 : (1 + x) ^ d - x ^ d = (1 + x - x) * ((1 + x) ^ (d - 1) + (1 + x) ^ (d - 2) * x + ... + x ^ (d - 1)),
    by simp; rw [← mul_assoc, mul_assoc, mul_comm, mul_assoc, mul_assoc, mul_comm, add_mul, add_mul, ↑_root_.add, nat.mul_one, polynomial.C_1, polynomial.C_0, hd],
    rw h12,
    rw [mul_comm, h11, mul_add, mul_assoc, mul_comm, mul_assoc, ← add_mul, add_mul, ← add_mul, h11, ← add_assoc, mul_comm, mul_assoc],
    rw [← mul_add],
  end,
  rw h1,
  rw mul_comm,
  rw [mul_add, mul_assoc],
  rw [← polynomial.eval_add],
  suffices h2 : polynomial.eval (of_nat (d + 1) * ((1 - x) * (X ^ (d - 1) + X ^ (d - 2) * X + ... + X ^ 0))) (1 + x) = polynomial.eval (of_nat (d + 1) * ((1 - x) * (X ^ (d - 1) + X ^ (d - 2) * X + ... + X ^ 0))) x + polynomial.eval (of_nat (d + 1) * (1 - x) * (X ^ (d - 1))) x,
  begin
    rw mul_comm,
    rw [mul_add, mul_comm],
    rw add_comm,
  end,
  rw [← h2],
  rw add_comm,
  induction d with d hd,
  rw [nat.add_one, nat.zero_eq_zero, zero_add, polynomial.eval_C, polynomial.eval_C],
  simp,
  have h20 : polynomial.eval (of_nat (d + 2) * (1 - x) * (X ^ (d + 1) + X ^ d * X + ... + X ^ 0)) (1 + x) = polynomial.eval ((of_nat (d + 2) * (1 - x) * (X ^ (d + 1) + X ^ d * X + ... + X ^ 0)) + (of_nat (d + 2) * (1 - x) * (X ^ (d + 1)))) (1 + x),
  by simp,
  rw h20,
  have h21 : polynomial.eval (of_nat (d + 2) * (1 - x) * (X ^ (d + 1) + X ^ d * X + ... + X ^ 0)) x + polynomial.eval (of_nat (d + 2) * (1 - x) * (X ^ (d + 1))) x = polynomial.eval ((of_nat (d + 2) * (1 - x) * (X ^ (d + 1) + X ^ d * X + ... + X ^ 0)) + (of_nat (d + 2) * (1 - x) * (X ^ (d + 1)))) x,
  by simp,
  rw h21,
  rw [← polynomial.eval_add],
  rw [polynomial.C_add, polynomial.eval_add, polynomial.eval_mul],
  rw [polynomial.eval_add],
  rw polynomial.eval_C,
  rw polynomial.eval_mul,
  rw polynomial.eval_C,
  rw polynomial.eval_X,
  rw [→ mul_comm, mul_comm (d + 2), ← mul_add],
  rw add_comm,
  rw mul_assoc,
  rw [← polynomial.eval_add],
  have h22 : polynomial.eval (of_nat (d + 2) * ((1 - x) * (X ^ (d + 1) + X ^ d * X + ... + X ^ 0))) (1 + x) + polynomial.eval (of_nat (d + 2) * ((1 - x) * (X ^ (d + 1) + X ^ d * X + ... + X ^ 0))) x + polynomial.eval (of_nat (d + 2) * (1 - x) * (X ^ (d + 1))) x =
    polynomial.eval ((of_nat (d + 2) * (1 - x) * (X ^ (d + 1)))) (1 + x) + polynomial.eval ((of_nat (d + 2) * (1 - x) * (X ^ (d + 1) + X ^ d * X + ... + X ^ 0))) (1 + x) + polynomial.eval ((of_nat (d + 2) * (1 - x) * (X ^ (d + 1) + X ^ d * X + ... + X ^ 0))) x + polynomial.eval (of_nat (d + 2) * (1 - x) * (X ^ (d + 1))) x,
  by simp,
  rw h22,
  rw [← polynomial.eval_add],
  have h23 :
    polynomial.eval ((of_nat (d + 2) * (1 - x) * (X ^ (d + 1)))) (1 + x) =
    polynomial.eval ((of_nat (d + 2) * (1 - x) * (X ^ (d + 1)))) x +
    polynomial.eval (of_nat (d + 2) * (1 - x) * X ^ (d + 1)) x,
  by rw [polynomial.eval_mul, po
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

/--`theorem`
Bernoulli polynomial evaluation
Given a natural number $n$ and a rational $x$, let $B_n (x)$ denote the $n$-th Bernoulli polynomial evaluated at $x$. Then, $$B_n (1 + x) = B_n (x) + n x^{n - 1}$$
`proof`
We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
$$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
The conclusion then follows easily.

QED

-/
theorem  bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2019 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import data.set
import algebra.category.Mon.basic

def X : Type := set ℕ

instance : has_coe_to_sort X Type := set.has_coe_to_sort

@[derive ring] def T := ℤ

class binclass (T1 T2 : Type)

instance : binclass ℤ ℤ := ⟨⟩

@[derive [ring, binclass ℤ]] def U := ℤ

@[derive λ α, binclass α ℤ] def V := ℤ

-- test instance naming
example := U.ring
example := U.binclass
example := V.binclass

@[derive ring] def id_ring (α) [ring α] : Type := α

@[derive decidable_eq] def S := ℕ

@[derive decidable_eq] inductive P | a | b | c

open category_theory

-- Test that `delta_instance` works in the presence of universe metavariables.
attribute [derive large_category] Mon

-- test deriving instances on function types
@[derive monad]
meta def my_tactic : Type → Type :=
tactic