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
  apply nat.strong_induction_on n,
  assume n hn,
  begin
    rw [polynomial.eval_add, polynomial.eval_add, polynomial.eval_add, polynomial.eval_C],
    rw [polynomial.eval_add, polynomial.eval_add, polynomial.eval_C],
    rw [polynomial.eval_add, polynomial.eval_C],
    rw [polynomial.eval_add, polynomial.eval_C],

    rw [polynomial.eval_sub, polynomial.eval_sub, polynomial.eval_C],
    rw [polynomial.eval_sub, polynomial.eval_C],
    rw [polynomial.eval_sub, polynomial.eval_C],
    rw [polynomial.eval_sub, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],

    rw [polynomial.eval_mul, polynomial.eval_mul, polynomial.eval_C],
    rw [polynomial
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
  have h1 : ∀ m : ℕ, m < n → (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli m).eval x + m * x^(m - 1),
    assume m : ℕ,
    assume h2 : (m < n),
    induction m with m hm,
    show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from by auto [polynomial.bernoulli, eval_C, eval_X],
    show (polynomial.bernoulli (m + 1)).eval (1 + x) = (polynomial.bernoulli (m + 1)).eval x + (m + 1) * x^((m + 1) - 1),
    begin
      have h3 : (polynomial.bernoulli (m + 1)).eval (1 + x) = (polynomial.bernoulli (m + 1)).eval x + (polynomial.bernoulli m).eval (1 + x), from by auto [polynomial.bernoulli, eval_add, eval_mul, eval_X, eval_C],
      have h4 : (polynomial.bernoulli (m + 1)).eval x + (polynomial.bernoulli m).eval (1 + x) = (polynomial.bernoulli (m + 1)).eval x + (polynomial.bernoulli m).eval x + (polynomial.bernoulli m).eval x, from by auto [hm, add_assoc],
      have h5 : (polynomial.bernoulli (m + 1)).eval x + (polynomial.bernoulli m).eval x + (polynomial.bernoulli m).eval x = (polynomial.bernoulli (m + 1)).eval x + (polynomial.bernoulli m).eval x + m * x^(m - 1), from by auto [hm],
      have h6 : (polynomial.bernoulli (m + 1)).eval x + (polynomial.bernoulli m).eval x + m * x^(m - 1) = (polynomial.bernoulli (m + 1)).eval x + m * x^(m - 1) + m * x^(m - 1), from by auto [add_assoc],
      show (polynomial.bernoulli (m + 1)).eval (1 + x) = (polynomial.bernoulli (m + 1)).eval x + (m + 1) * x^((m + 1) - 1), from by auto [h3, h4, h5, h6],
    end,
  have h7 : (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + (polynomial.bernoulli (n - 1)).eval (1 + x), from by auto [polynomial.bernoulli, eval_add, eval_mul, eval_X, eval_C],
  have h8 : (polynomial.bernoulli n).eval x + (polynomial.bernoulli (n - 1)).eval (1 + x) = (polynomial.bernoulli n).eval x + (polynomial.bernoulli (n - 1)).eval x + (polynomial.bernoulli (n - 1)).eval x, from by auto [h1, nat.sub_lt],
  have h9 : (polynomial.bernoulli n).eval x + (polynomial.bernoulli (n - 1)).eval x + (polynomial.bernoulli (n - 1)).eval x = (polynomial.bernoulli n).eval x + (polynomial.bernoulli (n - 1)).eval x + (n - 1) * x^((n - 1) - 1), from by auto [h1, nat.sub_lt],
  have h10 : (polynomial.bernoulli n).eval x + (polynomial.bernoulli (n - 1)).eval x + (n - 1) * x^((n - 1) - 1) = (polynomial.bernoulli n).eval x + (n - 1) * x^((n - 1) - 1) + (n - 1) * x^((n - 1) - 1), from by auto [add_assoc],
  show (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1), from by auto [h7, h8, h9, h10],
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
  have h1 : ∀ l : ℕ, polynomial.sum (λ (k : ℕ), (polynomial.binomial (l + 1) k) * (polynomial.bernoulli k)) (l + 1) = (l + 1) * X^l, from by auto using [polynomial.sum_eq_mul],
  have h2 : ∀ l : ℕ, polynomial.sum (λ (k : ℕ), (polynomial.binomial (l + 1) k) * (polynomial.bernoulli k)) (l + 1) = polynomial.sum (λ (k : ℕ), (polynomial.binomial (l + 1) k) * (polynomial.bernoulli k)) l + (polynomial.binomial (l + 1) (l + 1)) * (polynomial.bernoulli (l + 1)), from by auto using [polynomial.sum_add],
  have h3 : ∀ l : ℕ, polynomial.sum (λ (k : ℕ), (polynomial.binomial (l + 1) k) * (polynomial.bernoulli k)) (l + 1) = polynomial.sum (λ (k : ℕ), (polynomial.binomial (l + 1) k) * (polynomial.bernoulli k)) l + (polynomial.bernoulli (l + 1)), from by auto,
  have h4 : ∀ l : ℕ, polynomial.sum (λ (k : ℕ), (polynomial.binomial (l + 1) k) * (polynomial.bernoulli k)) (l + 1) = polynomial.sum (λ (k : ℕ), (polynomial.binomial (l + 1) k) * (polynomial.bernoulli k)) (l + 1) + (polynomial.bernoulli (l + 1)), from by auto,

  induction n with d hd,
  {
    rw polynomial.bernoulli_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polynomial.eval_zero,
    rw polyn
end --Needs more than 2000 tokens!

--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.bernoulli,
  rw polynomial.eval_add,
  rw polynomial.eval_mul,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_monomial,
  rw polynomial.eval_mon
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
  have h1 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), ((polynomial.binomial (n + 1) k) * (polynomial.X ^ k)) * (polynomial.bernoulli k).coeff 0), from by auto [polynomial.bernoulli_def],
  have h2 : ∀ (k : ℕ), (polynomial.binomial (n + 1) k) * (polynomial.X ^ k) = polynomial.C (k + 1) * polynomial.X ^ k, from by auto [polynomial.binomial_def],
  have h3 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), ((polynomial.C (k + 1) * polynomial.X ^ k) * (polynomial.bernoulli k).coeff 0)), from by auto [h1, h2],
  have h4 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * polynomial.X ^ k * (polynomial.bernoulli k).coeff 0), from by auto [h3],
  have h5 : polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * polynomial.X ^ k * (polynomial.bernoulli k).coeff 0) = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * (polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [polynomial.sum_mul_C],
  have h6 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * (polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h4, h5],
  have h7 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * polynomial.X ^ k * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h6],
  have h8 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * (polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h7],
  have h9 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * polynomial.X ^ k * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h8],
  have h10 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), (polynomial.C (k + 1) * polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h9],
  have h11 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * polynomial.X ^ k * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h10],
  have h12 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), (polynomial.C (k + 1) * polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h11],
  have h13 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * (polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h12],
  have h14 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * polynomial.X ^ k * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h13],
  have h15 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), (polynomial.C (k + 1) * polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h14],
  have h16 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * (polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h15],
  have h17 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), (polynomial.C (k + 1) * polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h16],
  have h18 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * (polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h17],
  have h19 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), (polynomial.C (k + 1) * polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h18],
  have h20 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * (polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h19],
  have h21 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), (polynomial.C (k + 1) * polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h20],
  have h22 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * (polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h21],
  have h23 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), (polynomial.C (k + 1) * polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h22],
  have h24 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * (polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h23],
  have h25 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), (polynomial.C (k + 1) * polynomial.X ^ k) * polynomial.C (polynomial.bernoulli k).coeff 0), from by auto [h24],
  have h26 : polynomial.bernoulli n = polynomial.sum (λ (k : ℕ), polynomial.C (k + 1) * (polynomial.X ^ k) * polynomial.C (polynomial.bernoulli
end --Needs more than 2000 tokens!

--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 d hd,
  {
    unfold polynomial.bernoulli,
    unfold polynomial.eval,
    simp,
    ring,
  },
  {
    have h1 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (sum (λ k, ((d + 1) : ℚ) * (polynomial.C (1 : ℚ) ^ k * polynomial.C (x : ℚ) ^ (d - k))) (range (0, d + 1))).eval x, by unfold polynomial.bernoulli,
    have h2 : (sum (λ k, ((d + 1) : ℚ) * (polynomial.C (1 : ℚ) ^ k * polynomial.C (x : ℚ) ^ (d - k))) (range (0, d + 1))).eval x = (sum (λ k, ((d + 1) : ℚ) * (polynomial.C (1 : ℚ) ^ k * polynomial.C (x : ℚ) ^ (d - k))) (range (0, d + 1))).eval x + (sum (λ (k : ℕ), ((d + 1) : ℚ) * (d - k) * (x : ℚ) ^ (d - k - 1) * polynomial.C (1 : ℚ) ^ k) (range (0, d + 1))).eval x, by ring,
    have h3 : (sum (λ (k : ℕ), ((d + 1) : ℚ) * (d - k) * (x : ℚ) ^ (d - k - 1) * polynomial.C (1 : ℚ) ^ k) (range (0, d + 1))).eval x = (sum (λ (k : ℕ), ((d + 1) : ℚ) * (d - k) * (x : ℚ) ^ (d - k - 1) * polynomial.C (1 : ℚ) ^ k) (range (0, d + 1))).eval x + (sum (λ (k : ℕ), ((d + 1) : ℚ) * (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x, by ring,
    have h4 : (sum (λ (k : ℕ), ((d + 1) : ℚ) * (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x = (sum (λ (k : ℕ), ((d + 1) : ℚ) * (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x + (d + 1) * (x : ℚ) ^ (d - 1), by ring,
    have h5 : (sum (λ (k : ℕ), ((d + 1) : ℚ) * (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x = (sum (λ (k : ℕ), ((d + 1) : ℚ) * (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x + (sum (λ k, ((d + 1) : ℚ) * (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x, by ring,
    have h6 : (sum (λ k, ((d + 1) : ℚ) * (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x = (sum (λ k, ((d + 1) : ℚ) * (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x + (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x, by ring,
    have h7 : (sum (λ k, ((d + 1) : ℚ) * (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x = (sum (λ k, ((d + 1) : ℚ) * (x : ℚ) ^ (d - k - 1)) (range (0, d + 1))).eval x + (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d))).eval x, by ring,
    have h8 : (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d))).eval x = (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d))).eval x + (d : ℚ) * (x : ℚ) ^ (d - 1), by ring,
    have h9 : (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d))).eval x = (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d))).eval x + (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 1))).eval x, by ring,
    have h10 : (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 1))).eval x = (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 1))).eval x + (d - 1) * (x : ℚ) ^ (d - 2), by ring,
    have h11 : (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 1))).eval x = (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 1))).eval x + (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 2))).eval x, by ring,
    have h12 : (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 2))).eval x = (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 2))).eval x + (d - 2) * (x : ℚ) ^ (d - 3), by ring,
    have h13 : (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 2))).eval x = (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 2))).eval x + (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 3))).eval x, by ring,
    have h14 : (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 3))).eval x = (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 3))).eval x + (d - 3) * (x : ℚ) ^ (d - 4), by ring,
    have h15 : (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 3))).eval x = (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 3))).eval x + (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 4))).eval x, by ring,
    have h16 : (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d - 4))).eval x = (sum (λ k, (x : ℚ) ^ (d - k - 1)) (range (0, d
end --Needs more than 2000 tokens!

--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
  have h0 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C 1).pow (-k), from by auto [pow_add, sum_mul_distrib_left, pow_neg, pow_zero],
  have h1 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto,
  have h2 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h3 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h4 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],

  have h5 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h6 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h7 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h8 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],

  have h9 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h10 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],

  have h11 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h12 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h13 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h14 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h15 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h16 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h17 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],

  have h18 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h19 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).pow l = ∑ k in finset.range (l + 1), (l + 1) * (polynomial.C 1).pow k * (polynomial.C (1 : ℚ)).pow (-k), from by auto [polynomial.pow_C, one_pow],
  have h20 : ∀ l : ℕ, (l + 1) * (polynomial.C 1).
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
  induction n with d hd,
  {
    show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x ^ (0 - 1),
    from by auto [polynomial.bernoulli, polynomial.eval_add, polynomial.eval_C, polynomial.eval_X, polynomial.eval_mul, polynomial.eval_one, polynomial.bernoulli_zero]
  },
  {
    have h1 : (polynomial.bernoulli d).eval (1 + x) = (polynomial.bernoulli d).eval x + d * x ^ (d - 1), from by auto [hd],
    have h2 : ((polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1)) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x ^ (d - 1) * (d + 1), from by auto [add_mul],
    have h3 : ((polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1)) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + d * x ^ d * (d + 1), from by auto [mul_comm, pow_succ'],
    have h4 : ((polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1)) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + (polynomial.bernoulli d).eval x * (d + 1), from by auto [h1, h2, h3],
    have h5 : ((polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1)) * (d + 1) = (polynomial.bernoulli d).eval x * (d + 1) + (polynomial.bernoulli d).eval x * (d + 1), from by auto [mul_add],
    have h6 : (((polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1)) * (d + 1) - (polynomial.bernoulli d).eval x * (d + 1) - (polynomial.bernoulli d).eval x * (d + 1)) = 0, from by auto [h4, h5, sub_eq_zero],
    have h7 : (((polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1)) * (d + 1) - (polynomial.bernoulli d).eval x * (d + 1) - (polynomial.bernoulli d).eval x * (d + 1)) = (polynomial.bernoulli d).eval x * (d + 1) - (polynomial.bernoulli d).eval x * (d + 1), from by auto [add_sub_cancel'],
    have h8 : (((polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1)) * (d + 1) - (polynomial.bernoulli d).eval x * (d + 1) - (polynomial.bernoulli d).eval x * (d + 1)) = ((polynomial.bernoulli d).eval x - (polynomial.bernoulli d).eval x) * (d + 1), from by auto [h7, sub_eq_zero],
    have h9 : (((polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1)) * (d + 1) - (polynomial.bernoulli d).eval x * (d + 1) - (polynomial.bernoulli d).eval x * (d + 1)) = 0, from by auto [h6, h7, h8, mul_zero],

    have h10 : (polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1) = (polynomial.bernoulli d).eval x * (d + 1) / (d + 1), from by auto [h9, div_eq_zero, eq_zero_of_mul_self_eq_zero],
    have h11 : (polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1) = (polynomial.bernoulli d).eval x, from by auto [h10, div_one],
    have h12 : (polynomial.bernoulli d).eval (1 + x) + d * x ^ (d - 1) = (polynomial.bernoulli d).eval x + d * x ^ (d - 1), from by auto [h1, h11, eq.symm],
    show (polynomial.bernoulli (d + 1)).eval (1 + x) = (polynomial.bernoulli (d + 1)).eval x + (d + 1) * x ^ (d + 1 - 1), from by auto [h12, polynomial.bernoulli]
  }
end

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

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

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

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

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

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

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from 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)-/


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p : ℕ) (x : ℕ) (h : nat.coprime x p) : (x : ℤ_[p]) ∈ units ℤ_[p] :=
begin
  -- prove the contrapositive
  have h1 : ¬ (x : ℤ_[p]) ∈ units ℤ_[p] → ¬ nat.coprime x p, from by {
    assume h2 : ¬ (x : ℤ_[p]) ∈ units ℤ_[p],
    assume h3 : nat.coprime x p,
    have h4 : (x : ℤ_[p]) ∈ units ℤ_[p], from by {
      have h5 : (x : ℤ_[p]) ≠ 0, from by {
        assume h6 : (x : ℤ_[p]) = 0,
        have h7 : x = 0, from by {
          rw ← h6,
          rw ← int.coe_nat_zero,
        },
        have h8 : x ∣ p, from by {
          rw h7,
          apply nat.dvd_zero,
        },
        have h9 : ¬ nat.coprime x p, from by {
          apply nat.not_coprime_of_dvd_of_dvd h8 (nat.dvd_refl p),
        },
        show false, from by {
          rw h9 at h3,
          exact h3,
        },
      },
      have h5 : (x : ℤ_[p]) ≠ 0, from by {
        assume h6 : (x : ℤ_[p]) = 0,
        have h7 : x = 0, from by {
          rw ← h6,
          rw ← int.coe_nat_zero,
        },
        have h8 : x ∣ p, from by {
          rw h7,
          apply nat.dvd_zero,
        },
        have h9 : ¬ nat.coprime x p, from by {
          apply nat.not_coprime_of_dvd_of_dvd h8 (nat.dvd_refl p),
        },
        show false, from by {
          rw h9 at h3,
          exact h3,
        },
      },
      have h6 : (x : ℤ_[p]) ≠ 0, from by {
        assume h7 : (x : ℤ_[p]) = 0,
        have h8 : x = 0, from by {
          rw ← h7,
          rw ← int.coe_nat_zero,
        },
        have h9 : x ∣ p, from by {
          rw h8,
          apply nat.dvd_zero,
        },
        have h10 : ¬ nat.coprime x p, from by {
          apply nat.not_coprime_of_dvd_of_dvd h9 (nat.dvd_refl p),
        },
        show false, from by {
          rw h10 at h3,
          exact h3,
        },
      },
      have h7 : (x : ℤ_[p]) ≠ 0, from by {
        assume h8 : (x : ℤ_[p]) = 0,
        have h9 : x = 0, from by {
          rw ← h8,
          rw ← int.coe_nat_zero,
        },
        have h10 : x ∣ p, from by {
          rw h9,
          apply nat.dvd_zero,
        },
        have h11 : ¬ nat.coprime x p, from by {
          apply nat.not_coprime_of_dvd_of_dvd h10 (nat.dvd_refl p),
        },
        show false, from by {
          rw h11 at h3,
          exact h3,
        },
      },
      have h8 : (x : ℤ_[p]) ≠ 0, from by {
        assume h9 : (x : ℤ_[p]) = 0,
        have h10 : x = 0, from by {
          rw ← h9,
          rw ← int.coe_nat_zero,
        },
        have h11 : x ∣ p, from by {
          rw h10,
          apply nat.dvd_zero,
        },
        have h12 : ¬ nat.coprime x p, from by {
          apply nat.not_coprime_of_dvd_of_dvd h11 (nat.dvd_refl p),
        },
        show false, from by {
          rw h12 at h3,
          exact h3,
        },
      },
      have h9 : (x : ℤ_[p]) ≠ 0, from by {
        assume h10 : (x : ℤ_[p]) = 0,
        have h11 : x = 0, from by {
          rw ← h10,
          rw ← int.coe_nat_zero,
        },
        have h12 : x ∣ p, from by {
          rw h11,
          apply nat.dvd_zero,
        },
        have h13 : ¬ nat.coprime x p, from by {
          apply nat.not_coprime_of_dvd_of_dvd h12 (nat.dvd_refl p),
        },
        show false, from by {
          rw h13 at h3,
          exact h3,
        },
      },
      have h10 : (x : ℤ_[p]) ≠ 0, from by {
        assume h11 : (x : ℤ_[p]) = 0,
        have h12 : x = 0, from by {
          rw ← h11,
          rw ← int.coe_nat_zero,
        },
        have h13 : x ∣ p, from by {
          rw h12,
          apply nat.dvd_zero,
        },
        have h14 : ¬ nat.coprime x p, from by {
          apply nat.not_coprime_of_dvd_of_dvd h13 (nat.dvd_refl p),
        },
        show false, from by {
          rw h14 at h3,
          exact h3,
        },
      },
      have h11 : (x : ℤ_[p]) ≠ 0, from by {
        assume h12 : (x : ℤ_[p]) = 0,
        have h13 : x = 0, from by {
          rw ← h12,
          rw ← int.coe_nat_zero,
        },
        have h14 : x ∣ p, from by {
          rw h13,
          apply nat.dvd_zero,
        },
        have h15 : ¬ nat.coprime x p, from by {
          apply nat.not_coprime_of_dvd_of_dvd h14 (nat.dvd_refl p),
        },
        show false, from by {
          rw h15 at h3,
          exact h3,
        },
      },
      have h12 : (x : ℤ_[p]) ≠ 0, from by {
        assume h13 : (x : ℤ_[p]) = 0,
        have h14 : x = 0, from by {
          rw ← h13,
          rw ← int.coe_nat_zero,
        },
        have h15 : x ∣ p, from by {
          rw h14,
          apply nat.dvd_zero,
        },
        have h16 : ¬ nat.coprime x p, from by {
          apply nat.not_coprime_of_dvd_of_dvd h15 (nat.dvd_refl p),
        },
        show false, from by {
          rw h16 at h3,
          exact h3,
        },
      },
      have h13 : (x : ℤ_[p]) ≠ 0, from by {
        assume h14 : (x : ℤ
end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.simp_result
import Mathlib.tactic.clear
import Mathlib.control.equiv_functor.instances
import Mathlib.PostPort

namespace Mathlib

/-!
# The `equiv_rw` tactic transports goals or hypotheses along equivalences.

The basic syntax is `equiv_rw e`, where `e : α ≃ β` is an equivalence.
This will try to replace occurrences of `α` in the goal with `β`, for example
transforming
* `⊢ α` to `⊢ β`,
* `⊢ option α` to `⊢ option β`
* `⊢ {a // P}` to `{b // P (⇑(equiv.symm e) b)}`

The tactic can also be used to rewrite hypotheses, using the syntax `equiv_rw e at h`.

## Implementation details

The main internal function is `equiv_rw_type e t`,
which attempts to turn an expression `e : α ≃ β` into a new equivalence with left hand side `t`.
As an example, with `t = option α`, it will generate `functor.map_equiv option e`.

This is achieved by generating a new synthetic goal `%%t ≃ _`,
and calling `solve_by_elim` with an appropriate set of congruence lemmas.
To avoid having to specify the relevant congruence lemmas by hand,
we mostly rely on `equiv_functor.map_equiv` and `bifunctor.map_equiv`
along with some structural congruence lemmas such as
* `equiv.arrow_congr'`,
* `equiv.subtype_equiv_of_subtype'`,
* `equiv.sigma_congr_left'`, and
* `equiv.Pi_congr_left'`.

The main `equiv_rw` function, when operating on the goal, simply generates a new equivalence `e'`
with left hand side matching the target, and calls `apply e'.inv_fun`.

When operating on a hypothesis `x : α`, we introduce a new fact `h : x = e.symm (e x)`,
revert this, and then attempt to `generalize`, replacing all occurrences of `e x` with a new constant `y`,
before `intro`ing and `subst`ing `h`, and renaming `y` back to `x`.

## Future improvements
In a future PR I anticipate that `derive equiv_functor` should work on many examples,
(internally using `transport`, which is in turn based on `equiv_rw`)
and we can incrementally bootstrap the strength of `equiv_rw`.

An ambitious project might be to add `equiv_rw!`,
a tactic which, when failing to find appropriate `equiv_functor` instances,
attempts to `derive` them on the spot.

For now `equiv_rw` is entirely based on `equiv`,
but the framework can readily be generalised to also work with other types of equivalences,
for example specific notations such as ring equivalence (`≃+*`),
or general categorical isomorphisms (`≅`).

This will allow us to transport across more general types of equivalences,
but this will wait for another subsequent PR.
-/

namespace tactic

/-- A list of lemmas used for constructing congruence equivalences. -/
-- Although this looks 'hard-coded', in fact the lemma `equiv_functor.map_equiv`

-- allows us to extend `equiv_rw` simply by constructing new instance so `equiv_functor`.

-- TODO: We should also use `category_theory.functorial` and `category_theory.hygienic` instances.

-- (example goal: we could rewrite along an isomorphism of rings (either as `R ≅ S` or `R ≃+* S`)

-- and turn an `x : mv_polynomial σ R` into an `x : mv_polynomial σ S`.).

/--
Configuration structure for `equiv_rw`.

* `max_depth` bounds the search depth for equivalences to rewrite along.
  The default value is 10.
  (e.g., if you're rewriting along `e : α ≃ β`, and `max_depth := 2`,
  you can rewrite `option (option α))` but not `option (option (option α))`.
-/
/--
Implementation of `equiv_rw_type`, using `solve_by_elim`.
Expects a goal of the form `t ≃ _`,
and tries to solve it using `eq : α ≃ β` and congruence lemmas.
-/
/--
`equiv_rw_type e t` rewrites the type `t` using the equivalence `e : α ≃ β`,
returning a new equivalence `t ≃ t'`.
-/
/--
Attempt to replace the hypothesis with name `x`
by transporting it along the equivalence in `e : α ≃ β`.
-/
-- We call `dsimp_result` to perform the beta redex introduced by `revert`

/-- Rewrite the goal using an equiv `e`. -/
end tactic

namespace tactic.interactive

/--
`equiv_rw e at h`, where `h : α` is a hypothesis, and `e : α ≃ β`,
will attempt to transport `h` along `e`, producing a new hypothesis `h : β`,
with all occurrences of `h` in other hypotheses and the goal replaced with `e.symm h`.

`equiv_rw e` will attempt to transport the goal along an equivalence `e : α ≃ β`.
In its minimal form it replaces the goal `⊢ α` with `⊢ β` by calling `apply e.inv_fun`.

`equiv_rw` will also try rewriting under (equiv_)functors, so can turn
a hypothesis `h : list α` into `h : list β` or
a goal `⊢ unique α` into `⊢ unique β`.

The maximum search depth for rewriting in subexpressions is controlled by
`equiv_rw e {max_depth := n}`.
-/
/--
Solve a goal of the form `t ≃ _`,
by constructing an equivalence from `e : α ≃ β`.
This is the same equivalence that `equiv_rw` would use to rewrite a term of type `t`.

A typical usage might be:
```
have e' : option α ≃ option β := by equiv_rw_type e
```
-/


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module logic.nonempty
! leanprover-community/mathlib commit d2d8742b0c21426362a9dacebc6005db895ca963
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Basic

/-!
# Nonempty types

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

This file proves a few extra facts about `nonempty`, which is defined in core Lean.

## Main declarations

* `nonempty.some`: Extracts a witness of nonemptiness using choice. Takes `nonempty α` explicitly.
* `classical.arbitrary`: Extracts a witness of nonemptiness using choice. Takes `nonempty α` as an
  instance.
-/

variable {α β : Type _} {γ : α → Type _}

attribute [simp] instNonempty

#print Zero.nonempty /-
instance (priority := 20) Zero.nonempty [Zero α] : Nonempty α :=
  ⟨0⟩
#align has_zero.nonempty Zero.nonempty
-/

#print One.nonempty /-
instance (priority := 20) One.nonempty [One α] : Nonempty α :=
  ⟨1⟩
#align has_one.nonempty One.nonempty
-/

#print exists_true_iff_nonempty /-
theorem exists_true_iff_nonempty {α : Sort _} : (∃ a : α, True) ↔ Nonempty α :=
  Iff.intro (fun ⟨a, _⟩ => ⟨a⟩) fun ⟨a⟩ => ⟨a, trivial⟩
#align exists_true_iff_nonempty exists_true_iff_nonempty
-/

#print nonempty_Prop /-
@[simp]
theorem nonempty_Prop {p : Prop} : Nonempty p ↔ p :=
  Iff.intro (fun ⟨h⟩ => h) fun h => ⟨h⟩
#align nonempty_Prop nonempty_Prop
-/

#print not_nonempty_iff_imp_false /-
theorem not_nonempty_iff_imp_false {α : Sort _} : ¬Nonempty α ↔ α → False :=
  ⟨fun h a => h ⟨a⟩, fun h ⟨a⟩ => h a⟩
#align not_nonempty_iff_imp_false not_nonempty_iff_imp_false
-/

#print nonempty_sigma /-
@[simp]
theorem nonempty_sigma : Nonempty (Σa : α, γ a) ↔ ∃ a : α, Nonempty (γ a) :=
  Iff.intro (fun ⟨⟨a, c⟩⟩ => ⟨a, ⟨c⟩⟩) fun ⟨a, ⟨c⟩⟩ => ⟨⟨a, c⟩⟩
#align nonempty_sigma nonempty_sigma
-/

/- warning: nonempty_psigma -> nonempty_psigma is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : α -> Sort.{u2}}, Iff (Nonempty.{max 1 u1 u2} (PSigma.{u1, u2} α β)) (Exists.{u1} α (fun (a : α) => Nonempty.{u2} (β a)))
but is expected to have type
  forall {α : Sort.{u2}} {β : α -> Sort.{u1}}, Iff (Nonempty.{max (max 1 u1) u2} (PSigma.{u2, u1} α β)) (Exists.{u2} α (fun (a : α) => Nonempty.{u1} (β a)))
Case conversion may be inaccurate. Consider using '#align nonempty_psigma nonempty_psigmaₓ'. -/
@[simp]
theorem nonempty_psigma {α} {β : α → Sort _} : Nonempty (PSigma β) ↔ ∃ a : α, Nonempty (β a) :=
  Iff.intro (fun ⟨⟨a, c⟩⟩ => ⟨a, ⟨c⟩⟩) fun ⟨a, ⟨c⟩⟩ => ⟨⟨a, c⟩⟩
#align nonempty_psigma nonempty_psigma

#print nonempty_subtype /-
@[simp]
theorem nonempty_subtype {α} {p : α → Prop} : Nonempty (Subtype p) ↔ ∃ a : α, p a :=
  Iff.intro (fun ⟨⟨a, h⟩⟩ => ⟨a, h⟩) fun ⟨a, h⟩ => ⟨⟨a, h⟩⟩
#align nonempty_subtype nonempty_subtype
-/

#print nonempty_prod /-
@[simp]
theorem nonempty_prod : Nonempty (α × β) ↔ Nonempty α ∧ Nonempty β :=
  Iff.intro (fun ⟨⟨a, b⟩⟩ => ⟨⟨a⟩, ⟨b⟩⟩) fun ⟨⟨a⟩, ⟨b⟩⟩ => ⟨⟨a, b⟩⟩
#align nonempty_prod nonempty_prod
-/

/- warning: nonempty_pprod -> nonempty_pprod is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}}, Iff (Nonempty.{max 1 u1 u2} (PProd.{u1, u2} α β)) (And (Nonempty.{u1} α) (Nonempty.{u2} β))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}}, Iff (Nonempty.{max (max 1 u1) u2} (PProd.{u2, u1} α β)) (And (Nonempty.{u2} α) (Nonempty.{u1} β))
Case conversion may be inaccurate. Consider using '#align nonempty_pprod nonempty_pprodₓ'. -/
@[simp]
theorem nonempty_pprod {α β} : Nonempty (PProd α β) ↔ Nonempty α ∧ Nonempty β :=
  Iff.intro (fun ⟨⟨a, b⟩⟩ => ⟨⟨a⟩, ⟨b⟩⟩) fun ⟨⟨a⟩, ⟨b⟩⟩ => ⟨⟨a, b⟩⟩
#align nonempty_pprod nonempty_pprod

#print nonempty_sum /-
@[simp]
theorem nonempty_sum : Nonempty (Sum α β) ↔ Nonempty α ∨ Nonempty β :=
  Iff.intro
    (fun ⟨h⟩ =>
      match h with
      | Sum.inl a => Or.inl ⟨a⟩
      | Sum.inr b => Or.inr ⟨b⟩)
    fun h =>
    match h with
    | Or.inl ⟨a⟩ => ⟨Sum.inl a⟩
    | Or.inr ⟨b⟩ => ⟨Sum.inr b⟩
#align nonempty_sum nonempty_sum
-/

/- warning: nonempty_psum -> nonempty_psum is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}}, Iff (Nonempty.{max 1 u1 u2} (PSum.{u1, u2} α β)) (Or (Nonempty.{u1} α) (Nonempty.{u2} β))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}}, Iff (Nonempty.{max (max 1 u1) u2} (PSum.{u2, u1} α β)) (Or (Nonempty.{u2} α) (Nonempty.{u1} β))
Case conversion may be inaccurate. Consider using '#align nonempty_psum nonempty_psumₓ'. -/
@[simp]
theorem nonempty_psum {α β} : Nonempty (PSum α β) ↔ Nonempty α ∨ Nonempty β :=
  Iff.intro
    (fun ⟨h⟩ =>
      match h with
      | PSum.inl a => Or.inl ⟨a⟩
      | PSum.inr b => Or.inr ⟨b⟩)
    fun h =>
    match h with
    | Or.inl ⟨a⟩ => ⟨PSum.inl a⟩
    | Or.inr ⟨b⟩ => ⟨PSum.inr b⟩
#align nonempty_psum nonempty_psum

@[simp]
theorem nonempty_empty : ¬Nonempty Empty := fun ⟨h⟩ => h.elim
#align nonempty_empty nonempty_empty

/- warning: nonempty_ulift -> nonempty_ulift is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, Iff (Nonempty.{succ (max u1 u2)} (ULift.{u2, u1} α)) (Nonempty.{succ u1} α)
but is expected to have type
  forall {α : Type.{u2}}, Iff (Nonempty.{max (succ u2) (succ u1)} (ULift.{u1, u2} α)) (Nonempty.{succ u2} α)
Case conversion may be inaccurate. Consider using '#align nonempty_ulift nonempty_uliftₓ'. -/
@[simp]
theorem nonempty_ulift : Nonempty (ULift α) ↔ Nonempty α :=
  Iff.intro (fun ⟨⟨a⟩⟩ => ⟨a⟩) fun ⟨a⟩ => ⟨⟨a⟩⟩
#align nonempty_ulift nonempty_ulift

#print nonempty_plift /-
@[simp]
theorem nonempty_plift {α} : Nonempty (PLift α) ↔ Nonempty α :=
  Iff.intro (fun ⟨⟨a⟩⟩ => ⟨a⟩) fun ⟨a⟩ => ⟨⟨a⟩⟩
#align nonempty_plift nonempty_plift
-/

#print Nonempty.forall /-
@[simp]
theorem Nonempty.forall {α} {p : Nonempty α → Prop} : (∀ h : Nonempty α, p h) ↔ ∀ a, p ⟨a⟩ :=
  Iff.intro (fun h a => h _) fun h ⟨a⟩ => h _
#align nonempty.forall Nonempty.forall
-/

#print Nonempty.exists /-
@[simp]
theorem Nonempty.exists {α} {p : Nonempty α → Prop} : (∃ h : Nonempty α, p h) ↔ ∃ a, p ⟨a⟩ :=
  Iff.intro (fun ⟨⟨a⟩, h⟩ => ⟨a, h⟩) fun ⟨a, h⟩ => ⟨⟨a⟩, h⟩
#align nonempty.exists Nonempty.exists
-/

#print Classical.inhabited_of_nonempty' /-
/-- Using `classical.choice`, lifts a (`Prop`-valued) `nonempty` instance to a (`Type`-valued)
  `inhabited` instance. `classical.inhabited_of_nonempty` already exists, in
  `core/init/classical.lean`, but the assumption is not a type class argument,
  which makes it unsuitable for some applications. -/
noncomputable def Classical.inhabited_of_nonempty' {α} [h : Nonempty α] : Inhabited α :=
  ⟨Classical.choice h⟩
#align classical.inhabited_of_nonempty' Classical.inhabited_of_nonempty'
-/

#print Nonempty.some /-
/-- Using `classical.choice`, extracts a term from a `nonempty` type. -/
@[reducible]
protected noncomputable def Nonempty.some {α} (h : Nonempty α) : α :=
  Classical.choice h
#align nonempty.some Nonempty.some
-/

#print Classical.arbitrary /-
/-- Using `classical.choice`, extracts a term from a `nonempty` type. -/
@[reducible]
protected noncomputable def Classical.arbitrary (α) [h : Nonempty α] : α :=
  Classical.choice h
#align classical.arbitrary Classical.arbitrary
-/

/- warning: nonempty.map -> Nonempty.map is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}}, (α -> β) -> (Nonempty.{u1} α) -> (Nonempty.{u2} β)
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}}, (α -> β) -> (Nonempty.{u2} α) -> (Nonempty.{u1} β)
Case conversion may be inaccurate. Consider using '#align nonempty.map Nonempty.mapₓ'. -/
/-- Given `f : α → β`, if `α` is nonempty then `β` is also nonempty.
  `nonempty` cannot be a `functor`, because `functor` is restricted to `Type`. -/
theorem Nonempty.map {α β} (f : α → β) : Nonempty α → Nonempty β
  | ⟨h⟩ => ⟨f h⟩
#align nonempty.map Nonempty.map

/- warning: nonempty.map2 -> Nonempty.map2 is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} {γ : Sort.{u3}}, (α -> β -> γ) -> (Nonempty.{u1} α) -> (Nonempty.{u2} β) -> (Nonempty.{u3} γ)
but is expected to have type
  forall {α : Sort.{u3}} {β : Sort.{u2}} {γ : Sort.{u1}}, (α -> β -> γ) -> (Nonempty.{u3} α) -> (Nonempty.{u2} β) -> (Nonempty.{u1} γ)
Case conversion may be inaccurate. Consider using '#align nonempty.map2 Nonempty.map2ₓ'. -/
protected theorem Nonempty.map2 {α β γ : Sort _} (f : α → β → γ) :
    Nonempty α → Nonempty β → Nonempty γ
  | ⟨x⟩, ⟨y⟩ => ⟨f x y⟩
#align nonempty.map2 Nonempty.map2

/- warning: nonempty.congr -> Nonempty.congr is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}}, (α -> β) -> (β -> α) -> (Iff (Nonempty.{u1} α) (Nonempty.{u2} β))
but is expected to have type
  forall {α : Sort.{u2}} {β : Sort.{u1}}, (α -> β) -> (β -> α) -> (Iff (Nonempty.{u2} α) (Nonempty.{u1} β))
Case conversion may be inaccurate. Consider using '#align nonempty.congr Nonempty.congrₓ'. -/
protected theorem Nonempty.congr {α β} (f : α → β) (g : β → α) : Nonempty α ↔ Nonempty β :=
  ⟨Nonempty.map f, Nonempty.map g⟩
#align nonempty.congr Nonempty.congr

#print Nonempty.elim_to_inhabited /-
theorem Nonempty.elim_to_inhabited {α : Sort _} [h : Nonempty α] {p : Prop} (f : Inhabited α → p) :
    p :=
  h.elim <| f ∘ Inhabited.mk
#align nonempty.elim_to_inhabited Nonempty.elim_to_inhabited
-/

instance {α β} [h : Nonempty α] [h2 : Nonempty β] : Nonempty (α × β) :=
  h.elim fun g => h2.elim fun g2 => ⟨⟨g, g2⟩⟩

instance {ι : Sort _} {α : ι → Sort _} [∀ i, Nonempty (α i)] : Nonempty (∀ i, α i) :=
  ⟨fun _ => Classical.arbitrary _⟩

/- warning: classical.nonempty_pi -> Classical.nonempty_pi is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {α : ι -> Sort.{u2}}, Iff (Nonempty.{imax u1 u2} (forall (i : ι), α i)) (forall (i : ι), Nonempty.{u2} (α i))
but is expected to have type
  forall {ι : Sort.{u2}} {α : ι -> Sort.{u1}}, Iff (Nonempty.{imax u2 u1} (forall (i : ι), α i)) (forall (i : ι), Nonempty.{u1} (α i))
Case conversion may be inaccurate. Consider using '#align classical.nonempty_pi Classical.nonempty_piₓ'. -/
theorem Classical.nonempty_pi {ι} {α : ι → Sort _} : Nonempty (∀ i, α i) ↔ ∀ i, Nonempty (α i) :=
  ⟨fun ⟨f⟩ a => ⟨f a⟩, @Pi.nonempty _ _⟩
#align classical.nonempty_pi Classical.nonempty_pi

#print subsingleton_of_not_nonempty /-
theorem subsingleton_of_not_nonempty {α : Sort _} (h : ¬Nonempty α) : Subsingleton α :=
  ⟨fun x => False.elim <| not_nonempty_iff_imp_false.mp h x⟩
#align subsingleton_of_not_nonempty subsingleton_of_not_nonempty
-/

#print Function.Surjective.nonempty /-
theorem Function.Surjective.nonempty {α β : Sort _} [h : Nonempty β] {f : α → β}
    (hf : Function.Surjective f) : Nonempty α :=
  let ⟨y⟩ := h
  let ⟨x, hx⟩ := hf y
  ⟨x⟩
#align function.surjective.nonempty Function.Surjective.nonempty
-/


import tactic.interactive
import init.meta.interaction_monad
import data.real.basic

open tactic

-- Find the maximum element of a list of ℕ. Used to work out at what point
-- we don't need to traverse the targets list any further.
def find_max : list ℕ → ℕ → ℕ
| [] so_far := so_far
| (h :: tl) so_far := if h > so_far then find_max tl h else find_max tl so_far

-- Given a list of ℕ (the 'targets'), return the goals corresponding
-- to these indices. Indexed from 1 (not 0).
meta def find_wanted_goals : list ℕ → ℕ → ℕ → list expr → tactic (list expr)
| tgts crnt max gls := if crnt > max then return []
                                     else match gls with
                                     | [] := fail "No such goals!"
                                     | (g::gs) := if crnt ∈ tgts then
                                                  do out ← find_wanted_goals tgts (crnt+1) max gs,
                                                     return ([g]++out)
                                                     else do out ← find_wanted_goals tgts (crnt+1) max gs,
                                                             return out
                                     end

-- A wrapper for find_wanted_goals. Only needs to be given the targets.
meta def find_goals : list ℕ → tactic unit
| tgts := do let max := find_max tgts 0,
             gls ← get_goals,
             found_goals ← find_wanted_goals tgts 1 max gls,
             set_goals (found_goals)

meta def set_tactic_state (new_state : tactic_state) : tactic unit := λ s, (do skip new_state)

meta def get_tactic_state : tactic tactic_state := λ s, interaction_monad.result.success s s

-- focus_goals as described in the assignment specifications
-- The tactic can be invoked using the syntax requested
-- After focus_goals has been run, we restore the other goals. However,
-- Some of these might have been solved as a consequence of what was solved inside
-- the given goal block. For example, proving commutativity of addition will also
-- tell Lean the definition of addition we are using. This is unavoidable.
meta def tactic.interactive.focus_goals (pe : interactive.parse lean.parser.pexpr) (t : tactic.interactive.itactic) : tactic unit :=
do s ← get_tactic_state,
   s' ← get_goals,
   e ← to_expr pe,
   tgts ← eval_expr (list ℕ) e,
   find_goals tgts,
   s'' ← get_goals,
   let s''' := list.diff s' s'',
   t,
   gls ← get_goals,
   if gls ≠ [] then do set_tactic_state s, fail "Failed to discharge the goals!" else
   set_goals s'''

section focus_goals_examples

-- Example of failing when there are no such goals.
example : ring ℝ :=
begin
   constructor,
   success_if_fail {focus_goals [1,2,16] {simp}}, -- Error message "No such goals!"
   exact neg_add_self,
   exact add_comm,
   exact one_mul,
   exact mul_one,
   exact left_distrib,
   exact right_distrib,
end

-- Example of succeeding and restoring other goals.
example (p q : Prop) : ¬ (p ∧ q) ↔ ¬ p ∨ ¬ q :=
begin
   constructor,
   focus_goals [1] {exact classical.not_and_distrib.mp},
   exact not_and_of_not_or_not,
end

-- Example of discharging some goals but not others and therefore failing.
example : true ∧ (true ∨ false) :=
begin
   split,
   success_if_fail {focus_goals [1,2] {repeat {trivial}}}, -- Failed with error message "Failed to discharge the goals!"
   trivial,
   constructor,
   trivial,
end

-- Example of focus_goals succeeding
example : true ∧ true :=
begin
   split,
   focus_goals [1,2] {repeat {trivial}},
end

end focus_goals_examples

-- work_on_goals as described in the assignment specifications
meta def tactic.interactive.work_on_goals (pe : interactive.parse lean.parser.pexpr) (t : tactic.interactive.itactic) : tactic unit :=
do s ← get_tactic_state,
   s' ← get_goals,
   e ← to_expr pe,
   tgts ← eval_expr (list ℕ) e,
   find_goals tgts,
   s'' ← get_goals,
   let s''' := list.diff s' s'',
   t,
   gls ← get_goals,
   do set_goals (gls ++ s''')

section work_on_goals_examples

open real

-- Example of solving some goals and then prepending these to the remaining goals.
example : ring ℝ :=
begin
   constructor,
   work_on_goals [1, 3, 5, 11] {exact neg_add_self,
                                exact one_mul},
   exact left_distrib,
   exact add_comm,
   exact mul_one,
   exact right_distrib,
end

end work_on_goals_examples


import .love08_operational_semantics_demo

/-! # LoVe Demo 9: Hoare Logic

We review a second way to specify the semantics of a programming language: Hoare
logic. If operational semantics corresponds to an idealized interpreter,
__Hoare logic__ (also called __axiomatic semantics__) corresponds to a verifier.
Hoare logic is particularly convenient to reason about concrete programs. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## First Things First: Formalization Projects

Instead of two of the homework sheets, you can do a verification project, worth
20 points. If you choose to do so, please send your lecturer a message by email
by the end of the week. For a fully successful project, we expect about 200 (or
more) lines of Lean, including definitions and proofs.

Some ideas for projects follow.

Computer science:

* extended WHILE language with static arrays or other features;
* functional data structures (e.g., balanced trees);
* functional algorithms (e.g., bubble sort, merge sort, Tarjan's algorithm);
* compiler from expressions or imperative programs to, e.g., stack machine;
* type systems (e.g., Benjamin Pierce's __Types and Programming Languages__);
* security properties (e.g., Volpano–Smith-style noninterference analysis);
* theory of first-order terms, including matching, term rewriting;
* automata theory;
* normalization of context-free grammars or regular expressions;
* process algebras and bisimilarity;
* soundness and possibly completeness of proof systems (e.g., Genzen's sequent
  calculus, natural deduction, tableaux);
* separation logic;
* verified program using Hoare logic.

Mathematics:

* graphs;
* combinatorics;
* number theory.

Metaprogramming:

* custom tactic;
* custom diagnosis tool.

Past evaluation:

Q: How did you find the project?

A: Enjoyable.

A: Fun and hard.

A: Good, I think the format was excellent in a way that it gave people the
   chance to do challenging exercises and hand them in incomplete.

A: I really really liked it. I think it's a great way of learning—find
   something you like, dig in it a little, get stuck, ask for help. I wish I
   could do more of that!

A: It was great to have some time to try to work out some stuff you find
   interesting yourself.

A: lots of fun actually!!!

A: Very helpful. It gave the opportunity to spend some more time on a
   particular aspect of the course.

## Hoare Triples

The basic judgments of Hoare logic are often called __Hoare triples__. They have
the form

    `{P} S {Q}`

where `S` is a statement, and `P` and `Q` (called __precondition__ and
__postcondition__) are logical formulas over the state variables.

Intended meaning:

    If `P` holds before `S` is executed and the execution terminates normally,
    `Q` holds at termination.

This is a __partial correctness__ statement: The program is correct if it
terminates normally (i.e., no run-time error, no infinite loop or divergence).

All of these Hoare triples are valid (with respect to the intended meaning):

    `{true} b := 4 {b = 4}`
    `{a = 2} b := 2 * a {a = 2 ∧ b = 4}`
    `{b ≥ 5} b := b + 1 {b ≥ 6}`
    `{false} skip {b = 100}`
    `{true} while i ≠ 100 do i := i + 1 {i = 100}`

## Hoare Rules

The following is a complete set of rules for reasoning about WHILE programs:

    ———————————— Skip
    {P} skip {P}

    ——————————————————— Asn
    {Q[a/x]} x := a {Q}

    {P} S {R}   {R} S' {Q}
    —————————————————————— Seq
    {P} S; S' {Q}

    {P ∧ b} S {Q}   {P ∧ ¬b} S' {Q}
    ——————————————————————————————— If
    {P} if b then S else S' {Q}

    {I ∧ b} S {I}
    ————————————————————————— While
    {I} while b do S {I ∧ ¬b}

    P' → P   {P} S {Q}   Q → Q'
    ——————————————————————————— Conseq
    {P'} S {Q'}

`Q[a/x]` denotes `Q` with `x` replaced by `a`.

In the `While` rule, `I` is called an __invariant__.

Except for `Conseq`, the rules are syntax-driven: by looking at a program, we
see immediately which rule to apply.

Example derivations:

    —————————————————————— Asn   —————————————————————— Asn
    {a = 2} b := a {b = 2}       {b = 2} c := b {c = 2}
    ——————————————————————————————————————————————————— Seq
    {a = 2} b := a; c := b {c = 2}

                     —————————————————————— Asn
    x > 10 → x > 5   {x > 5} y := x {y > 5}   y > 5 → y > 0
    ——————————————————————————————————————————————————————— Conseq
    {x > 10} y := x {y > 0}

Various __derived rules__ can be proved to be correct in terms of the standard
rules. For example, we can derive bidirectional rules for `skip`, `:=`, and
`while`:

    P → Q
    ———————————— Skip'
    {P} skip {Q}

    P → Q[a/x]
    —————————————— Asn'
    {P} x := a {Q}

    {P ∧ b} S {P}   P ∧ ¬b → Q
    —————————————————————————— While'
    {P} while b do S {Q}

## A Semantic Approach to Hoare Logic

We can, and will, define Hoare triples **semantically** in Lean.

We will use predicates on states (`state → Prop`) to represent pre- and
postconditions, following the shallow embedding style. -/

def partial_hoare (P : state → Prop) (S : stmt)
  (Q : state → Prop) : Prop :=
∀s t, P s → (S, s) ⟹ t → Q t

notation `{* ` P : 1 ` *} ` S : 1 ` {* ` Q : 1 ` *}` :=
partial_hoare P S Q

namespace partial_hoare

lemma skip_intro {P} :
  {* P *} stmt.skip {* P *} :=
begin
  intros s t hs hst,
  cases' hst,
  assumption
end

lemma assign_intro (P : state → Prop) {x} {a : state → ℕ} :
  {* λs, P (s{x ↦ a s}) *} stmt.assign x a {* P *} :=
begin
  intros s t P hst,
  cases' hst,
  assumption
end

lemma seq_intro {P Q R S T} (hS : {* P *} S {* Q *})
    (hT : {* Q *} T {* R *}) :
  {* P *} S ;; T {* R *} :=
begin
  intros s t hs hst,
  cases' hst,
  apply hT,
  { apply hS,
    { exact hs },
    { assumption } },
  { assumption }
end

lemma ite_intro {b P Q : state → Prop} {S T}
    (hS : {* λs, P s ∧ b s *} S {* Q *})
    (hT : {* λs, P s ∧ ¬ b s *} T {* Q *}) :
  {* P *} stmt.ite b S T {* Q *} :=
begin
  intros s t hs hst,
  cases' hst,
  { apply hS,
    exact and.intro hs hcond,
    assumption },
  { apply hT,
    exact and.intro hs hcond,
    assumption }
end

lemma while_intro (P : state → Prop) {b : state → Prop} {S}
    (h : {* λs, P s ∧ b s *} S {* P *}) :
  {* P *} stmt.while b S {* λs, P s ∧ ¬ b s *} :=
begin
  intros s t hs hst,
  induction' hst,
  case while_true {
    apply ih_hst_1 P h,
    exact h _ _ (and.intro hs hcond) hst },
  case while_false {
    exact and.intro hs hcond }
end

lemma consequence {P P' Q Q' : state → Prop} {S}
    (h : {* P *} S {* Q *}) (hp : ∀s, P' s → P s)
    (hq : ∀s, Q s → Q' s) :
  {* P' *} S {* Q' *} :=
fix s t,
assume hs : P' s,
assume hst : (S, s) ⟹ t,
show Q' t, from
  hq _ (h s t (hp s hs) hst)

lemma consequence_left (P' : state → Prop) {P Q S}
    (h : {* P *} S {* Q *}) (hp : ∀s, P' s → P s) :
  {* P' *} S {* Q *} :=
consequence h hp (by cc)

lemma consequence_right (Q) {Q' : state → Prop} {P S}
    (h : {* P *} S {* Q *}) (hq : ∀s, Q s → Q' s) :
  {* P *} S {* Q' *} :=
consequence h (by cc) hq

lemma skip_intro' {P Q : state → Prop} (h : ∀s, P s → Q s) :
  {* P *} stmt.skip {* Q *} :=
consequence skip_intro h (by cc)

lemma assign_intro' {P Q : state → Prop} {x} {a : state → ℕ}
    (h : ∀s, P s → Q (s{x ↦ a s})):
  {* P *} stmt.assign x a {* Q *} :=
consequence (assign_intro Q) h (by cc)

lemma seq_intro' {P Q R S T} (hT : {* Q *} T {* R *})
    (hS : {* P *} S {* Q *}) :
  {* P *} S ;; T {* R *} :=
seq_intro hS hT

lemma while_intro' {b P Q : state → Prop} {S}
    (I : state → Prop)
    (hS : {* λs, I s ∧ b s *} S {* I *})
    (hP : ∀s, P s → I s)
    (hQ : ∀s, ¬ b s → I s → Q s) :
  {* P *} stmt.while b S {* Q *} :=
consequence (while_intro I hS) hP (by finish)

/-! `finish` applies a combination of techniques, including normalization of
logical connectives and quantifiers, simplification, congruence closure, and
quantifier instantiation. It either fully succeeds or fails. -/

lemma assign_intro_forward (P) {x a} :
  {* P *}
  stmt.assign x a
  {* λs, ∃n₀, P (s{x ↦ n₀}) ∧ s x = a (s{x ↦ n₀}) *} :=
begin
  apply assign_intro',
  intros s hP,
  apply exists.intro (s x),
  simp [*]
end

lemma assign_intro_backward (Q : state → Prop) {x}
    {a : state → ℕ} :
  {* λs, ∃n', Q (s{x ↦ n'}) ∧ n' = a s *}
  stmt.assign x a
  {* Q *} :=
begin
  apply assign_intro',
  intros s hP,
  cases' hP,
  cc
end

end partial_hoare

/-! ## First Program: Exchanging Two Variables -/

def SWAP : stmt :=
stmt.assign "t" (λs, s "a") ;;
stmt.assign "a" (λs, s "b") ;;
stmt.assign "b" (λs, s "t")

lemma SWAP_correct (a₀ b₀ : ℕ) :
  {* λs, s "a" = a₀ ∧ s "b" = b₀ *}
  SWAP
  {* λs, s "a" = b₀ ∧ s "b" = a₀ *} :=
begin
  apply partial_hoare.seq_intro',
  apply partial_hoare.seq_intro',
  apply partial_hoare.assign_intro,
  apply partial_hoare.assign_intro,
  apply partial_hoare.assign_intro',
  simp { contextual := tt }
end

lemma SWAP_correct₂ (a₀ b₀ : ℕ) :
  {* λs, s "a" = a₀ ∧ s "b" = b₀ *}
  SWAP
  {* λs, s "a" = b₀ ∧ s "b" = a₀ *} :=
begin
  intros s t hP hstep,
  cases' hstep,
  cases' hstep,
  cases' hstep_1,
  cases' hstep_1_1,
  cases' hstep_1,
  finish
end

/-! ## Second Program: Adding Two Numbers -/

def ADD : stmt :=
stmt.while (λs, s "n" ≠ 0)
  (stmt.assign "n" (λs, s "n" - 1) ;;
   stmt.assign "m" (λs, s "m" + 1))

lemma ADD_correct (n₀ m₀ : ℕ) :
  {* λs, s "n" = n₀ ∧ s "m" = m₀ *}
  ADD
  {* λs, s "n" = 0 ∧ s "m" = n₀ + m₀ *} :=
partial_hoare.while_intro' (λs, s "n" + s "m" = n₀ + m₀)
  begin
    apply partial_hoare.seq_intro',
    { apply partial_hoare.assign_intro },
    { apply partial_hoare.assign_intro',
      simp,
      intros s hnm hnz,
      rw ←hnm,
      cases s "n",
      { finish },
      { simp [nat.succ_eq_add_one],
        linarith } }
  end
  (by simp { contextual := tt })
  (by simp { contextual := tt })

/-! How did we come up with this invariant? The invariant must

1. be true before we enter the loop;

2. remain true after each iteration of the loop if it was true before the
   iteration;

3. be strong enough to imply the desired loop postcondition.

The invariant `true` meets 1 and 2 but usually not 3. Similarly, `false` meets
2 and 3 but usually not 1. Suitable invariants are often of the form

__work done__ + __work remaining__ = __desired result__

where `+` is some suitable operator. When we enter the loop, __work done__ will
often be `0`. And when we exit the loop, __work remaining__ should be `0`.

For the `ADD` loop:

* __work done__ is `m`;
* __work remaining__ is `n`;
* __desired result__ is `n₀ + m₀`.

## A Verification Condition Generator

__Verification condition generators__ (VCGs) are programs that apply Hoare rules
automatically, producing __verification conditions__ that must be proved by the
user. The user must usually also provide strong enough loop invariants, as an
annotation in their programs.

We can use Lean's metaprogramming framework to define a simple VCG.

Hundreds of program verification tools are based on these principles.

VCGs typically work backwards from the postcondition, using backward rules
(rules stated to have an arbitrary `Q` as their postcondition). This works well
because `Asn` is backward. -/

def stmt.while_inv (I b : state → Prop) (S : stmt) : stmt :=
stmt.while b S

namespace partial_hoare

lemma while_inv_intro {b I Q : state → Prop} {S}
    (hS : {* λs, I s ∧ b s *} S {* I *})
    (hQ : ∀s, ¬ b s → I s → Q s) :
  {* I *} stmt.while_inv I b S {* Q *} :=
while_intro' I hS (by cc) hQ

lemma while_inv_intro' {b I P Q : state → Prop} {S}
    (hS : {* λs, I s ∧ b s *} S {* I *})
    (hP : ∀s, P s → I s) (hQ : ∀s, ¬ b s → I s → Q s) :
  {* P *} stmt.while_inv I b S {* Q *} :=
while_intro' I hS hP hQ

end partial_hoare

meta def vcg : tactic unit :=
do
  t ← tactic.target,
  match t with
  | `({* %%P *} %%S {* _ *}) :=
    match S with
    | `(stmt.skip)            :=
      tactic.applyc
        (if expr.is_mvar P then ``partial_hoare.skip_intro
         else ``partial_hoare.skip_intro')
    | `(stmt.assign _ _)      :=
      tactic.applyc
        (if expr.is_mvar P then ``partial_hoare.assign_intro
         else ``partial_hoare.assign_intro')
    | `(stmt.seq _ _)         :=
      tactic.applyc ``partial_hoare.seq_intro'; vcg
    | `(stmt.ite _ _ _)       :=
      tactic.applyc ``partial_hoare.ite_intro; vcg
    | `(stmt.while_inv _ _ _) :=
      tactic.applyc
        (if expr.is_mvar P then ``partial_hoare.while_inv_intro
         else ``partial_hoare.while_inv_intro');
        vcg
    | _                       :=
      tactic.fail (to_fmt "cannot analyze " ++ to_fmt S)
    end
  | _                        := pure ()
  end

end LoVe

/-! Register `vcg` as a proper tactic: -/

meta def tactic.interactive.vcg : tactic unit :=
LoVe.vcg

namespace LoVe

/-! ## Second Program Revisited: Adding Two Numbers -/

lemma ADD_correct₂ (n₀ m₀ : ℕ) :
  {* λs, s "n" = n₀ ∧ s "m" = m₀ *}
  ADD
  {* λs, s "n" = 0 ∧ s "m" = n₀ + m₀ *} :=
show {* λs, s "n" = n₀ ∧ s "m" = m₀ *}
     stmt.while_inv (λs, s "n" + s "m" = n₀ + m₀)
       (λs, s "n" ≠ 0)
       (stmt.assign "n" (λs, s "n" - 1) ;;
        stmt.assign "m" (λs, s "m" + 1))
     {* λs, s "n" = 0 ∧ s "m" = n₀ + m₀ *}, from
  begin
    vcg; simp { contextual := tt },
    intros s hnm hnz,
    rw ←hnm,
    cases s "n",
    { finish },
    { simp [nat.succ_eq_add_one],
      linarith }
  end

/-! ## Hoare Triples for Total Correctness

__Total correctness__ asserts that the program not only is partially correct but
also that it always terminates normally. Hoare triples for total correctness
have the form

    [P] S [Q]

Intended meaning:

    If `P` holds before `S` is executed, the execution terminates normally and
    `Q` holds in the final state.

For deterministic programs, an equivalent formulation is as follows:

    If `P` holds before `S` is executed, there exists a state in which execution
    terminates normally and `Q` holds in that state.

Example:

    `[i ≤ 100] while i ≠ 100 do i := i + 1 [i = 100]`

In our WHILE language, this only affects while loops, which must now be
annotated by a __variant__ `V` (a natural number that decreases with each
iteration):

    [I ∧ b ∧ V = v₀] S [I ∧ V < v₀]
    ——————————————————————————————— While-Var
    [I] while b do S [I ∧ ¬b]

What is a suitable variant for the example above? -/

end LoVe


import MyNat.Definition
/-!
# Tactic exfalso

## Summary

`exfalso` changes your goal to `False`.

## Details

We know that `False` implies `P` for any proposition `P`, and so if your goal is `P`
then you should be able to `apply` `False → P` and reduce your goal to `False`. This
is what the `exfalso` tactic does. The theorem that `False → P` is called `False.elim`
so one can achieve the same effect with `apply False.elim`.

You might think this is a step backwards, but if you have a hypothesis `h : ¬ P`
then after `rw [not_iff_imp_false] at h,` you can `apply h,` to make progress.

This tactic can also be used in a proof by contradiction, where the hypotheses are enough
to deduce a contradiction and the goal happens to be some random statement (possibly
a False one) which you just want to simplify to `False`.

-/


opaque f (x y : Nat) : Nat
opaque g (x : Nat) : Nat

theorem ex1 (x : Nat) (h₁ : f x x = g x) (h₂ : g x = x) : f x (f x x) = x := by
  simp
  simp [*]

theorem ex2 (x : Nat) (h₁ : f x x = g x) (h₂ : g x = x) : f x (f x x) = x := by
  simp [*]

axiom g_ax (x : Nat) : g x = 0

theorem ex3 (x y : Nat) (h₁ : f x x = g x) (h₂ : f x x < 5) : f x x + f x x = 0 := by
  simp [*] at *
  trace_state
  have aux₁ : f x x = g x := h₁
  have aux₂ : g x < 5     := h₂
  simp [g_ax]


import condensed.projective_resolution

open category_theory.limits
open category_theory

namespace Condensed

--TODO: generalize (as needed...)
universe u
variables {A B : Condensed.{u} Ab.{u+1}} (f : A ⟶ B)

noncomputable theory

def kernel_diagram_iso {A B : Condensed.{u} Ab.{u+1}} (S : ExtrDisc) (f : A ⟶ B) :
  parallel_pair f 0 ⋙ Condensed.evaluation Ab S.val ≅
    parallel_pair ((Condensed.evaluation Ab S.val).map f) 0 :=
nat_iso.of_components (λ X,
  match X with
  | walking_parallel_pair.zero := iso.refl _
  | walking_parallel_pair.one := iso.refl _
  end) $ by { rintros (a|a) (b|b) (f|f), tidy }

def cokernel_diagram_iso {A B : Condensed.{u} Ab.{u+1}} (S : ExtrDisc) (f : A ⟶ B) :
  limits.parallel_pair ((Condensed.evaluation Ab S.val).map f) 0 ≅
    limits.parallel_pair f 0 ⋙ Condensed.evaluation Ab S.val :=
nat_iso.of_components (λ X,
  match X with
  | walking_parallel_pair.zero := iso.refl _
  | walking_parallel_pair.one := iso.refl _
  end) $ by { rintros (a|a) (b|b) (f|f), tidy }

def kernel_iso (S : ExtrDisc.{u}) :
  (Condensed.evaluation _ S.val).obj (kernel f) ≅
  kernel ((Condensed.evaluation _ S.val).map f) :=
(is_limit_of_preserves (Condensed.evaluation _ S.val)
  (limit.is_limit (parallel_pair f 0))).cone_point_unique_up_to_iso
  (limit.is_limit _) ≪≫ has_limit.iso_of_nat_iso (kernel_diagram_iso _ _)

@[simp, reassoc]
lemma kernel_iso_hom (S : ExtrDisc.{u}) :
  (kernel_iso f S).hom ≫ kernel.ι _ = (Condensed.evaluation _ S.val).map (kernel.ι _) :=
begin
  dsimp [kernel_iso, kernel_diagram_iso],
  simp only [category.assoc, has_limit.iso_of_nat_iso_hom_π,
    nat_iso.of_components_hom_app, limit.cone_point_unique_up_to_iso_hom_comp_assoc,
    functor.map_cone_π_app, equalizer.fork_π_app_zero,
    equalizer_as_kernel, Condensed.evaluation_map],
  apply category.comp_id,
end

def cokernel_iso (S : ExtrDisc.{u}) :
  cokernel ((Condensed.evaluation _ S.val).map f) ≅
  (Condensed.evaluation _ S.val).obj (cokernel f) :=
has_colimit.iso_of_nat_iso (cokernel_diagram_iso _ _) ≪≫
  (colimit.is_colimit _).cocone_point_unique_up_to_iso
  (is_colimit_of_preserves (Condensed.evaluation _ _)
  (colimit.is_colimit (parallel_pair f 0)))

@[simp, reassoc]
lemma cokernel_iso_hom (S : ExtrDisc.{u}) :
  cokernel.π _ ≫ (cokernel_iso f S).hom = (Condensed.evaluation _ S.val).map (cokernel.π _) :=
begin
  dsimp [cokernel_iso, cokernel_diagram_iso],
  simp only [has_colimit.iso_of_nat_iso_ι_hom_assoc, nat_iso.of_components_hom_app,
  colimit.comp_cocone_point_unique_up_to_iso_hom, functor.map_cocone_ι_app,
  coequalizer.cofork_ι_app_one, coequalizer_as_cokernel, Condensed.evaluation_map],
  apply category.id_comp,
end

end Condensed


/-
Copyright (c) 2021 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz
-/

import category_theory.sites.sheaf

/-!

In this file we construct the functor `Sheaf J A ⥤ Sheaf J B` between sheaf categories
obtained by composition with a functor `F : A ⥤ B`.

In order for the sheaf condition to be preserved, `F` must preserve the correct limits.
The lemma `presheaf.is_sheaf.comp` says that composition with such an `F` indeed preserves the
sheaf condition.

The functor between sheaf categories is called `Sheaf_compose J F`.
Given a natural transformation `η : F ⟶ G`, we obtain a natural transformation
`Sheaf_compose J F ⟶ Sheaf_compose J G`, which we call `Sheaf_compose_map J η`.

-/

namespace category_theory

open category_theory.limits

universes v₁ v₂ u₁ u₂ u₃

variables {C : Type u₁} [category.{v₁} C]
variables {A : Type u₂} [category.{max v₁ u₁} A]
variables {B : Type u₃} [category.{max v₁ u₁} B]
variables {J : grothendieck_topology C}
variables {U : C} (R : presieve U)
variables (F : A ⥤ B)

namespace grothendieck_topology.cover

variables (P : Cᵒᵖ ⥤ A) {X : C} (S : J.cover X)

/-- The multicospan associated to a cover `S : J.cover X` and a presheaf of the form `P ⋙ F`
is isomorphic to the composition of the multicospan associated to `S` and `P`,
composed with `F`. -/
def multicospan_comp : (S.index (P ⋙ F)).multicospan ≅ (S.index P).multicospan ⋙ F :=
nat_iso.of_components (λ t,
match t with
| walking_multicospan.left a := eq_to_iso rfl
| walking_multicospan.right b := eq_to_iso rfl
end) begin
  rintros (a|b) (a|b) (f|f|f),
  any_goals { dsimp, erw [functor.map_id, functor.map_id, category.id_comp] },
  any_goals { dsimp, erw [category.comp_id, category.id_comp], refl }
end

@[simp] lemma multicospan_comp_app_left (a) :
  (S.multicospan_comp F P).app (walking_multicospan.left a) = eq_to_iso rfl := rfl

@[simp] lemma multicospan_comp_app_right (b) :
  (S.multicospan_comp F P).app (walking_multicospan.right b) = eq_to_iso rfl := rfl

@[simp] lemma multicospan_comp_hom_app_left (a) :
  (S.multicospan_comp F P).hom.app (walking_multicospan.left a) = eq_to_hom rfl := rfl

@[simp] lemma multicospan_comp_hom_app_right (b) :
  (S.multicospan_comp F P).hom.app (walking_multicospan.right b) = eq_to_hom rfl := rfl

@[simp] lemma multicospan_comp_hom_inv_left (P : Cᵒᵖ ⥤ A) {X : C}
  (S : J.cover X) (a) : (S.multicospan_comp F P).inv.app (walking_multicospan.left a) =
  eq_to_hom rfl := rfl

@[simp] lemma multicospan_comp_hom_inv_right (P : Cᵒᵖ ⥤ A) {X : C}
  (S : J.cover X) (b) : (S.multicospan_comp F P).inv.app (walking_multicospan.right b) =
  eq_to_hom rfl := rfl

/-- Mapping the multifork associated to a cover `S : J.cover X` and a presheaf `P` with
respect to a functor `F` is isomorphic (upto a natural isomorphism of the underlying functors)
to the multifork associated to `S` and `P ⋙ F`. -/
def map_multifork : F.map_cone (S.multifork P) ≅ (limits.cones.postcompose
    (S.multicospan_comp F P).hom).obj (S.multifork (P ⋙ F)) :=
cones.ext (eq_to_iso rfl) begin
  rintros (a|b),
  { dsimp, simpa },
  { dsimp, simp, dsimp [multifork.of_ι], simpa }
end

end grothendieck_topology.cover

variables [∀ (X : C) (S : J.cover X) (P : Cᵒᵖ ⥤ A), preserves_limit (S.index P).multicospan F]

lemma presheaf.is_sheaf.comp {P : Cᵒᵖ ⥤ A} (hP : presheaf.is_sheaf J P) :
  presheaf.is_sheaf J (P ⋙ F) :=
begin
  rw presheaf.is_sheaf_iff_multifork at ⊢ hP,
  intros X S,
  obtain ⟨h⟩ := hP X S,
  replace h := is_limit_of_preserves F h,
  replace h := limits.is_limit.of_iso_limit h (S.map_multifork F P),
  exact ⟨limits.is_limit.postcompose_hom_equiv (S.multicospan_comp F P) _ h⟩,
end

variable (J)

/-- Composing a sheaf with a functor preserving the appropriate limits yields a functor
between sheaf categories. -/
@[simps]
def Sheaf_compose : Sheaf J A ⥤ Sheaf J B :=
{ obj := λ G, ⟨G.val ⋙ F, presheaf.is_sheaf.comp _ G.2⟩,
  map := λ G H η, ⟨whisker_right η.val _⟩,
  map_id' := λ G, Sheaf.hom.ext _ _ $ whisker_right_id _,
  map_comp' := λ G H W f g, Sheaf.hom.ext _ _ $ whisker_right_comp _ _ _ }

end category_theory


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

! This file was ported from Lean 3 source module control.bitraversable.lemmas
! leanprover-community/mathlib commit 58581d0fe523063f5651df0619be2bf65012a94a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Bitraversable.Basic

/-!
# Bitraversable Lemmas

## Main definitions
  * tfst - traverse on first functor argument
  * tsnd - traverse on second functor argument

## Lemmas

Combination of
  * bitraverse
  * tfst
  * tsnd

with the applicatives `id` and `comp`

## References

 * Hackage: <https://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Bitraversable.html>

## Tags

traversable bitraversable functor bifunctor applicative

-/

universe u

variable {t : Type u → Type u → Type u} [Bitraversable t]

variable {β : Type u}

namespace Bitraversable

open Functor LawfulApplicative

variable {F G : Type u → Type u} [Applicative F] [Applicative G]

/-- traverse on the first functor argument -/
@[reducible]
def tfst {α α'} (f : α → F α') : t α β → F (t α' β) :=
  bitraverse f pure
#align bitraversable.tfst Bitraversable.tfst

/-- traverse on the second functor argument -/
@[reducible]
def tsnd {α α'} (f : α → F α') : t β α → F (t β α') :=
  bitraverse pure f
#align bitraversable.tsnd Bitraversable.tsnd

variable [IsLawfulBitraversable t] [LawfulApplicative F] [LawfulApplicative G]

@[higher_order.1tfst_id]
theorem id_tfst : ∀ {α β} (x : t α β), tfst id.mk x = id.mk x :=
  @id_bitraverse _ _ _
#align bitraversable.id_tfst Bitraversable.id_tfst

@[higher_order.1tsnd_id]
theorem id_tsnd : ∀ {α β} (x : t α β), tsnd id.mk x = id.mk x :=
  @id_bitraverse _ _ _
#align bitraversable.id_tsnd Bitraversable.id_tsnd

@[higher_order.1tfst_comp_tfst]
theorem comp_tfst {α₀ α₁ α₂ β} (f : α₀ → F α₁) (f' : α₁ → G α₂) (x : t α₀ β) :
    Comp.mk (tfst f' <$> tfst f x) = tfst (Comp.mk ∘ map f' ∘ f) x := by
  rw [← comp_bitraverse] <;> simp [tfst, map_comp_pure, Pure.pure]
#align bitraversable.comp_tfst Bitraversable.comp_tfst

@[higher_order.1tfst_comp_tsnd]
theorem tfst_tsnd {α₀ α₁ β₀ β₁} (f : α₀ → F α₁) (f' : β₀ → G β₁) (x : t α₀ β₀) :
    Comp.mk (tfst f <$> tsnd f' x) = bitraverse (Comp.mk ∘ pure ∘ f) (Comp.mk ∘ map pure ∘ f') x :=
  by rw [← comp_bitraverse] <;> simp [tfst, tsnd]
#align bitraversable.tfst_tsnd Bitraversable.tfst_tsnd

@[higher_order.1tsnd_comp_tfst]
theorem tsnd_tfst {α₀ α₁ β₀ β₁} (f : α₀ → F α₁) (f' : β₀ → G β₁) (x : t α₀ β₀) :
    Comp.mk (tsnd f' <$> tfst f x) = bitraverse (Comp.mk ∘ map pure ∘ f) (Comp.mk ∘ pure ∘ f') x :=
  by rw [← comp_bitraverse] <;> simp [tfst, tsnd]
#align bitraversable.tsnd_tfst Bitraversable.tsnd_tfst

@[higher_order.1tsnd_comp_tsnd]
theorem comp_tsnd {α β₀ β₁ β₂} (g : β₀ → F β₁) (g' : β₁ → G β₂) (x : t α β₀) :
    Comp.mk (tsnd g' <$> tsnd g x) = tsnd (Comp.mk ∘ map g' ∘ g) x := by
  rw [← comp_bitraverse] <;> simp [tsnd] <;> rfl
#align bitraversable.comp_tsnd Bitraversable.comp_tsnd

open Bifunctor

private theorem pure_eq_id_mk_comp_id {α} : pure = id.mk ∘ @id α :=
  rfl
#align bitraversable.pure_eq_id_mk_comp_id bitraversable.pure_eq_id_mk_comp_id

open Function

@[higher_order.1]
theorem tfst_eq_fst_id {α α' β} (f : α → α') (x : t α β) : tfst (id.mk ∘ f) x = id.mk (fst f x) :=
  by simp [tfst, fst, pure_eq_id_mk_comp_id, -comp.right_id, bitraverse_eq_bimap_id]
#align bitraversable.tfst_eq_fst_id Bitraversable.tfst_eq_fst_id

@[higher_order.1]
theorem tsnd_eq_snd_id {α β β'} (f : β → β') (x : t α β) : tsnd (id.mk ∘ f) x = id.mk (snd f x) :=
  by simp [tsnd, snd, pure_eq_id_mk_comp_id, -comp.right_id, bitraverse_eq_bimap_id]
#align bitraversable.tsnd_eq_snd_id Bitraversable.tsnd_eq_snd_id

attribute [functor_norm]
  comp_bitraverse comp_tsnd comp_tfst tsnd_comp_tsnd tsnd_comp_tfst tfst_comp_tsnd tfst_comp_tfst bitraverse_comp bitraverse_id_id tfst_id tsnd_id

end Bitraversable