/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import data.finset.basic
import data.multiset.nat_antidiagonal

/-!
# The "antidiagonal" {(0,n), (1,n-1), ..., (n,0)} as a finset.
-/

namespace finset

namespace nat

/-- The antidiagonal of a natural number `n` is
    the finset of pairs `(i,j)` such that `i+j = n`. -/
def antidiagonal (n : ℕ) : finset (ℕ × ℕ) :=
⟨multiset.nat.antidiagonal n, multiset.nat.nodup_antidiagonal n⟩

/-- A pair (i,j) is contained in the antidiagonal of `n` if and only if `i+j=n`. -/
@[simp] lemma mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} :
  x ∈ antidiagonal n ↔ x.1 + x.2 = n :=
by rw [antidiagonal, mem_def, multiset.nat.mem_antidiagonal]

/-- The cardinality of the antidiagonal of `n` is `n+1`. -/
@[simp] lemma card_antidiagonal (n : ℕ) : (antidiagonal n).card = n+1 :=
by simp [antidiagonal]

/-- The antidiagonal of `0` is the list `[(0,0)]` -/
@[simp] lemma antidiagonal_zero : antidiagonal 0 = {(0, 0)} :=
rfl

lemma antidiagonal_succ {n : ℕ} :
  antidiagonal (n + 1) = insert (0, n + 1) ((antidiagonal n).map
  (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ (function.embedding.refl _))) :=
begin
  apply eq_of_veq,
  rw [insert_val_of_not_mem, map_val],
  {apply multiset.nat.antidiagonal_succ},
  { intro con, rcases mem_map.1 con with ⟨⟨a,b⟩, ⟨h1, h2⟩⟩,
    simp only [prod.mk.inj_iff, function.embedding.coe_prod_map, prod.map_mk] at h2,
    apply nat.succ_ne_zero a h2.1, }
end

lemma map_swap_antidiagonal {n : ℕ} :
  (antidiagonal n).map ⟨prod.swap, prod.swap_right_inverse.injective⟩ = antidiagonal n :=
begin
  ext,
  simp only [exists_prop, mem_map, mem_antidiagonal, prod.exists],
  rw add_comm,
  split,
  { rintro ⟨b, c, ⟨rfl, rfl⟩⟩,
    simp },
  { rintro rfl,
    use [a.snd, a.fst],
    simp }
end

/-- A point in the antidiagonal is determined by its first co-ordinate. -/
lemma antidiagonal_congr {n : ℕ} {p q : ℕ × ℕ} (hp : p ∈ antidiagonal n)
  (hq : q ∈ antidiagonal n) : p = q ↔ p.fst = q.fst :=
begin
  refine ⟨congr_arg prod.fst, (λ h, prod.ext h ((add_right_inj q.fst).mp _))⟩,
  rw mem_antidiagonal at hp hq,
  rw [hq, ← h, hp],
end

end nat

end finset


import inClassNotes.propositions.propositions_as_types_the_idea

/-
It's now an easy jump to using type
families indexed by two types to represent
predicates with two arguments. For example,
here's an equality predicate, representing
an equality relation, on terms of type day.
-/

open day

inductive eq_day : day → day → Prop
| eq_day_mo : eq_day mo mo
| eq_day_tu : eq_day tu tu
| eq_day_we : eq_day we we
| eq_day_th : eq_day th th
| eq_day_fr : eq_day fr fr
| eq_day_sa : eq_day sa sa
| eq_day_su : eq_day su su

/-
eq_day = { (mo,mo), (tu,tu), ..., (su,su) }
-/

open eq_day

#check eq_day mo mo   -- inhabited thus true
#check eq_day mo tu   -- not inhabited, not true
#check eq_day fr sa   -- not inhabited, not true

lemma mos_equal : eq_day mo mo := eq_day_mo
lemma mo_tu_equal : eq_day mo tu := _ -- stuck

/-
We use predicates specify sets and relations.
Unary predicates specify sets. Binary and n-ary
predicates more generally specify relations.

For example, always_rains_on : day → Prop
*with its particular proof constructors*
represents the set { mo }, as mo is the only
proposition in the family of propositions
for which there's a proof, i.e., that is
inhabited.

Similarly, our eq_day : day → day → Prop
type family / binary predicate specifies
the 7-element binary relation (a set of
pairs), { (mo,mo), ..., (su,su)}, in the
sense these are all of and the only values
for which eq_day yields a proposition for
which there's a proof.
-/

/-
We can even use our home-grown equality
predicate (a binary relation) on days to
re-write our (always_rains_on d) predicate
using eq_day so that we can finish our
proof above.
-/

inductive always_rains_on' : day → Prop
| mo_rainy' : ∀ (d : day), (eq_day d mo) → always_rains_on' d

open always_rains_on'

lemma bad_tuesdays' : always_rains_on' tu := mo_rainy' tu _  -- stuck
lemma bad_fridays' : always_rains_on' fr := mo_rainy' fr _  -- stuck
lemma bad_mondays' : always_rains_on' mo := mo_rainy' mo eq_day_mo

/-
As an aside you can of course use tactic mode.
-/

lemma bad_mondays'' : always_rains_on' mo := /- term -/
begin
apply mo_rainy' _ _,
exact eq_day_mo,
end

/-
We're now completely set up to look at
a first crucial application of these
ideas: the definition of an equality
predicate in Lean. We just saw how we
can represent an equality relation on
days as a two-place predicate.

We generalize our approach by defining
a polymorphic type family, eq. The eq
type family takes on type parameter, α,
and two *values* of that type, a1 and
a2, (just as our eq_day predicate takes
two values of type day). The resulting
proposition is (eq a b), for which Lean
gives us infix syntactic sugar, a = b.
The type parameter is implicit.

That defines our family of propositions.
They include propositions such as follow.
-/

#check eq 1 1           -- a1=1
#check eq 0 1           -- 0 = 1
#check eq tt tt         -- tt = tt
#check eq tt ff         -- tt = ff
#check eq "hi" "there"  -- "hi" = "there"
#check eq mo tu         -- mo = tu

/-
The following terms are not propositions
in Lean, for they do not even type check.
-/

#check eq 1 tt
#check eq "hi" 2
#check eq tt "Lean!"

/-
The final trick is that there is just
one constructor for eq, called "refl"
(generally written eq.refl) that takes
*one* argument, a : α, and constructs
a value of type (eq a a), aka a=a, which
we take to be a proof of equality. The
upshot is that you can generate a proof that
any value of any type is equal to itself
and there is no way to create a proof of
any other equality.
-/

#check @eq

/-
Here's Lean's exact definition of the
eq relation as a type family with some
members having proofs of equalty, and
other members not. The real key is to
define the constructors/axioms so that
you get exacty the relation you want!
-/

namespace eql

universe u

inductive eq {α : Sort u} (a : α) : α → Prop
| refl [] : eq a  -- skip notation for now

-- You can see exactly what's going on here
#check @eq
#check eq 1 1
#check 1 = 1    -- same thing
#check @eq.refl
#check eq.refl 1

end eql

example : 1 = 1 := eq.refl 1
example : 1 = 2 := _

/-
Moreover, Lean reduces arguments to calls
so you can use eq.refl to construct proofs
of propositions such as 1 + 1 = 2.
-/
example : 1 + 1 = 2 := eq.refl 2
example : "Hello, " ++ "Lean!" = "Hello, Lean!" := eq.refl "Hello, Lean!"

/-
By the way, "example", is like def, lemma
or theorem, but you don't bind a name to
a term. It's useful for show that a type
is inhabited by giving an example of a
value of that type. It's particularly
useful when you don't care which value
of a type is produced, since you're not
go to do anything else with it anyway,
given that it's unnamed.
-/

/-
A note on convenient shortcuts. The rfl
function uses inference pretty heavily.
-/

example : 1 + 1 = 4 - 2 := rfl

/-
Here's the definition of rfl from Lean's library.

def rfl {α : Sort u} {a : α} : a = a := eq.refl a

Lean has to be able to infer both the (α : Type)
and (a : α) value for this definition to work.
-/

/-
We've thus specified the binary relation, equality,
the equality predicate, on terms of any type. What
are its properties and related functions?
-/

/-
Properties of equality
-- reflexive
-- symmetric
-- transitive
An equivalence relation
-/

#check eq.refl
#check eq.symm
#check eq.trans
#check @eq.rec

inductive ev : ℕ → Prop
| ev_0 : ev 0
| ev_ss : ∀ (n : ℕ), ev n → ev (n+2)

open ev

lemma zero_even : ev 0 := ev_0
lemma two_even : ev 2 := ev_ss 0 ev_0
lemma four_even : ev 4 := ev_ss 2 two_even

lemma four_even' : ev 4 :=
  ev_ss   -- emphasizes recursive structure of proof term
    2
    (ev_ss
      0
      ev_0
    )

lemma five_hundred_even : ev 500 :=
begin
  repeat { apply ev_ss },
  _
end


import ..prooflab
import lectures.lec1_def_lem_thm

/-! # Homework 1: ...
Homework must be done individually.
Replace the placeholders (e.g., `:= sorry`) with your solutions. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace PROOFS

/-! ## Question 1 (10 points):
Use the lemma `mul_one` together with `rw` tactic to complete the proof below:
-/

#check (mul_one : ∀ (a : ℚ), a * 1 = a)

example (x y z : ℚ) (h₁ : x * 1 = y) (h₂ : y = z)  :
x = z :=
begin
sorry,
end

/-! ## Question 2 (10 points):
Use the tactic `exact` together with the lemma `symm_of_eq`, which we proved in `lec1_def_lem_thm` to complete the following proof.
-/

#check symm_of_eq

example (x : ℕ) (h : x = 2) :
  2 = x :=
begin
  sorry,
end

/-! ## Question 3 (20 points)
Use `rw` and the lemma `mul_assoc` to prove the `example` below.
-/

#check ( mul_assoc : ∀ (a b c : ℝ), a * b * c = a * (b * c) )

example (a b c : ℝ) :
  3 * a * b * c = 3 * a * (b * c) :=
begin
  sorry,
end

/-! ## Question 4 (20 points)
Complete the next proof using the following lemma:
  `sub_self x : x - x = 0`
-/

section
variable x : ℝ
#check sub_self x
end -- end of section

example (a b c d : ℝ) (h₁ : c = 1 + b * a - d) (h₂ : d = 1 + a * b) :
  c = 0 :=
begin
  rw mul_comm at h₂,
  rw h₂ at h₁,
  sorry,
end

/-! ## Question 5 (20 points)
Complete the next proof using lemmas `mul_assoc` and `mul_comm`:
-/

#check ( mul_assoc : ∀ (a b c : ℝ), a * b * c = a * (b * c) )
#check ( mul_comm : ∀ (a b : ℝ), a * b = b * a )

example (a b c : ℝ) :
  (c * b) * a = b * (a * c) :=
begin
  sorry,
end

/-! ## Question 6 (20 points)
Next exercises shows that the negation flips the strict order on real numbers. Complete the next proof using lemmas `neg_neg` and `neg_lt`:
-/

section
variables x y : ℝ
#check (neg_neg : ∀ a : ℝ, - -a = a)
#check (neg_lt.mpr : -x < y → -y < x)
#check (neg_lt : -x < y ↔ -y < x)
end
/-

-/
example  {x y : ℝ} (h : x < y)
  : - y < - x :=
begin
  sorry,
end

end PROOFS


import MyNat.Definition
namespace MyNat
open MyNat
/-!
# Proposition world.

## Level 3: `have`.

Say you have a whole bunch of propositions and implications between them, and your goal is to build
a certain proof of a certain proposition. If it helps, you can build intermediate proofs of other
propositions along the way, using the `have` command. `have q : Q := ...` is the Lean analogue of
saying "We now see that we can prove `Q`, because..." in the middle of a proof. It is often not
logically necessary, but on the other hand it is very convenient, for example it can save on
notation, or it can break proofs up into smaller steps.

In the level below, we have a proof of `P` and we want a proof of `U`; during the proof we will
construct proofs of of some of the other propositions involved. The diagram of propositions and
implications looks like this pictorially:

![diagram](../assets/propositions_diag.svg)

and so it's clear how to deduce `U` from `P`.
Indeed, we could solve this level in one move by typing

`exact l (j (h p))`

But let us instead stroll more lazily through the level.
We can start by using the `have` tactic to make a proof of `Q`:

`have q := h p`

and then we note that `j q` is a proof of `T`:

`have t : T := j q`

(note how we explicitly told Lean what proposition we thought `t` was
a proof of, with that `: T` thing before the `:=`)
and we could even define `u` to be `l t`:

`have u : U := l t`

and then finish the level with

`exact u`

## Lemma : maze

In the maze of logical implications above, if `P` is true then so is `U`.
-/
lemma maze (P Q R S T U: Prop)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U := by
  have q := h p
  have t := j q
  have u := l t
  exact u

/-!
Remember you can move your cursor around with the arrow keys and explore the various tactic states
in this proof in Visual Studio Code, and note that the tactic state at the beginning of `exact u` is
this mess:

```
P Q R S T U : Prop,
p : P,
h : P → Q,
i : Q → R,
j : Q → T,
k : S → T,
l : T → U,
q : Q,
t : T,
u : U
⊢ U
```

It was already bad enough to start with, and we added three more terms to it. In level 4 we will
learn about the `apply` tactic which solves the level using another technique, without leaving so
much junk behind.

Next up [Level 4](./Level4.lean.md)
-/


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : María Inés de Frutos-Fernández
-/

import tactic
import data.real.basic

/-
# Límites de secuencias en Lean
Escribimos la definicón `ε` - `N` del límite de una secuencia de
números reales y demostramos resultados sobre límites.

NOTA: adaptado de los cursos de formalización de Kevin Buzzard.
-/

/- ### Notación lambda (λ) para funciones
Recordatorio: para representar una función `f` en Lean, utilizamos notación lambda:
`λ x, f x` es la función que asigna a `x` el valor `f (x)`. -/

def f : ℕ → ℝ := λ n, n^2 + 3 -- `f(n) = n^2 + 3`

example : f 3 = 12 :=
begin
  rw f,
  dsimp only, -- Para simplificar la aplicación de funciones
  norm_num, -- Normaliza expresiones numéricas
end

/-
## Límite de una secuencia
-/

/-- Si `a(n)` es una secuencia de números reales y `L` es un real,
 `tends_to a L` dice que el límite de `a(n)` cuando `n → ∞` es `L`. -/
def tends_to (a : ℕ → ℝ) (L : ℝ) : Prop :=
∀ ε > 0, ∃ N : ℕ, ∀ n, N ≤ n → |a n - L| < ε

/-- Este lema nos permite reescribir la definición de `tends_to` en nuestras pruebas. -/
theorem tends_to_def {a : ℕ → ℝ} {t : ℝ} :
  tends_to a t ↔ ∀ ε, 0 < ε → ∃ B : ℕ, ∀ n, B ≤ n → |a n - t| < ε :=
begin
  refl
end

/-
## Ejercicios
-/

/-- El límite de la secuencia constante con valor `c` es `c`. -/
theorem tends_to_const (c : ℝ) : tends_to (λ n, c) c :=
begin
  sorry
end

/-- Si `a(n)` tiende a `L` entonces `a(n) + c` tiende a `t + c` -/
theorem tends_to_add_const {a : ℕ → ℝ} {L : ℝ} (c : ℝ)
  (h : tends_to a L) :
  tends_to (λ n, a n + c) (L + c) :=
begin
  sorry
end

/-- Si `a(n)` tiende a `L`, entonces `-a(n)` tiende a `-L`.
Si simplificar la expresión dentro del valor absoluto te está
dando problemas, ve a la hoja `reales.lean`.
-/
theorem tends_to_neg {a : ℕ → ℝ} {L : ℝ} (ha : tends_to a L) :
  tends_to (λ n, - a n) (-L) :=
begin
  sorry
end

/-- Si `a(n)` tiende a `La` y `b(n)` tiende a `Lb` entonces `a(n) + b(n)`
tiende a `La + Lb`.
Esta demostración es más complicada que las anteriores.
-/
theorem tends_to_add {a b : ℕ → ℝ} {La Lb : ℝ}
  (ha : tends_to a La) (hb : tends_to b Lb) :
  tends_to (λ n, a n + b n) (La + Lb) :=
begin
  sorry
end

/-- Si `a(n)` tiende a `La` y `b(n)` tiende a `Lb` entonces `a(n) - b(n)`
tiende a `La - Lb`. -/
theorem tends_to_sub {a b : ℕ → ℝ} {La Lb : ℝ}
  (ha : tends_to a La) (hb : tends_to b Lb) :
  tends_to (λ n, a n - b n) (La - Lb) :=
begin
  sorry
end

/-- Si `a(n)` tiende a `L`, entonces `c*a(n)` tiende a `c*L`.
Pista: tratad el caso `c = 0` por separado, utilizando `by_cases hc : c = 0`.
-/
lemma tends_to_mul_const_left {a : ℕ → ℝ} {L c : ℝ} (h : tends_to a L) :
  tends_to (λ n, c * (a n)) (c * L) :=
begin
  sorry
end

/- Lema del sandwich. -/
theorem sandwich (a b c : ℕ → ℝ) (L : ℝ) (ha : tends_to a L) (hc : tends_to c L)
  (hab : ∀ n, a n ≤ b n) (hbc : ∀ n, b n ≤ c n) :
  tends_to b L :=
begin
  sorry
end


import Mathlib.Data.Nat.Basic
import Mathlib.Algebra.Group.Basic

/-
Already our proofs are getting fairly complicated. A common technique
in a proof is to construct helper results which then are employed to
assist with the main goal.
-/

open Function

variable {α β γ δ : Type} (f : α → β) (g : β → γ) (h : γ → δ)

#check Function.comp

-- \circ ∘
example : (h ∘ g) ∘ f = h ∘ (g ∘ f) := by
  apply funext
  intro x
  simp

#print Injective

/-
We can use `have` to declare intermediate goals
-/

example (h₁ : Injective f) (h₂ : Injective g) : Injective (g ∘ f) := by
  intro a₁ a₂ h'
  have h'' : f a₁ = f a₂ := h₂ h'
  apply h₁ h''

#print Surjective

/-
We can also use `have` to destructure types
-/

example (h₁ : Surjective f) (h₂ : Surjective g) : Surjective (g ∘ f) := by
  intro c
  have ⟨b,h'⟩ := h₂ c
  have ⟨a,h''⟩ := h₁ b
  apply Exists.intro a
  dsimp
  rw [h'',h']

#print Bijective

example (h' : Bijective f) : Injective f := by
  have ⟨inj,_⟩ := h'
  assumption

/-
`let` is similar to `have` but is meant for data-carring types while `have` is
for `Prop`
-/

def translate (f : ℤ → ℤ) (shift input : ℤ) : ℤ :=
  let g : ℤ → ℤ := fun n => f n + shift
  g input

/-
When working with `=` or another transitive relation, we can use a `calc`.
-/

example (a : ℤ) (f : ℤ → ℤ) : translate (translate f a) (-a) = f := by
  apply funext
  intro m
  calc
    translate (translate f a) (-a) m = translate f a m + (-a) := by simp [translate]
    _ = (f m + a) + (-a) := by simp [translate]
    _ = f m + (a + (-a)) := by rw [Int.add_assoc]
    _ = f m + 0 := by rw [Int.add_right_neg]
    _ = f m := by rw [Int.add_zero]

/-
More generally `calc` blocks can be used for transitive relations.
-/
example (p q r : Prop) (h : p ↔ q) (h' : q ↔ r) : p ↔ r := by
  calc
    p ↔ q := by exact h
    _ ↔ r := by exact h'

/-
Here is `Nat.add`'s definition but with a new name
-/
def plus (m n : ℕ) : ℕ :=
  match n with
  | 0 => m
  | n'+1 => .succ (plus m n')

/-
Let's check that if `m₁ ≤ m₂` then `m₁ ≤ m₂ +1`
-/

theorem leq_succ_of_leq (m n : Nat) (h : m ≤ n) : m ≤ plus n 1 := by
  match n with
  | 0 =>
    have meq0 : m = 0 := Nat.eq_zero_of_le_zero h
    rw [meq0]
    simp
  | n'+1 =>
    simp [plus]
    calc
      m ≤ n'+1 := by exact h
      _ ≤ (n'+1)+1 := by exact Nat.le_succ _

theorem succ_leq_succ_of_leq (m n a : Nat) (h : m ≤ n) : plus m a ≤ plus n a := by
  match a with
  | 0 => simp [plus]; assumption
  | b+1 =>
    simp [plus]
    apply Nat.succ_le_succ
    exact succ_leq_succ_of_leq m n b h


/-
Prove P ∨ Q ↔ Q ∨ P.
-/

theorem
or_commutes :
    ∀ P Q: Prop, P ∨ Q ↔ Q ∨ P
:=
begin

/-
Introduce the assumptions that P and Q
are arbitrary propositions.
-/
assume P Q: Prop,

/-
To prove a bi-implication, we prove the
implications in each direction. That is,
we break the overall goal into subgoals,
one for the forward implication and one
for its converse (in the other direction).
-/
apply iff.intro,

    -- now we prove the forward implication
    assume pq : P ∨ Q,
    show Q ∨ P,
    from
        begin
        /-
        The key proof technique for reasoning
        from a proof of a disjunction, P ∨ Q,
        is to consider two possible cases for
        this proof, that either P is true or
        Q is, and to show that the goal is
        true in either case. This shows that
        no matter why P ∨ Q is true, the goal
        follows.

        So, the proof strategy is first to
        assumes that P ∨ Q is true because P
        is true, which is to say you assume
        you have a proof of P, and then show
        that the goal follows. Then you assume
        P ∨ Q is true because Q is true, and
        you show that given an assumed proof
        of Q, the goal follows. The goal thus
        follows in either case.

        The tactic that we use in Lean to
        reason by cases from a disjunction is
        called "cases." As arguments you give
        it (1) the name of the disjunction to
        reason from, and (2) names to use for
        the assumed proofs of P and Q in the
        respective cases (after keyword "with").

        So here we go. Make sure you have the
        Lean Messages window open so that you
        can see how "cases" changes your tactic
        state. Note that it introduces two new
        subgoals. In the first, there is an
        assumed proof, p : P. In the second,
        there is an an assumed proof q : Q.
        -/
        cases pq with p q,
        -- now prove each case separately

            -- proof for case where P is true
            show Q ∨ P,
            from or.intro_right Q p,

            -- proof for case where Q is true
            show Q ∨ P,
            from or.intro_left P q,
        end,

    -- and now we prove the converse
    assume qp : Q ∨ P,
    show P ∨ Q,
    from
        begin
        cases qp with q p,
            show P ∨ Q,
            from or.intro_right P q,
            show P ∨ Q,
            from or.intro_left Q p,
        end,
end

/-
Homework:

Prove, ∀ P Q: Prop, ¬ P ∧ ¬ Q ↔ ¬ (P ∨ Q)

-/

theorem aDemorganLaw : ∀ P Q: Prop, ¬ P ∧ ¬ Q ↔ ¬ (P ∨ Q) :=
begin
assume P Q : Prop,
apply iff.intro,

-- forward
assume npnq,
show ¬(P ∨ Q),
from
    begin
    assume poq,
    -- proof by cases
    cases poq with p q,
    -- case where P is true
    show false, from npnq.left p,
    -- case where Q is true
    show false, from npnq.right q,
    end,

-- converse
assume poq,
show  ¬P ∧ ¬Q,
from
    begin
    -- proof by and introduction
    apply and.intro,
    -- left conjunct
    assume p, show false, from poq (or.intro_left Q p),
    -- right conjunct
    assume q, show false, from poq (or.intro_right P q)
    end,
-- QED
end


import tactic.omega
import data.real.basic
import data.real.sqrt
import data.nat.prime
import data.nat.factorial

/- Dealing with numbers:

  ℕ    natural numbers
  ℤ    integers
  ℚ    rational numbers
  ℝ    real numbers
  ℂ    complex numbers

Tactics:

  norm_num, linarith, ring, norm_cast, field_simp, omega

Also see LFTCM 2020 lecture:

  https://www.youtube.com/watch?v=iEs2U_kzYy4

-/

example : 2 + 3 = 5 := rfl
example : 1 + 2 + 3 = 6 := by refl
example : 2 + 3 = 5 := begin
  refl
end

example : 2000000 + 3000000 = 5000000 := by norm_num

example : 2 * 3 = 6 := rfl

example : 2 - 3 = 0 := rfl      -- "Totalization" of a partial function (subtraction : ℕ × ℕ → ℕ)
example : 2 / 3 = 0 := rfl

example : (2 : ℤ) - 3 = -1 := rfl
example : (2 : ℚ) - 3 = -1 := rfl
example : (2 : ℝ) - 3 = -1 := by norm_num

#print notation -
#check @has_sub.sub

#check (show has_sub ℤ, by apply_instance)
#check int.has_sub

example : nat.prime 65537 := by norm_num
example : ¬ nat.prime 65538 := by norm_num
example : nat.factorial 6 = 720 := by norm_num

-- `omega` can prove theorems in the language (ℕ, 0, 1, +, <).

example (i j n : ℕ) (h₁ : i ≤ j) (h₂ : j < n) : i + (j - i + 1) + (n - 1 - j) = n :=
begin
  omega,
  -- alternatively: prove equality of integers,
  -- using tools like `norm_cast` & `ring`
end

open real

example (r : ℝ) (hr : r*r + r - 1 = 0) (rpos : r > 0) : r = (sqrt 5 - 1) / 2 :=
begin
  have : (r - (sqrt 5 - 1) / 2) * (r - (- sqrt 5 - 1) / 2) = r*r + r - 1,
  { ring,
    norm_num,
    ring, },
  rw hr at this,
  rw mul_eq_zero at this,
  cases this with h h,
  { linarith,
},
  sorry
end

example (x : ℝ) (hx : x ≠ 0) : x / x^2 = 1 / x :=
begin
  -- field_simp,
  ring,
end

/- Exercises: From Lean for the Curious Mathematician 2020.
See https://leanprover-community.github.io/lftcm2020/exercises.html
This lecture: tuesday/numbers.lean
-/


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import data.polynomial.monomial
import data.nat.with_bot

/-!
# Theory of univariate polynomials

The definitions include
`degree`, `monic`, `leading_coeff`

Results include
- `degree_mul` : The degree of the product is the sum of degrees
- `leading_coeff_add_of_degree_eq` and `leading_coeff_add_of_degree_lt` :
    The leading_coefficient of a sum is determined by the leading coefficients and degrees
-/

noncomputable theory
local attribute [instance, priority 100] classical.prop_decidable

open finsupp finset
open_locale big_operators

namespace polynomial
universes u v
variables {R : Type u} {S : Type v} {a b : R} {n m : ℕ}

section semiring
variables [semiring R] {p q r : polynomial R}

/-- `degree p` is the degree of the polynomial `p`, i.e. the largest `X`-exponent in `p`.
`degree p = some n` when `p ≠ 0` and `n` is the highest power of `X` that appears in `p`, otherwise
`degree 0 = ⊥`. -/
def degree (p : polynomial R) : with_bot ℕ := p.support.sup some

lemma degree_lt_wf : well_founded (λp q : polynomial R, degree p < degree q) :=
inv_image.wf degree (with_bot.well_founded_lt nat.lt_wf)

instance : has_well_founded (polynomial R) := ⟨_, degree_lt_wf⟩

/-- `nat_degree p` forces `degree p` to ℕ, by defining nat_degree 0 = 0. -/
def nat_degree (p : polynomial R) : ℕ := (degree p).get_or_else 0

/-- `leading_coeff p` gives the coefficient of the highest power of `X` in `p`-/
def leading_coeff (p : polynomial R) : R := coeff p (nat_degree p)

/-- a polynomial is `monic` if its leading coefficient is 1 -/
def monic (p : polynomial R) := leading_coeff p = (1 : R)

@[nontriviality] lemma monic_of_subsingleton [subsingleton R] (p : polynomial R) : monic p :=
subsingleton.elim _ _

lemma monic.def : monic p ↔ leading_coeff p = 1 := iff.rfl

instance monic.decidable [decidable_eq R] : decidable (monic p) :=
by unfold monic; apply_instance

@[simp] lemma monic.leading_coeff {p : polynomial R} (hp : p.monic) :
  leading_coeff p = 1 := hp

lemma monic.coeff_nat_degree {p : polynomial R} (hp : p.monic) : p.coeff p.nat_degree = 1 := hp

@[simp] lemma degree_zero : degree (0 : polynomial R) = ⊥ := rfl

@[simp] lemma nat_degree_zero : nat_degree (0 : polynomial R) = 0 := rfl

@[simp] lemma coeff_nat_degree : coeff p (nat_degree p) = leading_coeff p := rfl

lemma degree_eq_bot : degree p = ⊥ ↔ p = 0 :=
⟨λ h, by rw [degree, ← max_eq_sup_with_bot] at h;
  exact support_eq_empty.1 (max_eq_none.1 h),
λ h, h.symm ▸ rfl⟩

@[nontriviality] lemma degree_of_subsingleton [subsingleton R] : degree p = ⊥ :=
by rw [subsingleton.elim p 0, degree_zero]

@[nontriviality] lemma nat_degree_of_subsingleton [subsingleton R] : nat_degree p = 0 :=
by rw [subsingleton.elim p 0, nat_degree_zero]

lemma degree_eq_nat_degree (hp : p ≠ 0) : degree p = (nat_degree p : with_bot ℕ) :=
let ⟨n, hn⟩ :=
  not_forall.1 (mt option.eq_none_iff_forall_not_mem.2 (mt degree_eq_bot.1 hp)) in
have hn : degree p = some n := not_not.1 hn,
by rw [nat_degree, hn]; refl

lemma degree_eq_iff_nat_degree_eq {p : polynomial R} {n : ℕ} (hp : p ≠ 0) :
  p.degree = n ↔ p.nat_degree = n :=
by rw [degree_eq_nat_degree hp, with_bot.coe_eq_coe]

lemma degree_eq_iff_nat_degree_eq_of_pos {p : polynomial R} {n : ℕ} (hn : 0 < n) :
  p.degree = n ↔ p.nat_degree = n :=
begin
  split,
  { intro H, rwa ← degree_eq_iff_nat_degree_eq, rintro rfl,
    rw degree_zero at H, exact option.no_confusion H },
  { intro H, rwa degree_eq_iff_nat_degree_eq, rintro rfl,
    rw nat_degree_zero at H, rw H at hn, exact lt_irrefl _ hn }
end

lemma nat_degree_eq_of_degree_eq_some {p : polynomial R} {n : ℕ}
  (h : degree p = n) : nat_degree p = n :=
have hp0 : p ≠ 0, from λ hp0, by rw hp0 at h; exact option.no_confusion h,
option.some_inj.1 $ show (nat_degree p : with_bot ℕ) = n,
  by rwa [← degree_eq_nat_degree hp0]

@[simp] lemma degree_le_nat_degree : degree p ≤ nat_degree p :=
with_bot.gi_get_or_else_bot.gc.le_u_l _

lemma nat_degree_eq_of_degree_eq [semiring S] {q : polynomial S} (h : degree p = degree q) :
  nat_degree p = nat_degree q :=
by unfold nat_degree; rw h

lemma le_degree_of_ne_zero (h : coeff p n ≠ 0) : (n : with_bot ℕ) ≤ degree p :=
show @has_le.le (with_bot ℕ) _ (some n : with_bot ℕ) (p.support.sup some : with_bot ℕ),
from finset.le_sup (finsupp.mem_support_iff.2 h)

lemma le_nat_degree_of_ne_zero (h : coeff p n ≠ 0) : n ≤ nat_degree p :=
begin
  rw [← with_bot.coe_le_coe, ← degree_eq_nat_degree],
  exact le_degree_of_ne_zero h,
  { assume h, subst h, exact h rfl }
end

lemma le_nat_degree_of_mem_supp (a : ℕ) :
  a ∈ p.support → a ≤ nat_degree p:=
le_nat_degree_of_ne_zero ∘ mem_support_iff.mp

lemma supp_subset_range (h : nat_degree p < m) : p.support ⊆ finset.range m :=
λ n hn, mem_range.2 $ (le_nat_degree_of_mem_supp _ hn).trans_lt h

lemma supp_subset_range_nat_degree_succ : p.support ⊆ finset.range (nat_degree p + 1) :=
supp_subset_range (nat.lt_succ_self _)

lemma degree_le_degree (h : coeff q (nat_degree p) ≠ 0) : degree p ≤ degree q :=
begin
  by_cases hp : p = 0,
  { rw hp, exact bot_le },
  { rw degree_eq_nat_degree hp, exact le_degree_of_ne_zero h }
end

lemma degree_ne_of_nat_degree_ne {n : ℕ} :
  p.nat_degree ≠ n → degree p ≠ n :=
mt $ λ h, by rw [nat_degree, h, option.get_or_else_coe]

theorem nat_degree_le_iff_degree_le {n : ℕ} : nat_degree p ≤ n ↔ degree p ≤ n :=
with_bot.get_or_else_bot_le_iff

alias polynomial.nat_degree_le_iff_degree_le ↔ . .

lemma nat_degree_le_nat_degree (hpq : p.degree ≤ q.degree) : p.nat_degree ≤ q.nat_degree :=
with_bot.gi_get_or_else_bot.gc.monotone_l hpq

@[simp] lemma degree_C (ha : a ≠ 0) : degree (C a) = (0 : with_bot ℕ) :=
show sup (ite (a = 0) ∅ {0}) some = 0, by rw if_neg ha; refl

lemma degree_C_le : degree (C a) ≤ (0 : with_bot ℕ) :=
by by_cases h : a = 0; [rw [h, C_0], rw [degree_C h]]; [exact bot_le, exact le_refl _]

lemma degree_one_le : degree (1 : polynomial R) ≤ (0 : with_bot ℕ) :=
by rw [← C_1]; exact degree_C_le

@[simp] lemma nat_degree_C (a : R) : nat_degree (C a) = 0 :=
begin
  by_cases ha : a = 0,
  { have : C a = 0, { rw [ha, C_0] },
    rw [nat_degree, degree_eq_bot.2 this],
    refl },
  { rw [nat_degree, degree_C ha], refl }
end

@[simp] lemma nat_degree_one : nat_degree (1 : polynomial R) = 0 := nat_degree_C 1

@[simp] lemma nat_degree_nat_cast (n : ℕ) : nat_degree (n : polynomial R) = 0 :=
by simp only [←C_eq_nat_cast, nat_degree_C]

@[simp] lemma degree_monomial (n : ℕ) (ha : a ≠ 0) : degree (monomial n a) = n :=
by rw [degree, support_monomial _ _ ha]; refl

@[simp] lemma degree_C_mul_X_pow (n : ℕ) (ha : a ≠ 0) : degree (C a * X ^ n) = n :=
by rw [← single_eq_C_mul_X, degree_monomial n ha]

lemma degree_monomial_le (n : ℕ) (a : R) : degree (monomial n a) ≤ n :=
if h : a = 0 then by rw [h, (monomial n).map_zero]; exact bot_le else le_of_eq (degree_monomial n h)

lemma degree_C_mul_X_pow_le (n : ℕ) (a : R) : degree (C a * X ^ n) ≤ n :=
by { rw C_mul_X_pow_eq_monomial, apply degree_monomial_le }

@[simp] lemma nat_degree_C_mul_X_pow (n : ℕ) (a : R) (ha : a ≠ 0) : nat_degree (C a * X ^ n) = n :=
nat_degree_eq_of_degree_eq_some (degree_C_mul_X_pow n ha)

@[simp] lemma nat_degree_C_mul_X (a : R) (ha : a ≠ 0) : nat_degree (C a * X) = 1 :=
by simpa only [pow_one] using nat_degree_C_mul_X_pow 1 a ha

@[simp] lemma nat_degree_monomial (i : ℕ) (r : R) (hr : r ≠ 0) :
  nat_degree (monomial i r) = i :=
by rw [← C_mul_X_pow_eq_monomial, nat_degree_C_mul_X_pow i r hr]

lemma coeff_eq_zero_of_degree_lt (h : degree p < n) : coeff p n = 0 :=
not_not.1 (mt le_degree_of_ne_zero (not_le_of_gt h))

lemma coeff_eq_zero_of_nat_degree_lt {p : polynomial R} {n : ℕ} (h : p.nat_degree < n) :
  p.coeff n = 0 :=
begin
  apply coeff_eq_zero_of_degree_lt,
  by_cases hp : p = 0,
  { subst hp, exact with_bot.bot_lt_coe n },
  { rwa [degree_eq_nat_degree hp, with_bot.coe_lt_coe] }
end

@[simp] lemma coeff_nat_degree_succ_eq_zero {p : polynomial R} : p.coeff (p.nat_degree + 1) = 0 :=
coeff_eq_zero_of_nat_degree_lt (lt_add_one _)

-- We need the explicit `decidable` argument here because an exotic one shows up in a moment!
lemma ite_le_nat_degree_coeff (p : polynomial R) (n : ℕ) (I : decidable (n < 1 + nat_degree p)) :
  @ite _ (n < 1 + nat_degree p) I (coeff p n) 0 = coeff p n :=
begin
  split_ifs,
  { refl },
  { exact (coeff_eq_zero_of_nat_degree_lt (not_le.1 (λ w, h (nat.lt_one_add_iff.2 w)))).symm, }
end

lemma as_sum_support (p : polynomial R) :
  p = ∑ i in p.support, monomial i (p.coeff i) :=
p.sum_single.symm

lemma as_sum_support_C_mul_X_pow (p : polynomial R) :
  p = ∑ i in p.support, C (p.coeff i) * X^i :=
trans p.as_sum_support $ by simp only [C_mul_X_pow_eq_monomial]

/--
We can reexpress a sum over `p.support` as a sum over `range n`,
for any `n` satisfying `p.nat_degree < n`.
-/
lemma sum_over_range' [add_comm_monoid S] (p : polynomial R) {f : ℕ → R → S} (h : ∀ n, f n 0 = 0)
  (n : ℕ) (w : p.nat_degree < n) :
  p.sum f = ∑ (a : ℕ) in range n, f a (coeff p a) :=
finsupp.sum_of_support_subset _ (supp_subset_range w) _ $ λ n hn, h n

/--
We can reexpress a sum over `p.support` as a sum over `range (p.nat_degree + 1)`.
-/
lemma sum_over_range [add_comm_monoid S] (p : polynomial R) {f : ℕ → R → S} (h : ∀ n, f n 0 = 0) :
  p.sum f = ∑ (a : ℕ) in range (p.nat_degree + 1), f a (coeff p a) :=
sum_over_range' p h (p.nat_degree + 1) (lt_add_one _)

lemma as_sum_range' (p : polynomial R) (n : ℕ) (w : p.nat_degree < n) :
  p = ∑ i in range n, monomial i (coeff p i) :=
p.sum_single.symm.trans $ p.sum_over_range' (λ n, single_zero) _ w

lemma as_sum_range (p : polynomial R) :
  p = ∑ i in range (p.nat_degree + 1), monomial i (coeff p i) :=
p.sum_single.symm.trans $ p.sum_over_range $ λ n, single_zero

lemma as_sum_range_C_mul_X_pow (p : polynomial R) :
  p = ∑ i in range (p.nat_degree + 1), C (coeff p i) * X ^ i :=
p.as_sum_range.trans $ by simp only [C_mul_X_pow_eq_monomial]

lemma coeff_ne_zero_of_eq_degree (hn : degree p = n) :
  coeff p n ≠ 0 :=
λ h, mem_support_iff.mp (mem_of_max hn) h

lemma eq_X_add_C_of_degree_le_one (h : degree p ≤ 1) :
  p = C (p.coeff 1) * X + C (p.coeff 0) :=
ext (λ n, nat.cases_on n (by simp)
  (λ n, nat.cases_on n (by simp [coeff_C])
    (λ m, have degree p < m.succ.succ, from lt_of_le_of_lt h dec_trivial,
      by simp [coeff_eq_zero_of_degree_lt this, coeff_C, nat.succ_ne_zero, coeff_X,
        nat.succ_inj', @eq_comm ℕ 0])))

lemma eq_X_add_C_of_degree_eq_one (h : degree p = 1) :
  p = C (p.leading_coeff) * X + C (p.coeff 0) :=
(eq_X_add_C_of_degree_le_one (show degree p ≤ 1, from h ▸ le_refl _)).trans
  (by simp [leading_coeff, nat_degree_eq_of_degree_eq_some h])

lemma eq_X_add_C_of_nat_degree_le_one (h : nat_degree p ≤ 1) :
  p = C (p.coeff 1) * X + C (p.coeff 0) :=
eq_X_add_C_of_degree_le_one $ degree_le_of_nat_degree_le h

lemma exists_eq_X_add_C_of_nat_degree_le_one (h : nat_degree p ≤ 1) :
  ∃ a b, p = C a * X + C b :=
⟨p.coeff 1, p.coeff 0, eq_X_add_C_of_nat_degree_le_one h⟩

theorem degree_X_pow_le (n : ℕ) : degree (X^n : polynomial R) ≤ n :=
by simpa only [C_1, one_mul] using degree_C_mul_X_pow_le n (1:R)

theorem degree_X_le : degree (X : polynomial R) ≤ 1 :=
degree_monomial_le _ _

lemma nat_degree_X_le : (X : polynomial R).nat_degree ≤ 1 :=
nat_degree_le_of_degree_le degree_X_le

lemma support_C_mul_X_pow (c : R) (n : ℕ) : (C c * X ^ n).support ⊆ singleton n :=
begin
  rw [C_mul_X_pow_eq_monomial],
  exact support_single_subset
end

lemma mem_support_C_mul_X_pow {n a : ℕ} {c : R} (h : a ∈ (C c * X ^ n).support) : a = n :=
mem_singleton.1 $ support_C_mul_X_pow _ _ h

lemma card_support_C_mul_X_pow_le_one {c : R} {n : ℕ} : (C c * X ^ n).support.card ≤ 1 :=
begin
  rw ← card_singleton n,
  apply card_le_of_subset (support_C_mul_X_pow c n),
end

lemma card_supp_le_succ_nat_degree (p : polynomial R) : p.support.card ≤ p.nat_degree + 1 :=
begin
  rw ← finset.card_range (p.nat_degree + 1),
  exact finset.card_le_of_subset supp_subset_range_nat_degree_succ,
end

lemma le_degree_of_mem_supp (a : ℕ) :
  a ∈ p.support → ↑a ≤ degree p :=
le_degree_of_ne_zero ∘ mem_support_iff.mp

lemma nonempty_support_iff : p.support.nonempty ↔ p ≠ 0 :=
by rw [ne.def, nonempty_iff_ne_empty, ne.def, ← support_eq_empty]

lemma support_C_mul_X_pow_nonzero {c : R} {n : ℕ} (h : c ≠ 0) :
  (C c * X ^ n).support = singleton n :=
begin
  rw [C_mul_X_pow_eq_monomial],
  exact support_single_ne_zero h
end

end semiring

section nonzero_semiring
variables [semiring R] [nontrivial R] {p q : polynomial R}

@[simp] lemma degree_one : degree (1 : polynomial R) = (0 : with_bot ℕ) :=
degree_C (show (1 : R) ≠ 0, from zero_ne_one.symm)

@[simp] lemma degree_X : degree (X : polynomial R) = 1 :=
degree_monomial _ one_ne_zero

@[simp] lemma nat_degree_X : (X : polynomial R).nat_degree = 1 :=
nat_degree_eq_of_degree_eq_some degree_X

end nonzero_semiring

section ring
variables [ring R]

lemma coeff_mul_X_sub_C {p : polynomial R} {r : R} {a : ℕ} :
  coeff (p * (X - C r)) (a + 1) = coeff p a - coeff p (a + 1) * r :=
by simp [mul_sub]

lemma C_eq_int_cast (n : ℤ) : C (n : R) = n :=
(C : R →+* _).map_int_cast n

@[simp] lemma degree_neg (p : polynomial R) : degree (-p) = degree p :=
by unfold degree; rw support_neg

@[simp] lemma nat_degree_neg (p : polynomial R) : nat_degree (-p) = nat_degree p :=
by simp [nat_degree]

@[simp] lemma nat_degree_int_cast (n : ℤ) : nat_degree (n : polynomial R) = 0 :=
by simp only [←C_eq_int_cast, nat_degree_C]

end ring

section semiring
variables [semiring R]

/-- The second-highest coefficient, or 0 for constants -/
def next_coeff (p : polynomial R) : R :=
if p.nat_degree = 0 then 0 else p.coeff (p.nat_degree - 1)

@[simp]
lemma next_coeff_C_eq_zero (c : R) :
  next_coeff (C c) = 0 := by { rw next_coeff, simp }

lemma next_coeff_of_pos_nat_degree (p : polynomial R) (hp : 0 < p.nat_degree) :
  next_coeff p = p.coeff (p.nat_degree - 1) :=
by { rw [next_coeff, if_neg], contrapose! hp, simpa }

end semiring

section semiring
variables [semiring R] {p q : polynomial R} {ι : Type*}

lemma coeff_nat_degree_eq_zero_of_degree_lt (h : degree p < degree q) :
  coeff p (nat_degree q) = 0 :=
coeff_eq_zero_of_degree_lt (lt_of_lt_of_le h degree_le_nat_degree)

lemma ne_zero_of_degree_gt {n : with_bot ℕ} (h : n < degree p) : p ≠ 0 :=
mt degree_eq_bot.2 (ne.symm (ne_of_lt (lt_of_le_of_lt bot_le h)))

lemma ne_zero_of_degree_ge_degree (hpq : p.degree ≤ q.degree) (hp : p ≠ 0) : q ≠ 0 :=
polynomial.ne_zero_of_degree_gt (lt_of_lt_of_le (bot_lt_iff_ne_bot.mpr
  (by rwa [ne.def, polynomial.degree_eq_bot])) hpq : q.degree > ⊥)

lemma ne_zero_of_nat_degree_gt {n : ℕ} (h : n < nat_degree p) : p ≠ 0 :=
λ H, by simpa [H, nat.not_lt_zero] using h

lemma degree_lt_degree (h : nat_degree p < nat_degree q) : degree p < degree q :=
begin
  by_cases hp : p = 0,
  { simp [hp],
    rw bot_lt_iff_ne_bot,
    intro hq,
    simpa [hp, degree_eq_bot.mp hq, lt_irrefl] using h },
  { rw [degree_eq_nat_degree hp, degree_eq_nat_degree $ ne_zero_of_nat_degree_gt h],
    exact_mod_cast h }
end

lemma nat_degree_lt_nat_degree_iff (hp : p ≠ 0) :
  nat_degree p < nat_degree q ↔ degree p < degree q :=
⟨degree_lt_degree, begin
  intro h,
  have hq : q ≠ 0 := ne_zero_of_degree_gt h,
  rw [degree_eq_nat_degree hp, degree_eq_nat_degree hq] at h,
  exact_mod_cast h
end⟩

lemma eq_C_of_degree_le_zero (h : degree p ≤ 0) : p = C (coeff p 0) :=
begin
  ext (_|n), { simp },
  rw [coeff_C, if_neg (nat.succ_ne_zero _), coeff_eq_zero_of_degree_lt],
  exact h.trans_lt (with_bot.some_lt_some.2 n.succ_pos),
end

lemma eq_C_of_degree_eq_zero (h : degree p = 0) : p = C (coeff p 0) :=
eq_C_of_degree_le_zero (h ▸ le_refl _)

lemma degree_le_zero_iff : degree p ≤ 0 ↔ p = C (coeff p 0) :=
⟨eq_C_of_degree_le_zero, λ h, h.symm ▸ degree_C_le⟩

lemma degree_add_le (p q : polynomial R) : degree (p + q) ≤ max (degree p) (degree q) :=
calc degree (p + q) = ((p + q).support).sup some : rfl
  ... ≤ (p.support ∪ q.support).sup some : by convert sup_mono support_add
  ... = p.support.sup some ⊔ q.support.sup some : by convert sup_union
  ... = _ : with_bot.sup_eq_max _ _

@[simp] lemma leading_coeff_zero : leading_coeff (0 : polynomial R) = 0 := rfl

@[simp] lemma leading_coeff_eq_zero : leading_coeff p = 0 ↔ p = 0 :=
⟨λ h, by_contradiction $ λ hp, mt mem_support_iff.1
  (not_not.2 h) (mem_of_max (degree_eq_nat_degree hp)),
λ h, h.symm ▸ leading_coeff_zero⟩

lemma leading_coeff_ne_zero : leading_coeff p ≠ 0 ↔ p ≠ 0 :=
by rw [ne.def, leading_coeff_eq_zero]

lemma leading_coeff_eq_zero_iff_deg_eq_bot : leading_coeff p = 0 ↔ degree p = ⊥ :=
by rw [leading_coeff_eq_zero, degree_eq_bot]

lemma nat_degree_mem_support_of_nonzero (H : p ≠ 0) : p.nat_degree ∈ p.support :=
(p.mem_support_to_fun p.nat_degree).mpr ((not_congr leading_coeff_eq_zero).mpr H)

lemma nat_degree_eq_support_max' (h : p ≠ 0) :
  p.nat_degree = p.support.max' (nonempty_support_iff.mpr h) :=
(le_max' _ _ $ nat_degree_mem_support_of_nonzero h).antisymm $
  max'_le _ _ _ le_nat_degree_of_mem_supp

lemma nat_degree_C_mul_X_pow_le (a : R) (n : ℕ) : nat_degree (C a * X ^ n) ≤ n :=
nat_degree_le_iff_degree_le.2 $ degree_C_mul_X_pow_le _ _

lemma degree_add_eq_left_of_degree_lt (h : degree q < degree p) : degree (p + q) = degree p :=
le_antisymm (max_eq_left_of_lt h ▸ degree_add_le _ _) $ degree_le_degree $
  begin
    rw [coeff_add, coeff_nat_degree_eq_zero_of_degree_lt h, add_zero],
    exact mt leading_coeff_eq_zero.1 (ne_zero_of_degree_gt h)
  end

lemma degree_add_eq_right_of_degree_lt (h : degree p < degree q) : degree (p + q) = degree q :=
by rw [add_comm, degree_add_eq_left_of_degree_lt h]

lemma degree_add_C (hp : 0 < degree p) : degree (p + C a) = degree p :=
add_comm (C a) p ▸ degree_add_eq_right_of_degree_lt $ lt_of_le_of_lt degree_C_le hp

lemma degree_add_eq_of_leading_coeff_add_ne_zero (h : leading_coeff p + leading_coeff q ≠ 0) :
  degree (p + q) = max p.degree q.degree :=
le_antisymm (degree_add_le _ _) $
  match lt_trichotomy (degree p) (degree q) with
  | or.inl hlt :=
    by rw [degree_add_eq_right_of_degree_lt hlt, max_eq_right_of_lt hlt]; exact le_refl _
  | or.inr (or.inl heq) :=
    le_of_not_gt $
      assume hlt : max (degree p) (degree q) > degree (p + q),
      h $ show leading_coeff p + leading_coeff q = 0,
      begin
        rw [heq, max_self] at hlt,
        rw [leading_coeff, leading_coeff, nat_degree_eq_of_degree_eq heq, ← coeff_add],
        exact coeff_nat_degree_eq_zero_of_degree_lt hlt
      end
  | or.inr (or.inr hlt) :=
    by rw [degree_add_eq_left_of_degree_lt hlt, max_eq_left_of_lt hlt]; exact le_refl _
  end

lemma degree_erase_le (p : polynomial R) (n : ℕ) : degree (p.erase n) ≤ degree p :=
by convert sup_mono (erase_subset _ _)

lemma degree_erase_lt (hp : p ≠ 0) : degree (p.erase (nat_degree p)) < degree p :=
lt_of_le_of_ne (degree_erase_le _ _) $
  (degree_eq_nat_degree hp).symm ▸ (by convert λ h, not_mem_erase _ _ (mem_of_max h))

lemma degree_sum_le (s : finset ι) (f : ι → polynomial R) :
  degree (∑ i in s, f i) ≤ s.sup (λ b, degree (f b)) :=
finset.induction_on s (by simp only [sum_empty, sup_empty, degree_zero, le_refl]) $
  assume a s has ih,
  calc degree (∑ i in insert a s, f i) ≤ max (degree (f a)) (degree (∑ i in s, f i)) :
    by rw sum_insert has; exact degree_add_le _ _
  ... ≤ _ : by rw [sup_insert, with_bot.sup_eq_max]; exact max_le_max (le_refl _) ih

lemma degree_mul_le (p q : polynomial R) : degree (p * q) ≤ degree p + degree q :=
calc degree (p * q) ≤ (p.support).sup (λi, degree (sum q (λj a, C (coeff p i * a) * X ^ (i + j)))) :
    by simp only [single_eq_C_mul_X.symm]; exact degree_sum_le _ _
  ... ≤ p.support.sup (λi, q.support.sup (λj, degree (C (coeff p i * coeff q j) * X ^ (i + j)))) :
    finset.sup_mono_fun (assume i hi,  degree_sum_le _ _)
  ... ≤ degree p + degree q :
    begin
      refine finset.sup_le (λ a ha, finset.sup_le (λ b hb, le_trans (degree_C_mul_X_pow_le _ _) _)),
      rw [with_bot.coe_add],
      rw mem_support_iff at ha hb,
      exact add_le_add (le_degree_of_ne_zero ha) (le_degree_of_ne_zero hb)
    end

lemma degree_pow_le (p : polynomial R) : ∀ (n : ℕ), degree (p ^ n) ≤ n • (degree p)
| 0     := by rw [pow_zero, zero_nsmul]; exact degree_one_le
| (n+1) := calc degree (p ^ (n + 1)) ≤ degree p + degree (p ^ n) :
    by rw pow_succ; exact degree_mul_le _ _
  ... ≤ _ : by rw succ_nsmul; exact add_le_add (le_refl _) (degree_pow_le _)

@[simp] lemma leading_coeff_monomial (a : R) (n : ℕ) : leading_coeff (monomial n a) = a :=
begin
  by_cases ha : a = 0,
  { simp only [ha, (monomial n).map_zero, leading_coeff_zero] },
  { rw [leading_coeff, nat_degree_monomial _ _ ha],
    exact @finsupp.single_eq_same _ _ _ n a }
end

lemma leading_coeff_C_mul_X_pow (a : R) (n : ℕ) : leading_coeff (C a * X ^ n) = a :=
by rw [C_mul_X_pow_eq_monomial, leading_coeff_monomial]

@[simp]

@[simp] lemma leading_coeff_X_pow (n : ℕ) : leading_coeff ((X : polynomial R) ^ n) = 1 :=
by simpa only [C_1, one_mul] using leading_coeff_C_mul_X_pow (1 : R) n

@[simp] lemma leading_coeff_X : leading_coeff (X : polynomial R) = 1 :=
by simpa only [pow_one] using @leading_coeff_X_pow R _ 1

@[simp] lemma monic_X_pow (n : ℕ) : monic (X ^ n : polynomial R) := leading_coeff_X_pow n

@[simp] lemma monic_X : monic (X : polynomial R) := leading_coeff_X

@[simp] lemma leading_coeff_one : leading_coeff (1 : polynomial R) = 1 :=
leading_coeff_C 1

@[simp] lemma monic_one : monic (1 : polynomial R) := leading_coeff_C _

lemma monic.ne_zero {R : Type*} [semiring R] [nontrivial R] {p : polynomial R} (hp : p.monic) :
  p ≠ 0 :=
by { rintro rfl, simpa [monic] using hp }

lemma monic.ne_zero_of_ne (h : (0:R) ≠ 1) {p : polynomial R} (hp : p.monic) :
  p ≠ 0 :=
by { nontriviality R, exact hp.ne_zero }

lemma monic.ne_zero_of_polynomial_ne {r} (hp : monic p) (hne : q ≠ r) : p ≠ 0 :=
by { haveI := nontrivial.of_polynomial_ne hne, exact hp.ne_zero }

lemma leading_coeff_add_of_degree_lt (h : degree p < degree q) :
  leading_coeff (p + q) = leading_coeff q :=
have coeff p (nat_degree q) = 0, from coeff_nat_degree_eq_zero_of_degree_lt h,
by simp only [leading_coeff, nat_degree_eq_of_degree_eq (degree_add_eq_right_of_degree_lt h),
  this, coeff_add, zero_add]

lemma leading_coeff_add_of_degree_eq (h : degree p = degree q)
  (hlc : leading_coeff p + leading_coeff q ≠ 0) :
  leading_coeff (p + q) = leading_coeff p + leading_coeff q :=
have nat_degree (p + q) = nat_degree p,
  by apply nat_degree_eq_of_degree_eq;
    rw [degree_add_eq_of_leading_coeff_add_ne_zero hlc, h, max_self],
by simp only [leading_coeff, this, nat_degree_eq_of_degree_eq h, coeff_add]

@[simp] lemma coeff_mul_degree_add_degree (p q : polynomial R) :
  coeff (p * q) (nat_degree p + nat_degree q) = leading_coeff p * leading_coeff q :=
calc coeff (p * q) (nat_degree p + nat_degree q) =
    ∑ x in nat.antidiagonal (nat_degree p + nat_degree q),
    coeff p x.1 * coeff q x.2 : coeff_mul _ _ _
... = coeff p (nat_degree p) * coeff q (nat_degree q) :
  begin
    refine finset.sum_eq_single (nat_degree p, nat_degree q) _ _,
    { rintro ⟨i,j⟩ h₁ h₂, rw nat.mem_antidiagonal at h₁,
      by_cases H : nat_degree p < i,
      { rw [coeff_eq_zero_of_degree_lt
          (lt_of_le_of_lt degree_le_nat_degree (with_bot.coe_lt_coe.2 H)), zero_mul] },
      { rw not_lt_iff_eq_or_lt at H, cases H,
        { subst H, rw add_left_cancel_iff at h₁, dsimp at h₁, subst h₁, exfalso, exact h₂ rfl },
        { suffices : nat_degree q < j,
          { rw [coeff_eq_zero_of_degree_lt
              (lt_of_le_of_lt degree_le_nat_degree (with_bot.coe_lt_coe.2 this)), mul_zero] },
          { by_contra H', rw not_lt at H',
            exact ne_of_lt (nat.lt_of_lt_of_le
              (nat.add_lt_add_right H j) (nat.add_le_add_left H' _)) h₁ } } } },
    { intro H, exfalso, apply H, rw nat.mem_antidiagonal }
  end

lemma degree_mul' (h : leading_coeff p * leading_coeff q ≠ 0) :
  degree (p * q) = degree p + degree q :=
have hp : p ≠ 0 := by refine mt _ h; exact λ hp, by rw [hp, leading_coeff_zero, zero_mul],
have hq : q ≠ 0 := by refine mt _ h; exact λ hq, by rw [hq, leading_coeff_zero, mul_zero],
le_antisymm (degree_mul_le _ _)
begin
  rw [degree_eq_nat_degree hp, degree_eq_nat_degree hq],
  refine le_degree_of_ne_zero _,
  rwa coeff_mul_degree_add_degree
end

lemma degree_mul_monic (hq : monic q) : degree (p * q) = degree p + degree q :=
if hp : p = 0 then by simp [hp]
else degree_mul' $ by rwa [hq.leading_coeff, mul_one, ne.def, leading_coeff_eq_zero]

lemma nat_degree_mul' (h : leading_coeff p * leading_coeff q ≠ 0) :
  nat_degree (p * q) = nat_degree p + nat_degree q :=
have hp : p ≠ 0 := mt leading_coeff_eq_zero.2 (λ h₁, h $ by rw [h₁, zero_mul]),
have hq : q ≠ 0 := mt leading_coeff_eq_zero.2 (λ h₁, h $ by rw [h₁, mul_zero]),
nat_degree_eq_of_degree_eq_some $
  by rw [degree_mul' h, with_bot.coe_add, degree_eq_nat_degree hp, degree_eq_nat_degree hq]

lemma leading_coeff_mul' (h : leading_coeff p * leading_coeff q ≠ 0) :
  leading_coeff (p * q) = leading_coeff p * leading_coeff q :=
begin
  unfold leading_coeff,
  rw [nat_degree_mul' h, coeff_mul_degree_add_degree],
  refl
end

lemma leading_coeff_pow' : leading_coeff p ^ n ≠ 0 →
  leading_coeff (p ^ n) = leading_coeff p ^ n :=
nat.rec_on n (by simp) $
λ n ih h,
have h₁ : leading_coeff p ^ n ≠ 0 :=
  λ h₁, h $ by rw [pow_succ, h₁, mul_zero],
have h₂ : leading_coeff p * leading_coeff (p ^ n) ≠ 0 :=
  by rwa [pow_succ, ← ih h₁] at h,
by rw [pow_succ, pow_succ, leading_coeff_mul' h₂, ih h₁]

lemma degree_pow' : ∀ {n : ℕ}, leading_coeff p ^ n ≠ 0 →
  degree (p ^ n) = n • (degree p)
| 0     := λ h, by rw [pow_zero, ← C_1] at *;
  rw [degree_C h, zero_nsmul]
| (n+1) := λ h,
have h₁ : leading_coeff p ^ n ≠ 0 := λ h₁, h $
  by rw [pow_succ, h₁, mul_zero],
have h₂ : leading_coeff p * leading_coeff (p ^ n) ≠ 0 :=
  by rwa [pow_succ, ← leading_coeff_pow' h₁] at h,
by rw [pow_succ, degree_mul' h₂, succ_nsmul, degree_pow' h₁]

lemma nat_degree_pow' {n : ℕ} (h : leading_coeff p ^ n ≠ 0) :
  nat_degree (p ^ n) = n * nat_degree p :=
if hp0 : p = 0 then
  if hn0 : n = 0 then by simp *
  else by rw [hp0, zero_pow (nat.pos_of_ne_zero hn0)]; simp
else
have hpn : p ^ n ≠ 0, from λ hpn0,  have h1 : _ := h,
  by rw [← leading_coeff_pow' h1, hpn0, leading_coeff_zero] at h;
  exact h rfl,
option.some_inj.1 $ show (nat_degree (p ^ n) : with_bot ℕ) = (n * nat_degree p : ℕ),
  by rw [← degree_eq_nat_degree hpn, degree_pow' h, degree_eq_nat_degree hp0,
    ← with_bot.coe_nsmul]; simp

theorem leading_coeff_mul_monic {p q : polynomial R} (hq : monic q) :
  leading_coeff (p * q) = leading_coeff p :=
decidable.by_cases
  (λ H : leading_coeff p = 0, by rw [H, leading_coeff_eq_zero.1 H, zero_mul, leading_coeff_zero])
  (λ H : leading_coeff p ≠ 0,
    by rw [leading_coeff_mul', hq.leading_coeff, mul_one];
      rwa [hq.leading_coeff, mul_one])

@[simp] theorem leading_coeff_mul_X_pow {p : polynomial R} {n : ℕ} :
  leading_coeff (p * X ^ n) = leading_coeff p :=
leading_coeff_mul_monic (monic_X_pow n)

@[simp] theorem leading_coeff_mul_X {p : polynomial R} :
  leading_coeff (p * X) = leading_coeff p :=
leading_coeff_mul_monic monic_X

lemma nat_degree_mul_le {p q : polynomial R} : nat_degree (p * q) ≤ nat_degree p + nat_degree q :=
begin
  apply nat_degree_le_of_degree_le,
  apply le_trans (degree_mul_le p q),
  rw with_bot.coe_add,
  refine add_le_add _ _; apply degree_le_nat_degree,
end

lemma subsingleton_of_monic_zero (h : monic (0 : polynomial R)) :
  (∀ p q : polynomial R, p = q) ∧ (∀ a b : R, a = b) :=
by rw [monic.def, leading_coeff_zero] at h;
  exact ⟨λ p q, by rw [← mul_one p, ← mul_one q, ← C_1, ← h, C_0, mul_zero, mul_zero],
    λ a b, by rw [← mul_one a, ← mul_one b, ← h, mul_zero, mul_zero]⟩

lemma zero_le_degree_iff {p : polynomial R} : 0 ≤ degree p ↔ p ≠ 0 :=
by rw [ne.def, ← degree_eq_bot];
  cases degree p; exact dec_trivial

lemma degree_nonneg_iff_ne_zero : 0 ≤ degree p ↔ p ≠ 0 :=
⟨λ h0p hp0, absurd h0p (by rw [hp0, degree_zero]; exact dec_trivial),
  λ hp0, le_of_not_gt (λ h, by simp [gt, degree_eq_bot, *] at *)⟩

lemma nat_degree_eq_zero_iff_degree_le_zero : p.nat_degree = 0 ↔ p.degree ≤ 0 :=
by rw [← nonpos_iff_eq_zero, nat_degree_le_iff_degree_le, with_bot.coe_zero]

theorem degree_le_iff_coeff_zero (f : polynomial R) (n : with_bot ℕ) :
  degree f ≤ n ↔ ∀ m : ℕ, n < m → coeff f m = 0 :=
⟨λ (H : finset.sup (f.support) some ≤ n) m (Hm : n < (m : with_bot ℕ)), decidable.of_not_not $ λ H4,
  have H1 : m ∉ f.support,
    from λ H2, not_lt_of_ge ((finset.sup_le_iff.1 H) m H2 : ((m : with_bot ℕ) ≤ n)) Hm,
  H1 $ (finsupp.mem_support_to_fun f m).2 H4,
λ H, finset.sup_le $ λ b Hb, decidable.of_not_not $ λ Hn,
  (finsupp.mem_support_to_fun f b).1 Hb $ H b $ lt_of_not_ge Hn⟩

theorem degree_lt_iff_coeff_zero (f : polynomial R) (n : ℕ) :
  degree f < n ↔ ∀ m : ℕ, n ≤ m → coeff f m = 0 :=
begin
  refine ⟨λ hf m hm, coeff_eq_zero_of_degree_lt (lt_of_lt_of_le hf (with_bot.coe_le_coe.2 hm)), _⟩,
  simp only [degree, finset.sup_lt_iff (with_bot.bot_lt_coe n), mem_support_iff,
    with_bot.some_eq_coe, with_bot.coe_lt_coe, ← @not_le ℕ],
  exact λ h m, mt (h m),
end

lemma degree_lt_degree_mul_X (hp : p ≠ 0) : p.degree < (p * X).degree :=
by haveI := nontrivial.of_polynomial_ne hp; exact
have leading_coeff p * leading_coeff X ≠ 0, by simpa,
by erw [degree_mul' this, degree_eq_nat_degree hp,
    degree_X, ← with_bot.coe_one, ← with_bot.coe_add, with_bot.coe_lt_coe];
  exact nat.lt_succ_self _

lemma nat_degree_pos_iff_degree_pos :
  0 < nat_degree p ↔ 0 < degree p :=
lt_iff_lt_of_le_iff_le nat_degree_le_iff_degree_le

lemma eq_C_of_nat_degree_le_zero (h : nat_degree p ≤ 0) : p = C (coeff p 0) :=
eq_C_of_degree_le_zero $ degree_le_of_nat_degree_le h

lemma eq_C_of_nat_degree_eq_zero (h : nat_degree p = 0) : p = C (coeff p 0) :=
eq_C_of_nat_degree_le_zero h.le

lemma ne_zero_of_coe_le_degree (hdeg : ↑n ≤ p.degree) : p ≠ 0 :=
by rw ← degree_nonneg_iff_ne_zero; exact trans (by exact_mod_cast n.zero_le) hdeg

lemma le_nat_degree_of_coe_le_degree (hdeg : ↑n ≤ p.degree) :
  n ≤ p.nat_degree :=
with_bot.coe_le_coe.mp ((degree_eq_nat_degree $ ne_zero_of_coe_le_degree hdeg) ▸ hdeg)

end semiring

section nonzero_semiring
variables [semiring R] [nontrivial R] {p q : polynomial R}

@[simp] lemma degree_X_pow (n : ℕ) : degree ((X : polynomial R) ^ n) = n :=
by rw [X_pow_eq_monomial, degree_monomial _ (@one_ne_zero R _ _)]

@[simp] lemma nat_degree_X_pow (n : ℕ) : nat_degree ((X : polynomial R) ^ n) = n :=
nat_degree_eq_of_degree_eq_some (degree_X_pow n)

theorem not_is_unit_X : ¬ is_unit (X : polynomial R) :=
λ ⟨⟨_, g, hfg, hgf⟩, rfl⟩, @zero_ne_one R _ _ $ by { rw [← coeff_one_zero, ← hgf], simp }

@[simp] lemma degree_mul_X : degree (p * X) = degree p + 1 := by simp [degree_mul_monic monic_X]

@[simp] lemma degree_mul_X_pow : degree (p * X ^ n) = degree p + n :=
by simp [degree_mul_monic (monic_X_pow n)]

end nonzero_semiring

section ring
variables [ring R] {p q : polynomial R}

lemma degree_sub_le (p q : polynomial R) : degree (p - q) ≤ max (degree p) (degree q) :=
by simpa only [sub_eq_add_neg, degree_neg q] using degree_add_le p (-q)

lemma degree_sub_lt (hd : degree p = degree q)
  (hp0 : p ≠ 0) (hlc : leading_coeff p = leading_coeff q) :
  degree (p - q) < degree p :=
have hp : single (nat_degree p) (leading_coeff p) + p.erase (nat_degree p) = p :=
  finsupp.single_add_erase _ _,
have hq : single (nat_degree q) (leading_coeff q) + q.erase (nat_degree q) = q :=
  finsupp.single_add_erase _ _,
have hd' : nat_degree p = nat_degree q := by unfold nat_degree; rw hd,
have hq0 : q ≠ 0 := mt degree_eq_bot.2 (hd ▸ mt degree_eq_bot.1 hp0),
calc degree (p - q) = degree (erase (nat_degree q) p + -erase (nat_degree q) q) :
  by conv {to_lhs, rw [← hp, ← hq, hlc, hd', add_sub_add_left_eq_sub, sub_eq_add_neg]}
... ≤ max (degree (erase (nat_degree q) p)) (degree (erase (nat_degree q) q))
  : degree_neg (erase (nat_degree q) q) ▸ degree_add_le _ _
... < degree p : max_lt_iff.2 ⟨hd' ▸ degree_erase_lt hp0, hd.symm ▸ degree_erase_lt hq0⟩

lemma nat_degree_X_sub_C_le {r : R} : (X - C r).nat_degree ≤ 1 :=
nat_degree_le_iff_degree_le.2 $ le_trans (degree_sub_le _ _) $ max_le degree_X_le $
le_trans degree_C_le $ with_bot.coe_le_coe.2 zero_le_one

lemma degree_sum_fin_lt {n : ℕ} (f : fin n → R) :
  degree (∑ i : fin n, C (f i) * X ^ (i : ℕ)) < n :=
begin
  haveI : is_commutative (with_bot ℕ) max := ⟨max_comm⟩,
  haveI : is_associative (with_bot ℕ) max := ⟨max_assoc⟩,
  calc  (∑ i, C (f i) * X ^ (i : ℕ)).degree
      ≤ finset.univ.fold (⊔) ⊥ (λ i, (C (f i) * X ^ (i : ℕ)).degree) : degree_sum_le _ _
  ... = finset.univ.fold max ⊥ (λ i, (C (f i) * X ^ (i : ℕ)).degree) :
    (@finset.fold_hom _ _ _ (⊔) _ _ _ ⊥ finset.univ _ _ _ id (with_bot.sup_eq_max)).symm
  ... < n : (finset.fold_max_lt (n : with_bot ℕ)).mpr ⟨with_bot.bot_lt_some _, _⟩,

  rintros ⟨i, hi⟩ -,
  calc (C (f ⟨i, hi⟩) * X ^ i).degree
      ≤ (C _).degree + (X ^ i).degree : degree_mul_le _ _
  ... ≤ 0 + i : add_le_add degree_C_le (degree_X_pow_le i)
  ... = i : zero_add _
  ... < n : with_bot.some_lt_some.mpr hi,
end

lemma degree_sub_eq_left_of_degree_lt (h : degree q < degree p) : degree (p - q) = degree p :=
by { rw ← degree_neg q at h, rw [sub_eq_add_neg, degree_add_eq_left_of_degree_lt h] }

lemma degree_sub_eq_right_of_degree_lt (h : degree p < degree q) : degree (p - q) = degree q :=
by { rw ← degree_neg q at h, rw [sub_eq_add_neg, degree_add_eq_right_of_degree_lt h, degree_neg] }

end ring

section nonzero_ring
variables [nontrivial R] [ring R]

@[simp] lemma degree_X_sub_C (a : R) : degree (X - C a) = 1 :=
have degree (C a) < degree (X : polynomial R),
from calc degree (C a) ≤ 0 : degree_C_le
                   ... < 1 : with_bot.some_lt_some.mpr zero_lt_one
                   ... = degree X : degree_X.symm,
by rw [degree_sub_eq_left_of_degree_lt this, degree_X]

@[simp] lemma degree_X_add_C (a : R) : degree (X + C a) = 1 :=
have degree (C a) < degree (X : polynomial R),
from calc degree (C a) ≤ 0 : degree_C_le
                   ... < 1 : with_bot.some_lt_some.mpr zero_lt_one
                   ... = degree X : degree_X.symm,
by rw [degree_add_eq_left_of_degree_lt this, degree_X]

@[simp] lemma nat_degree_X_sub_C (x : R) : (X - C x).nat_degree = 1 :=
nat_degree_eq_of_degree_eq_some $ degree_X_sub_C x

@[simp]
lemma next_coeff_X_sub_C (c : R) : next_coeff (X - C c) = - c :=
by simp [next_coeff_of_pos_nat_degree]

lemma degree_X_pow_sub_C {n : ℕ} (hn : 0 < n) (a : R) :
  degree ((X : polynomial R) ^ n - C a) = n :=
have degree (C a) < degree ((X : polynomial R) ^ n),
  from calc degree (C a) ≤ 0 : degree_C_le
  ... < degree ((X : polynomial R) ^ n) : by rwa [degree_X_pow];
    exact with_bot.coe_lt_coe.2 hn,
by rw [degree_sub_eq_left_of_degree_lt this, degree_X_pow]

lemma X_pow_sub_C_ne_zero {n : ℕ} (hn : 0 < n) (a : R) :
  (X : polynomial R) ^ n - C a ≠ 0 :=
mt degree_eq_bot.2 (show degree ((X : polynomial R) ^ n - C a) ≠ ⊥,
  by rw degree_X_pow_sub_C hn a; exact dec_trivial)

theorem X_sub_C_ne_zero (r : R) : X - C r ≠ 0 :=
pow_one (X : polynomial R) ▸ X_pow_sub_C_ne_zero zero_lt_one r

theorem zero_nmem_multiset_map_X_sub_C {α : Type*} (m : multiset α) (f : α → R) :
  (0 : polynomial R) ∉ m.map (λ a, X - C (f a)) :=
λ mem, let ⟨a, _, ha⟩ := multiset.mem_map.mp mem in X_sub_C_ne_zero _ ha

lemma nat_degree_X_pow_sub_C {n : ℕ} {r : R} :
  (X ^ n - C r).nat_degree = n :=
begin
  by_cases hn : n = 0,
  { rw [hn, pow_zero, ←C_1, ←ring_hom.map_sub, nat_degree_C] },
  { exact nat_degree_eq_of_degree_eq_some (degree_X_pow_sub_C (pos_iff_ne_zero.mpr hn) r) },
end

@[simp] lemma leading_coeff_X_pow_sub_C {n : ℕ} (hn : 0 < n) {r : R} :
  (X ^ n - C r).leading_coeff = 1 :=
by rw [leading_coeff, nat_degree_X_pow_sub_C, coeff_sub, coeff_X_pow_self,
  coeff_C, if_neg (pos_iff_ne_zero.mp hn), sub_zero]

@[simp] lemma leading_coeff_X_pow_sub_one {n : ℕ} (hn : 0 < n) :
  (X ^ n - 1 : polynomial R).leading_coeff = 1 :=
leading_coeff_X_pow_sub_C hn

end nonzero_ring

section no_zero_divisors
variables [semiring R] [no_zero_divisors R] {p q : polynomial R}

@[simp] lemma degree_mul : degree (p * q) = degree p + degree q :=
if hp0 : p = 0 then by simp only [hp0, degree_zero, zero_mul, with_bot.bot_add]
else if hq0 : q = 0 then  by simp only [hq0, degree_zero, mul_zero, with_bot.add_bot]
else degree_mul' $ mul_ne_zero (mt leading_coeff_eq_zero.1 hp0)
    (mt leading_coeff_eq_zero.1 hq0)

@[simp] lemma degree_pow [nontrivial R] (p : polynomial R) (n : ℕ) :
  degree (p ^ n) = n • (degree p) :=
by induction n; [simp only [pow_zero, degree_one, zero_nsmul],
simp only [*, pow_succ, succ_nsmul, degree_mul]]

@[simp] lemma leading_coeff_mul (p q : polynomial R) : leading_coeff (p * q) =
  leading_coeff p * leading_coeff q :=
begin
  by_cases hp : p = 0,
  { simp only [hp, zero_mul, leading_coeff_zero] },
  { by_cases hq : q = 0,
    { simp only [hq, mul_zero, leading_coeff_zero] },
    { rw [leading_coeff_mul'],
      exact mul_ne_zero (mt leading_coeff_eq_zero.1 hp) (mt leading_coeff_eq_zero.1 hq) } }
end

@[simp] lemma leading_coeff_X_add_C [nontrivial R] (a b : R) (ha : a ≠ 0):
  leading_coeff (C a * X + C b) = a :=
begin
  rw [add_comm, leading_coeff_add_of_degree_lt],
  { simp },
  { simpa [degree_C ha] using lt_of_le_of_lt degree_C_le (with_bot.coe_lt_coe.2 zero_lt_one)}
end

/-- `polynomial.leading_coeff` bundled as a `monoid_hom` when `R` has `no_zero_divisors`, and thus
  `leading_coeff` is multiplicative -/
def leading_coeff_hom : polynomial R →* R :=
{ to_fun := leading_coeff,
  map_one' := by simp,
  map_mul' := leading_coeff_mul }

@[simp] lemma leading_coeff_hom_apply (p : polynomial R) :
  leading_coeff_hom p = leading_coeff p := rfl

@[simp] lemma leading_coeff_pow (p : polynomial R) (n : ℕ) :
  leading_coeff (p ^ n) = leading_coeff p ^ n :=
(leading_coeff_hom : polynomial R →* R).map_pow p n

end no_zero_divisors

end polynomial


import algebra.big_operators
import data.real.basic

open finset
open_locale big_operators

def Sum (f : ℕ → ℝ) (s : finset ℕ) :=
∑ k in s, f k

lemma SumDistr (f : ℕ → ℝ) (s : finset ℕ) (c : ℝ) : Sum (λ k, c * (f k)) s  = c * Sum f s :=
begin
  unfold Sum,
  rw mul_sum,
end

lemma SumAssoc (a : ℕ → ℝ) (b : ℕ → ℝ) (s : finset ℕ) : Sum (λ k, a k + b k) s = Sum a s + Sum b s :=
begin
  exact sum_add_distrib,
end

lemma SumComm (f : ℕ → ℝ) (l1 : list ℕ) (p : ℕ → ℕ) (h : l1 ~ (l1.map p) ) :
Sum f l1.to_finset = Sum f (l1.map p).to_finset :=
begin
  have h1 : l1.to_finset = (l1.map p).to_finset,
  { exact list.to_finset_eq_of_perm l1 (l1.map p) h,  },
  rw h1,
end

lemma GaussSum (n : ℕ) : 2 * Sum (λ k, k) (range (n+1)) = n * (n + 1) :=
begin
unfold Sum,
induction n with n IH,
{  simp, },
rw sum_range_succ,
rw mul_add,
rw IH,
norm_num,
ring,
end

lemma AuxRev (a : ℝ) (b : ℝ) (n : ℕ) (s = range (n+1)) :
Sum (λ k, a + b*(n-k)) s = Sum (λ k, a + b*k) s :=
begin
  unfold Sum,
  apply eq_of_sub_eq_zero,
  rw ← sum_sub_distrib,
  simp,
  rw ← mul_sum,
  rw ← mul_sum,
  rw ← mul_sub,
  rw sum_sub_distrib,
  rw sub_sub,
  rw ← two_mul,
  rw mul_sum,
  rw ← sum_sub_distrib,
  simp,
  right,
  rw sub_eq_zero,
  rw H,
  rw card_range,
  rw ← mul_sum,
  rw eq_comm,
  rw mul_comm ↑(n + 1) ↑n,
  rw ← Sum,
  rw GaussSum n,
  refl,
end

lemma SumArithProg (a : ℝ) (b : ℝ) (n : ℕ) (s = range (n+1)) :
Sum (λ k, a + b*k) s = (a + (1/2)*b*n) * (n + 1) :=
begin
  have h1 : Sum (λ k, a + b*k) s = Sum (λ k, a + b*(n-k)) s,
  { rw (AuxRev a b n s H), },

  have h2 : Sum (λ k, a + b*(n-k)) s = Sum (λ k, a + b*n - b*k) s,
  { ring_nf, },

  have h3 : Sum (λ k, a + b*k) s + Sum (λ k, a + b*n - b*k) s = Sum (λ k, 2*a + b*n) s,
  { rw ← SumAssoc, simp, rw ← add_assoc, rw two_mul, },

  have h4 : Sum (λ k, 1) s = n + 1,
  { unfold Sum, rw H, rw sum_const, rw card_range, simp, },

  have h5 : Sum (λ k, 2*a + b*n) s = (2*a + b*n) * (n + 1),
  { rw ← mul_one (2*a + b*n), rw SumDistr, rw mul_one, rw h4, },

  rw ← h2 at h3,
  rw ← h1 at h3,
  rw ← two_mul at h3,
  rw h5 at h3,
  rw mul_comm at h3,

  have h6 : Sum (λ k, a + b*k) s = ((2*a + b*n) * (n + 1)) / 2,
  { apply eq_div_of_mul_eq, norm_num, exact h3,},

  rw h6,
  ring,
end

lemma id220 (f : ℕ → ℝ) (s1 : finset ℕ ) (s2 : finset ℕ ) :
Sum f s1 + Sum f s2 = Sum f (s1 ∩ s2) + Sum f (s1 ∪ s2) :=
begin
  rw add_comm (Sum f (s1 ∩ s2)),
  unfold Sum,
  rw sum_union_inter,
end

lemma id221 (f : ℕ → ℝ) (s : finset ℕ) (snat : finset ℕ) (s ⊆ snat) :
 Sum f s = Sum (λ k, f k * (ite (k ∈ s) 1 0)) snat :=
begin
  have h : Sum (λ k, ((ite (k ∈ s) (f k) 0))) snat = Sum (λ k, (f k * (ite (k ∈ s) 1 0))) snat,
  { apply congr, apply congr, refl, apply funext, intro x, exact (mul_boole (x ∈ s) (f x)).symm, refl, },
  rw ← h,
  unfold Sum,
  rw sum_ite,
  rw sum_const_zero,
  rw add_zero,
  have h1 : filter (λ (x : ℕ), x ∈ s) snat = s,
  { exact inf_eq_right.mpr H, },
  rw h1,
end

lemma id222 (s1 : finset ℕ) (s2 : finset ℕ) (k : ℕ) :
 (ite (k ∈ s1) 1 0) + (ite (k ∈ s2) 1 0) = (ite (k ∈ s1 ∩ s2) 1 0) + (ite (k ∈ s1 ∪ s2) 1 0) :=
begin
  simp,
  by_cases h1 : (k ∈ s1),
  { by_cases h2 : (k ∈ s2),
    { rw (if_pos h1), rw (if_pos h2), rw (if_pos (and.intro h1 h2)), rw (if_pos (or.inl h1)), },
    rw (if_pos h1), rw (if_neg h2), have hb : (k ∈ s1 ∧ k ∈ s2) = false,
   { apply and_eq_of_eq_false_right, simp, exact h2, },
    rw (if_neg (not_of_eq_false hb)), rw (if_pos (or.inl h1)), },
  by_cases h2 : (k ∈ s2),
    { rw (if_neg h1), rw (if_pos h2), have hb : (k ∈ s1 ∧ k ∈ s2) = false,
   { apply and_eq_of_eq_false_left, simp, exact h1, },
    rw (if_neg (not_of_eq_false hb)), rw (if_pos (or.inr h2)), },
  rw (if_neg h1), rw (if_neg h2),  have hb : (k ∈ s1 ∧ k ∈ s2) = false,
   { apply and_eq_of_eq_false_right, simp, exact h2, },
    rw (if_neg (not_of_eq_false hb)), have ho : (k ∈ s1 ∨ k ∈ s2) = false,
  { simp, intro notor, apply or.elim notor h1 h2, }, rw (if_neg (not_of_eq_false ho)),
end

lemma id223 (f : ℕ → ℝ) (n : ℕ) : Sum f (range (n+1)) = f 0 + Sum f ( (range (n+1)) \ (range 1)) :=
begin
  unfold Sum,
  rw add_comm (f 0),
  rw ← (sum_range_one f),
  rw sum_sdiff,
  norm_num,
end

lemma id224 (f : ℕ → ℝ) (n : ℕ) :
Sum f (range (n+1)) + f (n+1) = f 0 + Sum (λ k, f (k+1)) (range (n+1)) :=
begin
  unfold Sum,
  rw add_comm (f 0),
  rw ← sum_range_succ',
  rw ← sum_range_succ,
end

lemma id225 (a : ℕ) (x : ℝ) (n : ℕ) (s = range (n+1)) (h : x ≠ 1) :
 Sum (λ k, a * x^k) s = (a - a * x^(n+1)) / (1 - x) :=
begin
  have h1 : Sum (λ k, a * x^k) s + (a * x^(n+1)) =
  (a * x^0) + Sum (λ k, a * x^(k+1)) s,
  {rw H, rw id224, },

  have h2 :  Sum (λ k, a * x^(k+1)) s = x * Sum (λ k, a * x^k) s,
  { rw ← SumDistr, unfold Sum, apply congr, refl, apply funext, intro k, rw pow_add, ring, },

  rw h2 at h1,
  rw [pow_zero, mul_one, ← sub_eq_zero, add_comm, ← sub_sub] at h1,

  have h3 : Sum (λ (k : ℕ), ↑a * x ^ k) s - x * Sum (λ (k : ℕ), ↑a * x ^ k) s =
   0 - ↑a * x ^ (n + 1) + ↑a,
  { rw ← sub_eq_zero, rw zero_sub, rw ← h1, ring, },

  apply eq_div_of_mul_eq,
  { rw sub_ne_zero, rw ne_comm, exact h, },
  rw [mul_comm, sub_mul, one_mul],
  rw h3,
  ring,
end

lemma id226 (x : ℝ) (n : ℕ) (h : x ≠ 1) (s = range (n + 1)) (f : ℕ → ℝ) (H2 : f = (λ b, b * x^b)) :
Sum (λ k, k * x^k) s = (x - (n + 1) * x^(n+1) + n * x^(n+2)) / (1 - x)^2 :=
begin
  have h1 : Sum f (range (n + 1)) + f (n + 1) =
  f 0 + Sum (λ k, f (k+1)) (range (n + 1)),
  { rw id224, },

  have h2 : Sum (λ k, f (k+1)) s = Sum (λ k, k * x^(k+1)) s + Sum (λ k, ↑1 * x^(k+1)) s,
  { rw H2, rw ← SumAssoc, apply congr, apply congr, refl, apply funext, intro k, simp, ring, refl, },

  have h3 : Sum (λ k, k * x^(k+1)) s = x * Sum (λ k, k * x^k) s,
  { rw ← SumDistr, unfold Sum, apply congr, refl, apply funext, intro k, rw pow_add, ring, },

  have haux : Sum (λ k, ↑1 * x^(k+1)) s = x * Sum (λ k, ↑1 * x^k) s,
  { rw ← SumDistr, unfold Sum, apply congr, refl, apply funext, intro k, rw pow_add, ring, },
  have h4 : Sum (λ k, ↑1 * x^(k+1)) s = (x - 1 * x^(n+1+1)) / (1 - x),
  { rw haux, rw pow_add, rw pow_one, rw id225, rw ← mul_div_assoc, rw mul_sub, norm_num, rw mul_comm, exact H, exact h, },

  have h5 : Sum (λ k, k * x^k) s + f (n+1) =
  x * Sum (λ k, k * x^k) s + (x - 1 * x^(n+2)) / (1 - x),
  { rw H, rw ← H2, rw h1, norm_num, rw ← H, rw h2, rw h3, rw h4, rw H2, norm_num, },

  have h6 : Sum (λ k, k * x^k) s - x * Sum (λ k, k * x^k) s =
  (x - 1 * x^(n+2)) / (1 - x) - ((n + 1) * x^(n+1)),
  { apply eq_sub_of_add_eq, rw add_comm, rw add_sub, apply eq.symm,
  apply eq_sub_of_add_eq, rw add_comm, rw ← h5, rw add_comm, rw H2, simp, },

  have h7 : Sum f s - x * Sum f s = (1 - x) * Sum f s,
  { ring,},
  rw ← H2 at h6,
  rw h7 at h6,
  have h8 : (1 - x) ≠ 0, { rw sub_ne_zero, rw ne_comm, exact h, },
  rw mul_comm at h6,
  rw ← (div_eq_iff_mul_eq h8) at h6,
  rw ← H2,

  calc
  Sum f s =
  ((x - 1 * x ^ (n + 2)) / (1 - x) - (↑n + 1) * x ^ (n + 1)) / (1 - x) :
  by { rw h6, }
  ...                       = (x - x ^ (n + 2)) / (1 - x)^2 - (↑n + 1) * x ^ (n + 1) / (1 - x) :
  by { rw sub_div, rw pow_two, rw div_div_eq_div_mul, rw one_mul, }
  ...                       = (x - x ^ (n + 2)) / (1 - x)^2 - (((↑n + 1) * x ^ (n + 1)) * (1-x)) / ((1 - x) * (1 - x)) :
  by { simp, rw (mul_div_mul_right ((↑n + 1) * x ^ (n + 1))), exact h8, }
  ...                       = ((x - x ^ (n + 2)) -  ((↑n + 1) * x ^ (n + 1)) * (1-x)) / (1 - x)^2 :
  by { rw ← pow_two, rw div_sub_div_same, }
  ...                       = ((x - x ^ (n + 2)) - ((↑n + 1) * x ^ (n + 1)) + ((↑n + 1) * x ^ (n+1+1)) ) / (1 - x)^2 :
  by { rw mul_sub, rw mul_one, rw mul_assoc, rw ← sub_add, rw pow_add x (n+1), rw pow_one, }
  ...                       = (x - (↑n + 1) * x ^ (n + 1) + (↑n + 1) * x ^ (n+2) - x ^ (n + 2) ) / (1 - x)^2 :
  by ring
  ...                       = (x - (n + 1) * x^(n+1) + n * x^(n+2)) / (1 - x)^2 :
  by ring,
end


import algebra.big_operators
import analysis.special_functions.exp_log
import to_mathlib_maybe.log

import rnd_var

---- SHANNON ENTROPY

open finset rnd_var

open_locale big_operators  -- this enables the notation

universe x

variables
{ι : Type x} -- indexing type
[fintype ι] -- tell Lean that the set of all elements ι is finite.
[decidable_eq ι] -- and that its elements can be compared for equality

noncomputable theory

/--
Definition: Shannon entropy.
-/
def Shannon_entropy (X : ι → ℝ) [rnd_var X] : ℝ :=
- ∑ i, (X i) * real.log(X i)

-- notation `H(`X`)` := Shannon_entropy X

/--
Theorem (non-negativity): Shannon entropy is non-negative for
any discrete random variable.
-/
theorem Shannon_entropy_nonneg (X : ι → ℝ) [rnd_var X] :
Shannon_entropy X ≥ 0 :=
begin
  intros,
  rw Shannon_entropy,
  -- move the minus inside
  simp only [← mul_neg_eq_neg_mul_symm, ← sum_neg_distrib],
  -- each term in the sum is nonnegative
  have H2 : ∀ i, - (X i) * real.log(X i) ≥ 0, {
    intros,
    have h : - (X i) * real.log(X i) = (X i) * (- real.log(X i)), by linarith,
    rw h,
    apply mul_nonneg,
    {apply probs_nonneg},
    {
      rw neg_nonneg,
      apply real.log_nonpos,
      {apply probs_nonneg},
      {apply probs_le_one},
    },
  },
  -- so we have that the whole sum is nonneg
  apply sum_nonneg,
  simp only [neg_mul_eq_neg_mul_symm, ge_iff_le, mul_neg_eq_neg_mul_symm, neg_nonneg] at *,
  intros i hi,
  exact H2 i,
end

lemma sum_nonneg_zero {f : ι → ℝ} (hf1 : ∑ i, f i = 0) (hf2: ∀ i, 0 ≤ f i) :
∀ i, f i = 0 :=
begin
  intro i,
  have H : ∑ i, f i = 0 ↔ ∀ i, f i = 0, {
    rw sum_eq_zero_iff_of_nonneg,
    {
      finish,
    },
    {
      simp only [hf2],
      finish,
    },
  },
  have H2 : ∀ i, f i = 0, {
    exact H.1 hf1,
  },
  apply H2,
end

lemma helper4 (X : ι → ℝ) :
(∀ (i : ι), X i = 0 ∨ X i = 1) → (∀ (i : ι), X i = 0 ∨ real.log(X i) = 0) :=
begin
  intros hi i,
  have H : X i = 0 ∨ X i = 1, by exact hi i,
  cases H with x0 log0,
  left, exact x0,
  right, simp only [log0, real.log_one],
end

lemma helper5 {X : ι → ℝ} :
(∃ j, ∀ i, ite (i = j) (X i = 1) (X i = 0)) → (∀ i, X i = 0 ∨ X i = 1) :=
begin
  contrapose,
  intro h,
  push_neg,
  push_neg at h,
  cases h with i hi,
  cases hi,
  intro j,
  use i,
  split_ifs,
  exact hi_right,
  exact hi_left,
end

/--
Theorem (Minimum value): Shannon entropy vanishes if and only if
X is a deterministic variable.

This is property 10.1.4 here (https://arxiv.org/pdf/1106.1445.pdf)
-/
theorem Shannon_entropy_zero_iff_deterministic (X : ι → ℝ) [rnd_var X] :
Shannon_entropy X = 0 ↔ is_deterministic X :=
begin
  -- we begin by asking Lean to provide the meanings of the
  -- words we've taught it. We use the rewrite tactic for that.
  rw [is_deterministic, Shannon_entropy],
  -- We split the two directions of the iff.
  split,
  {
    -- we prove one direction
    intro H0,
    -- rewrite in a more convenient form
    simp only [← real.log_inv, ← mul_neg_eq_neg_mul_symm, ← sum_neg_distrib] at H0,
    -- show each term in the sum must be zero
    have H2 : ∀ (i : ι), (X i) * real.log((X i)⁻¹) = 0,
    {
      apply sum_nonneg_zero,
      exact H0,
      intro i,
      rw mul_nonneg_iff,
      left,
      split, {apply probs_nonneg}, {apply real.log_inv_nonneg, apply probs_nonneg, apply probs_le_one},
    },
    -- if the product is zero then one of the factors must be zero
    have H3 : ∀ (i : ι), (X i = 0) ∨ (real.log((X i)⁻¹) = 0),
    {
      intros i,
      specialize H2 i,
      rw mul_eq_zero at H2,
      exact H2,
    },
    have H4 : ∀ (i : ι), (X i = 0) ∨ (X i = 1),
    {
      intros i,
      specialize H3 i,
      cases H3 with l r,
      left, exact l,
      have hxi : 0 ≤ X i,
      {
        apply probs_nonneg i,
        exact _inst_3,
      },
      replace hxi := le_iff_lt_or_eq.mp hxi,
      cases hxi with xi0 xi1,
      right,
      rw real.log_inv at r,
      norm_num at r,
      exact real.one_of_log_zero_of_pos (X i) xi0 r,
      left,
      linarith,
    },
    apply delta_if_det, exact H4,
  },
  {
    -- we prove the other direction
    intro h,
    simp only [← sum_neg_distrib, ← mul_neg_eq_neg_mul_symm, ← real.log_inv],
    rw sum_eq_zero, norm_num,
    apply helper4,
    apply helper5,
    cases h with j hj,
    use j,
    finish,
  },
end

lemma
sum_of_constant_fun {f : ι → ℝ} {c : ℝ} (h1 : ∀ i, f i = c) :
∑ i, f i = c * fintype.card ι :=
begin
  have h' : ∑ i, f i = ∑ i : ι, c, {finish,},
  have h'' : ∑ i : ι, c = fintype.card(ι) * c,
  {
    rw finset.sum_const,
    finish,
  },
  finish,
end

/--
Theorem: The Shannon entropy of a uniform
random variable is log(n).
-/
theorem Shannon_entropy_of_uniform (X : ι → ℝ) [rnd_var X] :
is_uniform X → Shannon_entropy X = real.log(fintype.card ι) :=
begin
  intro hX,
  rw Shannon_entropy,
  have H : - ∑ i, X i * real.log (X i) = ∑ i, X i * real.log (1 / (X i)),
    by simp only [one_div, real.log_inv, mul_neg_eq_neg_mul_symm, sum_neg_distrib],
  unfold is_uniform at hX,
  -- we need to subsitute 1 / fintype.card ι for (X i).
  -- have H : ∀ i, X i * real.log (X i) = (1 / fintype.card ι) * real.log (1 / fintype.card ι), {
  --   sorry
  -- },
  -- have H2 :
  -- ∑ i, X i = ((1 / fintype.card ι) * real.log (1 / fintype.card ι)) * fintype.card ι, {
  --   apply sum_of_constant_fun X,
  -- },
  let f : ι → ℝ := λ i, (X i) * real.log (X i),
  let c : ℝ := (1 / fintype.card ι) * real.log (1 / fintype.card ι),
  have hX2 :
  ∀ i, f i = c, {
    sorry -- should be easy
  },
  -- should be easy from there.
  sorry
end


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers

/-

# Limits of sequences in Lean

We give the standard `ε`, `N` definition of the limit of a sequence
and prove some theorems about them.

## lambda (λ) notation for functions

Here's how we define the functions from the naturals to the naturals
sending n to n^2 + 3:

-/

def f : ℕ → ℝ := λ n, n^2+3

/-

Mathematicians might write `n ↦ n^2+3` for this functions; indeed `λ` is
just prefix notation for the infix notation `↦` (i.e. you write `λ` at
the front and `↦` in the middle but they mean the same thing). You can
read more about function types in the "three kinds of types" section
of Part B of the course book.

Sometimes you might find yourself with a lambda-defined function
evaluated at a number. For example, you might see something like
`(λ n, n^2 + 3) 37`, which means "take the function sending
`n` to `n^2+3` and then evaluate it at 37". You can use the `dsimp`
(or `dsimp only`) tactic to simplify this to `37^2+3`.

The reason we need to know about function notation for this sheet
is that a sequence `x₀, x₁, x₂, …` of reals on this sheet will
be encoded as a function from `ℕ` to `ℝ` sending `0` to `x₀`, `1` to `x₁`
and so on.

## Limit of a sequence.

Here's the definition of the limit of a sequence.
-/

/-- If `a(n)` is a sequence of reals and `t` is a real, `tendsto a t`
is the assertion that the limit of `a(n)` as `n → ∞` is `t`. -/
def tendsto (a : ℕ → ℝ) (t : ℝ) : Prop :=
∀ ε > 0, ∃ B : ℕ, ∀ n, B ≤ n → |a n - t| < ε

/-

We've made a definition, so it's our job to now make the API
for the definition, i.e. prove some basic theorems about it.
-/

-- If your goal is `tendsto a t` and you want to replace it with
-- `∀ ε > 0, ∃ B, …` then you can do this with `rw tendsto_def`.
theorem tendsto_def {a : ℕ → ℝ} {t : ℝ} :
  tendsto a t ↔ ∀ ε, 0 < ε → ∃ B : ℕ, ∀ n, B ≤ n → |a n - t| < ε :=
begin
  -- true by definition
  refl,
end

-- the eagle-eyed viewers amongst you might have spotted
-- that `∀ ε > 0, ...` and `∀ ε, ε > 0 → ...` and `∀ ε, 0 < ε → ...`
-- are all definitionally equal, so `refl` sees through them.

/-

## The questions

Here are some basic results about limits of sequences.
See if you can fill in the `sorry`s with Lean proofs.
Note that `norm_num` can work with `|x|` if `x` is a numeral like 37,
but it can't do anything with it if it's a variable.
-/

/-- The limit of the constant sequence with value 37 is 37. -/
theorem tendsto_thirtyseven : tendsto (λ n, 37) 37 :=
begin
  rw tendsto_def,
  intros ε hε,
  use 100,
  intros n hn,
  norm_num,
  exact hε,
end

/-- The limit of the constant sequence with value `c` is `c`. -/
theorem tendsto_const (c : ℝ) : tendsto (λ n, c) c :=
begin
  intros ε hε,
  dsimp only,
  use 37,
  intros n hn,
  ring_nf,
  norm_num,
  exact hε,
end

/-- If `a(n)` tends to `t` then `a(n) + c` tends to `t + c` -/
theorem tendsto_add_const {a : ℕ → ℝ} {t : ℝ} (c : ℝ)
  (h : tendsto a t) :
  tendsto (λ n, a n + c) (t + c) :=
begin
  rw tendsto_def at h ⊢,
  ring_nf,
  exact h,
end

/-- If `a(n)` tends to `t` then `-a(n)` tends to `-t`.  -/
example {a : ℕ → ℝ} {t : ℝ} (ha : tendsto a t) :
  tendsto (λ n, - a n) (-t) :=
begin
  rw tendsto_def at ha ⊢,
  ring_nf,
  intros ε hε,
  specialize ha ε hε,
  cases ha with B hB,
  use B,
  intros n hn,
  specialize hB n hn,
  ring_nf at hB ⊢,
  have h : ∀ (x : ℝ), |(-x)| = |x|,
    sorry, -- how to prove basic results about |.|? See next sheet!
  rw ← h,
  ring_nf at hB ⊢,
  exact hB,
end


import data.set.basic
open set

/-
This problem tests your ability to
contruct proofs using case analysis
on a disjunction, ∀ elimination, and
or introduction.

Remember, To eliminate a ∀ in a goal,
of the form, ∀ x, P x, introduce an
arbitrary value x into your context
(using intro or assume) and then show
P x for that x. (Of course you will
pick a sensible name instead of x for
the value being introduced into the
context.) The idea is that by showing
P x for an arbitrarily assumed value,
x, you thereby show P x for any x, and
thus you show P x for ∀ x.
-/

example :
    ∀ (x : Type),
    ∀ (p q : x → Prop),
    (∀ x, p x) ∨ (∀ x, q x) →
    ∀ x, p x ∨ q x :=
_


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic

/-

# Prove that there exists infinitely many positive integers n such that
# 4n² + 1 is divisible both by 5 and 13.

This is the third question in Sierpinski's book "250 elementary problems
in number theory".

Maths proof: if n=4 then 4n^2+1=65 is divisible by both 5 and 13
so if n is congruent to 4 mod 5 and mod 13 (i.e if n=4+65*t)
then this will work.

There are various ways to formalise the statement that some set
of naturals is infinite. We suggest two here (although proving
they're the same is fiddly)

-/

-- The number-theoretic heart of the argument.
-- Note that "divides" is `\|` not `|`
lemma divides_of_cong_four (t : ℕ) : 5 ∣ 4 * (65 * t + 4)^2 + 1 ∧
13 ∣ 4 * (65 * t + 4)^2 + 1 :=
begin
  split,
  { use 3380*t^2 + 416*t + 13,
    ring },
  { use 1300*t^2 + 160*t + 5,
    ring }
end

-- There are arbitrarily large solutions to `5 ∣ 4*n^2+1 ∧ 13 ∣ 4*n^2+1`
lemma arb_large_soln : ∀ N : ℕ, ∃ n > N, 5 ∣ 4*n^2+1 ∧ 13 ∣ 4*n^2+1 :=
begin
  intro N,
  -- need to find t such that 65t+4>N. Just set t=N for simplicity
  use 65 * N + 4,
  split,
  { linarith },
  { apply divides_of_cong_four }
end

-- This is not number theory any more, it's switching between two
-- interpretations of "this set of naturals is infinite"
lemma infinite_iff_arb_large (S : set ℕ) : S.infinite ↔ ∀ N, ∃ n > N, n ∈ S :=
begin
  split,
  { intro h,
    have h2 := set.infinite.exists_nat_lt h,
    intro n,
    rcases h2 n with ⟨m, hm, h3⟩,
    use m,
    exact ⟨h3, hm⟩,
  },
  { contrapose!,
    intro h,
    rw set.not_infinite at h,
    let S2 : finset ℕ := set.finite.to_finset h,
    have h2 : ∃ B, ∀n ∈ S2, n ≤ B,
    { use finset.sup S2 id,
      intros,
      apply finset.le_sup H },
    cases h2 with N hN,
    use N,
    have h3 : ∀n : ℕ, n ∈ S ↔ n ∈ S2,
      intro n,
      exact (set.finite.mem_to_finset h).symm,
    intros n hn h4,
    rw h3 at h4,
    specialize hN n h4,
    linarith,
  }
end

-- Another way of stating the question (note different "|" symbols:
-- there's `|` for "such that" in set theory and `\|` for "divides" in number theory)
lemma infinite_set_of_solutions : {n : ℕ | 5 ∣ 4*n^2+1 ∧ 13 ∣ 4*n^2+1}.infinite :=
begin
  rw infinite_iff_arb_large,
  exact arb_large_soln,
end


/-
Copyright (c) 2021 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, sheet 7 : the sets API

It might have occurred to you that if you had a prove
things like commutativity of `∩` every time you needed it,
then things would get boring quite quickly.

Fortunately, the writers of Lean's mathematics library
already proved these things and *gave the proofs names*.
On the previous sheet you showed that you could do these
things yourself, so on this sheet I'll tell you the names
of the Lean versions of the proofs, and show you how to use them.

Here are some examples of proof names in Lean.

`set.union_comm A B : A ∪ B = B ∪ A`
`set.inter_comm A B : A ∩ B = B ∩ A`
-- note `A ∪ B ∪ C` means `(A ∪ B) ∪ C`
`set.union_assoc A B C : A ∪ B ∪ C = A ∪ (B ∪ C)`
 -- similar comment for `∩`
`set.inter_assoc A B C : A ∩ B ∩ C = A ∩ (B ∩ C)`

(A technical point: note that `∪` and `∩` are "left associative",
in contrast to `→` which is right associative: `P → Q → R` means `P → (Q → R)`).

These lemmas are all in the `set` namespace (i.e. their full names
all begin with `set.`). It's annoying having to type `set.` all the time
so we `open set` which means you can skip it and just write things
like `union_comm A B`.

Note that `union_comm A B` is the *proof* that `A ∪ B = B ∪ A`.
In the language of type theory, `union_comm A B` is a
"term of type `A ∪ B = B ∪ A`". Let's just compare this with what we
were seeing in the logic sheet:

```
P : Prop -- P is a proposition
hP : P -- hP is a proof of P
```

Similarly here we have
```
A ∪ B = B ∪ A : Prop -- this is the *statement*
union_comm A B : A ∪ B = B ∪ A -- this is the *proof*
```

## New tactics you will need

* `rw` ("rewrite")

### The `rw` tactic (again)

We've seen `rw h,` being used if `h : P ↔ Q`; it changed all `P`s to `Q`s
in the goal. But `rw h,` also works for `h : A = B` -- it changes all
`A`s to `B`s in the goal. So `rw` is a "substitute in" command.

After the substitution has occurred, Lean tries `refl` just to see if it works.
For example if `A`, `B`, `C` are sets, and our context is

```
h : A = B
⊢ A ∩ C = B ∩ C
```

then `rw h` changes the goal into `B ∩ C = B ∩ C` and then solves
the goal automatically, because `refl` works.

`rw` doesn't just work for hypotheses -- if there is a theorem
in Lean's maths library (like `inter_comm A B`, which is a proof
that `A ∩ B = B ∩ A`) then you can `rw inter_comm A B` and it
will change `A ∩ B` in the goal to `B ∩ A`.

`rw` is a smart tactic. If the goal is

```
⊢ (A ∪ B) ∩ C = D
```

and you want to change it to `⊢ (B ∪ A) ∩ C = D` then you don't
have to write `rw union_comm A B`, you can write `rw union_comm`
and Lean will figure out what you meant. You can also write
`rw union_comm A` or even `rw union_comm _ B` if you want to give
it hints about exactly which union to commute.

-/

open set

variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

-- You can solve this one with `exact union_comm A B` or `rw union_comm`
example : A ∪ B = B ∪ A :=
begin
  sorry
end

example : (A ∪ B) ∩ C = C ∩ (B ∪ A) :=
begin
  sorry
end

/-
Note that `rw union_comm A` will change `A ∪ ?` to
`? ∪ A` for some set `?`. You can even do `rw union_comm _ B` if you
want to change `? ∪ B` to `B ∪ ?`
-/

example : A ∪ B ∪ C = C ∪ B ∪ A :=
begin
  sorry
end

example : x ∈ A ∩ B ∩ C ↔ x ∈ B ∩ C ∩ A :=
begin
  sorry
end

example : ((A ∪ B) ∪ C) ∪ D = A ∪ (B ∪ (C ∪ D)) :=
begin
  sorry
end

example : A ∪ B = C ∩ D → B ∪ A ∪ E = E ∪ (C ∩ D) :=
begin
  sorry
end

/-

Here are some distributivity results.

`set.union_distrib_left A B C : A ∪ (B ∩ C) = (A ∪ B) ∩ (A ∪ C)`
`set.union_distrib_right A B C : (A ∩ B) ∪ C = (A ∪ C) ∩ (B ∪ C)`
`set.inter_distrib_left A B C : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C)`
`set.inter_distrib_right A B C : (A ∪ B) ∩ C = (A ∩ C) ∪ (B ∩ C)`

Which ones will you use to do the following? Note that because of the `open set`
line much earlier, you don't have to write the `set.` part of the name.

-/

example : (A ∪ B) ∩ (C ∪ D) = (A ∩ C) ∪ (B ∩ C) ∪ (A ∩ D) ∪ (B ∩ D) :=
begin
  sorry
end

/-

## Top tips

How the heck are we supposed to remember all the names of these lemmas
in Lean's maths library??

Method 1) There is a logic to the naming system! You will slowly
get used to the logic.

Method 2) Until then, just use the `library_search` tactic
to look up proofs.

If you run the below code

```
example : A ∩ B = B ∩ A :=
begin
  library_search
end
```

you'll see some output on the right hand side of the screen containing
the name of the lemma which proves this example.

-/


import .love04_functional_programming_demo

/-! # LoVe Homework 4: Functional Programming

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (2 points): Maps

1.1 (1 point). Complete the following definition. The `map_btree` function
should apply its argument `f` to all values of type `α` stored in the tree and
otherwise preserve the tree's structure. -/

def map_btree {α β : Type} (f : α → β) : btree α → btree β :=
sorry

/-! 1.2 (1 point). Prove the following lemma about your `map_btree` function. -/

lemma map_btree_iden {α : Type} :
  ∀t : btree α, map_btree (λa, a) t = t :=
sorry

/-! ## Question 2 (4 points): Tail-Recursive Factorials

Recall the definition of the factorial functions: -/

#check fact

/-! 2.1 (2 points). Experienced functional programmers tend to avoid definitions
such as the above, because they lead to a deep call stack. Tail recursion can be
used to avoid this. Results are accumulated in an argument and returned. This
can be optimized by compilers. For factorials, this gives the following
definition: -/

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

/-! Prove that, given 1 as the accumulator `a`, `accufact` computes `fact`.

Hint: You will need to prove a generalized version of the statement as a
separate lemma or `have`, because the desired property fixes `a` to 1, which
yields a too weak induction hypothesis. -/

lemma accufact_1_eq_fact (n : ℕ) :
  accufact 1 n = fact n :=
sorry

/-! 2.2 (2 points). Prove the same property as above again, this time as a
"paper" proof. Follow the guidelines given in question 1.4 of the exercise. -/

-- enter your paper proof here

/-! ## Question 3 (3 points): Gauss's Summation Formula -/

-- `sum_upto f n = f 0 + f 1 + ⋯ + f n`
def sum_upto (f : ℕ → ℕ) : ℕ → ℕ
| 0       := f 0
| (m + 1) := sum_upto m + f (m + 1)

/-! 3.1 (2 point). Prove the following lemma, discovered by Carl Friedrich Gauss
as a pupil.

Hint: The `mul_add` and `add_mul` lemmas might be useful to reason about
multiplication. -/

#check mul_add
#check add_mul

lemma sum_upto_eq :
  ∀m : ℕ, 2 * sum_upto (λi, i) m = m * (m + 1) :=
sorry

/-! 3.2 (1 point). Prove the following property of `sum_upto`. -/

lemma sum_upto_mul (f g : ℕ → ℕ) :
  ∀n : ℕ, sum_upto (λi, f i + g i) n = sum_upto f n + sum_upto g n :=
sorry

end LoVe


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.urysohns_lemma
import topology.continuous_function.bounded

/-!
# Urysohn's lemma for bounded continuous functions

In this file we reformulate Urysohn's lemma `exists_continuous_zero_one_of_closed` in terms of
bounded continuous functions `X →ᵇ ℝ`. These lemmas live in a separate file because
`topology.continuous_function.bounded` imports too many other files.

## Tags

Urysohn's lemma, normal topological space
-/

open_locale bounded_continuous_function
open set function

/-- Urysohns lemma: if `s` and `t` are two disjoint closed sets in a normal topological space `X`,
then there exists a continuous function `f : X → ℝ` such that

* `f` equals zero on `s`;
* `f` equals one on `t`;
* `0 ≤ f x ≤ 1` for all `x`.
-/
lemma exists_bounded_zero_one_of_closed {X : Type*} [topological_space X] [normal_space X]
  {s t : set X} (hs : is_closed s) (ht : is_closed t)
  (hd : disjoint s t) :
  ∃ f : X →ᵇ ℝ, eq_on f 0 s ∧ eq_on f 1 t ∧ ∀ x, f x ∈ Icc (0 : ℝ) 1 :=
let ⟨f, hfs, hft, hf⟩ := exists_continuous_zero_one_of_closed hs ht hd
in ⟨⟨f, 1, λ x y, real.dist_le_of_mem_Icc_01 (hf _) (hf _)⟩, hfs, hft, hf⟩

/-- Urysohns lemma: if `s` and `t` are two disjoint closed sets in a normal topological space `X`,
and `a ≤ b` are two real numbers, then there exists a continuous function `f : X → ℝ` such that

* `f` equals `a` on `s`;
* `f` equals `b` on `t`;
* `a ≤ f x ≤ b` for all `x`.
-/
lemma exists_bounded_mem_Icc_of_closed_of_le {X : Type*} [topological_space X] [normal_space X]
  {s t : set X} (hs : is_closed s) (ht : is_closed t) (hd : disjoint s t)
  {a b : ℝ} (hle : a ≤ b) :
  ∃ f : X →ᵇ ℝ, eq_on f (const X a) s ∧ eq_on f (const X b) t ∧ ∀ x, f x ∈ Icc a b :=
let ⟨f, hfs, hft, hf01⟩ := exists_bounded_zero_one_of_closed hs ht hd
in ⟨bounded_continuous_function.const X a + (b - a) • f,
  λ x hx, by simp [hfs hx], λ x hx, by simp [hft hx],
  λ x, ⟨by dsimp; nlinarith [(hf01 x).1], by dsimp; nlinarith [(hf01 x).2]⟩⟩


/- The expression And.intro h1 h2 builds a proof of p ∧ q using proofs
h1 : p and h2 : q
The order of operations is as follows: unary negation ¬ binds most strongly, then ∧, then ∨, then →, and finally ↔
-/

variable (p q : Prop)

--The example command states a theorem without naming it or storing it in the permanent context. Essentially, it just checks that the given term has the indicated type.
example (hp : p) (hq : q) : p ∧ q := And.intro hp hq

#check fun (hp : p) (hq : q) => And.intro hp hq

-- The expression And.left h creates a proof of p from a proof h : p ∧ q
example (h : p ∧ q) : p := And.left h
example (h : p ∧ q) : q := And.right h

-- We can now prove p ∧ q → q ∧ p with the following proof term.
example (h : p ∧ q) : q ∧ p  :=
  And.intro (And.right h) (And.left h)


-- Las partes simétricas de las reflexivas son reflexivas
-- ======================================================

-- ----------------------------------------------------
-- Ej. 1. La parte simétrica de una relación R es la
-- relación S definida por
--    S x y := R x y ∧ R y x
--
-- Demostrar que la parte simétrica de una relación
-- reflexiva es reflexiva.
-- ----------------------------------------------------

section

parameter A : Type
parameter R : A → A → Prop
parameter reflR : reflexive R

include reflR

def S (x y : A) := R x y ∧ R y x

-- 1ª demostración
example : reflexive S :=
begin
  intro x,
  split,
  { exact (reflR x), },
  { exact (reflR x), },
end

-- 2ª demostración
example : reflexive S :=
assume x,
have R x x, from reflR x,
show S x x, from and.intro this this

-- 3ª demostración
example : reflexive S :=
assume x,
show S x x, from and.intro (reflR x) (reflR x)

-- 4ª demostración
example : reflexive S :=
assume x,
and.intro (reflR x) (reflR x)

-- 5ª demostración
example : reflexive S :=
λ x, ⟨reflR x, reflR x⟩

end


variables p q r : Prop

namespace mth1001

section theorems

-- Exercise 028:
/-
A theorem is a mechanism for naming a result. By _applying_ a theorem, we can produce new results.
Here is a theorem with its proof left as an exercise.
-/
theorem and_of_and : p ∧ q → q ∧ p :=
begin
  sorry
end

/-
The _type_ of any expression can be printed to the Infoview using `#check`.
The type of `and_of_and` is
  `∀ (p q : Prop), p ∧ q → q ∧ p`
This means that the theorem takes `p` and `q` propositions (i.e. terms of
type `Prop`) and returns a proof of `p ∧ q → q ∧ p`.

The symbol `∀` is read as 'for all' or 'for every' and is called the
universal quantifier. We'll return to a full explanation of `∀` later.
-/
#check and_of_and

/-
We apply this theorem by subsituting other quantities for `p` and `q`.]
Below, we take `q → r` for `p` and `q ∧ p` for `q` in `and_of_and`.
-/
example : (q → r) ∧ (q ∧ p) → (q ∧ p) ∧ (q → r) :=
and_of_and (q → r) (q ∧ p)

-- Even better, Lean can often infer the arguments to theorems if they
-- are replaced with the `_` placeholder:
example : (q → r) ∧ (q ∧ p) → (q ∧ p) ∧ (q → r) :=
and_of_and _ _

-- We can apply theorems in tactic mode. Using `exact` mimics the term-style proof.
example : (q → r) ∧ (q ∧ p) → (q ∧ p) ∧ (q → r) :=
begin
  exact and_of_and _ _,
end

/-
We don't need to use `_` here to explicitly request argument inference; the `apply` tactic
does this automatically.
-/
example : (q → r) ∧ (q ∧ p) → (q ∧ p) ∧ (q → r) :=
begin
  apply and_of_and,
end

-- Exercise 029:
-- Give either a tactic-style or term-style proof of the following.
theorem and_assoc1 : (p ∧ q) ∧ r → p ∧ (q ∧ r) :=
sorry

-- Exercise 030:
-- Using the previous theorem, give a one-line proof of the following.
example (a b : Prop) : ((a → b) ∧ b) ∧ (b → a) → (a → b) ∧ (b ∧ (b → a)) :=
sorry

-- Exercise 031:
/-
The next example is more challenging. Use `intro`, `apply`, `exact`,
and the previous two theorems.
-/
example (a b : Prop) : ((a → b) ∧ b) ∧ (b → a) → (b ∧ (b → a)) ∧ (a → b) :=
begin
  sorry  end

variables s t u : Prop

-- Exercise 032:
/-
Complete the following proof. The only tactics you are permitted to use are `apply` and `exact`
(each as many times as you like). You can only use these tactics with `and_of_and`,
`and_assoc`, or `h`.
-/
theorem and_assoc2 : s ∧ (t ∧ u) → (s ∧ t) ∧ u :=
begin
  intro h,
  sorry
end

end theorems

/-
SUMMARY:

* Theorems in Lean.
* `#check` to find the type of a theorem.
* Using theorems.
-/

end mth1001


/-
The connective, ∧, in predicate as in
propositional logic builds a proposition
that asserts that each of two propositions
is true. Given propositions P, Q, P ∧ Q
is also a proposition, and we judge it to
be true iff we judge P to be true and we
judge Q to be true. We judge P and Q to
be true iff we have evidence that they
are true, in the form of proofs. Our rule
for constructing evidence for P ∧ Q thus
demands evidence for P and evidence for
Q and yields evidence for P ∧ Q.
-/

#check and

/-
structure and (a b : Prop) : Prop :=
intro :: (left : a) (right : b)
-/

-- A polymorphic product type (in Prop)!

axioms (P Q : Prop) (p : P) (q : Q)

example : P := p
example : Q := q
example : P ∧ Q := and.intro p q
lemma paq : P ∧ Q := ⟨ p, q ⟩

#check paq
#reduce paq

#check and.elim_left

/-
def and.elim_left {a b : Prop} (h : and a b) : a := h.1
def and.elim_right {a b : Prop} (h : and a b) : b := h.2
-/

#reduce and.elim_left paq
#reduce and.elim_right paq

example : 0 = 0 ∧ 1 = 0 :=
and.intro (eq.refl 0) (eq.refl _)   -- stuck

lemma zzoo : 0 = 0 ∧ 1 = 1 :=
and.intro rfl rfl

#reduce zzoo.right

/-
Proof that and commutes and is
associative (you can regroup at
will, by associativity).
-/

example : P ∧ Q → Q ∧ P :=
λ (h : P ∧ Q), and.intro h.right h.left

/-
And is commutative and associative.
Prove it.
-/
axiom R : Prop

lemma and_assoc_forward : (P ∧ Q) ∧ R -> P ∧ (Q ∧ R) :=
λ h,
  (and.intro
    h.left.left
   (and.intro h.left.right h.right)
  )

/-
Full proof. and commutes
-/
example : P ∧ Q ↔ Q ∧ P :=

-- proof is pair: forward/backward proofs
iff.intro
  -- proof forward
  (λ h, ⟨ h.right, h.left ⟩ )
  -- proof backwards
  (λ h, ⟨ h.right, h.left ⟩)

/-
Full proof, modulo reverse direction,
that and is associative.
-/
example : (P ∧ Q) ∧ R ↔ P ∧ (Q ∧ R) :=
iff.intro
  (and_assoc_forward)
  (_)