/-
Copyright (c) 2022 Sina Hazratpour. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
----------------

# Algebra of Functions (Part III) : Function Composition
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

import ..prooflab
import lectures.lec4_equality_of_functions

set_option pp.beta true
set_option pp.generalized_field_notation false
-- set_option pp.all true

/-
New tactics we'll learn in this lesson:
10. `dsimp` and its variants
11. `cases`
-/

namespace PROOFS

variables {A B C X Y Z U V W : Type}

/-! ### Composition of Functions** -/

/-
A function can be implemented in different ways, but once it is implemented, we can forget about the details of its implementation and concentrate on how it interacts with other functions. There is an interesting algebra of interactions of functions.

The main way functions interact is via the operation of __composition__. The main idea of composition of functions is to create _compound_ functions from simpler functions which can do more tasks.

The operation of composition gives us an incredibly powerful tool to focus on these interaction of functions.

Suppose `f : A → B` and `g : B → C` are functions.
We define a new function `g ∘ f : A → C` by letting

` g ∘ f (x) =  g(f(x))`

The function `g ∘ f` is called the __composition__ of `f` and `g` which we also call "f composed with g" (or "g after f"). Often when there is no risk of confusion mathematicians dispense with `∘` in the notation above and simply write `g f` for the composition of `f` and `g`.
-/

-- namespace composition

def compose {X Y Z : Type} (g: Y → Z) (f: X → Y) : X → Z :=
λ x : X,  g (f x)

#check compose
#check @compose

def compose_Nicole {X Y Z : Type} (f : X → Y) (g : Y → Z): X → Z :=
λ x : X,  g (f x)

#check @compose_Nicole

/-
*Note*: heed the explicit vs implicit variables!
-/

variables (f₀ : ℕ → ℤ) (g₀ : ℤ → ℚ) (h₀ : ℚ → ℕ )

#check compose g₀ f₀
#check g₀ ∘ f₀ -- shorthand notation for `compose g₀ f₀`.

/-
- Note that we can compose two functions only if the domain of the first one matches with the codomain of the second one.
-/

/-
- A shorthand notation for `compose f g` is `f ∘ g`. To get `∘` type "\comp".
- infixr  ` ∘ ` := comp
-/

-- #check g₀ ∘ f₀
#check h₀ ∘ f₀ -- can you understand the error?
#check (h₀ ∘ g₀) ∘ f₀
#check h₀ ∘ (g₀ ∘ f₀)
#check (h₀ ∘ g₀) ∘ f₀
#check g₀ ∘ (f₀ ∘ h₀)

/-
*Note*: by default, Lean reads `h₀ ∘ g₀ ∘ f₀` as `(h₀ ∘ g₀) ∘ f₀`, that is the bracketing is from the left to right.
-/

/-
There is a wonderful yet very simple function which is defined in the same way for every object. This is the so-called __identity function__ of that object. For an object `A`, Lean defines a function `id : A → A` which assigns to an element `a` itself! Therefore,
`id a = a`.
-/

section
variable a : A
#check id
#check id a
end

lemma id_def (a : A) :
  id a = a
:=
begin
refl,
end

#check switch
#eval switch ff
#check switch ∘ switch
-- #eval (switch ∘ switch) ff

section
variable b : bool
#check switch b
#eval switch b
end

lemma switch_switch_alt :
  switch ∘ switch = id :=
begin
  funext b,
  dsimp,
  refl, -- this does not work since `switch b` depends on the value of `b`, and we have to reason by cases.
end

lemma switch_switch :
  switch ∘ switch = id :=
begin
  funext b,
  dsimp,
  cases b, -- tactic `cases` branches the proof into two branches, one when `b = ff` and the second branch when `b = tt`
  {
    refl,
  },
  {
    refl,
  },
end

lemma switch_switch_alt_alt :
  switch ∘ switch = id :=
begin
  funext b,
  dsimp,
  cases b,
  repeat {refl},
end

lemma swap_square_is_id (X Y : Type) : (swap_pair Y X) ∘ (swap_pair X Y)= id :=
begin
ext p,
repeat {refl}, -- instead of writing refl two times.
end

-- function `fun_pair` takes two functions and returns their cartesian product, i.e. a function from the cartesian product of the domains of the input function to the cartesian product of the codomains of the the input functions.

def fun_pair (f : A → B) (g : X → Y) (p : A × X) : B × Y   :=
(f p.1 , g p.2)

#check fun_pair
#check fun_pair double switch
#eval (fun_pair double switch) (2, ff)

#check pairing
#check @pairing

/-
Therer is a difference between the functions `pairing` and `fun_pair`.
1. `pairing` takes two functions with the same domain as inputs.
2. `fun_pair` on the other hand takes any two functions as input.

However, theorem `fun_pair_is_pairing` below proves that the two functions `pairing` and `fun_pair` are intimately related.
-/

lemma fun_pair_is_pairing (f : A → X) (g : B → Y) :
fun_pair (f : A → X) (g : B → Y) =
pairing (λ c : A × B, f c.1) (λ c : A × B, g c.2) :=
begin
  funext x,
  refl,
end

/-
Projection `fst` and `pairing` commute.
-/
lemma fun_of_fst_is_fst_of_fun_pair (X₁ Y₁ X₂ Y₂: Type) (f : X₁ → Y₁) (g : X₂ → Y₂) : fst ∘ (fun_pair f g) = f ∘ fst :=
begin
  ext p,
  refl,
end

def associator (X Y Z : Type) : X × (Y × Z) → (X × Y) × Z :=
λ p, ((p.1, p.2.1), p.2.2)

#check associator

--Challenge: prove pentagon

/-! ### Propoerties of composition of functions -/

/-
__unitality of composition__ is a fancy name for saying that the composition of the identity function and any function `f` is the same function `f`.
-/

/-
For any given function `f : X → Y` we want to prove that `id ∘ f = f`. Therefore in Lean we write

lemma comp_left_unitality (f : X → Y) : id ∘ f = f
:= proof

Now we need to supply the proof. But let's think about `id ∘ f`. For any `x : X`, we have
`(id ∘ f) x = id (f x) = f x` where these equalities are proved by `rfl`. By `funext` we can conclude that
`id ∘ f = f`.
-/

/-
__left unitality of composition__
-/

lemma comp_left_unit {X Y : Type} (f : X → Y) :
  id ∘ f = f :=
begin
funext x,
dsimp,
refl,
end

/-
__right unitality of composition__
-/
lemma comp_right_unit {X Y : Type} (f : X → Y) :
  f ∘ id = f :=
begin
funext x,
dsimp,
refl,
end

/-
The theorem __associativity of composition__ says in that the order of bracketing in the composition of three functions (with matching domaisn and codomains) does not matter since the two different ways of composition result in the same function, that is
`(h ∘ g) ∘ f  = h ∘ (g ∘ f)`
for any three functions `(f : X → Y ) (g : Y → Z) (h : Z → W) `.
-/

theorem comp_assoc {X Y Z W: Type} (f : X → Y ) (g : Y → Z) (h : Z → W) :   (h ∘ g) ∘ f  = h ∘ (g ∘ f)  :=
begin
funext x,
dsimp,
refl,
end

theorem comp_tetrahedral_assoc (f : X → Y ) (g : Y → Z) (h : Z → W) (k : W → V) : k ∘ (h ∘ ( g ∘ f)) = ((k ∘ h) ∘ g) ∘ f
:=
begin
  funext x,
  dsimp,
  refl,
end

theorem comp_tetrahedral_assoc_alt (f : X → Y ) (g : Y → Z) (h : Z → W) (k : W → V) : k ∘ (h ∘ ( g ∘ f)) = ((k ∘ h) ∘ g) ∘ f
:=
begin
  calc k ∘ (h ∘ ( g ∘ f)) = (k ∘ h ) ∘ (g ∘ f) : by rw comp_assoc (g ∘ f) h k
  ... = ((k ∘ h) ∘ g) ∘ f : by rw comp_assoc f g (k ∘ h),
end

end PROOFS


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import order.filter.lift
import topology.separation
import data.set.intervals.monotone

/-!
# Topology on the set of filters on a type

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

In this file introduce topology on `filter α`. It is generated by the sets
`set.Iic (𝓟 s) = {l : filter α | s ∈ l}`, `s : set α`. A set `s : set (filter α)` is open if and
only if it is a union of a family of these basic open sets, see `filter.is_open_iff`.

This topology has the following important properties.

* If `X` is a topological space, then the map `𝓝 : X → filter X` is a topology inducing map.

* In particular, it is a continuous map, so `𝓝 ∘ f` tends to `𝓝 (𝓝 a)` whenever `f` tends to `𝓝 a`.

* If `X` is an ordered topological space with order topology and no max element, then `𝓝 ∘ f` tends
  to `𝓝 filter.at_top` whenever `f` tends to `filter.at_top`.

* It turns `filter X` into a T₀ space and the order on `filter X` is the dual of the
  `specialization_order (filter X)`.

## Tags

filter, topological space
-/

open set filter topological_space
open_locale filter topology

variables {ι : Sort*} {α β X Y : Type*}

namespace filter

/-- Topology on `filter α` is generated by the sets `set.Iic (𝓟 s) = {l : filter α | s ∈ l}`,
`s : set α`. A set `s : set (filter α)` is open if and only if it is a union of a family of these
basic open sets, see `filter.is_open_iff`. -/
instance : topological_space (filter α) := generate_from $ range $ Iic ∘ 𝓟

lemma is_open_Iic_principal {s : set α} : is_open (Iic (𝓟 s)) :=
generate_open.basic _ (mem_range_self _)

lemma is_open_set_of_mem {s : set α} : is_open {l : filter α | s ∈ l} :=
by simpa only [Iic_principal] using is_open_Iic_principal

lemma is_topological_basis_Iic_principal :
  is_topological_basis (range (Iic ∘ 𝓟 : set α → set (filter α))) :=
{ exists_subset_inter :=
    begin
      rintro _ ⟨s, rfl⟩ _ ⟨t, rfl⟩ l hl,
      exact ⟨Iic (𝓟 s) ∩ Iic (𝓟 t), ⟨s ∩ t, by simp⟩, hl, subset.rfl⟩
    end,
  sUnion_eq := sUnion_eq_univ_iff.2 $ λ l, ⟨Iic ⊤, ⟨univ, congr_arg Iic principal_univ⟩, le_top⟩,
  eq_generate_from := rfl }

lemma is_open_iff {s : set (filter α)} :
  is_open s ↔ ∃ T : set (set α), s = ⋃ t ∈ T, Iic (𝓟 t) :=
is_topological_basis_Iic_principal.open_iff_eq_sUnion.trans $
  by simp only [exists_subset_range_iff, sUnion_image]

lemma nhds_eq' (l : filter α) : 𝓝 l = l.lift' (λ s, {l' | s ∈ l'}) :=
by simpa only [(∘), Iic_principal] using nhds_eq l

protected lemma tendsto_nhds {la : filter α} {lb : filter β} {f : α → filter β} :
  tendsto f la (𝓝 lb) ↔ ∀ s ∈ lb, ∀ᶠ a in la, s ∈ f a :=
by simp only [nhds_eq', tendsto_lift', mem_set_of_eq]

lemma has_basis.nhds {l : filter α} {p : ι → Prop} {s : ι → set α} (h : has_basis l p s) :
  has_basis (𝓝 l) p (λ i, Iic (𝓟 (s i))) :=
by { rw nhds_eq, exact h.lift' monotone_principal.Iic }

/-- Neighborhoods of a countably generated filter is a countably generated filter. -/
instance {l : filter α} [is_countably_generated l] : is_countably_generated (𝓝 l) :=
let ⟨b, hb⟩ := l.exists_antitone_basis in has_countable_basis.is_countably_generated $
  ⟨hb.nhds, set.to_countable _⟩

lemma has_basis.nhds' {l : filter α} {p : ι → Prop} {s : ι → set α} (h : has_basis l p s) :
  has_basis (𝓝 l) p (λ i, {l' | s i ∈ l'}) :=
by simpa only [Iic_principal] using h.nhds

lemma mem_nhds_iff {l : filter α} {S : set (filter α)} :
  S ∈ 𝓝 l ↔ ∃ t ∈ l, Iic (𝓟 t) ⊆ S :=
l.basis_sets.nhds.mem_iff

lemma mem_nhds_iff' {l : filter α} {S : set (filter α)} :
  S ∈ 𝓝 l ↔ ∃ t ∈ l, ∀ ⦃l' : filter α⦄, t ∈ l' → l' ∈ S :=
l.basis_sets.nhds'.mem_iff

@[simp] lemma nhds_bot : 𝓝 (⊥ : filter α) = pure ⊥ :=
by simp [nhds_eq, lift'_bot monotone_principal.Iic]

@[simp] lemma nhds_top : 𝓝 (⊤ : filter α) = ⊤ := by simp [nhds_eq]

@[simp] lemma nhds_principal (s : set α) : 𝓝 (𝓟 s) = 𝓟 (Iic (𝓟 s)) :=
(has_basis_principal s).nhds.eq_of_same_basis (has_basis_principal _)

@[simp] lemma nhds_pure (x : α) : 𝓝 (pure x : filter α) = 𝓟 {⊥, pure x} :=
by rw [← principal_singleton, nhds_principal, principal_singleton, Iic_pure]

@[simp] lemma nhds_infi (f : ι → filter α) : 𝓝 (⨅ i, f i) = ⨅ i, 𝓝 (f i) :=
by { simp only [nhds_eq], apply lift'_infi_of_map_univ; simp }

@[simp] lemma nhds_inf (l₁ l₂ : filter α) : 𝓝 (l₁ ⊓ l₂) = 𝓝 l₁ ⊓ 𝓝 l₂ :=
by simpa only [infi_bool_eq] using nhds_infi (λ b, cond b l₁ l₂)

lemma monotone_nhds : monotone (𝓝 : filter α → filter (filter α)) :=
monotone.of_map_inf nhds_inf

lemma Inter_nhds (l : filter α) : ⋂₀ {s | s ∈ 𝓝 l} = Iic l :=
by simp only [nhds_eq, sInter_lift'_sets monotone_principal.Iic, Iic, le_principal_iff,
  ← set_of_forall, ← filter.le_def]

@[simp] lemma nhds_mono {l₁ l₂ : filter α} : 𝓝 l₁ ≤ 𝓝 l₂ ↔ l₁ ≤ l₂ :=
begin
  refine ⟨λ h, _, λ h, monotone_nhds h⟩,
  rw [← Iic_subset_Iic, ← Inter_nhds, ← Inter_nhds],
  exact sInter_subset_sInter h
end

protected lemma mem_interior {s : set (filter α)} {l : filter α} :
  l ∈ interior s ↔ ∃ t ∈ l, Iic (𝓟 t) ⊆ s :=
by rw [mem_interior_iff_mem_nhds, mem_nhds_iff]

protected lemma mem_closure {s : set (filter α)} {l : filter α} :
  l ∈ closure s ↔ ∀ t ∈ l, ∃ l' ∈ s, t ∈ l' :=
by simp only [closure_eq_compl_interior_compl, filter.mem_interior, mem_compl_iff, not_exists,
  not_forall, not_not, exists_prop, not_and, and_comm, subset_def, mem_Iic, le_principal_iff]

@[simp] protected lemma closure_singleton (l : filter α) : closure {l} = Ici l :=
by { ext l', simp [filter.mem_closure, filter.le_def] }

@[simp] lemma specializes_iff_le {l₁ l₂ : filter α} : l₁ ⤳ l₂ ↔ l₁ ≤ l₂ :=
by simp only [specializes_iff_closure_subset, filter.closure_singleton, Ici_subset_Ici]

instance : t0_space (filter α) :=
⟨λ x y h, (specializes_iff_le.1 h.specializes).antisymm (specializes_iff_le.1 h.symm.specializes)⟩

lemma nhds_at_top [preorder α] : 𝓝 at_top = ⨅ x : α, 𝓟 (Iic (𝓟 (Ici x))) :=
by simp only [at_top, nhds_infi, nhds_principal]

protected lemma tendsto_nhds_at_top_iff [preorder β] {l : filter α} {f : α → filter β} :
  tendsto f l (𝓝 at_top) ↔ ∀ y, ∀ᶠ a in l, Ici y ∈ f a :=
by simp only [nhds_at_top, tendsto_infi, tendsto_principal, mem_Iic, le_principal_iff]

lemma nhds_at_bot [preorder α] : 𝓝 at_bot = ⨅ x : α, 𝓟 (Iic (𝓟 (Iic x))) := @nhds_at_top αᵒᵈ _

protected lemma tendsto_nhds_at_bot_iff [preorder β] {l : filter α} {f : α → filter β} :
  tendsto f l (𝓝 at_bot) ↔ ∀ y, ∀ᶠ a in l, Iic y ∈ f a :=
@filter.tendsto_nhds_at_top_iff α βᵒᵈ _ _ _

variables [topological_space X]

lemma nhds_nhds (x : X) :
  𝓝 (𝓝 x) = ⨅ (s : set X) (hs : is_open s) (hx : x ∈ s), 𝓟 (Iic (𝓟 s)) :=
by simp only [(nhds_basis_opens x).nhds.eq_binfi, infi_and, @infi_comm _ (_ ∈ _)]

lemma inducing_nhds : inducing (𝓝 : X → filter X) :=
inducing_iff_nhds.2 $ λ x, (nhds_def' _).trans $
  by simp only [nhds_nhds, comap_infi, comap_principal, Iic_principal, preimage_set_of_eq,
    ← mem_interior_iff_mem_nhds, set_of_mem_eq, is_open.interior_eq] { contextual := tt }

@[continuity] lemma continuous_nhds : continuous (𝓝 : X → filter X) := inducing_nhds.continuous

protected lemma tendsto.nhds {f : α → X} {l : filter α} {x : X} (h : tendsto f l (𝓝 x)) :
  tendsto (𝓝 ∘ f) l (𝓝 (𝓝 x)) :=
(continuous_nhds.tendsto _).comp h

end filter

variables [topological_space X] [topological_space Y] {f : X → Y} {x : X} {s : set X}

lemma continuous_within_at.nhds (h : continuous_within_at f s x) :
  continuous_within_at (𝓝 ∘ f) s x :=
h.nhds

lemma continuous_at.nhds (h : continuous_at f x) : continuous_at (𝓝 ∘ f) x := h.nhds
lemma continuous_on.nhds (h : continuous_on f s) : continuous_on (𝓝 ∘ f) s := λ x hx, (h x hx).nhds
lemma continuous.nhds (h : continuous f) : continuous (𝓝 ∘ f) := filter.continuous_nhds.comp h


import Mathlib.Algebra.Ring.Basic
import Mathlib.Data.Rat.Basic
import Mathlib.Tactic.Ring

/-
Bulgarian Mathematical Olympiad 1998, Problem 8
The polynomials Pₙ(x,y) for n = 1, 2, ... are defined by P₁(x,y) = 1 and
  Pₙ₊₁(x,y) = (x + y - 1)(y + 1)Pₙ(x,y+2) + (y - y²)Pₙ(x,y)
Prove that Pₙ(x,y) = Pₙ(y,x) for all x,y,n.
-/

variable {R : Type} [CommRing R]

def P : ℕ → R → R → R
| 0, _, _ => 1
| n+1, x, y => (x + y - 1) * (y + 1) * P n x (y + 2) + (y - y^2) * P n x y

/- helper function
   Sₙ₋₁(x,y) = [(x + y)² - 1](y + 1)(x + 1)Pₙ₋₁(y+2, x+2).
-/
def S : ℕ → R → R → R
| n, x, y => ((x + y)^2 - 1) * (y + 1) * (x + 1) * P n (y + 2) (x + 2)

/- helper function
   Tₙ₋₁(x,y) = (y - y²)(x - x²)Pₙ₋₁(y, x).
-/
def T : ℕ → R → R → R
| n, x, y => (y - y^2) * (x - x^2) * P n y x

/- helper function
   Uₙ₋₁(x,y) = (x + y - 1) [(y + 1)(x - x²)Pₙ₋₁(y + 2, x)
                           + (x + 1)(y - y²) Pₙ₋₁(y, x + 2)]
-/
def U : ℕ → R → R → R
| n, x, y => (x + y - 1) *((y + 1)*(x - x^2) * P n (y + 2) x
                           + (x + 1) * (y - y^2) * P n y (x + 2))

theorem bulgaria1998_q8 (n : ℕ) (x y : R) : P n x y = P n y x := by
  -- We induct on n. For n = 1,2 the result is evident.
  -- So we take n > 1 and suppose that the result is true for
  -- Pₙ₋₁(x,y) and Pₙ₋₂(x,y).
  revert x y
  induction n using Nat.strong_induction_on with | h n ih =>
  cases n with | zero => intros; rfl | succ n =>
  cases n with | zero => intros; dsimp only [P]; ring | succ n =>

  -- in the informal proof at this point, we're trying to
  -- prove the end result at n+1.
  -- In our formal version, that corresponds to proving the result for
  -- n.succ.succ

  /- We have
     Pₙ₊₁(x,y) = (x + y - 1)(y + 1)Pₙ(x,y+2) + (y - y²)Pₙ(x,y)
               = (x + y - 1)(y + 1)Pₙ(y+2,x) + (y - y²)Pₙ(y,x)
  -/

  have ih1 := ih n.succ (lt_add_one n.succ)
  have h1 : ∀ x y : R, P n.succ.succ x y =
               (x + y - 1) * (y + 1) * (P n.succ (y + 2) x) +
                   (y - y^2) * (P n.succ y x) := by
    intros x y
    calc P (n.succ.succ) x y
        = (x + y - 1) * (y + 1) * (P n.succ x (y + 2)) +
          (y - y^2) * (P n.succ x y) := rfl
      _ = (x + y - 1) * (y + 1) * (P n.succ (y + 2) x) +
          (y - y^2) * (P n.succ y x) := by rw[ih1 x y, ih1 x (y+2)]

  have h2 : ∀ x y : R, (x + y - 1) * (y + 1) * P n.succ (y + 2) x
        = S n x y + (x + y - 1)* (y + 1) * (x - x^2)* P n (y+2) x := by
     intros x y; dsimp only [S, P]; ring

  have h_s_symm : ∀ m : ℕ, m < n.succ.succ → ∀ x y : R, S m x y = S m y x := by
    intros m hm x y; dsimp only [S]; rw[ih m hm (x + 2) (y + 2)]; ring

  have h4 : ∀ x y : R, (y - y^2) * P n.succ y x =
              (y - y^2) * (x + y -1) * (x + 1) * P n y (x + 2) + T n x y := by
    intros x y; dsimp only[T, P]; ring

  have h_t_symm : ∀ m : ℕ, m < n.succ.succ → ∀ x y : R, T m x y = T m y x := by
    intros m hm x y; dsimp only[T]; rw[ih m hm x y]; ring

  have h_u_symm : ∀ m : ℕ, m < n.succ.succ → ∀ x y : R, U m x y = U m y x := by
    intros m hm x y; dsimp only [U]; rw[ih m hm (y+2) x, ih m hm (x+2) y]; ring

  have h7 : ∀ x y : R, P n.succ.succ x y = S n x y + T n x y + U n x y := by
    intros x y; rw[h1 x y, h2 x y, h4 x y]; dsimp only [U]; ring

  have h8 : n < n.succ := lt_add_one n
  have h9 : n < n.succ.succ := Nat.lt.step h8

  intros x y
  calc P n.succ.succ x y
      = S n x y + T n x y + U n x y := h7 x y
    _ = S n y x + T n x y + U n x y := by rw[h_s_symm n h9 x y]
    _ = S n y x + T n y x + U n x y := by rw[h_t_symm n h9 x y]
    _ = S n y x + T n y x + U n y x := by rw[h_u_symm n h9 x y]
    _ = P n.succ.succ y x := (h7 y x).symm


variable {p : Prop}
variable {q : Prop}

-- given a value in `p`, exhibit a function that takes a `q` and returns a `p`.
theorem t1 : p → (q → p) := fun (vp : p) => (fun (_vq : q) => vp)
#print t1  -- fun {p q} vp _vq => vp

theorem t1_alt : p → q → p :=
  fun hp : p =>
  fun _hq : q =>
  show p from hp
#print t1_alt

theorem t1_alt2 (hp : p) (_hq : q) : p := hp
#print t1_alt2

axiom hp : p

/- Apply theorem t1 -/
theorem t2 : q → p := t1 hp

/-
section unsound
  axiom unsound : False
  theorem one_eq_zero : 1 = 0 := False.elim unsound
end unsound

#check unsound  -- unsoundness escapes the section!
-/

variable (p q r s : Prop)
theorem compose (h₁ : q → r) (h₂ : p → q) (hp : p) : r :=
  h₁ (h₂ hp)

theorem compose_alt (h₁ : q → r) (h₂ : p → q) : p → r :=
  fun hp : p =>
  show r from h₁ (h₂ hp)

-- p → q and ¬ q implies ¬ p
example (hpq: p → q) (hnq: ¬ q) : ¬ p :=
  fun hp : p => show False from hnq (hpq hp)

-- ex falso
example (hp : p) (hnp : ¬ p) : q :=
  show q from False.elim (hnp hp)

example (hp : p) (hnp : ¬ p) : q := absurd hp hnp
#check absurd  -- absurd.{v} {a : Prop} {b : Sort v} (h₁ : a) (h₂ : ¬a) : b

-- canonical proof of True
example (_t : True) := True.intro

-- logical equivalence

theorem and_swap : p ∧ q ↔ q ∧ p :=
  Iff.intro
    -- left => right
    (fun h : p ∧ q =>
     show q ∧ p from And.intro (And.right h) (And.left h))
    -- right => left
    (fun h : q ∧ p =>
     show p ∧ q from And.intro (And.right h) (And.left h))

#check and_swap p q    -- p ∧ q ↔ q ∧ p

-- compare to and_commutative.lean proof
example (h : p ∧ q) : q ∧ p := Iff.mp (and_swap p q) h

-- using anonymous constructors for structural types `Iff` and `And`
theorem and_swap_alt : p ∧ q ↔ q ∧ p :=
  ⟨ fun h => ⟨h.right, h.left⟩, fun h => ⟨h.right, h.left⟩ ⟩

example (h : p ∧ q) : q ∧ p := (and_swap p q).mp h
#check Iff.mp  -- Iff.mp {a b : Prop} (self : a ↔ b) (a✝ : a) : b

/-
 - Exercises: https://leanprover.github.io/theorem_proving_in_lean4/propositions_and_proofs.html
 -/

 section exercises
 variable (p q r : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  Iff.intro
    (fun (hpq : p ∧ q) => And.intro hpq.right hpq.left)
    (fun (hqp : q ∧ p) => And.intro hqp.right hqp.left)
example : p ∨ q ↔ q ∨ p :=
  Iff.intro
    (fun (hpq : p ∨ q) =>
      Or.elim hpq
        (fun hp : p => Or.inr hp)
        (fun hq : q => Or.inl hq))
    (fun (hqp : q ∨ p) =>
      Or.elim hqp
        (fun hq : q => Or.inr hq)
        (fun hp : p => Or.inl hp))

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  Iff.intro
    (fun hpqr =>
      have hr : r := hpqr.right
      have hpq : p ∧ q := hpqr.left
      ⟨hpq.left, hpq.right, hr⟩)
    (fun hpqr =>
      have hp : p := hpqr.left
      have hqr : q ∧ r := hpqr.right
      ⟨⟨hp, hqr.left⟩, hqr.right⟩)
example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := sorry

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := sorry
example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := sorry

-- De Morgan's Law
theorem de_morgan_1 : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  Iff.intro
    (fun hnpoq : (p ∨ q → False) =>
      have hnp : ¬p := (fun hp: p => hnpoq (Or.inl hp))
      have hnq : ¬q := (fun hq: q => hnpoq (Or.inr hq))
      ⟨hnp, hnq⟩)
    (fun hnpnq : ¬p ∧ ¬q =>
      -- use partially applied And.left/And.right
      fun hpoq : p ∨ q => Or.elim hpoq hnpnq.left hnpnq.right)
theorem de_morgan_2 : ¬(p ∧ q) ↔ (¬p ∨ ¬q) := sorry

-- other properties
theorem pq_imply_r : (p → (q → r)) ↔ (p ∧ q → r) := sorry
#check @pq_imply_r
theorem pq_imply_false : (p → ¬q) ↔ ¬(p ∧ q) := @pq_imply_r p q False
#check pq_imply_false
#check Iff.mp
#check Iff.mp (@pq_imply_false p q)
-- use pq_imply_false and De Morgan to prove this alternate tautology
example : (p → ¬q) ↔ ¬p ∨ ¬q :=
  Iff.intro
    (fun lhs : (p → ¬q) =>
      have hnpq : ¬(p ∧ q) := (Iff.mp (@pq_imply_false p q)) lhs
      show (¬p ∨ ¬q) from (Iff.mp (@de_morgan_2 p q) hnpq))
    (fun rhs : ¬p ∨ ¬q =>
      have hnpaq : ¬ (p ∧ q) := (Iff.mpr (@de_morgan_2 p q)) rhs
      fun hp : p =>
      fun hq : q => hnpaq ⟨hp, hq⟩)

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := sorry

example : ¬p ∨ ¬q → ¬(p ∧ q) := sorry
example : ¬(p ∧ ¬p) := sorry
example : p ∧ ¬q → ¬(p → q) := sorry
example : ¬p → (p → q) := sorry
example : (¬p ∨ q) → (p → q) := sorry
example : p ∨ False ↔ p := sorry
example : p ∧ False ↔ False := sorry
example : (p → q) → (¬q → ¬p) := sorry

end exercises


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/
import data.list.join
import data.set.lattice

/-!
# Languages

This file contains the definition and operations on formal languages over an alphabet. Note strings
are implemented as lists over the alphabet.
The operations in this file define a [Kleene algebra](https://en.wikipedia.org/wiki/Kleene_algebra)
over the languages.
-/

universes u v

open list set

variables {α : Type u}

/-- A language is a set of strings over an alphabet. -/
@[derive [has_mem (list α), has_singleton (list α), has_insert (list α), complete_boolean_algebra]]
def language (α) := set (list α)

namespace language

local attribute [reducible] language

/-- Zero language has no elements. -/
instance : has_zero (language α) := ⟨(∅ : set _)⟩
/-- `1 : language α` contains only one element `[]`. -/
instance : has_one (language α) := ⟨{[]}⟩

instance : inhabited (language α) := ⟨0⟩

/-- The sum of two languages is their union. -/
instance : has_add (language α) := ⟨set.union⟩

/-- The product of two languages `l` and `m` is the language made of the strings `x ++ y` where
`x ∈ l` and `y ∈ m`. -/
instance : has_mul (language α) := ⟨image2 (++)⟩

lemma zero_def : (0 : language α) = (∅ : set _) := rfl
lemma one_def : (1 : language α) = {[]} := rfl

lemma add_def (l m : language α) : l + m = l ∪ m := rfl
lemma mul_def (l m : language α) : l * m = image2 (++) l m := rfl

/-- The star of a language `L` is the set of all strings which can be written by concatenating
  strings from `L`. -/
def star (l : language α) : language α :=
{ x | ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l}

lemma star_def (l : language α) :
  l.star = { x | ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l} := rfl

@[simp] lemma not_mem_zero (x : list α) : x ∉ (0 : language α) := id
lemma nil_mem_one : [] ∈ (1 : language α) := mem_singleton _
@[simp] lemma mem_one (x : list α) : x ∈ (1 : language α) ↔ x = [] := iff.rfl
@[simp] lemma mem_add (l m : language α) (x : list α) : x ∈ l + m ↔ x ∈ l ∨ x ∈ m :=
by simp [add_def]
lemma mem_mul (l m : language α) (x : list α) : x ∈ l * m ↔ ∃ a b, a ∈ l ∧ b ∈ m ∧ a ++ b = x :=
by simp [mul_def]
lemma mem_star (l : language α) (x : list α) :
  x ∈ l.star ↔ ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l :=
iff.rfl

instance : semiring (language α) :=
{ add := (+),
  add_assoc := union_assoc,
  zero := 0,
  zero_add := empty_union,
  add_zero := union_empty,
  add_comm := union_comm,
  mul := (*),
  mul_assoc := λ _ _ _, image2_assoc append_assoc,
  zero_mul := λ _, image2_empty_left,
  mul_zero := λ _, image2_empty_right,
  one := 1,
  one_mul := λ l, by simp [mul_def, one_def],
  mul_one := λ l, by simp [mul_def, one_def],
  left_distrib := λ _ _ _, image2_union_right,
  right_distrib := λ _ _ _, image2_union_left }

@[simp] lemma add_self (l : language α) : l + l = l := sup_idem

lemma star_def_nonempty (l : language α) :
  l.star = {x | ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l ∧ y ≠ []} :=
begin
  ext x,
  split,
  { rintro ⟨S, rfl, h⟩,
    refine ⟨S.filter (λ l, ¬list.empty l), by simp, λ y hy, _⟩,
    rw [mem_filter, empty_iff_eq_nil] at hy,
    exact ⟨h y hy.1, hy.2⟩ },
  { rintro ⟨S, hx, h⟩,
    exact ⟨S, hx, λ y hy, (h y hy).1⟩ }
end

lemma le_mul_congr {l₁ l₂ m₁ m₂ : language α} : l₁ ≤ m₁ → l₂ ≤ m₂ → l₁ * l₂ ≤ m₁ * m₂ :=
begin
  intros h₁ h₂ x hx,
  simp only [mul_def, exists_and_distrib_left, mem_image2, image_prod] at hx ⊢,
  tauto
end

lemma le_add_congr {l₁ l₂ m₁ m₂ : language α} : l₁ ≤ m₁ → l₂ ≤ m₂ → l₁ + l₂ ≤ m₁ + m₂ := sup_le_sup

lemma mem_supr {ι : Sort v} {l : ι → language α} {x : list α} :
  x ∈ (⨆ i, l i) ↔ ∃ i, x ∈ l i :=
mem_Union

lemma supr_mul {ι : Sort v} (l : ι → language α) (m : language α) :
  (⨆ i, l i) * m = ⨆ i, l i * m :=
image2_Union_left _ _ _

lemma mul_supr {ι : Sort v} (l : ι → language α) (m : language α) :
  m * (⨆ i, l i) = ⨆ i, m * l i :=
image2_Union_right _ _ _

lemma supr_add {ι : Sort v} [nonempty ι] (l : ι → language α) (m : language α) :
  (⨆ i, l i) + m = ⨆ i, l i + m := supr_sup

lemma add_supr {ι : Sort v} [nonempty ι] (l : ι → language α) (m : language α) :
  m + (⨆ i, l i) = ⨆ i, m + l i := sup_supr

lemma mem_pow {l : language α} {x : list α} {n : ℕ} :
  x ∈ l ^ n ↔ ∃ S : list (list α), x = S.join ∧ S.length = n ∧ ∀ y ∈ S, y ∈ l :=
begin
  induction n with n ihn generalizing x,
  { simp only [mem_one, pow_zero, length_eq_zero],
    split,
    { rintro rfl, exact ⟨[], rfl, rfl, λ y h, h.elim⟩ },
    { rintro ⟨_, rfl, rfl, _⟩, refl } },
  { simp only [pow_succ, mem_mul, ihn],
    split,
    { rintro ⟨a, b, ha, ⟨S, rfl, rfl, hS⟩, rfl⟩,
      exact ⟨a :: S, rfl, rfl, forall_mem_cons.2 ⟨ha, hS⟩⟩ },
    { rintro ⟨_|⟨a, S⟩, rfl, hn, hS⟩; cases hn,
      rw forall_mem_cons at hS,
      exact ⟨a, _, hS.1, ⟨S, rfl, rfl, hS.2⟩, rfl⟩ } }
end

lemma star_eq_supr_pow (l : language α) : l.star = ⨆ i : ℕ, l ^ i :=
begin
  ext x,
  simp only [mem_star, mem_supr, mem_pow],
  split,
  { rintro ⟨S, rfl, hS⟩, exact ⟨_, S, rfl, rfl, hS⟩ },
  { rintro ⟨_, S, rfl, rfl, hS⟩, exact ⟨S, rfl, hS⟩ }
end

lemma mul_self_star_comm (l : language α) : l.star * l = l * l.star :=
by simp only [star_eq_supr_pow, mul_supr, supr_mul, ← pow_succ, ← pow_succ']

@[simp] lemma one_add_self_mul_star_eq_star (l : language α) : 1 + l * l.star = l.star :=
begin
  simp only [star_eq_supr_pow, mul_supr, ← pow_succ, ← pow_zero l],
  exact sup_supr_nat_succ _
end

@[simp] lemma one_add_star_mul_self_eq_star (l : language α) : 1 + l.star * l = l.star :=
by rw [mul_self_star_comm, one_add_self_mul_star_eq_star]

lemma star_mul_le_right_of_mul_le_right (l m : language α) : l * m ≤ m → l.star * m ≤ m :=
begin
  intro h,
  rw [star_eq_supr_pow, supr_mul],
  refine supr_le _,
  intro n,
  induction n with n ih,
  { simp },
  rw [pow_succ', mul_assoc (l^n) l m],
  exact le_trans (le_mul_congr le_rfl h) ih,
end

lemma star_mul_le_left_of_mul_le_left (l m : language α) : m * l ≤ m → m * l.star ≤ m :=
begin
  intro h,
  rw [star_eq_supr_pow, mul_supr],
  refine supr_le _,
  intro n,
  induction n with n ih,
  { simp },
  rw [pow_succ, ←mul_assoc m l (l^n)],
  exact le_trans (le_mul_congr h le_rfl) ih
end

end language


/-
Copyright (c) 2019 Tim Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baanen, Lu-Ming Zhang
-/
import algebra.regular.smul
import linear_algebra.matrix.adjugate
import linear_algebra.matrix.polynomial

/-!
# Nonsingular inverses

In this file, we define an inverse for square matrices of invertible determinant.

For matrices that are not square or not of full rank, there is a more general notion of
pseudoinverses which we do not consider here.

The definition of inverse used in this file is the adjugate divided by the determinant.
We show that dividing the adjugate by `det A` (if possible), giving a matrix `A⁻¹` (`nonsing_inv`),
will result in a multiplicative inverse to `A`.

Note that there are at least three different inverses in mathlib:

* `A⁻¹` (`has_inv.inv`): alone, this satisfies no properties, although it is usually used in
  conjunction with `group` or `group_with_zero`. On matrices, this is defined to be zero when no
  inverse exists.
* `⅟A` (`inv_of`): this is only available in the presence of `[invertible A]`, which guarantees an
  inverse exists.
* `ring.inverse A`: this is defined on any `monoid_with_zero`, and just like `⁻¹` on matrices, is
  defined to be zero when no inverse exists.

We start by working with `invertible`, and show the main results:

* `matrix.invertible_of_det_invertible`
* `matrix.det_invertible_of_invertible`
* `matrix.is_unit_iff_is_unit_det`
* `matrix.mul_eq_one_comm`

After this we define `matrix.has_inv` and show it matches `⅟A` and `ring.inverse A`.
The rest of the results in the file are then about `A⁻¹`

## References

  * https://en.wikipedia.org/wiki/Cramer's_rule#Finding_inverse_matrix

## Tags

matrix inverse, cramer, cramer's rule, adjugate
-/

namespace matrix
universes u v
variables {n : Type u} [decidable_eq n] [fintype n] {α : Type v} [comm_ring α]
open_locale matrix big_operators
open equiv equiv.perm finset

variables (A : matrix n n α) (B : matrix n n α)

/-! ### Matrices are `invertible` iff their determinants are -/

section invertible

/-- A copy of `inv_of_mul_self` using `⬝` not `*`. -/
protected lemma inv_of_mul_self [invertible A] : ⅟A ⬝ A = 1 := inv_of_mul_self A

/-- A copy of `mul_inv_of_self` using `⬝` not `*`. -/
protected lemma mul_inv_of_self [invertible A] : A ⬝ ⅟A = 1 := mul_inv_of_self A

/-- If `A.det` has a constructive inverse, produce one for `A`. -/
def invertible_of_det_invertible [invertible A.det] : invertible A :=
{ inv_of := ⅟A.det • A.adjugate,
  mul_inv_of_self :=
    by rw [mul_smul_comm, matrix.mul_eq_mul, mul_adjugate, smul_smul, inv_of_mul_self, one_smul],
  inv_of_mul_self :=
    by rw [smul_mul_assoc, matrix.mul_eq_mul, adjugate_mul, smul_smul, inv_of_mul_self, one_smul] }

lemma inv_of_eq [invertible A.det] [invertible A] : ⅟A = ⅟A.det • A.adjugate :=
by { letI := invertible_of_det_invertible A, convert (rfl : ⅟A = _) }

/-- `A.det` is invertible if `A` has a left inverse. -/
def det_invertible_of_left_inverse (h : B ⬝ A = 1) : invertible A.det :=
{ inv_of := B.det,
  mul_inv_of_self := by rw [mul_comm, ← det_mul, h, det_one],
  inv_of_mul_self := by rw [← det_mul, h, det_one] }

/-- `A.det` is invertible if `A` has a right inverse. -/
def det_invertible_of_right_inverse (h : A ⬝ B = 1) : invertible A.det :=
{ inv_of := B.det,
  mul_inv_of_self := by rw [← det_mul, h, det_one],
  inv_of_mul_self := by rw [mul_comm, ← det_mul, h, det_one] }

/-- If `A` has a constructive inverse, produce one for `A.det`. -/
def det_invertible_of_invertible [invertible A] : invertible A.det :=
det_invertible_of_left_inverse A (⅟A) (inv_of_mul_self _)

lemma det_inv_of [invertible A] [invertible A.det] : (⅟A).det = ⅟A.det :=
by { letI := det_invertible_of_invertible A, convert (rfl : _ = ⅟A.det) }

/-- Together `matrix.det_invertible_of_invertible` and `matrix.invertible_of_det_invertible` form an
equivalence, although both sides of the equiv are subsingleton anyway. -/
@[simps]
def invertible_equiv_det_invertible : invertible A ≃ invertible A.det :=
{ to_fun := @det_invertible_of_invertible _ _ _ _ _ A,
  inv_fun := @invertible_of_det_invertible _ _ _ _ _ A,
  left_inv := λ _, subsingleton.elim _ _,
  right_inv := λ _, subsingleton.elim _ _ }

variables {A B}

lemma mul_eq_one_comm : A ⬝ B = 1 ↔ B ⬝ A = 1 :=
suffices ∀ A B, A ⬝ B = 1 → B ⬝ A = 1, from ⟨this A B, this B A⟩, assume A B h,
begin
  letI : invertible B.det := det_invertible_of_left_inverse _ _ h,
  letI : invertible B := invertible_of_det_invertible B,
  calc B ⬝ A = (B ⬝ A) ⬝ (B ⬝ ⅟B) : by rw [matrix.mul_inv_of_self, matrix.mul_one]
        ... = B ⬝ ((A ⬝ B) ⬝ ⅟B) : by simp only [matrix.mul_assoc]
        ... = B ⬝ ⅟B : by rw [h, matrix.one_mul]
        ... = 1 : matrix.mul_inv_of_self B,
end

variables (A B)

/-- We can construct an instance of invertible A if A has a left inverse. -/
def invertible_of_left_inverse (h : B ⬝ A = 1) : invertible A :=
⟨B, h, mul_eq_one_comm.mp h⟩

/-- We can construct an instance of invertible A if A has a right inverse. -/
def invertible_of_right_inverse (h : A ⬝ B = 1) : invertible A :=
⟨B, mul_eq_one_comm.mp h, h⟩

/-- Given a proof that `A.det` has a constructive inverse, lift `A` to `units (matrix n n α)`-/
def unit_of_det_invertible [invertible A.det] : units (matrix n n α) :=
@unit_of_invertible _ _ A (invertible_of_det_invertible A)

/-- When lowered to a prop, `matrix.invertible_equiv_det_invertible` forms an `iff`. -/
lemma is_unit_iff_is_unit_det : is_unit A ↔ is_unit A.det :=
begin
  split; rintros ⟨x, hx⟩; refine @is_unit_of_invertible _ _ _ (id _),
  { haveI : invertible A := hx.rec x.invertible,
    apply det_invertible_of_invertible, },
  { haveI : invertible A.det := hx.rec x.invertible,
    apply invertible_of_det_invertible, },
end

/-! #### Variants of the statements above with `is_unit`-/

lemma is_unit_det_of_invertible [invertible A] : is_unit A.det :=
@is_unit_of_invertible _ _ _ (det_invertible_of_invertible A)

variables {A B}

lemma is_unit_det_of_left_inverse (h : B ⬝ A = 1) : is_unit A.det :=
@is_unit_of_invertible _ _ _ (det_invertible_of_left_inverse _ _ h)

lemma is_unit_det_of_right_inverse (h : A ⬝ B = 1) : is_unit A.det :=
@is_unit_of_invertible _ _ _ (det_invertible_of_right_inverse _ _ h)

lemma det_ne_zero_of_left_inverse [nontrivial α] (h : B ⬝ A = 1) : A.det ≠ 0 :=
(is_unit_det_of_left_inverse h).ne_zero

lemma det_ne_zero_of_right_inverse [nontrivial α] (h : A ⬝ B = 1) : A.det ≠ 0 :=
(is_unit_det_of_right_inverse h).ne_zero

end invertible

open_locale classical

lemma is_unit_det_transpose (h : is_unit A.det) : is_unit Aᵀ.det :=
by { rw det_transpose, exact h, }

/-! ### A noncomputable `has_inv` instance  -/

/-- The inverse of a square matrix, when it is invertible (and zero otherwise).-/
noncomputable instance : has_inv (matrix n n α) := ⟨λ A, ring.inverse A.det • A.adjugate⟩

lemma inv_def (A : matrix n n α) : A⁻¹ = ring.inverse A.det • A.adjugate := rfl

lemma nonsing_inv_apply_not_is_unit (h : ¬ is_unit A.det) :
  A⁻¹ = 0 :=
by rw [inv_def, ring.inverse_non_unit _ h, zero_smul]

lemma nonsing_inv_apply (h : is_unit A.det) :
  A⁻¹ = (↑h.unit⁻¹ : α) • A.adjugate :=
by rw [inv_def, ←ring.inverse_unit h.unit, is_unit.unit_spec]

/-- The nonsingular inverse is the same as `inv_of` when `A` is invertible. -/
@[simp] lemma inv_of_eq_nonsing_inv [invertible A] : ⅟A = A⁻¹ :=
begin
  letI := det_invertible_of_invertible A,
  rw [inv_def, ring.inverse_invertible, inv_of_eq],
end

/-- The nonsingular inverse is the same as the general `ring.inverse`. -/
lemma nonsing_inv_eq_ring_inverse : A⁻¹ = ring.inverse A :=
begin
  by_cases h_det : is_unit A.det,
  { casesI (A.is_unit_iff_is_unit_det.mpr h_det).nonempty_invertible,
    rw [←inv_of_eq_nonsing_inv, ring.inverse_invertible], },
  { have h := mt A.is_unit_iff_is_unit_det.mp h_det,
    rw [ring.inverse_non_unit _ h, nonsing_inv_apply_not_is_unit A h_det], },
end

lemma transpose_nonsing_inv : (A⁻¹)ᵀ = (Aᵀ)⁻¹ :=
by rw [inv_def, inv_def, transpose_smul, det_transpose, adjugate_transpose]

lemma conj_transpose_nonsing_inv [star_ring α] : (A⁻¹)ᴴ = (Aᴴ)⁻¹ :=
by rw [inv_def, inv_def, conj_transpose_smul, det_conj_transpose, adjugate_conj_transpose,
       ring.inverse_star]

/-- The `nonsing_inv` of `A` is a right inverse. -/
@[simp] lemma mul_nonsing_inv (h : is_unit A.det) : A ⬝ A⁻¹ = 1 :=
begin
  casesI (A.is_unit_iff_is_unit_det.mpr h).nonempty_invertible,
  rw [←inv_of_eq_nonsing_inv, matrix.mul_inv_of_self],
end

/-- The `nonsing_inv` of `A` is a left inverse. -/
@[simp] lemma nonsing_inv_mul (h : is_unit A.det) : A⁻¹ ⬝ A = 1 :=
begin
  casesI (A.is_unit_iff_is_unit_det.mpr h).nonempty_invertible,
  rw [←inv_of_eq_nonsing_inv, matrix.inv_of_mul_self],
end

@[simp] lemma mul_inv_of_invertible [invertible A] : A ⬝ A⁻¹ = 1 :=
mul_nonsing_inv A (is_unit_det_of_invertible A)

@[simp] lemma inv_mul_of_invertible [invertible A] : A⁻¹ ⬝ A = 1 :=
nonsing_inv_mul A (is_unit_det_of_invertible A)

lemma nonsing_inv_cancel_or_zero :
  (A⁻¹ ⬝ A = 1 ∧ A ⬝ A⁻¹ = 1) ∨ A⁻¹ = 0 :=
begin
  by_cases h : is_unit A.det,
  { exact or.inl ⟨nonsing_inv_mul _ h, mul_nonsing_inv _ h⟩ },
  { exact or.inr (nonsing_inv_apply_not_is_unit _ h) }
end

lemma det_nonsing_inv_mul_det (h : is_unit A.det) : A⁻¹.det * A.det = 1 :=
by rw [←det_mul, A.nonsing_inv_mul h, det_one]

@[simp] lemma det_nonsing_inv : A⁻¹.det = ring.inverse A.det :=
begin
  by_cases h : is_unit A.det,
  { casesI h.nonempty_invertible, letI := invertible_of_det_invertible A,
    rw [ring.inverse_invertible, ←inv_of_eq_nonsing_inv, det_inv_of] },
  casesI is_empty_or_nonempty n,
  { rw [det_is_empty, det_is_empty, ring.inverse_one] },
  { rw [ring.inverse_non_unit _ h, nonsing_inv_apply_not_is_unit _ h, det_zero ‹_›] },
end

lemma is_unit_nonsing_inv_det (h : is_unit A.det) : is_unit A⁻¹.det :=
is_unit_of_mul_eq_one _ _ (A.det_nonsing_inv_mul_det h)

@[simp] lemma nonsing_inv_nonsing_inv (h : is_unit A.det) : (A⁻¹)⁻¹ = A :=
calc (A⁻¹)⁻¹ = 1 ⬝ (A⁻¹)⁻¹        : by rw matrix.one_mul
         ... = A ⬝ A⁻¹ ⬝ (A⁻¹)⁻¹  : by rw A.mul_nonsing_inv h
         ... = A                  : by { rw [matrix.mul_assoc,
                                         (A⁻¹).mul_nonsing_inv (A.is_unit_nonsing_inv_det h),
                                         matrix.mul_one], }

lemma is_unit_nonsing_inv_det_iff {A : matrix n n α} :
  is_unit A⁻¹.det ↔ is_unit A.det :=
by rw [matrix.det_nonsing_inv, is_unit_ring_inverse]

/- `is_unit.invertible` lifts the proposition `is_unit A` to a constructive inverse of `A`. -/

/-- A version of `matrix.invertible_of_det_invertible` with the inverse defeq to `A⁻¹` that is
therefore noncomputable. -/
noncomputable def invertible_of_is_unit_det (h : is_unit A.det) : invertible A :=
⟨A⁻¹, nonsing_inv_mul A h, mul_nonsing_inv A h⟩

/-- A version of `matrix.units_of_det_invertible` with the inverse defeq to `A⁻¹` that is therefore
noncomputable. -/
noncomputable def nonsing_inv_unit (h : is_unit A.det) : units (matrix n n α) :=
@unit_of_invertible _ _ _ (invertible_of_is_unit_det A h)

lemma unit_of_det_invertible_eq_nonsing_inv_unit [invertible A.det] :
  unit_of_det_invertible A = nonsing_inv_unit A (is_unit_of_invertible _) :=
by { ext, refl }

variables {A} {B}

/-- If matrix A is left invertible, then its inverse equals its left inverse. -/
lemma inv_eq_left_inv (h : B ⬝ A = 1) : A⁻¹ = B :=
begin
  letI := invertible_of_left_inverse _ _ h,
  exact inv_of_eq_nonsing_inv A ▸ inv_of_eq_left_inv h,
end

/-- If matrix A is right invertible, then its inverse equals its right inverse. -/
lemma inv_eq_right_inv (h : A ⬝ B = 1) : A⁻¹ = B :=
inv_eq_left_inv (mul_eq_one_comm.2 h)

section inv_eq_inv

variables {C : matrix n n α}

/-- The left inverse of matrix A is unique when existing. -/

/-- The right inverse of matrix A is unique when existing. -/
lemma right_inv_eq_right_inv (h : A ⬝ B = 1) (g : A ⬝ C = 1) : B = C :=
by rw [←inv_eq_right_inv h, ←inv_eq_right_inv g]

/-- The right inverse of matrix A equals the left inverse of A when they exist. -/
lemma right_inv_eq_left_inv (h : A ⬝ B = 1) (g : C ⬝ A = 1) : B = C :=
by rw [←inv_eq_right_inv h, ←inv_eq_left_inv g]

lemma inv_inj (h : A⁻¹ = B⁻¹) (h' : is_unit A.det) : A = B :=
begin
  refine left_inv_eq_left_inv (mul_nonsing_inv _ h') _,
  rw h,
  refine mul_nonsing_inv _ _,
  rwa [←is_unit_nonsing_inv_det_iff, ←h, is_unit_nonsing_inv_det_iff]
end

end inv_eq_inv

variable (A)

@[simp] lemma inv_zero : (0 : matrix n n α)⁻¹ = 0 :=
begin
  casesI (subsingleton_or_nontrivial α) with ht ht,
  { simp },
  cases (fintype.card n).zero_le.eq_or_lt with hc hc,
  { rw [eq_comm, fintype.card_eq_zero_iff] at hc,
    haveI := hc,
    ext i,
    exact (is_empty.false i).elim },
  { have hn : nonempty n := fintype.card_pos_iff.mp hc,
    refine nonsing_inv_apply_not_is_unit _ _,
    simp [hn] },
end

@[simp] lemma inv_one : (1 : matrix n n α)⁻¹ = 1 :=
inv_eq_left_inv (by simp)

lemma inv_smul (k : α) [invertible k] (h : is_unit A.det) : (k • A)⁻¹ = ⅟k • A⁻¹ :=
inv_eq_left_inv (by simp [h, smul_smul])

lemma inv_smul' (k : units α) (h : is_unit A.det) : (k • A)⁻¹ = k⁻¹ • A⁻¹ :=
inv_eq_left_inv (by simp [h, smul_smul])

lemma inv_adjugate (A : matrix n n α) (h : is_unit A.det) :
  (adjugate A)⁻¹ = h.unit⁻¹ • A :=
begin
  refine inv_eq_left_inv _,
  rw [smul_mul, mul_adjugate, units.smul_def, smul_smul, h.coe_inv_mul, one_smul]
end

@[simp] lemma inv_inv_inv (A : matrix n n α) : A⁻¹⁻¹⁻¹ = A⁻¹ :=
begin
  by_cases h : is_unit A.det,
  { rw [nonsing_inv_nonsing_inv _ h] },
  { simp [nonsing_inv_apply_not_is_unit _ h] }
end

lemma mul_inv_rev (A B : matrix n n α) : (A ⬝ B)⁻¹ = B⁻¹ ⬝ A⁻¹ :=
begin
  simp only [inv_def],
  rw [matrix.smul_mul, matrix.mul_smul, smul_smul, det_mul, adjugate_mul_distrib,
    ring.mul_inverse_rev],
end

/-- One form of **Cramer's rule**. See `matrix.mul_vec_cramer` for a stronger form. -/
@[simp] lemma det_smul_inv_mul_vec_eq_cramer (A : matrix n n α) (b : n → α) (h : is_unit A.det) :
  A.det • A⁻¹.mul_vec b = cramer A b :=
begin
  rw [cramer_eq_adjugate_mul_vec, A.nonsing_inv_apply h, ← smul_mul_vec_assoc,
      smul_smul, h.mul_coe_inv, one_smul]
end

/-- One form of **Cramer's rule**. See `matrix.mul_vec_cramer` for a stronger form. -/
@[simp] lemma det_smul_inv_vec_mul_eq_cramer_transpose
  (A : matrix n n α) (b : n → α) (h : is_unit A.det) :
  A.det • A⁻¹.vec_mul b = cramer Aᵀ b :=
by rw [← (A⁻¹).transpose_transpose, vec_mul_transpose, transpose_nonsing_inv, ← det_transpose,
    Aᵀ.det_smul_inv_mul_vec_eq_cramer _ (is_unit_det_transpose A h)]

end matrix


/-
Copyright (c) 2020 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import data.polynomial.degree.trailing_degree
import data.polynomial.erase_lead
import data.polynomial.eval

/-!
# Reverse of a univariate polynomial

The main definition is `reverse`.  Applying `reverse` to a polynomial `f : R[X]` produces
the polynomial with a reversed list of coefficients, equivalent to `X^f.nat_degree * f(1/X)`.

The main result is that `reverse (f * g) = reverse f * reverse g`, provided the leading
coefficients of `f` and `g` do not multiply to zero.
-/

namespace polynomial

open polynomial finsupp finset
open_locale classical polynomial

section semiring

variables {R : Type*} [semiring R] {f : R[X]}

/-- If `i ≤ N`, then `rev_at_fun N i` returns `N - i`, otherwise it returns `i`.
This is the map used by the embedding `rev_at`.
-/
def rev_at_fun (N i : ℕ) : ℕ := ite (i ≤ N) (N-i) i

lemma rev_at_fun_invol {N i : ℕ} : rev_at_fun N (rev_at_fun N i) = i :=
begin
  unfold rev_at_fun,
  split_ifs with h j,
  { exact tsub_tsub_cancel_of_le h, },
  { exfalso,
    apply j,
    exact nat.sub_le N i, },
  { refl, },
end

lemma rev_at_fun_inj {N : ℕ} : function.injective (rev_at_fun N) :=
begin
  intros a b hab,
  rw [← @rev_at_fun_invol N a, hab, rev_at_fun_invol],
end

/-- If `i ≤ N`, then `rev_at N i` returns `N - i`, otherwise it returns `i`.
Essentially, this embedding is only used for `i ≤ N`.
The advantage of `rev_at N i` over `N - i` is that `rev_at` is an involution.
-/
def rev_at (N : ℕ) : function.embedding ℕ ℕ :=
{ to_fun := λ i , (ite (i ≤ N) (N-i) i),
  inj' := rev_at_fun_inj }

/-- We prefer to use the bundled `rev_at` over unbundled `rev_at_fun`. -/
@[simp] lemma rev_at_fun_eq (N i : ℕ) : rev_at_fun N i = rev_at N i := rfl

@[simp] lemma rev_at_invol {N i : ℕ} : (rev_at N) (rev_at N i) = i :=
rev_at_fun_invol

@[simp] lemma rev_at_le {N i : ℕ} (H : i ≤ N) : rev_at N i = N - i :=
if_pos H

lemma rev_at_add {N O n o : ℕ} (hn : n ≤ N) (ho : o ≤ O) :
  rev_at (N + O) (n + o) = rev_at N n + rev_at O o :=
begin
  rcases nat.le.dest hn with ⟨n', rfl⟩,
  rcases nat.le.dest ho with ⟨o', rfl⟩,
  repeat { rw rev_at_le (le_add_right rfl.le) },
  rw [add_assoc, add_left_comm n' o, ← add_assoc, rev_at_le (le_add_right rfl.le)],
  repeat {rw add_tsub_cancel_left},
end

@[simp] lemma rev_at_zero (N : ℕ) : rev_at N 0 = N :=
by simp [rev_at]

/-- `reflect N f` is the polynomial such that `(reflect N f).coeff i = f.coeff (rev_at N i)`.
In other words, the terms with exponent `[0, ..., N]` now have exponent `[N, ..., 0]`.

In practice, `reflect` is only used when `N` is at least as large as the degree of `f`.

Eventually, it will be used with `N` exactly equal to the degree of `f`.  -/
noncomputable def reflect (N : ℕ) : R[X] → R[X]
| ⟨f⟩ := ⟨finsupp.emb_domain (rev_at N) f⟩

lemma reflect_support (N : ℕ) (f : R[X]) :
  (reflect N f).support = image (rev_at N) f.support :=
begin
  rcases f,
  ext1,
  rw [reflect, mem_image, support, support, support_emb_domain, mem_map],
end

@[simp] lemma coeff_reflect (N : ℕ) (f : R[X]) (i : ℕ) :
  coeff (reflect N f) i = f.coeff (rev_at N i) :=
begin
  rcases f,
  simp only [reflect, coeff],
  calc finsupp.emb_domain (rev_at N) f i
      = finsupp.emb_domain (rev_at N) f (rev_at N (rev_at N i)) : by rw rev_at_invol
  ... = f (rev_at N i) : finsupp.emb_domain_apply _ _ _
end

@[simp] lemma reflect_zero {N : ℕ} : reflect N (0 : R[X]) = 0 := rfl

@[simp] lemma reflect_eq_zero_iff {N : ℕ} {f : R[X]} :
  reflect N (f : R[X]) = 0 ↔ f = 0 :=
by { rcases f, simp [reflect] }

@[simp] lemma reflect_add (f g : R[X]) (N : ℕ) :
  reflect N (f + g) = reflect N f + reflect N g :=
by { ext, simp only [coeff_add, coeff_reflect], }

@[simp] lemma reflect_C_mul (f : R[X]) (r : R) (N : ℕ) :
  reflect N (C r * f) = C r * (reflect N f) :=
by { ext, simp only [coeff_reflect, coeff_C_mul], }

@[simp] lemma reflect_C_mul_X_pow (N n : ℕ) {c : R} :
  reflect N (C c * X ^ n) = C c * X ^ (rev_at N n) :=
begin
  ext,
  rw [reflect_C_mul, coeff_C_mul, coeff_C_mul, coeff_X_pow, coeff_reflect],
  split_ifs with h j,
  { rw [h, rev_at_invol, coeff_X_pow_self], },
  { rw [not_mem_support_iff.mp],
    intro a,
    rw [← one_mul (X ^ n), ← C_1] at a,
    apply h,
    rw [← (mem_support_C_mul_X_pow a), rev_at_invol], },
end

@[simp] lemma reflect_C (r : R) (N : ℕ) : reflect N (C r) = C r * X ^ N :=
by conv_lhs { rw [← mul_one (C r), ← pow_zero X, reflect_C_mul_X_pow, rev_at_zero] }

@[simp] lemma reflect_monomial (N n : ℕ) : reflect N ((X : R[X]) ^ n) = X ^ (rev_at N n) :=
by rw [← one_mul (X ^ n), ← one_mul (X ^ (rev_at N n)), ← C_1, reflect_C_mul_X_pow]

lemma reflect_mul_induction (cf cg : ℕ) :
  ∀ N O : ℕ, ∀ f g : R[X],
  f.support.card ≤ cf.succ → g.support.card ≤ cg.succ → f.nat_degree ≤ N → g.nat_degree ≤ O →
  (reflect (N + O) (f * g)) = (reflect N f) * (reflect O g) :=
begin
  induction cf with cf hcf,
  --first induction (left): base case
  { induction cg with cg hcg,
    -- second induction (right): base case
    { intros N O f g Cf Cg Nf Og,
      rw [← C_mul_X_pow_eq_self Cf, ← C_mul_X_pow_eq_self Cg],
      simp_rw [mul_assoc, X_pow_mul, mul_assoc, ← pow_add (X : R[X]), reflect_C_mul,
        reflect_monomial, add_comm, rev_at_add Nf Og, mul_assoc, X_pow_mul, mul_assoc,
        ← pow_add (X : R[X]), add_comm], },
    -- second induction (right): induction step
    { intros N O f g Cf Cg Nf Og,
      by_cases g0 : g = 0,
      { rw [g0, reflect_zero, mul_zero, mul_zero, reflect_zero], },

      rw [← erase_lead_add_C_mul_X_pow g, mul_add, reflect_add, reflect_add, mul_add, hcg, hcg];
        try { assumption },
      { exact le_add_left card_support_C_mul_X_pow_le_one },
      { exact (le_trans (nat_degree_C_mul_X_pow_le g.leading_coeff g.nat_degree) Og) },
      { exact nat.lt_succ_iff.mp (gt_of_ge_of_gt Cg (erase_lead_support_card_lt g0)) },
      { exact le_trans erase_lead_nat_degree_le_aux Og } } },
  --first induction (left): induction step
  { intros N O f g Cf Cg Nf Og,
    by_cases f0 : f = 0,
    { rw [f0, reflect_zero, zero_mul, zero_mul, reflect_zero], },

    rw [← erase_lead_add_C_mul_X_pow f, add_mul, reflect_add, reflect_add, add_mul, hcf, hcf];
       try { assumption },
    { exact le_add_left card_support_C_mul_X_pow_le_one },
    { exact (le_trans (nat_degree_C_mul_X_pow_le f.leading_coeff f.nat_degree) Nf) },
    { exact nat.lt_succ_iff.mp (gt_of_ge_of_gt Cf (erase_lead_support_card_lt f0)) },
    { exact (le_trans erase_lead_nat_degree_le_aux Nf) } }
end

@[simp] theorem reflect_mul
  (f g : R[X]) {F G : ℕ} (Ff : f.nat_degree ≤ F) (Gg : g.nat_degree ≤ G) :
  reflect (F + G) (f * g) = reflect F f * reflect G g :=
reflect_mul_induction _ _ F G f g f.support.card.le_succ g.support.card.le_succ Ff Gg

section eval₂

variables {S : Type*} [comm_semiring S]

lemma eval₂_reflect_mul_pow (i : R →+* S) (x : S) [invertible x] (N : ℕ) (f : R[X])
  (hf : f.nat_degree ≤ N) : eval₂ i (⅟x) (reflect N f) * x ^ N = eval₂ i x f :=
begin
  refine induction_with_nat_degree_le (λ f, eval₂ i (⅟x) (reflect N f) * x ^ N = eval₂ i x f)
    _ _ _ _ f hf,
  { simp },
  { intros n r hr0 hnN,
    simp only [rev_at_le hnN, reflect_C_mul_X_pow, eval₂_X_pow, eval₂_C, eval₂_mul],
    conv in (x ^ N) { rw [← nat.sub_add_cancel hnN] },
    rw [pow_add, ← mul_assoc, mul_assoc (i r), ← mul_pow, inv_of_mul_self, one_pow, mul_one] },
  { intros,
    simp [*, add_mul] }
end

lemma eval₂_reflect_eq_zero_iff (i : R →+* S) (x : S) [invertible x] (N : ℕ) (f : R[X])
  (hf : f.nat_degree ≤ N) : eval₂ i (⅟x) (reflect N f) = 0 ↔ eval₂ i x f = 0 :=
begin
  conv_rhs { rw [← eval₂_reflect_mul_pow i x N f hf] },
  split,
  { intro h, rw [h, zero_mul] },
  { intro h, rw [← mul_one (eval₂ i (⅟x) _), ← one_pow N, ← mul_inv_of_self x,
      mul_pow, ← mul_assoc, h, zero_mul] }
end

end eval₂

/-- The reverse of a polynomial f is the polynomial obtained by "reading f backwards".
Even though this is not the actual definition, reverse f = f (1/X) * X ^ f.nat_degree. -/
noncomputable def reverse (f : R[X]) : R[X] := reflect f.nat_degree f

lemma coeff_reverse (f : R[X]) (n : ℕ) :
  f.reverse.coeff n = f.coeff (rev_at f.nat_degree n) :=
by rw [reverse, coeff_reflect]

@[simp] lemma coeff_zero_reverse (f : R[X]) : coeff (reverse f) 0 = leading_coeff f :=
by rw [coeff_reverse, rev_at_le (zero_le f.nat_degree), tsub_zero, leading_coeff]

@[simp] lemma reverse_zero : reverse (0 : R[X]) = 0 := rfl

@[simp] lemma reverse_eq_zero : f.reverse = 0 ↔ f = 0 :=
by simp [reverse]

lemma reverse_nat_degree_le (f : R[X]) : f.reverse.nat_degree ≤ f.nat_degree :=
begin
  rw [nat_degree_le_iff_degree_le, degree_le_iff_coeff_zero],
  intros n hn,
  rw with_bot.coe_lt_coe at hn,
  rw [coeff_reverse, rev_at, function.embedding.coe_fn_mk,
      if_neg (not_le_of_gt hn), coeff_eq_zero_of_nat_degree_lt hn],
end

lemma nat_degree_eq_reverse_nat_degree_add_nat_trailing_degree (f : R[X]) :
  f.nat_degree = f.reverse.nat_degree + f.nat_trailing_degree :=
begin
  by_cases hf : f = 0,
  { rw [hf, reverse_zero, nat_degree_zero, nat_trailing_degree_zero] },
  apply le_antisymm,
  { refine tsub_le_iff_right.mp _,
    apply le_nat_degree_of_ne_zero,
    rw [reverse, coeff_reflect, ←rev_at_le f.nat_trailing_degree_le_nat_degree, rev_at_invol],
    exact trailing_coeff_nonzero_iff_nonzero.mpr hf },
  { rw ← le_tsub_iff_left f.reverse_nat_degree_le,
    apply nat_trailing_degree_le_of_ne_zero,
    have key := mt leading_coeff_eq_zero.mp (mt reverse_eq_zero.mp hf),
    rwa [leading_coeff, coeff_reverse, rev_at_le f.reverse_nat_degree_le] at key },
end

lemma reverse_nat_degree (f : R[X]) :
  f.reverse.nat_degree = f.nat_degree - f.nat_trailing_degree :=
by rw [f.nat_degree_eq_reverse_nat_degree_add_nat_trailing_degree, add_tsub_cancel_right]

lemma reverse_leading_coeff (f : R[X]) : f.reverse.leading_coeff = f.trailing_coeff :=
by rw [leading_coeff, reverse_nat_degree, ←rev_at_le f.nat_trailing_degree_le_nat_degree,
  coeff_reverse, rev_at_invol, trailing_coeff]

lemma reverse_nat_trailing_degree  (f : R[X]) : f.reverse.nat_trailing_degree = 0 :=
begin
  by_cases hf : f = 0,
  { rw [hf, reverse_zero, nat_trailing_degree_zero] },
  { rw ← nat.le_zero_iff,
    apply nat_trailing_degree_le_of_ne_zero,
    rw [coeff_zero_reverse],
    exact mt leading_coeff_eq_zero.mp hf },
end

theorem reverse_mul {f g : R[X]} (fg : f.leading_coeff * g.leading_coeff ≠ 0) :
 reverse (f * g) = reverse f * reverse g :=
begin
  unfold reverse,
  rw [nat_degree_mul' fg, reflect_mul  f g rfl.le rfl.le],
end

@[simp] lemma reverse_mul_of_domain {R : Type*} [ring R] [is_domain R] (f g : R[X]) :
  reverse (f * g) = reverse f * reverse g :=
begin
  by_cases f0 : f=0,
  { simp only [f0, zero_mul, reverse_zero], },
  by_cases g0 : g=0,
  { rw [g0, mul_zero, reverse_zero, mul_zero], },
  simp [reverse_mul, *],
end

lemma trailing_coeff_mul {R : Type*} [ring R] [is_domain R] (p q : R[X]) :
  (p * q).trailing_coeff = p.trailing_coeff * q.trailing_coeff :=
by rw [←reverse_leading_coeff, reverse_mul_of_domain, leading_coeff_mul,
  reverse_leading_coeff, reverse_leading_coeff]

@[simp] lemma coeff_one_reverse (f : R[X]) : coeff (reverse f) 1 = next_coeff f :=
begin
  rw [coeff_reverse, next_coeff],
  split_ifs with hf,
  { have : coeff f 1 = 0 := coeff_eq_zero_of_nat_degree_lt (by simp only [hf, zero_lt_one]),
    simp [*, rev_at] },
  { rw rev_at_le,
    exact nat.succ_le_iff.2 (pos_iff_ne_zero.2 hf) }
end

section eval₂
variables {S : Type*} [comm_semiring S]

lemma eval₂_reverse_mul_pow (i : R →+* S) (x : S) [invertible x] (f : R[X]) :
  eval₂ i (⅟x) (reverse f) * x ^ f.nat_degree = eval₂ i x f :=
eval₂_reflect_mul_pow i _ _ f le_rfl

@[simp] lemma eval₂_reverse_eq_zero_iff (i : R →+* S) (x : S) [invertible x] (f : R[X]) :
  eval₂ i (⅟x) (reverse f) = 0 ↔ eval₂ i x f = 0 :=
eval₂_reflect_eq_zero_iff i x _ _ le_rfl

end eval₂

end semiring

section ring

variables {R : Type*} [ring R]

@[simp] lemma reflect_neg (f : R[X]) (N : ℕ) :
  reflect N (- f) = - reflect N f :=
by rw [neg_eq_neg_one_mul, ←C_1, ←C_neg, reflect_C_mul, C_neg, C_1, ←neg_eq_neg_one_mul]

@[simp] lemma reflect_sub (f g : R[X]) (N : ℕ) :
  reflect N (f - g) = reflect N f - reflect N g :=
by rw [sub_eq_add_neg, sub_eq_add_neg, reflect_add, reflect_neg]

@[simp] lemma reverse_neg (f : R[X]) :
  reverse (- f) = - reverse f :=
by rw [reverse, reverse, reflect_neg, nat_degree_neg]

end ring

end polynomial


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.degree.definitions
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Cancel the leading terms of two polynomials

## Definition

* `cancel_leads p q`: the polynomial formed by multiplying `p` and `q` by monomials so that they
  have the same leading term, and then subtracting.

## Main Results
The degree of `cancel_leads` is less than that of the larger of the two polynomials being cancelled.
Thus it is useful for induction or minimal-degree arguments.
-/

namespace polynomial

/-- `cancel_leads p q` is formed by multiplying `p` and `q` by monomials so that they
  have the same leading term, and then subtracting. -/
def cancel_leads {R : Type u_1} [comm_ring R] (p : polynomial R) (q : polynomial R) : polynomial R :=
  coe_fn C (leading_coeff p) * X ^ (nat_degree p - nat_degree q) * q -
    coe_fn C (leading_coeff q) * X ^ (nat_degree q - nat_degree p) * p

@[simp] theorem neg_cancel_leads {R : Type u_1} [comm_ring R] {p : polynomial R} {q : polynomial R} : -cancel_leads p q = cancel_leads q p :=
  neg_sub (coe_fn C (leading_coeff p) * X ^ (nat_degree p - nat_degree q) * q)
    (coe_fn C (leading_coeff q) * X ^ (nat_degree q - nat_degree p) * p)

theorem dvd_cancel_leads_of_dvd_of_dvd {R : Type u_1} [comm_ring R] {p : polynomial R} {q : polynomial R} {r : polynomial R} (pq : p ∣ q) (pr : p ∣ r) : p ∣ cancel_leads q r :=
  dvd_sub (dvd.trans pr (dvd.intro_left (coe_fn C (leading_coeff q) * X ^ (nat_degree q - nat_degree r)) rfl))
    (dvd.trans pq (dvd.intro_left (coe_fn C (leading_coeff r) * X ^ (nat_degree r - nat_degree q)) rfl))

theorem nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree {R : Type u_1} [integral_domain R] {p : polynomial R} {q : polynomial R} (h : nat_degree p ≤ nat_degree q) (hq : 0 < nat_degree q) : nat_degree (cancel_leads p q) < nat_degree q := sorry


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

! This file was ported from Lean 3 source module algebra.linear_recurrence
! leanprover-community/mathlib commit 85d9f2189d9489f9983c0d01536575b0233bd305
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.Eval
import Mathbin.LinearAlgebra.Dimension

/-!
# Linear recurrence

Informally, a "linear recurrence" is an assertion of the form
`∀ n : ℕ, u (n + d) = a 0 * u n + a 1 * u (n+1) + ... + a (d-1) * u (n+d-1)`,
where `u` is a sequence, `d` is the *order* of the recurrence and the `a i`
are its *coefficients*.

In this file, we define the structure `linear_recurrence` so that
`linear_recurrence.mk d a` represents the above relation, and we call
a sequence `u` which verifies it a *solution* of the linear recurrence.

We prove a few basic lemmas about this concept, such as :

* the space of solutions is a submodule of `(ℕ → α)` (i.e a vector space if `α`
  is a field)
* the function that maps a solution `u` to its first `d` terms builds a `linear_equiv`
  between the solution space and `fin d → α`, aka `α ^ d`. As a consequence, two
  solutions are equal if and only if their first `d` terms are equals.
* a geometric sequence `q ^ n` is solution iff `q` is a root of a particular polynomial,
  which we call the *characteristic polynomial* of the recurrence

Of course, although we can inductively generate solutions (cf `mk_sol`), the
interesting part would be to determinate closed-forms for the solutions.
This is currently *not implemented*, as we are waiting for definition and
properties of eigenvalues and eigenvectors.

-/

noncomputable section

open Finset

open BigOperators Polynomial

/-- A "linear recurrence relation" over a commutative semiring is given by its
  order `n` and `n` coefficients. -/
structure LinearRecurrence (α : Type _) [CommSemiring α] where
  order : ℕ
  coeffs : Fin order → α
#align linear_recurrence LinearRecurrence

instance (α : Type _) [CommSemiring α] : Inhabited (LinearRecurrence α) :=
  ⟨⟨0, default⟩⟩

namespace LinearRecurrence

section CommSemiring

variable {α : Type _} [CommSemiring α] (E : LinearRecurrence α)

/-- We say that a sequence `u` is solution of `linear_recurrence order coeffs` when we have
  `u (n + order) = ∑ i : fin order, coeffs i * u (n + i)` for any `n`. -/
def IsSolution (u : ℕ → α) :=
  ∀ n, u (n + E.order) = ∑ i, E.coeffs i * u (n + i)
#align linear_recurrence.is_solution LinearRecurrence.IsSolution

/-- A solution of a `linear_recurrence` which satisfies certain initial conditions.
  We will prove this is the only such solution. -/
def mkSol (init : Fin E.order → α) : ℕ → α
  | n =>
    if h : n < E.order then init ⟨n, h⟩
    else
      ∑ k : Fin E.order,
        have : n - E.order + k < n :=
          by
          rw [add_comm, ← add_tsub_assoc_of_le (not_lt.mp h), tsub_lt_iff_left]
          · exact add_lt_add_right k.is_lt n
          · convert add_le_add (zero_le (k : ℕ)) (not_lt.mp h)
            simp only [zero_add]
        E.coeffs k * mk_sol (n - E.order + k)
#align linear_recurrence.mk_sol LinearRecurrence.mkSol

/-- `E.mk_sol` indeed gives solutions to `E`. -/
theorem is_sol_mkSol (init : Fin E.order → α) : E.IsSolution (E.mkSol init) := fun n => by
  rw [mk_sol] <;> simp
#align linear_recurrence.is_sol_mk_sol LinearRecurrence.is_sol_mkSol

/-- `E.mk_sol init`'s first `E.order` terms are `init`. -/
theorem mkSol_eq_init (init : Fin E.order → α) : ∀ n : Fin E.order, E.mkSol init n = init n :=
  fun n => by
  rw [mk_sol]
  simp only [n.is_lt, dif_pos, Fin.mk_val, Fin.eta]
#align linear_recurrence.mk_sol_eq_init LinearRecurrence.mkSol_eq_init

/-- If `u` is a solution to `E` and `init` designates its first `E.order` values,
  then `∀ n, u n = E.mk_sol init n`. -/
theorem eq_mk_of_is_sol_of_eq_init {u : ℕ → α} {init : Fin E.order → α} (h : E.IsSolution u)
    (heq : ∀ n : Fin E.order, u n = init n) : ∀ n, u n = E.mkSol init n
  | n =>
    if h' : n < E.order then by
      rw [mk_sol] <;> simp only [h', dif_pos] <;> exact_mod_cast HEq ⟨n, h'⟩
    else by
      rw [mk_sol, ← tsub_add_cancel_of_le (le_of_not_lt h'), h (n - E.order)]
      simp [h']
      congr with k
      exact
        by
        have wf : n - E.order + k < n :=
          by
          rw [add_comm, ← add_tsub_assoc_of_le (not_lt.mp h'), tsub_lt_iff_left]
          · exact add_lt_add_right k.is_lt n
          · convert add_le_add (zero_le (k : ℕ)) (not_lt.mp h')
            simp only [zero_add]
        rw [eq_mk_of_is_sol_of_eq_init]
#align linear_recurrence.eq_mk_of_is_sol_of_eq_init LinearRecurrence.eq_mk_of_is_sol_of_eq_init

/-- If `u` is a solution to `E` and `init` designates its first `E.order` values,
  then `u = E.mk_sol init`. This proves that `E.mk_sol init` is the only solution
  of `E` whose first `E.order` values are given by `init`. -/
theorem eq_mk_of_is_sol_of_eq_init' {u : ℕ → α} {init : Fin E.order → α} (h : E.IsSolution u)
    (heq : ∀ n : Fin E.order, u n = init n) : u = E.mkSol init :=
  funext (E.eq_mk_of_is_sol_of_eq_init h HEq)
#align linear_recurrence.eq_mk_of_is_sol_of_eq_init' LinearRecurrence.eq_mk_of_is_sol_of_eq_init'

/-- The space of solutions of `E`, as a `submodule` over `α` of the module `ℕ → α`. -/
def solSpace : Submodule α (ℕ → α)
    where
  carrier := { u | E.IsSolution u }
  zero_mem' n := by simp
  add_mem' u v hu hv n := by simp [mul_add, sum_add_distrib, hu n, hv n]
  smul_mem' a u hu n := by simp [hu n, mul_sum] <;> congr <;> ext <;> ac_rfl
#align linear_recurrence.sol_space LinearRecurrence.solSpace

/-- Defining property of the solution space : `u` is a solution
  iff it belongs to the solution space. -/
theorem is_sol_iff_mem_solSpace (u : ℕ → α) : E.IsSolution u ↔ u ∈ E.solSpace :=
  Iff.rfl
#align linear_recurrence.is_sol_iff_mem_sol_space LinearRecurrence.is_sol_iff_mem_solSpace

/-- The function that maps a solution `u` of `E` to its first
  `E.order` terms as a `linear_equiv`. -/
def toInit : E.solSpace ≃ₗ[α] Fin E.order → α
    where
  toFun u x := (u : ℕ → α) x
  map_add' u v := by
    ext
    simp
  map_smul' a u := by
    ext
    simp
  invFun u := ⟨E.mkSol u, E.is_sol_mkSol u⟩
  left_inv u := by ext n <;> symm <;> apply E.eq_mk_of_is_sol_of_eq_init u.2 <;> intro k <;> rfl
  right_inv u := Function.funext_iff.mpr fun n => E.mkSol_eq_init u n
#align linear_recurrence.to_init LinearRecurrence.toInit

/-- Two solutions are equal iff they are equal on `range E.order`. -/
theorem sol_eq_of_eq_init (u v : ℕ → α) (hu : E.IsSolution u) (hv : E.IsSolution v) :
    u = v ↔ Set.EqOn u v ↑(range E.order) :=
  by
  refine' Iff.intro (fun h x hx => h ▸ rfl) _
  intro h
  set u' : ↥E.sol_space := ⟨u, hu⟩
  set v' : ↥E.sol_space := ⟨v, hv⟩
  change u'.val = v'.val
  suffices h' : u' = v'; exact h' ▸ rfl
  rw [← E.to_init.to_equiv.apply_eq_iff_eq, LinearEquiv.coe_toEquiv]
  ext x
  exact_mod_cast h (mem_range.mpr x.2)
#align linear_recurrence.sol_eq_of_eq_init LinearRecurrence.sol_eq_of_eq_init

/-! `E.tuple_succ` maps `![s₀, s₁, ..., sₙ]` to `![s₁, ..., sₙ, ∑ (E.coeffs i) * sᵢ]`,
  where `n := E.order`. This operation is quite useful for determining closed-form
  solutions of `E`. -/

/-- `E.tuple_succ` maps `![s₀, s₁, ..., sₙ]` to `![s₁, ..., sₙ, ∑ (E.coeffs i) * sᵢ]`,
  where `n := E.order`. -/
def tupleSucc : (Fin E.order → α) →ₗ[α] Fin E.order → α
    where
  toFun X i := if h : (i : ℕ) + 1 < E.order then X ⟨i + 1, h⟩ else ∑ i, E.coeffs i * X i
  map_add' x y := by
    ext i
    split_ifs <;> simp [h, mul_add, sum_add_distrib]
  map_smul' x y := by
    ext i
    split_ifs <;> simp [h, mul_sum]
    exact sum_congr rfl fun x _ => by ac_rfl
#align linear_recurrence.tuple_succ LinearRecurrence.tupleSucc

end CommSemiring

section Field

variable {α : Type _} [Field α] (E : LinearRecurrence α)

/-- The dimension of `E.sol_space` is `E.order`. -/
theorem solSpace_dim : Module.rank α E.solSpace = E.order :=
  @dim_fin_fun α _ E.order ▸ E.toInit.dim_eq
#align linear_recurrence.sol_space_dim LinearRecurrence.solSpace_dim

end Field

section CommRing

variable {α : Type _} [CommRing α] (E : LinearRecurrence α)

/-- The characteristic polynomial of `E` is
`X ^ E.order - ∑ i : fin E.order, (E.coeffs i) * X ^ i`. -/
def charPoly : α[X] :=
  Polynomial.monomial E.order 1 - ∑ i : Fin E.order, Polynomial.monomial i (E.coeffs i)
#align linear_recurrence.char_poly LinearRecurrence.charPoly

/-- The geometric sequence `q^n` is a solution of `E` iff
  `q` is a root of `E`'s characteristic polynomial. -/
theorem geom_sol_iff_root_charPoly (q : α) : (E.IsSolution fun n => q ^ n) ↔ E.charPoly.IsRoot q :=
  by
  rw [char_poly, Polynomial.IsRoot.def, Polynomial.eval]
  simp only [Polynomial.eval₂_finset_sum, one_mul, RingHom.id_apply, Polynomial.eval₂_monomial,
    Polynomial.eval₂_sub]
  constructor
  · intro h
    simpa [sub_eq_zero] using h 0
  · intro h n
    simp only [pow_add, sub_eq_zero.mp h, mul_sum]
    exact sum_congr rfl fun _ _ => by ring
#align linear_recurrence.geom_sol_iff_root_char_poly LinearRecurrence.geom_sol_iff_root_charPoly

end CommRing

end LinearRecurrence


import tactic

/-!

# The entourage definition of a uniform space

We start with a little section on `U ∘ V` (see axiom 4 of the wikipedia
entourage definition of a uniform space)

We then give the entourage definition of a uniform space

-/

-- We first define U ∘ V. First the function itself (called `comp_ent`)

/-- composition `∘` of two subsets of X × X -/
def comp_ent {X : Type} (U V : set (X×X)) :=
  {p : X × X | ∃z : X, (p.1, z) ∈ U ∧ (z, p.2) ∈ V}

-- and now the notation
notation U ` ∘ ` V := comp_ent U V

variables {X : Type} {U V : set (X × X)} {x y : X}

/-- This is the theorem which gives the defining property of U ∘ V -/
@[simp] theorem mem_comp_ent :
  (x, y) ∈ U ∘ V ↔ ∃ z, (x, z) ∈ U ∧ (z, y) ∈ V := iff.rfl -- true by definition

structure uniform_space_entourage (X : Type) :=
(entourages : set (set (X × X)))
-- now go through the five axioms in Wikipedia
(refl : ∀ U ∈ entourages, ∀ x : X, (x,x) ∈ U)
(bigger : ∀ U V : set (X × X), U ∈ entourages → U ⊆ V → V ∈ entourages)
(inter : ∀ U V ∈ entourages, U ∩ V ∈ entourages)
(comp : ∀ U ∈ entourages, ∃ V ∈ entourages, V ∘ V ⊆ U)
(symm : ∀ U ∈ entourages, {z : X × X | (z.2, z.1) ∈ U} ∈ entourages)


/-*** #check ***-/

/-
In Lean, the #check command is part of Lean but not part of
predicate logic. It takes any expression does two things:

(1) It checks it for syntax errors
(2) If it's syntactically correct, it tells you its type

Let's look at some examples. Hover over the blue squiggle.
-/

#check 5    -- 5 is a good expression; it's type is ℕ (natural number)
#check ℕ    -- ℕ is a data type so *it's& type is Type

/-
The type of the value 5 is ℕ
The type of ℕ is Type
Type is the type of every simple data type in Lean
-/

/-
Let's look at another example
-/

#check "Hi"   -- "Hi" is a value true of the string data type
#check string -- string is a data type so it's type is also Type

/-
The type of 5 is ℕ (5 : ℕ) and the type of ℕ is type (ℕ : Type)
The type of "Hi" is string ("Hi" : string") and the type of string is type (type : Type)
Similarly in Lean, the type of tt is bool (tt : bool) and the type of bool is Type (bool : Type)
In Lean, the type of every basic data type is just Type. Types are values, too, in Lean.
That let's us express ideas such as this: every value, t, of every data type T, equals itself
-/

#check ∀ (T : Type) (t : T), t = t
-- for every type T, and every value t of this type, t = t.

/-
Now let's look at using #check to check expressions involving propositions.
-/

#check ∀ (P : Prop), P ∨ ¬P

/-
The expression, ∀ (P : Prop), P ∨ ¬P, is syntactically correct;
and because this value is a proposition, it's type is Prop. The
type of any proposition our higher-order predicate logic is Prop.
Here's another example.
-/

#check 0 = 1

/-
The expression 0 = 1 is a syntactically correct proposition,
and because it's a proposition, it's type is also Prop
-/

#check true

/-
The logical expression, true, is also a proposition,
so it's type is also Prop.
-/

#check true.intro

/-
Finally we again see that propositions, themselves
of type, Prop, are also types; just like string or
bool are of type, Type, but are themselves types as
well.
-/

#check bool
#check tt

#check true
#check true.intro

/-
Proofs (or "proof objects" or "proof terms") in
Lean are values of logical/propositional types.
It's strange, but every proposition is its own
type in the higher-order constructive logic of
Lean. That is to say, in type theory, which you
now understand pretty well!
-/

/-
Extra! So what's the type of Prop, or of Type?
In the following diagrams, --> means "has type."
So, for example, Prop has type Type 0, which in
Lean we can and usually do write just as "Type."

Prop   --> Type 0 --> Type 1 --> Type 2, ad inf.
Sort 0 --> Sort 1 --> Sort 2 --> Sort 3, ad inf.
-/

-- You can see it for yourself using #check

-- Here with computational types
#check 0
#check nat
#check Type
#check Type 0
#check Type 1
-- ad infinitum

-- Here with logical types
#check true.intro -- a proof is a value
#check true       -- a proposition is a type "in" Prop
#check Prop       -- the type of Prop is Type
#check Type 1     -- etc.
-- ad infinitum

/-
Prop gets special treatment. In particular, and two
proofs of any propositional type are considered to be
equal, because they are considered to be equally good
*as proofs*. This is certainly not the case for values
of types that "live in" Type. Take bool, for example.
It has two obviously unqual values, tt and ff in Lean.
But suppose we have an arbitrary proposition, P, and
two arbitrary proofs of it. Lean will treat them as
being equal.
-/

example (P : Prop) (pf1 pf2 : P) : pf1 = pf2 := rfl

/-
Cool! Note by the way that here we used Python/C-style
"code" by declaring named arguments before the colon.
We could have avoided that by binding names to formal
parameters after the colon, with the same effect.
-/

example : ∀ (P : Prop) (pf1 pf2 : P), pf1 = pf2 :=
begin
assume P p1 p2,
exact rfl,
end


-- proving 2^n > n^2 - 1

-- https://leanprover.zulipchat.com/#narrow/stream/113489-new-members/topic/.E2.9C.94.20lean4.20induction.20with.20multiple.20base.20cases

import LeanUtils
open Nat

theorem two_exp_n (n : Nat) : 2^n > n^2 - 1 := by
  match n with
  | 0 => simp
  | 1 => simp
  | 2 => simp
  | k+3 =>
    have h₁ : 2^(k+2) > (k+2)^2 - 1 := two_exp_n (k + 2)
    have h₂ : (k+3) >= 3 := by simp_arith
    have h₃ : 2^(k+3) > (k+3)^2 - 1 := by calc
      -- ring should be able to solve these types of equalities when fully implemented
      2^(k+3) = 2 * 2^(k+2) := by admit
      -- linarith should be able to solve this when implemented, but currently only in lean3
      _ > 2 * ((k+2)^2 - 1) := by admit
      _ = (k+2) ^ 2 + (k+2) ^ 2  - 2 := by admit
      _ ≥ (k+2) ^ 2 + 3 * k - 2 := by admit
      _ ≥ (k+2) ^ 2 + 2 * k + 1 := by admit
      -- The following should be >, but gives
      --    invalid 'calc' step, failed to synthesize `Trans` instance
      --    Trans GT.gt GT.gt ?m.4046Lean
      _ ≥ (k+2) ^ 2 + 2 * k := by admit
      _ = (k+3) ^ 2 - 1 := by admit

    assumption