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

import data.int.modeq
import algebra.char_p.basic
import data.nat.totient
import ring_theory.ideal.operations
import tactic.fin_cases

/-!
# Integers mod `n`

Definition of the integers mod n, and the field structure on the integers mod p.

## Definitions

* `zmod n`, which is for integers modulo a nat `n : ℕ`

* `val a` is defined as a natural number:
  - for `a : zmod 0` it is the absolute value of `a`
  - for `a : zmod n` with `0 < n` it is the least natural number in the equivalence class

* `val_min_abs` returns the integer closest to zero in the equivalence class.

* A coercion `cast` is defined from `zmod n` into any ring.
This is a ring hom if the ring has characteristic dividing `n`

-/

namespace fin

/-!
## Ring structure on `fin n`

We define a commutative ring structure on `fin n`, but we do not register it as instance.
Afterwords, when we define `zmod n` in terms of `fin n`, we use these definitions
to register the ring structure on `zmod n` as type class instance.
-/

open nat nat.modeq int

/-- Multiplicative commutative semigroup structure on `fin (n+1)`. -/
instance (n : ℕ) : comm_semigroup (fin (n+1)) :=
{ mul_assoc := λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, fin.eq_of_veq
    (calc ((a * b) % (n+1) * c) ≡ a * b * c [MOD (n+1)] : modeq_mul (nat.mod_mod _ _) rfl
      ... ≡ a * (b * c) [MOD (n+1)] : by rw mul_assoc
      ... ≡ a * (b * c % (n+1)) [MOD (n+1)] : modeq_mul rfl (nat.mod_mod _ _).symm),
  mul_comm := λ ⟨a, _⟩ ⟨b, _⟩,
    fin.eq_of_veq (show (a * b) % (n+1) = (b * a) % (n+1), by rw mul_comm),
  ..fin.has_mul }

private lemma left_distrib_aux (n : ℕ) : ∀ a b c : fin (n+1), a * (b + c) = a * b + a * c :=
λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, fin.eq_of_veq
(calc a * ((b + c) % (n+1)) ≡ a * (b + c) [MOD (n+1)] : modeq_mul rfl (nat.mod_mod _ _)
  ... ≡ a * b + a * c [MOD (n+1)] : by rw mul_add
  ... ≡ (a * b) % (n+1) + (a * c) % (n+1) [MOD (n+1)] :
        modeq_add (nat.mod_mod _ _).symm (nat.mod_mod _ _).symm)

/-- Commutative ring structure on `fin (n+1)`. -/
instance (n : ℕ) : comm_ring (fin (n+1)) :=
{ one_mul := fin.one_mul,
  mul_one := fin.mul_one,
  left_distrib := left_distrib_aux n,
  right_distrib := λ a b c, by rw [mul_comm, left_distrib_aux, mul_comm _ b, mul_comm]; refl,
  ..fin.has_one,
  ..fin.add_comm_group n,
  ..fin.comm_semigroup n }

end fin

/-- The integers modulo `n : ℕ`. -/
def zmod : ℕ → Type
| 0     := ℤ
| (n+1) := fin (n+1)

namespace zmod

instance fintype : Π (n : ℕ) [fact (0 < n)], fintype (zmod n)
| 0     h := false.elim $ nat.not_lt_zero 0 h.1
| (n+1) _ := fin.fintype (n+1)

lemma card (n : ℕ) [fact (0 < n)] : fintype.card (zmod n) = n :=
begin
  casesI n,
  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
  { exact fintype.card_fin (n+1) }
end

instance decidable_eq : Π (n : ℕ), decidable_eq (zmod n)
| 0     := int.decidable_eq
| (n+1) := fin.decidable_eq _

instance has_repr : Π (n : ℕ), has_repr (zmod n)
| 0     := int.has_repr
| (n+1) := fin.has_repr _

instance comm_ring : Π (n : ℕ), comm_ring (zmod n)
| 0     := int.comm_ring
| (n+1) := fin.comm_ring n

instance inhabited (n : ℕ) : inhabited (zmod n) := ⟨0⟩

/-- `val a` is a natural number defined as:
  - for `a : zmod 0` it is the absolute value of `a`
  - for `a : zmod n` with `0 < n` it is the least natural number in the equivalence class

See `zmod.val_min_abs` for a variant that takes values in the integers.
-/
def val : Π {n : ℕ}, zmod n → ℕ
| 0     := int.nat_abs
| (n+1) := (coe : fin (n + 1) → ℕ)

lemma val_lt {n : ℕ} [fact (0 < n)] (a : zmod n) : a.val < n :=
begin
  casesI n,
  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
  exact fin.is_lt a
end

@[simp] lemma val_zero : ∀ {n}, (0 : zmod n).val = 0
| 0     := rfl
| (n+1) := rfl

@[simp] lemma val_one' : (1 : zmod 0).val = 1 := rfl
@[simp] lemma val_neg' {n : zmod 0} : (-n).val = n.val := by simp [val]
@[simp] lemma val_mul' {m n : zmod 0} : (m * n).val = m.val * n.val :=
by simp [val, int.nat_abs_mul]

lemma val_nat_cast {n : ℕ} (a : ℕ) : (a : zmod n).val = a % n :=
begin
  casesI n,
  { rw [nat.mod_zero, int.nat_cast_eq_coe_nat],
    exact int.nat_abs_of_nat a, },
  rw ← fin.of_nat_eq_coe,
  refl
end

instance (n : ℕ) : char_p (zmod n) n :=
{ cast_eq_zero_iff :=
  begin
    intro k,
    cases n,
    { simp only [int.nat_cast_eq_coe_nat, zero_dvd_iff, int.coe_nat_eq_zero], },
    rw [fin.eq_iff_veq],
    show (k : zmod (n+1)).val = (0 : zmod (n+1)).val ↔ _,
    rw [val_nat_cast, val_zero, nat.dvd_iff_mod_eq_zero],
  end }

@[simp] lemma nat_cast_self (n : ℕ) : (n : zmod n) = 0 :=
char_p.cast_eq_zero (zmod n) n

@[simp] lemma nat_cast_self' (n : ℕ) : (n + 1 : zmod (n + 1)) = 0 :=
by rw [← nat.cast_add_one, nat_cast_self (n + 1)]

section universal_property

variables {n : ℕ} {R : Type*}

section
variables [has_zero R] [has_one R] [has_add R] [has_neg R]

/-- Cast an integer modulo `n` to another semiring.
This function is a morphism if the characteristic of `R` divides `n`.
See `zmod.cast_hom` for a bundled version. -/
def cast : Π {n : ℕ}, zmod n → R
| 0     := int.cast
| (n+1) := λ i, i.val

-- see Note [coercion into rings]
@[priority 900] instance (n : ℕ) : has_coe_t (zmod n) R := ⟨cast⟩

@[simp] lemma cast_zero : ((0 : zmod n) : R) = 0 :=
by { cases n; refl }

end

/-- So-named because the coercion is `nat.cast` into `zmod`. For `nat.cast` into an arbitrary ring,
see `zmod.nat_cast_val`. -/
lemma nat_cast_zmod_val {n : ℕ} [fact (0 < n)] (a : zmod n) : (a.val : zmod n) = a :=
begin
  casesI n,
  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
  { apply fin.coe_coe_eq_self }
end

lemma nat_cast_right_inverse [fact (0 < n)] : function.right_inverse val (coe : ℕ → zmod n) :=
nat_cast_zmod_val

lemma nat_cast_zmod_surjective [fact (0 < n)] : function.surjective (coe : ℕ → zmod n) :=
nat_cast_right_inverse.surjective

/-- So-named because the outer coercion is `int.cast` into `zmod`. For `int.cast` into an arbitrary
ring, see `zmod.int_cast_cast`. -/
lemma int_cast_zmod_cast (a : zmod n) : ((a : ℤ) : zmod n) = a :=
begin
  cases n,
  { rw [int.cast_id a, int.cast_id a], },
  { rw [coe_coe, int.nat_cast_eq_coe_nat, int.cast_coe_nat, fin.coe_coe_eq_self] }
end

lemma int_cast_right_inverse : function.right_inverse (coe : zmod n → ℤ) (coe : ℤ → zmod n) :=
int_cast_zmod_cast

lemma int_cast_surjective : function.surjective (coe : ℤ → zmod n) :=
int_cast_right_inverse.surjective

@[norm_cast]
lemma cast_id : ∀ n (i : zmod n), ↑i = i
| 0     i := int.cast_id i
| (n+1) i := nat_cast_zmod_val i

@[simp]
lemma cast_id' : (coe : zmod n → zmod n) = id := funext (cast_id n)

variables (R) [ring R]

/-- The coercions are respectively `nat.cast` and `zmod.cast`. -/
@[simp] lemma nat_cast_comp_val [fact (0 < n)] :
  (coe : ℕ → R) ∘ (val : zmod n → ℕ) = coe :=
begin
  casesI n,
  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
  refl
end

/-- The coercions are respectively `int.cast`, `zmod.cast`, and `zmod.cast`. -/
@[simp] lemma int_cast_comp_cast : (coe : ℤ → R) ∘ (coe : zmod n → ℤ) = coe :=
begin
  cases n,
  { exact congr_arg ((∘) int.cast) zmod.cast_id', },
  { ext, simp }
end

variables {R}

@[simp] lemma nat_cast_val [fact (0 < n)] (i : zmod n) : (i.val : R) = i :=
congr_fun (nat_cast_comp_val R) i

@[simp] lemma int_cast_cast (i : zmod n) : ((i : ℤ) : R) = i :=
congr_fun (int_cast_comp_cast R) i

section char_dvd
/-! If the characteristic of `R` divides `n`, then `cast` is a homomorphism. -/

variables {n} {m : ℕ} [char_p R m]

@[simp] lemma cast_one (h : m ∣ n) : ((1 : zmod n) : R) = 1 :=
begin
  casesI n,
  { exact int.cast_one },
  show ((1 % (n+1) : ℕ) : R) = 1,
  cases n, { rw [nat.dvd_one] at h, substI m, apply subsingleton.elim },
  rw nat.mod_eq_of_lt,
  { exact nat.cast_one },
  exact nat.lt_of_sub_eq_succ rfl
end

lemma cast_add (h : m ∣ n) (a b : zmod n) : ((a + b : zmod n) : R) = a + b :=
begin
  casesI n,
  { apply int.cast_add },
  simp only [coe_coe],
  symmetry,
  erw [fin.coe_add, ← nat.cast_add, ← sub_eq_zero, ← nat.cast_sub (nat.mod_le _ _),
      @char_p.cast_eq_zero_iff R _ _ m],
  exact dvd_trans h (nat.dvd_sub_mod _),
end

lemma cast_mul (h : m ∣ n) (a b : zmod n) : ((a * b : zmod n) : R) = a * b :=
begin
  casesI n,
  { apply int.cast_mul },
  simp only [coe_coe],
  symmetry,
  erw [fin.coe_mul, ← nat.cast_mul, ← sub_eq_zero, ← nat.cast_sub (nat.mod_le _ _),
      @char_p.cast_eq_zero_iff R _ _ m],
  exact dvd_trans h (nat.dvd_sub_mod _),
end

/-- The canonical ring homomorphism from `zmod n` to a ring of characteristic `n`. -/
def cast_hom (h : m ∣ n) (R : Type*) [ring R] [char_p R m] : zmod n →+* R :=
{ to_fun := coe,
  map_zero' := cast_zero,
  map_one' := cast_one h,
  map_add' := cast_add h,
  map_mul' := cast_mul h }

@[simp] lemma cast_hom_apply {h : m ∣ n} (i : zmod n) : cast_hom h R i = i := rfl

@[simp, norm_cast]
lemma cast_sub (h : m ∣ n) (a b : zmod n) : ((a - b : zmod n) : R) = a - b :=
(cast_hom h R).map_sub a b

@[simp, norm_cast]
lemma cast_neg (h : m ∣ n) (a : zmod n) : ((-a : zmod n) : R) = -a :=
(cast_hom h R).map_neg a

@[simp, norm_cast]
lemma cast_pow (h : m ∣ n) (a : zmod n) (k : ℕ) : ((a ^ k : zmod n) : R) = a ^ k :=
(cast_hom h R).map_pow a k

@[simp, norm_cast]
lemma cast_nat_cast (h : m ∣ n) (k : ℕ) : ((k : zmod n) : R) = k :=
(cast_hom h R).map_nat_cast k

@[simp, norm_cast]
lemma cast_int_cast (h : m ∣ n) (k : ℤ) : ((k : zmod n) : R) = k :=
(cast_hom h R).map_int_cast k

end char_dvd

section char_eq
/-! Some specialised simp lemmas which apply when `R` has characteristic `n`. -/
variable [char_p R n]

@[simp] lemma cast_one' : ((1 : zmod n) : R) = 1 :=
cast_one (dvd_refl _)

@[simp] lemma cast_add' (a b : zmod n) : ((a + b : zmod n) : R) = a + b :=
cast_add (dvd_refl _) a b

@[simp] lemma cast_mul' (a b : zmod n) : ((a * b : zmod n) : R) = a * b :=
cast_mul (dvd_refl _) a b

@[simp] lemma cast_sub' (a b : zmod n) : ((a - b : zmod n) : R) = a - b :=
cast_sub (dvd_refl _) a b

@[simp] lemma cast_pow' (a : zmod n) (k : ℕ) : ((a ^ k : zmod n) : R) = a ^ k :=
cast_pow (dvd_refl _) a k

@[simp, norm_cast]
lemma cast_nat_cast' (k : ℕ) : ((k : zmod n) : R) = k :=
cast_nat_cast (dvd_refl _) k

@[simp, norm_cast]
lemma cast_int_cast' (k : ℤ) : ((k : zmod n) : R) = k :=
cast_int_cast (dvd_refl _) k

instance (R : Type*) [comm_ring R] [char_p R n] : algebra (zmod n) R :=
(zmod.cast_hom (dvd_refl n) R).to_algebra

variables (R)

lemma cast_hom_injective : function.injective (zmod.cast_hom (dvd_refl n) R) :=
begin
  rw ring_hom.injective_iff,
  intro x,
  obtain ⟨k, rfl⟩ := zmod.int_cast_surjective x,
  rw [ring_hom.map_int_cast, char_p.int_cast_eq_zero_iff R n,
    char_p.int_cast_eq_zero_iff (zmod n) n],
  exact id
end

lemma cast_hom_bijective [fintype R] (h : fintype.card R = n) :
  function.bijective (zmod.cast_hom (dvd_refl n) R) :=
begin
  haveI : fact (0 < n) :=
  ⟨begin
    rw [pos_iff_ne_zero],
    unfreezingI { rintro rfl },
    exact fintype.card_eq_zero_iff.mp h 0
  end⟩,
  rw [fintype.bijective_iff_injective_and_card, zmod.card, h, eq_self_iff_true, and_true],
  apply zmod.cast_hom_injective
end

/-- The unique ring isomorphism between `zmod n` and a ring `R`
of characteristic `n` and cardinality `n`. -/
noncomputable def ring_equiv [fintype R] (h : fintype.card R = n) : zmod n ≃+* R :=
ring_equiv.of_bijective _ (zmod.cast_hom_bijective R h)

end char_eq

end universal_property

lemma int_coe_eq_int_coe_iff (a b : ℤ) (c : ℕ) :
  (a : zmod c) = (b : zmod c) ↔ a ≡ b [ZMOD c] :=
char_p.int_coe_eq_int_coe_iff (zmod c) c a b

lemma int_coe_eq_int_coe_iff' (a b : ℤ) (c : ℕ) :
  (a : zmod c) = (b : zmod c) ↔ a % c = b % c :=
zmod.int_coe_eq_int_coe_iff a b c

lemma nat_coe_eq_nat_coe_iff (a b c : ℕ) :
  (a : zmod c) = (b : zmod c) ↔ a ≡ b [MOD c] :=
begin
  convert zmod.int_coe_eq_int_coe_iff a b c,
  simp [nat.modeq.modeq_iff_dvd, int.modeq.modeq_iff_dvd],
end

lemma int_coe_zmod_eq_zero_iff_dvd (a : ℤ) (b : ℕ) : (a : zmod b) = 0 ↔ (b : ℤ) ∣ a :=
begin
  change (a : zmod b) = ((0 : ℤ) : zmod b) ↔ (b : ℤ) ∣ a,
  rw [zmod.int_coe_eq_int_coe_iff, int.modeq.modeq_zero_iff],
end

lemma nat_coe_zmod_eq_zero_iff_dvd (a b : ℕ) : (a : zmod b) = 0 ↔ b ∣ a :=
begin
  change (a : zmod b) = ((0 : ℕ) : zmod b) ↔ b ∣ a,
  rw [zmod.nat_coe_eq_nat_coe_iff, nat.modeq.modeq_zero_iff],
end

@[push_cast, simp]
lemma int_cast_mod (a : ℤ) (b : ℕ) : ((a % b : ℤ) : zmod b) = (a : zmod b) :=
begin
  rw zmod.int_coe_eq_int_coe_iff,
  apply int.modeq.mod_modeq,
end

local attribute [semireducible] int.nonneg

@[simp] lemma nat_cast_to_nat (p : ℕ) :
  ∀ {z : ℤ} (h : 0 ≤ z), (z.to_nat : zmod p) = z
| (n : ℕ) h := by simp only [int.cast_coe_nat, int.to_nat_coe_nat]
| -[1+n]  h := false.elim h

lemma val_injective (n : ℕ) [fact (0 < n)] :
  function.injective (zmod.val : zmod n → ℕ) :=
begin
  casesI n,
  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
  assume a b h,
  ext,
  exact h
end

lemma val_one_eq_one_mod (n : ℕ) : (1 : zmod n).val = 1 % n :=
by rw [← nat.cast_one, val_nat_cast]

lemma val_add {n : ℕ} [fact (0 < n)] (a b : zmod n) : (a + b).val = (a.val + b.val) % n :=
begin
  casesI n,
  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
  { apply fin.val_add }
end

lemma val_mul {n : ℕ} (a b : zmod n) : (a * b).val = (a.val * b.val) % n :=
begin
  cases n,
  { rw nat.mod_zero, apply int.nat_abs_mul },
  { apply fin.val_mul }
end

instance nontrivial (n : ℕ) [fact (1 < n)] : nontrivial (zmod n) :=
⟨⟨0, 1, assume h, zero_ne_one $
   calc 0 = (0 : zmod n).val : by rw val_zero
      ... = (1 : zmod n).val : congr_arg zmod.val h
      ... = 1                : val_one n ⟩⟩

/-- The inversion on `zmod n`.
It is setup in such a way that `a * a⁻¹` is equal to `gcd a.val n`.
In particular, if `a` is coprime to `n`, and hence a unit, `a * a⁻¹ = 1`. -/
def inv : Π (n : ℕ), zmod n → zmod n
| 0     i := int.sign i
| (n+1) i := nat.gcd_a i.val (n+1)

instance (n : ℕ) : has_inv (zmod n) := ⟨inv n⟩

lemma inv_zero : ∀ (n : ℕ), (0 : zmod n)⁻¹ = 0
| 0     := int.sign_zero
| (n+1) := show (nat.gcd_a _ (n+1) : zmod (n+1)) = 0,
             by { rw val_zero, unfold nat.gcd_a nat.xgcd nat.xgcd_aux, refl }

lemma mul_inv_eq_gcd {n : ℕ} (a : zmod n) :
  a * a⁻¹ = nat.gcd a.val n :=
begin
  cases n,
  { calc a * a⁻¹ = a * int.sign a  : rfl
             ... = a.nat_abs   : by rw [int.mul_sign, int.nat_cast_eq_coe_nat]
             ... = a.val.gcd 0 : by rw nat.gcd_zero_right; refl },
  { set k := n.succ,
    calc a * a⁻¹ = a * a⁻¹ + k * nat.gcd_b (val a) k : by rw [nat_cast_self, zero_mul, add_zero]
             ... = ↑(↑a.val * nat.gcd_a (val a) k + k * nat.gcd_b (val a) k) :
                     by { push_cast, rw nat_cast_zmod_val, refl }
             ... = nat.gcd a.val k : (congr_arg coe (nat.gcd_eq_gcd_ab a.val k)).symm, }
end

@[simp] lemma nat_cast_mod (n : ℕ) (a : ℕ) : ((a % n : ℕ) : zmod n) = a :=
by conv {to_rhs, rw ← nat.mod_add_div a n}; simp

lemma eq_iff_modeq_nat (n : ℕ) {a b : ℕ} : (a : zmod n) = b ↔ a ≡ b [MOD n] :=
begin
  cases n,
  { simp only [nat.modeq, int.coe_nat_inj', nat.mod_zero, int.nat_cast_eq_coe_nat], },
  { rw [fin.ext_iff, nat.modeq, ← val_nat_cast, ← val_nat_cast], exact iff.rfl, }
end

lemma coe_mul_inv_eq_one {n : ℕ} (x : ℕ) (h : nat.coprime x n) :
  (x * x⁻¹ : zmod n) = 1 :=
begin
  rw [nat.coprime, nat.gcd_comm, nat.gcd_rec] at h,
  rw [mul_inv_eq_gcd, val_nat_cast, h, nat.cast_one],
end

/-- `unit_of_coprime` makes an element of `units (zmod n)` given
  a natural number `x` and a proof that `x` is coprime to `n`  -/
def unit_of_coprime {n : ℕ} (x : ℕ) (h : nat.coprime x n) : units (zmod n) :=
⟨x, x⁻¹, coe_mul_inv_eq_one x h, by rw [mul_comm, coe_mul_inv_eq_one x h]⟩

@[simp] lemma coe_unit_of_coprime {n : ℕ} (x : ℕ) (h : nat.coprime x n) :
  (unit_of_coprime x h : zmod n) = x := rfl

lemma val_coe_unit_coprime {n : ℕ} (u : units (zmod n)) :
  nat.coprime (u : zmod n).val n :=
begin
  cases n,
  { rcases int.units_eq_one_or u with rfl|rfl; simp },
  apply nat.modeq.coprime_of_mul_modeq_one ((u⁻¹ : units (zmod (n+1))) : zmod (n+1)).val,
  have := units.ext_iff.1 (mul_right_inv u),
  rw [units.coe_one] at this,
  rw [← eq_iff_modeq_nat, nat.cast_one, ← this], clear this,
  rw [← nat_cast_zmod_val ((u * u⁻¹ : units (zmod (n+1))) : zmod (n+1))],
  rw [units.coe_mul, val_mul, nat_cast_mod],
end

@[simp] lemma inv_coe_unit {n : ℕ} (u : units (zmod n)) :
  (u : zmod n)⁻¹ = (u⁻¹ : units (zmod n)) :=
begin
  have := congr_arg (coe : ℕ → zmod n) (val_coe_unit_coprime u),
  rw [← mul_inv_eq_gcd, nat.cast_one] at this,
  let u' : units (zmod n) := ⟨u, (u : zmod n)⁻¹, this, by rwa mul_comm⟩,
  have h : u = u', { apply units.ext, refl },
  rw h,
  refl
end

lemma mul_inv_of_unit {n : ℕ} (a : zmod n) (h : is_unit a) :
  a * a⁻¹ = 1 :=
begin
  rcases h with ⟨u, rfl⟩,
  rw [inv_coe_unit, u.mul_inv],
end

lemma inv_mul_of_unit {n : ℕ} (a : zmod n) (h : is_unit a) :
  a⁻¹ * a = 1 :=
by rw [mul_comm, mul_inv_of_unit a h]

/-- Equivalence between the units of `zmod n` and
the subtype of terms `x : zmod n` for which `x.val` is comprime to `n` -/
def units_equiv_coprime {n : ℕ} [fact (0 < n)] :
  units (zmod n) ≃ {x : zmod n // nat.coprime x.val n} :=
{ to_fun := λ x, ⟨x, val_coe_unit_coprime x⟩,
  inv_fun := λ x, unit_of_coprime x.1.val x.2,
  left_inv := λ ⟨_, _, _, _⟩, units.ext (nat_cast_zmod_val _),
  right_inv := λ ⟨_, _⟩, by simp }

section totient
open_locale nat

@[simp] lemma card_units_eq_totient (n : ℕ) [fact (0 < n)] :
  fintype.card (units (zmod n)) = φ n :=
calc fintype.card (units (zmod n)) = fintype.card {x : zmod n // x.val.coprime n} :
  fintype.card_congr zmod.units_equiv_coprime
... = φ n :
begin
  apply finset.card_congr (λ (a : {x : zmod n // x.val.coprime n}) _, a.1.val),
  { intro a, simp [(a : zmod n).val_lt, a.prop.symm] {contextual := tt} },
  { intros _ _ _ _ h, rw subtype.ext_iff_val, apply val_injective, exact h, },
  { intros b hb,
    rw [finset.mem_filter, finset.mem_range] at hb,
    refine ⟨⟨b, _⟩, finset.mem_univ _, _⟩,
    { let u := unit_of_coprime b hb.2.symm,
      exact val_coe_unit_coprime u },
    { show zmod.val (b : zmod n) = b,
      rw [val_nat_cast, nat.mod_eq_of_lt hb.1], } }
end

end totient

instance subsingleton_units : subsingleton (units (zmod 2)) :=
⟨λ x y, begin
  ext1,
  cases x with x xi hx1 hx2,
  cases y with y yi hy1 hy2,
  revert hx1 hx2 hy1 hy2,
  fin_cases x; fin_cases y; simp
end⟩

lemma le_div_two_iff_lt_neg (n : ℕ) [hn : fact ((n : ℕ) % 2 = 1)]
  {x : zmod n} (hx0 : x ≠ 0) : x.val ≤ (n / 2 : ℕ) ↔ (n / 2 : ℕ) < (-x).val :=
begin
  haveI npos : fact (0 < n) := ⟨by
  { apply (nat.eq_zero_or_pos n).resolve_left,
    unfreezingI { rintro rfl },
    simpa [fact_iff] using hn, }⟩,
  have hn2 : (n : ℕ) / 2 < n := nat.div_lt_of_lt_mul
    ((lt_mul_iff_one_lt_left npos.1).2 dec_trivial),
  have hn2' : (n : ℕ) - n / 2 = n / 2 + 1,
  { conv {to_lhs, congr, rw [← nat.succ_sub_one n, nat.succ_sub npos.1]},
    rw [← nat.two_mul_odd_div_two hn.1, two_mul, ← nat.succ_add, nat.add_sub_cancel], },
  have hxn : (n : ℕ) - x.val < n,
  { rw [nat.sub_lt_iff (le_of_lt x.val_lt) (le_refl _), nat.sub_self],
    rw ← zmod.nat_cast_zmod_val x at hx0,
    exact nat.pos_of_ne_zero (λ h, by simpa [h] using hx0) },
  by conv {to_rhs, rw [← nat.succ_le_iff, nat.succ_eq_add_one, ← hn2', ← zero_add (- x),
    ← zmod.nat_cast_self, ← sub_eq_add_neg, ← zmod.nat_cast_zmod_val x,
    ← nat.cast_sub (le_of_lt x.val_lt),
    zmod.val_nat_cast, nat.mod_eq_of_lt hxn, nat.sub_le_sub_left_iff (le_of_lt x.val_lt)] }
end

lemma ne_neg_self (n : ℕ) [hn : fact ((n : ℕ) % 2 = 1)] {a : zmod n} (ha : a ≠ 0) : a ≠ -a :=
λ h, have a.val ≤ n / 2 ↔ (n : ℕ) / 2 < (-a).val := le_div_two_iff_lt_neg n ha,
by rwa [← h, ← not_lt, not_iff_self] at this

lemma neg_one_ne_one {n : ℕ} [fact (2 < n)] :
  (-1 : zmod n) ≠ 1 :=
char_p.neg_one_ne_one (zmod n) n

@[simp] lemma neg_eq_self_mod_two (a : zmod 2) : -a = a :=
by fin_cases a; ext; simp [fin.coe_neg, int.nat_mod]; norm_num

@[simp] lemma nat_abs_mod_two (a : ℤ) : (a.nat_abs : zmod 2) = a :=
begin
  cases a,
  { simp only [int.nat_abs_of_nat, int.cast_coe_nat, int.of_nat_eq_coe] },
  { simp only [neg_eq_self_mod_two, nat.cast_succ, int.nat_abs, int.cast_neg_succ_of_nat] }
end

@[simp] lemma val_eq_zero : ∀ {n : ℕ} (a : zmod n), a.val = 0 ↔ a = 0
| 0     a := int.nat_abs_eq_zero
| (n+1) a := by { rw fin.ext_iff, exact iff.rfl }

lemma val_cast_of_lt {n : ℕ} {a : ℕ} (h : a < n) : (a : zmod n).val = a :=
by rw [val_nat_cast, nat.mod_eq_of_lt h]

lemma neg_val' {n : ℕ} [fact (0 < n)] (a : zmod n) : (-a).val = (n - a.val) % n :=
begin
  have : ((-a).val + a.val) % n = (n - a.val + a.val) % n,
  { rw [←val_add, add_left_neg, nat.sub_add_cancel (le_of_lt a.val_lt), nat.mod_self, val_zero], },
  calc (-a).val = val (-a)    % n : by rw nat.mod_eq_of_lt ((-a).val_lt)
            ... = (n - val a) % n : nat.modeq.modeq_add_cancel_right rfl this
end

lemma neg_val {n : ℕ} [fact (0 < n)] (a : zmod n) : (-a).val = if a = 0 then 0 else n - a.val :=
begin
  rw neg_val',
  by_cases h : a = 0, { rw [if_pos h, h, val_zero, nat.sub_zero, nat.mod_self] },
  rw if_neg h,
  apply nat.mod_eq_of_lt,
  apply nat.sub_lt (fact.out (0 < n)),
  contrapose! h,
  rwa [nat.le_zero_iff, val_eq_zero] at h,
end

/-- `val_min_abs x` returns the integer in the same equivalence class as `x` that is closest to `0`,
  The result will be in the interval `(-n/2, n/2]`. -/
def val_min_abs : Π {n : ℕ}, zmod n → ℤ
| 0       x := x
| n@(_+1) x := if x.val ≤ n / 2 then x.val else (x.val : ℤ) - n

@[simp] lemma val_min_abs_def_zero (x : zmod 0) : val_min_abs x = x := rfl

lemma val_min_abs_def_pos {n : ℕ} [fact (0 < n)] (x : zmod n) :
  val_min_abs x = if x.val ≤ n / 2 then x.val else x.val - n :=
begin
  casesI n,
  { exfalso, exact nat.not_lt_zero 0 (fact.out (0 < 0)) },
  { refl }
end

@[simp] lemma coe_val_min_abs : ∀ {n : ℕ} (x : zmod n), (x.val_min_abs : zmod n) = x
| 0       x := int.cast_id x
| k@(n+1) x :=
begin
  rw val_min_abs_def_pos,
  split_ifs,
  { rw [int.cast_coe_nat, nat_cast_zmod_val] },
  { rw [int.cast_sub, int.cast_coe_nat, nat_cast_zmod_val, int.cast_coe_nat, nat_cast_self,
      sub_zero] }
end

lemma nat_abs_val_min_abs_le {n : ℕ} [fact (0 < n)] (x : zmod n) : x.val_min_abs.nat_abs ≤ n / 2 :=
begin
  rw zmod.val_min_abs_def_pos,
  split_ifs with h, { exact h },
  have : (x.val - n : ℤ) ≤ 0,
  { rw [sub_nonpos, int.coe_nat_le], exact le_of_lt x.val_lt, },
  rw [← int.coe_nat_le, int.of_nat_nat_abs_of_nonpos this, neg_sub],
  conv_lhs { congr, rw [← nat.mod_add_div n 2, int.coe_nat_add, int.coe_nat_mul,
    int.coe_nat_bit0, int.coe_nat_one] },
  suffices : ((n % 2 : ℕ) + (n / 2) : ℤ) ≤ (val x),
  { rw ← sub_nonneg at this ⊢, apply le_trans this (le_of_eq _), ring_nf, ring },
  norm_cast,
  calc (n : ℕ) % 2 + n / 2 ≤ 1 + n / 2 :
    nat.add_le_add_right (nat.le_of_lt_succ (nat.mod_lt _ dec_trivial)) _
                       ... ≤ x.val     :
    by { rw add_comm, exact nat.succ_le_of_lt (lt_of_not_ge h) }
end

@[simp] lemma val_min_abs_zero : ∀ n, (0 : zmod n).val_min_abs = 0
| 0     := by simp only [val_min_abs_def_zero]
| (n+1) := by simp only [val_min_abs_def_pos, if_true, int.coe_nat_zero, zero_le, val_zero]

@[simp] lemma val_min_abs_eq_zero {n : ℕ} (x : zmod n) :
  x.val_min_abs = 0 ↔ x = 0 :=
begin
  cases n, { simp },
  split,
  { simp only [val_min_abs_def_pos, int.coe_nat_succ],
    split_ifs with h h; assume h0,
    { apply val_injective, rwa [int.coe_nat_eq_zero] at h0, },
    { apply absurd h0, rw sub_eq_zero, apply ne_of_lt, exact_mod_cast x.val_lt } },
  { rintro rfl, rw val_min_abs_zero }
end

lemma nat_cast_nat_abs_val_min_abs {n : ℕ} [fact (0 < n)] (a : zmod n) :
  (a.val_min_abs.nat_abs : zmod n) = if a.val ≤ (n : ℕ) / 2 then a else -a :=
begin
  have : (a.val : ℤ) - n ≤ 0,
    by { erw [sub_nonpos, int.coe_nat_le], exact le_of_lt a.val_lt, },
  rw [zmod.val_min_abs_def_pos],
  split_ifs,
  { rw [int.nat_abs_of_nat, nat_cast_zmod_val] },
  { rw [← int.cast_coe_nat, int.of_nat_nat_abs_of_nonpos this, int.cast_neg, int.cast_sub],
    rw [int.cast_coe_nat, int.cast_coe_nat, nat_cast_self, sub_zero, nat_cast_zmod_val], }
end

@[simp] lemma nat_abs_val_min_abs_neg {n : ℕ} (a : zmod n) :
  (-a).val_min_abs.nat_abs = a.val_min_abs.nat_abs :=
begin
  cases n, { simp only [int.nat_abs_neg, val_min_abs_def_zero], },
  by_cases ha0 : a = 0, { rw [ha0, neg_zero] },
  by_cases haa : -a = a, { rw [haa] },
  suffices hpa : (n+1 : ℕ) - a.val ≤ (n+1) / 2 ↔ (n+1 : ℕ) / 2 < a.val,
  { rw [val_min_abs_def_pos, val_min_abs_def_pos],
    rw ← not_le at hpa,
    simp only [if_neg ha0, neg_val, hpa, int.coe_nat_sub (le_of_lt a.val_lt)],
    split_ifs,
    all_goals { rw [← int.nat_abs_neg], congr' 1, ring } },
  suffices : (((n+1 : ℕ) % 2) + 2 * ((n + 1) / 2)) - a.val ≤ (n+1) / 2 ↔ (n+1 : ℕ) / 2 < a.val,
  by rwa [nat.mod_add_div] at this,
  suffices : (n + 1) % 2 + (n + 1) / 2 ≤ val a ↔ (n + 1) / 2 < val a,
  by rw [nat.sub_le_iff, two_mul, ← add_assoc, nat.add_sub_cancel, this],
  cases (n + 1 : ℕ).mod_two_eq_zero_or_one with hn0 hn1,
  { split,
    { assume h,
      apply lt_of_le_of_ne (le_trans (nat.le_add_left _ _) h),
      contrapose! haa,
      rw [← zmod.nat_cast_zmod_val a, ← haa, neg_eq_iff_add_eq_zero, ← nat.cast_add],
      rw [char_p.cast_eq_zero_iff (zmod (n+1)) (n+1)],
      rw [← two_mul, ← zero_add (2 * _), ← hn0, nat.mod_add_div] },
    { rw [hn0, zero_add], exact le_of_lt } },
  { rw [hn1, add_comm, nat.succ_le_iff] }
end

lemma val_eq_ite_val_min_abs {n : ℕ} [fact (0 < n)] (a : zmod n) :
  (a.val : ℤ) = a.val_min_abs + if a.val ≤ n / 2 then 0 else n :=
by { rw [zmod.val_min_abs_def_pos], split_ifs; simp only [add_zero, sub_add_cancel] }

lemma prime_ne_zero (p q : ℕ) [hp : fact p.prime] [hq : fact q.prime] (hpq : p ≠ q) :
  (q : zmod p) ≠ 0 :=
by rwa [← nat.cast_zero, ne.def, eq_iff_modeq_nat, nat.modeq.modeq_zero_iff,
  ← hp.1.coprime_iff_not_dvd, nat.coprime_primes hp.1 hq.1]

end zmod

namespace zmod

variables (p : ℕ) [fact p.prime]

private lemma mul_inv_cancel_aux (a : zmod p) (h : a ≠ 0) : a * a⁻¹ = 1 :=
begin
  obtain ⟨k, rfl⟩ := nat_cast_zmod_surjective a,
  apply coe_mul_inv_eq_one,
  apply nat.coprime.symm,
  rwa [nat.prime.coprime_iff_not_dvd (fact.out p.prime), ← char_p.cast_eq_zero_iff (zmod p)]
end

/-- Field structure on `zmod p` if `p` is prime. -/
instance : field (zmod p) :=
{ mul_inv_cancel := mul_inv_cancel_aux p,
  inv_zero := inv_zero p,
  .. zmod.comm_ring p,
  .. zmod.has_inv p,
  .. zmod.nontrivial p }

end zmod

lemma ring_hom.ext_zmod {n : ℕ} {R : Type*} [semiring R] (f g : (zmod n) →+* R) : f = g :=
begin
  ext a,
  obtain ⟨k, rfl⟩ := zmod.int_cast_surjective a,
  let φ : ℤ →+* R := f.comp (int.cast_ring_hom (zmod n)),
  let ψ : ℤ →+* R := g.comp (int.cast_ring_hom (zmod n)),
  show φ k = ψ k,
  rw φ.ext_int ψ,
end

namespace zmod
variables {n : ℕ} {R : Type*}

instance subsingleton_ring_hom [semiring R] : subsingleton ((zmod n) →+* R) :=
⟨ring_hom.ext_zmod⟩

instance subsingleton_ring_equiv [semiring R] : subsingleton (zmod n ≃+* R) :=
⟨λ f g, by { rw ring_equiv.coe_ring_hom_inj_iff, apply ring_hom.ext_zmod _ _ }⟩

@[simp] lemma ring_hom_map_cast [ring R] (f : R →+* (zmod n)) (k : zmod n) :
  f k = k :=
by { cases n; simp }

lemma ring_hom_right_inverse [ring R] (f : R →+* (zmod n)) :
  function.right_inverse (coe : zmod n → R) f :=
ring_hom_map_cast f

lemma ring_hom_surjective [ring R] (f : R →+* (zmod n)) : function.surjective f :=
(ring_hom_right_inverse f).surjective

lemma ring_hom_eq_of_ker_eq [comm_ring R] (f g : R →+* (zmod n))
  (h : f.ker = g.ker) : f = g :=
begin
  have := f.lift_of_right_inverse_comp _ (zmod.ring_hom_right_inverse f) ⟨g, le_of_eq h⟩,
  rw subtype.coe_mk at this,
  rw [←this, ring_hom.ext_zmod (f.lift_of_right_inverse _ _ _) (ring_hom.id _), ring_hom.id_comp],
end

end zmod


/-
Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou
-/
import algebra.char_p.invertible
import order.filter.at_top_bot
import tactic.linarith

/-!
# Quadratic discriminants and roots of a quadratic

This file defines the discriminant of a quadratic and gives the solution to a quadratic equation.

## Main definition

- `discrim a b c`: the discriminant of a quadratic `a * x * x + b * x + c` is `b * b - 4 * a * c`.

## Main statements

- `quadratic_eq_zero_iff`: roots of a quadratic can be written as
  `(-b + s) / (2 * a)` or `(-b - s) / (2 * a)`, where `s` is a square root of the discriminant.
- `quadratic_ne_zero_of_discrim_ne_sq`: if the discriminant has no square root,
  then the corresponding quadratic has no root.
- `discrim_le_zero`: if a quadratic is always non-negative, then its discriminant is non-positive.

## Tags

polynomial, quadratic, discriminant, root
-/

open filter

section ring
variables {R : Type*}

/-- Discriminant of a quadratic -/
def discrim [ring R] (a b c : R) : R := b^2 - 4 * a * c

variables [integral_domain R] {a b c : R}

/--
A quadratic has roots if and only if its discriminant equals some square.
-/
lemma quadratic_eq_zero_iff_discrim_eq_sq (h2 : (2 : R) ≠ 0) (ha : a ≠ 0) (x : R) :
  a * x * x + b * x + c = 0 ↔ discrim a b c = (2 * a * x + b) ^ 2 :=
begin
  split,
  { assume h,
    calc discrim a b c
        = 4 * a * (a * x * x + b * x + c) + b * b - 4 * a * c : by { rw [h, discrim], ring }
    ... = (2*a*x + b)^2 : by ring },
  { assume h,
    have ha : 2 * 2 * a ≠ 0 := mul_ne_zero (mul_ne_zero h2 h2) ha,
    apply mul_left_cancel' ha,
    calc
      2 * 2 * a * (a * x * x + b * x + c) = (2 * a * x + b) ^ 2 - (b ^ 2 - 4 * a * c) : by ring
      ... = 0 : by { rw [← h, discrim], ring }
      ... = 2*2*a*0 : by ring }
end

/-- A quadratic has no root if its discriminant has no square root. -/
lemma quadratic_ne_zero_of_discrim_ne_sq (h2 : (2 : R) ≠ 0) (ha : a ≠ 0)
  (h : ∀ s : R, discrim a b c ≠ s * s) (x : R) :
  a * x * x + b * x + c ≠ 0 :=
begin
  assume h',
  rw [quadratic_eq_zero_iff_discrim_eq_sq h2 ha, sq] at h',
  exact h _ h'
end

end ring

section field
variables {K : Type*} [field K] [invertible (2 : K)] {a b c x : K}

/-- Roots of a quadratic -/
lemma quadratic_eq_zero_iff (ha : a ≠ 0) {s : K} (h : discrim a b c = s * s) (x : K) :
  a * x * x + b * x + c = 0 ↔ x = (-b + s) / (2 * a) ∨ x = (-b - s) / (2 * a) :=
begin
  have h2 : (2 : K) ≠ 0 := nonzero_of_invertible 2,
  rw [quadratic_eq_zero_iff_discrim_eq_sq h2 ha, h, sq, mul_self_eq_mul_self_iff],
  have ne : 2 * a ≠ 0 := mul_ne_zero h2 ha,
  have : x = 2 * a * x / (2 * a) := (mul_div_cancel_left x ne).symm,
  have h₁ : 2 * a * ((-b + s) / (2 * a)) = -b + s := mul_div_cancel' _ ne,
  have h₂ : 2 * a * ((-b - s) / (2 * a)) = -b - s := mul_div_cancel' _ ne,
  split,
  { intro h', rcases h',
    { left, rw h', simpa [add_comm] },
    { right, rw h', simpa [add_comm, sub_eq_add_neg] } },
  { intro h', rcases h', { left, rw [h', h₁], ring }, { right, rw [h', h₂], ring } }
end

/-- A quadratic has roots if its discriminant has square roots -/
lemma exists_quadratic_eq_zero (ha : a ≠ 0) (h : ∃ s, discrim a b c = s * s) :
  ∃ x, a * x * x + b * x + c = 0 :=
begin
  rcases h with ⟨s, hs⟩,
  use (-b + s) / (2 * a),
  rw quadratic_eq_zero_iff ha hs,
  simp
end

/-- Root of a quadratic when its discriminant equals zero -/
lemma quadratic_eq_zero_iff_of_discrim_eq_zero (ha : a ≠ 0) (h : discrim a b c = 0) (x : K) :
  a * x * x + b * x + c = 0 ↔ x = -b / (2 * a) :=
begin
  have : discrim a b c = 0 * 0, by rw [h, mul_zero],
  rw [quadratic_eq_zero_iff ha this, add_zero, sub_zero, or_self]
end

end field

section linear_ordered_field
variables {K : Type*} [linear_ordered_field K] {a b c : K}

/-- If a polynomial of degree 2 is always nonnegative, then its discriminant is nonpositive -/
lemma discrim_le_zero (h : ∀ x : K, 0 ≤ a * x * x + b * x + c) : discrim a b c ≤ 0 :=
begin
  rw [discrim, sq],
  obtain ha|rfl|ha : a < 0 ∨ a = 0 ∨ 0 < a := lt_trichotomy a 0,
  -- if a < 0
  { have : tendsto (λ x, (a * x + b) * x + c) at_top at_bot :=
     tendsto_at_bot_add_const_right _ c ((tendsto_at_bot_add_const_right _ b
       (tendsto_id.neg_const_mul_at_top ha)).at_bot_mul_at_top tendsto_id),
    rcases (this.eventually (eventually_lt_at_bot 0)).exists with ⟨x, hx⟩,
    exact false.elim ((h x).not_lt $ by rwa ← add_mul) },
  -- if a = 0
  { rcases em (b = 0) with (rfl|hb),
    { simp },
    { have := h ((-c - 1) / b), rw [mul_div_cancel' _ hb] at this, linarith } },
  -- if a > 0
  { have := calc
      4 * a * (a * (-(b / a) * (1 / 2)) * (-(b / a) * (1 / 2)) + b * (-(b / a) * (1 / 2)) + c)
          = (a * (b / a)) * (a * (b / a)) - 2 * (a * (b / a)) * b + 4 * a * c : by ring
      ... = -(b * b - 4 * a * c) : by { simp only [mul_div_cancel' b (ne_of_gt ha)], ring },
    have ha' : 0 ≤ 4 * a, by linarith,
    have h := (mul_nonneg ha' (h (-(b / a) * (1 / 2)))),
    rw this at h, rwa ← neg_nonneg }
end

/--
If a polynomial of degree 2 is always positive, then its discriminant is negative,
at least when the coefficient of the quadratic term is nonzero.
-/
lemma discrim_lt_zero (ha : a ≠ 0) (h : ∀ x : K, 0 < a * x * x + b * x + c) : discrim a b c < 0 :=
begin
  have : ∀ x : K, 0 ≤ a*x*x + b*x + c := assume x, le_of_lt (h x),
  refine lt_of_le_of_ne (discrim_le_zero this) _,
  assume h',
  have := h (-b / (2 * a)),
  have : a * (-b / (2 * a)) * (-b / (2 * a)) + b * (-b / (2 * a)) + c = 0,
  { rw [quadratic_eq_zero_iff_of_discrim_eq_zero ha h' (-b / (2 * a))] },
  linarith
end

end linear_ordered_field


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import order.well_founded
import data.nat.basic
import combinatorics.quiver.subquiver
import combinatorics.quiver.path

/-!
# Arborescences

A quiver `V` is an arborescence (or directed rooted tree) when we have a root vertex `root : V` such
that for every `b : V` there is a unique path from `root` to `b`.

## Main definitions

- `quiver.arborescence V`: a typeclass asserting that `V` is an arborescence
- `arborescence_mk`: a convenient way of proving that a quiver is an arborescence
- `rooted_connected r`: a typeclass asserting that there is at least one path from `r` to `b` for
every `b`.
- `geodesic_subtree r`: given `[rooted_conntected r]`, this is a subquiver of `V` which contains
just enough edges to include a shortest path from `r` to `b` for every `b`.
- `geodesic_arborescence : arborescence (geodesic_subtree r)`: an instance saying that the geodesic
subtree is an arborescence. This proves the directed analogue of 'every connected graph has a
spanning tree'. This proof avoids the use of Zorn's lemma.
-/

open opposite
universes v u

namespace quiver

/-- A quiver is an arborescence when there is a unique path from the default vertex
    to every other vertex. -/
class arborescence (V : Type u) [quiver.{v} V] : Type (max u v) :=
(root : V)
(unique_path : Π (b : V), unique (path root b))

/-- The root of an arborescence. -/
def root (V : Type u) [quiver V] [arborescence V] : V :=
arborescence.root

instance {V : Type u} [quiver V] [arborescence V] (b : V) : unique (path (root V) b) :=
arborescence.unique_path b

/-- To show that `[quiver V]` is an arborescence with root `r : V`, it suffices to
  - provide a height function `V → ℕ` such that every arrow goes from a
    lower vertex to a higher vertex,
  - show that every vertex has at most one arrow to it, and
  - show that every vertex other than `r` has an arrow to it. -/
noncomputable def arborescence_mk {V : Type u} [quiver V] (r : V)
  (height : V → ℕ)
  (height_lt : ∀ ⦃a b⦄, (a ⟶ b) → height a < height b)
  (unique_arrow : ∀ ⦃a b c : V⦄ (e : a ⟶ c) (f : b ⟶ c), a = b ∧ e == f)
  (root_or_arrow : ∀ b, b = r ∨ ∃ a, nonempty (a ⟶ b)) : arborescence V :=
{ root := r,
  unique_path := λ b, ⟨classical.inhabited_of_nonempty
    begin
      rcases (show ∃ n, height b < n, from ⟨_, lt_add_one _⟩) with ⟨n, hn⟩,
      induction n with n ih generalizing b,
      { exact false.elim (nat.not_lt_zero _ hn) },
      rcases root_or_arrow b with ⟨⟨⟩⟩ | ⟨a, ⟨e⟩⟩,
      { exact ⟨path.nil⟩ },
      { rcases ih a (lt_of_lt_of_le (height_lt e) (nat.lt_succ_iff.mp hn)) with ⟨p⟩,
        exact ⟨p.cons e⟩ }
    end,
    begin
      have height_le : ∀ {a b}, path a b → height a ≤ height b,
      { intros a b p, induction p with b c p e ih, refl,
        exact le_of_lt (lt_of_le_of_lt ih (height_lt e)) },
      suffices : ∀ p q : path r b, p = q,
      { intro p, apply this },
      intros p q, induction p with a c p e ih; cases q with b _ q f,
      { refl },
      { exact false.elim (lt_irrefl _ (lt_of_le_of_lt (height_le q) (height_lt f))) },
      { exact false.elim (lt_irrefl _ (lt_of_le_of_lt (height_le p) (height_lt e))) },
      { rcases unique_arrow e f with ⟨⟨⟩, ⟨⟩⟩, rw ih },
    end ⟩ }

/-- `rooted_connected r` means that there is a path from `r` to any other vertex. -/
class rooted_connected {V : Type u} [quiver V] (r : V) : Prop :=
(nonempty_path : ∀ b : V, nonempty (path r b))

attribute [instance] rooted_connected.nonempty_path

section geodesic_subtree

variables {V : Type u} [quiver.{v+1} V] (r : V) [rooted_connected r]

/-- A path from `r` of minimal length. -/
noncomputable def shortest_path (b : V) : path r b :=
well_founded.min (measure_wf path.length) set.univ set.univ_nonempty

/-- The length of a path is at least the length of the shortest path -/
lemma shortest_path_spec {a : V} (p : path r a) :
  (shortest_path r a).length ≤ p.length :=
not_lt.mp (well_founded.not_lt_min (measure_wf _) set.univ _ trivial)

/-- A subquiver which by construction is an arborescence. -/
def geodesic_subtree : wide_subquiver V :=
λ a b, { e | ∃ p : path r a, shortest_path r b = p.cons e }

noncomputable instance geodesic_arborescence : arborescence (geodesic_subtree r) :=
arborescence_mk r (λ a, (shortest_path r a).length)
(by { rintros a b ⟨e, p, h⟩, rw [h, path.length_cons, nat.lt_succ_iff], apply shortest_path_spec })
(by { rintros a b c ⟨e, p, h⟩ ⟨f, q, j⟩, cases h.symm.trans j, split; refl })
begin
  intro b,
  rcases hp : shortest_path r b with (_ | ⟨a, _, p, e⟩),
  { exact or.inl rfl },
  { exact or.inr ⟨a, ⟨⟨e, p, hp⟩⟩⟩ }
end

end geodesic_subtree

end quiver


variables A B : Prop

premise P1 : not(A/\B)
premise P2 : A

example : not(B) :=
assume H1: B,
show false, from P1 (and.intro P2 H1).


import data.real.basic
import data.real.nnreal

theorem USAMO_Problem_1_2011 (a b c : real) [a > 0] [b > 0] [c > 0]:
a^2 + b^2 + c^2 +(a+b+c)^4 ≤ 4 →
((a*b + 1) / (a+b)^2) +(b*c+1) / (b+c)^2 + (c*a+1) / (c+a)^2 ≥ 3
 := sorry


import tactic
import fol
import Rings.Notation
import Rings.ToMathlib
import data.polynomial.eval
import data.mv_polynomial

universe u

namespace Rings

local notation h :: t  := dvector.cons h t
local notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`) := l

/-- The constant symbols in RingSignature -/
inductive RingConsts : Type u
| zero : RingConsts
| one : RingConsts

/-- The unary function symbols in RingSignature-/
inductive RingUnaries : Type u
| neg : RingUnaries

/-- The binary function symbols in RingSignature-/
inductive RingBinaries : Type u
| add : RingBinaries
| mul : RingBinaries

/-- All function symbols in RingSignature-/
def RingFuncs : ℕ → Type u
| 0 := RingConsts
| 1 := RingUnaries
| 2 := RingBinaries
| (n + 3) := pempty

instance : inhabited RingConsts := ⟨ RingConsts.zero ⟩
instance : inhabited RingUnaries := ⟨ RingUnaries.neg ⟩
instance : inhabited RingBinaries := ⟨ RingBinaries.add ⟩

open fol

/-- The language of rings -/
def RingSignature : Language :=
(Language.mk) (RingFuncs) (λ n, pempty)

@[reducible] private def bdt (n : ℕ) := bounded_term RingSignature n
@[reducible] private def bdt' (n : ℕ) := bounded_preterm RingSignature n 0
-- I shouldn't need to make a duplicate since they are definitionally equal

/- The following instances allow us to use symbols 0 1 - + * to write down terms in the language-/
@[simp] def zero {n} : bdt n := bd_const RingConsts.zero

@[reducible] instance RingBDTHasZero {n} : has_zero (bdt n) := ⟨ zero ⟩
@[reducible] instance RingBDTHasZero' {n} : has_zero (bdt' n) := ⟨ zero ⟩

@[simp] def one {n} : bdt n := bd_const RingConsts.one
@[reducible] instance RingBDTHasOne {n} : has_one (bdt n) := ⟨ one ⟩
@[reducible] instance RingBDTHasOne' {n} : has_one (bdt' n) := ⟨ one ⟩

@[simp] def neg {n} : bdt n → bdt n := bd_app (bd_func RingUnaries.neg)
@[reducible] instance RingBDTHasNeg {n} : has_neg (bdt n) := ⟨ neg ⟩
@[reducible] instance RingBDTHasNeg' {n} : has_neg (bdt'  n) := ⟨ neg ⟩

@[simp] def add {n} (x : bdt n) : bdt n → bdt n :=
  bd_app (bd_app (bd_func RingBinaries.add) x)
@[reducible] instance RingBDTHasAdd {n} : has_add (bdt n) := ⟨ add ⟩
@[reducible] instance RingBDTHasAdd' {n} : has_add (bdt'  n) := ⟨ add ⟩

@[simp] def mul {n} (x : bdt n) : bdt n → bdt n :=
  bd_app (bd_app (bd_func RingBinaries.mul) x)
@[reducible] instance RingBDTHasMul {n} : has_mul (bdt n) := ⟨ mul ⟩
@[reducible] instance RingBDTHasMul' {n} : has_mul (bdt' n) := ⟨ mul ⟩

-- has_pow comes for free by having instances of mul and 1 (see ToMathlib) -- input x ^ n

@[simp] lemma pow_zero {n} (t : bounded_term RingSignature n) : t ^ 0 = 1 := rfl
@[simp] lemma pow_succ {n m} (t : bounded_term RingSignature m) : t ^ (n + 1) = t * t ^ n := rfl

-- with has_one and has_add you can write any natural and lean will know what term you mean
-- with has_neg you can write any integer etc.

/-
-- variables x0 , x1 in the signature
-- (they are only variables in bounded terms that have up to n + 1, n + 2 variables)
example {n} : bounded_term RingSignature (n + 1) := x_ 0
-- for example {n} : bounded_term RingSignature n := x_ 0 doesn't work
-- since fin n doesn't have an instance of 0 in general (when n = 0)
example {n} : bounded_term RingSignature (n + 2) := x_ 1
-- actually example {n} : bounded_term RingSignature (n + 1) := x_ 1 also works because
-- fin (n + 1) is implemented mod (n + 1), in particular 1 = 0 ∈ fin 1
-- but let's avoid that

-- neg x
example {n} : bounded_term RingSignature (n + 1) := - (x_ 0)
example {n} : bounded_term RingSignature (n + 1) := (x_ 0) + 1
example {n} : bounded_term RingSignature (n + 2):= (- x_ 0) * x_ 1
example {n} : bounded_term RingSignature (n + 1) := x_ 0 + x_ 0
-/

/-- Part of the definition of BdtRec -/
@[simp] def RingFuncRec {n} {C : bounded_term RingSignature n → Sort u}
  (cvar : Π (k : fin n), C (x_ k))
  (c0 : C 0) (c1 : C 1)
  (cneg : Π {t}, C t → C (- t))
  (cadd : Π {s t}, C s → C t → C (s + t)) (cmul : Π {s t}, C s → C t → C (s * t)) :
  Π {l : ℕ} (f : RingSignature.functions l) (ts : dvector (bounded_term RingSignature n) l),
  (Π (t : bounded_term RingSignature n), dvector.pmem t ts → C t)
  → C (bd_apps (bd_func f) ts)
| 0 (RingConsts.zero) ([]) h := c0
| 0 (RingConsts.one) ([]) h := c1
| 1 (RingUnaries.neg) ([t]) h := cneg (h t (psum.inl rfl))
| 2 (RingBinaries.add) ([s,t]) h := cadd (h s (psum.inl rfl)) (h t (psum.inr (psum.inl rfl)))
| 2 (RingBinaries.mul) ([s,t]) h := cmul (h s (psum.inl rfl)) (h t (psum.inr (psum.inl rfl)))
| (n + 3) f ts h := pempty.elim f

/-- An interface for mapping out of bounded_term RingSignature n (basically bounded_term.rec) -/
def RingTermRec {n : ℕ} {C : bounded_term RingSignature n → Sort u}
  (cvar : Π (k : fin n), C (x_ k))
  (c0 : C 0) (c1 : C 1)
  (cneg : Π {t}, C t → C (- t))
  (cadd : Π {s t}, C s → C t → C (s + t)) (cmul : Π {s t}, C s → C t → C (s * t))
  : Π (t : bounded_term RingSignature n), C t :=
@bounded_term.rec RingSignature n C
(λ k, cvar k)
(λ l, RingFuncRec cvar c0 c1 @cneg @cadd @cmul)

def RingTermInd {n : ℕ} {C : bounded_term RingSignature n → Prop}
  (cvar : Π (k : fin n), C (x_ k))
  (c0 : C 0) (c1 : C 1)
  (cneg : Π {t}, C t → C (- t))
  (cadd : Π {s t}, C s → C t → C (s + t)) (cmul : Π {s t}, C s → C t → C (s * t))
  : Π (t : bounded_term RingSignature n), C t :=
@bounded_term.rec RingSignature n C
(λ k, cvar k)
(λ l, RingFuncRec cvar c0 c1 @cneg @cadd @cmul)

/- Commutative group for additions axioms -/

/-- Assosiativity of addition -/
def AddAssoc : sentence RingSignature :=
  ∀' ∀' ∀' ( (x_ 0 + x_ 1) + x_ 2 ≃ x_ 0 + (x_ 1 + x_ 2) )

/-- Identity for addition -/
def AddId : sentence RingSignature := ∀' ( x_ 0 + 0 ≃ x_ 0 )
-- def AddId : sentence RingSignature := ∀' (   &'0 r+ r0 ≃ &'0   ⊓   r0 r+ &'0 ≃ &'0   )

/-- Inverse for addition -/
def AddInv : sentence RingSignature := ∀' ( - x_ 0 + x_ 0 ≃ 0 )
-- def AddInv : sentence RingSignature := ∀' (  &'0 r+ r- &'0 ≃ r0  ⊓  r- &'0 r+ &'0 ≃ r0  )

/-- Commutativity of addition-/
def AddComm : sentence RingSignature := ∀' ∀' ( x_ 0 + x_ 1 ≃ x_ 1 + x_ 0 )

/- Commutative monoid for multiplication axioms -/
/-- Associativity of multiplication -/
def MulAssoc : sentence RingSignature := ∀' ∀' ∀' ( (x_ 0 * x_ 1) * x_ 2 ≃ x_ 0 * (x_ 1 * x_ 2) )

/-- Identity of multiplication -/
def MulId : sentence RingSignature :=  ∀' ( x_ 0 * 1 ≃ x_ 0 )
-- def MulId : sentence RingSignature :=  ∀' (   &'0 r× r1 ≃ &'0   )

/-- Commutativity of multiplication -/
def MulComm : sentence RingSignature := ∀' ∀' ( x_ 0 * x_ 1 ≃ x_ 1 * x_ 0   )

/-- Distributibity -/
def AddMul : sentence RingSignature := ∀' ∀' ∀' ( (x_ 0 + x_ 1) * x_ 2 ≃ x_ 0 * x_ 2 + x_ 1 * x_ 2 )

/-- The theory of rings -/
def RingTheory : Theory RingSignature :=
{AddAssoc, AddId, AddInv, AddComm, MulAssoc, MulId, MulComm, AddMul}

lemma AddAssocInRingTheory : AddAssoc ∈ RingTheory :=
begin unfold RingTheory, left, refl end

lemma AddIdInRingTheory : AddId ∈ RingTheory :=
begin unfold RingTheory, iterate 1 {right}, left, refl end

lemma AddInvInRingTheory : AddInv ∈ RingTheory :=
begin unfold RingTheory, iterate 2 {right}, left, refl end

lemma AddCommInRingTheory : AddComm ∈ RingTheory :=
begin unfold RingTheory, iterate 3 {right}, left, refl end

lemma MulAssocInRingTheory : MulAssoc ∈ RingTheory :=
begin unfold RingTheory, iterate 4 {right}, left, refl end

lemma MulIdInRingTheory : MulId ∈ RingTheory :=
begin unfold RingTheory, iterate 5 {right}, left, refl end

lemma MulCommInRingTheory : MulComm ∈ RingTheory :=
begin unfold RingTheory, iterate 6 {right}, left, refl end

lemma AddMulInRingTheory : AddMul ∈ RingTheory :=
begin unfold RingTheory, iterate 7 {right}, exact set.mem_singleton _, end

namespace structureTo
  -- We make any (type theoretic) structure A,0,1,-,+,* into a
  -- (model theoretic) Structure in RingSignature

  variable
    {A : Type u}

  /-- Interpreting consant symbols from RingSignature -/
  @[simp] def ConstMap [has_zero A] [has_one A] : RingConsts → (dvector A 0) → A
  | RingConsts.zero _ := 0
  | RingConsts.one  _ := 1

  /-- Interpreting unary function symbols from RingSignature -/
  @[simp] def UnariesMap [has_neg A] : RingUnaries → (dvector A 1) → A
  | RingUnaries.neg a := - (dvector.last a)

  /-- Interpreting binary function symbols from RingSignature -/
  @[simp] def BinariesMap [has_add A] [has_mul A] : RingBinaries → (dvector A 2) → A
  | RingBinaries.add   (a :: b) := a + dvector.last b
  | RingBinaries.mul  (a :: b) := a * dvector.last b

  variables [has_zero A] [has_one A] [has_neg A] [has_add A] [has_mul A]

  /-- Interpreting all symbols from RingSignature-/
  @[simp] def FuncMap : Π (n : ℕ), (RingFuncs n) → (dvector A n) → A
  | 0       := ConstMap
  | 1       := UnariesMap
  | 2       := BinariesMap
  | (n + 3) := pempty.elim

  variable (A)

  /-- Interpreting the symbols -/
  @[reducible] def Structure : Structure RingSignature :=
  Structure.mk A FuncMap (λ n, pempty.elim)

  @[simp] lemma realize_zero {n} {vec : dvector A n} :
    @realize_bounded_term RingSignature (structureTo.Structure A) n vec 0
      (@bd_const RingSignature _ RingConsts.zero) dvector.nil = 0 := rfl

  @[simp] lemma realize_zero' {n} {vec : dvector A n} :
    @realize_bounded_term RingSignature (structureTo.Structure A) n vec 0
      (@bd_func RingSignature _ 0 RingConsts.zero) dvector.nil = 0 := rfl

  @[simp] lemma realize_one {n} {vec : dvector A n} :
    @realize_bounded_term RingSignature (structureTo.Structure A) n vec 0
      (@bd_const RingSignature _ RingConsts.one) dvector.nil = 1 := rfl

  @[simp] lemma realize_one' {n} {vec : dvector A n} :
    @realize_bounded_term RingSignature (structureTo.Structure A) n vec 0
      (@bd_func RingSignature _ 0 RingConsts.one) dvector.nil = 1 := rfl

  @[simp] lemma apps_zero {n} : Π {t_ : dvector (bounded_term RingSignature n) 0},
    bd_apps (@bd_func RingSignature _ 0 RingConsts.zero) t_ = 0
  | [] := rfl

  @[simp] lemma apps_one {n} : Π {t_ : dvector (bounded_term RingSignature n) 0},
    bd_apps (@bd_func RingSignature _ 0 RingConsts.one) t_ = 1
  | [] := rfl

  @[simp] lemma app_neg {n} {t : bounded_term RingSignature n} :
    bd_app (@bd_func RingSignature _ 1 RingUnaries.neg) t = - t := rfl

  lemma apps_neg {n} {t : bounded_term RingSignature n} :
     bd_apps (@bd_func RingSignature _ 1 RingUnaries.neg) ([t]) = - t := rfl

  @[simp] lemma app_add {n} {s t : bounded_term RingSignature n} :
    ((@bd_func RingSignature _ 2 RingBinaries.add).bd_app t).bd_app s = t + s := rfl

  lemma apps_add {n} {s t : bounded_term RingSignature n} :
     bd_apps (@bd_func RingSignature _ 2 RingBinaries.add) ([s,t]) = s + t := rfl

  @[simp] lemma app_mul {n} {s t : bounded_term RingSignature n} :
    ((@bd_func RingSignature _ 2 RingBinaries.mul).bd_app t).bd_app s = t * s := rfl

  lemma apps_mul {n} {s t : bounded_term RingSignature n} :
     bd_apps (@bd_func RingSignature _ 2 RingBinaries.mul) ([s,t]) = s * t := rfl

  -- lemma preterm_upper_bound {n} : bounded_preterm RingSignature n 3 → false := _

end structureTo

namespace comm_ring_to

  variables
    (A : Type u) [comm_ring A]

  lemma RealizeRingTheory :
    (structureTo.Structure A) ⊨ RingTheory := -- squeeze_simp, val_zero
  begin
    intros ϕ h,
    repeat {cases h},
    {
      intros a b c,
      simp only [structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap, dvector.last,
        add, realize_bounded_formula, realize_bounded_term, fin.val_two, fin.val_one, dvector.nth],
      apply add_assoc
    },
    {
      intro a,
      simp only [add_zero, structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap,
        dvector.last, eq_self_iff_true, realize_bounded_term_bd_app, add, realize_bounded_formula,
        realize_bounded_term, structureTo.realize_zero, dvector.nth, zero],
    },
    {
      intro a,
      simp only [structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap,
        structureTo.UnariesMap, dvector.last, eq_self_iff_true, realize_bounded_term_bd_app, add,
        realize_bounded_formula, realize_bounded_term, structureTo.realize_zero,
        dvector.nth, zero, neg, add_left_neg],
    },
    {
      intros a b,
      simp only [structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap,
        dvector.last, add, realize_bounded_formula,
        realize_bounded_term, fin.val_one, dvector.nth, add_comm]
    },
    {
      intros a b c,
      simp only [mul, structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap,
      dvector.last, realize_bounded_formula,
      realize_bounded_term, fin.val_two, fin.val_one, dvector.nth, mul_assoc],
    },
    {
      intro a,
      simp only [mul, structureTo.realize_one, structureTo.FuncMap, fin.val_zero',
        mul_one, structureTo.BinariesMap, dvector.last, eq_self_iff_true, one,
        realize_bounded_term_bd_app, realize_bounded_formula, realize_bounded_term, dvector.nth],
    },
    {
      intros a b,
      simp only [mul, structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap,
      dvector.last, realize_bounded_formula,
      realize_bounded_term, fin.val_one, dvector.nth, mul_comm],
    },
    {
      intros a b c,
      simp only [mul, structureTo.FuncMap, fin.val_zero', structureTo.BinariesMap, dvector.last,
      add, realize_bounded_formula, realize_bounded_term, fin.val_two,
      fin.val_one, dvector.nth, add_mul]
    }
  end

  /-- -/
  def ModelOfRingTheory : Model RingTheory.{u} :=
  ⟨ structureTo.Structure A ,  RealizeRingTheory A ⟩

end comm_ring_to

namespace mv_polynomial
  /- Terms in the RingSignature are multivariable polynomials over ℤ -/

  variable {σ : Type}

  @[simp] noncomputable def Const : RingConsts → mv_polynomial σ ℤ
  | RingConsts.zero := 0
  | RingConsts.one := 1

  @[simp] noncomputable def UniAux : RingUnaries → mv_polynomial σ ℤ → mv_polynomial σ ℤ
  | RingUnaries.neg p := - p

  @[simp] noncomputable def Uni {n} (f : RingSignature.functions 1) :
    Π (ts : dvector (bounded_term RingSignature n) 1),
    (Π (t : bounded_term RingSignature n), dvector.pmem t ts → mv_polynomial σ ℤ)
    → mv_polynomial σ ℤ
  | [t] h := UniAux f (h t (psum.inl rfl))

  noncomputable def BinAux : RingBinaries →
    mv_polynomial σ ℤ → mv_polynomial σ ℤ → mv_polynomial σ ℤ
  | RingBinaries.add p q := p + q
  | RingBinaries.mul p q := p * q

  noncomputable def Bin {n} (f : RingSignature.functions 2) :
    Π (ts : dvector (bounded_term RingSignature n) 2),
    (Π (t : bounded_term RingSignature n), dvector.pmem t ts → mv_polynomial σ ℤ)
    → mv_polynomial σ ℤ
  | [s, t] h := BinAux f (h s (psum.inl rfl)) (h t (psum.inr (psum.inl rfl)))

  @[simp] noncomputable def Func {n} :
    Π {l : ℕ} (f : RingSignature.functions l) (ts : dvector (bounded_term RingSignature n) l),
    (Π (t : bounded_term RingSignature n), dvector.pmem t ts → mv_polynomial σ ℤ) →
    (λ (_x : bounded_term RingSignature n), mv_polynomial σ ℤ) (bd_apps (bd_func f) ts)
  | 0 := λ f ts h, Const f
  | 1 := Uni
  | 2 := Bin
  | (n + 3) := λ f, pempty.elim f

  noncomputable def Term {n} :
    bounded_term RingSignature n → mv_polynomial (fin n) ℤ :=
  @RingTermRec n (λ _, mv_polynomial (fin n) ℤ)
    mv_polynomial.X 0 1
    (λ _ p, - p)
    (λ _ _ p q, p + q)
    (λ _ _ p q, p * q)

  noncomputable def Term' {n} :
    bounded_term RingSignature n → mv_polynomial (fin n) ℤ :=
  @bounded_term.rec RingSignature n (λ _, mv_polynomial (fin n) ℤ)
    mv_polynomial.X (λ _, Func)

  @[simp] lemma TermX {n} {k : fin n} : Term (x_ k) = mv_polynomial.X k := rfl

  @[simp] lemma TermZero {n} : @Term n (bd_const RingConsts.zero) = 0 := rfl
  @[simp] lemma TermOne {n} : @Term n (bd_const RingConsts.one) = 1 := rfl

  @[simp] lemma TermNeg {n} {t : bounded_term RingSignature n} :
    Term (- t) = - Term t := rfl

  @[simp] lemma TermAdd {n} {s t : bounded_term RingSignature n} :
    Term (s + t) = Term s + Term t := rfl

  @[simp] lemma TermMul {n} {s t : bounded_term RingSignature n} :
    Term (s * t) = Term s * Term t := rfl

  variables {A : Type u} [comm_ring A]

  @[reducible] private def AStruc := structureTo.Structure A

  lemma RealisedVarIsEvaluatedVar {n} {as : dvector A n} : Π (k : fin n),
  @realize_bounded_term _ AStruc _ as _ (x_ k) dvector.nil
  = mv_polynomial.eval (fin_val_of_dvector as) (Term (x_ k)) :=
  begin
    intro k,
    simpa only [mv_polynomial.eval_X, fin_val_of_dvector, fin.val_eq_coe,
      TermX, coe_mv_poly_X, realize_bounded_term],
  end

  lemma RealisedFuncIsEvaluatedFunc {n} {as : dvector A n} :
    Π {l : ℕ} (f : RingSignature.functions l)
    (ts : dvector (bounded_term RingSignature n) l),
    (Π (t : bounded_term RingSignature (n )),
       dvector.pmem t ts →
       (@realize_bounded_term _ AStruc _ as _ t dvector.nil =
         mv_polynomial.eval (fin_val_of_dvector as) (Term t)))
    → @realize_bounded_term _ AStruc _ as _ (bd_apps (bd_func f) ts) dvector.nil =
       mv_polynomial.eval (fin_val_of_dvector as) (Term (bd_apps (bd_func f) ts))
  | 0 RingConsts.zero _ h :=
  begin
    rw structureTo.apps_zero,
    simp only [fin_val_of_dvector, realize_bounded_term, structureTo.realize_zero, TermZero, zero],
    refl,
  end
  | 0 RingConsts.one _ h :=
  begin
    rw structureTo.apps_one,
    simp only [fin_val_of_dvector, realize_bounded_term, structureTo.realize_one, TermOne,
      one, coe_mv_poly_one, ring_hom.map_one],
  end
  | 1 RingUnaries.neg [t] h :=
  begin
    rw [structureTo.apps_neg, TermNeg],
    unfold_coes,
    unfold_coes at h,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map] at h,
    simp only [structureTo.UnariesMap, structureTo.FuncMap,
      dvector.last, realize_bounded_term, neg, dvector.nth, coe_mv_poly_neg],
    simp only [ring_hom.to_fun_eq_coe, ring_hom.map_neg,
    mv_polynomial.eval_map, neg_inj],
    rw ← h t (psum.inl rfl),
  end
  | 2 RingBinaries.add ([s,t]) h :=
  begin
    rw [structureTo.apps_add, TermAdd],
    unfold_coes,
    unfold_coes at h,
    simp only [structureTo.FuncMap, structureTo.BinariesMap,
      ring_hom.map_add, dvector.last, ring_hom.to_fun_eq_coe,
      realize_bounded_term, mv_polynomial.eval_map, dvector.nth, add],
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map] at h,
    rw ← (h s (psum.inl rfl)),
    rw ← (h t (psum.inr (psum.inl rfl))),
  end
  | 2 RingBinaries.mul [s,t] h :=
  begin
    rw [structureTo.apps_mul, TermMul],
    unfold_coes,
    unfold_coes at h,
    simp only [structureTo.FuncMap, structureTo.BinariesMap,
      ring_hom.map_mul, dvector.last, ring_hom.to_fun_eq_coe,
      realize_bounded_term, mv_polynomial.eval_map, dvector.nth, mul],
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map] at h,
    rw ← (h s (psum.inl rfl)),
    rw ← (h t (psum.inr (psum.inl rfl))),
  end
  | (n + 3) f t_ h := pempty.elim f

  lemma RealizedTermIsEvaluatedPoly {n} {as : dvector A n} :
  Π (t : bounded_term RingSignature n),
    @realize_bounded_term _ AStruc _ as _ t dvector.nil
    = mv_polynomial.eval (fin_val_of_dvector as) (Term t) :=
  @bounded_term.rec RingSignature n
  (λ t, @realize_bounded_term _ AStruc _ as _ t dvector.nil
    = mv_polynomial.eval (fin_val_of_dvector as) (Term t))
  (RealisedVarIsEvaluatedVar)
  (λ l, RealisedFuncIsEvaluatedFunc)

end mv_polynomial

namespace polynomial

  variables {A : Type u} [comm_ring A]

  @[reducible] private def AStruc := structureTo.Structure A

  -- noncomputable def mv_poly_Z_to_poly_A {n} (as : dvector A n) (p : mv_polynomial (fin n.succ) ℤ) :
  --   polynomial A :=
  -- let σ : fin n.succ → polynomial A :=
  -- @fin.cases n (λ _, polynomial A) polynomial.X (λ i, polynomial.C (dvector.nth' as i)) in
  -- mv_polynomial.eval σ p

  @[simp] noncomputable def TermEvaluatedAtCoeffs {n} (as : dvector A n)
    (t : bounded_term RingSignature n.succ) : polynomial A :=
  let σ : fin n.succ → polynomial A :=
  @fin.cases n (λ _, polynomial A) polynomial.X (λ i, polynomial.C (dvector.nth' as i)) in
  mv_polynomial.eval σ (mv_polynomial.Term t)

  -- lemma this'x_k {n} {as : dvector A n} {x : A} : Π {k : fin n.succ},
  --   polynomial.eval x (TermEvaluatedAtCoeffs as (x_ k))
  --   = @realize_bounded_term _ AStruc n.succ (x::as) _ (x_ k) dvector.nil :=
  -- @fin.cases n
  -- (λ k, polynomial.eval x (TermEvaluatedAtCoeffs as (x_ k))
  --   = @realize_bounded_term _ AStruc n.succ (x::as) _ (x_ k) dvector.nil)
  -- (begin
  --   simp only [TermEvaluatedAtCoeffs, realize_bounded_term,
  --     mv_polynomial.Term, bounded_term.rec],
  --   simp,
  -- end)
  -- (begin
  --   intro k,
  --   simp only [TermEvaluatedAtCoeffs, realize_bounded_term,
  --     mv_polynomial.Term, bounded_term.rec],
  --   simpa,
  -- end)

  lemma fin_val_of_dvector_eq_x_val {n} {x : A} {as : dvector A n} :
    fin_val_of_dvector (x :: as) = x_val x (fin_val_of_dvector as) :=
    funext (
    @fin.cases n (λ k, fin_val_of_dvector (x :: as) k = x_val x (fin_val_of_dvector as) k)
    rfl
    (λ k, begin unfold fin_val_of_dvector, simp, end)
    )

  lemma eval_eq_realize_bounded_term
    {n} {as : dvector A n} {x : A} (t : bounded_term.{u} RingSignature n.succ) :
    (polynomial.eval x (TermEvaluatedAtCoeffs as t)
      = @realize_bounded_term _ AStruc n.succ (x::as) _ t dvector.nil) :=
  begin
    rw mv_polynomial.RealizedTermIsEvaluatedPoly,
    rw fin_val_of_dvector_eq_x_val,
    rw mv_polynomial.eval_eq_poly_eval_mv_coeffs,
    simp only [fin_val_of_dvector, function.comp_app, x_val,
      mv_poly_coeffs_to_poly, TermEvaluatedAtCoeffs],
    have hcoes : polynomial.C.comp (int.cast_ring_hom AStruc) = int.cast_ring_hom (polynomial A) :=
    by simp,
    unfold_coes,
    rw ← hcoes,
    simp,
  end

  lemma TermEvaluatedAtCoeffsX {n} {as : dvector A n} :
    TermEvaluatedAtCoeffs as (x_ 0) = polynomial.X :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermX],
    simp,
  end

  lemma TermEvaluatedAtCoeffsCoeff
  {n} {as : dvector A n} {k : fin n} :
    TermEvaluatedAtCoeffs as (x_ (k.succ)) = polynomial.C (dvector.nth' as k) :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermX],
    simp,
  end

  lemma TermEvaluatedAtCoeffsZero {n} {as : dvector A n} :
    TermEvaluatedAtCoeffs as (bd_const RingConsts.zero) = 0 :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermZero],
    simp,
  end

  lemma TermEvaluatedAtCoeffsOne {n} {as : dvector A n} :
    TermEvaluatedAtCoeffs as (bd_const RingConsts.one) = 1 :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermOne],
    simp,
  end

  lemma TermEvaluatedAtCoeffsNeg {n} {as : dvector A n} {t : bounded_term RingSignature n.succ} :
    TermEvaluatedAtCoeffs as (- t) = - TermEvaluatedAtCoeffs as t :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermNeg],
    simp,
  end

  lemma TermEvaluatedAtCoeffsAdd {n} {as : dvector A n} {s t : bounded_term RingSignature n.succ} :
    TermEvaluatedAtCoeffs as (s + t) = TermEvaluatedAtCoeffs as s + TermEvaluatedAtCoeffs as t :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermAdd],
    simp,
  end

  lemma TermEvaluatedAtCoeffsMul {n} {as : dvector A n} {s t : bounded_term RingSignature n.succ} :
    TermEvaluatedAtCoeffs as (s * t) = TermEvaluatedAtCoeffs as s * TermEvaluatedAtCoeffs as t :=
  begin
    simp only [TermEvaluatedAtCoeffs],
    unfold_coes,
    simp only [ring_hom.to_fun_eq_coe, mv_polynomial.eval_map, mv_polynomial.TermMul],
    simp,
  end

  lemma TermEvaluatedAtCoeffsPow {n : ℕ} : Π {m : ℕ} {as : dvector A n},
    polynomial.TermEvaluatedAtCoeffs as (x_ 0 ^ m) = polynomial.X ^ m
  | 0       _ :=
  begin
    rw pow_zero,
    simp,
  end
  | (n + 1) as :=
  begin
    rw Rings.pow_succ,
    rw TermEvaluatedAtCoeffsMul,
    rw TermEvaluatedAtCoeffsX,
    rw TermEvaluatedAtCoeffsPow,
    refl
  end

  lemma TermEvaluatedAtCoeffsMonomial {n : ℕ} {m : ℕ} {as : dvector A n} {k : fin n} :
    polynomial.TermEvaluatedAtCoeffs as (x_ (k.succ) * x_ 0 ^ m)
      = polynomial.monomial m (dvector.nth' as k) :=
  begin
    rw TermEvaluatedAtCoeffsMul,
    rw TermEvaluatedAtCoeffsCoeff,
    rw TermEvaluatedAtCoeffsPow,
    rw polynomial.monomial_eq_C_mul_X,
  end

  lemma nth_eq_succ_nth : Π {k n : ℕ} {as : dvector A (n + 1)} {h : k < n},
  as.nth k (lt_trans h (by simp)) = (dvector.remove_mth (n + 2) as).nth k h
  | k nat.zero ([a]) h := by {exfalso, simpa using h}
  | nat.zero (nat.succ n) (a::as) h := by simp
  | (nat.succ k) (nat.succ n) (a::as) h := by {simpa using nth_eq_succ_nth}

  lemma lift_succ_remove_last {n : ℕ} :
  Π {t : bounded_term RingSignature (n + 1)} {as : dvector A (n + 1)},
    polynomial.TermEvaluatedAtCoeffs as (lift_succ t)
    = polynomial.TermEvaluatedAtCoeffs (dvector.remove_mth (n + 2) as) t :=
  @RingTermRec (n + 1)
  (λ {t : bounded_term RingSignature (n + 1)}, Π {as : dvector A (n + 1)},
    polynomial.TermEvaluatedAtCoeffs as (lift_succ t)
    = polynomial.TermEvaluatedAtCoeffs (dvector.remove_mth (n + 2) as) t)
    (begin -- variables
      intros k as,
      rw lift_succ_x_k,
      cases k with k hk,
      cases k,
      {simp only [mv_polynomial.eval_X, fin.mk_zero, fin.cases_zero, fin.coe_eq_cast_succ,
        fin.cast_succ_zero, coe_mv_poly_X,
        mv_polynomial.TermX, TermEvaluatedAtCoeffs]},
      {
        simp only [mv_polynomial.eval_X, polynomial.C_inj,
          fin.coe_eq_cast_succ, fin.cases_succ', coe_mv_poly_X, fin.cast_succ_mk,
          mv_polynomial.TermX, TermEvaluatedAtCoeffs, dvector.nth'],
        apply nth_eq_succ_nth,
      },
    end)
    (begin -- 0
      intro as,
      simp only [zero, bd_const, lift_succ],
      repeat {rw ← bd_const},
      repeat {rw TermEvaluatedAtCoeffsZero},
    end)
    (begin -- 1
      intro as,
      simp only [one, bd_const, lift_succ],
      repeat {rw ← bd_const},
      repeat {rw TermEvaluatedAtCoeffsOne},
    end)
    (begin -- neg
      intros t h as,
      simp only [neg, lift_succ],
      repeat {rw structureTo.app_neg},
      repeat {rw TermEvaluatedAtCoeffsNeg},
      rw h,
    end)
    (begin
      intros s t hs ht as,
      simp only [add, lift_succ],
      repeat {rw structureTo.app_add},
      repeat {rw TermEvaluatedAtCoeffsAdd},
      rw [hs, ht],
    end)
    (begin
      intros s t hs ht as,
      simp only [mul, lift_succ],
      repeat {rw structureTo.app_mul},
      repeat {rw TermEvaluatedAtCoeffsMul},
      rw [hs, ht],
    end)

end polynomial

namespace ModelTo

  variable {M : Structure RingSignature}

  def zero : ↥ M := @Structure.fun_map _ M 0 RingConsts.zero dvector.nil
  def one : ↥ M := @Structure.fun_map _ M 0 RingConsts.one dvector.nil
  def neg (a : M.carrier) : M.carrier := @Structure.fun_map _ M 1 RingUnaries.neg ([a])
  def add (a b : M.carrier) : M.carrier := @Structure.fun_map _ M 2 RingBinaries.add ([a , b])
  def mul (a b : M.carrier) : M.carrier := @Structure.fun_map _ M 2 RingBinaries.mul ([a , b])

  instance : has_zero M := ⟨ zero ⟩
  instance : has_one M := ⟨ one ⟩
  instance : has_neg M := ⟨ neg ⟩
  instance : has_add M := ⟨ add ⟩
  instance : has_mul M := ⟨ mul ⟩

  @[simp] lemma realize_zero {n} {vec : dvector M.carrier n} :
    realize_bounded_term vec (bd_const RingConsts.zero) dvector.nil = 0 := rfl

  @[simp] lemma realize_one {n} {vec : dvector M.carrier n} :
    realize_bounded_term vec (bd_const RingConsts.one) dvector.nil = 1 := rfl

  @[simp] lemma realize_neg {a : M.carrier} :
    @Structure.fun_map _ M 1 RingUnaries.neg ([a]) = - a := rfl

  @[simp] lemma realize_add {a b : M.carrier} :
    @Structure.fun_map _ M 2 RingBinaries.add ([a , b]) = a + b := rfl

  @[simp] lemma realize_mul {a b : M.carrier} :
    @Structure.fun_map _ M 2 RingBinaries.mul ([a , b]) = a * b := rfl

  variable [h : fact (M ⊨ RingTheory)]

  include h
  lemma add_assoc (a b c : M) : (a + b) + c = a + (b + c) :=
  begin
      have hAssoc := h.elim AddAssocInRingTheory, have habc := hAssoc c b a,
      simpa using habc
  end

  lemma add_comm (a b : M) : a + b = b + a :=
  begin
    have hId := h.elim AddCommInRingTheory, have hab := hId b a, simpa using hab
  end

  lemma add_zero (a : M) : a + 0 = a :=
  begin
    have hId := h.elim AddIdInRingTheory, have ha := hId a, simpa using ha
  end

  lemma zero_add (a : M) : 0 + a = a :=
  begin
    rw add_comm, apply add_zero,
  end

  lemma left_neg (a : M) : - a + a = 0 :=
  begin
    have hInv := h.elim AddInvInRingTheory, have ha := hInv a, simpa using ha
  end

  lemma mul_assoc (a b c : M) : (a * b) * c = a * (b * c) :=
  begin
    have hAssoc := h.elim MulAssocInRingTheory, have habc := hAssoc c b a,
    simpa using habc
  end

  lemma mul_comm (a b : M) : a * b = b * a :=
  begin
    have hId := h.elim MulCommInRingTheory, have hab := hId b a, simpa using hab
  end

  lemma mul_one (a : M) : a * 1 = a :=
  begin
    have hId := h.elim MulIdInRingTheory, have ha := hId a, simpa using ha
  end

  lemma one_mul (a : M) : 1 * a = a :=
  begin
    rw mul_comm, apply mul_one
  end

  lemma add_mul (a b c : M) : (a + b) * c = a * c + b * c :=
  begin
    have hAM := h.elim AddMulInRingTheory, have habc := hAM c b a, simpa using habc
  end

  lemma mul_add (c a b : M) : c * (a + b) = c * a + c * b :=
  begin
    rw (mul_comm c (a + b)), rw (mul_comm c a), rw (mul_comm c b),
    exact add_mul a b c,
  end

  instance CommRing : comm_ring M :=
  {
    add            := add,
    add_assoc      := add_assoc,
    zero           := zero,
    zero_add       := zero_add,
    add_zero       := add_zero,
    neg            := neg,
    add_left_neg   := left_neg,
    add_comm       := add_comm,
    mul            := mul,
    mul_assoc      := mul_assoc,
    one            := one,
    one_mul        := one_mul,
    mul_one        := mul_one,
    left_distrib   := mul_add,
    right_distrib  := add_mul,
    mul_comm       := mul_comm,
  }

end ModelTo

end Rings


/- More on Sections -/

namespace ms
  section
    variable (x y : Nat)

    def double := x + x

    #check double (x + 1)

    theorem t1 : double (x + y) = double x + double y := by
      simp_arith [double]

    #check t1 y 1

    theorem t2 : double (x * y) = double x * y := by
      simp_arith [double, Nat.add_mul]

  end
end ms

/- Attributes -/

namespace att
  def isPrefix (l₁ l₂ : List α) : Prop := ∃ t, l₁ ++ t = l₂
  /-
  @[simp] theorem List.isPrefix_self (as : List α) : isPrefix as as :=
    Exists.intro [] (by simp)
  -/

  instance : LE (List α) where le := isPrefix

  @[simp] theorem List.isPrefix_self (as : List α) : as ≤ as :=
    Exists.intro [] (by simp)

  example : [1, 2] ≤ [1, 2] := by simp
end att

/- More on Implicit Arguments -/

namespace mia
  def f (x : Nat) {y : Nat} (z : Nat) := x + z
  #check f 7 -- Nat → Nat
  #check f 7 3 -- Nat

  def f' (x : Nat) ⦃y : Nat⦄ (z : Nat) := x + z
  #check f' 7 -- ⦃Nat⦄ Nat → Nat  f
  #check f' 7 3 -- Nat

  def reflexive {α : Type u} (r : α → α → Prop) : Prop :=
    ∀ {{a}}, r a a

  def symmetric {α : Type u} (r : α → α → Prop) : Prop :=
    ∀ {{a b}}, r a b → r b a

  def transitive {α : Type u} (r : α → α → Prop) : Prop :=
    ∀ {{a b c}}, r a b → r b c → r a c

  def euclidean {α : Type u} (r : α → α → Prop) : Prop :=
    ∀ {{a b c}}, r a b → r a c → r b c

  theorem th1 {α : Type u} {r : α → α → Prop}
      (reflr : reflexive r) (eucl : euclidean r) : symmetric r := by
    repeat intro
    apply eucl; assumption
    apply reflr

  theorem th2 {α : Type u} {r : α → α → Prop}
      (symm : symmetric r) (eucl : euclidean r) : transitive r := by
    repeat intro
    apply eucl
    apply symm
    repeat assumption

  theorem th3 {α : Type u} {r : α → α → Prop}
      (reflr : reflexive r) (eucl : euclidean r) : transitive r := by
    repeat intro
    have : symmetric r := by apply th1 <;> assumption
    apply th2 <;> assumption
end mia

/- Notation -/
/-
namespace not
  infixl:65 "+" => HAdd.hAdd
  infix:50 "=" => Eq
  set_option quotPrecheck false
  postfix:max "⁻¹" => Inv.inv

  notation:65 lhs:65 "+" rhs:66 => HAdd.hAdd lhs rhs -- a + b + c = (a + b) + c
  notation:80 base:81 "^" exp:80 => HPow.hPow base exp -- a ^ b ^ c = a ^ (b ^ c)
end not
-/

/- Coercions -/

namespace coer
  variable (m n : Nat) (i j : Int)
  #check i + m -- i + Int.ofNat m : Int
  #check m + i -- Int.ofNat m + i : Int
end coer

/- Options -/

namespace opt
  /-
    pp.explicit  : display implicit arguments
    pp.universes : display hidden universe parameters
    pp.notation  : display output using defined notations
  -/

  set_option pp.explicit true
  set_option pp.universes true
  set_option pp.notation false
  /-
  #check 2 + 2 = 4
  #reduce (fun x => x + 2) = (fun x => x + 3)
  #check (fun x => x + 1) 1
  -/
end opt

/- AutoBound Implicit Arguments -/

namespace abia
  section
    universe u v w
    def compose₀ {α : Type u} {β : Type v} {γ : Type w}
        (g : β → γ) (f : α → β) (x : α) : γ :=
      g (f x)
  end

  def compose₁.{u, v, w}
      {α : Type u} {β : Type v} {γ : Type w}
      (g : β → γ) (f : α → β) (x : α) : γ :=
    g (f x)

  def compose (g : β → γ) (f : α → β) (x : α) : γ :=
    g (f x)

  /-
  @compose : {β : Sort u_1} → {γ : Sort u_2} → {α : Sort u_3} → (β → γ) → (α → β) → α → γ
  -/
  #check @compose

end abia

/- Sugar for Simple Functions -/

namespace Sugar
  #check (2 - ·) -- fun a => 2 - a

  #eval [1, 2, 3, 4, 5].foldl (· * ·) 1 -- 120

  #eval [(1, 2), (3, 4), (5, 6)].map (·.1) -- [1, 3, 5]
end Sugar

/- Named Arguments -/

namespace na
  def sum (xs : List Nat) : Nat :=
    xs.foldl (init:=0) (Nat.add · ·)
  #eval sum [1, 2, 3, 4] -- 10

  example {a b : Nat} {p : Nat → Nat → Nat → Prop} (h₁ : p a b b) (h₂ : b = a)
      : p a a b :=
    Eq.subst (motive := fun x => p a x b) h₂ h₁

  def g {α} [Add α] (a : α) (b? : Option α := none) (c : α) : α :=
    match b? with
    | none => a + c
    | some b => a + b + c

  variable {α} [Add α]
  example (x : α) : g (c := x) = fun (a : α) => a + x := rfl

end na


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

import data.list.basic

/-!
# Palindromes

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

This module defines *palindromes*, lists which are equal to their reverse.

The main result is the `palindrome` inductive type, and its associated `palindrome.rec_on` induction
principle. Also provided are conversions to and from other equivalent definitions.

## References

* [Pierre Castéran, *On palindromes*][casteran]

[casteran]: https://www.labri.fr/perso/casteran/CoqArt/inductive-prop-chap/palindrome.html

## Tags

palindrome, reverse, induction
-/

variables {α β : Type*}

namespace list

/--
`palindrome l` asserts that `l` is a palindrome. This is defined inductively:

* The empty list is a palindrome;
* A list with one element is a palindrome;
* Adding the same element to both ends of a palindrome results in a bigger palindrome.
-/
inductive palindrome : list α → Prop
| nil : palindrome []
| singleton : ∀ x, palindrome [x]
| cons_concat : ∀ x {l}, palindrome l → palindrome (x :: (l ++ [x]))

namespace palindrome
variables {l : list α}

lemma reverse_eq {l : list α} (p : palindrome l) : reverse l = l :=
palindrome.rec_on p rfl (λ _, rfl) (λ x l p h, by simp [h])

lemma of_reverse_eq {l : list α} : reverse l = l → palindrome l :=
begin
  refine bidirectional_rec_on l (λ _, palindrome.nil) (λ a _, palindrome.singleton a) _,
  intros x l y hp hr,
  rw [reverse_cons, reverse_append] at hr,
  rw head_eq_of_cons_eq hr,
  have : palindrome l, from hp (append_inj_left' (tail_eq_of_cons_eq hr) rfl),
  exact palindrome.cons_concat x this
end

lemma iff_reverse_eq {l : list α} : palindrome l ↔ reverse l = l :=
iff.intro reverse_eq of_reverse_eq

lemma append_reverse (l : list α) : palindrome (l ++ reverse l) :=
by { apply of_reverse_eq, rw [reverse_append, reverse_reverse] }

protected lemma map (f : α → β) (p : palindrome l) : palindrome (map f l) :=
of_reverse_eq $ by rw [← map_reverse, p.reverse_eq]

instance [decidable_eq α] (l : list α) : decidable (palindrome l) :=
decidable_of_iff' _ iff_reverse_eq

end palindrome
end list


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import data.fun_like.embedding
import data.prod.pprod
import data.set.basic
import data.sigma.basic
import logic.equiv.basic

/-!
# Injective functions
-/

universes u v w x

namespace function

/-- `α ↪ β` is a bundled injective function. -/
@[nolint has_inhabited_instance] -- depending on cardinalities, an injective function may not exist
structure embedding (α : Sort*) (β : Sort*) :=
(to_fun : α → β)
(inj'   : injective to_fun)

infixr ` ↪ `:25 := embedding

instance {α : Sort u} {β : Sort v} : has_coe_to_fun (α ↪ β) (λ _, α → β) := ⟨embedding.to_fun⟩

initialize_simps_projections embedding (to_fun → apply)

instance {α : Sort u} {β : Sort v} : embedding_like (α ↪ β) α β :=
{ coe := embedding.to_fun,
  injective' := embedding.inj',
  coe_injective' := λ f g h, by { cases f, cases g, congr' } }

instance {α β : Sort*} : can_lift (α → β) (α ↪ β) :=
{ coe := coe_fn,
  cond := injective,
  prf := λ f hf, ⟨⟨f, hf⟩, rfl⟩ }

end function

section equiv

variables {α : Sort u} {β : Sort v} (f : α ≃ β)

/-- Convert an `α ≃ β` to `α ↪ β`.

This is also available as a coercion `equiv.coe_embedding`.
The explicit `equiv.to_embedding` version is preferred though, since the coercion can have issues
inferring the type of the resulting embedding. For example:

```lean
-- Works:
example (s : finset (fin 3)) (f : equiv.perm (fin 3)) : s.map f.to_embedding = s.map f := by simp
-- Error, `f` has type `fin 3 ≃ fin 3` but is expected to have type `fin 3 ↪ ?m_1 : Type ?`
example (s : finset (fin 3)) (f : equiv.perm (fin 3)) : s.map f = s.map f.to_embedding := by simp
```
-/
@[simps] protected def equiv.to_embedding : α ↪ β := ⟨f, f.injective⟩

instance equiv.coe_embedding : has_coe (α ≃ β) (α ↪ β) := ⟨equiv.to_embedding⟩

@[reducible]
instance equiv.perm.coe_embedding : has_coe (equiv.perm α) (α ↪ α) := equiv.coe_embedding

@[simp] lemma equiv.coe_eq_to_embedding  : ↑f = f.to_embedding := rfl

/-- Given an equivalence to a subtype, produce an embedding to the elements of the corresponding
set. -/
@[simps]
def equiv.as_embedding {p : β → Prop} (e : α ≃ subtype p) : α ↪ β :=
⟨coe ∘ e, subtype.coe_injective.comp e.injective⟩

@[simp]
lemma equiv.as_embedding_range {α β : Sort*} {p : β → Prop} (e : α ≃ subtype p) :
  set.range e.as_embedding = set_of p :=
set.ext $ λ x, ⟨λ ⟨y, h⟩, h ▸ subtype.coe_prop (e y), λ hs, ⟨e.symm ⟨x, hs⟩, by simp⟩⟩

end equiv

namespace function
namespace embedding

lemma coe_injective {α β} : @function.injective (α ↪ β) (α → β) coe_fn := fun_like.coe_injective

@[ext] lemma ext {α β} {f g : embedding α β} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h

lemma ext_iff {α β} {f g : embedding α β} : (∀ x, f x = g x) ↔ f = g := fun_like.ext_iff.symm

@[simp] theorem to_fun_eq_coe {α β} (f : α ↪ β) : to_fun f = f := rfl

@[simp] theorem coe_fn_mk {α β} (f : α → β) (i) :
  (@mk _ _ f i : α → β) = f := rfl

@[simp] lemma mk_coe {α β : Type*} (f : α ↪ β) (inj) : (⟨f, inj⟩ : α ↪ β) = f :=
by { ext, simp }

protected theorem injective {α β} (f : α ↪ β) : injective f := embedding_like.injective f

lemma apply_eq_iff_eq {α β} (f : α ↪ β) (x y : α) : f x = f y ↔ x = y :=
embedding_like.apply_eq_iff_eq f

/-- The identity map as a `function.embedding`. -/
@[refl, simps {simp_rhs := tt}]
protected def refl (α : Sort*) : α ↪ α :=
⟨id, injective_id⟩

/-- Composition of `f : α ↪ β` and `g : β ↪ γ`. -/
@[trans, simps {simp_rhs := tt}]
protected def trans {α β γ} (f : α ↪ β) (g : β ↪ γ) : α ↪ γ :=
⟨g ∘ f, g.injective.comp f.injective⟩

@[simp]
lemma equiv_to_embedding_trans_symm_to_embedding {α β : Sort*} (e : α ≃ β) :
  e.to_embedding.trans e.symm.to_embedding = embedding.refl _ :=
by { ext, simp, }

@[simp]
lemma equiv_symm_to_embedding_trans_to_embedding {α β : Sort*} (e : α ≃ β) :
  e.symm.to_embedding.trans e.to_embedding = embedding.refl _ :=
by { ext, simp, }

/-- Transfer an embedding along a pair of equivalences. -/
@[simps { fully_applied := ff }]
protected def congr {α : Sort u} {β : Sort v} {γ : Sort w} {δ : Sort x}
  (e₁ : α ≃ β) (e₂ : γ ≃ δ) (f : α ↪ γ) : (β ↪ δ) :=
(equiv.to_embedding e₁.symm).trans (f.trans e₂.to_embedding)

/-- A right inverse `surj_inv` of a surjective function as an `embedding`. -/
protected noncomputable def of_surjective {α β} (f : β → α) (hf : surjective f) :
  α ↪ β :=
⟨surj_inv hf, injective_surj_inv _⟩

/-- Convert a surjective `embedding` to an `equiv` -/
protected noncomputable def equiv_of_surjective {α β} (f : α ↪ β) (hf : surjective f) :
  α ≃ β :=
equiv.of_bijective f ⟨f.injective, hf⟩

/-- There is always an embedding from an empty type. --/
protected def of_is_empty {α β} [is_empty α] : α ↪ β :=
⟨is_empty_elim, is_empty_elim⟩

/-- Change the value of an embedding `f` at one point. If the prescribed image
is already occupied by some `f a'`, then swap the values at these two points. -/
def set_value {α β} (f : α ↪ β) (a : α) (b : β) [∀ a', decidable (a' = a)]
  [∀ a', decidable (f a' = b)] : α ↪ β :=
⟨λ a', if a' = a then b else if f a' = b then f a else f a',
  begin
    intros x y h,
    dsimp at h,
    split_ifs at h; try { substI b }; try { simp only [f.injective.eq_iff] at * }; cc
  end⟩

theorem set_value_eq {α β} (f : α ↪ β) (a : α) (b : β) [∀ a', decidable (a' = a)]
  [∀ a', decidable (f a' = b)] : set_value f a b a = b :=
by simp [set_value]

/-- Embedding into `option α` using `some`. -/
@[simps { fully_applied := ff }] protected def some {α} : α ↪ option α :=
⟨some, option.some_injective α⟩

/-- Embedding into `option α` using `coe`. Usually the correct synctatical form for `simp`. -/
@[simps { fully_applied := ff }]
def coe_option {α} : α ↪ option α := ⟨coe, option.some_injective α⟩

/-- Embedding into `with_top α`. -/
@[simps]
def coe_with_top {α} : α ↪ with_top α := { to_fun := coe, ..embedding.some}

/-- Given an embedding `f : α ↪ β` and a point outside of `set.range f`, construct an embedding
`option α ↪ β`. -/
@[simps] def option_elim {α β} (f : α ↪ β) (x : β) (h : x ∉ set.range f) :
  option α ↪ β :=
⟨option.elim x f, option.injective_iff.2 ⟨f.2, h⟩⟩

/-- Equivalence between embeddings of `option α` and a sigma type over the embeddings of `α`. -/
@[simps]
def option_embedding_equiv (α β) : (option α ↪ β) ≃ Σ f : α ↪ β, ↥(set.range f)ᶜ :=
{ to_fun := λ f, ⟨coe_option.trans f, f none, λ ⟨x, hx⟩, option.some_ne_none x $ f.injective hx⟩,
  inv_fun := λ f, f.1.option_elim f.2 f.2.2,
  left_inv := λ f, ext $ by { rintro (_|_); simp [option.coe_def] },
  right_inv := λ ⟨f, y, hy⟩, by { ext; simp [option.coe_def] } }

/-- A version of `option.map` for `function.embedding`s. -/
@[simps { fully_applied := ff }]
def option_map {α β} (f : α ↪ β) : option α ↪ option β :=
⟨option.map f, option.map_injective f.injective⟩

/-- Embedding of a `subtype`. -/
def subtype {α} (p : α → Prop) : subtype p ↪ α :=
⟨coe, λ _ _, subtype.ext_val⟩

@[simp] lemma coe_subtype {α} (p : α → Prop) : ⇑(subtype p) = coe := rfl

/-- Choosing an element `b : β` gives an embedding of `punit` into `β`. -/
def punit {β : Sort*} (b : β) : punit ↪ β :=
⟨λ _, b, by { rintros ⟨⟩ ⟨⟩ _, refl, }⟩

/-- Fixing an element `b : β` gives an embedding `α ↪ α × β`. -/
@[simps] def sectl (α : Sort*) {β : Sort*} (b : β) : α ↪ α × β :=
⟨λ a, (a, b), λ a a' h, congr_arg prod.fst h⟩

/-- Fixing an element `a : α` gives an embedding `β ↪ α × β`. -/
@[simps] def sectr {α : Sort*} (a : α) (β : Sort*): β ↪ α × β :=
⟨λ b, (a, b), λ b b' h, congr_arg prod.snd h⟩

/-- Restrict the codomain of an embedding. -/
def cod_restrict {α β} (p : set β) (f : α ↪ β) (H : ∀ a, f a ∈ p) : α ↪ p :=
⟨λ a, ⟨f a, H a⟩, λ a b h, f.injective (@congr_arg _ _ _ _ subtype.val h)⟩

@[simp] theorem cod_restrict_apply {α β} (p) (f : α ↪ β) (H a) :
  cod_restrict p f H a = ⟨f a, H a⟩ := rfl

/-- If `e₁` and `e₂` are embeddings, then so is `prod.map e₁ e₂ : (a, b) ↦ (e₁ a, e₂ b)`. -/
def prod_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α × γ ↪ β × δ :=
⟨prod.map e₁ e₂, e₁.injective.prod_map e₂.injective⟩

@[simp] lemma coe_prod_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
  ⇑(e₁.prod_map e₂) = prod.map e₁ e₂ :=
rfl

/-- If `e₁` and `e₂` are embeddings, then so is `λ ⟨a, b⟩, ⟨e₁ a, e₂ b⟩ : pprod α γ → pprod β δ`. -/
def pprod_map {α β γ δ : Sort*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : pprod α γ ↪ pprod β δ :=
⟨λ x, ⟨e₁ x.1, e₂ x.2⟩, e₁.injective.pprod_map e₂.injective⟩

section sum
open sum

/-- If `e₁` and `e₂` are embeddings, then so is `sum.map e₁ e₂`. -/
def sum_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α ⊕ γ ↪ β ⊕ δ :=
⟨sum.map e₁ e₂,
    assume s₁ s₂ h, match s₁, s₂, h with
    | inl a₁, inl a₂, h := congr_arg inl $ e₁.injective $ inl.inj h
    | inr b₁, inr b₂, h := congr_arg inr $ e₂.injective $ inr.inj h
    end⟩

@[simp] theorem coe_sum_map {α β γ δ} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
  ⇑(sum_map e₁ e₂) = sum.map e₁ e₂ :=
rfl

/-- The embedding of `α` into the sum `α ⊕ β`. -/
@[simps] def inl {α β : Type*} : α ↪ α ⊕ β :=
⟨sum.inl, λ a b, sum.inl.inj⟩

/-- The embedding of `β` into the sum `α ⊕ β`. -/
@[simps] def inr {α β : Type*} : β ↪ α ⊕ β :=
⟨sum.inr, λ a b, sum.inr.inj⟩

end sum

section sigma

variables {α α' : Type*} {β : α → Type*} {β' : α' → Type*}

/-- `sigma.mk` as an `function.embedding`. -/
@[simps apply] def sigma_mk (a : α) : β a ↪ Σ x, β x :=
⟨sigma.mk a, sigma_mk_injective⟩

/-- If `f : α ↪ α'` is an embedding and `g : Π a, β α ↪ β' (f α)` is a family
of embeddings, then `sigma.map f g` is an embedding. -/
@[simps apply] def sigma_map (f : α ↪ α') (g : Π a, β a ↪ β' (f a)) :
  (Σ a, β a) ↪ Σ a', β' a' :=
⟨sigma.map f (λ a, g a), f.injective.sigma_map (λ a, (g a).injective)⟩

end sigma

/-- Define an embedding `(Π a : α, β a) ↪ (Π a : α, γ a)` from a family of embeddings
`e : Π a, (β a ↪ γ a)`. This embedding sends `f` to `λ a, e a (f a)`. -/
@[simps] def Pi_congr_right {α : Sort*} {β γ : α → Sort*} (e : ∀ a, β a ↪ γ a) :
  (Π a, β a) ↪ (Π a, γ a) :=
⟨λf a, e a (f a), λ f₁ f₂ h, funext $ λ a, (e a).injective (congr_fun h a)⟩

/-- An embedding `e : α ↪ β` defines an embedding `(γ → α) ↪ (γ → β)` that sends each `f`
to `e ∘ f`. -/
def arrow_congr_right {α : Sort u} {β : Sort v} {γ : Sort w}
  (e : α ↪ β) : (γ → α) ↪ (γ → β) :=
Pi_congr_right (λ _, e)

@[simp] lemma arrow_congr_right_apply {α : Sort u} {β : Sort v} {γ : Sort w}
  (e : α ↪ β) (f : γ ↪ α) : arrow_congr_right e f = e ∘ f := rfl

/-- An embedding `e : α ↪ β` defines an embedding `(α → γ) ↪ (β → γ)` for any inhabited type `γ`.
This embedding sends each `f : α → γ` to a function `g : β → γ` such that `g ∘ e = f` and
`g y = default` whenever `y ∉ range e`. -/
noncomputable def arrow_congr_left {α : Sort u} {β : Sort v} {γ : Sort w} [inhabited γ]
  (e : α ↪ β) : (α → γ) ↪ (β → γ) :=
⟨λ f, extend e f default, λ f₁ f₂ h, funext $ λ x,
  by simpa only [extend_apply e.injective] using congr_fun h (e x)⟩

/-- Restrict both domain and codomain of an embedding. -/
protected def subtype_map {α β} {p : α → Prop} {q : β → Prop} (f : α ↪ β)
  (h : ∀{{x}}, p x → q (f x)) : {x : α // p x} ↪ {y : β // q y} :=
⟨subtype.map f h, subtype.map_injective h f.2⟩

open set

/-- `set.image` as an embedding `set α ↪ set β`. -/
@[simps apply] protected def image {α β} (f : α ↪ β) : set α ↪ set β :=
⟨image f, f.2.image_injective⟩

lemma swap_apply {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α ↪ β) (x y z : α) :
  equiv.swap (f x) (f y) (f z) = f (equiv.swap x y z) :=
f.injective.swap_apply x y z

lemma swap_comp {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α ↪ β) (x y : α) :
  equiv.swap (f x) (f y) ∘ f = f ∘ equiv.swap x y :=
f.injective.swap_comp x y

end embedding
end function

namespace equiv

open function.embedding

/-- The type of embeddings `α ↪ β` is equivalent to
    the subtype of all injective functions `α → β`. -/
def subtype_injective_equiv_embedding (α β : Sort*) :
  {f : α → β // function.injective f} ≃ (α ↪ β) :=
{ to_fun := λ f, ⟨f.val, f.property⟩,
  inv_fun := λ f, ⟨f, f.injective⟩,
  left_inv := λ f, by simp,
  right_inv := λ f, by {ext, refl} }

/-- If `α₁ ≃ α₂` and `β₁ ≃ β₂`, then the type of embeddings `α₁ ↪ β₁`
is equivalent to the type of embeddings `α₂ ↪ β₂`. -/
@[congr, simps apply] def embedding_congr {α β γ δ : Sort*}
  (h : α ≃ β) (h' : γ ≃ δ) : (α ↪ γ) ≃ (β ↪ δ) :=
{ to_fun := λ f, f.congr h h',
  inv_fun := λ f, f.congr h.symm h'.symm,
  left_inv := λ x, by {ext, simp},
  right_inv := λ x, by {ext, simp} }

@[simp] lemma embedding_congr_refl {α β : Sort*} :
  embedding_congr (equiv.refl α) (equiv.refl β) = equiv.refl (α ↪ β) :=
by {ext, refl}

@[simp] lemma embedding_congr_trans {α₁ β₁ α₂ β₂ α₃ β₃ : Sort*}
  (e₁ : α₁ ≃ α₂) (e₁' : β₁ ≃ β₂) (e₂ : α₂ ≃ α₃) (e₂' : β₂ ≃ β₃) :
  embedding_congr (e₁.trans e₂) (e₁'.trans e₂') =
  (embedding_congr e₁ e₁').trans (embedding_congr e₂ e₂') :=
rfl

@[simp] lemma embedding_congr_symm {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) :
  (embedding_congr e₁ e₂).symm = embedding_congr e₁.symm e₂.symm :=
rfl

lemma embedding_congr_apply_trans {α₁ β₁ γ₁ α₂ β₂ γ₂ : Sort*}
  (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) (ec : γ₁ ≃ γ₂) (f : α₁ ↪ β₁) (g : β₁ ↪ γ₁) :
  equiv.embedding_congr ea ec (f.trans g) =
  (equiv.embedding_congr ea eb f).trans (equiv.embedding_congr eb ec g) :=
by {ext, simp}

@[simp]
lemma refl_to_embedding {α : Type*} : (equiv.refl α).to_embedding = function.embedding.refl α := rfl

@[simp]
lemma trans_to_embedding {α β γ : Type*} (e : α ≃ β) (f : β ≃ γ) :
  (e.trans f).to_embedding = e.to_embedding.trans f.to_embedding := rfl

end equiv

namespace set

/-- The injection map is an embedding between subsets. -/
@[simps apply] def embedding_of_subset {α} (s t : set α) (h : s ⊆ t) : s ↪ t :=
⟨λ x, ⟨x.1, h x.2⟩, λ ⟨x, hx⟩ ⟨y, hy⟩ h, by { congr, injection h }⟩

end set

section subtype

variable {α : Type*}

/-- A subtype `{x // p x ∨ q x}` over a disjunction of `p q : α → Prop` can be injectively split
into a sum of subtypes `{x // p x} ⊕ {x // q x}` such that `¬ p x` is sent to the right. -/
def subtype_or_left_embedding (p q : α → Prop) [decidable_pred p] :
  {x // p x ∨ q x} ↪ {x // p x} ⊕ {x // q x} :=
⟨λ x, if h : p x then sum.inl ⟨x, h⟩ else sum.inr ⟨x, x.prop.resolve_left h⟩,
  begin
    intros x y,
    dsimp only,
    split_ifs;
    simp [subtype.ext_iff]
  end⟩

lemma subtype_or_left_embedding_apply_left {p q : α → Prop} [decidable_pred p]
  (x : {x // p x ∨ q x}) (hx : p x) : subtype_or_left_embedding p q x = sum.inl ⟨x, hx⟩ :=
dif_pos hx

lemma subtype_or_left_embedding_apply_right {p q : α → Prop} [decidable_pred p]
  (x : {x // p x ∨ q x}) (hx : ¬ p x) :
  subtype_or_left_embedding p q x = sum.inr ⟨x, x.prop.resolve_left hx⟩ :=
dif_neg hx

/-- A subtype `{x // p x}` can be injectively sent to into a subtype `{x // q x}`,
if `p x → q x` for all `x : α`. -/
@[simps] def subtype.imp_embedding (p q : α → Prop) (h : p ≤ q) :
  {x // p x} ↪ {x // q x} :=
⟨λ x, ⟨x, h x x.prop⟩, λ x y, by simp [subtype.ext_iff]⟩

/-- A subtype `{x // p x ∨ q x}` over a disjunction of `p q : α → Prop` is equivalent to a sum of
subtypes `{x // p x} ⊕ {x // q x}` such that `¬ p x` is sent to the right, when
`disjoint p q`.

See also `equiv.sum_compl`, for when `is_compl p q`.  -/
@[simps apply] def subtype_or_equiv (p q : α → Prop) [decidable_pred p] (h : disjoint p q) :
  {x // p x ∨ q x} ≃ {x // p x} ⊕ {x // q x} :=
{ to_fun := subtype_or_left_embedding p q,
  inv_fun := sum.elim
    (subtype.imp_embedding _ _ (λ x hx, (or.inl hx : p x ∨ q x)))
    (subtype.imp_embedding _ _ (λ x hx, (or.inr hx : p x ∨ q x))),
  left_inv := λ x, begin
    by_cases hx : p x,
    { rw subtype_or_left_embedding_apply_left _ hx,
      simp [subtype.ext_iff] },
    { rw subtype_or_left_embedding_apply_right _ hx,
      simp [subtype.ext_iff] },
  end,
  right_inv := λ x, begin
    cases x,
    { simp only [sum.elim_inl],
      rw subtype_or_left_embedding_apply_left,
      { simp },
      { simpa using x.prop } },
    { simp only [sum.elim_inr],
      rw subtype_or_left_embedding_apply_right,
      { simp },
      { suffices : ¬ p x,
        { simpa },
        intro hp,
        simpa using h x ⟨hp, x.prop⟩ } }
  end }

@[simp] lemma subtype_or_equiv_symm_inl (p q : α → Prop) [decidable_pred p] (h : disjoint p q)
  (x : {x // p x}) : (subtype_or_equiv p q h).symm (sum.inl x) = ⟨x, or.inl x.prop⟩ :=
rfl

@[simp] lemma subtype_or_equiv_symm_inr (p q : α → Prop) [decidable_pred p] (h : disjoint p q)
  (x : {x // q x}) : (subtype_or_equiv p q h).symm (sum.inr x) = ⟨x, or.inr x.prop⟩ :=
rfl

end subtype