/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.polynomial.derivative
import data.nat.choose.sum
import ring_theory.polynomial.pochhammer
import data.polynomial.algebra_map
import linear_algebra.linear_independent
import data.mv_polynomial.pderiv

/-!
# Bernstein polynomials

The definition of the Bernstein polynomials
```
bernstein_polynomial (R : Type*) [comm_ring R] (n ν : ℕ) : polynomial R :=
(choose n ν) * X^ν * (1 - X)^(n - ν)
```
and the fact that for `ν : fin (n+1)` these are linearly independent over `ℚ`.

We prove the basic identities
* `(finset.range (n + 1)).sum (λ ν, bernstein_polynomial R n ν) = 1`
* `(finset.range (n + 1)).sum (λ ν, ν • bernstein_polynomial R n ν) = n • X`
* `(finset.range (n + 1)).sum (λ ν, (ν * (ν-1)) • bernstein_polynomial R n ν) = (n * (n-1)) • X^2`

## Notes

See also `analysis.special_functions.bernstein`, which defines the Bernstein approximations
of a continuous function `f : C([0,1], ℝ)`, and shows that these converge uniformly to `f`.
-/

noncomputable theory

open nat (choose)
open polynomial (X)

variables (R : Type*) [comm_ring R]

/--
`bernstein_polynomial R n ν` is `(choose n ν) * X^ν * (1 - X)^(n - ν)`.

Although the coefficients are integers, it is convenient to work over an arbitrary commutative ring.
-/
def bernstein_polynomial (n ν : ℕ) : polynomial R := choose n ν * X^ν * (1 - X)^(n - ν)

example : bernstein_polynomial ℤ 3 2 = 3 * X^2 - 3 * X^3 :=
begin
  norm_num [bernstein_polynomial, choose],
  ring,
end

namespace bernstein_polynomial

lemma eq_zero_of_lt {n ν : ℕ} (h : n < ν) : bernstein_polynomial R n ν = 0 :=
by simp [bernstein_polynomial, nat.choose_eq_zero_of_lt h]

section
variables {R} {S : Type*} [comm_ring S]

@[simp] lemma map (f : R →+* S) (n ν : ℕ) :
  (bernstein_polynomial R n ν).map f = bernstein_polynomial S n ν :=
by simp [bernstein_polynomial]

end

lemma flip (n ν : ℕ) (h : ν ≤ n) :
  (bernstein_polynomial R n ν).comp (1-X) = bernstein_polynomial R n (n-ν) :=
begin
  dsimp [bernstein_polynomial],
  simp [h, tsub_tsub_assoc, mul_right_comm],
end

lemma flip' (n ν : ℕ) (h : ν ≤ n) :
  bernstein_polynomial R n ν = (bernstein_polynomial R n (n-ν)).comp (1-X) :=
begin
  rw [←flip _ _ _ h, polynomial.comp_assoc],
  simp,
end

lemma eval_at_0 (n ν : ℕ) : (bernstein_polynomial R n ν).eval 0 = if ν = 0 then 1 else 0 :=
begin
  dsimp [bernstein_polynomial],
  split_ifs,
  { subst h, simp, },
  { simp [zero_pow (nat.pos_of_ne_zero h)], },
end

lemma eval_at_1 (n ν : ℕ) : (bernstein_polynomial R n ν).eval 1 = if ν = n then 1 else 0 :=
begin
  dsimp [bernstein_polynomial],
  split_ifs,
  { subst h, simp, },
  { obtain w | w := (n - ν).eq_zero_or_pos,
    { simp [nat.choose_eq_zero_of_lt ((tsub_eq_zero_iff_le.mp w).lt_of_ne (ne.symm h))] },
    { simp [zero_pow w] } },
end.

lemma derivative_succ_aux (n ν : ℕ) :
  (bernstein_polynomial R (n+1) (ν+1)).derivative =
    (n+1) * (bernstein_polynomial R n ν - bernstein_polynomial R n (ν + 1)) :=
begin
  dsimp [bernstein_polynomial],
  suffices :
    ↑((n + 1).choose (ν + 1)) * ((↑ν + 1) * X ^ ν) * (1 - X) ^ (n - ν)
      -(↑((n + 1).choose (ν + 1)) * X ^ (ν + 1) * (↑(n - ν) * (1 - X) ^ (n - ν - 1))) =
    (↑n + 1) * (↑(n.choose ν) * X ^ ν * (1 - X) ^ (n - ν) -
         ↑(n.choose (ν + 1)) * X ^ (ν + 1) * (1 - X) ^ (n - (ν + 1))),
  { simpa [polynomial.derivative_pow, ←sub_eq_add_neg], },
  conv_rhs { rw mul_sub, },
  -- We'll prove the two terms match up separately.
  refine congr (congr_arg has_sub.sub _) _,
  { simp only [←mul_assoc],
    refine congr (congr_arg (*) (congr (congr_arg (*) _) rfl)) rfl,
    -- Now it's just about binomial coefficients
    exact_mod_cast congr_arg (λ m : ℕ, (m : polynomial R)) (nat.succ_mul_choose_eq n ν).symm, },
  { rw [← tsub_add_eq_tsub_tsub, ← mul_assoc, ← mul_assoc], congr' 1,
    rw mul_comm , rw [←mul_assoc,←mul_assoc],  congr' 1,
    norm_cast,
    congr' 1,
    convert (nat.choose_mul_succ_eq n (ν + 1)).symm using 1,
    { convert mul_comm _ _ using 2,
      simp, },
    { apply mul_comm, }, },
end

lemma derivative_succ (n ν : ℕ) :
  (bernstein_polynomial R n (ν+1)).derivative =
    n * (bernstein_polynomial R (n-1) ν - bernstein_polynomial R (n-1) (ν+1)) :=
begin
  cases n,
  { simp [bernstein_polynomial], },
  { apply derivative_succ_aux, }
end

lemma derivative_zero (n : ℕ) :
  (bernstein_polynomial R n 0).derivative = -n * bernstein_polynomial R (n-1) 0 :=
begin
  dsimp [bernstein_polynomial],
  simp [polynomial.derivative_pow],
end

lemma iterate_derivative_at_0_eq_zero_of_lt (n : ℕ) {ν k : ℕ} :
  k < ν → (polynomial.derivative^[k] (bernstein_polynomial R n ν)).eval 0 = 0 :=
begin
  cases ν,
  { rintro ⟨⟩, },
  { rw nat.lt_succ_iff,
    induction k with k ih generalizing n ν,
    { simp [eval_at_0], },
    { simp only [derivative_succ, int.coe_nat_eq_zero, int.nat_cast_eq_coe_nat, mul_eq_zero,
        function.comp_app, function.iterate_succ,
        polynomial.iterate_derivative_sub, polynomial.iterate_derivative_cast_nat_mul,
        polynomial.eval_mul, polynomial.eval_nat_cast, polynomial.eval_sub],
      intro h,
      apply mul_eq_zero_of_right,
      rw [ih _ _ (nat.le_of_succ_le h), sub_zero],
      convert ih _ _ (nat.pred_le_pred h),
      exact (nat.succ_pred_eq_of_pos (k.succ_pos.trans_le h)).symm } },
end

@[simp]
lemma iterate_derivative_succ_at_0_eq_zero (n ν : ℕ) :
  (polynomial.derivative^[ν] (bernstein_polynomial R n (ν+1))).eval 0 = 0 :=
iterate_derivative_at_0_eq_zero_of_lt R n (lt_add_one ν)

open polynomial

@[simp]

lemma iterate_derivative_at_0_ne_zero [char_zero R] (n ν : ℕ) (h : ν ≤ n) :
  (polynomial.derivative^[ν] (bernstein_polynomial R n ν)).eval 0 ≠ 0 :=
begin
  simp only [int.coe_nat_eq_zero, bernstein_polynomial.iterate_derivative_at_0, ne.def,
    nat.cast_eq_zero],
  simp only [←pochhammer_eval_cast],
  norm_cast,
  apply ne_of_gt,
  obtain rfl|h' := nat.eq_zero_or_pos ν,
  { simp, },
  { rw ← nat.succ_pred_eq_of_pos h' at h,
    exact pochhammer_pos _ _ (tsub_pos_of_lt (nat.lt_of_succ_le h)) }
end

/-!
Rather than redoing the work of evaluating the derivatives at 1,
we use the symmetry of the Bernstein polynomials.
-/
lemma iterate_derivative_at_1_eq_zero_of_lt (n : ℕ) {ν k : ℕ} :
  k < n - ν → (polynomial.derivative^[k] (bernstein_polynomial R n ν)).eval 1 = 0 :=
begin
  intro w,
  rw flip' _ _ _ (tsub_pos_iff_lt.mp (pos_of_gt w)).le,
  simp [polynomial.eval_comp, iterate_derivative_at_0_eq_zero_of_lt R n w],
end

@[simp]
lemma iterate_derivative_at_1 (n ν : ℕ) (h : ν ≤ n) :
  (polynomial.derivative^[n-ν] (bernstein_polynomial R n ν)).eval 1 =
    (-1)^(n-ν) * (pochhammer R (n - ν)).eval (ν + 1) :=
begin
  rw flip' _ _ _ h,
  simp [polynomial.eval_comp, h],
  obtain rfl | h' := h.eq_or_lt,
  { simp, },
  { congr,
    norm_cast,
    rw [← tsub_add_eq_tsub_tsub, tsub_tsub_cancel_of_le (nat.succ_le_iff.mpr h')] },
end

lemma iterate_derivative_at_1_ne_zero [char_zero R] (n ν : ℕ) (h : ν ≤ n) :
  (polynomial.derivative^[n-ν] (bernstein_polynomial R n ν)).eval 1 ≠ 0 :=
begin
  rw [bernstein_polynomial.iterate_derivative_at_1 _ _ _ h, ne.def, neg_one_pow_mul_eq_zero_iff,
    ←nat.cast_succ, ←pochhammer_eval_cast, ←nat.cast_zero, nat.cast_inj],
  exact (pochhammer_pos _ _ (nat.succ_pos ν)).ne',
end

open submodule

lemma linear_independent_aux (n k : ℕ) (h : k ≤ n + 1):
  linear_independent ℚ (λ ν : fin k, bernstein_polynomial ℚ n ν) :=
begin
  induction k with k ih,
  { apply linear_independent_empty_type, },
  { apply linear_independent_fin_succ'.mpr,
    fsplit,
    { exact ih (le_of_lt h), },
    { -- The actual work!
      -- We show that the (n-k)-th derivative at 1 doesn't vanish,
      -- but vanishes for everything in the span.
      clear ih,
      simp only [nat.succ_eq_add_one, add_le_add_iff_right] at h,
      simp only [fin.coe_last, fin.init_def],
      dsimp,
      apply not_mem_span_of_apply_not_mem_span_image ((polynomial.derivative_lhom ℚ)^(n-k)),
      simp only [not_exists, not_and, submodule.mem_map, submodule.span_image],
      intros p m,
      apply_fun (polynomial.eval (1 : ℚ)),
      simp only [polynomial.derivative_lhom_coe, linear_map.pow_apply],
      -- The right hand side is nonzero,
      -- so it will suffice to show the left hand side is always zero.
      suffices : (polynomial.derivative^[n-k] p).eval 1 = 0,
      { rw [this],
        exact (iterate_derivative_at_1_ne_zero ℚ n k h).symm, },
      apply span_induction m,
      { simp,
        rintro ⟨a, w⟩, simp only [fin.coe_mk],
        rw [iterate_derivative_at_1_eq_zero_of_lt ℚ n ((tsub_lt_tsub_iff_left_of_le h).mpr w)] },
      { simp, },
      { intros x y hx hy, simp [hx, hy], },
      { intros a x h, simp [h], }, }, },
end

/--
The Bernstein polynomials are linearly independent.

We prove by induction that the collection of `bernstein_polynomial n ν` for `ν = 0, ..., k`
are linearly independent.
The inductive step relies on the observation that the `(n-k)`-th derivative, evaluated at 1,
annihilates `bernstein_polynomial n ν` for `ν < k`, but has a nonzero value at `ν = k`.
-/

lemma linear_independent (n : ℕ) :
  linear_independent ℚ (λ ν : fin (n+1), bernstein_polynomial ℚ n ν) :=
linear_independent_aux n (n+1) (le_refl _)

lemma sum (n : ℕ) : (finset.range (n + 1)).sum (λ ν, bernstein_polynomial R n ν) = 1 :=
begin
  -- We calculate `(x + (1-x))^n` in two different ways.
  conv { congr, congr, skip, funext, dsimp [bernstein_polynomial], rw [mul_assoc, mul_comm], },
  rw ←add_pow,
  simp,
end

open polynomial
open mv_polynomial

lemma sum_smul (n : ℕ) :
  (finset.range (n + 1)).sum (λ ν, ν • bernstein_polynomial R n ν) = n • X :=
begin
  -- We calculate the `x`-derivative of `(x+y)^n`, evaluated at `y=(1-x)`,
  -- either directly or by using the binomial theorem.

  -- We'll work in `mv_polynomial bool R`.
  let x : mv_polynomial bool R := mv_polynomial.X tt,
  let y : mv_polynomial bool R := mv_polynomial.X ff,

  have pderiv_tt_x : pderiv tt x = 1, { simp [x], },
  have pderiv_tt_y : pderiv tt y = 0, { simp [pderiv_X, y], },

  let e : bool → polynomial R := λ i, cond i X (1-X),

  -- Start with `(x+y)^n = (x+y)^n`,
  -- take the `x`-derivative, evaluate at `x=X, y=1-X`, and multiply by `X`:
  have h : (x+y)^n = (x+y)^n := rfl,
  apply_fun (pderiv tt) at h,
  apply_fun (aeval e) at h,
  apply_fun (λ p, p * X) at h,

  -- On the left hand side we'll use the binomial theorem, then simplify.

  -- We first prepare a tedious rewrite:
  have w : ∀ k : ℕ,
    ↑k * polynomial.X ^ (k - 1) * (1 - polynomial.X) ^ (n - k) * ↑(n.choose k) * polynomial.X =
      k • bernstein_polynomial R n k,
  { rintro (_|k),
    { simp, },
    { dsimp [bernstein_polynomial],
      simp only [←nat_cast_mul, nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, pow_succ],
      push_cast,
      ring, }, },

  conv at h
  { to_lhs,
    rw [add_pow, (pderiv tt).map_sum, (mv_polynomial.aeval e).map_sum, finset.sum_mul],
    -- Step inside the sum:
    apply_congr, skip,
    simp [pderiv_mul, pderiv_tt_x, pderiv_tt_y, e, w], },
  -- On the right hand side, we'll just simplify.
  conv at h
  { to_rhs,
    rw [pderiv_pow, (pderiv tt).map_add, pderiv_tt_x, pderiv_tt_y],
    simp [e] },
  simpa using h,
end

lemma sum_mul_smul (n : ℕ) :
  (finset.range (n + 1)).sum (λ ν, (ν * (ν-1)) • bernstein_polynomial R n ν) =
    (n * (n-1)) • X^2 :=
begin
  -- We calculate the second `x`-derivative of `(x+y)^n`, evaluated at `y=(1-x)`,
  -- either directly or by using the binomial theorem.

  -- We'll work in `mv_polynomial bool R`.
  let x : mv_polynomial bool R := mv_polynomial.X tt,
  let y : mv_polynomial bool R := mv_polynomial.X ff,

  have pderiv_tt_x : pderiv tt x = 1, { simp [x], },
  have pderiv_tt_y : pderiv tt y = 0, { simp [pderiv_X, y], },

  let e : bool → polynomial R := λ i, cond i X (1-X),

  -- Start with `(x+y)^n = (x+y)^n`,
  -- take the second `x`-derivative, evaluate at `x=X, y=1-X`, and multiply by `X`:
  have h : (x+y)^n = (x+y)^n := rfl,
  apply_fun (pderiv tt) at h,
  apply_fun (pderiv tt) at h,
  apply_fun (aeval e) at h,
  apply_fun (λ p, p * X^2) at h,

  -- On the left hand side we'll use the binomial theorem, then simplify.

  -- We first prepare a tedious rewrite:
  have w : ∀ k : ℕ,
    ↑k * (↑(k-1) * polynomial.X ^ (k - 1 - 1)) *
      (1 - polynomial.X) ^ (n - k) * ↑(n.choose k) * polynomial.X^2 =
      (k * (k-1)) • bernstein_polynomial R n k,
  { rintro (_|k),
    { simp, },
    { rcases k with (_|k),
      { simp, },
      { dsimp [bernstein_polynomial],
        simp only [←nat_cast_mul, nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, pow_succ],
        push_cast,
        ring, }, }, },

  conv at h
  { to_lhs,
    rw [add_pow, (pderiv tt).map_sum, (pderiv tt).map_sum, (mv_polynomial.aeval e).map_sum,
      finset.sum_mul],
    -- Step inside the sum:
    apply_congr, skip,
    simp [pderiv_mul, pderiv_tt_x, pderiv_tt_y, e, w] },
  -- On the right hand side, we'll just simplify.
  conv at h
  { to_rhs,
    simp only [pderiv_one, pderiv_mul, pderiv_pow, pderiv_nat_cast, (pderiv tt).map_add,
      pderiv_tt_x, pderiv_tt_y],
    simp [e, smul_smul] },
  simpa using h,
end

/--
A certain linear combination of the previous three identities,
which we'll want later.
-/
lemma variance (n : ℕ) :
  (finset.range (n+1)).sum (λ ν, (n • polynomial.X - ν)^2 * bernstein_polynomial R n ν) =
    n • polynomial.X * (1 - polynomial.X) :=
begin
  have p :
    (finset.range (n+1)).sum (λ ν, (ν * (ν-1)) • bernstein_polynomial R n ν) +
    (1 - (2 * n) • polynomial.X) * (finset.range (n+1)).sum (λ ν, ν • bernstein_polynomial R n ν) +
    (n^2 • X^2) * (finset.range (n+1)).sum (λ ν, bernstein_polynomial R n ν) = _ := rfl,
  conv at p { to_lhs,
    rw [finset.mul_sum, finset.mul_sum, ←finset.sum_add_distrib, ←finset.sum_add_distrib],
    simp only [←nat_cast_mul],
    simp only [←mul_assoc],
    simp only [←add_mul], },
  conv at p { to_rhs,
    rw [sum, sum_smul, sum_mul_smul, ←nat_cast_mul], },
  calc _ = _ : finset.sum_congr rfl (λ k m, _)
     ... = _ : p
     ... = _ : _,
  { congr' 1, simp only [←nat_cast_mul] with push_cast,
    cases k; { simp, ring, }, },
  { simp only [←nat_cast_mul] with push_cast,
    cases n,
    { simp, },
    { simp, ring, }, },
end

end bernstein_polynomial


import mynat.definition
import mynat.mul
import world2.level2
import world2.level5
import world2.level6

namespace mynat

lemma succ_mul (a b : mynat) : succ(a) * b = a * b + b :=
begin [nat_num_game]
    induction b with d hd,
    {
        repeat {rw mul_zero},
        rw add_zero,
        refl,
    },
    {
        rw mul_succ,
        rw hd,
        rw mul_succ,
        rw succ_eq_add_one,
        rw succ_eq_add_one,
        rw ← add_assoc,
        rw ← add_assoc,
        rw add_right_comm (a * d),
        refl,
    },
end

end mynat


namespace TBA

-- Let's work with some inductive types other than `Nat`!

-- Here is our very own definition of `List`:
inductive List (α : Type) where
  | nil : List α
  | cons (head : α) (tail : List α) : List α

notation  (priority := high) "[" "]" => List.nil   -- `[]`
infixr:67 (priority := high) " :: "  => List.cons  -- `a :: as`

-- as a warm-up exercise, let's define concatenation of two lists
def append (as bs : List α) : List α := _

infixl:65 (priority := high) " ++ " => append

example : 1::2::[] ++ 3::4::[] = 1::2::3::4::[] := rfl

-- as with associativity on `Nat`, think twice about what induction variable to use!
theorem append_assoc : (as ++ bs) ++ cs = as ++ (bs ++ cs) := by

open Decidable

/-
One important special case of `Decidable` is decidability of equalities:
```
abbrev DecidableEq (α : Type) :=
  (a b : α) → Decidable (a = b)

def decEq [s : DecidableEq α] (a b : α) : Decidable (a = b) :=
  s a b
```
Note: `DecidableEq` is defined using `abbrev` instead of `def` because typeclass resolution only
unfolds the former for performance reasons.

Let's try to prove that `List` equality is decidable!
-/
-- hint: Something is still missing. Do we need to assume anything about `α`?
-- hint: Apply `match` case distinctions until the the appropriate `Decidable` constructor is clear,
--   then fill in its proof argument with `by`.
--   We could also do everything in a `by` block, but it's nicer to reserve tactics for proofs so we have
--   more control about the code of programs, i.e. the part that is actually executed
def ldecEq  (as bs : List α) : Decidable (as = bs) := _

-- Let's declare the instance:
instance  : DecidableEq (List α) := _

-- This should now work:
#eval decEq (1::2::[]) (1::3::[])

/-
`DecidabePred` is another convenient abbreviation of `Decidable`
```
abbrev DecidablePred (r : α → Prop) :=
  (a : α) → Decidable (r a)
```
If we have `[DecidablePred p]`, we can e.g. use `if p a then ...` for some `a : α`.

`filter p as` is a simple list function that should remove all elements `a` for which `p a` does not hold.
-/
def filter (p : α → Prop) [DecidablePred p] (as : List α) : List α := _

example : filter (fun x => x % 2 = 0) (1::2::3::4::[]) = 2::4::[] := rfl

variable {p : α → Prop} [DecidablePred p] {as bs : List α}

-- These helper theorems can be useful, also for manual rewriting
@[simp] theorem filter_cons_true (h : p a) : filter p (a :: as) = a :: filter p as :=
  by simp [filter, h]
@[simp] theorem filter_cons_false (h : ¬ p a) : filter p (a :: as) = filter p as :=
  by simp [filter, h]
-- It's worthwhile thinking about what's actually happening here:
-- * first, `filter p (a :: as)` is unfolded to `if p a then a :: filter p as else filter p as`
--   (note that the second `filter` cannot be unfolded)
-- * then `if p a then ...` is rewritten to `if True then ...` using `h`
-- * finally, `if True then a :: filter p as else ...` is rewritten to `a :: filter p as` using
--   the built-in simp theorem `Lean.Simp.ite_true`

-- useful tactic: `by_cases h : q` for a decidable proposition `q`
theorem filter_idem : filter p (filter p as) = filter p as := by

theorem filter_append : filter p (as ++ bs) = filter p as ++ filter p bs := by

-- list membership as an inductive predicate:
inductive Mem (a : α) : List α → Prop where
  -- either it's the first element...
  | head {as} : Mem a (a::as)
  -- or it's in the remainder list
  | tail {as} : Mem a as → Mem a (a'::as)

infix:50 " ∈ " => Mem

-- recall that `a ≠ b` is the same as `a = b → False`
theorem mem_of_nonempty_filter (h : ∀ a, p a → a = x) : filter p as ≠ [] → x ∈ as := by

-- This proof is pretty long! Some hints:
-- * If you have an assumption `h : a ∈ []`, you can solve the current goal by `cases h`:
--   since there is no `Mem` constructor that could possibly match `[]`, there is nothing left to prove!
--   This exclusion of cases, and case analysis on inductive predicates in general,
--   is also called *rule inversion* since we (try to) apply the introduction rules (constructors)
--   "in reverse".
-- * On the other hand, if you try to do case analysis on a proof of e.g. `a ∈ filter p as`,
--   Lean will complain with "dependent elimination failed" since it *doesn't* know yet if
--   the argument `filter p as` is of the form `_ :: _` as demanded by the `Mem` constructors.
--   You need to get the assumption into the shape `_ ∈ []` or `_ ∈ _ :: _` before applying
--   `(no)match/cases` to it.
theorem mem_filter : a ∈ filter p as ↔ a ∈ as ∧ p a := _

-- Here is an alternative definition of list membership via `append`
inductive Mem' (a : α) : List α → Prop where
  | intro (as bs) : Mem' a (as ++ (a :: bs))

infix:50 " ∈' " => Mem'

-- Let's prove that they are equivalent!
theorem mem_mem' : a ∈ as ↔ a ∈' as := _

end TBA


import data.polynomial
import missing_mathlib.ring_theory.algebra

universe variables u v w

namespace polynomial

variables {α : Type u} {β : Type v}
open polynomial

lemma leading_coeff_X_add_C {α : Type v} [integral_domain α] [decidable_eq α] (a b : α) (ha : a ≠ 0):
  leading_coeff (C a * X + C b) = a :=
begin
  rw [add_comm, leading_coeff_add_of_degree_lt],
  { simp },
  { simp [degree_C ha],
    apply lt_of_le_of_lt degree_C_le (with_bot.coe_lt_coe.2 zero_lt_one)}
end

end polynomial

section eval₂

variables {α : Type u} {β : Type v} [comm_ring α] [decidable_eq α] [semiring β]
variables (f : α →+* β) (x : β) (p q : polynomial α)
open is_semiring_hom
open polynomial finsupp finset

lemma eval₂_mul_noncomm (hf : ∀ b a, a * f b = f b * a) :
  (p * q).eval₂ f x = p.eval₂ f x * q.eval₂ f x :=
begin
  dunfold eval₂,
  rw [add_monoid_algebra.mul_def, finsupp.sum_mul _ p], simp only [finsupp.mul_sum _ q], rw [sum_sum_index],
  { apply sum_congr rfl, assume i hi, dsimp only, rw [sum_sum_index],
    { apply sum_congr rfl, assume j hj, dsimp only,
      rw [sum_single_index, is_semiring_hom.map_mul f, pow_add],
      { rw [mul_assoc, ←mul_assoc _ (x ^ i), ← hf _ (x ^ i)],
        simp only [mul_assoc] },
      { rw [is_semiring_hom.map_zero f, zero_mul] } },
    { intro, rw [is_semiring_hom.map_zero f, zero_mul] },
    { intros, rw [is_semiring_hom.map_add f, add_mul] } },
  { intro, rw [is_semiring_hom.map_zero f, zero_mul] },
  { intros, rw [is_semiring_hom.map_add f, add_mul] }
end

end eval₂

lemma finsupp_sum_eq_eval₂ (α : Type v) (β : Type w)
  [decidable_eq α] [comm_ring α] [decidable_eq β] [add_comm_group β] [module α β]
  (f : β →ₗ[α] β) (v : β) (p : polynomial α) :
  (finsupp.sum p (λ n b, b • (f ^ n) v))
    = polynomial.eval₂ (algebra_map α (β →ₗ[α] β)) f p v :=
begin
  dunfold polynomial.eval₂ finsupp.sum,
  convert @finset.sum_hom _ _ _ _ _ p.support _ (λ h : β →ₗ[α] β, h v) _,
  simp [module.endomorphism_algebra_map_apply]
end

lemma eval₂_prod_noncomm {α β : Type*} [comm_ring α] [decidable_eq α] [semiring β]
  (f : α →+* β) (hf : ∀ b a, a * f b = f b * a) (x : β)
  (ps : list (polynomial α)) :
  polynomial.eval₂ f x ps.prod = (ps.map (λ p, (polynomial.eval₂ f x p))).prod :=
begin
  induction ps,
  simp,
  simp [eval₂_mul_noncomm f _ _ _ hf, ps_ih] {contextual := tt}
end


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

import data.polynomial.coeff
import data.nat.choose.basic

/-!

# Vandermonde's identity

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

In this file we prove Vandermonde's identity (`nat.add_choose_eq`):
`(m + n).choose k = ∑ (ij : ℕ × ℕ) in antidiagonal k, m.choose ij.1 * n.choose ij.2`

We follow the algebraic proof from
https://en.wikipedia.org/wiki/Vandermonde%27s_identity#Algebraic_proof .

-/

open_locale big_operators

open polynomial finset.nat

/-- Vandermonde's identity -/
lemma nat.add_choose_eq (m n k : ℕ) :
  (m + n).choose k = ∑ (ij : ℕ × ℕ) in antidiagonal k, m.choose ij.1 * n.choose ij.2 :=
begin
  calc (m + n).choose k
      = ((X + 1) ^ (m + n)).coeff k : _
  ... = ((X + 1) ^ m * (X + 1) ^ n).coeff k : by rw pow_add
  ... = ∑ (ij : ℕ × ℕ) in antidiagonal k, m.choose ij.1 * n.choose ij.2 : _,
  { rw [coeff_X_add_one_pow, nat.cast_id], },
  { rw [coeff_mul, finset.sum_congr rfl],
    simp only [coeff_X_add_one_pow, nat.cast_id, eq_self_iff_true, imp_true_iff], }
end


import game.order.level08
import game.order.level02
import game.order.dumb
import game.order.lessdumb
import game.order.twocase
open real

namespace xena -- hide

/-
# Chapter 2 : Order

## Level 9

This level invites you to work out a property of the absolute value.
In Lean the absolute value of $x$ is denoted by `abs x`.
For ease of use, a notation can be used around that definition as below.
Feel free to use the triangle inequality on the real numbers,

`abs_add : ∀ (a b : ?M_1), |a + b| ≤ |a| + |b|`

together with the `linarith` and `norm_num` tactics.
-/

notation `|` x `|` := abs x

-- begin hide
-- this to go in the side bar
lemma eq_sqr_to_eq (a b : ℝ) (ha : 0 ≤ a) (hb : 0 ≤ b) : a^2 = b^2 → a = b :=
begin
    intro h,
    have h2 : sqrt (a ^ 2) = sqrt (a ^ 2),
    refl,
    --occurreneces.pos introduce
    rw h at h2 {occs := occurrences.pos [2]},
    have j := sqrt_sqr ha,
    rw j at h2,
    have k := sqrt_sqr hb,
    rw k at h2,
    exact h2,

end
-- end hide

/- Lemma
For any two real numbers $a$ and $b$, we have that
$$|a + b| = |a| + |b|$$ if and only if $ab \ge 0$ .
-/
theorem abs_sub_eq_sum_abs (a b : ℝ) : |a + b| = |a| + |b| ↔ a * b ≥ 0 :=
begin
    have H0 : (a+b)^2 = |a+b|^2,
        have h01 := abs_mul_abs_self (a+b),
        rw pow_two _, rw pow_two _, symmetry, exact h01,
    have H1 : 0 ≤ (a + b) ^ 2, exact pow_two_nonneg (a+b),
    have H2 : (a+b) ^ 2 = a ^2 + 2 * a * b + b^2, ring,
    have H3 : ( |a| + |b| )^2 = |a|^2 + 2*|a|*|b| + |b|^2, ring,
    rw H0 at H2,
    have Ha : a^2 = |a|^2,
        have h01 := abs_mul_abs_self a,
        rw pow_two _, rw pow_two _, symmetry, exact h01,
    have Hb : b^2 = |b|^2,
        have h01 := abs_mul_abs_self b,
        rw pow_two _, rw pow_two _, symmetry, exact h01,
    rw [Ha, Hb] at H2,

    split,
    intro j,
    rw j at H2, rw H3 at H2, simp at H2,
    rw mul_assoc at H2, rw mul_assoc at H2,
    have g : (|a| * |b|) = (a * b),
    linarith,
    have g2 : |a * b| = |a| * |b|, exact abs_mul _ _,
    rw ← g2 at g,
    by_contradiction hn, push_neg at hn,
    have g3 : |a * b| = -(a * b),
    exact abs_of_neg hn,
    rw g at g3, linarith,

    --add hints and comments and stuff
    intro k,
    have g : |a * b| = a * b,
    exact abs_of_nonneg k,
    have g2 : |a * b| = |a| * |b|,
    exact abs_mul _ _,
    rw g2 at g, rw mul_assoc 2 a b at H2,
    rw ← g at H2,
    have g3 : |a| ^ 2 + 2 * ( |a| * |b| ) + |b| ^ 2 = ( |a| + |b| )^2, ring,
    rw g3 at H2,
    have g4 : sqrt ( |a + b| ^ 2 ) = sqrt ( |a + b| ^ 2), refl,
    rw H2 at g4 {occs := occurrences.pos [2]},
    have hab : 0 ≤ |a + b|,  exact is_absolute_value.abv_nonneg abs (a+b),
    have ha : 0 ≤ |a|,  exact is_absolute_value.abv_nonneg abs a,
    have hb : 0 ≤ |b|,  exact is_absolute_value.abv_nonneg abs b,
    have hc : 0 ≤ |a| + |b|, linarith,
    have G := eq_sqr_to_eq ( |a + b| ) ( |a| + |b| ) hab hc H2, exact G,

end

end xena -- hide


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.nat.interval
import data.nat.prime
import group_theory.perm.sign
import tactic.fin_cases

example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *,
  simp, assumption,
  simp, assumption,
  simp, assumption,
end

example (f : ℕ → Prop) (p : fin 0) : f p.val :=
by fin_cases *

example (f : ℕ → Prop) (p : fin 1) (h : f 0) : f p.val :=
begin
  fin_cases p,
  assumption
end

example (x2 : fin 2) (x3 : fin 3) (n : nat) (y : fin n) : x2.val * x3.val = x3.val * x2.val :=
begin
  fin_cases x2;
  fin_cases x3,
  success_if_fail { fin_cases * },
  success_if_fail { fin_cases y },
  all_goals { refl },
end

open finset
example (x : ℕ) (h : x ∈ Ico 2 5) : x = 2 ∨ x = 3 ∨ x = 4 :=
begin
  fin_cases h,
  all_goals { simp }
end

open nat
example (x : ℕ) (h : x ∈ [2,3,5,7]) : x = 2 ∨ x = 3 ∨ x = 5 ∨ x = 7 :=
begin
  fin_cases h,
  all_goals { simp }
end

example (x : ℕ) (h : x ∈ [2,3,5,7]) : true :=
begin
  success_if_fail { fin_cases h with [3,3,5,7] },
  trivial
end

example (x : list ℕ) (h : x ∈ [[1],[2]]) : x.length = 1 :=
begin
  fin_cases h with [[1],[1+1]],
  simp,
  guard_target (list.length [1 + 1] = 1),
  simp
end

 -- testing that `with` arguments are elaborated with respect to the expected type:
example (x : ℤ) (h : x ∈ ([2,3] : list ℤ)) : x = 2 ∨ x = 3 :=
begin
  fin_cases h with [2,3],
  all_goals { simp }
end

instance (n : ℕ) : decidable (prime n) := decidable_prime_1 n
example (x : ℕ) (h : x ∈ (range 10).filter prime) : x = 2 ∨ x = 3 ∨ x = 5 ∨ x = 7 :=
begin
  fin_cases h; exact dec_trivial
end

open equiv.perm
example (x : (Σ (a : fin 4), fin 4)) (h : x ∈ fin_pairs_lt 4) : x.1.val < 4 :=
begin
  fin_cases h; simp,
  any_goals { exact dec_trivial },
end

example (x : fin 3) : x.val < 5 :=
begin
  fin_cases x; exact dec_trivial
end

example (f : ℕ → Prop) (p : fin 3) (h0 : f 0) (h1 : f 1) (h2 : f 2) : f p.val :=
begin
  fin_cases *,
  all_goals { assumption }
end

example (n : ℕ) (h : n % 3 ∈ [0,1]) : true :=
begin
  fin_cases h,
  guard_hyp h : n % 3 = 0, trivial,
  guard_hyp h : n % 3 = 1, trivial,
end


import .auxiliary ...mathlib.data.list.basic

variables {α β γ : Type}

namespace list

def update_nth_force : list α → ℕ → α → α → list α
| (x::xs) 0     a a' := a :: xs
| (x::xs) (i+1) a a' := x :: update_nth_force xs i a a'
| []      0     a a' := [a]
| []      (i+1) a a' := a' :: update_nth_force [] i a a'

def zip_pad (a' b') : list α → list β → list (α × β)
| [] [] := []
| [] (b::bs) := (a',b)::(zip_pad [] bs)
| (a::as) [] := (a,b')::(zip_pad as [])
| (a::as) (b::bs) := (a,b)::(zip_pad as bs)

lemma cons_zip_pad_cons {a b a' b'} {as : list α} {bs : list β} :
  zip_pad a' b' (a::as) (b::bs) = (a,b)::(zip_pad a' b' as bs) :=
begin unfold zip_pad end

@[simp] def map_mul [has_mul α] (a) (as : list α) : list α :=
list.map (λ x, a * x) as

@[simp] def map_neg [has_neg α] (as : list α) : list α :=
list.map (λ x, -x) as

def comp_add [has_zero α] [has_add α] (as1 as2 : list α) : list α :=
list.map (λ xy, prod.fst xy + prod.snd xy) (list.zip_pad 0 0 as1 as2)

def comp_sub [has_zero α] [has_neg α] [has_add α] (as1 as2 : list α) : list α :=
comp_add as1 (map_neg as2)

def dot_prod [has_zero α] [has_add α] [has_mul α] (as1 as2 : list α) : α :=
list.sum (list.map (λ xy, prod.fst xy * prod.snd xy) (list.zip_pad 0 0 as1 as2))

@[simp] lemma nil_dot_prod [semiring α] :
  ∀ (as : list α), dot_prod [] as = 0
| [] :=
  begin
    unfold dot_prod, unfold list.zip_pad, simp
  end
| (a::as) :=
  begin
    unfold dot_prod, unfold list.zip_pad,
    simp, apply nil_dot_prod
  end

@[simp] lemma dot_prod_nil [semiring α] :
  ∀ (as : list α), dot_prod as [] = 0
| [] :=
  begin
    unfold dot_prod, unfold list.zip_pad, simp
  end
| (a::as) :=
  begin
    unfold dot_prod, unfold list.zip_pad,
    simp, apply dot_prod_nil
  end

@[simp] lemma cons_dot_prod_cons [semiring α] (a1 a2 : α) (as1 as2 : list α) :
dot_prod (a1::as1) (a2::as2) = (a1 * a2) + dot_prod as1 as2 :=
begin unfold dot_prod, rewrite cons_zip_pad_cons, simp end

lemma nil_comp_add [semiring α] :
  ∀ (as : list α), comp_add [] as = as
| [] := rfl
| (a::as) :=
  begin
    unfold comp_add, unfold list.zip_pad,
    unfold list.map, simp,
    have h := nil_comp_add as,
    unfold comp_add at h, rewrite h
  end

lemma comp_add_nil [semiring α] :
  ∀ (as : list α), comp_add as [] = as
| [] := rfl
| (a::as) :=
  begin
    unfold comp_add, unfold list.zip_pad,
    simp, have h := comp_add_nil as,
    unfold comp_add at h, rewrite h
  end

lemma cons_comp_add_cons [semiring α] (a1 a2 : α) (as1 as2) :
comp_add (a1::as1) (a2::as2) = (a1 + a2)::(comp_add as1 as2) :=
begin unfold comp_add, unfold list.zip_pad, simp end

lemma comp_add_dot_prod [semiring α] :
  ∀ (as1 as2 as3 : list α), dot_prod (comp_add as1 as2) as3 = (dot_prod as1 as3) + (dot_prod as2 as3)
| [] as2 as3 :=
  begin
    rewrite nil_comp_add,
    rewrite nil_dot_prod, simp
  end
| as1 [] as3 :=
  begin
    rewrite comp_add_nil,
    rewrite nil_dot_prod, simp
  end
| as1 as2 [] :=
  begin repeat {rewrite dot_prod_nil}, simp end
| (a1::as1) (a2::as2) (a3::as3) :=
  begin
    rewrite cons_comp_add_cons,
    repeat {rewrite cons_dot_prod_cons},
    simp, rewrite add_mul, rewrite add_assoc,
    rewrite comp_add_dot_prod
  end

lemma map_mul_dot_prod [semiring α] (a : α) :
  ∀ (as1 as2), dot_prod (map_mul a as1) as2 = a * (dot_prod as1 as2)
| [] as2 :=
  begin
    unfold map_mul, simp,
    repeat {rewrite nil_dot_prod}
  end
| as1 [] :=
  begin
    repeat {rewrite dot_prod_nil},
    rewrite mul_zero
  end
| (a1::as1) (a2::as2) :=
  begin
    unfold map_mul, simp, repeat {rewrite cons_dot_prod_cons},
    have h := map_mul_dot_prod as1 as2, unfold map_mul at h,
    rewrite h, rewrite mul_add, simp, rewrite mul_assoc
  end

@[simp] lemma mul_dot_prod [semiring α] {a : α} {as1 as2} :
   a * (dot_prod as1 as2) = dot_prod (map_mul a as1) as2 :=
by rewrite map_mul_dot_prod

def neg_dot_prod [ring α] : ∀ (as1 as2 : list α),
  dot_prod (list.map (λ x, -x) as1) as2 = -(dot_prod as1 as2) :=
begin
  intros as1 as2,
  rewrite eq.symm (one_mul (dot_prod as1 as2)),
  rewrite neg_mul_eq_neg_mul, simp,
end

lemma sum_exp [has_zero α] [has_add α] (as : list α) :
  sum as = foldl (+) 0 as:= refl _

--def omap (f : α → option β) : list α → list β
--| [] := []
--| (a::as) :=
--  match f a with
--  | none := omap as
--  | (some b) := b::(omap as)
--  end
--
--lemma mem_omap {f : α → option β} {a} {b} (he : f a = some b) :
--  ∀ {as : list α} (HM : a ∈ as), b ∈ omap f as
--| [] hm := by cases hm
--| (a'::as) hm :=
--  begin
--    unfold has_mem.mem at hm, unfold list.mem at hm,
--    cases hm with hm hm, subst hm,
--    unfold omap, rewrite he, apply or.inl rfl,
--    unfold omap, cases (f a'),
--    apply mem_omap, apply hm,
--    apply or.inr, apply mem_omap, apply hm
--  end
--
--lemma mem_omap_of_mem_omap_tail {f : α → option β} {a} {b} :
--  ∀ {as : list α}, b ∈ omap f as → b ∈ omap f (a::as) :=
--begin
--  intros as h, unfold omap, cases (f a),
--  apply h, apply or.inr h
--end
--
--lemma exp_mem_omap {f : α → option β} {b : β} : ∀ {as : list α}, (b ∈ omap f as) ↔ ∃ a, a ∈ as ∧ some b = f a
--| [] :=
--  iff.intro
--    (by {intro h, cases h})
--    (begin intro h, cases h with a ha, cases ha^.elim_left end)
--| (a::as) :=
-- iff.intro
-- (begin
--    intro h, unfold omap at h,
--    cases (dest_option (f a)) with ho ho,
--    rewrite ho at h,
--    cases (exp_mem_omap^.elim_left h) with a' ha',
--    cases ha' with ha1' ha2',
--    existsi a', apply and.intro (or.inr ha1') ha2',
--    cases ho with b' hb', rewrite hb' at h,
--    unfold omap at h, rewrite mem_cons_iff at h,
--    cases h with h h, existsi a,
--    apply and.intro (or.inl rfl), rewrite h,
--    apply eq.symm hb',
--    cases (exp_mem_omap^.elim_left h) with a' ha',
--    cases ha' with ha1' ha2',
--    existsi a', apply and.intro (or.inr ha1') ha2'
--  end)
-- (begin
--   intro h, cases h with a' ha',
--   cases ha' with h1 h2, rewrite mem_cons_iff at h1,
--   cases h1 with h1 h1,
--   unfold omap, subst h1, rewrite eq.symm h2,
--   apply or.inl rfl, apply mem_omap_of_mem_omap_tail,
--   apply exp_mem_omap^.elim_right, existsi a',
--   apply and.intro h1 h2
--  end)

lemma exists_maximum [linear_order β] :
∀ (bs : list β) (hi : bs ≠ []), ∃ b, b ∈ bs ∧ ∀ b' ∈ bs, b' ≤ b
| [] hi := begin exfalso, apply hi rfl end
| [b] hi :=
  begin
    existsi b, apply and.intro (or.inl rfl),
    intros b' hb', cases hb' with hb' hb',
    subst hb', cases hb',
  end
| (b::b'::bs') hi :=
  begin
    cases (exists_maximum (b'::bs') _) with bm hbm,
    cases hbm with hbm1 hbm2,
    apply @classical.by_cases (b ≤ bm); intro hle,

    existsi bm, apply and.intro (or.inr hbm1),
    intros bl hbl, rewrite mem_cons_iff at hbl,
    cases hbl with hbl hbl, subst hbl, apply hle,
    apply hbm2 _ hbl,

    existsi b, apply and.intro (or.inl rfl),
    intros bl hbl, rewrite mem_cons_iff at hbl,
    cases hbl with hbl hbl, subst hbl,
    apply le_trans, apply hbm2 _ hbl,
    apply le_of_not_le hle,
    intro hc, cases hc
  end

lemma exists_minimum [hlo : linear_order β] :
∀ (bs : list β) (hi : bs ≠ []), ∃ b, b ∈ bs ∧ ∀ b' ∈ bs, b' ≥ b :=
@exists_maximum _ (converse_linear_order hlo)

lemma dest_list : ∀ (as : list α), as = [] ∨ ∃ a' as', as = (a'::as')
| [] := or.inl rfl
| (a::as) := begin apply or.inr, existsi a, existsi as, refl end

-- def list.product : list α → list β → list (α × β)
-- | [] _ := []
-- | (a1::l1) l2 := (list.map (λ a2, ⟨a1,a2⟩) l2) ++ list.product l1 l2

def pluck (p : α → Prop) [decidable_pred p] : list α → option (α × list α)
| []      := none
| (a::as) :=
  if p a
  then some (a, as)
  else do (a',as') ← pluck as,
          some (a',a::as')

def pluck_true (p : α → Prop) [decidable_pred p] (a as) (ha : p a) :
  pluck p (a::as) = some (a,as) :=
begin unfold pluck, rewrite ite_eq_of, apply ha end

def pluck_false (p : α → Prop) [decidable_pred p] (a as) (ha : ¬ p a) :
  pluck p (a::as)
  = (do (a',as') ← pluck p as, some (a',a::as') ) :=
begin unfold pluck, rewrite ite_eq_of_not, refl, apply ha end

/- equiv -/

def equiv (l1 l2 : list α) := l1 ⊆ l2 ∧ l2 ⊆ l1

notation l1 `≃` l2 := equiv l1 l2

def equiv.refl {l : list α} : l ≃ l :=
and.intro (subset.refl _) (subset.refl _)

def equiv.symm {as1 as2 : list α} : (as1 ≃ as2) → (as2 ≃ as1) :=
begin
  intro h, cases h with h1 h2,
  apply and.intro; assumption
end

lemma equiv.trans {l1 l2 l3 : list α} : (l1 ≃ l2) → (l2 ≃ l3) → (l1 ≃ l3) :=
begin
  intros h1 h2,
  cases h1 with h1a h1b, cases h2 with h2a h2b,
  apply and.intro (subset.trans h1a h2a) (subset.trans h2b h1b),
end

lemma subset.swap {a1 a2 : α} {l} : (a1::a2::l) ⊆ (a2::a1::l) :=
begin
  intros a ha, cases ha with ha ha,
  apply or.inr (or.inl ha), cases ha with ha ha,
  apply or.inl ha, apply or.inr (or.inr ha)
end

lemma equiv.swap {a1 a2 : α} {l} : (a1::a2::l) ≃ (a2::a1::l) :=
begin apply and.intro; apply subset.swap end

lemma cons_equiv_cons {a : α} {l1 l2} : (l1 ≃ l2) → ((a::l1) ≃ (a::l2)) :=
begin
  intro h, cases h with hl hr,
  apply and.intro; apply cons_subset_cons; assumption
end

lemma mem_iff_mem_of_equiv {as1 as2 : list α} :
  (as1 ≃ as2) → ∀ (a : α), a ∈ as1 ↔ a ∈ as2 :=
begin
  intros heqv a, cases heqv with hss1 hss2,
  apply iff.intro; intro hm,
  apply hss1; assumption,
  apply hss2; assumption
end

lemma map_union [decidable_eq α] [decidable_eq β]
  {f : α → β} {as1 as2 : list α} :
  map f (as1 ∪ as2) ≃ (map f as1) ∪ (map f as2) :=
begin
  apply and.intro; intros x hx,
  rewrite mem_map at hx, cases hx with y hy,
  cases hy with hy1 hy2, subst hy2,
  rewrite mem_union at hy1,
  cases hy1 with hym hym,
  apply mem_union_left, rewrite mem_map,
  existsi y, apply and.intro, assumption, refl,
  apply mem_union_right, rewrite mem_map,
  existsi y, apply and.intro, assumption, refl,
  rewrite mem_union at hx, cases hx with hx hx;
  rewrite mem_map at hx; cases hx with y hy;
  rewrite mem_map; existsi y; cases hy with hy1 hy2;
  apply and.intro _ hy2,
  apply mem_union_left hy1,
  apply mem_union_right _ hy1
end

lemma map_subset_map_of_subset
  {f : α → β} {as1 as2 : list α} :
  (as1 ⊆ as2) → (map f as1 ⊆ map f as2) :=
begin
  intros hss b hb,
  rewrite mem_map at *, cases hb with a ha,
  cases ha with ha1 ha2, subst ha2,
  existsi a, apply and.intro _ rfl,
  apply hss ha1
end

lemma map_equiv_map_of_equiv
  {f : α → β} {as1 as2 : list α} :
  (as1 ≃ as2) → (map f as1 ≃ map f as2) :=
begin
  intro heqv, cases heqv with hss1 hss2,
  apply and.intro;
  apply map_subset_map_of_subset; assumption
end

lemma union_subset_union_of_subset [decidable_eq α]
  {as1 as1' as2 : list α} : (as1 ⊆ as1') → (as1 ∪ as2 ⊆ as1' ∪ as2) :=
begin
  intros h a ha, rewrite mem_union at ha,
  cases ha with ha ha,
  apply mem_union_left, apply h ha,
  apply mem_union_right, apply ha
end

lemma union_equiv_union_of_equiv [decidable_eq α]
  {as1 as1' as2 : list α} : (as1 ≃ as1') → (as1 ∪ as2 ≃ as1' ∪ as2) :=
begin
  intro h, cases h with h1 h2,
  apply and.intro;
  apply union_subset_union_of_subset; assumption
end

lemma union_comm [decidable_eq α]
 {as1 as2 : list α} : (as1 ∪ as2 ≃ as2 ∪ as1) :=
begin
  apply and.intro; intros a ha;
  rewrite mem_union at ha; cases ha with ha ha;
  {apply mem_union_left ha <|> apply mem_union_right _ ha}
end

lemma filter_union [decidable_eq α]
  {P : α → Prop} [decidable_pred P]
  {as1 as2 : list α} :
  filter P (as1 ∪ as2) ≃ (filter P as1 ∪ filter P as2) :=
begin
  apply and.intro; intros a ha;
  rewrite mem_union at *; repeat {rewrite mem_filter at *};
  cases ha with ha1 ha2, rewrite mem_union at ha1,
  cases ha1 with hm hm, apply or.inl,
  apply and.intro; assumption, apply or.inr,
  apply and.intro; assumption,
  cases ha1 with hm hP,
  apply and.intro _ hP, apply mem_union_left hm,
  cases ha2 with hm hP,
  apply and.intro _ hP, apply mem_union_right _ hm
end

def anyp (P : α → Prop) (l : list α) := ∃ a, a ∈ l ∧ P a

lemma cases_pluck (P : α → Prop) [hd : decidable_pred P] : ∀ (as : list α),
(pluck P as = none ∧ (∀ x ∈ as, ¬ P x))
∨ ∃ (a) (as'), (pluck P as = some (a,as') ∧ P a ∧ (as ≃ (a::as')))
| [] :=
  begin
    apply or.inl, apply and.intro,
    unfold pluck, intros _ H, cases H
  end
| (a::as) :=
  begin
    cases (hd a) with ha ha,
    cases (cases_pluck as) with has has,

    apply or.inl, cases has with has1 has2,
    apply and.intro, rewrite pluck_false,
    rewrite has1, refl, apply ha,
    rewrite forall_mem_cons,
    apply and.intro ha has2,

    apply or.inr, cases has with a' has,
    cases has with as' has',
    cases has' with h1 has', cases has' with h2 h3,
    existsi a', existsi (a::as'),
    apply and.intro, rewrite pluck_false,
    rewrite h1, refl, apply ha, apply and.intro h2,
    apply equiv.trans, apply cons_equiv_cons,
    apply h3, apply equiv.swap,

    apply or.inr, existsi a, existsi as,
    apply and.intro, rewrite pluck_true, apply ha,
    apply and.intro ha equiv.refl
  end

@[simp] def nth_dft (a : α) (l : list α) (n : nat) : α :=
match nth l n with
| none := a
| (some a') := a'
end

def head_dft (a' : α) : list α → α
| [] := a'
| (a::as) := a

lemma nth_pred (a : α) (l : list α) (n : nat) (H : n > 0) :
nth (a::l) n = nth l (n - 1) :=
begin cases n, cases H, simp end

lemma nth_dft_pred {a a' : α} {l : list α} {n : nat} (H : n > 0) :
nth_dft a (a'::l) n = nth_dft a l (n - 1) :=
begin unfold nth_dft, rewrite nth_pred, apply H  end

lemma nth_dft_succ {a a' : α} {l : list α} {n : nat} :
nth_dft a (a'::l) (n+1) = nth_dft a l n :=
begin unfold nth_dft, simp  end

lemma nth_dft_head {a a' : α} {as : list α} : nth_dft a' (a::as) 0 = a :=
begin unfold nth_dft, simp end

@[simp] def append_pair {α : Type} : (list α × list α) → list α
| (l1,l2) := l1 ++ l2

def all_true (ps : list Prop) : Prop := ∀ (p : Prop), p ∈ ps → p

lemma all_true_nil : all_true [] :=
by {intros _ H, cases H}

-- def disj_list : list Prop → Prop
-- | [] := false
-- | (p::ps) := p ∨ disj_list ps

def some_true (ps : list Prop) : Prop := ∃ (p : Prop), p ∈ ps ∧ p

lemma some_true_nil : some_true [] ↔ false :=
begin
  apply iff.intro; intro h, cases h with p hp,
  cases hp^.elim_left, cases h
end

lemma some_true_cons (p ps) : some_true (p::ps) ↔ (p ∨ some_true ps) :=
begin
  apply iff.intro; intro h, cases h with q hq,
  cases hq with hq1 hq2, rewrite mem_cons_iff at hq1,
  cases hq1 with hq1 hq1, subst hq1, apply or.inl hq2,
  apply or.inr, existsi q, apply and.intro hq1 hq2,
  cases h with h h, existsi p, simp, apply h,
  cases h with q hq, cases hq with hq1 hq2,
  existsi q, apply and.intro (or.inr hq1) hq2
end

lemma some_true_append {ps1 ps2} : some_true (ps1 ++ ps2) ↔ (some_true ps1 ∨ some_true ps2) :=
begin
  apply iff.intro; intro h, cases h with p hp,
  cases hp with hp1 hp2, rewrite mem_append at hp1,
  cases hp1 with hp1 hp1,
  apply or.inl, existsi p, apply and.intro; assumption,
  apply or.inr, existsi p, apply and.intro; assumption,
  cases h with h h; cases h with p hp; cases hp with hp1 hp2;
  existsi p; apply and.intro,
  apply mem_append_left, apply hp1, apply hp2,
  apply mem_append_right, apply hp1, apply hp2
end

lemma forall_mem_append {P : α → Prop} {as1 as2 : list α} :
  (∀ a ∈ (as1 ++ as2), P a) ↔ ((∀ a ∈ as1, P a) ∧ (∀ a ∈ as2, P a)) :=
begin
  apply iff.intro; intro h,
  apply and.intro; intros a ha; apply h,
  apply mem_append_left _ ha,
  apply mem_append_right _ ha,
  intros a ha, rewrite mem_append at ha,
  cases h with hl hr, cases ha with ha ha,
  apply hl _ ha, apply hr _ ha
end
/-
lemma some_true_iff_disj_list :
  ∀ {ps : list Prop}, some_true ps ↔ disj_list ps
| [] :=
  begin
    unfold some_true, unfold disj_list,
    apply iff.intro; intro h, cases h with x hx,
    cases hx^.elim_left, exfalso, apply h
  end
| (p::ps) :=
  begin
    unfold some_true, unfold disj_list,
    apply iff.intro; intro h, cases h with x hx,
    cases hx with hx1 hx2, rewrite mem_cons_iff at hx1,
    cases hx1 with hx1 hx1, subst hx1, apply or.inl hx2,
    rewrite iff.symm some_true_iff_disj_list,
    apply or.inr, existsi x, apply and.intro hx1 hx2,
    cases h with h h, existsi p,
    apply and.intro (or.inl rfl) h,
    rewrite iff.symm some_true_iff_disj_list at h,
    cases h with x hx, existsi x, cases hx with hx1 hx2,
    apply and.intro (or.inr hx1) hx2
  end

lemma disj_list_iff_some_true : ∀ (ps : list Prop), disj_list ps ↔ some_true ps
| [] :=
  begin
    apply iff.intro, intro H, cases H,
    intro H, cases H with H1 H2, cases (H2^.elim_left)
  end
| (p::ps) :=
  begin
    apply iff.intro, intro H, cases H with H H,
    existsi p, apply and.intro,
    apply or.inl (eq.refl _), apply H,
    cases ((disj_list_iff_some_true ps)^.elim_left H) with p Hp,
    existsi p, apply and.intro,
    apply or.inr (Hp^.elim_left),
    apply Hp^.elim_right,
    unfold some_true, unfold disj_list,
    unfold has_mem.mem, unfold list.mem,
    intro H, cases H with p' Hp',
    cases (Hp'^.elim_left) with HM HM,
    apply or.inl, rewrite (eq.symm HM),
    apply Hp'^.elim_right,
    apply or.inr, rewrite disj_list_iff_some_true,
    existsi p', apply (and.intro HM Hp'^.elim_right)

  end
-/

-- lemma disj_list_dist_append (l1 l2 : list Prop) : disj_list (l1 ++ l2) = (disj_list l1 ∨ disj_list l2) :=
-- begin
--   repeat {rewrite disj_list_iff_some_true},
--   apply propext, apply iff.intro,
--   intro H, cases H with x Hx,
--   cases Hx with Hl Hr, cases (mem_or_mem_of_mem_append Hl) with HM HM,
--   apply or.inl, existsi x, apply and.intro HM Hr,
--   apply or.inr, existsi x, apply and.intro HM Hr,
--   intro H, cases H with H H; cases H with x Hx ; cases Hx with Hl Hr ; existsi x ; apply and.intro,
--   apply mem_append_of_mem_or_mem,
--   apply or.inl, apply Hl, apply Hr,
--   apply mem_append_of_mem_or_mem,
--   apply or.inr, apply Hl, apply Hr
-- end

-- def ex_arg_of_mem_map {f : α → β} {b : β} :
--   ∀ {as : list α}, (b ∈ list.map f as) → ∃ a, a ∈ as ∧ b = f a
-- | [] H := by cases H
-- | (a::as) H :=
--   begin
--     simp at H, cases H with H H, existsi a,
--     apply and.intro (or.inl (eq.refl _)) H,
--     cases (list.exists_of_mem_map H) with a' Ha',
--     existsi a', apply and.intro,
--     apply or.inr (Ha'^.elim_left),
--     apply Ha'^.elim_right
--   end

lemma fst_mem_of_mem_product :
  ∀ {as : list α} {bs : list β} {p : α × β},
    p ∈ (product as bs) → (prod.fst p) ∈ as
| [] bs b H := begin unfold product at H, cases H end
| (a::as) bs ab h :=
  begin
    unfold product at h, simp at h, cases h with h h,

    cases h with b hb, cases hb with hb1 hb2,
    rewrite eq.symm hb2, apply or.inl rfl,

    cases h with a' h, cases h with h1 h2,
    cases h2 with b hb, cases hb with hb1 hb2,
    rewrite eq.symm hb2, apply or.inr, apply h1
  end

lemma snd_mem_of_mem_product :
  ∀ {as : list α} {bs : list β} {p : α × β},
    p ∈ (product as bs) → (prod.snd p) ∈ bs
| [] bs b H := begin unfold product at H, cases H end
| (a::as) bs ab h :=
  begin
    unfold product at h, simp at h, cases h with h h,

    cases h with b hb, cases hb with hb1 hb2,
    rewrite eq.symm hb2, apply hb1,

    cases h with a' h, cases h with h1 h2,
    cases h2 with b hb, cases hb with hb1 hb2,
    rewrite eq.symm hb2, apply hb1
  end

lemma forall_mem_map_of_forall_mem (P : α → Prop) {Q : β → Prop} {f : α → β} {as} :
(∀ a ∈ as, P a) → (∀ a, P a → Q (f a)) → (∀ b ∈ (map f as), Q b) :=
begin
  intros has hf b hb,
  rewrite mem_map at hb,
  cases hb with a ha, cases ha with ha1 ha2,
  subst ha2, apply hf, apply has, apply ha1
end

lemma mem_product_of_mem_and_mem {as : list α} {bs : list β}
  {a : α} {b : β} (h : a ∈ as ∧ b ∈ bs) : (a,b) ∈ product as bs :=
begin rewrite mem_product, apply h end

lemma map_eq (f g : α → β) : ∀ (as : list α) (H : ∀ a ∈ as, f a = g a), map f as = map g as
| [] _ := eq.refl _
| (a::as) H :=
  begin
    unfold map, rewrite H, rewrite map_eq,
    intros a Ha, apply (H _ (or.inr Ha)),
    apply (or.inl (eq.refl _))
  end

meta def first_arg (f : α → tactic β) : list α → tactic β
| [] := tactic.failed
| (a::as) := f a <|> (first_arg as)

lemma forall_mem_filter_of_forall_mem {P Q : α → Prop} [H : decidable_pred Q]
  {as : list α} (h : ∀ a ∈ as, P a) : ∀ a ∈ (list.filter Q as), P a :=
begin
  intros a ha, apply h,
  apply mem_of_mem_filter ha
end

@[simp] def allp (P : α → Prop) (as : list α) := ∀ a ∈ as, P a

lemma allp_iff_forall_mem (P : α → Prop) (as : list α) :
  (allp P as) ↔ (∀ a ∈ as, P a) :=
by unfold allp

lemma map_one_mul [monoid α] :
  ∀ (l : list α), map (has_mul.mul (1 : α)) l = l
| [] := refl _
| (a::as) := begin simp, apply map_one_mul end

end list


import .prop_logic
import .bool_sat

open prop_logic
open prop_logic.var
open prop_logic.pExp

/-
An example: The 0th, 1st, and
2nd bits from the right in 100,
the binary numeral for decimal
4, are 0, 0, and 1, respectively.
-/
#eval mth_bit_from_right_in_n 2 4

/-
#1. Write and evaluate expressions
(using eval) to determine what is
the bit in the 9th position from
the right in the binary expansion
of the decimal number 8485672345?

Hint: don't use reduce here. Eval
uses hardware (machine) int values
to represent nats, while reduce
uses the unary nat representation.

Self-test: How much memory might
it take to represent the decimal
number, 8485672345, as a ℕ value
in unary? -- come back here
-/

#eval mth_bit_from_right_in_n 9 8485672345

/-
The next section presents examples
to set up test cases for definitions
to follow.
-/

/-
We define a few variables to use
in the rest of this assignment.
-/
def P : pExp:= varExp (mkVar 0)
def Q: pExp := varExp (mkVar 1)
def R : pExp := varExp (mkVar 2)

/-
We set parameter values used in
some function definitions to follow.
-/
def max_var_index := 2
def num_vars := max_var_index + 1

/-
An example of a propositional logic
expression.
-/
def theExpr : pExp := (pImpl P (P ∧ R))

/-
An example using the truth_table_results
function to compute and return a list of
the truth values of theExpr under each of
its possible interpretations.
-/
#eval truth_table_results theExpr num_vars

/-
#2. Define interp5 to be the interpretation
in the six row (m=5) of the truth table that
our interps_for_n_vars functions returns for
our three variables (P, Q, and R).

Hint: use the mth_interp_n_vars function.
Definitely check out the definition of the
function, and any specification text, even
if informal, given with the formal definition.
-/
#eval interps_for_n_vars 3
#eval truth_table_results P
def interp5 := mth_interp_n_vars 5 3

/-
#3. What Boolean values are assigned to
P, Q, and R by this interpretation (interp5)?
Use three #eval commands to compute answers by
evaluating each variable expressions under the
interp5 interpretation.
-/

#eval interp5 (mkVar 0) -- P
#eval interp5 (mkVar 1) -- Q
#eval interp5 (mkVar 2) -- R

/-
#4. Write a truth table within this
comment block showing the values for
P, Q, and R, in each row in the truth
table, represented by a corresponding
value in the list of interpretations
returned by interps_for_n_vars. Label
your columns as R, Q, and P, in that
order. (Try to understand why.)
Hint: Don't just write what you think
the answers are:, evaluate each of
the three variable expression under
each interpretation. You can use the
mth_interp_n_vars function if you want
to obtain interpretation functions for
each of the rows individually if you
want.

Answer:
    R   |   Q   |   P
  ----------------------
    F       F       F
    F       F       T
    F       T       F
    F       T       T
    T       F       F
    T       F       T
    T       T       F
    T       T       T
-/

/-
#5. Write an expression here to
compute the "results" column of
the truth table for "theExpr" as
defined above.
-/

#eval truth_table_results theExpr

/-
#6. Copy and paste the truth table
from question #4 here and extend it
with the results you just obtained.
Check the results for correctness.

Answer here:

    R   |   Q   |   P   | TheExpr
  --------------------------------
    F       F       F       T
    F       F       T       T
    F       T       F       T
    F       T       T       T
    T       F       F       F
    T       F       T       T
    T       T       F       F
    T       T       T       T

-/

/-
#7.

Write a "predicate" function, isModel,
that takes a propositional logic
expression, e, and an interpretation,
i, as its arguments and that returns
the Boolean true (tt) value if and only
if i is a model of e (otherwise false).
-/

def isModel :pExp → (var → bool) → bool
| pExp f := if ∀ (b : truth_table_results pExp f) then tt else ff

/-
#8. Write a one-line implementation
of a function, is_valid, that takes as
its arguments a propositional expression,
e, and the number of variables, n, in its
truth table, and that returns true if and
only if it is valid, construed to mean
tha every result in the list returned by
the truth_table_results function is true.

To do so, define and use a fold function
to reduce returned lists of Boolean truth
values to single truth values. Define and
use a bool-specific function, fold_bool :
    (bool → bool → bool) - binary operator
     →
    bool - identity element for that operator
    →
    (list bool) - list to be reduced

     →
    bool,
where the arguments are, respectively,
a binary operator, an identity element
for that operator, and a list of bools
to be reduced to a single bool result.
-/

def fold_bool :
    (bool → bool → bool) → bool → (list bool) → bool
| func id [] := id
| func id (list.cons (h) (t)) :=  func h ( fold_bool func id t )

#eval fold_bool band tt [tt,ff,tt]

def is_valid : pExp → ℕ → bool
|pExp num_vars := fold_bool band tt (truth_table_results pExp num_vars)

/-
Write similar one-line implementations of the
functions, is_satisfiable and is_unsatisfiable,
respectively. Do not use fold (directly) in your
implementation of is_unsatisfiable.
-/

def is_satisfiable : pExp → ℕ → bool
|pExp num_vars := if fold_bool bor ff (truth_table_results pExp num_vars)
  then tt
  else ff

def is_unsatisfiable : pExp → ℕ → bool
|pExp num_vars := if fold_bool bor ff (truth_table_results pExp num_vars)
  then ff
  else tt

/-
9. Use your is_valid function to determine which
of the following putative valid laws of reasoning
really are valid, and which ones are not. For each
one that is not, give a real-world scenario that
shows that the rule doesn't always lead to a valid
deduction. Use #eval to evaluate the validity of
each proposition. Use -- to put a comment after
each of the following definitions indicating
either "-- valid" or "-- NOT valid".
-/

def true_intro : pExp := pTrue -- valid
#eval is_valid true_intro 3
def false_elim := pImpl pFalse P -- valid
#eval is_valid false_elim 3
def and_intro := pImpl P (pImpl Q (P ∧ Q)) -- valid
#eval is_valid and_intro 3
def and_elim_left := pImpl (P ∧ Q) P  -- valid
#eval is_valid and_elim_left 3
def and_elim_right := pImpl (P ∧ Q) Q
#eval is_valid and_elim_right 3
def or_intro_left := pImpl P (P ∨ Q)
def or_intro_right := pImpl Q (P ∨ Q)
def or_elim := pImpl ( P ∨ Q) (pImpl (pImpl P R)  (pImpl (pImpl Q R)  R))
def iff_intro := pImpl (pImpl P Q) (pImpl(pImpl Q  P) (P ↔ Q))
def iff_elim_left := pImpl (P ↔ Q) (pImpl P Q)
def iff_elim_right := pImpl (P ↔ Q) (pImpl Q  P)
def arrow_elim := (pImpl P  Q) ( pImpl ( pImpl P  Q))
def affirm_consequence := (P ⇒ Q) ⇒ Q ⇒ P
def resolution := (P ∨ Q) ⇒ (¬ Q ∨ R) ⇒ (P ∨ R)
def unit_resolution := (P ∨ Q) ⇒ (¬ Q) ⇒ P
def syllogism := (P ⇒ Q) ⇒ (Q ⇒ R) ⇒ (P ⇒ R)
def modus_tollens := (P ⇒ Q) ⇒ ¬ Q ⇒ ¬ P
def neg_elim := ¬ ¬ P ⇒ P
def excluded_middle := P ∨ ¬ P
def neg_intro := (P ⇒ pFalse) ⇒ ¬ P
def affirm_disjunct := (P ∨ Q) ⇒ P ⇒ ¬ Q
def deny_antecedent := (P ⇒ Q) ⇒ (¬ P ⇒ ¬ Q)

-- Answer below


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import order.filter.at_top_bot
import algebra.archimedean

/-!
# `at_top` filter and archimedean (semi)rings/fields

In this file we prove that for a linear ordered archimedean semiring `R` and a function `f : α → ℕ`,
the function `coe ∘ f : α → R` tends to `at_top` along a filter `l` if and only if so does `f`.
We also prove that `coe : ℕ → R` tends to `at_top` along `at_top`, as well as version of these
two results for `ℤ` (and a ring `R`) and `ℚ` (and a field `R`).
-/

variables {α R : Type*}

open filter

lemma tendsto_coe_nat_at_top_iff [ordered_semiring R] [nontrivial R] [archimedean R]
  {f : α → ℕ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
tendsto_at_top_embedding (assume a₁ a₂, nat.cast_le) exists_nat_ge

lemma tendsto_coe_nat_at_top_at_top [ordered_semiring R] [archimedean R] :
  tendsto (coe : ℕ → R) at_top at_top :=
nat.mono_cast.tendsto_at_top_at_top exists_nat_ge

lemma tendsto_coe_int_at_top_iff [ordered_ring R] [nontrivial R] [archimedean R]
  {f : α → ℤ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
tendsto_at_top_embedding (assume a₁ a₂, int.cast_le) $
  assume r, let ⟨n, hn⟩ := exists_nat_ge r in ⟨(n:ℤ), hn⟩

lemma tendsto_coe_int_at_top_at_top [ordered_ring R] [archimedean R] :
  tendsto (coe : ℤ → R) at_top at_top :=
int.cast_mono.tendsto_at_top_at_top $ λ b,
  let ⟨n, hn⟩ := exists_nat_ge b in ⟨n, hn⟩

lemma tendsto_coe_rat_at_top_iff [linear_ordered_field R] [archimedean R]
  {f : α → ℚ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
tendsto_at_top_embedding (assume a₁ a₂, rat.cast_le) $
  assume r, let ⟨n, hn⟩ := exists_nat_ge r in ⟨(n:ℚ), by assumption_mod_cast⟩

variables [linear_ordered_semiring R] [archimedean R]
variables {l : filter α} {f : α → R} {r : R}

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the left) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.const_mul_at_top`). -/
lemma filter.tendsto.const_mul_at_top' (hr : 0 < r) (hf : tendsto f l at_top) :
  tendsto (λx, r * f x) l at_top :=
begin
  apply tendsto_at_top.2 (λb, _),
  obtain ⟨n : ℕ, hn : 1 ≤ n • r⟩ := archimedean.arch 1 hr,
  rw nsmul_eq_mul' at hn,
  filter_upwards [tendsto_at_top.1 hf (n * max b 0)],
  assume x hx,
  calc b ≤ 1 * max b 0 : by { rw [one_mul], exact le_max_left _ _ }
  ... ≤ (r * n) * max b 0 : mul_le_mul_of_nonneg_right hn (le_max_right _ _)
  ... = r * (n * max b 0) : by rw [mul_assoc]
  ... ≤ r * f x : mul_le_mul_of_nonneg_left hx (le_of_lt hr)
end

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the right) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.at_top_mul_const`). -/
lemma filter.tendsto.at_top_mul_const' (hr : 0 < r) (hf : tendsto f l at_top) :
  tendsto (λx, f x * r) l at_top :=
begin
  apply tendsto_at_top.2 (λb, _),
  obtain ⟨n : ℕ, hn : 1 ≤ n • r⟩ := archimedean.arch 1 hr,
  have hn' : 1 ≤ (n : R) * r, by rwa nsmul_eq_mul at hn,
  filter_upwards [tendsto_at_top.1 hf (max b 0 * n)],
  assume x hx,
  calc b ≤ max b 0 * 1 : by { rw [mul_one], exact le_max_left _ _ }
  ... ≤ max b 0 * (n * r) : mul_le_mul_of_nonneg_left hn' (le_max_right _ _)
  ... = (max b 0 * n) * r : by rw [mul_assoc]
  ... ≤ f x * r : mul_le_mul_of_nonneg_right hx (le_of_lt hr)
end


import algebra.big_operators.intervals
import algebra.big_operators.ring
import data.nat.prime
import algebra.associated
import data.int.basic
import tactic.ring

/-
Hungarian Mathematical Olympiad 1998, Problem 6

Let x, y, z be integers with z > 1. Show that

 (x + 1)² + (x + 2)² + ... + (x + 99)² ≠ yᶻ.
-/

open_locale big_operators

lemma sum_range_square_mul_six (n : ℕ) :
  (∑(i:ℕ) in finset.range n, (i+1)^2) * 6 = n * (n + 1) * (2*n + 1) :=
begin
  induction n with n ih,
  { refl },
  { have h : n.succ = n + 1 := rfl,
    rw[finset.sum_range_succ, add_mul, ih, h],
    ring,}
end

lemma sum_range_square (n : ℕ) :
  ∑(i:ℕ) in finset.range n, (i+1)^2 = n * (n + 1) * (2*n + 1)/6 :=
begin
  by rw [← sum_range_square_mul_six n, nat.mul_div_cancel]; exact dec_trivial
end

lemma cast_sum_square (n : ℕ) :
  ∑(i:ℕ) in finset.range n, ((i:ℤ)+1)^2 =
   (((∑(i:ℕ) in finset.range n, (i+1)^2):ℕ) :ℤ) :=
begin
 norm_cast
end

theorem hungary1998_q6 (x y : ℤ) (z : ℕ) (hz : 1 < z) :
    ∑(i : ℕ) in finset.range 99, (x + i + 1)^2 ≠ y^z :=
begin
  -- Suppose (x + 1)² + (x + 2)² + ... + (x + 99)² = yᶻ.

  intro he,

  -- We notice that
  -- y^z = (x + 1)² + (x + 2)² + ... + (x + 99)²
  --     = 99x² + 2(1 + 2 + ... + 99)x + (1² + 2² + ... + 99²)
  --     = 99x² + 2[(99 ⬝ 100)/2]x + (99 ⬝ 100 ⬝ 199)/6
  --     = 33(3x² + 300x + 50 ⬝ 199).

  have h2 : ∑(i : ℕ) in finset.range 99, (x^2) = 99 * x^2 := by norm_num,

  have h3 : ∑(i : ℕ) in finset.range 99, (2 * x * (i + 1)) =
         2 * x * ∑(i : ℕ) in finset.range 99, (i + 1) := finset.mul_sum.symm,

  have h4 : ∑(i : ℕ) in finset.range 99, ((i:ℤ) + 1) =
          ∑(i : ℕ) in finset.range 100, (i:ℤ) := by
  { rw[@finset.sum_range_succ' _ _ _ 99], refl},

  have h5 : ∑(i : ℕ) in finset.range 100, (i:ℤ) = 99 * 100 / 2,
  { rw[← nat.cast_sum, finset.sum_range_id], norm_num},

  have h6 : ∑(i : ℕ) in finset.range 99, ((i:ℤ) + 1)^2 = (99 * 100 * 199)/6,
  { rw[cast_sum_square, sum_range_square], norm_num },

  have h7 := calc y^z
      = ∑(i : ℕ) in finset.range 99, ((x + i) + 1)^2 : he.symm
  ... = ∑(i : ℕ) in finset.range 99,
          (x^2 + 2 * x * (i + 1) + (i + 1)^2) : by {congr, funext, ring}
  ... = ∑(i : ℕ) in finset.range 99, (x^2 + 2 * x * (i + 1)) +
         ∑(i : ℕ) in finset.range 99, ((i + 1)^2) : finset.sum_add_distrib
  ... = ∑(i : ℕ) in finset.range 99, (x^2) +
          ∑(i : ℕ) in finset.range 99, (2 * x * (i + 1)) +
         ∑(i : ℕ) in finset.range 99, ((i + 1)^2) : by rw[finset.sum_add_distrib]
  ... = 99 * x^2 + 2 * x * (99 * 100 / 2) +  (99 * 100 * 199)/6
        : by rw[h2, h3, h4, h5, h6]
  ... = 3 * (11 * (3 * x^2 + 300 * x + 50 * 199)) : by {norm_num, ring},

  -- which implies that 3∣y.
  have h8 : 3 ∣ y^z := dvd.intro _ (eq.symm h7),
  have h9 : 3 ∣ y := prime.dvd_of_dvd_pow int.prime_three h8,

  obtain ⟨k,hk⟩ := h9,
  rw[hk] at h7,
  cases z, { exact nat.not_lt_zero 1 hz },
  cases z, { exact nat.lt_asymm hz hz },
  rw[pow_succ,pow_succ] at h7,

  -- Since z ≥ 2, 3²∣yᶻ, but 3² does not divide
  -- 33(3x² + 300x + 50 ⬝ 199), contradiction.

  have h10 : 3 * k * (3 * k * (3 * k) ^ z) = 3 * (k * (3 * k * (3 * k) ^ z))
       := by ring,
  rw[h10] at h7,

  have h11 : (3:ℤ) ≠ 0 := by norm_num,

  have h12 : k * (3 * k * (3 * k) ^ z) = (11 * (3 * x ^ 2 + 300 * x + 50 * 199)),
  { exact (mul_right_inj' h11).mp h7 },

  have h14 : (k * (3 * k * (3 * k) ^ z)) = (3 * (k * k * (3 * k) ^ z)) :=
    by ring,
  have h16 : 11 * (3 * x ^ 2 + 300 * x + 50 * 199) =
    3 * (11 * (x ^ 2 + 100 * x + 3316) + 7) + 1 := by ring,

  rw[h14,h16] at h12,

  have h18 : (3 * (k * k * (3 * k) ^ z)) % 3 =
    (3 * (11 * (x ^ 2 + 100 * x + 3316) + 7) + 1) % 3 :=
    congr_fun (congr_arg has_mod.mod h12) 3,

  have h19 : (3 * (11 * (x ^ 2 + 100 * x + 3316) + 7) + 1) % 3 =
   (((3 * (11 * (x ^ 2 + 100 * x + 3316) + 7))% 3) + (1%3)) % 3 :=
   int.add_mod _ _ _,
  rw[h19] at h18,
  norm_num at h18,
end


/-
Copyright (c) 2022 Chris Birkbeck. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Birkbeck, David Loeffler
-/

import algebra.module.submodule.basic
import analysis.complex.upper_half_plane.basic
import order.filter.zero_and_bounded_at_filter

/-!
# Bounded at infinity

For complex valued functions on the upper half plane, this file defines the filter `at_im_infty`
required for defining when functions are bounded at infinity and zero at infinity.
Both of which are relevant for defining modular forms.

-/

open complex filter

open_locale topology upper_half_plane

noncomputable theory

namespace upper_half_plane

/-- Filter for approaching `i∞`. -/
def at_im_infty := filter.at_top.comap upper_half_plane.im

lemma at_im_infty_basis : (at_im_infty).has_basis (λ _, true) (λ (i : ℝ), im ⁻¹' set.Ici i) :=
filter.has_basis.comap upper_half_plane.im filter.at_top_basis

lemma at_im_infty_mem (S : set ℍ) : S ∈ at_im_infty ↔ (∃ A : ℝ, ∀ z : ℍ, A ≤ im z → z ∈ S) :=
begin
  simp only [at_im_infty, filter.mem_comap', filter.mem_at_top_sets, ge_iff_le, set.mem_set_of_eq,
    upper_half_plane.coe_im],
  refine ⟨λ ⟨a, h⟩, ⟨a, (λ z hz, h (im z) hz rfl)⟩, _⟩,
  rintro ⟨A, h⟩,
  refine ⟨A, λ b hb x hx, h x _⟩,
  rwa hx,
end

/-- A function ` f : ℍ → α` is bounded at infinity if it is bounded along `at_im_infty`. -/
def is_bounded_at_im_infty {α : Type*} [has_norm α] (f : ℍ → α) : Prop :=
bounded_at_filter at_im_infty f

/-- A function ` f : ℍ → α` is zero at infinity it is zero along `at_im_infty`. -/
def is_zero_at_im_infty {α : Type*} [has_zero α] [topological_space α] (f : ℍ → α) : Prop :=
zero_at_filter at_im_infty f

lemma zero_form_is_bounded_at_im_infty {α : Type*} [normed_field α] :
  is_bounded_at_im_infty (0 : ℍ → α) := const_bounded_at_filter at_im_infty (0:α)

/-- Module of functions that are zero at infinity. -/
def zero_at_im_infty_submodule (α : Type*) [normed_field α] : submodule α (ℍ → α) :=
zero_at_filter_submodule at_im_infty

/-- ubalgebra of functions that are bounded at infinity. -/
def bounded_at_im_infty_subalgebra (α : Type*) [normed_field α] : subalgebra α (ℍ → α) :=
bounded_filter_subalgebra at_im_infty

lemma is_bounded_at_im_infty.mul {f g : ℍ → ℂ} (hf : is_bounded_at_im_infty f)
  (hg : is_bounded_at_im_infty g) : is_bounded_at_im_infty (f * g) :=
by simpa only [pi.one_apply, mul_one, norm_eq_abs] using hf.mul hg

lemma bounded_mem (f : ℍ → ℂ) :
  is_bounded_at_im_infty f ↔ ∃ (M A : ℝ), ∀ z : ℍ, A ≤ im z → abs (f z) ≤ M :=
by simp [is_bounded_at_im_infty, bounded_at_filter, asymptotics.is_O_iff, filter.eventually,
    at_im_infty_mem]

lemma zero_at_im_infty (f : ℍ → ℂ) :
  is_zero_at_im_infty f ↔ ∀ ε : ℝ, 0 < ε → ∃ A : ℝ, ∀ z : ℍ, A ≤ im z → abs (f z) ≤ ε :=
begin
  rw [is_zero_at_im_infty, zero_at_filter, tendsto_iff_forall_eventually_mem],
  split,
  {  simp_rw [filter.eventually, at_im_infty_mem],
    intros h ε hε,
    simpa using (h (metric.closed_ball (0 : ℂ) ε) (metric.closed_ball_mem_nhds (0 : ℂ) hε))},
  { simp_rw metric.mem_nhds_iff,
    intros h s hs,
    simp_rw [filter.eventually, at_im_infty_mem],
    obtain ⟨ε, h1, h2⟩ := hs,
    have h11 : 0 < (ε/2), by {linarith,},
    obtain ⟨A, hA⟩ := (h (ε/2) h11),
    use A,
    intros z hz,
    have hzs : f z ∈ s,
    { apply h2,
      simp only [mem_ball_zero_iff, norm_eq_abs],
      apply lt_of_le_of_lt (hA z hz),
      linarith },
    apply hzs,}
end

end upper_half_plane


theorem add_le_add_right {a b : mynat} : a ≤ b → ∀ t, (a + t) ≤ (b + t) :=
begin
intros h t,
cases h with c hc,
rw hc,
use c,
rw add_right_comm,
refl,
end


/-
Consideraciones:
  - Este ejercicio se puede resolver usando unicamente las herramientas vistas en clase, como
    intro, apply y by_contradiction.
  - Recuerde apoyarse en Lean_Tactics, pdf disponible en el material de la clase 2, sumado a lo
    visto en auxiliar y los ejemplos presentados en la Demo de Lean, clase 2.
Mucho exito!
-/

lemma Proof_1 (A B : Prop) : A → ¬ (¬ A ∧ B) :=
begin
    -- Complete
end

lemma Proof_2 (A B : Prop) : (¬ A ∧ ¬ B) → ¬ (A ∨ B) :=
begin
    -- Complete
end

lemma Proof_3 (A B C : Prop) : A → (B ∨ C) → (A ∧ B) ∨ (A ∧ C) :=
begin
    -- Complete
end


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Mario Carneiro
-/

import algebra.algebra.basic
import algebra.category.Ring.basic
import ring_theory.ideal.operations

/-!

# Local rings

Define local rings as commutative rings having a unique maximal ideal.

## Main definitions

* `local_ring`: A predicate on commutative semirings, stating that for any pair of elements that
  adds up to `1`, one of them is a unit. This is shown to be equivalent to the condition that there
  exists a unique maximal ideal.
* `local_ring.maximal_ideal`: The unique maximal ideal for a local rings. Its carrier set is the
  set of non units.
* `is_local_ring_hom`: A predicate on semiring homomorphisms, requiring that it maps nonunits
  to nonunits. For local rings, this means that the image of the unique maximal ideal is again
  contained in the unique maximal ideal.
* `local_ring.residue_field`: The quotient of a local ring by its maximal ideal.

-/

universes u v w u'

variables {R : Type u} {S : Type v} {T : Type w} {K : Type u'}

/-- A semiring is local if it is nontrivial and `a` or `b` is a unit whenever `a + b = 1`.
Note that `local_ring` is a predicate. -/
class local_ring (R : Type u) [semiring R] extends nontrivial R : Prop :=
of_is_unit_or_is_unit_of_add_one ::
(is_unit_or_is_unit_of_add_one {a b : R} (h : a + b = 1) : is_unit a ∨ is_unit b)

section comm_semiring
variables [comm_semiring R]

namespace local_ring

lemma of_is_unit_or_is_unit_of_is_unit_add [nontrivial R]
  (h : ∀ a b : R, is_unit (a + b) → is_unit a ∨ is_unit b) :
  local_ring R :=
⟨λ a b hab,  h a b $ hab.symm ▸ is_unit_one⟩

/-- A semiring is local if it is nontrivial and the set of nonunits is closed under the addition. -/
lemma of_nonunits_add [nontrivial R]
  (h : ∀ a b : R, a ∈ nonunits R → b ∈ nonunits R → a + b ∈ nonunits R) :
  local_ring R :=
⟨λ a b hab, or_iff_not_and_not.2 $ λ H, h a b H.1 H.2 $ hab.symm ▸ is_unit_one⟩

/-- A semiring is local if it has a unique maximal ideal. -/
lemma of_unique_max_ideal (h : ∃! I : ideal R, I.is_maximal) :
  local_ring R :=
@of_nonunits_add _ _ (nontrivial_of_ne (0 : R) 1 $
  let ⟨I, Imax, _⟩ := h in (λ (H : 0 = 1), Imax.1.1 $ I.eq_top_iff_one.2 $ H ▸ I.zero_mem)) $
  λ x y hx hy H,
    let ⟨I, Imax, Iuniq⟩ := h in
    let ⟨Ix, Ixmax, Hx⟩ := exists_max_ideal_of_mem_nonunits hx in
    let ⟨Iy, Iymax, Hy⟩ := exists_max_ideal_of_mem_nonunits hy in
    have xmemI : x ∈ I, from Iuniq Ix Ixmax ▸ Hx,
    have ymemI : y ∈ I, from Iuniq Iy Iymax ▸ Hy,
    Imax.1.1 $ I.eq_top_of_is_unit_mem (I.add_mem xmemI ymemI) H

lemma of_unique_nonzero_prime (h : ∃! P : ideal R, P ≠ ⊥ ∧ ideal.is_prime P) :
  local_ring R :=
of_unique_max_ideal begin
  rcases h with ⟨P, ⟨hPnonzero, hPnot_top, _⟩, hPunique⟩,
  refine ⟨P, ⟨⟨hPnot_top, _⟩⟩, λ M hM, hPunique _ ⟨_, ideal.is_maximal.is_prime hM⟩⟩,
  { refine ideal.maximal_of_no_maximal (λ M hPM hM, ne_of_lt hPM _),
    exact (hPunique _ ⟨ne_bot_of_gt hPM, ideal.is_maximal.is_prime hM⟩).symm },
  { rintro rfl,
    exact hPnot_top (hM.1.2 P (bot_lt_iff_ne_bot.2 hPnonzero)) },
end

variables [local_ring R]

lemma is_unit_or_is_unit_of_is_unit_add {a b : R} (h : is_unit (a + b)) :
  is_unit a ∨ is_unit b :=
begin
  rcases h with ⟨u, hu⟩,
  rw [←units.inv_mul_eq_one, mul_add] at hu,
  apply or.imp _ _ (is_unit_or_is_unit_of_add_one hu);
    exact is_unit_of_mul_is_unit_right,
end

lemma nonunits_add {a b : R} (ha : a ∈ nonunits R) (hb : b ∈ nonunits R) : a + b ∈ nonunits R:=
λ H, not_or ha hb (is_unit_or_is_unit_of_is_unit_add H)

variables (R)

/-- The ideal of elements that are not units. -/
def maximal_ideal : ideal R :=
{ carrier := nonunits R,
  zero_mem' := zero_mem_nonunits.2 $ zero_ne_one,
  add_mem' := λ x y hx hy, nonunits_add hx hy,
  smul_mem' := λ a x, mul_mem_nonunits_right }

instance maximal_ideal.is_maximal : (maximal_ideal R).is_maximal :=
begin
  rw ideal.is_maximal_iff,
  split,
  { intro h, apply h, exact is_unit_one },
  { intros I x hI hx H,
    erw not_not at hx,
    rcases hx with ⟨u,rfl⟩,
    simpa using I.mul_mem_left ↑u⁻¹ H }
end

lemma maximal_ideal_unique : ∃! I : ideal R, I.is_maximal :=
⟨maximal_ideal R, maximal_ideal.is_maximal R,
  λ I hI, hI.eq_of_le (maximal_ideal.is_maximal R).1.1 $
  λ x hx, hI.1.1 ∘ I.eq_top_of_is_unit_mem hx⟩

variable {R}

lemma eq_maximal_ideal {I : ideal R} (hI : I.is_maximal) : I = maximal_ideal R :=
unique_of_exists_unique (maximal_ideal_unique R) hI $ maximal_ideal.is_maximal R

lemma le_maximal_ideal {J : ideal R} (hJ : J ≠ ⊤) : J ≤ maximal_ideal R :=
begin
  rcases ideal.exists_le_maximal J hJ with ⟨M, hM1, hM2⟩,
  rwa ←eq_maximal_ideal hM1
end

@[simp] lemma mem_maximal_ideal (x) : x ∈ maximal_ideal R ↔ x ∈ nonunits R := iff.rfl

end local_ring

end comm_semiring

section comm_ring
variables [comm_ring R]

namespace local_ring

lemma of_is_unit_or_is_unit_one_sub_self [nontrivial R]
  (h : ∀ a : R, is_unit a ∨ is_unit (1 - a)) : local_ring R :=
⟨λ a b hab, add_sub_cancel' a b ▸ hab.symm ▸ h a⟩

variables [local_ring R]

lemma is_unit_or_is_unit_one_sub_self (a : R) : is_unit a ∨ is_unit (1 - a) :=
is_unit_or_is_unit_of_is_unit_add $ (add_sub_cancel'_right a 1).symm ▸ is_unit_one

lemma is_unit_of_mem_nonunits_one_sub_self (a : R) (h : 1 - a ∈ nonunits R) :
  is_unit a :=
or_iff_not_imp_right.1 (is_unit_or_is_unit_one_sub_self a) h

lemma is_unit_one_sub_self_of_mem_nonunits (a : R) (h : a ∈ nonunits R) :
  is_unit (1 - a) :=
or_iff_not_imp_left.1 (is_unit_or_is_unit_one_sub_self a) h

lemma of_surjective' [comm_ring S] [nontrivial S] (f : R →+* S) (hf : function.surjective f) :
  local_ring S :=
of_is_unit_or_is_unit_one_sub_self
begin
  intros b,
  obtain ⟨a, rfl⟩ := hf b,
  apply (is_unit_or_is_unit_one_sub_self a).imp f.is_unit_map _,
  rw [← f.map_one, ← f.map_sub],
  apply f.is_unit_map,
end

end local_ring

end comm_ring

/-- A local ring homomorphism is a homomorphism `f` between local rings such that `a` in the domain
  is a unit if `f a` is a unit for any `a`. See `local_ring.local_hom_tfae` for other equivalent
  definitions. -/
class is_local_ring_hom [semiring R] [semiring S] (f : R →+* S) : Prop :=
(map_nonunit : ∀ a, is_unit (f a) → is_unit a)

section
variables [semiring R] [semiring S] [semiring T]

instance is_local_ring_hom_id (R : Type*) [semiring R] : is_local_ring_hom (ring_hom.id R) :=
{ map_nonunit := λ a, id }

@[simp] lemma is_unit_map_iff (f : R →+* S) [is_local_ring_hom f] (a) :
  is_unit (f a) ↔ is_unit a :=
⟨is_local_ring_hom.map_nonunit a, f.is_unit_map⟩

@[simp] lemma map_mem_nonunits_iff (f : R →+* S) [is_local_ring_hom f] (a) :
  f a ∈ nonunits S ↔ a ∈ nonunits R :=
⟨λ h ha, h $ (is_unit_map_iff f a).mpr ha, λ h ha, h $ (is_unit_map_iff f a).mp ha⟩

instance is_local_ring_hom_comp
  (g : S →+* T) (f : R →+* S) [is_local_ring_hom g] [is_local_ring_hom f] :
  is_local_ring_hom (g.comp f) :=
{ map_nonunit := λ a, is_local_ring_hom.map_nonunit a ∘ is_local_ring_hom.map_nonunit (f a) }

instance is_local_ring_hom_equiv (f : R ≃+* S) :
  is_local_ring_hom (f : R →+* S) :=
{ map_nonunit := λ a ha,
  begin
    convert (f.symm : S →+* R).is_unit_map ha,
    exact (ring_equiv.symm_apply_apply f a).symm,
  end }

@[simp] lemma is_unit_of_map_unit (f : R →+* S) [is_local_ring_hom f]
  (a) (h : is_unit (f a)) : is_unit a :=
is_local_ring_hom.map_nonunit a h

theorem of_irreducible_map (f : R →+* S) [h : is_local_ring_hom f] {x}
  (hfx : irreducible (f x)) : irreducible x :=
⟨λ h, hfx.not_unit $ is_unit.map f h, λ p q hx, let ⟨H⟩ := h in
or.imp (H p) (H q) $ hfx.is_unit_or_is_unit $ f.map_mul p q ▸ congr_arg f hx⟩

lemma is_local_ring_hom_of_comp (f : R →+* S) (g : S →+* T) [is_local_ring_hom (g.comp f)] :
  is_local_ring_hom f :=
⟨λ a ha, (is_unit_map_iff (g.comp f) _).mp (g.is_unit_map ha)⟩

instance _root_.CommRing.is_local_ring_hom_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T)
  [is_local_ring_hom g] [is_local_ring_hom f] :
  is_local_ring_hom (f ≫ g) := is_local_ring_hom_comp _ _

/-- If `f : R →+* S` is a local ring hom, then `R` is a local ring if `S` is. -/
lemma _root_.ring_hom.domain_local_ring {R S : Type*} [comm_semiring R] [comm_semiring S]
  [H : _root_.local_ring S] (f : R →+* S)
  [is_local_ring_hom f] : _root_.local_ring R :=
begin
  haveI : nontrivial R := pullback_nonzero f f.map_zero f.map_one,
  apply local_ring.of_nonunits_add,
  intros a b,
  simp_rw [←map_mem_nonunits_iff f, f.map_add],
  exact local_ring.nonunits_add
end

section
open category_theory

lemma is_local_ring_hom_of_iso {R S : CommRing} (f : R ≅ S) : is_local_ring_hom f.hom :=
{ map_nonunit := λ a ha,
  begin
    convert f.inv.is_unit_map ha,
    rw category_theory.iso.hom_inv_id_apply,
  end }

@[priority 100] -- see Note [lower instance priority]
instance is_local_ring_hom_of_is_iso {R S : CommRing} (f : R ⟶ S) [is_iso f] :
  is_local_ring_hom f :=
is_local_ring_hom_of_iso (as_iso f)

end

end

section
open local_ring
variables [comm_semiring R] [local_ring R] [comm_semiring S] [local_ring S]

/--
The image of the maximal ideal of the source is contained within the maximal ideal of the target.
-/
lemma map_nonunit (f : R →+* S) [is_local_ring_hom f] (a : R) (h : a ∈ maximal_ideal R) :
  f a ∈ maximal_ideal S :=
λ H, h $ is_unit_of_map_unit f a H

end

namespace local_ring

section
variables [comm_semiring R] [local_ring R] [comm_semiring S] [local_ring S]

/--
A ring homomorphism between local rings is a local ring hom iff it reflects units,
i.e. any preimage of a unit is still a unit. https://stacks.math.columbia.edu/tag/07BJ
-/
theorem local_hom_tfae (f : R →+* S) :
  tfae [is_local_ring_hom f,
        f '' (maximal_ideal R).1 ⊆ maximal_ideal S,
        (maximal_ideal R).map f ≤ maximal_ideal S,
        maximal_ideal R ≤ (maximal_ideal S).comap f,
        (maximal_ideal S).comap f = maximal_ideal R] :=
begin
  tfae_have : 1 → 2, rintros _ _ ⟨a,ha,rfl⟩,
    resetI, exact map_nonunit f a ha,
  tfae_have : 2 → 4, exact set.image_subset_iff.1,
  tfae_have : 3 ↔ 4, exact ideal.map_le_iff_le_comap,
  tfae_have : 4 → 1, intro h, fsplit, exact λ x, not_imp_not.1 (@h x),
  tfae_have : 1 → 5, intro, resetI, ext,
    exact not_iff_not.2 (is_unit_map_iff f x),
  tfae_have : 5 → 4, exact λ h, le_of_eq h.symm,
  tfae_finish,
end

end

lemma of_surjective [comm_semiring R] [local_ring R] [comm_semiring S] [nontrivial S]
  (f : R →+* S) [is_local_ring_hom f] (hf : function.surjective f) :
  local_ring S :=
of_is_unit_or_is_unit_of_is_unit_add
begin
  intros a b hab,
  obtain ⟨a, rfl⟩ := hf a,
  obtain ⟨b, rfl⟩ := hf b,
  rw ←map_add at hab,
  exact (is_unit_or_is_unit_of_is_unit_add $ is_local_ring_hom.map_nonunit _ hab).imp
    f.is_unit_map f.is_unit_map
end

section
variables (R) [comm_ring R] [local_ring R] [comm_ring S] [local_ring S]

/-- The residue field of a local ring is the quotient of the ring by its maximal ideal. -/
def residue_field := R ⧸ maximal_ideal R

noncomputable instance residue_field.field : field (residue_field R) :=
ideal.quotient.field (maximal_ideal R)

noncomputable instance : inhabited (residue_field R) := ⟨37⟩

/-- The quotient map from a local ring to its residue field. -/
def residue : R →+* (residue_field R) :=
ideal.quotient.mk _

noncomputable
instance residue_field.algebra : algebra R (residue_field R) := (residue R).to_algebra

variables {R}

namespace residue_field

/-- The map on residue fields induced by a local homomorphism between local rings -/
noncomputable def map (f : R →+* S) [is_local_ring_hom f] :
  residue_field R →+* residue_field S :=
ideal.quotient.lift (maximal_ideal R) ((ideal.quotient.mk _).comp f) $
λ a ha,
begin
  erw ideal.quotient.eq_zero_iff_mem,
  exact map_nonunit f a ha
end

end residue_field

lemma ker_eq_maximal_ideal [field K] (φ : R →+* K) (hφ : function.surjective φ) :
  φ.ker = maximal_ideal R :=
local_ring.eq_maximal_ideal $ (ring_hom.ker_is_maximal_of_surjective φ) hφ

end

end local_ring

namespace field
variables (K) [field K]

open_locale classical

@[priority 100] -- see Note [lower instance priority]
instance : local_ring K :=
local_ring.of_is_unit_or_is_unit_one_sub_self $ λ a,
  if h : a = 0
  then or.inr (by rw [h, sub_zero]; exact is_unit_one)
  else or.inl $ is_unit.mk0 a h

end field


prelude
import init.meta init.logic init.data.nat.lemmas
import init.data.char.basic

namespace char
lemma val_of_nat_eq_of_is_valid {n : nat} : is_valid_char n → (of_nat n).val = n :=
by intro h; unfold of_nat; rw [dif_pos h]

lemma val_of_nat_eq_of_not_is_valid {n : nat} : ¬ is_valid_char n → (of_nat n).val = 0 :=
by intro h; unfold of_nat; rw [dif_neg h]

lemma of_nat_eq_of_not_is_valid {n : nat} : ¬ is_valid_char n → of_nat n = of_nat 0 :=
by intro h; apply eq_of_veq; rw [val_of_nat_eq_of_not_is_valid h]; reflexivity

lemma of_nat_ne_of_ne {n₁ n₂ : nat} (h₁ : n₁ ≠ n₂) (h₂ : is_valid_char n₁) (h₃ : is_valid_char n₂) : of_nat n₁ ≠ of_nat n₂ :=
begin
  apply ne_of_vne,
  rw [val_of_nat_eq_of_is_valid h₂, val_of_nat_eq_of_is_valid h₃],
  assumption
end
end char