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

import algebra.big_operators.nat_antidiagonal
import data.polynomial.ring_division

/-!
# "Mirror" of a univariate polynomial

In this file we define `polynomial.mirror`, a variant of `polynomial.reverse`. The difference
between `reverse` and `mirror` is that `reverse` will decrease the degree if the polynomial is
divisible by `X`.

## Main definitions

- `polynomial.mirror`

## Main results

- `polynomial.mirror_mul_of_domain`: `mirror` preserves multiplication.
- `polynomial.irreducible_of_mirror`: an irreducibility criterion involving `mirror`

-/

namespace polynomial
open_locale polynomial

section semiring

variables {R : Type*} [semiring R] (p q : R[X])

/-- mirror of a polynomial: reverses the coefficients while preserving `polynomial.nat_degree` -/
noncomputable def mirror := p.reverse * X ^ p.nat_trailing_degree

@[simp] lemma mirror_zero : (0 : R[X]).mirror = 0 := by simp [mirror]

lemma mirror_monomial (n : ℕ) (a : R) : (monomial n a).mirror = (monomial n a) :=
begin
  classical,
  by_cases ha : a = 0,
  { rw [ha, monomial_zero_right, mirror_zero] },
  { rw [mirror, reverse, nat_degree_monomial n a, if_neg ha, nat_trailing_degree_monomial ha,
        ← C_mul_X_pow_eq_monomial, reflect_C_mul_X_pow, rev_at_le (le_refl n), tsub_self, pow_zero,
        mul_one] },
end

lemma mirror_C (a : R) : (C a).mirror = C a :=
mirror_monomial 0 a

lemma mirror_X : X.mirror = (X : R[X]) :=
mirror_monomial 1 (1 : R)

lemma mirror_nat_degree : p.mirror.nat_degree = p.nat_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, mirror_zero] },
  nontriviality R,
  rw [mirror, nat_degree_mul', reverse_nat_degree, nat_degree_X_pow,
      tsub_add_cancel_of_le p.nat_trailing_degree_le_nat_degree],
  rwa [leading_coeff_X_pow, mul_one, reverse_leading_coeff, ne, trailing_coeff_eq_zero]
end

lemma mirror_nat_trailing_degree : p.mirror.nat_trailing_degree = p.nat_trailing_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, mirror_zero] },
  { rw [mirror, nat_trailing_degree_mul_X_pow ((mt reverse_eq_zero.mp) hp),
        reverse_nat_trailing_degree, zero_add] },
end

lemma coeff_mirror (n : ℕ) :
  p.mirror.coeff n = p.coeff (rev_at (p.nat_degree + p.nat_trailing_degree) n) :=
begin
  by_cases h2 : p.nat_degree < n,
  { rw [coeff_eq_zero_of_nat_degree_lt (by rwa mirror_nat_degree)],
    by_cases h1 : n ≤ p.nat_degree + p.nat_trailing_degree,
    { rw [rev_at_le h1, coeff_eq_zero_of_lt_nat_trailing_degree],
      exact (tsub_lt_iff_left h1).mpr (nat.add_lt_add_right h2 _) },
    { rw [←rev_at_fun_eq, rev_at_fun, if_neg h1, coeff_eq_zero_of_nat_degree_lt h2] } },
  rw not_lt at h2,
  rw [rev_at_le (h2.trans (nat.le_add_right _ _))],
  by_cases h3 : p.nat_trailing_degree ≤ n,
  { rw [←tsub_add_eq_add_tsub h2, ←tsub_tsub_assoc h2 h3, mirror, coeff_mul_X_pow',
        if_pos h3, coeff_reverse, rev_at_le (tsub_le_self.trans h2)] },
  rw not_le at h3,
  rw coeff_eq_zero_of_nat_degree_lt (lt_tsub_iff_right.mpr (nat.add_lt_add_left h3 _)),
  exact coeff_eq_zero_of_lt_nat_trailing_degree (by rwa mirror_nat_trailing_degree),
end

--TODO: Extract `finset.sum_range_rev_at` lemma.

lemma mirror_mirror : p.mirror.mirror = p :=
polynomial.ext (λ n, by rw [coeff_mirror, coeff_mirror,
  mirror_nat_degree, mirror_nat_trailing_degree, rev_at_invol])

variables {p q}

lemma mirror_involutive : function.involutive (mirror : R[X] → R[X]) :=
mirror_mirror

lemma mirror_eq_iff : p.mirror = q ↔ p = q.mirror :=
mirror_involutive.eq_iff

@[simp] lemma mirror_inj : p.mirror = q.mirror ↔ p = q :=
mirror_involutive.injective.eq_iff

@[simp] lemma mirror_eq_zero : p.mirror = 0 ↔ p = 0 :=
⟨λ h, by rw [←p.mirror_mirror, h, mirror_zero], λ h, by rw [h, mirror_zero]⟩

variables (p q)

@[simp] lemma mirror_trailing_coeff : p.mirror.trailing_coeff = p.leading_coeff :=
by rw [leading_coeff, trailing_coeff, mirror_nat_trailing_degree, coeff_mirror,
  rev_at_le (nat.le_add_left _ _), add_tsub_cancel_right]

@[simp] lemma mirror_leading_coeff : p.mirror.leading_coeff = p.trailing_coeff :=
by rw [←p.mirror_mirror, mirror_trailing_coeff, p.mirror_mirror]

lemma coeff_mul_mirror :
  (p * p.mirror).coeff (p.nat_degree + p.nat_trailing_degree) = p.sum (λ n, (^ 2)) :=
begin
  rw [coeff_mul, finset.nat.sum_antidiagonal_eq_sum_range_succ_mk],
  refine (finset.sum_congr rfl (λ n hn, _)).trans (p.sum_eq_of_subset (λ n, (^ 2))
    (λ n, zero_pow zero_lt_two) _ (λ n hn, finset.mem_range_succ_iff.mpr
    ((le_nat_degree_of_mem_supp n hn).trans (nat.le_add_right _ _)))).symm,
  rw [coeff_mirror, ←rev_at_le (finset.mem_range_succ_iff.mp hn), rev_at_invol, ←sq],
end

variables [no_zero_divisors R]

lemma nat_degree_mul_mirror : (p * p.mirror).nat_degree = 2 * p.nat_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, zero_mul, nat_degree_zero, mul_zero] },
  rw [nat_degree_mul hp (mt mirror_eq_zero.mp hp), mirror_nat_degree, two_mul],
end

lemma nat_trailing_degree_mul_mirror :
  (p * p.mirror).nat_trailing_degree = 2 * p.nat_trailing_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, zero_mul, nat_trailing_degree_zero, mul_zero] },
  rw [nat_trailing_degree_mul hp (mt mirror_eq_zero.mp hp), mirror_nat_trailing_degree, two_mul],
end

end semiring

section ring

variables {R : Type*} [ring R] (p q : R[X])

lemma mirror_neg : (-p).mirror = -(p.mirror) :=
by rw [mirror, mirror, reverse_neg, nat_trailing_degree_neg, neg_mul_eq_neg_mul]

variables [no_zero_divisors R]

lemma mirror_mul_of_domain : (p * q).mirror = p.mirror * q.mirror :=
begin
  by_cases hp : p = 0,
  { rw [hp, zero_mul, mirror_zero, zero_mul] },
  by_cases hq : q = 0,
  { rw [hq, mul_zero, mirror_zero, mul_zero] },
  rw [mirror, mirror, mirror, reverse_mul_of_domain, nat_trailing_degree_mul hp hq, pow_add],
  rw [mul_assoc, ←mul_assoc q.reverse],
  conv_lhs { congr, skip, congr, rw [←X_pow_mul] },
  repeat { rw [mul_assoc], },
end

lemma mirror_smul (a : R) : (a • p).mirror = a • p.mirror :=
by rw [←C_mul', ←C_mul', mirror_mul_of_domain, mirror_C]

end ring

section comm_ring

variables {R : Type*} [comm_ring R] [no_zero_divisors R] {f : R[X]}

lemma irreducible_of_mirror (h1 : ¬ is_unit f)
  (h2 : ∀ k, f * f.mirror = k * k.mirror → k = f ∨ k = -f ∨ k = f.mirror ∨ k = -f.mirror)
  (h3 : ∀ g, g ∣ f → g ∣ f.mirror → is_unit g) : irreducible f :=
begin
  split,
  { exact h1 },
  { intros g h fgh,
    let k := g * h.mirror,
    have key : f * f.mirror = k * k.mirror,
    { rw [fgh, mirror_mul_of_domain, mirror_mul_of_domain, mirror_mirror,
          mul_assoc, mul_comm h, mul_comm g.mirror, mul_assoc, ←mul_assoc] },
    have g_dvd_f : g ∣ f,
    { rw fgh,
      exact dvd_mul_right g h },
    have h_dvd_f : h ∣ f,
    { rw fgh,
      exact dvd_mul_left h g },
    have g_dvd_k : g ∣ k,
    { exact dvd_mul_right g h.mirror },
    have h_dvd_k_rev : h ∣ k.mirror,
    { rw [mirror_mul_of_domain, mirror_mirror],
      exact dvd_mul_left h g.mirror },
    have hk := h2 k key,
    rcases hk with hk | hk | hk | hk,
    { exact or.inr (h3 h h_dvd_f (by rwa ← hk)) },
    { exact or.inr (h3 h h_dvd_f (by rwa [← neg_eq_iff_eq_neg.mpr hk, mirror_neg, dvd_neg])) },
    { exact or.inl (h3 g g_dvd_f (by rwa ← hk)) },
    { exact or.inl (h3 g g_dvd_f (by rwa [← neg_eq_iff_eq_neg.mpr hk, dvd_neg])) } },
end

end comm_ring

end polynomial


-- Razonamiento con tipos abreviados: Posiciones
-- =============================================

import tactic

-- ----------------------------------------------------
-- Ejercicio 1. Definir el tipo Pos como una abreviatura
-- de pares de enteros para representar posiciones.
-- ----------------------------------------------------

-- 1ª definición
-- abbreviation Pos : Type := ℤ × ℤ

-- 2ª definición
-- notation `Pos` := ℤ × ℤ

-- 3ª definición
-- local notation `Pos` := ℤ × ℤ

-- 4ª definición
def Pos := ℤ × ℤ

-- ----------------------------------------------------
-- Ejercicio 2. Definir la posición origen.
-- ----------------------------------------------------

def origen : Pos :=
(0,0)

-- ----------------------------------------------------
-- Ejercicio 3. Definir la función
--    izquierda : Pos → Pos
-- tal que (izquierda p) esla posición que se encuentra
-- a la izquierda de p. Por ejemplo,
--    izquierda (3,5) = (2,5)
-- ----------------------------------------------------

-- 1ª definición
@[simp]
def izquierda : Pos → Pos :=
λ ⟨x,y⟩, (x-1,y)

-- 2ª definición
@[simp]
def izquierda_2 : Pos → Pos
| (x,y) := (x-1,y)

-- #eval izquierda (3,5)
-- Da: (2,5)

-- ----------------------------------------------------
-- Ejercicio 4. Definir la función
--    derecha : Pos → Pos
-- tal que (derecha p) esla posición que se encuentra
-- a la derecha de p. Por ejemplo,
--    derecha (3,5) = (4,5)
-- ----------------------------------------------------

-- 1ª definición
@[simp]
def derecha : Pos → Pos :=
λ ⟨x,y⟩, (x+1,y)

-- 2ª definición
@[simp]
def derecha_2 : Pos → Pos
| (x,y) := (x+1,y)

-- #eval derecha (3,5)
-- Da: (4, 5)

-- ----------------------------------------------------
-- Ejercicio 5. Demostrar que para cualquier posición p,
--    izquierda (derecha p) = p
-- ----------------------------------------------------

-- 1ª demostración
lemma izquierda_derecha :
  ∀ p : Pos, izquierda (derecha p) = p
| (x,y) := by calc izquierda (derecha (x, y))
                   = izquierda (x+1, y)       :by simp
               ... = (x+1-1, y)               :by simp
               ... = (x, y)                   :by simp

-- 2ª demostración
lemma izquierda_derecha_2 :
  ∀ p : Pos, izquierda (derecha p) = p :=
λ ⟨x,y⟩, by simp

-- ----------------------------------------------------
-- Ejercicio 6. Definir el tipo Movimiento para
-- representar los movimientos com funciones desde la
-- posición inicial a la final.
-- ----------------------------------------------------

def Movimiento : Type := Pos → Pos


import lib.m154

namespace m154
open nat M154
/-
# Equivalences

Ce fichier aborde l'étude du connecteur logique `↔` (équivalence logique, notée ⇔ sur papier).
L'énoncé `P ↔ Q` si lit « `P` est vrai si et seulement si `Q` est vrai ».
Il affirme donc à la fois `P → Q` et `Q → P`.

Pour démontrer une équivalence par double implication on utilise
`Montrons que` suivi de l'implication directe.
Une fois celle-ci démontrée, on peut utiliser
`Montrons que` suivi de l'implication inverse, mais ce n'est pas obligatoire.
-/

-- Dans toute la suite, x, a, b, c et d désignent des nombres réels.
variables {x a b c d : ℝ}

/- Les lemmes `inferieur_diff_pos` et `diff_pos_inferieur` se combinent
en une équivalence. -/

lemma inferieur_pos_ssi (x y : ℝ) : x ≤ y ↔ 0 ≤ y - x :=
begin
  Montrons que x ≤ y → 0 ≤ y - x,
  On conclut par inferieur_diff_pos,
  Montrons que 0 ≤ y - x → x ≤ y,
  On conclut par diff_pos_inferieur,
end

/-
Faites de même avec `inferieur_add_gauche` et `inferieur_simpl_gauche`.
-/

lemma inferieur_add_gauche_ssi : a ≤ b ↔ c + a ≤ c + b :=
begin
  sorry
end

/-
Pour utiliser une équivalence on peut accéder aux deux implications de façons complètement
analogue au connecteur `∧`, avec `Par ... on obtient ...` ou via le suffixe
`.1` pour l'implication de gauche à droite et `.2` pour l'autre sens.

Vérifions par exemple que le lemme ci-dessus permet de retrouver l'énoncé `inferieur_add_gauche`.
-/

example (h : a ≤ b) : c + a ≤ c + b :=
begin
  Par inferieur_add_gauche_ssi on obtient
    (imp₁ : a ≤ b → c + a ≤ c + b) (imp₂ : c + a ≤ c + b → a ≤ b),
  On conclut par imp₁ appliqué à h,
end

/- Ou de façon plus concise. -/

example (h : a ≤ b) : c + a ≤ c + b :=
begin
  On conclut par inferieur_add_gauche_ssi.1 appliqué à h,
end

example (h : 2 + a ≤ 2 + b) : a ≤ b :=
begin
  sorry
end

/-
On peut également utiliser une équivalence pour réécrire le but ou une hypothèse,
de même qu'une égalité peut servir à réécrire le but ou une hypothèse. La syntaxe est
la même que pour les égalités.

Par exemple, l'équivalence donnée par

`abs_inferieur_ssi : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y`

est utilisée pour réécrire l'hypothèse `h` dans la démonstration suivante.
-/

example (h : |a| ≤ 1) : a ≤ 1 :=
begin
  On réécrit via abs_inferieur_ssi dans h,
  On conclut par h.2,
end

example (h : |a| ≤ 1) : -1 ≤ a :=
begin
  sorry
end

/-
## Exercice de synthèse sur =, →, ∧, ↔

On a la relation de divisibilité sur les entiers naturels :
`a ∣ b` si `b` est un multiple de `a`. Attention la barre verticale n'est pas celle du
clavier mais s'obtient par ,|

Cette relation est réflexive et antisymétrique, c'est à dire qu'on a les deux énoncés :
`divise_refl (a : ℕ) : a ∣ a`
et
`divise_antisym {a b : ℕ} (h: a ∣ b) (h' : b ∣ a) : a = b`

De plus on a une fonction `pgcd` qui, à deux entiers naturels associde un troisième entier
(leur plus grand diviseur commun). Cette fonction est liée à la relation
de divisibilité par :

`divise_pgcd_ssi {a b c : ℕ} : c ∣ pgcd a b ↔ c ∣ a ∧ c ∣ b`

Dans l'exercice suivant, le jeu est de n'utiliser que ces trois énoncés, sans essayer
de faire avouer à Lean la définition de la divisibilité ou du pgcd.

Cet exercice est plus difficile que les exercices rencontrés jusqu'ici et nécessite
de combiner beaucoup de manipulations logiques.
-/

example (a b : ℕ) : a ∣ b ↔ pgcd a b = a :=
begin
  sorry
end

end m154


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

import data.polynomial.hasse_deriv

/-!
# Taylor expansions of polynomials

## Main declarations

* `polynomial.taylor`: the Taylor expansion of the polynomial `f` at `r`
* `polynomial.taylor_coeff`: the `k`th coefficient of `taylor r f` is
  `(polynomial.hasse_deriv k f).eval r`
* `polynomial.eq_zero_of_hasse_deriv_eq_zero`:
  the identity principle: a polynomial is 0 iff all its Hasse derivatives are zero

-/

noncomputable theory

namespace polynomial
open_locale polynomial

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

/-- The Taylor expansion of a polynomial `f` at `r`. -/
def taylor (r : R) : R[X] →ₗ[R] R[X] :=
{ to_fun := λ f, f.comp (X + C r),
  map_add' := λ f g, add_comp,
  map_smul' := λ c f, by simp only [smul_eq_C_mul, C_mul_comp, ring_hom.id_apply] }

lemma taylor_apply : taylor r f = f.comp (X + C r) := rfl

@[simp] lemma taylor_X : taylor r X = X + C r :=
by simp only [taylor_apply, X_comp]

@[simp] lemma taylor_C (x : R) : taylor r (C x) = C x :=
by simp only [taylor_apply, C_comp]

@[simp] lemma taylor_zero' : taylor (0 : R) = linear_map.id :=
begin
  ext,
  simp only [taylor_apply, add_zero, comp_X, _root_.map_zero, linear_map.id_comp, function.comp_app,
             linear_map.coe_comp]
end

lemma taylor_zero (f : R[X]) : taylor 0 f = f :=
by rw [taylor_zero', linear_map.id_apply]

@[simp] lemma taylor_one : taylor r (1 : R[X]) = C 1 :=
by rw [← C_1, taylor_C]

@[simp] lemma taylor_monomial (i : ℕ) (k : R) : taylor r (monomial i k) = C k * (X + C r) ^ i :=
by simp [taylor_apply]

/-- The `k`th coefficient of `polynomial.taylor r f` is `(polynomial.hasse_deriv k f).eval r`. -/
lemma taylor_coeff (n : ℕ) : (taylor r f).coeff n = (hasse_deriv n f).eval r :=
show (lcoeff R n).comp (taylor r) f = (leval r).comp (hasse_deriv n) f,
begin
  congr' 1, clear f, ext i,
  simp only [leval_apply, mul_one, one_mul, eval_monomial, linear_map.comp_apply, coeff_C_mul,
    hasse_deriv_monomial, taylor_apply, monomial_comp, C_1,
    (commute_X (C r)).add_pow i, linear_map.map_sum],
  simp only [lcoeff_apply, ← C_eq_nat_cast, mul_assoc, ← C_pow, ← C_mul, coeff_mul_C,
    (nat.cast_commute _ _).eq, coeff_X_pow, boole_mul, finset.sum_ite_eq, finset.mem_range],
  split_ifs with h, { refl },
  push_neg at h, rw [nat.choose_eq_zero_of_lt h, nat.cast_zero, mul_zero],
end

@[simp] lemma taylor_coeff_zero : (taylor r f).coeff 0 = f.eval r :=
by rw [taylor_coeff, hasse_deriv_zero, linear_map.id_apply]

@[simp] lemma taylor_coeff_one : (taylor r f).coeff 1 = f.derivative.eval r :=
by rw [taylor_coeff, hasse_deriv_one]

@[simp] lemma nat_degree_taylor (p : R[X]) (r : R) :
  nat_degree (taylor r p) = nat_degree p :=
begin
  refine map_nat_degree_eq_nat_degree _ _,
  nontriviality R,
  intros n c c0,
  simp [taylor_monomial, nat_degree_C_mul_eq_of_mul_ne_zero, nat_degree_pow_X_add_C, c0]
end

@[simp] lemma taylor_mul {R} [comm_semiring R] (r : R) (p q : R[X]) :
  taylor r (p * q) = taylor r p * taylor r q :=
by simp only [taylor_apply, mul_comp]

lemma taylor_taylor {R} [comm_semiring R] (f : R[X]) (r s : R) :
  taylor r (taylor s f) = taylor (r + s) f :=
by simp only [taylor_apply, comp_assoc, map_add, add_comp, X_comp, C_comp, C_add, add_assoc]

lemma taylor_eval {R} [comm_semiring R] (r : R) (f : R[X]) (s : R) :
  (taylor r f).eval s = f.eval (s + r) :=
by simp only [taylor_apply, eval_comp, eval_C, eval_X, eval_add]

lemma taylor_eval_sub {R} [comm_ring R] (r : R) (f : R[X]) (s : R) :
  (taylor r f).eval (s - r) = f.eval s :=
by rw [taylor_eval, sub_add_cancel]

lemma taylor_injective {R} [comm_ring R] (r : R) : function.injective (taylor r) :=
begin
  intros f g h,
  apply_fun taylor (-r) at h,
  simpa only [taylor_apply, comp_assoc, add_comp, X_comp, C_comp, C_neg,
    neg_add_cancel_right, comp_X] using h,
end

/-- Taylor's formula. -/
lemma sum_taylor_eq {R} [comm_ring R] (f : R[X]) (r : R) :
  (taylor r f).sum (λ i a, C a * (X - C r) ^ i) = f :=
by rw [←comp_eq_sum_left, sub_eq_add_neg, ←C_neg, ←taylor_apply, taylor_taylor, neg_add_self,
       taylor_zero]

end polynomial


import .love02_backward_proofs_demo

/- # LoVe Exercise 2: Backward Proofs -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/- ## Question 1: Connectives and Quantifiers

1.1. Carry out the following proofs using basic tactics.

Hint: Some strategies for carrying out such proofs are described at the end of
Section 2.3 in the Hitchhiker's Guide. -/

lemma I (a : Prop) :
  a → a :=
sorry

lemma K (a b : Prop) :
  a → b → b :=
sorry

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
sorry

lemma proj_1st (a : Prop) :
  a → a → a :=
sorry

/- Please give a different answer than for `proj_1st`: -/

lemma proj_2nd (a : Prop) :
  a → a → a :=
sorry

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
sorry

/- 1.2. Prove the contraposition rule using basic tactics. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
sorry

/- 1.3. Prove the distributivity of `∀` over `∧` using basic tactics.

Hint: This exercise is tricky, especially the right-to-left direction. Some
forward reasoning, like in the proof of `and_swap₂` in the lecture, might be
necessary. -/

lemma forall_and {α : Type} (p q : α → Prop) :
  (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
sorry

/- ## Question 2: Natural Numbers

2.1. Prove the following recursive equations on the first argument of the
`mul` operator defined in lecture 1. -/

#check mul

lemma mul_zero (n : ℕ) :
  mul 0 n = 0 :=
sorry

lemma mul_succ (m n : ℕ) :
  mul (nat.succ m) n = add (mul m n) n :=
sorry

/- 2.2. Prove commutativity and associativity of multiplication using the
`induction'` tactic. Choose the induction variable carefully. -/

lemma mul_comm (m n : ℕ) :
  mul m n = mul n m :=
sorry

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
sorry

/- 2.3. Prove the symmetric variant of `mul_add` using `rw`. To apply
commutativity at a specific position, instantiate the rule by passing some
arguments (e.g., `mul_comm _ l`). -/

lemma add_mul (l m n : ℕ) :
  mul (add l m) n = add (mul n l) (mul n m) :=
sorry

/- ## Question 3 (**optional**): Intuitionistic Logic

Intuitionistic logic is extended to classical logic by assuming a classical
axiom. There are several possibilities for the choice of axiom. In this
question, we are concerned with the logical equivalence of three different
axioms: -/

def excluded_middle :=
∀a : Prop, a ∨ ¬ a

def peirce :=
∀a b : Prop, ((a → b) → a) → a

def double_negation :=
∀a : Prop, (¬¬ a) → a

/- For the proofs below, please avoid using lemmas from Lean's `classical`
namespace, because this would defeat the purpose of the exercise.

3.1 (**optional**). Prove the following implication using tactics.

Hint: You will need `or.elim` and `false.elim`. You can use
`rw excluded_middle` to unfold the definition of `excluded_middle`,
and similarly for `peirce`. -/

lemma peirce_of_em :
  excluded_middle → peirce :=
sorry

/- 3.2 (**optional**). Prove the following implication using tactics. -/

lemma dn_of_peirce :
  peirce → double_negation :=
sorry

/- We leave the missing implication for the homework: -/

namespace sorry_lemmas

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

end sorry_lemmas

end backward_proofs

end LoVe


import data.set.lattice

/- Good work!
90/90 Correctness
10/10 Style
-/

/- This assignment is due by 11:59pm on Friday, March 3, 2023 . -/

/-
EXERCISE 1.

A function `F : set α → set α` is called a *monotone operator* if for every
pair of sets `s ⊆ t`, we have `F s ⊆ F t`.

Every such operator has a *least fixed point*, i.e. a set `s` satisfying:
- `F s = s`
- For every `t`, if `F t = t`, then `s ⊆ t`.

This exercise has you prove that fact. In fact, the least fixed point is
the intersection of all sets `s` such that `F s ⊆ s`.

This theorem, or the generalization to monotone operators on a complete lattice,
is called *Tarski's theorem* or the *Knaster-Tarski Theorem*. Feel free to use
Google to find more information.
-/
namespace monotone_set_operator
open set

-- You will need these. The full names are `set.mem_sInter`, etc.
#check @mem_sInter
#check @subset_sInter
#check @subset_sInter_iff

variable {α : Type*}

def lfp (F : set α → set α) := ⋂₀ { t | F t ⊆ t }

variable {F : set α → set α}
-- The monotonicity assumption:
variable (monoF : ∀ ⦃s t⦄, s ⊆ t → F s ⊆ F t)

/-
This follows immediately from the definition of `lfp F`.
-/
-- Exercise 1a. [8pts]
lemma aux0 {s : set α} (h : F s ⊆ s) : lfp F ⊆ s :=
begin
  apply sInter_subset_of_mem,
  exact h
end

/-
All the remaining theorems in this section need the monotonicity assumption.
After you prove `aux1`, you have to write `aux1 monoF` to use it in a
later theorem.
-/
include monoF

/-
To show this next statement, it suffices to show that `F (lfp F)` is contained
in every set `t` such that `F t ⊆ t`. So suppose `t` has this property.
Then by `aux0`, `lfp F ⊆ t`, and by monotonicity, we have `F (lfp F) ⊆ F t ⊆ t`.
-/
-- Exercise 1b. [10pts]
lemma aux1 : F (lfp F) ⊆ lfp F :=
begin
  apply subset_sInter,
  intros t ht,
  apply subset_trans _ ht,
  apply monoF,
  exact aux0 ht,
end

-- Hint: The remaining exercise 1 proofs below can be done in at most three
-- lines each.

/- To show this, use `aux0`. -/
-- Exercise 1c. [5pts]
lemma aux2 : lfp F ⊆ F (lfp F) :=
begin
  apply aux0,
  apply monoF,
  exact aux1 monoF,
end

/- Follows from `aux1` and `aux2`. -/
-- Exercise 1d. [5pts]
theorem lfp_fixed_point : F (lfp F) = lfp F :=
begin
  apply subset_antisymm,
  { -- F (lfp F) ⊆ lfp F
    exact aux1 monoF },
  { -- lfp F ⊆ F (lfp F)
    exact aux2 monoF },
end

-- Exercise 1e. [5pts]
theorem lfp_least_fixed_point (s : set α) (h : F s = s) : lfp F ⊆ s :=
begin
  apply aux0,
  exact eq.subset h
end

end monotone_set_operator

/-
EXERCISE 2.

A `complete lattice` is a partial order such that every subset has a greatest
lower bound (`Inf`) and a least upper bound (`Sup`). In fact, the existence
of either implies the other.

The proofs above carry over to this more general setting, if you replace
`α` by `set α`, `⊆` by `≤`, `⋂₀` by `Inf`, and make some small adjustments
to the proof.

Really, start by cutting and pasting the proofs above.
-/

namespace monotone_operator

#check @le_Inf
#check @le_Inf_iff
#check @Inf_le

variables {α : Type*} [complete_lattice α]

def lfp (F : α → α) := Inf { s | F s ≤ s }

variables {F : α → α} (monoF : ∀ ⦃s t⦄, s ≤ t → F s ≤ F t)

-- Exercise 2a. [5pts]
lemma aux0 {s : α} (h : F s ≤ s) : lfp F ≤ s :=
begin
  apply Inf_le,
  exact h
end

include monoF

-- Exercise 2b. [5pts]
lemma aux1 : F (lfp F) ≤ lfp F :=
begin
  apply le_Inf,
  intros t ht,
  apply le_trans,
  { -- F (lfp F) ≤ F t
    apply monoF,
    apply aux0 ht },
  { -- F t ≤ t
    exact ht },
end

-- Exercise 2c. [3pts]
lemma aux2 : lfp F ≤ F (lfp F) :=
begin
  apply aux0,
  apply monoF,
  exact aux1 monoF,
end

-- Exercise 2d. [2pts]
theorem lfp_fixed_point : F (lfp F) = lfp F :=
begin
  apply le_antisymm,
  { -- F (lfp F) ≤ lfp F
    exact aux1 monoF },
  { -- lfp F ≤ F (lfp F)
    exact aux2 monoF },
end

-- Exercise 2e. [2pts]
theorem lfp_least_fixed_point (s : α) (h : F s = s) : lfp F ≤ s :=
begin
  apply aux0,
  exact eq.le h
end

end monotone_operator

/-
EXERCISE 3.

Suppose `A 0, A 1, A 2, ...` is a sequence of sets. For each `n`, suppose
`B n = ⋃ i < n, A i`. Then the sequence `B 0, B 1, B 2, ...` is a monotone
sequence with the same union.
-/

namespace set_sequences

variable  {α : Type*}
variables (A B : ℕ → set α)
variable (B_def : ∀ n, B n = ⋃ i < n, A i)

/-
Remember, a (bounded) union corresponds to a (bounded) existential quantifier.
Use the simplifier with `simp only [set.mem_Union]` to do the translation for
you. You can also write `simp only [set.mem_Union] at h` to simplify a
hypothesis. You can also just use `simp`. However, mathlib conventions
discourage "non-terminal" calls, i.e. ones which don't close a goal, to `simp`
without `only`.
-/
example (x : α) (n : ℕ) : (x ∈ ⋃ i < n, A i) ↔ ∃ i < n, x ∈ A i :=
  by simp only [set.mem_Union]

-- This might be helpful to you:
example (i : ℕ) : i < i + 1 := nat.lt_succ_self _

include B_def

-- Exercise 3a. [10pts]
theorem monotone_B : ∀ i j, i ≤ j → B i ⊆ B j :=
begin
  intros,
  rw B_def i,
  rw B_def j,
  apply set.Union_mono,
  intro k,
  apply set.Union_subset_Union_const,
  intros,
  apply lt_of_lt_of_le,
  repeat { assumption },
end

-- Exercise 3b. [15pts]
theorem Union_B_eq_Union_A : (⋃ i, B i) = (⋃ i, A i) :=
begin
  apply subset_antisymm,
  { -- (⋃ i, B i) ⊆ (⋃ i, A i)
    intro x,
    rw [set.mem_Union, exists_imp_distrib],
    intros _ hx,
    rw [B_def, set.mem_Union] at hx,
    cases hx with _ hx,
    rw set.mem_Union at hx,
    cases hx with _ hx,
    apply set.mem_Union_of_mem,
    exact hx, },
  { -- (⋃ i, A i) ⊆ (⋃ i, B i)
    apply set.Union_mono',
    intros i,
    use i + 1,
    rw B_def,
    repeat { apply set.subset_Union_of_subset },
    apply nat.lt_succ_self,
    refl },
end

end set_sequences

/-
EXERCISE 4.

Suppose `A 0, A 1, A 2, ...` is a sequence of sets. For each `n`, suppose
`C n = A n \ (⋃ i < n, A i)`. Then whenever `i ≠ j`, the sets `C i` and `C j` are
disjoint, but the sequence still has the same union.
-/

namespace set_sequences

variable  {α : Type*}
variables (A C : ℕ → set α)
variable (C_def : ∀ n, C n = A n \ (⋃ i < n, A i))

-- This may be useful.
-- #check @set.eq_empty_of_forall_not_mem

/-
Use the lemma `aux` below to show that if `x` is in some `A i`, then there
is a least `i` with that property.
-/
section
open_locale classical

lemma aux {A : ℕ → set α} {x : α} (h : ∃ i, x ∈ A i) :
  ∃ i, x ∈ A i ∧ ∀ j < i, x ∉ A j :=
subtype.exists_of_subtype (nat.find_x h)
end

include C_def

-- Exercise 4a. [10pts]
theorem disjoint_C_of_lt : ∀ i j, i < j → C i ∩ C j = ∅ :=
begin
  intros,
  rw [C_def, C_def, set.eq_empty_iff_forall_not_mem],
  by_contra hx,
  push_neg at hx,
  rcases hx with ⟨x, ⟨⟨xinCi, _⟩, ⟨_, xinCj⟩⟩⟩,
  apply xinCj,
  repeat { apply set.mem_Union_of_mem <|> assumption },
end

-- Exercise 4b. [15pts]
theorem Union_C_eq_Union_A : (⋃ i, C i) = (⋃ i, A i) :=
begin
  apply subset_antisymm,
  { -- (⋃ i, C i) ⊆ (⋃ i, A i)
    apply set.Union_mono,
    intro i,
    rw C_def,
    apply set.diff_subset },
  { -- (⋃ i, A i) ⊆ (⋃ i, C i)
    intro x,
    rw set.mem_Union,
    intro xinUnionA,
    rw set.mem_Union,
    obtain ⟨i, ⟨xinAi, hj⟩⟩ := aux xinUnionA,
    use i,
    rw C_def,
    split, { by exact xinAi },
    by_contra h,
    rw set.mem_Union at h,
    cases h with j h,
    rw set.mem_Union at h,
    cases h,
    apply hj,
    repeat { assumption } },
end

end set_sequences


import tactic

-- Этот файл переведен и адаптирован из второй недели курса Formalising Mathematics: https://github.com/ImperialCollegeLondon/formalising-mathematics/tree/master/src/week_2
-- Там же есть продолжение про подгруппы, скачайте репозиторий с помощью
-- `leanproject get ImperialCollegeLondon/formalising-mathematics`
-- И самостоятельно пройдите то, что там есть

namespace itmo.lean

/-
Определим группу как тайпкласс (подробнее: https://leanprover.github.io/theorem_proving_in_lean/type_classes.html), расширяющий `has_mul`, `has_one` и `has_inv`.

`has_mul G` означает, что на `G` определено умножение `* : G → G → G`
`has_one G` означает, что в `G` есть единица `1 : G`
`has_inv G` означает, что есть функция, выдающая обратный для элемента `G`: `⁻¹ : G → G`

Все эти определения - просто нотация, свойства и взаимодействие этих функций надо будет добавить. Определим класс `group` с аксиомами групп:
-/

class group (G : Type) extends has_mul G, has_one G, has_inv G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

/-
Формально, `group G` это структура, в которой есть умножение, 1, обратный элемент, и доказательства аксиом групп. Поскольку `group G` это тайпкласс, то добавить в сигнатуру функции "пусть `G` - группа" нужно, как `(G : Type) [group G]`. Квадратные скобки используются для тайпклассов и автоматически (насколько получится) находятся соответствующие инстансы для `G`.

Обратите внимание, что набор использованных аксиом минимален, например, нет аксиом
`mul_one : ∀ (a : G), a * 1 = a` и
`mul_right_inv : ∀ (a : G), a * a⁻¹ = 1`.

На самом деле, эти аксиомы следуют из основных, и мы это докажем.
-/

namespace group

variables {G : Type} [group G]

lemma mul_left_cancel (a b c : G) (Habac : a * b = a * c) : b = c :=
begin
  sorry,
end

-- Доказательства из длинных цепочек равенств или неравенств часто можно заменить на `calc` (справка по `calc`: https://leanprover-community.github.io/extras/calc.html)
-- Пример решения задачи с IMO 2020 с использованием `calc`: https://github.com/leanprover-community/mathlib/blob/master/archive/imo/imo2020_q2.lean

example (a b c : G) (Habac : a * b = a * c) : b = c :=
begin
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : by rw ← mul_left_inv a
    ... = a⁻¹ * (a * b) : by rw ← mul_assoc
    ... = a⁻¹ * (a * c) : by rw Habac
    ... = (a⁻¹ * a) * c : by rw ← mul_assoc
    ... = 1 * c         : by rw mul_left_inv a
    ... = c             : by rw one_mul,
end

lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  sorry,
end

variables (a b c x y : G)

/-
Попробуйте начать доказательство с `apply mul_eq_of_eq_inv_mul`.
-/

@[simp] theorem mul_one : a * 1 = a :=
begin
  sorry,
end

@[simp] theorem mul_right_inv : a * a⁻¹ = 1 :=
begin
  sorry,
end

/-

Хорошей идеей было бы научить `simp` работать с леммами вида `A = B` или `A ↔ B`, которые мы описали выше. Для этого мы написали атрибут `@[simp]` перед леммой. В идеале, хочется, чтобы равенства в группах решались автоматически:

`example : (a * b) * 1⁻¹⁻¹ * b⁻¹ * (a⁻¹ * a⁻¹⁻¹⁻¹) * a = 1`

Тактика `simp` будет пытаться "упростить" цель как можно больше, в идеале закрыть цель с помощью известных ей лемм. `simp` работает переписываниями, только используя переписывания слева направо (если хочется изменить направление, можно дать дополнительный аргумент `simp [← h] at ...`). Поэтому, в тождествах, помеченных `simp`, правая часть должна быть "проще", чем левая. В частности, `add_comm (a b : ℕ) : a + b = b + a` - плохая лемма для `simp`. Обратите внимание, что во всех леммах выше, например,

`@[simp] theorem mul_one (a : G) : a * 1 = a`
`@[simp] theorem mul_right_inv (a : G) : a * a⁻¹ = 1`

правая часть проще левой. Помечать равенство  `a = a * 1` тегом `@[simp]` - плохая идея.

Уже определенным функциям (или определенным в другом файле) можно ретроспективно проставить атрибуты вручную.
-/

attribute [simp] one_mul mul_left_inv mul_assoc

/-
Научим `simp` использовать следующие пять лемм:

`inv_mul_cancel_left : a⁻¹ * (a * b) = b`
`mul_inv_cancel_left : a * (a⁻¹ * b) = b`
`inv_mul : (a * b)⁻¹ = b⁻¹ * a⁻¹`
`one_inv : (1 : G)⁻¹ = 1`
`inv_inv : (a⁻¹)⁻¹ = a`

Обратите внимание, что везде правая часть "проще" левой.
-/

@[simp] lemma inv_mul_cancel_left : a⁻¹ * (a * b) = b :=
begin
  rw ← mul_assoc,
  -- Здесь уже `simp` сможет переписать `a⁻¹ * a = 1` и `1 * b = b`
  simp,
end

@[simp] lemma mul_inv_cancel_left : a * (a⁻¹ * b) = b :=
begin
  sorry,
end

@[simp] lemma inv_mul : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  sorry,
end

@[simp] lemma one_inv : (1 : G)⁻¹ = 1 :=
begin
  sorry,
end

@[simp] lemma inv_inv : a ⁻¹ ⁻¹ = a :=
begin
  sorry,
end

/-
Эти 5 лемм выбраны неспроста: это вывод алгоритма Кнута-Бендикса для переписываний в группе:

https://en.wikipedia.org/wiki/Word_problem_(mathematics)#Example:_A_term_rewriting_system_to_decide_the_word_problem_in_the_free_group
-/

-- Сложный пример теперь решается автоматически
example : (a * b) * 1⁻¹⁻¹ * b⁻¹ * (a⁻¹ * a⁻¹⁻¹⁻¹) * a = 1 := by simp

lemma eq_mul_inv_of_mul_eq {a b c : G} (h : a * c = b) : a = b * c⁻¹ :=
begin
  sorry,
end

lemma eq_inv_mul_of_mul_eq {a b c : G} (h : b * a = c) : a = b⁻¹ * c :=
begin
  sorry,
end

lemma mul_left_eq_self {a b : G} : a * b = b ↔ a = 1 :=
begin
  sorry,
end

lemma mul_right_eq_self {a b : G} : a * b = a ↔ b = 1 :=
begin
  sorry,
end

lemma eq_inv_of_mul_eq_one {a b : G} (h : a * b = 1) : a = b⁻¹ :=
calc  a = a * 1 : by rw mul_one
    ... = b⁻¹   : by sorry

lemma inv_eq_of_mul_eq_one {a b : G} (h : a * b = 1) : a⁻¹ = b :=
begin
  sorry,
end

lemma unique_left_id {e : G} (h : ∀ x : G, e * x = x) : e = 1 :=
begin
  sorry,
end

lemma unique_right_inv {a b : G} (h : a * b = 1) : b = a⁻¹ :=
begin
  sorry,
end

lemma mul_left_cancel_iff (a x y : G) : a * x = a * y ↔ x = y :=
begin
  sorry,
end

lemma mul_right_cancel (a x y : G) (Habac : x * a = y * a) : x = y :=
calc x = x * 1 : by rw mul_one
  ... = y : by sorry

@[simp] theorem inv_inj_iff {a b : G}: a⁻¹ = b⁻¹ ↔ a = b :=
begin
  sorry,
end

theorem inv_eq {a b : G}: a⁻¹ = b ↔ b⁻¹ = a :=
begin
  sorry,
end

end group

end itmo.lean


import game.world10.level4 -- hide
namespace mynat -- hide
/-

# Inequality world.

## Level 5: `le_trans`

Another straightforward one.
-/

/- Lemma
≤ is transitive. In other words, if $a\leq b$ and $b\leq c$ then $a\leq c$.
-/
theorem le_trans (a b c : mynat) (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
begin [nat_num_game]
  cases hab with d hd,
  cases hbc with e he,
  use (d + e),
  rw ←add_assoc,
  rw ←hd,
  assumption,
end

/-
Congratulations -- you just got a collectible. You proved that the
natural numbers are a preorder.
-/
instance : preorder mynat := by structure_helper
end mynat -- hide


import data.set
import tactic

-- dEAduction imports
import logics
import structures
import definitions

-- import definitions_test

----------------------------------------------
namespace set_theory -- Course title
/- dEAduction
Section
    Set Theory
-/

variables {X : Type} {Y : Type}

lemma definition.inclusion (A B : set X) : A ⊆ B ↔ ∀ {{x:X}}, x ∈ A → x ∈ B :=
iff.rfl

lemma definition.egalite_ensembles {A A' : set X} : (A = A') ↔ ( ∀ x, x ∈ A ↔ x ∈ A' ) :=
/- dEAduction
PrettyName
    Egalité d'ensembles
-/
by exact set.ext_iff

lemma theorem.double_inclusion {A A' : set X} : (A = A') ↔ (A ⊆ A' ∧ A' ⊆ A) :=
begin
    exact le_antisymm_iff
end

----------------------------------------------
namespace unions_and_intersections -- section 1
-- pretty name for dEAduction will be computed from lean name

lemma definition.intersection_deux  (A B : set X) (x : X) :  x ∈ A ∩ B ↔ ( x ∈ A ∧ x ∈ B) :=
iff.rfl
/- dEAduction
PrettyName
    Intersection de deux ensembles
-/

lemma theorem.intersection_ensemble  (A B C : set X) : C ⊆ A ∩ B ↔ C ⊆ A ∧ C ⊆ B :=
begin
    exact ball_and_distrib
end

lemma definition.intersection_quelconque (I : Type) (O : I → set X)  (x : X) : (x ∈ set.Inter O) ↔ (∀ i:I, x ∈ O i) :=
set.mem_Inter
/- dEAduction
PrettyName
    Intersection quelconque
-/

-- Les deux lemmes suivants seront à regroupé au sein d'une même tactique : essayer le premier,
-- en cas d'échec essayer le second. Un seul bouton dans l'interface graphique
lemma definition.union  (A : set X) (B : set X) (x : X) :  x ∈ A ∪ B ↔ ( x ∈ A ∨ x ∈ B) :=
iff.rfl
/- dEAduction
PrettyName
    Union de deux ensembles
-/

lemma definition.union_quelconque (I : Type) (O : I → set X)  (x : X) : (x ∈ set.Union O) ↔ (∃ i:I, x ∈ O i) :=
set.mem_Union
/- dEAduction
PrettyName
    Union quelconque
-/

lemma exercise.union_distributive_inter (X : Type) (A B C : set X) : A ∩ (B ∪ C)  = (A ∩ B) ∪ (A ∩ C) :=
/- dEAduction
PrettyName
    Intersection d'unions
Description
    L'intersection est distributive par rapport à l'union
    et ça continue sur la ligne suivante
Tools->Logic
    $ALL -implicate -negate
Tools->ProofTechniques
    $ALL -contradiction
Tools->Definitions
    $UNTIL_NOW
Tools->Theorems
    double_inclusion, Riemann_hypothesis
ExpectedVarsNumber
    X=3, A=1, B=1
-/
begin
    sorry
end

variables {A B C : set X}

lemma exercise.inter_distributive_union : A ∪ (B ∩ C)  = (A ∪ B) ∩ (A ∪ C) :=
/- dEAduction
PrettyName
    Union d'intersections
Description
    L'union est distributive par rapport à l'intersection
Tools->Logic
    $ALL
Tools->ProofTechniques
    $ALL -choice
Tools->Statements
    $UNTIL_NOW
-/
begin
    sorry
end

end unions_and_intersections

-----------------------------------------
namespace complements -- section 2
/- dEAduction
Section
    Complementaires
-/

lemma definition.complement {A : set X} {x : X} : x ∈ set.univ \ A ↔ x ∉ A :=
by finish

lemma definition.complement_1 {A : set X} {x : X} : x ∈ set.compl A ↔ x ∉ A :=
by finish

lemma definition.complement_2 {A B : set X} {x : X} : x ∈ B \ A ↔ (x ∈ B ∧ x ∉ A) :=
iff.rfl

lemma exercise.complement_complement {A : set X} : - - A = A :=
/- dEAduction
PrettyName
    Complémentaire du complémentaire
Description
    Tout ensemble est égal au complémentaire de son complémentaire
    et réciproquement.
-/
begin
    sorry
end

end complements

end set_theory


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.submonoid.operations
import group_theory.subsemigroup.center
import data.fintype.basic

/-!
# Centers of monoids

## Main definitions

* `submonoid.center`: the center of a monoid
* `add_submonoid.center`: the center of an additive monoid

We provide `subgroup.center`, `add_subgroup.center`, `subsemiring.center`, and `subring.center` in
other files.
-/

namespace submonoid
section
variables (M : Type*) [monoid M]

/-- The center of a monoid `M` is the set of elements that commute with everything in `M` -/
@[to_additive "The center of a monoid `M` is the set of elements that commute with everything in
`M`"]
def center : submonoid M :=
{ carrier := set.center M,
  one_mem' := set.one_mem_center M,
  mul_mem' := λ a b, set.mul_mem_center }

@[to_additive] lemma coe_center : ↑(center M) = set.center M := rfl

@[simp]
lemma center_to_subsemigroup : (center M).to_subsemigroup = subsemigroup.center M := rfl

lemma _root_.add_submonoid.center_to_add_subsemigroup (M) [add_monoid M] :
  (add_submonoid.center M).to_add_subsemigroup = add_subsemigroup.center M := rfl

attribute [to_additive add_submonoid.center_to_add_subsemigroup] submonoid.center_to_subsemigroup

variables {M}

@[to_additive] lemma mem_center_iff {z : M} : z ∈ center M ↔ ∀ g, g * z = z * g := iff.rfl

instance decidable_mem_center [decidable_eq M] [fintype M] : decidable_pred (∈ center M) :=
λ _, decidable_of_iff' _ mem_center_iff

/-- The center of a monoid is commutative. -/
instance : comm_monoid (center M) :=
{ mul_comm := λ a b, subtype.ext $ b.prop _,
  .. (center M).to_monoid }

/-- The center of a monoid acts commutatively on that monoid. -/
instance center.smul_comm_class_left : smul_comm_class (center M) M M :=
{ smul_comm := λ m x y, (commute.left_comm (m.prop x) y).symm }

/-- The center of a monoid acts commutatively on that monoid. -/
instance center.smul_comm_class_right : smul_comm_class M (center M) M :=
smul_comm_class.symm _ _ _

/-! Note that `smul_comm_class (center M) (center M) M` is already implied by
`submonoid.smul_comm_class_right` -/
example : smul_comm_class (center M) (center M) M := by apply_instance

end

section
variables (M : Type*) [comm_monoid M]

@[simp] lemma center_eq_top : center M = ⊤ :=
set_like.coe_injective (set.center_eq_univ M)

end

end submonoid


import data.nat.prime
       data.nat.parity
       tactic

theorem even_of_prime_succ_pow (a b : ℕ) (ha : a > 1) (hb : b > 1) (hp : nat.prime (a^b + 1)) : 2 ∣ a :=
begin
  refine nat.prime.dvd_of_dvd_pow nat.prime_two (show 2 ∣ a^b, from _),
  by_contra h,
  have hab2 : a^b % 2 = 1, from nat.not_even_iff.mp h,
  set k := (a^b)/2 with hk,
  have habk : (a^b) = 1 + 2*k, by rw [←nat.mod_add_div (a^b) 2, hab2],
  rw [habk,
      show 1 + 2 * k + 1 = 2*(k + 1), by ring] at hp,
  refine nat.not_prime_mul one_lt_two _ hp,
  { suffices : k ≠ 0, by omega,
    intro h,
    rw [h, mul_zero, add_zero] at habk,
    have : 1^b < a ^ b, from nat.pow_lt_pow_of_lt_left ha (lt_trans zero_lt_one hb),
    rw [nat.one_pow, ←habk] at this,
    exact nat.lt_irrefl _ this }
end


import data.real.basic

--OUTPUT 1
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ 9 / 2, from by auto [div_eq_mul_inv, add_div],
  have h2 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 / 2) * ((a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b)), from by auto [div_le_div_of_mul_le, lt_of_lt_of_le (ha + hb + hc) (by auto [add_pos]), mul_le_mul_of_nonneg_right (by auto [add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg, add_nonneg]), mul_self_nonneg, mul_self_nonneg, mul_self_nonneg, mul_self_nonneg, mul_self_nonneg, mul_self_nonneg, mul_self_nonneg, mul_self_nonneg, mul_self_nonneg],
  have h3 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (1 / 2) * ((a + b + c) / (b + c) + (a + b + c) + (a + b + c) / (a + b)), from by auto [mul_le_mul_of_nonneg_left (by auto [half_pos]), h2],
  have h4 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (1 / 2) * ((a + b + c) + (a + b + c) + (a + b + c)), from by auto [mul_le_mul_of_nonneg_right (by auto [add_pos]), h3],
  have h5 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ ((1 / 2) * (a + b + c) + (1 / 2) * (a + b + c) + (1 / 2) * (a + b + c)), from by auto [mul_le_mul_of_nonneg_left (by auto [half_pos]), h4],
  have h6 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ ((1 / 2) * (a + b + c) + (1 / 2) * (a + b + c) + (1 / 2) * (a + b + c)) / (b + c + a + b), from by auto [mul_le_mul_of_nonneg_right, add_pos, add_pos, add_pos, h5],
  have h7 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ ((1 / 2) * (a + b + c) + (1 / 2) * (a + b + c) + (1 / 2) * (a + b + c)) / (b + c + a + b), from by auto [add_le_add_iff_left, add_le_add_iff_left, h6],
  have h8 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ ((1 / 2) * (a + b + c) + (1 / 2) * (a + b + c) + (1 / 2) * (a + b + c)) / (b + c + a + b), from by auto [add_le_add_iff_right, h7],
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by auto [div_eq_mul_inv, add_div, h8],
end

--OUTPUT 2
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : 0 < (b + c) + (a + c) + (a + b), from by auto [add_pos],
  have h2 : 0 < (b + c) + (a + c) + (a + b) / 3, from by auto [add_pos, div_pos],
  have h3 : (a + b + c) / ((b + c) + (a + c) + (a + b) / 3) = 1 / 2, from by auto [div_eq_iff],

  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (a + b + c) / ((b + c) + (a + c) + (a + b)) : by auto [mul_div_mul_left, div_add_div_left, div_add_div_left, div_add_div_left, add_pos, add_pos, add_pos, h1, h2, h3]
  ... ≥ (a + b + c) / ((b + c) + (a + c) + (a + b) / 3) : by auto [div_le_div_right, h1, h2, add_pos, add_pos, add_pos]
  ... = 1 / 2 : by auto [h3]
  ... = 3 / 6 : by auto [div_eq_iff, mul_comm]
  ... = 3 / 2 : by auto [div_eq_iff, mul_comm]
end

--OUTPUT 3
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) ≥ (9 / 2), from by auto [div_add_div_same, div_add_div_same, add_mul_div_left, add_mul_div_left, add_mul_div_left, mul_self_inj, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add_halves, add
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : a + b + c > 0, from by auto [add_pos, ha, hb, hc],
  have h2 : (a + b + c) / 3 = (1 / 2) * (a + b + c), from by auto [mul_div_cancel, three],
  have h3 : (a + b + c) / (b + c) = (1 / 2) * (a + b + c), from by auto [mul_div_cancel, two],
  have h4 : (a + b + c) / (a + c) = (1 / 2) * (a + b + c), from by auto [mul_div_cancel, two],
  have h5 : (a + b + c) / (a + b) = (1 / 2) * (a + b + c), from by auto [mul_div_cancel, two],
  have h6 : (1 / (b + c)) + (1 / (a + c)) + (1 / (a + b)) > 0, from by auto [add_pos, one_div_pos, ha, hb, hc],
  have h7 : (1 / (b + c)) + (1 / (a + c)) + (1 / (a + b)) = (b + c) + (a + c) + (a + b) / ((b + c) * (a + c) * (a + b)), from by auto [one_div_mul, mul_comm, mul_add],
  have h8 : (3 / 2) * (b + c) * (a + c) * (a + b) = (3 / 2) * ((b + c) + (a + c) + (a + b)), from by auto [mul_div_cancel, two, mul_comm, mul_add],
  have h9 : (1 / (b + c)) + (1 / (a + c)) + (1 / (a + b)) ≥ (3 / 2) / ((b + c) + (a + c) + (a + b)), from by auto [arithmetic_mean_never_less_than_harmonic_mean, h6],
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by auto [h3, h4, h5]
  ... = 1 / 2 * (a + b + c) + 1 / 2 * (a + b + c) + 1 / 2 * (a + b + c) : by auto [add_mul, h3, h4, h5]
  ... = (1 / 2) * (3 * (a + b + c)) : by auto [mul_add, three, mul_comm, mul_assoc]
  ... = (1 / 2) * (3 / 3) * (a + b + c) : by auto [mul_div_cancel, three]
  ... = (1 / 2) * (1 / 2) * (a + b + c) : by auto [mul_div_cancel, two]
  ... = (1 / 2) * (a + b + c) / 2 : by auto [mul_div_cancel, two]
  ... = (1 / 2) * ((a + b + c) / 3) : by auto [mul_div_cancel, two]
  ... = (1 / 2) * (1 / 2) * (a + b + c) : by auto [h2]
  ... = (1 / (b + c)) + (1 / (a + c)) + (1 / (a + b)) : by auto [one_div_mul, mul_comm, mul_add]
  ... ≥ (3 / 2) / ((b + c) + (a + c) + (a + b)) : by auto [h9]
  ... = (3 / 2) * ((b + c) + (a + c) + (a + b)) / ((b + c) * (a + c) * (a + b)) : by auto [div_mul_cancel, h6]
  ... = (3 / 2) * (b + c) * (a + c) * (a + b) / ((b + c) * (a + c) * (a + b)) : by auto [mul_comm, mul_add]
  ... = (3 / 2) : by auto [h8],
end

--OUTPUT 5
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : 0 < b + c, from by exact add_pos hb hc,
  have h2 : 0 < a + c, from by exact add_pos ha hc,
  have h3 : 0 < a + b, from by exact add_pos ha hb,
  have h4 : 0 < (b + c) + (a + c) + (a + b), from by exact add_pos h1 h2 h3,
  have h5 : 0 < 3, from by exact is_pos_three,
  have h6 : 0 < (b + c) + (a + c) + (a + b), from by exact add_pos h1 h2 h3,
  have h7 : 0 < (a + b + c), from by exact add_pos ha hb hc,

  have h8 : (a + b + c) / (b + c) = (a + b + c) * ((b + c)⁻¹), from by auto [div],
  have h9 : (a + b + c) / (a + c) = (a + b + c) * ((a + c)⁻¹), from by auto [div],
  have h10 : (a + b + c) / (a + b) = (a + b + c) * ((a + b)⁻¹), from by auto [div],

  have h11 : (a + b + c) / (b + c) = (a + b + c) * (1 / (b + c)), from by auto [one_div],
  have h12 : (a + b + c) / (a + c) = (a + b + c) * (1 / (a + c)), from by auto [one_div],
  have h13 : (a + b + c) / (a + b) = (a + b + c) * (1 / (a + b)), from by auto [one_div],

  have h14 : (a + b + c) / (b + c) = a + b + c - (a / (b + c)) + (b / (b + c)), from by auto [add_div, add_comm, add_mul, add_comm (a + b + c) (a / (b + c))],
  have h15 : (a + b + c) / (a + c) = a + b + c - (a / (a + c)) + (c / (a + c)), from by auto [add_div, add_comm, add_mul, add_comm (a + b + c) (a / (a + c))],
  have h16 : (a + b + c) / (a + b) = a + b + c - (c / (a + b)) + (b / (a + b)), from by auto [add_div, add_comm, add_mul, add_comm (a + b + c) (c / (a + b))],

  have h17 : (a + b + c) / (b + c) = a + b + c + (-a / (b + c)) + (b / (b + c)), from by auto [neg_div, add_mul, add_comm (a + b + c) (-a / (b + c))],
  have h18 : (a + b + c) / (a + c) = a + b + c + (-a / (a + c)) + (c / (a + c)), from by auto [neg_div, add_mul, add_comm (a + b + c) (-a / (a + c))],
  have h19 : (a + b + c) / (a + b) = a + b + c + (-c / (a + b)) + (b / (a + b)), from by auto [neg_div, add_mul, add_comm (a + b + c) (-c / (a + b))],

  have h20 : (a + b + c) / (b + c) = a + b + c + (-a / (b + c)) + b * (1 / (b + c)), from by auto [h17, h11],
  have h21 : (a + b + c) / (a + c) = a + b + c + (-a / (a + c)) + c * (1 / (a + c)), from by auto [h18, h12],
  have h22 : (a + b + c) / (a + b) = a + b + c + (-c / (a + b)) + b * (1 / (a + b)), from by auto [h19, h13],

  have h23 : (a + b + c) / (b + c) = a + b + c + (1 / (b + c)) + b * (1 / (b + c)), from by auto [h20, neg_div, add_mul],
  have h24 : (a + b + c) / (a + c) = a + b + c + (1 / (a + c)) + c * (1 / (a + c)), from by auto [h21, neg_div, add_mul],
  have h25 : (a + b + c) / (a + b) = a + b + c + (1 / (a + b)) + b * (1 / (a + b)), from by auto [h22, neg_div, add_mul],

  have h26 : (a + b + c) / (b + c) = a + b + c + (1 / (b + c)) + (b / (b + c)), from by auto [h23, mul_one],
  have h27 : (a + b + c) / (a + c) = a + b + c + (1 / (a + c)) + (c / (a + c)), from by auto [h24, mul_one],
  have h28 : (a + b + c) / (a + b) = a + b + c + (1 / (a + b)) + (b / (a + b)), from by auto [h25, mul_one],

  have h29 : (a + b + c) / (b + c) = a + b + c + (1 / (b + c)) + (b / (b + c)) + (-a / (b + c)), from by auto [h26, add_comm],
  have h30 : (a + b + c) / (a + c) = a + b + c + (1 / (a + c)) + (c / (a + c)) + (-a / (a + c)), from by auto [h27, add_comm],
  have h31 : (a + b + c) / (a + b) = a + b + c + (1 / (a + b)) + (b / (a + b)) + (-c / (a + b)), from by auto [h28, add_comm],

  have h32 : (a + b + c) / (b + c) = a + b + c + (1 / (b + c)) - (a / (b + c)) + (b / (b + c)), from by auto [h29, add_comm (-a / (b + c))],
  have h33 : (a + b + c) / (a + c) = a + b + c + (1 / (a + c)) - (a / (a + c)) + (c / (a + c)), from by auto [h30, add_comm (-a / (a + c))],
  have h34 : (a + b + c) / (a + b) = a + b + c + (1 / (a + b)) - (c / (a + b)) + (b / (a + b)), from by auto [h31, add_comm (-c / (a + b))],

  have h35 : (a + b + c) / (b + c) = a + b + c + (1 / (b + c)) - (a / (b + c)) + (b / (b + c)) + c, from by auto [h32, add_right_inj],
  have h36 : (a + b + c) / (a + c) = a + b + c + (1 / (a + c)) - (a / (a + c)) + (c / (a + c)) + b, from by auto [h33, add_right_inj],
  have h37 : (a + b + c) / (a + b) = a + b + c + (1 / (a + b
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : a + b + c > 0, from by auto [ha, hb, hc, add_pos],
  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by simp
  ... = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by auto [add_div_cancel_left] using [h1]
  ... ≥ (9 * (a + b + c)) / ((b + c) + (a + c) + (a + b)) : by auto [div_le_div_of_le_of_pos, add_pos, div_le_div_of_le_of_pos, add_pos, div_le_div_of_le_of_pos, add_pos, le_div_iff, mul_pos] using [h1, ha, hb, hc, arithmetic_mean_is_never_less_than_harmonic_mean]
  ... = 3 / 2 : by auto [div_eq_iff_mul_eq, mul_comm, mul_assoc, mul_left_cancel, mul_div_cancel, mul_one] using [h1],
end

--OUTPUT 7
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : 0 < a + b + c, from by auto [add_pos],
  have h2 : 0 < b + c, from by auto [add_pos],
  have h3 : 0 < a + c, from by auto [add_pos],
  have h4 : 0 < a + b, from by auto [add_pos],

  calc (a / (b + c)) + (b / (a + c)) + (c / (a + b)) = (a + b + c) / (b + c) + (a + b + c) / (a + c) + (a + b + c) / (a + b) : by auto [div_add_div_same, add_assoc, add_assoc, add_assoc, add_assoc] using [field]
  ... ≥ 9 / 2 : by auto [add_pos, div_le_div_iff_le_of_pos, mul_pos] using [arithmetic_mean_harmonic_mean]
  ... ≥ 3 / 2 : by auto [div_le_div_iff_le_of_pos, div_pos] using [field]
end

--OUTPUT 8
theorem nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
begin
  have h1 : (a + b + c) / ((b + c) + (a + c) + (a + b)) = (1 / 2), from by auto [div_eq_mul_inv, add_mul, mul_comm, mul_assoc],
  have h2 : (9 / 2) * ((a + b + c) / ((b + c) + (a + c) + (a + b))) = (9 / 2) * (1 / 2), from by auto [mul_assoc, h1],
  have h3 : ((a + b + c) / (b + c)) + ((a + b + c) / (a + c)) + ((a + b + c) / (a + b)) = (9 / 2) * (1 / 2), from by auto [mul_one, add_mul, add_mul, add_mul, add_assoc, add_assoc, add_comm, add_assoc, add_comm, add_comm, add_assoc, add_comm, add_assoc, add_assoc, add_comm, add_assoc, add_assoc, mul_assoc, mul_comm, mul_assoc, mul_comm, mul_assoc, mul_comm, mul_assoc, mul_comm, mul_comm, mul_assoc, mul_comm, mul_assoc, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, h2, !mul_one],
  have h4 : (1 / (b + c)) + (1 / (a + c)) + (1 / (a + b)) = (9 / 2) * (1 / 2), from by auto [h3, div_eq_mul_inv, mul_one, mul_one, mul_one, add_mul, add_mul, add_mul, add_assoc, add_assoc, add_comm, add_assoc, add_comm, add_comm, add_assoc, add_comm, add_assoc, add_assoc, add_comm, add_assoc, add_assoc, mul_comm, mul_assoc, mul_comm, mul_assoc, mul_comm, mul_assoc, mul_comm, mul_comm, mul_assoc, mul_comm, mul_assoc, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, !mul_one],
  have h5 : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / (b + c) + (a + c) + (a + b)), from by auto [arithmetic_mean_harmonic_mean, h4],
  show (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2), from by auto [h5, div_eq_mul_inv, mul_one, mul_one, mul_one, mul_comm, mul_assoc, mul_comm, mul_assoc, mul_comm, mul_assoc, mul_comm, mul_comm, mul_assoc, mul_comm, mul_assoc, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, mul_comm, !mul_one],
end

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

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

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

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

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

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

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

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

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

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

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

Setting $b = a$, this becomes:

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

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

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

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Nesbitt's inequality
Let $a$, $b$ and $c$ be positive real numbers.

Then:
:$\dfrac a {b + c} + \dfrac b {a + c} + \dfrac c {a + b} \ge \dfrac 3 2$

`proof`
{{begin-eqn}}
{{eqn | l = \frac a {b + c} + \frac b {a + c} + \frac c {a + b}
      | o = \ge
      | r = \dfrac 3 2
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac 9 2
      | c = by adding $3$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {a + b + c} {b + c} + \frac {a + b + c} {a + c} + \frac {a + b + c} {a + b}
      | o = \ge
      | r = \frac {9 \paren {a + b + c} } {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = as $\dfrac {a + b + c} {\paren {b + c} + \paren {a + c} + \paren {a + b} } = \dfrac 1 2$
}}
{{eqn | ll= \leadstoandfrom
      | l = \frac {\frac 1 {b + c} + \frac 1 {a + c} + \frac 1 {a + b} } 3
      | o = \ge
      | r = \frac 3 {\paren {b + c} + \paren {a + c} + \paren {a + b} }
      | c = dividing by $3 \paren {a + b + c}$
}}
{{end-eqn}}
These are the arithmetic mean and the harmonic mean of $\dfrac 1 {b + c}$, $\dfrac 1 {a + c}$ and $\dfrac 1 {a + b}$.

From Arithmetic Mean is Never Less than Harmonic Mean the last inequality is true.

Thus Nesbitt's Inequality holds.
{{qed}}

-/
theorem  nesbitt_inequality {a b c : ℝ} (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : (a / (b + c)) + (b / (a + c)) + (c / (a + b)) ≥ (3 / 2) :=
FEW SHOT PROMPTS TO CODEX(END)-/


section pred_logic

variables X Y Z : Prop

/- *** TRUE AND FALSE *** -/

/-
In propositional logic, the literal expressions, true
and false, are part of the syntax of the logic, with
obvious interpretations. The "true" expression always
evaluates to Boolean true, and the "false" expression
to Boolean false. We could thus write expressions such
as (X ∨ false) and (X ∧ true).

In predicate logic we have the same concepts exactly.
In first order predicate logic, true is a proposition
that is invariably judged to be true, and false is a
proposition that is invariable false.

In the higher-order predicate logic defined in Lean,
true and false are also propositions, as we can see
with the following checks and an example.
-/

#check true
#check false
#check ∀ (P : Prop), P ∨ true

/-
As with all of the basic connectives and quantifiers,
the *meanings* of these terms are established by their
inference rules. We address the rules for each one now.
-/

/-
We want "true" to be a proposition that is always true.
In constructive logic, that means there's always a proof
of it. Indeed, in Lean, that proof is called true.intro.
The way to prove that "true" is true is by giving this
proof as evidence.
-/

theorem true_is_true : true := true.intro

/-
In other words, there's always a trivial proof lying
around to prove that the proposition, "true," is true.
Let's decode that theorem:
- "theorem" says we're about to prove a proposition
- the proposition in this case is "true"
- and the proof is true.intro
The Lean prover accepts this proof as correct. It is.
Simply put, true.intro is the introduction rule for the
proposition, "true," in Lean.
-/

/-
What about the elimination rule for true? Well, having
a proof of true gives you essentially zero information,
so there's nothing useful you can really do with a proof
of true. Thus there is no elimination rule for true.
-/

/-
Next, we want the inference rules for the proposition,
"false" to capture two ideas. First, the proposition
"false" must always be logically false. In first-order
logic, that's all there is to it. In the constructive
logic of Lean, the proposition "false," is logically
false *because it is defined to be a proposition that
has no proofs.* Because it has no proofs, there is no
introduction rule for "false." If there were, then we
would be able to use it to construct a proof of false,
which can't exist." There is thus *no possible way* to
complete the following definition.
-/

theorem a_proof_of_false : false := _   -- no can do!

/-
Now we get to the most interesting and important rule:
false elimination, or the elimination rule for "false."

As you recall, in propositional logic, false → X is
always true, no matter whether X is true or false.
So, false → false is true, and false → true is true.

Now suppose P is any proposition in first-order logic.
The elimination rule for "false" is false ⊢ P. In
other words, if you assume or have somehow proven
false (which is possible from a false premise), then
you can deduce that anything at all is true: including
P, no matter what proposition it is, even if it's a
false proposition. As they say, "from false anything
follows," or, in Latin, "ex falso quodlibet."

This principle makes good sense, because if false is
true (the premise), then even if a proposition, P, is
false, false is true, so P is true (too)!
-/

/-
A little practice. Which of the following propositions
in predicate logic is true?
-/

def p1 : Prop := false → false
def p2 : Prop := false → true
def p3 : Prop := true → true
def p4 : Prop := true → false
def p5 : Prop := false → 2 = 3
def p6 : Prop := false → 0 = 0
def p7 : Prop := ∀ (P : Prop), true → P
def p8 : Prop := ∀ (P : Prop), false → P

theorem p8_is_true : p8 :=
begin
unfold p8,
assume P,
assume f,
apply false.elim f,
end

/-
For each proposition, state whether it's true or false
then give a proof of it (in English). Here are some formal
proofs to help.
-/

-- def p1 : Prop := false → false
theorem x : p1 :=
begin
  unfold p1,
  assume f : false,
  exact f,
end

-- false → true
example : p2 :=
begin
  unfold p2,
  assume f,           -- move premise into context
  --exact true.intro,   -- don't have to use assumption
  -- apply false.elim f,
  contradiction,
end

example : p3 :=
begin
unfold p3,
assume t,
exact t,    -- exact true.intro also works
end

example : p4 :=
begin
unfold p4,
assume t,
end

example : p5 :=
begin
unfold p5,
assume f,
cases f,
end

example : p6 :=
begin
unfold p6,
assume f,
cases f,
-- exact rfl,
end
/-
What? The cases tactic applies the elimination rule to
an assumed or derived proof of false. For each of the
ways that the proof, f, could have been constructed,
you have a case to consider; but there are no ways a
proof of false can be constructed so you have no cases
to consider, so the proof is done! This is another way
to understand how/why false elimination works in the
constructive logic of Lean and other similar tools.
-/

example : p7 :=
begin
unfold p7,
intro P,
assume t,
-- stuck
end

example : p8 :=
begin
unfold p8,
assume P f,
cases f,
end


/-
References:

Lectures on the Curry-Howard Isomorphism
Morten Heine Sørensen
Pawel Urzyczyn
Jul 2006
Elsevier
https://play.google.com/store/books/details/Morten_Heine_S%C3%B8rensen_Lectures_on_the_Curry_Howard?id=_mtnm-9KtbEC&hl=en
-/

import tactic

def var := ℕ

inductive term : Type
| var : var → term
| app : term → term → term
-- term.abs y P = λ y . P
| abs : var → term → term

def FV : term → set var
| (term.var x) := {x}
| (term.app P Q) := (FV P) ∪ (FV Q)
| (term.abs x P) := (FV P) \ {x}

lemma simp_term_var
(x : var) (y : var) :
x ∈ FV (term.var y) ↔ x = y :=
begin
unfold FV,
simp only [set.mem_singleton_iff]
end

lemma simp_term_app
(x : var) (P : term) (Q : term) :
x ∈ FV (term.app P Q) ↔ x ∈ FV P ∨ x ∈ FV Q :=
begin
unfold FV,
simp only [set.mem_union_eq]
end

lemma simp_term_app_not
(x : var) (P : term) (Q : term) :
x ∉ FV (term.app P Q) ↔ x ∉ FV P ∧ x ∉ FV Q :=
begin
unfold FV,
simp only [set.mem_union_eq],
push_neg,
exact iff.rfl
end

lemma simp_term_abs
(x : var) (y : var) (P : term) :
x ∈ FV (term.abs y P) ↔ x ∈ FV P ∧ x ≠ y :=
begin
unfold FV,
simp only [set.mem_diff, set.mem_singleton_iff]
end

lemma misc_1
{x : var} {y : var} {P : term}
(H1 : x ∈ FV P)
(H2 : x ≠ y) :
x ∈ FV (term.abs y P) :=
begin
simp only [simp_term_abs],
exact and.intro H1 H2
end

lemma misc_2
{x : var} {y : var} {P : term}
(H1 : x ∈ FV (term.abs y P)) :
x ∈ FV P :=
begin
simp only [simp_term_abs] at H1,
cases H1,
exact H1_left
end

lemma misc_3
{x : var} {y : var} {P : term}
(H1 : x ∈ FV (term.abs y P)) :
x ≠ y :=
begin
simp only [simp_term_abs] at H1,
cases H1,
exact H1_right
end

lemma misc_4
{x : var} {y : var} {P : term}
(H1 : x = y) :
x ∉ FV (term.abs y P) :=
begin
simp only [simp_term_abs],
push_neg,
intro, exact H1
end

lemma misc_5
{x : var} {y : var} {P : term}
(H1 : x ∉ FV P) :
x ∉ FV (term.abs y P) :=
begin
simp only [simp_term_abs],
push_neg,
intro H2, by_contradiction, apply H1, exact H2
end

lemma misc_6
{x : var} {y : var} {P : term}
(H1 : x ∉ FV (term.abs y P))
(H2 : x ∈ FV P) :
x = y :=
begin
simp only [simp_term_abs] at H1,
push_neg at H1,
exact H1 H2
end

lemma misc_7
{x : var} {y : var} {P : term}
(H1 : x ∉ FV (term.abs y P))
(H2 : x ≠ y) :
x ∉ FV P :=
begin
simp only [simp_term_abs] at H1,
push_neg at H1,
intro H3, apply H2, exact H1 H3
end

-- sub_is_def M x N means M [ x := N ] is defined
inductive sub_is_def : term → var → term → Prop

-- y [ x := N ] is defined
| var {y : var} {x : var} {N : term} :
  sub_is_def (term.var y) x N

-- P [ x := N ] is defined → Q [ x := N ] is defined → (P Q) [ x := N ] is defined
| app {P : term} {Q : term} {x : var} {N : term} :
  sub_is_def P x N → sub_is_def Q x N → sub_is_def (term.app P Q) x N

-- x = y → ( λ y . P ) [ x := N ] is defined
| abs_same {y : var} {P : term} {x : var} {N : term} :
  x = y → sub_is_def (term.abs y P) x N

-- x ≠ y → x ∉ FV ( λ y . P ) → ( λ y . P ) [ x := N ] is defined
| abs_diff_nel {y : var} {P : term} {x : var} {N : term} :
  x ≠ y → x ∉ FV (term.abs y P) → sub_is_def (term.abs y P) x N

-- x ≠ y → y ∉ FV ( N ) → P [ x := N ] is defined → ( λ y . P ) [ x := N ] is defined
| abs_diff {y : var} {P : term} {x : var} {N : term} :
  x ≠ y → y ∉ FV N → sub_is_def P x N → sub_is_def (term.abs y P) x N

notation M `[` x `:=` N `]` `is_def` := sub_is_def M x N

-- M [ x := N ]
def sub : term → var → term → term
-- if x = y then y [ x := N ] = N else y [ x := N ] = y
| (term.var y) x N := if x = y then N else term.var y

-- (P Q) [ x := N ] = (P [ x := N ] Q [ x := N ])
| (term.app P Q) x N := term.app (sub P x N) (sub Q x N)

-- if x = y then ( λ y . P ) [ x := N ] = ( λ y . P ) else ( λ y . P ) [ x := N ] = ( λ y . P [ x := N ] )
| (term.abs y P) x N := if x = y then term.abs y P else term.abs y (sub P x N)

notation M `[` x `:=` N `]` := sub M x N

-- is_sub M x N L means M [ x := N ] = L
inductive is_sub : term → var → term → term → Prop

-- if x = y then y [ x := N ] = N
| var_same {y : var} {x : var} {N : term} :
  x = y → is_sub (term.var y) x N N

-- if x ≠ y then y [ x := N ] = y
| var_diff {y : var} {x : var} {N : term} :
  x ≠ y → is_sub (term.var y) x N (term.var y)

-- (P Q) [ x := N ] = (P [ x := N ] Q [ x := N ])
| app {P : term} {Q : term} {x : var} {N : term} {P' : term} {Q' : term} :
  is_sub P x N P' → is_sub Q x N Q' → is_sub (term.app P Q) x N (term.app P' Q')

-- if x = y then ( λ y . P ) [ x := N ] = ( λ y . P )
| abs_same {y : var} {P : term} {x : var} {N : term} :
  x = y → is_sub (term.abs y P) x N (term.abs y P)

-- if x ≠ y then ( λ y . P ) [ x := N ] = ( λ y . P [ x := N ] )

| abs_diff_nel {y : var} {P : term} {x : var} {N : term} {P' : term} :
  x ≠ y → x ∉ FV (term.abs y P) → is_sub P x N P' → is_sub (term.abs y P) x N (term.abs y P')

| abs_diff {y : var} {P : term} {x : var} {N : term} {P' : term} :
  x ≠ y → y ∉ FV N → is_sub P x N P' → is_sub (term.abs y P) x N (term.abs y P')

lemma simp_var_same
{y : var} {x : var} {N : term}
(H1 : x = y) :
(term.var y) [ x := N ] = N := if_pos H1

lemma simp_var_diff
{y : var} {x : var} {N : term}
(H1 : x ≠ y) :
(term.var y) [ x := N ] = term.var y := if_neg H1

lemma simp_abs_same
{y : var} {P : term} {x : var} {N : term}
(H1 : x = y) :
(term.abs y P) [ x := N ] = term.abs y P := if_pos H1

lemma simp_abs_diff
{y : var} {P : term} {x : var} {N : term}
(H1 : x ≠ y) :
(term.abs y P) [ x := N ] = term.abs y (P [ x := N ]) := if_neg H1

lemma lemma_1_2_5_i_a
{M : term} {x : var} {N : term}
(H1 : x ∉ FV M) :
M [ x := N ] is_def :=
begin
induction M,
case term.var : y
{
  exact sub_is_def.var
},
case term.app : P Q IH_P IH_Q
{
  simp only [simp_term_app_not] at H1,
  cases H1,
  specialize IH_P H1_left,
  specialize IH_Q H1_right,
  exact sub_is_def.app IH_P IH_Q
},
case term.abs : y P
{
  by_cases h_xy : x = y,
  exact sub_is_def.abs_same h_xy,
  exact sub_is_def.abs_diff_nel h_xy H1
}
end

lemma lemma_1_2_5_i_b
{M : term} {x : var} {N : term}
(H1 : x ∉ FV M) :
M [ x := N ] = M :=
begin
induction M,
case term.var : y
{
  exact if_neg H1
},
case term.app : P Q IH_P IH_Q
{
  unfold sub,
  simp only [simp_term_app_not] at H1,
  cases H1,
  specialize IH_P H1_left,
  specialize IH_Q H1_right,
  rewrite IH_P, rewrite IH_Q
},
case term.abs : y P IH
{
  by_cases h_xy : x = y,
  {
    exact if_pos h_xy
  },
  {
    have s1 : x ∉ FV P, exact misc_7 H1 h_xy,
    specialize IH s1,
    rewrite simp_abs_diff h_xy,
    rewrite IH
  }
}
end

lemma lemma_1_2_5_i
{M : term} {x : var} {N : term}
(H1 : x ∉ FV M) :
is_sub M x N M :=
begin
induction M,
case term.var : y
{
  simp only [simp_term_var] at H1,
  exact is_sub.var_diff H1
},
case term.app : P Q IH_P IH_Q
{
  simp only [simp_term_app_not] at H1,
  cases H1,
  specialize IH_P H1_left,
  specialize IH_Q H1_right,
  exact is_sub.app IH_P IH_Q
},
case term.abs : y P IH
{
  by_cases h_xy : x = y,
  {
    exact is_sub.abs_same h_xy
  },
  {
    have s1 : x ∉ FV P, exact misc_7 H1 h_xy,
    specialize IH s1,
    exact is_sub.abs_diff_nel h_xy H1 IH
  }
}
end

example
(M : term) (x : var) (N : term) (L : term)
(H1 : is_sub M x N L) :
M [ x := N ] = L :=
begin
induction H1,
exact if_pos H1_ᾰ,
exact if_neg H1_ᾰ,
unfold sub, rewrite H1_ih_ᾰ, rewrite H1_ih_ᾰ_1,
exact if_pos H1_ᾰ,
rewrite <- H1_ih, exact if_neg H1_ᾰ,
rewrite <- H1_ih, exact if_neg H1_ᾰ,
end

example
(M : term) (x : var) (N : term)
(H1 : ∃ (L : term), is_sub M x N L) :
M [ x := N ] is_def :=
begin
apply exists.elim H1,
intros L,
intros h,
induction h,
case is_sub.var_same : y x N h
{
  exact sub_is_def.var
},
case is_sub.var_diff : y x N h
{
  exact sub_is_def.var
},
case is_sub.app : P Q x N P' Q' IH_P' IH_Q' IH_P IH_Q
{
  apply sub_is_def.app, apply IH_P, existsi P', exact IH_P', apply IH_Q, existsi Q', exact IH_Q'
},
case is_sub.abs_same : y P x N h
{
  exact sub_is_def.abs_same h
},
case is_sub.abs_diff_nel : y P x N P' h1 h2 h3 IH
{
  exact sub_is_def.abs_diff_nel h1 h2
},
case is_sub.abs_diff : y P x N P' h1 h2 h3 IH
{
  apply sub_is_def.abs_diff h1 h2, apply IH, existsi P', exact h3
}
end

example
(M : term) (x : var) (N : term)
(H1 : M [ x := N ] is_def) :
is_sub M x N (M [ x := N ]) :=
begin
induction M,
case term.var : y
{
  by_cases h_xy : x = y,
  {
    rewrite simp_var_same h_xy,
    exact is_sub.var_same h_xy
  },
  {
    rewrite simp_var_diff h_xy,
    exact is_sub.var_diff h_xy
  }
},
case term.app : P Q IH_P IH_Q
{
  unfold sub,
  cases H1,
  specialize IH_P H1_ᾰ,
  specialize IH_Q H1_ᾰ_1,
  exact is_sub.app IH_P IH_Q
},
case term.abs : y P IH
{
  cases H1,
  {
    rewrite simp_abs_same H1_ᾰ,
    exact is_sub.abs_same H1_ᾰ
  },
  {
    rewrite simp_abs_diff H1_ᾰ,
    have s1 : x ∉ FV P, exact misc_7 H1_ᾰ_1 H1_ᾰ,
    have s2 : P [ x := N ] is_def, exact lemma_1_2_5_i_a s1,
    specialize IH s2,
    exact is_sub.abs_diff_nel H1_ᾰ H1_ᾰ_1 IH
  },
  {
    rewrite simp_abs_diff H1_ᾰ,
    specialize IH H1_ᾰ_2,
    exact is_sub.abs_diff H1_ᾰ H1_ᾰ_1 IH
  }
}
end

lemma misc_5'
{x : var} {y : var} {P : term} {N : term}
(H1 : x ∉ FV P) :
(term.abs y P) [ x := N ] = term.abs y P :=
begin
have s1 : x ∉ FV (term.abs y P), exact misc_5 H1,
exact lemma_1_2_5_i_b s1
end

lemma misc_7'
{x : var} {y : var} {P : term} {N : term}
(H1 : x ∉ FV (term.abs y P))
(H2 : x ≠ y) :
P [ x := N ] = P :=
begin
have s1 : x ∉ FV P, exact misc_7 H1 H2,
exact lemma_1_2_5_i_b s1
end

lemma lemma_1_2_5_ii_right
(M : term) (x : var) (N : term) (z : var)
(H1 : M [ x := N ] is_def)
(H2 : z ∈ FV (M [ x := N ])) :
(z ∈ FV M ∧ x ≠ z) ∨ (z ∈ FV N ∧ x ∈ FV M) :=
begin
induction H1,
case sub_is_def.var : y x N
{
  simp only [simp_term_var],
  by_cases h_xy : x = y,
  {
    rewrite simp_var_same h_xy at H2,
    apply or.intro_right, exact and.intro H2 h_xy,
  },
  {
    rewrite simp_var_diff h_xy at H2,
    simp only [simp_term_var] at H2,
    rewrite <- H2 at h_xy,
    apply or.intro_left, exact and.intro H2 h_xy,
  }
},
case sub_is_def.app : P Q x N H1_P H1_Q IH_P IH_Q
{
  unfold sub at H2,
  simp only [simp_term_app] at H2,
  simp only [simp_term_app],
  cases H2,
  {
    specialize IH_P H2,
    cases IH_P,
    {
      cases IH_P,
      apply or.intro_left,
      apply and.intro,
      apply or.intro_left, exact IH_P_left,
      exact IH_P_right
    },
    {
      cases IH_P,
      apply or.intro_right,
      apply and.intro,
      exact IH_P_left,
      apply or.intro_left, exact IH_P_right
    }
  },
  {
    specialize IH_Q H2,
    cases IH_Q,
    {
      cases IH_Q,
      apply or.intro_left,
      apply and.intro,
      apply or.intro_right, exact IH_Q_left,
      exact IH_Q_right
    },
    {
      cases IH_Q,
      apply or.intro_right,
      apply and.intro,
      exact IH_Q_left,
      apply or.intro_right, exact IH_Q_right
    }
  }
},
case sub_is_def.abs_same : y P x N IH_1
{
  rewrite simp_abs_same IH_1 at H2,
  apply or.intro_left,
  apply and.intro,
  exact H2,
  rewrite IH_1, symmetry, exact misc_3 H2
},
case sub_is_def.abs_diff_nel : y P x N IH_1 IH_2
{
  rewrite lemma_1_2_5_i_b IH_2 at H2,
  apply or.intro_left,
  apply and.intro,
  exact H2,
  intros h, apply IH_2, rewrite h, exact H2
},
case sub_is_def.abs_diff : y P x N IH_1 IH_2 IH_3 IH_4
{
  simp only [simp_term_abs],
  rewrite simp_abs_diff IH_1 at H2,
  simp only [simp_term_abs] at H2,
  cases H2,
  specialize IH_4 H2_left,
  cases IH_4,
  {
    cases IH_4,
    apply or.intro_left,
    apply and.intro,
    exact and.intro IH_4_left H2_right,
    exact IH_4_right
  },
  {
    cases IH_4,
    apply or.intro_right,
    apply and.intro,
    exact IH_4_left,
    exact and.intro IH_4_right IH_1
  }
}
end

lemma lemma_1_2_5_ii_left
(M : term) (x : var) (N : term) (z : var)
(H1 : M [ x := N ] is_def)
(H2 : (z ∈ FV M ∧ x ≠ z) ∨ (z ∈ FV N ∧ x ∈ FV M)) :
z ∈ FV (M [ x := N ]) :=
begin
induction H1,
case sub_is_def.var : y x N
{
  simp only [simp_term_var] at H2,
  cases H2,
  {
    cases H2,
    rewrite H2_left at H2_right,
    rewrite simp_var_diff H2_right,
    simp only [simp_term_var],
    exact H2_left,
  },
  {
    cases H2,
    rewrite simp_var_same H2_right,
    exact H2_left
  }
},
case sub_is_def.app : P Q x N H1_P H1_Q IH_P IH_Q
{
  unfold sub,
  simp only [simp_term_app],
  simp only [simp_term_app] at H2,
  cases H2,
  {
    cases H2,
    cases H2_left,
    {
      apply or.intro_left,
      apply IH_P,
      apply or.intro_left, exact and.intro H2_left H2_right
    },
    {
      apply or.intro_right,
      apply IH_Q,
      apply or.intro_left, exact and.intro H2_left H2_right
    }
  },
  {
    cases H2,
    cases H2_right,
    {
      apply or.intro_left,
      apply IH_P,
      apply or.intro_right, exact and.intro H2_left H2_right
    },
    {
      apply or.intro_right,
      apply IH_Q,
      apply or.intro_right, exact and.intro H2_left H2_right
    }
  }
},
case sub_is_def.abs_same : y P x N IH_1
{
  rewrite simp_abs_same IH_1,
  cases H2,
  {
    cases H2, exact H2_left
  },
  {
    cases H2,
    simp only [simp_term_abs] at H2_right,
    cases H2_right, specialize H2_right_right IH_1, contradiction
  }
},
case sub_is_def.abs_diff_nel : y P x N IH_1 IH_2
{
  rewrite lemma_1_2_5_i_b IH_2,
  cases H2,
  cases H2, exact H2_left,
  cases H2, specialize IH_2 H2_right, contradiction
},
case sub_is_def.abs_diff : y P x N IH_1 IH_2 IH_3 IH_4
{
  rewrite simp_abs_diff IH_1,
  simp only [simp_term_abs] at H2,
  simp only [simp_term_abs],
  cases H2,
  {
    cases H2, cases H2_left,
    apply and.intro,
    apply IH_4, apply or.intro_left, exact and.intro H2_left_left H2_right,
    exact H2_left_right
  },
  {
    cases H2, cases H2_right,
    apply and.intro,
    apply IH_4, apply or.intro_right, exact and.intro H2_left H2_right_left,
    intros h, apply IH_2, rewrite <- h, exact H2_left
  }
}
end

lemma lemma_1_2_5_ii
{M : term} {x : var} {N : term} {z : var}
(H1 : M [ x := N ] is_def) :
z ∈ FV (M [ x := N ]) ↔ (z ∈ FV M ∧ x ≠ z) ∨ (z ∈ FV N ∧ x ∈ FV M) :=
iff.intro (lemma_1_2_5_ii_right M x N z H1) (lemma_1_2_5_ii_left M x N z H1)

lemma lemma_1_2_5_iii_a
{M : term} {x : var} :
M [ x  := (term.var x) ] is_def :=
begin
induction M,
case term.var : y
{
  exact sub_is_def.var
},
case term.app : P Q IH_P IH_Q
{
  exact sub_is_def.app IH_P IH_Q
},
case term.abs : y P IH
{
  by_cases h_xy : x = y,
  {
    exact sub_is_def.abs_same h_xy
  },
  {
    have s1 : y ≠ x, intro h2, apply h_xy, symmetry, exact h2,
    have s2 : y ∉ FV (term.var x), simp only [simp_term_var], exact s1,
    exact sub_is_def.abs_diff h_xy s2 IH
  }
}
end

lemma lemma_1_2_5_iii_b
{M : term} {x : var} :
M [ x := (term.var x) ] = M :=
begin
induction M,
case term.var : y
{
  by_cases h_xy : x = y,
  rewrite h_xy, apply if_pos, reflexivity,
  exact if_neg h_xy
},
case term.app : P Q IH_P IH_Q
{
  unfold sub, rewrite IH_P, rewrite IH_Q
},
case term.abs : y P IH
{
  by_cases h_xy : x = y,
  {
    rewrite <- IH,
    exact if_pos h_xy
  },
  {
    rewrite simp_abs_diff h_xy,
    rewrite IH
  }
}
end

lemma lemma_1_2_5_iii
{M : term} {x : var} :
is_sub M x (term.var x) M :=
begin
induction M,
case term.var : y
{
  by_cases h_xy : x = y,
  rewrite h_xy, apply is_sub.var_same, reflexivity,
  exact is_sub.var_diff h_xy
},
case term.app : P Q IH_P IH_Q
{
  exact is_sub.app IH_P IH_Q
},
case term.abs : y P IH
{
  by_cases h_xy : x = y,
  exact is_sub.abs_same h_xy,
  apply is_sub.abs_diff h_xy,
  intro h, apply h_xy, symmetry, simp only [simp_term_var] at h, exact h, exact IH
}
end

lemma lemma_1_2_6_a_left
(M N L : term) (x y : var)
(H1 : M [ x := N ] is_def)
(H2 : N [ y := L ] is_def)
(H3 : (M [ x := N ]) [ y := L ] is_def)
(H4 : x ≠ y)
(H5 : x ∉ FV L ∨ y ∉ FV M) :
M [ y := L ] is_def :=
begin
induction M,
case term.var : z
{
  exact sub_is_def.var
},
case term.app : P Q IH_P IH_Q
{
  cases H1,
  cases H3,
  simp only [simp_term_app_not] at H5,
  apply sub_is_def.app,
  {
    apply IH_P H1_ᾰ H3_ᾰ,
    cases H5,
    apply or.intro_left, exact H5,
    cases H5, apply or.intro_right, exact H5_left,
  },
  {
    apply IH_Q H1_ᾰ_1 H3_ᾰ_1,
    cases H5,
    apply or.intro_left, exact H5,
    cases H5, apply or.intro_right, exact H5_right
  }
},
case term.abs : z P
{
  cases H1,
  {
    rewrite simp_abs_same H1_ᾰ at H3,
    exact H3
  },
  {
    rewrite simp_abs_diff H1_ᾰ at H3,
    have s1 : P [ x := N ] = P, exact misc_7' H1_ᾰ_1 H1_ᾰ,
    rewrite s1 at H3,
    exact H3
  },
  {
    rewrite simp_abs_diff H1_ᾰ at H3,
    cases H3,
    {
      exact sub_is_def.abs_same H3_ᾰ
    },
    {
      apply sub_is_def.abs_diff_nel H3_ᾰ,
      have s1 : y ∉ FV (P [ x := N ]), exact misc_7 H3_ᾰ_1 H3_ᾰ,
      have s2 : y ∉ FV P,
      simp only [lemma_1_2_5_ii H1_ᾰ_2] at s1,
      push_neg at s1,
      cases s1, intros h, specialize s1_left h, apply H4, exact s1_left,
      exact misc_5 s2
    },
    {
      apply sub_is_def.abs_diff H3_ᾰ H3_ᾰ_1,
      apply M_ih H1_ᾰ_2 H3_ᾰ_2,
      cases H5,
      apply or.intro_left, exact H5,
      apply or.intro_right, exact misc_7 H5 H3_ᾰ
    }
  }
}
end

lemma lemma_1_2_6_a_right
(M N L : term) (x y : var)
(H1 : M [ x := N ] is_def)
(H2 : N [ y := L ] is_def)
(H3 : (M [ x := N ]) [ y := L ] is_def)
(H4 : x ≠ y)
(H5 : x ∉ FV L ∨ y ∉ FV M) :
(M [ y := L ]) [ x := N [ y := L ] ] is_def :=
begin
induction M,
case term.var : z
{
  by_cases h_yz : y = z,
  {
    rewrite simp_var_same h_yz,
    cases H5,
    exact lemma_1_2_5_i_a H5,
    simp only [simp_term_var] at H5, specialize H5 h_yz, contradiction
  },
  {
    rewrite simp_var_diff h_yz,
    exact sub_is_def.var
  }
},
case term.app : P Q IH_1 IH_2
{
  cases H1,
  cases H3,
  simp only [simp_term_app_not] at H5,
  apply sub_is_def.app,
  apply IH_1 H1_ᾰ H3_ᾰ,
  cases H5,
  apply or.intro_left, exact H5,
  cases H5, apply or.intro_right, exact H5_left,
  apply IH_2 H1_ᾰ_1 H3_ᾰ_1,
  cases H5,
  apply or.intro_left, exact H5,
  cases H5, apply or.intro_right, exact H5_right
},
case term.abs : z P
{
  cases H1,
  {
    have s1 : y ≠ z, rewrite H1_ᾰ at H4, symmetry, exact H4,
    rewrite simp_abs_diff s1,
    exact sub_is_def.abs_same H1_ᾰ
  },
  {
    rewrite simp_abs_diff H1_ᾰ at H3,
    have s1 : x ∉ FV P, exact misc_7 H1_ᾰ_1 H1_ᾰ,
    rewrite lemma_1_2_5_i_b s1 at H3,
    cases H3,
    {
      rewrite simp_abs_same H3_ᾰ,
      apply sub_is_def.abs_diff_nel H1_ᾰ, exact misc_5 s1
    },
    {
      rewrite lemma_1_2_5_i_b H3_ᾰ_1,
      exact lemma_1_2_5_i_a H1_ᾰ_1
    },
    {
      rewrite simp_abs_diff H3_ᾰ,
      apply sub_is_def.abs_diff_nel H1_ᾰ,
      apply misc_5,
      simp only [lemma_1_2_5_ii H3_ᾰ_2], push_neg,
      apply and.intro,
      intros, specialize s1 ᾰ, contradiction,
      intros,
      cases H5,
      specialize H5 ᾰ, contradiction,
      exact misc_7 H5 H3_ᾰ
    }
  },
  {
    rewrite simp_abs_diff H1_ᾰ at H3,
    cases H3,
    {
      rewrite simp_abs_same H3_ᾰ,
      apply sub_is_def.abs_diff H1_ᾰ,
      rewrite H3_ᾰ, rewrite lemma_1_2_5_i_b H1_ᾰ_1, exact H1_ᾰ_1,
      rewrite H3_ᾰ, rewrite lemma_1_2_5_i_b H1_ᾰ_1, exact H1_ᾰ_2
    },
    {
      rewrite simp_abs_diff H3_ᾰ,
      have s1 : y ∉ FV (P [ x := N ]), exact misc_7 H3_ᾰ_1 H3_ᾰ,
      simp only [lemma_1_2_5_ii H1_ᾰ_2] at s1, push_neg at s1, cases s1,
      have s2 : y ∉ FV P, intros h, specialize s1_left h, apply H4, exact s1_left,
      rewrite lemma_1_2_5_i_b s2,
      by_cases y ∈ FV N,
      {
        specialize s1_right h,
        have s3 : x ∉ FV (term.abs z P), exact misc_5 s1_right,
        exact lemma_1_2_5_i_a s3
      },
      {
        rewrite lemma_1_2_5_i_b h,
        exact sub_is_def.abs_diff H1_ᾰ H1_ᾰ_1 H1_ᾰ_2
      }
    },
    {
      rewrite simp_abs_diff H3_ᾰ,
      apply sub_is_def.abs_diff H1_ᾰ,
      simp only [lemma_1_2_5_ii H2], push_neg,
      apply and.intro,
      intros, specialize H1_ᾰ_1 ᾰ, contradiction,
      intros, specialize H3_ᾰ_1 ᾰ, contradiction,
      apply M_ih H1_ᾰ_2 H3_ᾰ_2,
      cases H5,
      apply or.intro_left, exact H5,
      apply or.intro_right, exact misc_7 H5 H3_ᾰ
    }
  }
}
end

lemma lemma_1_2_6_b
(M N L : term) (x y : var)
(H1 : M [ x := N ] is_def)
(H2 : N [ y := L ] is_def)
(H3 : (M [ x := N ]) [ y := L ] is_def)
(H4 : x ≠ y)
(H5 : x ∉ FV L ∨ y ∉ FV M) :
M [ x := N ] [ y := L ] = M [ y := L ] [ x := N [ y := L ] ] :=
begin
induction M,
case term.var : z
{
  by_cases h_xz : x = z,
  {
    have s1 : y ≠ z, rewrite <- h_xz, symmetry, exact H4,
    rewrite simp_var_diff s1,
    rewrite simp_var_same h_xz, rewrite simp_var_same h_xz
  },
  {
    rewrite simp_var_diff h_xz,
    by_cases h_yz : y = z,
    {
      rewrite simp_var_same h_yz,
      cases H5,
      {
        rewrite lemma_1_2_5_i_b H5,
      },
      {
        simp only [simp_term_var] at H5,
        specialize H5 h_yz, contradiction
      }
    },
    {
      rewrite simp_var_diff h_yz,
      rewrite simp_var_diff h_xz
    }
  }
},
case term.app : P Q IH_P IH_Q
{
  cases H1,
  cases H3,
  simp only [simp_term_app_not] at H5,
  cases H5,
  {
    have s1 : P [ x := N ] [ y := L ] = P [ y := L ] [ x:= N [ y:= L ] ],
    apply IH_P H1_ᾰ H3_ᾰ, apply or.intro_left, exact H5,
    have s2 : Q [ x := N ] [ y := L ] = Q [ y := L ] [ x:= N [ y:= L ] ],
    apply IH_Q H1_ᾰ_1 H3_ᾰ_1, apply or.intro_left, exact H5,
    unfold sub, rewrite s1, rewrite s2
  },
  {
    cases H5,
    have s1 : P [ x := N ] [ y := L ] = P [ y := L ] [ x:= N [ y:= L ] ],
    apply IH_P H1_ᾰ H3_ᾰ, apply or.intro_right, exact H5_left,
    have s2 : Q [ x := N ] [ y := L ] = Q [ y := L ] [ x:= N [ y:= L ] ],
    apply IH_Q H1_ᾰ_1 H3_ᾰ_1, apply or.intro_right, exact H5_right,
    unfold sub, rewrite s1, rewrite s2
  }
},
case term.abs : z P
{
  cases H1,
  {
    rewrite simp_abs_same H1_ᾰ,
    have s1 : y ≠ z, rewrite <- H1_ᾰ, symmetry, exact H4,
    rewrite simp_abs_diff s1,
    rewrite simp_abs_same H1_ᾰ
  },
  {
    rewrite simp_abs_diff H1_ᾰ,
    rewrite simp_abs_diff H1_ᾰ at H3,
    cases H3,
    {
      have s1 : x ∉ FV P, exact misc_7 H1_ᾰ_1 H1_ᾰ,
      rewrite lemma_1_2_5_i_b s1,
      rewrite simp_abs_same H3_ᾰ,
      rewrite simp_abs_diff H1_ᾰ,
      rewrite lemma_1_2_5_i_b s1
    },
    {
      have s1 : x ∉ FV P, exact misc_7 H1_ᾰ_1 H1_ᾰ,
      rewrite lemma_1_2_5_i_b s1,
      rewrite lemma_1_2_5_i_b s1 at H3_ᾰ_1,
      rewrite simp_abs_diff H3_ᾰ,
      have s2 : y ∉ FV P, exact misc_7 H3_ᾰ_1 H3_ᾰ,
      rewrite lemma_1_2_5_i_b s2,
      rewrite simp_abs_diff H1_ᾰ,
      rewrite lemma_1_2_5_i_b s1,
    },
    {
      have s1 : x ∉ FV P, exact misc_7 H1_ᾰ_1 H1_ᾰ,
      rewrite lemma_1_2_5_i_b s1,
      rewrite simp_abs_diff H3_ᾰ,
      rewrite simp_abs_diff H1_ᾰ,
      have s2 : P [ x := N ] is_def, exact lemma_1_2_5_i_a s1,
      have s3 : x ∉ FV L ∨ y ∉ FV P, cases H5, apply or.intro_left, exact H5, apply or.intro_right, exact misc_7 H5 H3_ᾰ,
      specialize M_ih s2 H3_ᾰ_2 s3,
      rewrite <- M_ih, rewrite lemma_1_2_5_i_b s1
    }
  },
  {
    rewrite simp_abs_diff H1_ᾰ,
    rewrite simp_abs_diff H1_ᾰ at H3,
    cases H3,
    {
      rewrite simp_abs_same H3_ᾰ,
      rewrite simp_abs_same H3_ᾰ,
      rewrite simp_abs_diff H1_ᾰ,
      rewrite <- H3_ᾰ at H1_ᾰ_1,
      rewrite lemma_1_2_5_i_b H1_ᾰ_1
    },
    {
      rewrite simp_abs_diff H3_ᾰ,
      rewrite simp_abs_diff H3_ᾰ,
      rewrite simp_abs_diff H1_ᾰ,
      have s1 : y ∉ FV (P [ x := N ]), exact misc_7 H3_ᾰ_1 H3_ᾰ,
      have s2 : P [ x := N ] [ y := L ] is_def, exact lemma_1_2_5_i_a s1,
      have s3 : x ∉ FV L ∨ y ∉ FV P, cases H5, apply or.intro_left, exact H5, apply or.intro_right, exact misc_7 H5 H3_ᾰ,
      specialize M_ih H1_ᾰ_2 s2 s3,
      rewrite M_ih
    },
    {
      rewrite simp_abs_diff H3_ᾰ,
      rewrite simp_abs_diff H3_ᾰ,
      rewrite simp_abs_diff H1_ᾰ,
      have s1 : x ∉ FV L ∨ y ∉ FV P, cases H5, apply or.intro_left, exact H5, apply or.intro_right, exact misc_7 H5 H3_ᾰ,
      specialize M_ih H1_ᾰ_2 H3_ᾰ_2 s1,
      rewrite M_ih
    }
  }
}
end


import MyNat.Definition
import MyNat.Addition -- add_zero
import MyNat.Inequality -- le_iff_exists_add
import Mathlib.Tactic.Use -- use tactic
import Mathlib.Tactic.Relation.Rfl -- rfl tactic
import AdditionWorld.Level4 -- add_comm
namespace MyNat
open MyNat
/-!

# Inequality world.

Here's a nice easy one.

## Level 2: le_refl

## Lemma :
The `≤` relation is reflexive. In other words, if `x` is a natural number,
then `x ≤ x`.
-/
lemma le_refl_mynat (x : MyNat) : x ≤ x := by
  use 0

/-!
## Upgrading the `rfl` tactic

Now with the following incantation you can teach the MathLib rfl tactic
about our new lemma.
-/
attribute [refl] MyNat.le_refl_mynat
/-!
Now we find that the `rfl` tactic will close all goals
of the form `a ≤ a` as well as all goals of the form `a = a`.
-/
example : (0 : MyNat) ≤ 0 := by
  rfl

/-!
## Pro tip

-- BUGBUG in lean4 `use 0` closes the proof, so no need for all this stuff
below -- so I need to move this info to another place where it makes sense.

Did you skip `rw [le_iff_exists_add]` in your proof of `le_refl_mynat` above?
Instead of `rw [add_zero]` or `ring` or `exact add_zero x` at the end there,
what happens if you just try `rfl`? The *definition* of `x + 0` is `x`,
so you don't need to `rw add_zero` either! The proof

```
use 0
```

works.

The same remarks are true of
`add_succ`, `mul_zero`, `mul_succ`, `pow_zero` and `pow_succ`. All of those
theorems are true *by definition*. The same is *not* true however of `zero_add`;
the theorem `0 + x = x` was proved by induction on `x`,
and in particular it is not true by *definition*.

Definitional equality is of great importance
to computer scientists, but mathematicians are much more fluid with their idea
of a definition -- a concept can simultaneously have three equivalent definitions
in a maths talk, as long as they're all logically equivalent. In Lean, a definition
is *one thing*, and definitional equality is a subtle concept which depends on
exactly which definition you chose. `add_comm` is certainly not true by definition,
which means that if we had decided to define `a ≤ b` by `∃ c, b = c + a` (rather
than `a + c`) all the same theorems would be true, but `rfl` would work in
different places. `rfl` closes a goal of the form `X = Y` if `X` and `Y` are
definitionally equal.

Next up [Level 3](./Level3.lean.md)
-/


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

! This file was ported from Lean 3 source module linear_algebra.matrix.absolute_value
! leanprover-community/mathlib commit ab0a2959c83b06280ef576bc830d4aa5fe8c8e61
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.AbsoluteValue
import Mathbin.LinearAlgebra.Matrix.Determinant

/-!
# Absolute values and matrices

This file proves some bounds on matrices involving absolute values.

## Main results

 * `matrix.det_le`: if the entries of an `n × n` matrix are bounded by `x`,
   then the determinant is bounded by `n! x^n`
 * `matrix.det_sum_le`: if we have `s` `n × n` matrices and the entries of each
   matrix are bounded by `x`, then the determinant of their sum is bounded by `n! (s * x)^n`
 * `matrix.det_sum_smul_le`: if we have `s` `n × n` matrices each multiplied by
   a constant bounded by `y`, and the entries of each matrix are bounded by `x`,
   then the determinant of the linear combination is bounded by `n! (s * y * x)^n`
-/

open BigOperators

open Matrix

namespace Matrix

open Equiv Finset

variable {R S : Type _} [CommRing R] [Nontrivial R] [LinearOrderedCommRing S]

variable {n : Type _} [Fintype n] [DecidableEq n]

theorem det_le {A : Matrix n n R} {abv : AbsoluteValue R S} {x : S} (hx : ∀ i j, abv (A i j) ≤ x) :
    abv A.det ≤ Nat.factorial (Fintype.card n) • x ^ Fintype.card n :=
  calc
    abv A.det = abv (∑ σ : Perm n, _) := congr_arg abv (det_apply _)
    _ ≤ ∑ σ : Perm n, abv _ := (abv.sum_le _ _)
    _ = ∑ σ : Perm n, ∏ i, abv (A (σ i) i) :=
      (sum_congr rfl fun σ hσ => by rw [abv.map_units_int_smul, abv.map_prod])
    _ ≤ ∑ σ : Perm n, ∏ i : n, x :=
      (sum_le_sum fun _ _ => prod_le_prod (fun _ _ => abv.NonNeg _) fun _ _ => hx _ _)
    _ = ∑ σ : Perm n, x ^ Fintype.card n :=
      (sum_congr rfl fun _ _ => by rw [prod_const, Finset.card_univ])
    _ = Nat.factorial (Fintype.card n) • x ^ Fintype.card n := by
      rw [sum_const, Finset.card_univ, Fintype.card_perm]

#align matrix.det_le Matrix.det_le

theorem det_sum_le {ι : Type _} (s : Finset ι) {A : ι → Matrix n n R} {abv : AbsoluteValue R S}
    {x : S} (hx : ∀ k i j, abv (A k i j) ≤ x) :
    abv (det (∑ k in s, A k)) ≤
      Nat.factorial (Fintype.card n) • (Finset.card s • x) ^ Fintype.card n :=
  det_le fun i j =>
    calc
      abv ((∑ k in s, A k) i j) = abv (∑ k in s, A k i j) := by simp only [sum_apply]
      _ ≤ ∑ k in s, abv (A k i j) := (abv.sum_le _ _)
      _ ≤ ∑ k in s, x := (sum_le_sum fun k _ => hx k i j)
      _ = s.card • x := sum_const _

#align matrix.det_sum_le Matrix.det_sum_le

theorem det_sum_smul_le {ι : Type _} (s : Finset ι) {c : ι → R} {A : ι → Matrix n n R}
    {abv : AbsoluteValue R S} {x : S} (hx : ∀ k i j, abv (A k i j) ≤ x) {y : S}
    (hy : ∀ k, abv (c k) ≤ y) :
    abv (det (∑ k in s, c k • A k)) ≤
      Nat.factorial (Fintype.card n) • (Finset.card s • y * x) ^ Fintype.card n :=
  by
  simpa only [smul_mul_assoc] using
    det_sum_le s fun k i j =>
      calc
        abv (c k * A k i j) = abv (c k) * abv (A k i j) := abv.map_mul _ _
        _ ≤ y * x := mul_le_mul (hy k) (hx k i j) (abv.nonneg _) ((abv.nonneg _).trans (hy k))

#align matrix.det_sum_smul_le Matrix.det_sum_smul_le

end Matrix