/-
-/
import tactic
import data.real.basic
import data.set.intervals.basic
import algebra.order.floor

variables (a b : ℝ)
open set
def I := {x : ℝ // x ∈ Icc a b}

/-Defines convegences for sequences on I a b-/
def Itendsto (s : ℕ → I a b) (t : I a b) : Prop :=
  ∀ ε > 0, ∃ B : ℕ, ∀ n, B ≤ n → |(s n).val - t.val| < ε

/-Defines convergence for sequences on ℝ-/
def Rtendsto (s : ℕ → ℝ) (t : ℝ) : Prop :=
  ∀ ε > 0, ∃ B : ℕ, ∀ n, B ≤ n → |s n - t| < ε

/-Defines pointwise continuity for a point of type I a b-/
def I_pt_continuity (f : I a b → ℝ) (x : I a b) : Prop :=
  ∀ ε > 0, ∃ δ > 0, ∀ y : I a b, |x.val - y.val| < δ → |f x - f y| < ε

/-Defines the property of continuity for type I a b-/
def I_continuity (f : I a b → ℝ) : Prop :=
  ∀ (x : I a b), I_pt_continuity a b f x

/-For f on I a b, pointwise continuity at x is equivalent to sequential continuity at that point.-/
lemma I_cont_sql_cont_pt (a b : ℝ) (f : I a b → ℝ) (x : I a b):
I_pt_continuity a b f x ↔ ∀ (s : {seq : ℕ → I a b // Itendsto a b seq x}), Rtendsto (f ∘ s) (f x) :=
begin
  /-Separate right and left implication-/
  split,
  /-Forward case is fairly simple, for sequence s with ε > 0, find δ neighbourhood s.t. the image
      of this neighbourhood is within ε of f x. Then find sufficiently large N s.t. s is in the neighbourhood.-/
    /-Intro continuity property, sequence s and ε-/
    intros hcontin s ε hε,
    /-Extract δ neighbourhood with δ > 0.-/
    cases hcontin ε hε with δ,
    cases h with hδ,
    /-Extract N large enough s.t. s is in the δ neighbourhood above N.-/
    cases s.property δ hδ with N,
    use N,
    intros n hn,
    /-Adapt goal slightly.-/
    suffices hs1 : |f x - f (s.val n)| < ε,
      dsimp,
      rw abs_sub_comm,
      exact hs1,
    /-Show its sufficient that s is in the δ neighbourhood.-/
    suffices : |x.val - (s.val n).val| < δ,
      exact h_h (s.val n) this,
    rw abs_sub_comm x.val (s.val n).val,
    /-Goal is exactly the earlier proof that s is in the δ neighbourhood.-/
    exact h n hn,

  /-Backwards case proceeds by assuming the goal is not true and finding a
    sequence tn s.t. tn → x but f tn doesnt tend to f x. -/
    /-intros ε > 0.-/
    intros s,
    intros ε hε,
    /-intros negation of goal to find contradiction.-/
    by_contra,
    push_neg at h,
    /-define sequence we'll bound our target sequence with.-/
    let sn : ℕ → ℝ := λ n, (1 : ℝ) / (n + (1 : ℝ)),
    /-obtain sequence tn which converges to x, at least ε from f x-/
    have h₁ : ∀ (n : ℕ), ∃ (y : I a b), |x.val - y.val| < sn n ∧ ε ≤ |f x - f y|,
      intros n,
      exact h (sn n) nat.one_div_pos_of_nat,
    choose tn htn using h₁,
    /-show tn converges to x in I a b.-/
    have h₂ : Itendsto a b tn x,
      intros ε1 hε1,
      /-will choose a val greater than 1/ε1, then bound |tn - x| by sn val -/
      use ⌈1/ε1⌉₊,
      intros n hn,
      rw abs_sub_comm (tn n).val x.val,
      /-show its sufficient to show sn < ε1-/
      suffices : sn n < ε1,
        calc |x.val - (tn n).val| < sn n : (htn n).1
                              ... < ε1   : this,
      /-show that sn n ≤ ε1-/
      have s1 : ⌈1 / ε1⌉₊ < n + 1,
        by linarith,
      have s2 : (1 / ε1) < n + 1,
        exact nat.lt_of_ceil_lt s1,
      have s3 : (n + 1 : ℝ) > 0,
        exact nat.cast_add_one_pos n,
      have s4 : 1 / (n + 1 : ℝ) < 1 / (1/ ε1),
        exact (one_div_lt_one_div s3 (one_div_pos.mpr hε1)).mpr s2,
      calc sn n < 1 / (1 / ε1) : s4
            ... = ε1           : by norm_num,
    /-obtain proof that f ∘ tn converges to f x-/
    specialize s ⟨tn, h₂⟩,
    /-intro sufficiently large N s.t. above it, f ∘ tn is in ε of f x -/
    cases s ε hε with N,
    /-specifiy above to N + 1-/
    specialize h_1 (N+1) (by norm_num),
    simp at h_1,
    /-rw into a different form for simplicity-/
    have h₃ : |f x - f (tn (N + 1))| < ε,
      calc |f x - f (tn (N + 1))| = |f (tn (N + 1)) - f x| : abs_sub_comm (f x) (f (tn (N + 1)))
                              ... < ε                      : h_1,
    /-specify f tn being distance ε away from f x for N + 1-/
    specialize htn (N+1),
    /-induce contradiction from last 2 inequalities-/
    linarith [htn.2, h₃],
end

/-Intermediate value theorem for continuous f on I a b-/
lemma intermed_val {a b : ℝ} {a < b} {f : I a b → ℝ} {h₁ : I_continuity a b f}:
  ∀ (y : I (f ⟨a,⟨by linarith, by linarith⟩⟩) (f ⟨b, ⟨by linarith, by linarith⟩⟩)), ∃ (x₁ : I a b), f (x₁) = y.val :=
begin
  sorry,
end

/-Bolzano-Weirstrass for a sequence on I a b-/
lemma bolz_weir_I (a b : ℝ) (sn : ℕ → I a b):
  ∃ (c : I a b), ∃ (tn : ℕ → ℕ), strict_mono tn ∧ Itendsto a b (sn ∘ tn) c :=
begin
  sorry,
end

/-Natural ceil of a real + a nat is less than the real nat ceil plus the nat.-/
lemma  nat_ceil (var : ℝ) (n : ℕ)  :
⌈var + n⌉₊ ≤ ⌈var⌉₊ + n :=
begin
  /-split into cases -/
  by_cases var ≤ -(n : ℝ),
  calc ⌈var + n⌉₊ = (0 : ℕ)   : nat.ceil_eq_zero.mpr (show var + n ≤ 0, by linarith)
              ... = ⌈var⌉₊     : by linarith [nat.ceil_eq_zero.mpr (show var ≤ 0, by linarith [(show -(n : ℝ) ≤ 0, by simp)] )]
              ... ≤ ⌈var⌉₊ + n : by linarith,
  push_neg at h,
  /-show its sufficient that the inequality coerced to the reals is true.-/
  suffices : (⌈var + ↑n⌉₊ : ℝ) ≤ ↑(⌈var⌉₊ + n),
    /-non-working attempt:
    exact nat.coe_nat_le.mp this,-/
    sorry,

  /-prove the inequality coerced to the reals is true.-/
  /- non-working attempt, struggled with the typing:
  calc (⌈var + ↑n ⌉₊ : ℝ) = ↑⌈var + n⌉       : nat.cast_ceil_eq_cast_int_ceil (by linarith)
              ... = ⌈var⌉ + ↑↑n            : by rw (int.ceil_add_int var n)
              ... ≤ ⌈var⌉₊ + n              : by linarith [(show ⌈var⌉ = ⌈var⌉₊, by refl)]-/
  sorry,
end

lemma I_cont_bdd {a b : ℝ} {f : I a b → ℝ} :
I_continuity a b f → ∃ (M : ℝ), ∀ (x : I a b), |f x| < M :=
begin
  intros h₁,
  /-Show its sufficient to show f is bounded from above and below.-/
  /-bound f from above and below.-/
  suffices goal1 : ∃ (M1 : ℝ), ∀ (x : I a b), f x < M1,
    suffices goal2 : ∃ (M2 : ℝ), ∀ (x : I a b), M2 < f x,
      /-extract upper and lower bound for f.-/
      cases goal1 with M1,
      cases goal2 with M2,
      /-use max of modulus of upper and lower bounds.-/
      use max M1 (-M2),
      /-intro arbitrary x, rw goal to 2 conditions.-/
      intros x,
      rw abs_lt,
      /-apply bound to f x.-/
      specialize goal1_h x,
      specialize goal2_h x,
      /-split ∧ in goal into 2 separate goals -/
      split,
      have :  ∀ ( a b : ℝ), -max a b ≤ -b, norm_num,
      /-show f x bounded below by our choice-/
      calc (-max M1 (-M2)) ≤ -(-M2)   : this M1 (-M2)
                      ... = M2        : by ring
                      ... < f x       : goal2_h,
    /-show f x is bounded above by our choice-/
    calc f x < M1                  : goal1_h
        ... ≤ max M1 (-M2)        : by norm_num,
  /-only focus on bounding f from above for now.-/
  sorry,
  /-intro negation of goal to prove by contradiction-/
  by_contra,
  push_neg at h,
  /-construct sequence we'll bound f tn by from below.-/
  let sn : ℕ → ℝ := λ n, n,
  have hcons : ∀ (n : ℕ), ∃ (x : I a b), sn n ≤ f x,
    intros n,
    exact h (sn n),
  /-extract sequence tn using above s.t. n ≤ tn -/
  choose tn htn using hcons,
  /-extract subsequence of tn s.t. it converges using bolzanno-weierstrass.-/
  cases (bolz_weir_I a b tn) with c,
  cases h_1 with qn,
  /-find sufficient N s.t. f ∘ tn ∘ qn is within 1 of f c-/
  have main : Rtendsto (f ∘ tn ∘ qn) (f c),
    exact (I_cont_sql_cont_pt a b f c).mp (h₁ c) ⟨(tn ∘ qn), h_1_h.right⟩,
  specialize main 1 (by linarith),
  cases main with N,
  /-specialise to n = N of above.-/
  have main1 : |f (tn ( qn N)) - f c| < 1,
    exact main_h N (by linarith),

  /-specialise main to n = ⌈f (tn (qn N))⌉₊ + 2, which will lead to contradiction.-/
  have : N ≤ ⌈f (tn (qn N))⌉₊ + 2,
    sorry,
  have main2 : |f (tn ( qn (⌈f (tn (qn N))⌉₊ + 2))) - f c| < 1,
    exact main_h (⌈f (tn (qn N))⌉₊ + 2) this,

  /-bound f c from above by f( tn( qn N) + 1-/
  have main3 : f c < f ( tn( qn N)) + 1,
    rw abs_lt at main1,
    linarith [main1.left],

  /-bound f c + 1 below.-/
  have main4 : f (tn (qn (⌈f (tn (qn N))⌉₊ + 2))) < f c + 1,
    rw abs_lt at main2,
    linarith [main2.right],

  /-show f c + 1 is bounded below by f(tn (qn N)):
    -find N greater than f(tn(qn N)) using ⌈ ⌉₊
    -use monotonicity of qn and identity of sn
    -use f bounded below by sn
    -use earlier result that this is bounded above by f c + 1.apply.
  -/
  have this1 : ⌈f(tn (qn N)) + ↑2⌉₊ ≤ ⌈f(tn (qn N))⌉₊ + 2, exact nat_ceil (f (tn (qn N))) 2,
  have main5 : f (tn (qn N)) + 2 < f c + 1,
    calc f(tn (qn N)) + 2 ≤ ↑⌈f(tn (qn N)) + (2 : ℝ)⌉₊  : nat.le_ceil (f (tn (qn N)) + 2)
                      ... ≤ ↑(⌈f(tn (qn N))⌉₊ + 2)      : sorry /-nat.cast_le.mpr (nat_ceil (f (tn (qn N))) 2)-/
                      ... = ↑⌈f(tn (qn N))⌉₊ + (2 : ℝ)  : by simp
                      ... ≤ ↑(qn(⌈f(tn (qn N))⌉₊ + 2))  : sorry /-(function.well_founded.self_le_of_strict_mono (nat.lt_wf) h_1_h.left (⌈f(tn (qn N))⌉₊ + 2))-/
                      ... = sn (qn (⌈f (tn (qn N))⌉₊ + 2)) : rfl
                      ... ≤ f (tn ((qn (⌈f (tn (qn N))⌉₊ + 2)))) : htn (qn (⌈f (tn (qn N))⌉₊ + 2))
                      ... < f c + 1                           : main4,
  /-derive contradiction from above and below bound of f c by f tn qn N + 1.-/
  linarith,
end


import data.real.basic
import algebra.group.pi
import tuto_lib

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

/-
In this file we manipulate the elementary definition of limits of
sequences of real numbers.
mathlib has a much more general definition of limits, but here
we want to practice using the logical operators and relations
covered in the previous files.

A sequence u is a function from ℕ to ℝ, hence Lean says
u : ℕ → ℝ
The definition we'll be using is:

-- Definition of « u tends to l »
def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

Note the use of `∀ ε > 0, ...` which is an abbreviation of
`∀ ε, ε > 0 → ... `

In particular, a statement like `h : ∀ ε > 0, ...`
can be specialized to a given ε₀ by
  `specialize h ε₀ hε₀`
where hε₀ is a proof of ε₀ > 0.

Also recall that, wherever Lean expects some proof term, we can
start a tactic mode proof using the keyword `by` (followed by curly braces
if you need more than one tactic invocation).
For instance, if the local context contains:

δ : ℝ
δ_pos : δ > 0
h : ∀ ε > 0, ...

then we can specialize h to the real number δ/2 using:
  `specialize h (δ/2) (by linarith)`
where `by linarith` will provide the proof of `δ/2 > 0` expected by Lean.

We'll take this opportunity to use two new tactics:

`norm_num` will perform numerical normalization on the goal and `norm_num at h`
will do the same in assumption `h`. This will get rid of trivial calculations on numbers,
like replacing |l - l| by zero in the next exercise.

`congr'` will try to prove equalities between applications of functions by recursively
proving the arguments are the same.
For instance, if the goal is `f x + g y = f z + g t` then congr will replace it by
two goals: `x = z` and `y = t`.
You can limit the recursion depth by specifying a natural number after `congr'`.
For instance, in the above example, `congr' 1` will give new goals
`f x = f z` and `g y = g t`, which only inspect arguments of the addition and not deeper.
-/

variables (u v w : ℕ → ℝ) (l l' : ℝ)

-- If u is constant with value l then u tends to l
-- 0033
example : (∀ n, u n = l) → seq_limit u l :=
begin
  -- sorry
  intros h ε ε_pos,
  use 0,
  intros n hn,
  rw h,
  norm_num,
  linarith,
  -- sorry
end

/- When dealing with absolute values, we'll use lemmas:

abs_le {x y : ℝ} : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

abs_add (x y : ℝ) : |x + y| ≤ |x| + |y|

abs_sub_comm (x y : ℝ) : |x - y| = |y - x|

You should probably write them down on a sheet of paper that you keep at
hand since they are used in many exercises.
-/

-- Assume l > 0. Then u tends to l implies u n ≥ l/2 for large enough n
-- 0034
example (hl : l > 0) : seq_limit u l → ∃ N, ∀ n ≥ N, u n ≥ l/2 :=
begin
  -- sorry
  intro h,
  cases h (l/2) (by linarith) with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  rw abs_le at hN,
  linarith,
  -- sorry
end

/-
When dealing with max, you can use

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

You should probably add them to the sheet of paper where you wrote
the `abs` lemmas since they are used in many exercises.

Let's see an example.
-/

-- If u tends to l and v tends l' then u+v tends to l+l'
example (hu : seq_limit u l) (hv : seq_limit v l') :
seq_limit (u + v) (l + l') :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N₁ hN₁,
  cases hv (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  cases ge_max_iff.mp hn with hn₁ hn₂,
  have fact₁ : |u n - l| ≤ ε/2,
    from hN₁ n (by linarith),  -- note the use of `from`.
                               -- This is an alias for `exact`,
                               -- but reads nicer in this context
  have fact₂ : |v n - l'| ≤ ε/2,
    from hN₂ n (by linarith),
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1 ; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  ε                       : by linarith,
end

/-
In the above proof, we used `have` to prepare facts for `linarith` consumption in the last line.
Since we have direct proof terms for them, we can feed them directly to `linarith` as in the next proof
of the same statement.
Another variation we introduce is rewriting using `ge_max_iff` and letting `linarith` handle the
conjunction, instead of creating two new assumptions.
-/

example (hu : seq_limit u l) (hv : seq_limit v l') :
seq_limit (u + v) (l + l') :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N₁ hN₁,
  cases hv (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  rw ge_max_iff at hn,
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1 ; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  ε                       : by linarith [hN₁ n (by linarith), hN₂ n (by linarith)],
end

/- Let's do something similar: the squeezing theorem. -/
-- 0035
example (hu : seq_limit u l) (hw : seq_limit w l)
(h : ∀ n, u n ≤ v n)
(h' : ∀ n, v n ≤ w n) : seq_limit v l :=
begin
  -- sorry
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  cases hw ε ε_pos with N' hN',
  use max N N',
  intros n hn,
  rw ge_max_iff at hn,
  specialize hN n (by linarith),
  specialize hN' n (by linarith),
  specialize h n,
  specialize h' n,
  rw abs_le at *,
  split,
  -- Here `linarith` can finish, but on paper we would write
  calc -ε ≤ u n - l : by linarith
      ... ≤ v n - l : by linarith,
  calc v n - l ≤ w n - l : by linarith
      ... ≤ ε : by linarith,
  -- sorry

end

/- What about < ε? -/
-- 0036
example (u l) : seq_limit u l ↔
 ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| < ε :=
begin
  -- sorry
  split,
  { intros hyp ε ε_pos,
    cases hyp (ε/2) (by linarith) with N hN,
    use N,
    intros n hn,
    calc |u n - l| ≤ ε/2 : by exact hN n hn
              ...  < ε   : by linarith, },
  { intros hyp ε ε_pos,
    cases hyp ε ε_pos with N hN,
    use N,
    intros n hn,
    specialize hN n hn,
    linarith, },
  -- sorry
end

/- In the next exercise, we'll use

eq_of_abs_sub_le_all (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y
-/

-- A sequence admits at most one limit
-- 0037
example : seq_limit u l → seq_limit u l' → l = l' :=
begin
  -- sorry
  intros hl hl',
  apply eq_of_abs_sub_le_all,
  intros ε ε_pos,
  cases hl (ε/2) (by linarith) with N hN,
  cases hl' (ε/2) (by linarith) with N' hN',
  calc |l - l'| = |(l-u (max N N')) + (u (max N N') -l')| : by ring_nf
  ... ≤ |l - u (max N N')| + |u (max N N') - l'| : by apply abs_add
  ... =  |u (max N N') - l| + |u (max N N') - l'| : by rw abs_sub_comm
  ... ≤ ε : by linarith [hN (max N N') (le_max_left _ _), hN' (max N N') (le_max_right _ _)]
  -- sorry
end

/-
Let's now practice deciphering definitions before proving.
-/

def non_decreasing (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

def is_seq_sup (M : ℝ) (u : ℕ → ℝ) :=
(∀ n, u n ≤ M) ∧ ∀ ε > 0, ∃ n₀, u n₀ ≥ M - ε

-- 0038
example (M : ℝ) (h : is_seq_sup M u) (h' : non_decreasing u) :
seq_limit u M :=
begin
  -- sorry
  intros ε ε_pos,
  cases h with inf_M sup_M_ep,
  cases sup_M_ep ε ε_pos with n₀ hn₀,
  use n₀,
  intros n hn,
  rw abs_le,
  split; linarith [inf_M n, h' n₀ n hn],
  -- sorry
end


import .lovelib

/-! # LoVe Demo 4: Functional Programming

We take a closer look at the basics of typed functional programming: inductive
types, proofs by induction, recursive functions, pattern matching, structures
(records), and type classes. -/

set_option pp.beta true

namespace LoVe

/-! ## Inductive Types

Recall the definition of type `nat` (= `ℕ`): -/

#print nat

/-! Mottos:

* **No junk**: The type contains no values beyond those expressible using the
  constructors.

* **No confusion**: Values built in a different ways are different.

For `nat` (= `ℕ`):

* "No junk" means that there are no special values, say, `–1` or `ε`, that
  cannot be expressed using a finite combination of `zero` and `succ`.

* "No confusion" is what ensures that `zero` ≠ `succ x`.

In addition, inductive types are always finite. `succ (succ (succ …))` is not a
value.

## Structural Induction

__Structural induction__ is a generalization of mathematical induction to
inductive types. To prove a property `P[n]` for all natural numbers `n`, it
suffices to prove the base case

    `P[0]`

and the induction step

    `∀k, P[k] → P[k + 1]`

For lists, the base case is

    `P[[]]`

and the induction step is

    `∀y ys, P[ys] → P[y :: ys]`

In general, there is one subgoal per constructor, and induction hypotheses are
available for all constructor arguments of the type we are doing the induction
on. -/

lemma nat.succ_neq_self (n : ℕ) :
  nat.succ n ≠ n :=
begin
  induction n,
  { simp },
  { simp [n_ih] }
end

/-! The `case` tactic can be used to supply custom names, and potentially
reorder the cases. -/

lemma nat.succ_neq_self₂ (n : ℕ) :
  nat.succ n ≠ n :=
begin
  induction n,
  case nat.succ : m ih {
    simp [ih] },
  case nat.zero {
    simp }
end

/-! ## Structural Recursion

__Structural recursion__ is a form of recursion that allows us to peel off
one or more constructors from the value on which we recurse. Such functions are
guaranteed to call themselves only finitely many times before the recursion
stops. This is a prerequisite for establishing that the function terminates. -/

def fact : ℕ → ℕ
| 0       := 1
| (n + 1) := (n + 1) * fact n

def fact₂ : ℕ → ℕ
| 0       := 1
| 1       := 1
| (n + 1) := (n + 1) * fact₂ n

/-! For structurally recursive functions, Lean can automatically prove
termination. For more general recursive schemes, the termination check may fail.
Sometimes it does so for a good reason, as in the following example: -/

-- fails
def illegal : ℕ → ℕ
| n := illegal n + 1

constant immoral : ℕ → ℕ

axiom immoral_eq (n : ℕ) :
  immoral n = immoral n + 1

lemma proof_of_false :
  false :=
have immoral 0 = immoral 0 + 1 :=
  immoral_eq 0,
have immoral 0 - immoral 0 = immoral 0 + 1 - immoral 0 :=
  by cc,
have 0 = 1 :=
  by simp [*] at *,
show false, from
  by cc

/-! **Warning:** The above definitions of factorial are wrong.

## Pattern Matching Expressions

    `match` _term₁_, …, _termM_ `with`
    | _pattern₁₁_, …, _pattern₁M_ := _result₁_
        ⋮
    | _patternN₁_, …, _patternNM_ := _resultN_
    `end`

`match` allows nonrecursive pattern matching within terms.

In contrast to pattern matching after `lemma` or `def`, the patterns are
separated by commas, so parentheses are optional. -/

def bcount {α : Type} (p : α → bool) : list α → ℕ
| []        := 0
| (x :: xs) :=
  match p x with
  | tt := bcount xs + 1
  | ff := bcount xs
  end

def min (a b : ℕ) : ℕ :=
if a ≤ b then a else b

/-! ## Structures

Lean provides a convenient syntax for defining records, or structures. These are
essentially nonrecursive, single-constructor inductive types. -/

structure rgb : Type :=
(red green blue : ℕ)

#check rgb.mk
#check rgb.red
#check rgb.green
#check rgb.blue

namespace rgb_as_inductive

inductive rgb : Type
| mk : ℕ → ℕ → ℕ → rgb

def rgb.red : rgb → ℕ
| (rgb.mk r _ _) := r

def rgb.green : rgb → ℕ
| (rgb.mk _ g _) := g

def rgb.blue : rgb → ℕ
| (rgb.mk _ _ b) := b

end rgb_as_inductive

structure rgba extends rgb : Type :=
(alpha : ℕ)

#print rgba

def pure_red : rgb :=
{ red   := 0xff,
  green := 0x00,
  blue  := 0x00 }

def semitransparent_red : rgba :=
{ alpha := 0x7f,
  ..pure_red }

#print pure_red
#print semitransparent_red

def shuffle (c : rgb) : rgb :=
{ red   := rgb.green c,
  green := rgb.blue c,
  blue  := rgb.red c }

/-! `cases` performs a case distinction on the specified term. This gives rise
to as many subgoals as there are constructors in the definition of the term's
type. The tactic behaves almost the same as `induction` except that it does not
produce induction hypotheses. -/

lemma shuffle_shuffle_shuffle (c : rgb) :
  shuffle (shuffle (shuffle c)) = c :=
begin
  cases c,
  refl
end

lemma shuffle_shuffle_shuffle₂ (c : rgb) :
  shuffle (shuffle (shuffle c)) = c :=
match c with
| rgb.mk r g b := eq.refl _
end

/-! ## Type Classes

A __type class__ is a structure type combining abstract constants and their
properties. A type can be declared an instance of a type class by providing
concrete definitions for the constants and proving that the properties hold.
Based on the type, Lean retrieves the relevant instance. -/

#print inhabited

@[instance] def nat.inhabited : inhabited ℕ :=
{ default := 0 }

@[instance] def list.inhabited {α : Type} :
  inhabited (list α) :=
{ default := [] }

#eval inhabited.default ℕ          -- result: 0
#eval inhabited.default (list ℤ)   -- result: []

def head {α : Type} [inhabited α] : list α → α
| []       := inhabited.default α
| (x :: _) := x

lemma head_head {α : Type} [inhabited α] (xs : list α) :
  head [head xs] = head xs :=
begin
  cases xs,
  { refl },
  { refl }
end

#eval head ([] : list ℕ)   -- result: 0

#check list.head

@[instance] def fun.inhabited {α β : Type} [inhabited β] :
  inhabited (α → β) :=
{ default := λa : α, inhabited.default β }

inductive empty : Type

@[instance] def fun_empty.inhabited {β : Type} :
  inhabited (empty → β) :=
{ default := λa : empty, match a with end }

@[instance] def prod.inhabited {α β : Type}
    [inhabited α] [inhabited β] :
  inhabited (α × β) :=
{ default := (inhabited.default α, inhabited.default β) }

/-! Here are other type classes without properties: -/

#check has_zero
#check has_neg
#check has_add
#check has_one
#check has_inv
#check has_mul

#check (1 : ℕ)
#check (1 : ℤ)
#check (1 : ℝ)
#check (1 : linear_map _ _ _)

/-! We encountered these type classes in lecture 2: -/

#print is_commutative
#print is_associative

/-! ## Lists

`list` is an inductive polymorphic type constructed from `nil` and `cons`: -/

#print list

/-! `cases` can also be used on a hypothesis of the form `l = r`. It matches `r`
against `l` and replaces all occurrences of the variables occurring in `r` with
the corresponding terms in `l` everywhere in the goal. The remaining hypothesis
`l = l` can be removed using `clear h` if desired. -/

lemma injection_example {α : Type} (x y : α) (xs ys : list α)
    (h : list.cons x xs = list.cons y ys) :
  x = y ∧ xs = ys :=
begin
  cases h,
  cc
end

/-! If `r` fails to match `l`, no subgoals emerge; the proof is complete. -/

lemma distinctness_example {α : Type} (x y : α)
    (xs ys : list α) (h : [] = y :: ys) :
  false :=
by cases h

def map {α β : Type} (f : α → β) : list α → list β
| []        := []
| (x :: xs) := f x :: map xs

def map₂ {α β : Type} : (α → β) → list α → list β
| _ []        := []
| f (x :: xs) := f x :: map₂ f xs

lemma map_equiv  {α β : Type} (f : α → β) (xs : list α):
  map f xs = map₂ f xs :=
begin
  intros,
  induction xs,
  simp [map, map₂],
  simp [map, map₂, xs_ih],
end

#check list.map

lemma map_ident {α : Type} (xs : list α) :
  map (λx, x) xs = xs :=
begin
  induction xs,
  case list.nil {
    refl },
  case list.cons : y ys ih {
    simp [map, ih] }
end

lemma map_comp {α β γ : Type} (f : α → β) (g : β → γ)
    (xs : list α) :
  map g (map f xs) = map (λx, g (f x)) xs :=
begin
  induction xs,
  case list.nil {
    refl },
  case list.cons : y ys ih {
    simp [map, ih] }
end

lemma map_append {α β : Type} (f : α → β) (xs ys : list α) :
  map f (xs ++ ys) = map f xs ++ map f ys :=
begin
  induction xs,
  case list.nil {
    refl },
  case list.cons : y ys ih {
    simp [map, ih] }
end

def tail {α : Type} : list α → list α
| []        := []
| (_ :: xs) := xs

#check list.tail

def head_opt {α : Type} : list α → option α
| []       := option.none
| (x :: _) := option.some x

def head_le {α : Type} : ∀xs : list α, xs ≠ [] → α
| []       hxs := by cc
| (x :: _) _   := x

#eval head_opt [3, 1, 4]
#eval head_le [3, 1, 4] (by simp)
#eval head_le ([] : list ℕ) sorry   -- fails

def zip {α β : Type} : list α → list β → list (α × β)
| (x :: xs) (y :: ys) := (x, y) :: zip xs ys
| []        _         := []
| (_ :: _)  []        := []

#check list.zip

def length {α : Type} : list α → ℕ
| []        := 0
| (x :: xs) := length xs + 1

#check list.length

/-! `cases` can also be used to perform a case distinction on a proposition, in
conjunction with `classical.em`. Two cases emerge: one in which the proposition
is true and one in which it is false.

Also notice the `have` tactic below. We will come back to it. -/

#check classical.em

lemma min_add_add (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
begin
  cases classical.em (m ≤ n),
  case or.inl : h {
    simp [min, h] },
  case or.inr : h {
    simp [min, h] }
end

lemma min_add_add₂ (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
match classical.em (m ≤ n) with
| or.inl h := by simp [min, h]
| or.inr h := by simp [min, h]
end

lemma min_add_add₃ (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
if h : m ≤ n then
  by simp [min, h]
else
  by simp [min, h]

lemma length_zip {α β : Type} (xs : list α) (ys : list β) :
  length (zip xs ys) = min (length xs) (length ys) :=
begin
  induction xs generalizing ys,
    refl,
      cases ys,
        refl,
        simp [zip, length, xs_ih, min_add_add],
end

lemma map_zip {α α' β β' : Type} (f : α → α') (g : β → β') :
  ∀xs ys,
    map (λab : α × β, (f (prod.fst ab), g (prod.snd ab)))
      (zip xs ys) =
    zip (map f xs) (map g ys)
| (x :: xs) (y :: ys) := by simp [zip, map, map_zip xs ys]
| []        _         := by refl
| (_ :: _)  []        := by refl

/-! ## Binary Trees

Inductive types with constructors taking several recursive arguments define
tree-like objects. __Binary trees__ have nodes with at most two children. -/

inductive btree (α : Type) : Type
| empty {} : btree
| node     : α → btree → btree → btree

/-! The type `aexp` of arithmetic expressions was also an example of a tree data
structure.

The nodes of a tree, whether inner nodes or leaf nodes, often carry labels or
other annotations.

Inductive trees contain no infinite branches, not even cycles. This is less
expressive than pointer- or reference-based data structures (in imperative
languages) but easier to reason about.

Recursive definitions (and proofs by induction) work roughly as for lists, but
we may need to recurse (or invoke the induction hypothesis) on several child
nodes. -/

def mirror {α : Type} : btree α → btree α
| btree.empty        := btree.empty
| (btree.node a l r) := btree.node a (mirror r) (mirror l)

lemma mirror_mirror {α : Type} (t : btree α) :
  mirror (mirror t) = t :=
begin
  induction t,
  case btree.empty {
    refl },
  case btree.node : a l r ih_l ih_r {
    simp [mirror, ih_l, ih_r] }
end

lemma mirror_eq_empty_iff {α : Type} :
  ∀t : btree α, mirror t = btree.empty ↔ t = btree.empty
| btree.empty        := by refl
| (btree.node _ _ _) := by simp [mirror]

lemma mirror_mirror₂ {α : Type} :
  ∀t : btree α, mirror (mirror t) = t
| btree.empty        := by refl
| (btree.node a l r) :=
  calc  mirror (mirror (btree.node a l r))
      = mirror (btree.node a (mirror r) (mirror l)) :
    by refl
  ... = btree.node a (mirror (mirror l)) (mirror (mirror r)) :
    by refl
  ... = btree.node a l (mirror (mirror r)) :
    by rewrite mirror_mirror₂ l
  ... = btree.node a l r :
    by rewrite mirror_mirror₂ r

/-! ## Dependent Inductive Types (**optional**) -/

#check vector

inductive vec (α : Type) : ℕ → Type
| nil {}                           : vec 0
| cons (a : α) {n : ℕ} (v : vec n) : vec (n + 1)

#check vec.nil
#check vec.cons

def list_of_vec {α : Type} : ∀{n : ℕ}, vec α n → list α
| _ vec.nil        := []
| _ (vec.cons a v) := a :: list_of_vec v

def vec_of_list {α : Type} :
  ∀xs : list α, vec α (list.length xs)
| []        := vec.nil
| (x :: xs) := vec.cons x (vec_of_list xs)

lemma length_list_of_vec {α : Type} :
  ∀{n : ℕ} (v : vec α n), list.length (list_of_vec v) = n
| _ vec.nil        := by refl
| _ (vec.cons a v) :=
  by simp [list_of_vec, length_list_of_vec v]

end LoVe


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson

! This file was ported from Lean 3 source module analysis.special_functions.trigonometric.complex
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.QuadraticDiscriminant
import Mathbin.Analysis.SpecialFunctions.Trigonometric.Basic
import Mathbin.Analysis.Convex.SpecificFunctions

/-!
# Complex trigonometric functions

Basic facts and derivatives for the complex trigonometric functions.

Several facts about the real trigonometric functions have the proofs deferred here, rather than
`analysis.special_functions.trigonometric.basic`,
as they are most easily proved by appealing to the corresponding fact for complex trigonometric
functions, or require additional imports which are not available in that file.
-/

noncomputable section

namespace Complex

open Set Filter

open Real

theorem cos_eq_zero_iff {θ : ℂ} : cos θ = 0 ↔ ∃ k : ℤ, θ = (2 * k + 1) * π / 2 :=
  by
  have h : (exp (θ * I) + exp (-θ * I)) / 2 = 0 ↔ exp (2 * θ * I) = -1 :=
    by
    rw [@div_eq_iff _ _ (exp (θ * I) + exp (-θ * I)) 2 0 two_ne_zero, MulZeroClass.zero_mul,
      add_eq_zero_iff_eq_neg, neg_eq_neg_one_mul, ← div_eq_iff (exp_ne_zero _), ← exp_sub]
    field_simp only
    congr 3
    ring
  rw [cos, h, ← exp_pi_mul_I, exp_eq_exp_iff_exists_int, mul_right_comm]
  refine' exists_congr fun x => _
  refine' (iff_of_eq <| congr_arg _ _).trans (mul_right_inj' <| mul_ne_zero two_ne_zero I_ne_zero)
  field_simp
  ring
#align complex.cos_eq_zero_iff Complex.cos_eq_zero_iff

theorem cos_ne_zero_iff {θ : ℂ} : cos θ ≠ 0 ↔ ∀ k : ℤ, θ ≠ (2 * k + 1) * π / 2 := by
  rw [← not_exists, not_iff_not, cos_eq_zero_iff]
#align complex.cos_ne_zero_iff Complex.cos_ne_zero_iff

theorem sin_eq_zero_iff {θ : ℂ} : sin θ = 0 ↔ ∃ k : ℤ, θ = k * π :=
  by
  rw [← Complex.cos_sub_pi_div_two, cos_eq_zero_iff]
  constructor
  · rintro ⟨k, hk⟩
    use k + 1
    field_simp [eq_add_of_sub_eq hk]
    ring
  · rintro ⟨k, rfl⟩
    use k - 1
    field_simp
    ring
#align complex.sin_eq_zero_iff Complex.sin_eq_zero_iff

theorem sin_ne_zero_iff {θ : ℂ} : sin θ ≠ 0 ↔ ∀ k : ℤ, θ ≠ k * π := by
  rw [← not_exists, not_iff_not, sin_eq_zero_iff]
#align complex.sin_ne_zero_iff Complex.sin_ne_zero_iff

theorem tan_eq_zero_iff {θ : ℂ} : tan θ = 0 ↔ ∃ k : ℤ, θ = k * π / 2 :=
  by
  have h := (sin_two_mul θ).symm
  rw [mul_assoc] at h
  rw [tan, div_eq_zero_iff, ← mul_eq_zero, ← MulZeroClass.zero_mul (1 / 2 : ℂ), mul_one_div,
    CancelFactors.cancel_factors_eq_div h two_ne_zero, mul_comm]
  simpa only [zero_div, MulZeroClass.zero_mul, Ne.def, not_false_iff, field_simps] using
    sin_eq_zero_iff
#align complex.tan_eq_zero_iff Complex.tan_eq_zero_iff

theorem tan_ne_zero_iff {θ : ℂ} : tan θ ≠ 0 ↔ ∀ k : ℤ, θ ≠ k * π / 2 := by
  rw [← not_exists, not_iff_not, tan_eq_zero_iff]
#align complex.tan_ne_zero_iff Complex.tan_ne_zero_iff

theorem tan_int_mul_pi_div_two (n : ℤ) : tan (n * π / 2) = 0 :=
  tan_eq_zero_iff.mpr (by use n)
#align complex.tan_int_mul_pi_div_two Complex.tan_int_mul_pi_div_two

theorem cos_eq_cos_iff {x y : ℂ} : cos x = cos y ↔ ∃ k : ℤ, y = 2 * k * π + x ∨ y = 2 * k * π - x :=
  calc
    cos x = cos y ↔ cos x - cos y = 0 := sub_eq_zero.symm
    _ ↔ -2 * sin ((x + y) / 2) * sin ((x - y) / 2) = 0 := by rw [cos_sub_cos]
    _ ↔ sin ((x + y) / 2) = 0 ∨ sin ((x - y) / 2) = 0 := by simp [(by norm_num : (2 : ℂ) ≠ 0)]
    _ ↔ sin ((x - y) / 2) = 0 ∨ sin ((x + y) / 2) = 0 := or_comm
    _ ↔ (∃ k : ℤ, y = 2 * k * π + x) ∨ ∃ k : ℤ, y = 2 * k * π - x :=
      by
      apply or_congr <;>
        field_simp [sin_eq_zero_iff, (by norm_num : -(2 : ℂ) ≠ 0), eq_sub_iff_add_eq',
          sub_eq_iff_eq_add, mul_comm (2 : ℂ), mul_right_comm _ (2 : ℂ)]
      constructor <;>
        · rintro ⟨k, rfl⟩
          use -k
          simp
    _ ↔ ∃ k : ℤ, y = 2 * k * π + x ∨ y = 2 * k * π - x := exists_or.symm

#align complex.cos_eq_cos_iff Complex.cos_eq_cos_iff

theorem sin_eq_sin_iff {x y : ℂ} :
    sin x = sin y ↔ ∃ k : ℤ, y = 2 * k * π + x ∨ y = (2 * k + 1) * π - x :=
  by
  simp only [← Complex.cos_sub_pi_div_two, cos_eq_cos_iff, sub_eq_iff_eq_add]
  refine' exists_congr fun k => or_congr _ _ <;> refine' Eq.congr rfl _ <;> field_simp <;> ring
#align complex.sin_eq_sin_iff Complex.sin_eq_sin_iff

theorem tan_add {x y : ℂ}
    (h :
      ((∀ k : ℤ, x ≠ (2 * k + 1) * π / 2) ∧ ∀ l : ℤ, y ≠ (2 * l + 1) * π / 2) ∨
        (∃ k : ℤ, x = (2 * k + 1) * π / 2) ∧ ∃ l : ℤ, y = (2 * l + 1) * π / 2) :
    tan (x + y) = (tan x + tan y) / (1 - tan x * tan y) :=
  by
  rcases h with (⟨h1, h2⟩ | ⟨⟨k, rfl⟩, ⟨l, rfl⟩⟩)
  · rw [tan, sin_add, cos_add, ←
      div_div_div_cancel_right (sin x * cos y + cos x * sin y)
        (mul_ne_zero (cos_ne_zero_iff.mpr h1) (cos_ne_zero_iff.mpr h2)),
      add_div, sub_div]
    simp only [← div_mul_div_comm, ← tan, mul_one, one_mul, div_self (cos_ne_zero_iff.mpr h1),
      div_self (cos_ne_zero_iff.mpr h2)]
  · obtain ⟨t, hx, hy, hxy⟩ := tan_int_mul_pi_div_two, t (2 * k + 1), t (2 * l + 1),
      t (2 * k + 1 + (2 * l + 1))
    simp only [Int.cast_add, Int.cast_bit0, Int.cast_mul, Int.cast_one, hx, hy] at hx hy hxy
    rw [hx, hy, add_zero, zero_div, mul_div_assoc, mul_div_assoc, ←
      add_mul (2 * (k : ℂ) + 1) (2 * l + 1) (π / 2), ← mul_div_assoc, hxy]
#align complex.tan_add Complex.tan_add

theorem tan_add' {x y : ℂ}
    (h : (∀ k : ℤ, x ≠ (2 * k + 1) * π / 2) ∧ ∀ l : ℤ, y ≠ (2 * l + 1) * π / 2) :
    tan (x + y) = (tan x + tan y) / (1 - tan x * tan y) :=
  tan_add (Or.inl h)
#align complex.tan_add' Complex.tan_add'

theorem tan_two_mul {z : ℂ} : tan (2 * z) = 2 * tan z / (1 - tan z ^ 2) :=
  by
  by_cases h : ∀ k : ℤ, z ≠ (2 * k + 1) * π / 2
  · rw [two_mul, two_mul, sq, tan_add (Or.inl ⟨h, h⟩)]
  · rw [not_forall_not] at h
    rw [two_mul, two_mul, sq, tan_add (Or.inr ⟨h, h⟩)]
#align complex.tan_two_mul Complex.tan_two_mul

theorem tan_add_mul_i {x y : ℂ}
    (h :
      ((∀ k : ℤ, x ≠ (2 * k + 1) * π / 2) ∧ ∀ l : ℤ, y * I ≠ (2 * l + 1) * π / 2) ∨
        (∃ k : ℤ, x = (2 * k + 1) * π / 2) ∧ ∃ l : ℤ, y * I = (2 * l + 1) * π / 2) :
    tan (x + y * I) = (tan x + tanh y * I) / (1 - tan x * tanh y * I) := by
  rw [tan_add h, tan_mul_I, mul_assoc]
#align complex.tan_add_mul_I Complex.tan_add_mul_i

theorem tan_eq {z : ℂ}
    (h :
      ((∀ k : ℤ, (z.re : ℂ) ≠ (2 * k + 1) * π / 2) ∧
          ∀ l : ℤ, (z.im : ℂ) * I ≠ (2 * l + 1) * π / 2) ∨
        (∃ k : ℤ, (z.re : ℂ) = (2 * k + 1) * π / 2) ∧
          ∃ l : ℤ, (z.im : ℂ) * I = (2 * l + 1) * π / 2) :
    tan z = (tan z.re + tanh z.im * I) / (1 - tan z.re * tanh z.im * I) := by
  convert tan_add_mul_I h <;> exact (re_add_im z).symm
#align complex.tan_eq Complex.tan_eq

open Topology

theorem continuousOn_tan : ContinuousOn tan { x | cos x ≠ 0 } :=
  continuousOn_sin.div continuousOn_cos fun x => id
#align complex.continuous_on_tan Complex.continuousOn_tan

@[continuity]
theorem continuous_tan : Continuous fun x : { x | cos x ≠ 0 } => tan x :=
  continuousOn_iff_continuous_restrict.1 continuousOn_tan
#align complex.continuous_tan Complex.continuous_tan

theorem cos_eq_iff_quadratic {z w : ℂ} :
    cos z = w ↔ exp (z * I) ^ 2 - 2 * w * exp (z * I) + 1 = 0 :=
  by
  rw [← sub_eq_zero]
  field_simp [cos, exp_neg, exp_ne_zero]
  refine' Eq.congr _ rfl
  ring
#align complex.cos_eq_iff_quadratic Complex.cos_eq_iff_quadratic

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (w «expr ≠ » 0) -/
theorem cos_surjective : Function.Surjective cos :=
  by
  intro x
  obtain ⟨w, w₀, hw⟩ : ∃ (w : _)(_ : w ≠ 0), 1 * w * w + -2 * x * w + 1 = 0 :=
    by
    rcases exists_quadratic_eq_zero one_ne_zero
        ⟨_, (cpow_nat_inv_pow _ two_ne_zero).symm.trans <| pow_two _⟩ with
      ⟨w, hw⟩
    refine' ⟨w, _, hw⟩
    rintro rfl
    simpa only [zero_add, one_ne_zero, MulZeroClass.mul_zero] using hw
  refine' ⟨log w / I, cos_eq_iff_quadratic.2 _⟩
  rw [div_mul_cancel _ I_ne_zero, exp_log w₀]
  convert hw
  ring
#align complex.cos_surjective Complex.cos_surjective

@[simp]
theorem range_cos : range cos = Set.univ :=
  cos_surjective.range_eq
#align complex.range_cos Complex.range_cos

theorem sin_surjective : Function.Surjective sin :=
  by
  intro x
  rcases cos_surjective x with ⟨z, rfl⟩
  exact ⟨z + π / 2, sin_add_pi_div_two z⟩
#align complex.sin_surjective Complex.sin_surjective

@[simp]
theorem range_sin : range sin = Set.univ :=
  sin_surjective.range_eq
#align complex.range_sin Complex.range_sin

end Complex

namespace Real

open Real

theorem cos_eq_zero_iff {θ : ℝ} : cos θ = 0 ↔ ∃ k : ℤ, θ = (2 * k + 1) * π / 2 := by
  exact_mod_cast @Complex.cos_eq_zero_iff θ
#align real.cos_eq_zero_iff Real.cos_eq_zero_iff

theorem cos_ne_zero_iff {θ : ℝ} : cos θ ≠ 0 ↔ ∀ k : ℤ, θ ≠ (2 * k + 1) * π / 2 := by
  rw [← not_exists, not_iff_not, cos_eq_zero_iff]
#align real.cos_ne_zero_iff Real.cos_ne_zero_iff

theorem cos_eq_cos_iff {x y : ℝ} : cos x = cos y ↔ ∃ k : ℤ, y = 2 * k * π + x ∨ y = 2 * k * π - x :=
  by exact_mod_cast @Complex.cos_eq_cos_iff x y
#align real.cos_eq_cos_iff Real.cos_eq_cos_iff

theorem sin_eq_sin_iff {x y : ℝ} :
    sin x = sin y ↔ ∃ k : ℤ, y = 2 * k * π + x ∨ y = (2 * k + 1) * π - x := by
  exact_mod_cast @Complex.sin_eq_sin_iff x y
#align real.sin_eq_sin_iff Real.sin_eq_sin_iff

theorem lt_sin_mul {x : ℝ} (hx : 0 < x) (hx' : x < 1) : x < sin (π / 2 * x) := by
  simpa [mul_comm x] using
    strictConcaveOn_sin_Icc.2 ⟨le_rfl, pi_pos.le⟩ ⟨pi_div_two_pos.le, half_le_self pi_pos.le⟩
      pi_div_two_pos.ne (sub_pos.2 hx') hx
#align real.lt_sin_mul Real.lt_sin_mul

theorem le_sin_mul {x : ℝ} (hx : 0 ≤ x) (hx' : x ≤ 1) : x ≤ sin (π / 2 * x) := by
  simpa [mul_comm x] using
    strict_concave_on_sin_Icc.concave_on.2 ⟨le_rfl, pi_pos.le⟩
      ⟨pi_div_two_pos.le, half_le_self pi_pos.le⟩ (sub_nonneg.2 hx') hx
#align real.le_sin_mul Real.le_sin_mul

theorem mul_lt_sin {x : ℝ} (hx : 0 < x) (hx' : x < π / 2) : 2 / π * x < sin x :=
  by
  rw [← inv_div]
  simpa [-inv_div, pi_div_two_pos.ne'] using @lt_sin_mul ((π / 2)⁻¹ * x) _ _
  · exact mul_pos (inv_pos.2 pi_div_two_pos) hx
  · rwa [← div_eq_inv_mul, div_lt_one pi_div_two_pos]
#align real.mul_lt_sin Real.mul_lt_sin

/-- In the range `[0, π / 2]`, we have a linear lower bound on `sin`. This inequality forms one half
of Jordan's inequality, the other half is `real.sin_lt` -/
theorem mul_le_sin {x : ℝ} (hx : 0 ≤ x) (hx' : x ≤ π / 2) : 2 / π * x ≤ sin x :=
  by
  rw [← inv_div]
  simpa [-inv_div, pi_div_two_pos.ne'] using @le_sin_mul ((π / 2)⁻¹ * x) _ _
  · exact mul_nonneg (inv_nonneg.2 pi_div_two_pos.le) hx
  · rwa [← div_eq_inv_mul, div_le_one pi_div_two_pos]
#align real.mul_le_sin Real.mul_le_sin

end Real


open nat

variables one x n p q d e : nat

variable gcd (a b : nat) : nat
variable phi (n   : nat) : nat

variable prime     (a           : nat) : Prop
variable congruent (a b modulus : nat) : Prop

premise nDef   : n = p * q
premise pPhi   : phi p = p - one
premise qPhi   : phi q = q - one
premise nPhi   : phi n = (q - one) * (p - one)
premise xLess  : x < n
premise pIsPrime : prime p
premise qIsPrime : prime q
premise de_Inverse : (congruent (d * e) one (phi n))
premise OneMul : ∀ n : nat, one * n = n
premise OneExp : ∀ n : nat, one ^ n = one
premise ExpOne : ∀ n : nat, n ^ one = n
premise ExpSum  (a b c : nat) : (a ^ b) * (a ^ c) = a ^ (b + c)
premise ExpMul  (a b c : nat) : (a ^ b) ^ c = a ^ (b * c)
premise ExpSwap (a b c : nat) : (a ^ b) ^ c = (a ^ c) ^ b
premise ModuloDef (a b n : nat) : congruent a b n ↔ ∃ c, a = b + (c * n)
premise CongruenceReflexivity (a b n : nat) : congruent a b n → congruent b a n
premise CongruenceScaling (a b n k : nat) : congruent a b n → congruent (a * k) (b * k) n
premise CongruenceExponentiation (a b n k : nat) : congruent a b n → congruent (a ^ k) (b ^ k) n
premise EqMul (a b k : nat) : a = b → k * a = k * b
premise MulDistrib (a b c : nat) : a * (b + c) = (a * b) + (a * c)
premise Euler (a b : nat) : gcd a b = one → congruent (a ^ (phi b)) one b
premise GCDProperty (a b c : nat) : gcd a (b * c) ≠ one → prime b → prime c → a < b * c →  (((∃ n, a = n * b) ∧ (gcd a c = one)) ∨   ((∃ n, a = n * c) ∧ (gcd a b = one)))

theorem ProofCoprime (t : nat) : gcd x n = one → congruent (x * ((x ^ (phi n)) ^ t)) x n :=
assume H1    : gcd x n = one,
have   H2    : congruent (x ^ (phi n)) one n,     from       Euler x n H1,
have   Hexpt : congruent (x ^ (phi n)) one n →                 congruent ((x ^ (phi n)) ^ t) (one ^ t) n,     from       CongruenceExponentiation (x ^ (phi n)) one n t,
have   H3    : congruent ((x ^ (phi n)) ^ t) (one ^ t) n,     from       Hexpt H2,
have   Honet : one ^ t = one,     from       OneExp t,
have   H4    : congruent ((x ^ (phi n)) ^ t) one n,     from       eq.subst Honet H3,
have   Hmulx : congruent ((x ^ (phi n)) ^ t) one n →                 congruent (((x ^ (phi n)) ^ t) * x) (one * x) n,     from       CongruenceScaling ((x ^ (phi n)) ^ t) one n x,
have   H5    : congruent (((x ^ (phi n)) ^ t) * x) (one * x) n,     from       Hmulx H4,
have   Honex : one * x = x,     from       OneMul x,
have   H6    : congruent (((x ^ (phi n)) ^ t) * x) x n,     from       eq.subst Honex H5,
show           congruent (x * ((x ^ (phi n)) ^ t)) x n,     from       eq.subst (mul.comm ((x ^ (phi n)) ^ t) x) H6

theorem ProofNotCoprime_Part1 : gcd x n ≠ one → (((∃ n, x = n * p) ∧ (gcd x q = one)) ∨   ((∃ n, x = n * q) ∧ (gcd x p = one))) :=
assume H1  : gcd x n ≠ one,
have   H2  : x < p * q,     from eq.subst nDef xLess,
have   H3  : gcd x (p * q) ≠ one,     from eq.subst nDef H1,
show         (((∃ n, x = n * p) ∧ (gcd x q = one)) ∨                ((∃ n, x = n * q) ∧ (gcd x p = one))),     from GCDProperty x p q H3 pIsPrime qIsPrime H2

theorem ProofNotCoprime_Part2 (t : nat) : (∃ n, x = n * p) ∧ (gcd x q = one) → congruent (x * ((x ^ (phi n)) ^ t)) x n :=
assume H1 : (∃ n, x = n * p) ∧ (gcd x q = one),
have gcd x q = one,     from and.elim_right H1,
have congruent (x ^ (phi q)) one q,     from Euler x q this,
have congruent ((x ^ (phi q)) ^ t) (one ^ t) q,     from CongruenceExponentiation (x ^ (phi q)) one q t this,
have congruent ((x ^ (phi q)) ^ t) one q,     from eq.subst (OneExp t) this,
have congruent (((x ^ (phi q)) ^ t) ^ (p - one)) (one ^ (p - one)) q,     from CongruenceExponentiation          ((x ^ (phi q)) ^ t) one q (p - one) this,
have congruent (((x ^ (phi q)) ^ t) ^ (p - one)) one q,     from eq.subst (OneExp (p - one)) this,
have congruent (((x ^ (phi q)) ^ (p - one)) ^ t) one q,     from eq.subst (ExpSwap (x ^ (phi q)) t (p - one)) this,
have congruent ((x ^ ((phi q) * (p - one))) ^ t) one q,     from eq.subst (ExpMul x (phi q) (p - one)) this,
have congruent ((x ^ ((q - one) * (p - one))) ^ t) one q,     from eq.subst qPhi this,
have congruent ((x ^ (phi n)) ^ t) one q,     from eq.subst (eq.symm nPhi) this,
have ∃ c, ((x ^ (phi n)) ^ t) = one + (c * q),     from (iff.elim_left (ModuloDef ((x ^ (phi n)) ^ t) one q)) this,
exists.elim this (fun (v : nat) (Hv : ((x ^ (phi n)) ^ t) = one + (v * q)),
have x * ((x ^ (phi n)) ^ t) = x * (one + (v * q)),     from EqMul ((x ^ (phi n)) ^ t) (one + (v * q)) x Hv,
have x * ((x ^ (phi n)) ^ t) = (x * one) + (x * (v * q)),     from eq.trans this (MulDistrib x one (v * q)),
have x * ((x ^ (phi n)) ^ t) = (one * x) + (x * (v * q)),     from eq.subst (mul.comm x one) this,
have Hxvq : x * ((x ^ (phi n)) ^ t) = x + (x * (v * q)),     from eq.subst (OneMul x) this,
have ∃ n, x = n * p,     from and.elim_left H1,
exists.elim this (fun (w : nat) (Hw : x = w * p),
have x * ((x ^ (phi n)) ^ t) = x + ((w * p) * (v * q)),     from eq.subst Hw Hxvq,
have x * ((x ^ (phi n)) ^ t) = x + (w * (p * (v * q))),     from eq.subst (mul.assoc w p (v * q)) this,
have x * ((x ^ (phi n)) ^ t) = x + (w * (p * (q * v))),     from eq.subst (mul.comm v q) this,
have x * ((x ^ (phi n)) ^ t) = x + (w * ((p * q) * v)),     from eq.subst (eq.symm (mul.assoc p q v)) this,
have x * ((x ^ (phi n)) ^ t) = x + (w * (n * v)),     from eq.subst (eq.symm nDef) this,
have x * ((x ^ (phi n)) ^ t) = x + (w * (v * n)),     from eq.subst (mul.comm n v) this,
have x * ((x ^ (phi n)) ^ t) = x + (w * v) * n,     from eq.subst (eq.symm (mul.assoc w v n)) this,
have ∃ i, x * ((x ^ (phi n)) ^ t) = x + i * n,     from exists.intro (w * v) this,
show congruent (x * ((x ^ (phi n)) ^ t)) x n,     from (iff.elim_right          (ModuloDef (x * ((x ^ (phi n)) ^ t)) x n)) this))

theorem ProofFinal (t : nat) : congruent (x * ((x ^ (phi n)) ^ t)) x n →  congruent (x ^ (one + ((phi n) * t))) x n :=
assume H1    : congruent (x * ((x ^ (phi n)) ^ t)) x n,
have   H2    : congruent (x * (x ^ ((phi n) * t))) x n,     from eq.subst (ExpMul x (phi n) t) H1,
have   Honex : x = x ^ one,     from       eq.symm (ExpOne x),
have   H3    : congruent ((x ^ one) * (x ^ ((phi n) * t))) x n,     from eq.subst Honex H2,
show           congruent (x ^ (one + ((phi n) * t))) x n,     from eq.subst (ExpSum x one ((phi n) * t)) H3


/-
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.polynomial.algebra_map
import data.mv_polynomial.pderiv
import data.nat.choose.sum
import linear_algebra.basis
import ring_theory.polynomial.pochhammer
import tactic.omega

/-!
# 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, nat.sub_sub_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, },
  { by_cases w : 0 < n - ν,
    { simp [zero_pow w], },
    { simp [(show n < ν, by omega), nat.choose_eq_zero_of_lt], }, },
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 nat.sub_sub, rw [←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 ⟨⟩, },
  { intro w,
    replace w := nat.lt_succ_iff.mp w,
    revert w,
    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,
      simp only [sub_zero],
      convert @ih (n-1) (ν-1) _,
      { omega, },
      { omega, },
      { exact le_of_lt h, }, }, },
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

/-- A Pochhammer identity that is useful for `bernstein_polynomial.iterate_derivative_at_0_aux₂`. -/
lemma iterate_derivative_at_0_aux₁ (n k : ℕ) :
  k * polynomial.eval (k-n) (pochhammer ℕ n) = (k-n) * polynomial.eval (k-n+1) (pochhammer ℕ n) :=
begin
  have p :=
    congr_arg (eval (k-n)) ((pochhammer_succ_right ℕ n).symm.trans (pochhammer_succ_left ℕ n)),
  simp only [nat.cast_id, eval_X, eval_one, eval_mul, eval_nat_cast, eval_add, eval_comp] at p,
  rw [mul_comm] at p,
  rw ←p,
  by_cases h : n ≤ k,
  { rw nat.sub_add_cancel h, },
  { simp only [not_le] at h,
    simp only [mul_eq_mul_right_iff],
    right,
    rw nat.sub_eq_zero_of_le (le_of_lt h),
    simp only [pochhammer_eval_zero, ite_eq_right_iff],
    rintro rfl,
    cases h, },
end

lemma iterate_derivative_at_0_aux₂ (n k : ℕ) :
  (↑k) * polynomial.eval ↑(k-n) (pochhammer R n) =
    ↑(k-n) * polynomial.eval (↑(k-n+1)) (pochhammer R n) :=
by simpa using congr_arg (algebra_map ℕ R) (iterate_derivative_at_0_aux₁ n k)

@[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,
  by_cases h : ν = 0,
  { subst h, simp, },
  { apply pochhammer_pos,
    omega, },
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' _ _ _ (show ν ≤ n, by omega),
  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],
  by_cases h' : n = ν,
  { subst h', simp, },
  { replace h : ν < n, { omega, },
    congr,
    norm_cast,
    congr,
    omega, },
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
  simp only [bernstein_polynomial.iterate_derivative_at_1 _ _ _ h, ne.def,
    int.coe_nat_eq_zero, neg_one_pow_mul_eq_zero_iff, nat.cast_eq_zero],
    rw ←nat.cast_succ,
  simp only [←pochhammer_eval_cast],
  norm_cast,
  apply ne_of_gt,
  apply pochhammer_pos,
  exact nat.succ_pos ν,
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,
    rintro ⟨⟨n, ⟨⟩⟩⟩, },
  { 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 ℚ _ (show n - k < n - a, by omega)], },
      { 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, ring, }, },
end

end bernstein_polynomial


import combinatorics.simple_graph.basic

noncomputable theory

open set function

namespace simple_graph

/-- The cyclic graph with `n` vertices.

This is just one possible model: we might want to consider others. -/
@[simps] def cyclic (n : ℕ) : simple_graph (fin n) :=
{ adj := λ x y, (↑(x - y) : ℕ) = 1 ∨ (↑(y - x) : ℕ) = 1,
  symm := λ x y, (or_comm _ _).mp,
  loopless := λ x , by {
    simp only [or_self],
   -- unfold has_sub.sub,
    intro contra,
    have h : x ≤ x,
    {refl},
    rw ← fin.coe_sub_iff_le at h,
    rw h at contra,
    simp only [tsub_self, nat.zero_ne_one] at contra,
    exact contra,
    }, }

lemma not_cyclic_5_adj_0_2 : ¬(cyclic 5).adj 0 2 :=
begin
  simp only [cyclic_adj, zero_sub, sub_zero, fin.coe_two, nat.succ_succ_ne_one, or_false],
  rw [fin.coe_neg], simp only [fin.coe_two, nat.succ_sub_succ_eq_sub, tsub_zero],
  intros r, have : 3 % 5 = 3 := rfl, rw this at r, norm_num at r,
end

@[simp] lemma coe_four  {n : ℕ} : ((4 : fin (n+5)) : ℕ) = 4 := rfl
@[simp] lemma coe_three {n : ℕ} : ((3 : fin (n+4)) : ℕ) = 3 := rfl

lemma not_cyclic_5_adj_0_3 : ¬(cyclic 5).adj 0 3 :=
begin
  simp only [cyclic_adj, zero_sub, sub_zero, coe_three, nat.bit1_eq_one, nat.one_ne_zero, or_false],
  rw [fin.coe_neg],
  simp only [coe_three, nat.succ_sub_succ_eq_sub, tsub_zero],
  intros r, have : 2 % 5 = 2 := rfl, rw this at r, norm_num at r,
end

end simple_graph


import data.set.lattice
import data.set.function
import tactic

open set
open function

noncomputable theory
open_locale classical

variables {α β : Type*} [nonempty β]
variables (f : α → β) (g : β → α)
variables (x : α) (y : β)

#check (inv_fun g : α → β)

#check (left_inverse_inv_fun : injective g → left_inverse (inv_fun g) g)
#check (left_inverse_inv_fun : injective g → ∀ y, inv_fun g (g y) = y)

#check (inv_fun_eq : (∃ y, g y = x) → g (inv_fun g x) = x)

def sb_aux : ℕ → set α
| 0 := univ \ (g '' univ)
| (n + 1) := g '' (f '' sb_aux n)

def sb_set := ⋃ n, sb_aux f g n

def sb_fun (x : α) : β := if x ∈ sb_set f g then f x else inv_fun g x

theorem sb_right_inv {x : α} (hx : x ∉ sb_set f g) :
    g (inv_fun g x) = x :=
begin
  have : x ∈ g '' univ,
    contrapose! hx,
    rw [sb_set, mem_Union],
    use [0],
    rw [sb_aux, mem_diff],
    split,
    apply mem_univ,
    from hx,

  have : ∃ y, g y = x,
    simp at this,
    from this,

  apply inv_fun_eq,
  from this,

end

theorem sb_injective (hf: injective f) (hg : injective g) :
  injective (sb_fun f g) :=
begin
  set A := sb_set f g with A_def,
  set h := sb_fun f g with h_def,
  intros x₁ x₂ hxeq,
  show x₁ = x₂,
    simp only [h_def, sb_fun, ←A_def] at hxeq,
    by_cases xA : x₁ ∈ A ∨ x₂ ∈ A,

    { wlog : x₁ ∈ A := xA using [x₁ x₂, x₂ x₁],
      have x₂A : x₂ ∈ A,
        apply not_imp_self.mp,
        assume x₂nA : x₂ ∉ A,
        rw [if_pos xA, if_neg x₂nA] at hxeq,
        rw [A_def, sb_set, mem_Union] at xA,
        have x₂eq : x₂ = g (f x₁),
          calc
            x₂ = g (inv_fun g x₂) : by rw sb_right_inv f g x₂nA
            ... = g (f x₁) : by rw hxeq,
        rcases xA with ⟨n, hn⟩,
        rw [A_def, sb_set, mem_Union],
        use n + 1,
        simp [sb_aux],
        use [x₁, hn, x₂eq.symm],

      rw [if_pos xA, if_pos x₂A] at hxeq,
      from hf hxeq,},
    { push_neg at xA,
      rw [if_neg xA.1, if_neg xA.2] at hxeq,
      calc
        x₁ = g (inv_fun g x₁) : by rw sb_right_inv f g xA.1
        ... = g (inv_fun g x₂) : by rw hxeq
        ... = x₂ : by rw sb_right_inv f g xA.2,},
end

theorem sb_surjective (hf: injective f) (hg : injective g) :
  surjective (sb_fun f g) :=
begin
  set A := sb_set f g with A_def,
  set h := sb_fun f g with h_def,
  intro y,
  by_cases gyA : g y ∈ A,
  { rw [A_def, sb_set, mem_Union] at gyA,
    rcases gyA with ⟨n, hn⟩,
    cases n with n,
    { simp [sb_aux] at hn,
      contradiction,},
    { simp [sb_aux] at hn,
      rcases hn with ⟨x, xmem, hx⟩,
      use x,
      have : x ∈ A,
        rw [A_def, sb_set, mem_Union],
        use [n, xmem],
      simp only [h_def, sb_fun, if_pos this],
      from hg hx,}},
  { rw [A_def] at gyA,
    use g y,
    rw [h_def, sb_fun, if_neg gyA],
    apply left_inverse_inv_fun,
    from hg,}
end

theorem schroeder_bernstein {f : α → β} {g : β → α}
    (hf: injective f) (hg : injective g) :
  ∃ h : α → β, bijective h :=
⟨sb_fun f g, sb_injective f g hf hg, sb_surjective f g hf hg⟩


import tactic
import data.real.irrational

def rational (x : ℝ) :=
  ∃ (a b : ℤ), x = a / b

/-- The product of two rational numbers is always rational. -/
lemma part_a : ∀ {a b : ℝ}, rational a → rational b → rational (a * b) :=
begin
  sorry
end

/-- The product of two irrational numbers is not always irrational. -/
lemma part_b : ¬ ∀ {a b : ℝ}, irrational a → irrational b → irrational (a * b) :=
begin
  sorry
end

/-- The product of two irrational numbers is not always rational. -/
lemma part_c : ¬ ∀ {a b : ℝ}, irrational a → irrational b → rational (a * b) :=
begin
  sorry
end

/-- The product of a non-zero rational and an irrational is always irrational. -/
lemma part_d : ∀ {a b : ℝ}, a ≠ 0 → rational a → irrational b → irrational (a * b) :=
begin
  sorry
end


import data.seq.seq
import data.list.infix
import tactic

variable {α : Type*}

def stream_prefix : (ℕ → α) → ℕ → list α
| f 0 := list.nil
| f (n + 1) := list.concat (stream_prefix f n) (f n)

lemma stream_prefix_length (f : ℕ → α) (n : ℕ) :
  (stream_prefix f n).length = n :=
begin
  induction n with n ih,
  { refl, },
  { rw [stream_prefix, list.length_concat, ih], },
end

lemma stream_prefix_nth (f : ℕ → α) (n : ℕ) : (stream_prefix f (n + 1)).nth n = f n :=
begin
  unfold stream_prefix,
  have := stream_prefix_length f n,
  conv
  { to_lhs,
    congr,
    skip,
    rw ← this, },
  rw list.concat_eq_append,
  rw list.nth_concat_length,
  refl,
end

lemma stream_prefix_prefix (f : ℕ → α) (n m : ℕ) (h : n ≤ m) :
  stream_prefix f n <+: stream_prefix f m :=
begin
  induction m with m ih,
  { rw nonpos_iff_eq_zero.mp h, },
  { rw le_iff_eq_or_lt at h,
    cases h,
    { rw h, },
    { rw nat.lt_succ_iff at h,
       calc stream_prefix f n <+: stream_prefix f m : ih h
       ... <+: stream_prefix f m.succ : list.prefix_concat (f m) (stream_prefix f m), }, },
end

lemma stream_prefix_nth' (f : ℕ → α) (n i : ℕ) (hi : i < n) : (stream_prefix f n ).nth i = f i :=
begin
  rw ← stream_prefix_nth,
  have hf : stream_prefix f (i + 1) <+: stream_prefix f n := stream_prefix_prefix f (i + 1) n (nat.succ_le_iff.mpr hi),
  have : i < (stream_prefix f (i + 1)).length,
  { rw stream_prefix_length,
    exact lt_add_one i, },
  cases hf with s hs,
  rw ← hs,
  exact (list.nth_append this),
end

def is_prefix (s : list α) (f : ℕ → α) := stream_prefix f (s.length) = s

def is_prefix_def (s : list α) (f : ℕ → α) :
  is_prefix s f ↔ ∀ i < s.length, s.nth i = f i :=
begin
  split,
  { intros h i hi,
    unfold is_prefix at h,
    calc s.nth i = (stream_prefix f s.length).nth i : by rw h
    ... = f i : stream_prefix_nth' f s.length i hi, },
  { intros h,
    ext1 i,
    by_cases hi : i < s.length,
    { calc (stream_prefix f s.length).nth i = f i : stream_prefix_nth' f s.length i hi
      ... = s.nth i : (h i hi).symm, },
    { calc (stream_prefix f s.length).nth i = none : list.nth_len_le (by linarith [stream_prefix_length f s.length])
      ... = s.nth i : (list.nth_len_le (by linarith)).symm, }, },
end

lemma prefix_of_is_prefix (s : list α) (f : ℕ → α) (n : ℕ) (h : is_prefix s f)
  (h' : n ≥ s.length) : s <+: stream_prefix f n :=
begin
  rw is_prefix at h,
  rw ← h,
  exact stream_prefix_prefix f s.length n h',
end

lemma is_prefix_of_prefix (s : list α) (f : ℕ → α) (n : ℕ)
  (h : s <+: stream_prefix f n) : is_prefix s f :=
begin
  have hn : n ≥ s.length,
  { rw ← (stream_prefix_length f n),
    exact list.is_prefix.length_le h, },
  have hf : (stream_prefix f s.length).length = s.length :=
    stream_prefix_length f s.length,
  apply list.eq_of_prefix_of_length_eq,
  { apply list.prefix_of_prefix_length_le (stream_prefix_prefix f s.length n hn) h,
    rw stream_prefix_length, },
  { exact hf, },
end

def prefix_open (X : set (ℕ → α)) (C : set (list α)):= ∀ f : ℕ → α,
  f ∈ X ↔ ∃ s ∈ C, is_prefix s f

def is_prefix_open (X : set (ℕ → α)) := ∃ C, prefix_open X C


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module combinatorics.partition
! leanprover-community/mathlib commit 1ead22342e1a078bd44744ace999f85756555d35
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.Composition
import Mathbin.Data.Nat.Parity
import Mathbin.Tactic.ApplyFun

/-!
# Partitions

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

A partition of a natural number `n` is a way of writing `n` as a sum of positive integers, where the
order does not matter: two sums that differ only in the order of their summands are considered the
same partition. This notion is closely related to that of a composition of `n`, but in a composition
of `n` the order does matter.
A summand of the partition is called a part.

## Main functions

* `p : partition n` is a structure, made of a multiset of integers which are all positive and
  add up to `n`.

## Implementation details

The main motivation for this structure and its API is to show Euler's partition theorem, and
related results.

The representation of a partition as a multiset is very handy as multisets are very flexible and
already have a well-developed API.

## Tags

Partition

## References

<https://en.wikipedia.org/wiki/Partition_(number_theory)>
-/

variable {α : Type _}

open Multiset

open BigOperators

namespace Nat

#print Nat.Partition /-
/-- A partition of `n` is a multiset of positive integers summing to `n`. -/
@[ext]
structure Partition (n : ℕ) where
  parts : Multiset ℕ
  parts_pos : ∀ {i}, i ∈ parts → 0 < i
  parts_sum : parts.Sum = n
  deriving DecidableEq
#align nat.partition Nat.Partition
-/

namespace Partition

#print Nat.Partition.ofComposition /-
/-- A composition induces a partition (just convert the list to a multiset). -/
def ofComposition (n : ℕ) (c : Composition n) : Partition n
    where
  parts := c.blocks
  parts_pos i hi := c.blocks_pos hi
  parts_sum := by rw [Multiset.coe_sum, c.blocks_sum]
#align nat.partition.of_composition Nat.Partition.ofComposition
-/

#print Nat.Partition.ofComposition_surj /-
theorem ofComposition_surj {n : ℕ} : Function.Surjective (ofComposition n) :=
  by
  rintro ⟨b, hb₁, hb₂⟩
  rcases Quotient.exists_rep b with ⟨b, rfl⟩
  refine' ⟨⟨b, fun i hi => hb₁ hi, _⟩, partition.ext _ _ rfl⟩
  simpa using hb₂
#align nat.partition.of_composition_surj Nat.Partition.ofComposition_surj
-/

#print Nat.Partition.ofSums /-
-- The argument `n` is kept explicit here since it is useful in tactic mode proofs to generate the
-- proof obligation `l.sum = n`.
/-- Given a multiset which sums to `n`, construct a partition of `n` with the same multiset, but
without the zeros.
-/
def ofSums (n : ℕ) (l : Multiset ℕ) (hl : l.Sum = n) : Partition n
    where
  parts := l.filterₓ (· ≠ 0)
  parts_pos i hi := Nat.pos_of_ne_zero <| by apply of_mem_filter hi
  parts_sum := by
    have lt : l.filter (· = 0) + l.filter (· ≠ 0) = l := filter_add_not _ l
    apply_fun Multiset.sum  at lt
    have lz : (l.filter (· = 0)).Sum = 0 :=
      by
      rw [Multiset.sum_eq_zero_iff]
      simp
    simpa [lz, hl] using lt
#align nat.partition.of_sums Nat.Partition.ofSums
-/

#print Nat.Partition.ofMultiset /-
/-- A `multiset ℕ` induces a partition on its sum. -/
def ofMultiset (l : Multiset ℕ) : Partition l.Sum :=
  ofSums _ l rfl
#align nat.partition.of_multiset Nat.Partition.ofMultiset
-/

#print Nat.Partition.indiscretePartition /-
/-- The partition of exactly one part. -/
def indiscretePartition (n : ℕ) : Partition n :=
  ofSums n {n} rfl
#align nat.partition.indiscrete_partition Nat.Partition.indiscretePartition
-/

instance {n : ℕ} : Inhabited (Partition n) :=
  ⟨indiscretePartition n⟩

/- warning: nat.partition.count_of_sums_of_ne_zero -> Nat.Partition.count_ofSums_of_ne_zero is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {l : Multiset.{0} Nat} (hl : Eq.{1} Nat (Multiset.sum.{0} Nat Nat.addCommMonoid l) n) {i : Nat}, (Ne.{1} Nat i (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Eq.{1} Nat (Multiset.count.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) i (Nat.Partition.parts n (Nat.Partition.ofSums n l hl))) (Multiset.count.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) i l))
but is expected to have type
  forall {n : Nat} {l : Multiset.{0} Nat} (hl : Eq.{1} Nat (Multiset.sum.{0} Nat Nat.addCommMonoid l) n) {i : Nat}, (Ne.{1} Nat i (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Eq.{1} Nat (Multiset.count.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) i (Nat.Partition.parts n (Nat.Partition.ofSums n l hl))) (Multiset.count.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) i l))
Case conversion may be inaccurate. Consider using '#align nat.partition.count_of_sums_of_ne_zero Nat.Partition.count_ofSums_of_ne_zeroₓ'. -/
/-- The number of times a positive integer `i` appears in the partition `of_sums n l hl` is the same
as the number of times it appears in the multiset `l`.
(For `i = 0`, `partition.non_zero` combined with `multiset.count_eq_zero_of_not_mem` gives that
this is `0` instead.)
-/
theorem count_ofSums_of_ne_zero {n : ℕ} {l : Multiset ℕ} (hl : l.Sum = n) {i : ℕ} (hi : i ≠ 0) :
    (ofSums n l hl).parts.count i = l.count i :=
  count_filter_of_pos hi
#align nat.partition.count_of_sums_of_ne_zero Nat.Partition.count_ofSums_of_ne_zero

/- warning: nat.partition.count_of_sums_zero -> Nat.Partition.count_ofSums_zero is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {l : Multiset.{0} Nat} (hl : Eq.{1} Nat (Multiset.sum.{0} Nat Nat.addCommMonoid l) n), Eq.{1} Nat (Multiset.count.{0} Nat (fun (a : Nat) (b : Nat) => Nat.decidableEq a b) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) (Nat.Partition.parts n (Nat.Partition.ofSums n l hl))) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))
but is expected to have type
  forall {n : Nat} {l : Multiset.{0} Nat} (hl : Eq.{1} Nat (Multiset.sum.{0} Nat Nat.addCommMonoid l) n), Eq.{1} Nat (Multiset.count.{0} Nat (fun (a : Nat) (b : Nat) => instDecidableEqNat a b) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) (Nat.Partition.parts n (Nat.Partition.ofSums n l hl))) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))
Case conversion may be inaccurate. Consider using '#align nat.partition.count_of_sums_zero Nat.Partition.count_ofSums_zeroₓ'. -/
theorem count_ofSums_zero {n : ℕ} {l : Multiset ℕ} (hl : l.Sum = n) :
    (ofSums n l hl).parts.count 0 = 0 :=
  count_filter_of_neg fun h => h rfl
#align nat.partition.count_of_sums_zero Nat.Partition.count_ofSums_zero

/-- Show there are finitely many partitions by considering the surjection from compositions to
partitions.
-/
instance (n : ℕ) : Fintype (Partition n) :=
  Fintype.ofSurjective (ofComposition n) ofComposition_surj

#print Nat.Partition.odds /-
/-- The finset of those partitions in which every part is odd. -/
def odds (n : ℕ) : Finset (Partition n) :=
  Finset.univ.filterₓ fun c => ∀ i ∈ c.parts, ¬Even i
#align nat.partition.odds Nat.Partition.odds
-/

#print Nat.Partition.distincts /-
/-- The finset of those partitions in which each part is used at most once. -/
def distincts (n : ℕ) : Finset (Partition n) :=
  Finset.univ.filterₓ fun c => c.parts.Nodup
#align nat.partition.distincts Nat.Partition.distincts
-/

#print Nat.Partition.oddDistincts /-
/-- The finset of those partitions in which every part is odd and used at most once. -/
def oddDistincts (n : ℕ) : Finset (Partition n) :=
  odds n ∩ distincts n
#align nat.partition.odd_distincts Nat.Partition.oddDistincts
-/

end Partition

end Nat


import Std.Tactic.ShowTerm
import Mathlib.Init.Function

/-
Tactics are human helpers for constructing proof terms, ie terms `c : p` where
`p` is the proposition to be proven.

Let's look at the following two proofs
-/

section

variable (α β γ : Type) (f : α → β) (g : β → γ)

open Function

example : Injective (g ∘ f) → Injective f := by
  intro h a₁ a₂ h'
  apply h
  simp [h']

example : Surjective (g ∘ f) → Surjective g := by
  intro h s
  have ⟨a,h'⟩ := h s
  apply Exists.intro
  exact h'

/-
What do the proof terms look like?
-/

example : Injective (g ∘ f) → Injective f := fun h _ _ h' => h (congrArg g h')
  -- show_term {
  -- intro h a₁ a₂ h'
  -- apply h
  -- exact congrArg g h' }

-- We can then do this
example : Injective (g ∘ f) → Injective f := sorry

example : Surjective (g ∘ f) → Surjective g := by
  show_term {
  intro h s
  have ⟨a,h'⟩ := h s
  apply Exists.intro
  exact h'}

-- And this
example : Surjective (g ∘ f) → Surjective g := fun h s =>
  match h s with
  | Exists.intro a h' => Exists.intro (f a) h'

end
/-
Concision is the main advantage of constructing a proof term directly. Another
possible advantage is a lower level of complexity. Tactics can be implemented
with strange behavior in edge cases, in theory.

A distinct disadvantage is lower level of readability.
-/

/-
Lean is based on dependent type theory. Above we can have seen one incarnation
of "dependence".

`Injective f` depends on the input `f : α → β`. Thus, we have a type which
depends on a term.

While the name "dependent type theory" originates from this form of dependence
there are others built into Lean.

Terms can depend on a type.
-/

def proj₁ (α₁ α₂ : Type) : α₁ × α₂ → α₁ := fun ⟨a,_⟩ => a

/-
This is a term of a basic function type but it depends on `α` and `β`.
Instantiating either gives a concrete term.
-/

-- This is now a concrete term
#check proj₁ UInt8 Bool

/-
We can also have a type depend on another type, like `List`.

And of course we have terms that depend on other terms, ie functions.

Lean accomodates all these versions of dependence. It is based on the
Calculus of Inductive Constructions introduced by Thierry Coquand.

More details on the type theory of Lean can be found in Mario Carneiro's
[Masters thesis](https://github.com/digama0/lean-type-theory).
-/


import ..library.src_field
import tactic

namespace mth1001

namespace myreal

section grouplaws

variables {R : Type} [comm_group R]

/-
The following six lemmas are 'user-friendly' variants of the first four axioms of the real number
system. I have split each of the additive identity and additive inverse axioms into two lemmas.begin

For example, `zero_add` and `add_zero` together constitute the additive identity axiom.
-/

lemma add_comm (x y : R) : x + y = y + x := comm_group.add_comm x y
lemma add_assoc (x y z : R) : (x + y) + z = x + (y + z) := comm_group.add_assoc x y z
lemma add_zero (x : R) : x + 0 = x := comm_group.add_zero x
lemma zero_add (x : R) : 0 + x = x := by {rw [add_comm, add_zero]}
lemma add_neg (x : R) : x + (-x) = 0 := comm_group.add_inv x
lemma neg_add (x : R) : (-x) + x = 0 := by {rw [add_comm, add_neg]}

-- We define what it means for `u` to be an additive identity.
def add_identity (u : R) := ∀ x : R, (x + u = x) ∧ (u + x = x)

-- `0` is an additive identity.
example : add_identity (0 : R) :=
begin
  intro x,
  exact and.intro (add_zero x) (zero_add x),
end

-- The additive identity is unique.
theorem add_identity_unique {a b : R} (h₁ : add_identity a) (h₂ : add_identity b)
  : a = b :=
begin
  specialize h₁ b, -- `h₁ : (b + a = b) ∧ (a + b = b)`
  specialize h₂ a, -- `h₂ : (a + b = a) ∧ (b + a = a)`
  calc  a = a + b : h₂.left.symm -- If `h : x = y`, then `h.symm : y = x`.
      ... = b     : h₁.right
end

-- Definition of additive inverse.
def add_inverse (y x : R) := (x + y = 0) ∧ (y + x = 0)

-- Every real number has an additive inverse.
lemma has_add_inverse : ∀ a : R, ∃ b : R, add_inverse b a :=
begin
  intro a,
  use (-a),
  exact and.intro (add_neg a) (neg_add a)
end

-- The additive inverse is unique.
theorem add_inverse_unique {a b x : R} (h₁ : add_inverse a x) (h₂ : add_inverse b x)
  : a = b :=
calc  a = a + 0        : (add_zero a).symm
    ... = a + (x + b)  : by rw h₂.left
    ... = (a + x) + b  : by rw add_assoc
    ... = 0 + b        : by rw h₁.right
    ... = b            : zero_add b

-- Exercise 001:
-- Complete the following with a `calc` style proof.
lemma add_left_eq_self_mp {x a : R} : x + a = a → x = 0 :=
begin
  intro h,
  sorry
end

-- Exercise 002:
lemma add_left_eq_self_mpr {x a : R} : x = 0 → x + a = a :=
begin
  sorry
end

-- Exercise 003:
theorem add_left_eq_self (x a : R) : x + a = a ↔ x = 0:=
begin
  split,
  { exact add_left_eq_self_mp, },
  { sorry, },
end

-- Exercise 004:
-- Use `split` as above.
theorem add_left_inj (x a b : R) : a + x = b + x ↔ a = b :=
begin
  sorry
end

lemma sub_eq_add_neg (x y : R) : x - y = x + (-y) := rfl

-- Exercise 005:
-- You can do the following with two rewrites. Use `add_zero` and `neg_add`
lemma neg_zero : -(0 : R) = 0 :=
sorry

-- Exercise 006:
lemma sub_zero (a : R) : a - 0 = a :=
sorry

-- Exercise 007:
-- The following can be proved in one line as a sequences of rewrites.
theorem sub_eq_zero_iff_eq (x y : R) : x - y = 0 ↔ x = y :=
sorry

-- Exercise 008:
-- The following can be proved in one line as a sequences of rewrites.
theorem neg_neg (x : R) : - - x = x :=
sorry

-- Exercise 009:
-- Do the following using proof by calculation.
lemma neg_add_eq_neg_add_neg (x y : R) : -(x + y) = -y + - x :=
sorry

end grouplaws

section fieldlaws

variables {R : Type} [myfield R]

/-
The following lemmas encapsulate the remaining algebraic axioms of the real number type.
-/
lemma mul_comm (x y : R) : x * y = y * x := myfield.mul_comm x y
lemma mul_assoc (x y z : R) : (x * y) * z = x * (y * z) := myfield.mul_assoc x y z
lemma mul_one (x : R) : x * 1 = x := myfield.mul_one x
lemma one_mul (x : R) : 1 * x = x := by { rw [mul_comm, mul_one] }
lemma mul_inv (x : R) : x ≠ 0 → x * x⁻¹  = 1 := myfield.mul_inv x
lemma inv_mul (x : R) : x ≠ 0 → x⁻¹ * x = 1 := by {intro h, rw [mul_comm, mul_inv x h], }
lemma mul_add (x y z : R) : x * (y + z) = x * y + x * z := myfield.mul_add x y z
lemma zero_ne_one : (0 : R) ≠ (1 : R) := myfield.zero_ne_one

def mul_identity (u : R) := ∀ x : R, (x * u = x) ∧ (u * x = x)

-- Exercise 010:
-- Use `add_mul` and `add_comm` to prove the following.
theorem add_mul (x y z : R) : (x + y) * z = x * z + y * z :=
begin
  sorry
end

-- Exercise 011:
theorem mul_identity_unique {a b : R} (h₁ : mul_identity a) (h₂ : mul_identity b)
  : a = b :=
begin
  sorry
end

def mul_inverse (y x : R) := (x * y = 1) ∧ (y * x = 1)

-- Exercise 012:
theorem mul_inverse_unique {a b x : R} (h₁ : mul_inverse a x) (h₂ : mul_inverse b x)
  : a = b :=
sorry

-- Exercise 013:
-- This exercise is somewhat challenging.
theorem mul_zero {x : R} : x * (0 : R) = (0 : R) :=
begin
  have h₁ : x * 0 = x * 0 + x * 0,
    calc x * 0
          = x * (0 + 0)   : by rw add_zero (0 : R)
      ... = x * 0 + x * 0 : by rw mul_add,
  sorry
end

-- Exercise 014:
-- Whereas the next result is a simple consequence of the previous result.
theorem zero_mul {x : R} : (0 : R) * x = (0 : R) :=
begin
  sorry
end

-- Exercise 015:
theorem neg_one_mul (x : R) : (-1) * x = -x :=
begin
  sorry
end

-- Exercise 016:
-- Use the result above to prove this lemma.
lemma neg_one_mul_neg_one : (-(1 : R)) * (-1) = 1 :=
sorry

-- Exercise 017:
lemma neg_mul_eq_mul_neg (x y : R) : -(x * y) = x * (-y) :=
sorry

lemma neg_mul_neg_self (x : R) : (-x)*(-x) = x * x :=
by rw [←neg_one_mul, mul_assoc, mul_comm x _, ←mul_assoc, ←mul_assoc, neg_one_mul_neg_one, one_mul]

-- Exercise 018:
lemma neg_mul_neg (x y : R) : (-x) * (-y) = x * y :=
begin
  sorry
end

-- Exercise 019:
lemma one_inv : (1 : R)⁻¹ = (1 : R) :=
sorry
-- Exercise 020:
theorem mul_sub (x y z : R) : x * (y - z) = x * y - x * z :=
begin
  sorry
end

-- Exercise 021:
theorem mul_left_inj' (x a b : R) (h₁ : x ≠ 0): a * x = b * x ↔ a = b :=
begin
  sorry
end

open_locale classical

-- Exercise 022:
-- This is a challenging exercise.
-- Hint 1. Do a `by_cases` proof, depending on whether `x = 0` or not.
-- Hint 2. Use the fact that a non-zero real number has a multiplicative inverse.
lemma eq_zero_of_not_eq_zero_of_mul_not_eq_zero (x b : R) (h₁ : b ≠ 0) (h₂ : x * b = 0) : x = 0 :=
begin
  sorry
end

-- Exercise 023:
-- The following is a corollary of the result above.
lemma eq_zero_or_eq_zero_of_mul_eq_zero (x y : R) (h : x * y = 0) : x = 0 ∨ y = 0 :=
begin
  sorry
end

-- Exercise 024:
lemma mul_inv' (x y : R) (h₁ : x ≠ 0) (h₂ : y ≠ 0) : (x * y)⁻¹ = y⁻¹ * x⁻¹ :=
begin
  have h : x * y ≠ 0,
  { sorry, },
  rw ←(mul_left_inj' _ _ _ h₁),
  sorry
end

-- Exercise 025:
theorem inv_ne_zero {a : R} : a ≠ 0 → a⁻¹ ≠ 0 :=
begin
  sorry
end

-- Exercise 026:
theorem inv_inv' (a : R) (h : a ≠ 0 ) : (a⁻¹)⁻¹ = a :=
begin
  sorry  end

end fieldlaws

section powers

variables {R : Type} [myfield R]

-- The following lemma is essentially the definition of exponentiation.
lemma pow_succ (x : R) (n : ℕ) : x^(n+1) = x * x^n := rfl

-- We have a couple of fundamental results.
lemma pow_zero (x : R) : x ^ 0 = 1 := rfl
lemma pow_one (x : R) : x ^ 1 = x := by rw [pow_succ, pow_zero, mul_one]
lemma pow_succ' (x : R) (n : ℕ) : x^(n+1) = x^n * x := by rw [pow_succ, mul_comm]

-- Exercise 027:
-- Rewrite using the above lemmas to prove this result.
lemma pow_two (x : R) : x ^ 2 = x * x :=
begin
  sorry
end

-- Exercise 028:
-- Prove the following by induction on `n`.
theorem pow_ne_zero {x : R} (n : ℕ) (h : x ≠ 0) : x ^ n ≠ 0 :=
begin
  sorry
end

-- Exercise 029:
-- Use induction. Make use of `nat.add_zero` and `nat.add_succ`
theorem pow_add (x : R) (m n : ℕ) : x ^ (m + n) = (x ^ m) * (x ^ n) :=
begin
  sorry
end

-- Exercise 030:
-- Use induction. Make use of `nat.mul_zero`, `nat.succ_eq_add_one`, and `nat.mul_one`.
-- You'll need `left_distrib`, a synonym of `mul_add` for `ℕ`.
theorem pow_mul (x : R) (m n : ℕ) : x ^ (m*n) = (x ^ m) ^ n :=
begin
  sorry
end

example (m n : ℕ) (h : m ≤ n) : n - m + m = n := nat.sub_add_cancel h

-- Exercise 031:
-- Use `nat.sub_add_cancel` (as demonstrated above).
theorem pow_sub_mul_pow (x : R) {m n : ℕ} (h : m ≤ n) : x ^ (n - m) * x ^ m = x ^ n :=
begin
  rw [←pow_add, nat.sub_add_cancel h],
end

-- Exercise 032:
theorem pow_sub' (x : R) (m n : ℕ) (h : m ≤ n) (ne0 : x ≠ 0) : x ^ (n - m) = (x ^ n) * (x ^ m)⁻¹ :=
begin
  sorry
end

end powers

end myreal

end mth1001