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

import algebra.char_p.basic
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.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)] : (nat.mod_modeq _ _).mul_right _
      ... ≡ a * (b * c) [MOD (n+1)] : by rw mul_assoc
      ... ≡ a * (b * c % (n+1)) [MOD (n+1)] : (nat.mod_modeq _ _).symm.mul_left _),
  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)] : (nat.mod_modeq _ _).mul_left _
  ... ≡ a * b + a * c [MOD (n+1)] : by rw mul_add
  ... ≡ (a * b) % (n+1) + (a * c) % (n+1) [MOD (n+1)] :
        (nat.mod_modeq _ _).symm.add (nat.mod_modeq _ _).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)

@[simp] 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

lemma val_le {n : ℕ} [fact (0 < n)] (a : zmod n) : a.val ≤ n :=
a.val_lt.le

@[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 }

variables {S : Type*} [has_zero S] [has_one S] [has_add S] [has_neg S]

@[simp] lemma _root_.prod.fst_zmod_cast (a : zmod n) : (a : R × S).fst = a :=
by cases n; simp

@[simp] lemma _root_.prod.snd_zmod_cast (a : zmod n) : (a : R × S).snd = a :=
by cases n; simp

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

lemma coe_add_eq_ite {n : ℕ} (a b : zmod n) :
  (↑(a + b) : ℤ) = if (n : ℤ) ≤ a + b then a + b - n else a + b :=
begin
  cases n,
  { simp },
  simp only [coe_coe, fin.coe_add_eq_ite, int.nat_cast_eq_coe_nat,
             ← int.coe_nat_add, ← int.coe_nat_succ, int.coe_nat_le],
  split_ifs with h,
  { exact int.coe_nat_sub h },
  { refl }
end

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 h.trans (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 h.trans (nat.dvd_sub_mod _),
end

/-- The canonical ring homomorphism from `zmod n` to a ring of characteristic `n`.

See also `zmod.lift` (in `data.zmod.quotient`) for a generalized version working in `add_group`s.
-/
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_rfl

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

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

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

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

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

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

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],
    intro hn,
    rw hn at h,
    exact (fintype.card_eq_zero_iff.mp h).elim' 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_iff_dvd, int.modeq_iff_dvd],
end

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

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_zero_iff_dvd],
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_zero_iff_dvd],
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.mod_modeq,
end

lemma ker_int_cast_add_hom (n : ℕ) :
  (int.cast_add_hom (zmod n)).ker = add_subgroup.zmultiples n :=
by { ext, rw [int.mem_zmultiples_iff, add_monoid_hom.mem_ker,
              int.coe_cast_add_hom, int_coe_zmod_eq_zero_iff_dvd] }

lemma ker_int_cast_ring_hom (n : ℕ) :
  (int.cast_ring_hom (zmod n)).ker = ideal.span ({n} : set ℤ) :=
by { ext, rw [ideal.mem_span_singleton, ring_hom.mem_ker,
              int.coe_cast_ring_hom, int_coe_zmod_eq_zero_iff_dvd] }

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.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 }

/-- The **Chinese remainder theorem**. For a pair of coprime natural numbers, `m` and `n`,
  the rings `zmod (m * n)` and `zmod m × zmod n` are isomorphic.

See `ideal.quotient_inf_ring_equiv_pi_quotient` for the Chinese remainder theorem for ideals in any
ring.
-/
def chinese_remainder {m n : ℕ} (h : m.coprime n) :
  zmod (m * n) ≃+* zmod m × zmod n :=
let to_fun : zmod (m * n) → zmod m × zmod n :=
  zmod.cast_hom (show m.lcm n ∣ m * n, by simp [nat.lcm_dvd_iff]) (zmod m × zmod n) in
let inv_fun : zmod m × zmod n → zmod (m * n) :=
  λ x, if m * n = 0
    then if m = 1
      then ring_hom.snd _ _ x
      else ring_hom.fst _ _ x
    else nat.chinese_remainder h x.1.val x.2.val in
have inv : function.left_inverse inv_fun to_fun ∧ function.right_inverse inv_fun to_fun :=
  if hmn0 : m * n = 0
    then begin
      rcases h.eq_of_mul_eq_zero hmn0 with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩;
      simp [inv_fun, to_fun, function.left_inverse, function.right_inverse,
        ring_hom.eq_int_cast, prod.ext_iff]
    end
    else
      begin
        haveI : fact (0 < (m * n)) := ⟨nat.pos_of_ne_zero hmn0⟩,
        haveI : fact (0 < m) := ⟨nat.pos_of_ne_zero $ left_ne_zero_of_mul hmn0⟩,
        haveI : fact (0 < n) := ⟨nat.pos_of_ne_zero $ right_ne_zero_of_mul hmn0⟩,
        have left_inv : function.left_inverse inv_fun to_fun,
        { intro x,
          dsimp only [dvd_mul_left, dvd_mul_right, zmod.cast_hom_apply, coe_coe, inv_fun, to_fun],
          conv_rhs { rw ← zmod.nat_cast_zmod_val x },
          rw [if_neg hmn0, zmod.eq_iff_modeq_nat, ← nat.modeq_and_modeq_iff_modeq_mul h,
            prod.fst_zmod_cast, prod.snd_zmod_cast],
          refine
            ⟨(nat.chinese_remainder h (x : zmod m).val (x : zmod n).val).2.left.trans _,
            (nat.chinese_remainder h (x : zmod m).val (x : zmod n).val).2.right.trans _⟩,
          { rw [← zmod.eq_iff_modeq_nat, zmod.nat_cast_zmod_val, zmod.nat_cast_val] },
          { rw [← zmod.eq_iff_modeq_nat, zmod.nat_cast_zmod_val, zmod.nat_cast_val] } },
        exact ⟨left_inv, fintype.right_inverse_of_left_inverse_of_card_le left_inv (by simp)⟩,
      end,
{ to_fun := to_fun,
  inv_fun := inv_fun,
  map_mul' := ring_hom.map_mul _,
  map_add' := ring_hom.map_add _,
  left_inv := inv.1,
  right_inv := inv.2 }

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, add_tsub_cancel_right], },
  have hxn : (n : ℕ) - x.val < n,
  { rw [tsub_lt_iff_tsub_lt x.val_le le_rfl, tsub_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 x.val_le,
    zmod.val_nat_cast, nat.mod_eq_of_lt hxn, tsub_le_tsub_iff_left x.val_le] }
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 :=
calc (-a).val = val (-a)    % n : by rw nat.mod_eq_of_lt ((-a).val_lt)
          ... = (n - val a) % n : nat.modeq.add_right_cancel' _ (by rw [nat.modeq, ←val_add,
                  add_left_neg, tsub_add_cancel_of_le a.val_le, nat.mod_self, val_zero])

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, tsub_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 x.val_le, },
  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 a.val_le, },
  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 a.val_le],
    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 [tsub_le_iff_tsub_le, two_mul, ← add_assoc, add_tsub_cancel_right, 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_zero_iff_dvd,
  ← 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 }

/-- `zmod p` is an integral domain when `p` is prime. -/
instance (p : ℕ) [hp : fact p.prime] : is_domain (zmod p) :=
begin
  -- We need `cases p` here in order to resolve which `comm_ring` instance is being used.
  unfreezingI { cases p, { exfalso, rcases hp with ⟨⟨⟨⟩⟩⟩, }, },
  exact @field.is_domain (zmod _) (zmod.field _)
end

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

section lift

variables (n) {A : Type*} [add_group A]

/-- The map from `zmod n` induced by `f : ℤ →+ A` that maps `n` to `0`. -/
@[simps]
def lift : {f : ℤ →+ A // f n = 0} ≃ (zmod n →+ A) :=
(equiv.subtype_equiv_right $ begin
  intro f,
  rw ker_int_cast_add_hom,
  split,
  { rintro hf _ ⟨x, rfl⟩,
    simp only [f.map_zsmul, zsmul_zero, f.mem_ker, hf] },
  { intro h,
    refine h (add_subgroup.mem_zmultiples _) }
end).trans $ ((int.cast_add_hom (zmod n)).lift_of_right_inverse coe int_cast_zmod_cast)

variables (f : {f : ℤ →+ A // f n = 0})

@[simp] lemma lift_coe (x : ℤ) :
  lift n f (x : zmod n) = f x :=
add_monoid_hom.lift_of_right_inverse_comp_apply _ _ _ _ _

lemma lift_cast_add_hom (x : ℤ) :
  lift n f (int.cast_add_hom (zmod n) x) = f x :=
add_monoid_hom.lift_of_right_inverse_comp_apply _ _ _ _ _

@[simp] lemma lift_comp_coe : zmod.lift n f ∘ coe = f :=
funext $ lift_coe _ _

@[simp] lemma lift_comp_cast_add_hom :
  (zmod.lift n f).comp (int.cast_add_hom (zmod n)) = f :=
add_monoid_hom.ext $ lift_cast_add_hom _ _

end lift

end zmod


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module data.int.order.units
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Order.Basic
import Mathbin.Data.Int.Units
import Mathbin.Algebra.GroupPower.Order

/-!
# Lemmas about units in `ℤ`, which interact with the order structure.

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

namespace Int

/- warning: int.is_unit_iff_abs_eq -> Int.isUnit_iff_abs_eq is a dubious translation:
lean 3 declaration is
  forall {x : Int}, Iff (IsUnit.{0} Int Int.monoid x) (Eq.{1} Int (Abs.abs.{0} Int (Neg.toHasAbs.{0} Int Int.hasNeg (SemilatticeSup.toHasSup.{0} Int (Lattice.toSemilatticeSup.{0} Int (LinearOrder.toLattice.{0} Int Int.linearOrder)))) x) (OfNat.ofNat.{0} Int 1 (OfNat.mk.{0} Int 1 (One.one.{0} Int Int.hasOne))))
but is expected to have type
  forall {x : Int}, Iff (IsUnit.{0} Int Int.instMonoidInt x) (Eq.{1} Int (Abs.abs.{0} Int (Neg.toHasAbs.{0} Int Int.instNegInt (SemilatticeSup.toSup.{0} Int (Lattice.toSemilatticeSup.{0} Int (DistribLattice.toLattice.{0} Int (instDistribLattice.{0} Int Int.instLinearOrderInt))))) x) (OfNat.ofNat.{0} Int 1 (instOfNatInt 1)))
Case conversion may be inaccurate. Consider using '#align int.is_unit_iff_abs_eq Int.isUnit_iff_abs_eqₓ'. -/
theorem isUnit_iff_abs_eq {x : ℤ} : IsUnit x ↔ abs x = 1 := by
  rw [is_unit_iff_nat_abs_eq, abs_eq_nat_abs, ← Int.ofNat_one, coe_nat_inj']
#align int.is_unit_iff_abs_eq Int.isUnit_iff_abs_eq

/- warning: int.is_unit_sq -> Int.isUnit_sq is a dubious translation:
lean 3 declaration is
  forall {a : Int}, (IsUnit.{0} Int Int.monoid a) -> (Eq.{1} Int (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.monoid)) a (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} Int 1 (OfNat.mk.{0} Int 1 (One.one.{0} Int Int.hasOne))))
but is expected to have type
  forall {a : Int}, (IsUnit.{0} Int Int.instMonoidInt a) -> (Eq.{1} Int (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.instMonoidInt)) a (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} Int 1 (instOfNatInt 1)))
Case conversion may be inaccurate. Consider using '#align int.is_unit_sq Int.isUnit_sqₓ'. -/
theorem isUnit_sq {a : ℤ} (ha : IsUnit a) : a ^ 2 = 1 := by rw [sq, is_unit_mul_self ha]
#align int.is_unit_sq Int.isUnit_sq

/- warning: int.units_sq -> Int.units_sq is a dubious translation:
lean 3 declaration is
  forall (u : Units.{0} Int Int.monoid), Eq.{1} (Units.{0} Int Int.monoid) (HPow.hPow.{0, 0, 0} (Units.{0} Int Int.monoid) Nat (Units.{0} Int Int.monoid) (instHPow.{0, 0} (Units.{0} Int Int.monoid) Nat (Monoid.Pow.{0} (Units.{0} Int Int.monoid) (DivInvMonoid.toMonoid.{0} (Units.{0} Int Int.monoid) (Group.toDivInvMonoid.{0} (Units.{0} Int Int.monoid) (Units.group.{0} Int Int.monoid))))) u (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} (Units.{0} Int Int.monoid) 1 (OfNat.mk.{0} (Units.{0} Int Int.monoid) 1 (One.one.{0} (Units.{0} Int Int.monoid) (MulOneClass.toHasOne.{0} (Units.{0} Int Int.monoid) (Units.mulOneClass.{0} Int Int.monoid)))))
but is expected to have type
  forall (u : Units.{0} Int Int.instMonoidInt), Eq.{1} (Units.{0} Int Int.instMonoidInt) (HPow.hPow.{0, 0, 0} (Units.{0} Int Int.instMonoidInt) Nat (Units.{0} Int Int.instMonoidInt) (instHPow.{0, 0} (Units.{0} Int Int.instMonoidInt) Nat (Monoid.Pow.{0} (Units.{0} Int Int.instMonoidInt) (DivInvMonoid.toMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Group.toDivInvMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Units.instGroupUnits.{0} Int Int.instMonoidInt))))) u (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} (Units.{0} Int Int.instMonoidInt) 1 (One.toOfNat1.{0} (Units.{0} Int Int.instMonoidInt) (InvOneClass.toOne.{0} (Units.{0} Int Int.instMonoidInt) (DivInvOneMonoid.toInvOneClass.{0} (Units.{0} Int Int.instMonoidInt) (DivisionMonoid.toDivInvOneMonoid.{0} (Units.{0} Int Int.instMonoidInt) (DivisionCommMonoid.toDivisionMonoid.{0} (Units.{0} Int Int.instMonoidInt) (CommGroup.toDivisionCommMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Units.instCommGroupUnitsToMonoid.{0} Int Int.instCommMonoidInt))))))))
Case conversion may be inaccurate. Consider using '#align int.units_sq Int.units_sqₓ'. -/
@[simp]
theorem units_sq (u : ℤˣ) : u ^ 2 = 1 := by
  rw [Units.ext_iff, Units.val_pow_eq_pow_val, Units.val_one, is_unit_sq u.is_unit]
#align int.units_sq Int.units_sq

/- warning: int.units_pow_two -> Int.units_pow_two is a dubious translation:
lean 3 declaration is
  forall (u : Units.{0} Int Int.monoid), Eq.{1} (Units.{0} Int Int.monoid) (HPow.hPow.{0, 0, 0} (Units.{0} Int Int.monoid) Nat (Units.{0} Int Int.monoid) (instHPow.{0, 0} (Units.{0} Int Int.monoid) Nat (Monoid.Pow.{0} (Units.{0} Int Int.monoid) (DivInvMonoid.toMonoid.{0} (Units.{0} Int Int.monoid) (Group.toDivInvMonoid.{0} (Units.{0} Int Int.monoid) (Units.group.{0} Int Int.monoid))))) u (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} (Units.{0} Int Int.monoid) 1 (OfNat.mk.{0} (Units.{0} Int Int.monoid) 1 (One.one.{0} (Units.{0} Int Int.monoid) (MulOneClass.toHasOne.{0} (Units.{0} Int Int.monoid) (Units.mulOneClass.{0} Int Int.monoid)))))
but is expected to have type
  forall (u : Units.{0} Int Int.instMonoidInt), Eq.{1} (Units.{0} Int Int.instMonoidInt) (HPow.hPow.{0, 0, 0} (Units.{0} Int Int.instMonoidInt) Nat (Units.{0} Int Int.instMonoidInt) (instHPow.{0, 0} (Units.{0} Int Int.instMonoidInt) Nat (Monoid.Pow.{0} (Units.{0} Int Int.instMonoidInt) (DivInvMonoid.toMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Group.toDivInvMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Units.instGroupUnits.{0} Int Int.instMonoidInt))))) u (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} (Units.{0} Int Int.instMonoidInt) 1 (One.toOfNat1.{0} (Units.{0} Int Int.instMonoidInt) (InvOneClass.toOne.{0} (Units.{0} Int Int.instMonoidInt) (DivInvOneMonoid.toInvOneClass.{0} (Units.{0} Int Int.instMonoidInt) (DivisionMonoid.toDivInvOneMonoid.{0} (Units.{0} Int Int.instMonoidInt) (DivisionCommMonoid.toDivisionMonoid.{0} (Units.{0} Int Int.instMonoidInt) (CommGroup.toDivisionCommMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Units.instCommGroupUnitsToMonoid.{0} Int Int.instCommMonoidInt))))))))
Case conversion may be inaccurate. Consider using '#align int.units_pow_two Int.units_pow_twoₓ'. -/
alias units_sq ← units_pow_two
#align int.units_pow_two Int.units_pow_two

/- warning: int.units_mul_self -> Int.units_mul_self is a dubious translation:
lean 3 declaration is
  forall (u : Units.{0} Int Int.monoid), Eq.{1} (Units.{0} Int Int.monoid) (HMul.hMul.{0, 0, 0} (Units.{0} Int Int.monoid) (Units.{0} Int Int.monoid) (Units.{0} Int Int.monoid) (instHMul.{0} (Units.{0} Int Int.monoid) (MulOneClass.toHasMul.{0} (Units.{0} Int Int.monoid) (Units.mulOneClass.{0} Int Int.monoid))) u u) (OfNat.ofNat.{0} (Units.{0} Int Int.monoid) 1 (OfNat.mk.{0} (Units.{0} Int Int.monoid) 1 (One.one.{0} (Units.{0} Int Int.monoid) (MulOneClass.toHasOne.{0} (Units.{0} Int Int.monoid) (Units.mulOneClass.{0} Int Int.monoid)))))
but is expected to have type
  forall (u : Units.{0} Int Int.instMonoidInt), Eq.{1} (Units.{0} Int Int.instMonoidInt) (HMul.hMul.{0, 0, 0} (Units.{0} Int Int.instMonoidInt) (Units.{0} Int Int.instMonoidInt) (Units.{0} Int Int.instMonoidInt) (instHMul.{0} (Units.{0} Int Int.instMonoidInt) (MulOneClass.toMul.{0} (Units.{0} Int Int.instMonoidInt) (Units.instMulOneClassUnits.{0} Int Int.instMonoidInt))) u u) (OfNat.ofNat.{0} (Units.{0} Int Int.instMonoidInt) 1 (One.toOfNat1.{0} (Units.{0} Int Int.instMonoidInt) (InvOneClass.toOne.{0} (Units.{0} Int Int.instMonoidInt) (DivInvOneMonoid.toInvOneClass.{0} (Units.{0} Int Int.instMonoidInt) (DivisionMonoid.toDivInvOneMonoid.{0} (Units.{0} Int Int.instMonoidInt) (DivisionCommMonoid.toDivisionMonoid.{0} (Units.{0} Int Int.instMonoidInt) (CommGroup.toDivisionCommMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Units.instCommGroupUnitsToMonoid.{0} Int Int.instCommMonoidInt))))))))
Case conversion may be inaccurate. Consider using '#align int.units_mul_self Int.units_mul_selfₓ'. -/
@[simp]
theorem units_mul_self (u : ℤˣ) : u * u = 1 := by rw [← sq, units_sq]
#align int.units_mul_self Int.units_mul_self

/- warning: int.units_inv_eq_self -> Int.units_inv_eq_self is a dubious translation:
lean 3 declaration is
  forall (u : Units.{0} Int Int.monoid), Eq.{1} (Units.{0} Int Int.monoid) (Inv.inv.{0} (Units.{0} Int Int.monoid) (Units.hasInv.{0} Int Int.monoid) u) u
but is expected to have type
  forall (u : Units.{0} Int Int.instMonoidInt), Eq.{1} (Units.{0} Int Int.instMonoidInt) (Inv.inv.{0} (Units.{0} Int Int.instMonoidInt) (Units.instInvUnits.{0} Int Int.instMonoidInt) u) u
Case conversion may be inaccurate. Consider using '#align int.units_inv_eq_self Int.units_inv_eq_selfₓ'. -/
@[simp]
theorem units_inv_eq_self (u : ℤˣ) : u⁻¹ = u := by rw [inv_eq_iff_mul_eq_one, units_mul_self]
#align int.units_inv_eq_self Int.units_inv_eq_self

/- warning: int.units_coe_mul_self -> Int.units_coe_mul_self is a dubious translation:
lean 3 declaration is
  forall (u : Units.{0} Int Int.monoid), Eq.{1} Int (HMul.hMul.{0, 0, 0} Int Int Int (instHMul.{0} Int Int.hasMul) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Units.{0} Int Int.monoid) Int (HasLiftT.mk.{1, 1} (Units.{0} Int Int.monoid) Int (CoeTCₓ.coe.{1, 1} (Units.{0} Int Int.monoid) Int (coeBase.{1, 1} (Units.{0} Int Int.monoid) Int (Units.hasCoe.{0} Int Int.monoid)))) u) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) (Units.{0} Int Int.monoid) Int (HasLiftT.mk.{1, 1} (Units.{0} Int Int.monoid) Int (CoeTCₓ.coe.{1, 1} (Units.{0} Int Int.monoid) Int (coeBase.{1, 1} (Units.{0} Int Int.monoid) Int (Units.hasCoe.{0} Int Int.monoid)))) u)) (OfNat.ofNat.{0} Int 1 (OfNat.mk.{0} Int 1 (One.one.{0} Int Int.hasOne)))
but is expected to have type
  forall (u : Units.{0} Int Int.instMonoidInt), Eq.{1} Int (HMul.hMul.{0, 0, 0} Int Int Int (instHMul.{0} Int Int.instMulInt) (Units.val.{0} Int Int.instMonoidInt u) (Units.val.{0} Int Int.instMonoidInt u)) (OfNat.ofNat.{0} Int 1 (instOfNatInt 1))
Case conversion may be inaccurate. Consider using '#align int.units_coe_mul_self Int.units_coe_mul_selfₓ'. -/
-- `units.coe_mul` is a "wrong turn" for the simplifier, this undoes it and simplifies further
@[simp]
theorem units_coe_mul_self (u : ℤˣ) : (u * u : ℤ) = 1 := by
  rw [← Units.val_mul, units_mul_self, Units.val_one]
#align int.units_coe_mul_self Int.units_coe_mul_self

/- warning: int.neg_one_pow_ne_zero -> Int.neg_one_pow_ne_zero is a dubious translation:
lean 3 declaration is
  forall {n : Nat}, Ne.{1} Int (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.monoid)) (Neg.neg.{0} Int Int.hasNeg (OfNat.ofNat.{0} Int 1 (OfNat.mk.{0} Int 1 (One.one.{0} Int Int.hasOne)))) n) (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero)))
but is expected to have type
  forall {n : Nat}, Ne.{1} Int (HPow.hPow.{0, 0, 0} Int Nat Int Int.instHPowIntNat (Neg.neg.{0} Int Int.instNegInt (OfNat.ofNat.{0} Int 1 (instOfNatInt 1))) n) (OfNat.ofNat.{0} Int 0 (instOfNatInt 0))
Case conversion may be inaccurate. Consider using '#align int.neg_one_pow_ne_zero Int.neg_one_pow_ne_zeroₓ'. -/
@[simp]
theorem neg_one_pow_ne_zero {n : ℕ} : (-1 : ℤ) ^ n ≠ 0 :=
  pow_ne_zero _ (abs_pos.mp (by simp))
#align int.neg_one_pow_ne_zero Int.neg_one_pow_ne_zero

/- warning: int.sq_eq_one_of_sq_lt_four -> Int.sq_eq_one_of_sq_lt_four is a dubious translation:
lean 3 declaration is
  forall {x : Int}, (LT.lt.{0} Int Int.hasLt (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.monoid)) x (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} Int 4 (OfNat.mk.{0} Int 4 (bit0.{0} Int Int.hasAdd (bit0.{0} Int Int.hasAdd (One.one.{0} Int Int.hasOne)))))) -> (Ne.{1} Int x (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero)))) -> (Eq.{1} Int (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.monoid)) x (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} Int 1 (OfNat.mk.{0} Int 1 (One.one.{0} Int Int.hasOne))))
but is expected to have type
  forall {x : Int}, (LT.lt.{0} Int Int.instLTInt (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.instMonoidInt)) x (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} Int 4 (instOfNatInt 4))) -> (Ne.{1} Int x (OfNat.ofNat.{0} Int 0 (instOfNatInt 0))) -> (Eq.{1} Int (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.instMonoidInt)) x (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} Int 1 (instOfNatInt 1)))
Case conversion may be inaccurate. Consider using '#align int.sq_eq_one_of_sq_lt_four Int.sq_eq_one_of_sq_lt_fourₓ'. -/
theorem sq_eq_one_of_sq_lt_four {x : ℤ} (h1 : x ^ 2 < 4) (h2 : x ≠ 0) : x ^ 2 = 1 :=
  sq_eq_one_iff.mpr
    ((abs_eq (zero_le_one' ℤ)).mp
      (le_antisymm (lt_add_one_iff.mp (abs_lt_of_sq_lt_sq h1 zero_le_two))
        (sub_one_lt_iff.mp (abs_pos.mpr h2))))
#align int.sq_eq_one_of_sq_lt_four Int.sq_eq_one_of_sq_lt_four

/- warning: int.sq_eq_one_of_sq_le_three -> Int.sq_eq_one_of_sq_le_three is a dubious translation:
lean 3 declaration is
  forall {x : Int}, (LE.le.{0} Int Int.hasLe (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.monoid)) x (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} Int 3 (OfNat.mk.{0} Int 3 (bit1.{0} Int Int.hasOne Int.hasAdd (One.one.{0} Int Int.hasOne))))) -> (Ne.{1} Int x (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero)))) -> (Eq.{1} Int (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.monoid)) x (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (OfNat.ofNat.{0} Int 1 (OfNat.mk.{0} Int 1 (One.one.{0} Int Int.hasOne))))
but is expected to have type
  forall {x : Int}, (LE.le.{0} Int Int.instLEInt (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.instMonoidInt)) x (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} Int 3 (instOfNatInt 3))) -> (Ne.{1} Int x (OfNat.ofNat.{0} Int 0 (instOfNatInt 0))) -> (Eq.{1} Int (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.instMonoidInt)) x (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))) (OfNat.ofNat.{0} Int 1 (instOfNatInt 1)))
Case conversion may be inaccurate. Consider using '#align int.sq_eq_one_of_sq_le_three Int.sq_eq_one_of_sq_le_threeₓ'. -/
theorem sq_eq_one_of_sq_le_three {x : ℤ} (h1 : x ^ 2 ≤ 3) (h2 : x ≠ 0) : x ^ 2 = 1 :=
  sq_eq_one_of_sq_lt_four (lt_of_le_of_lt h1 (lt_add_one 3)) h2
#align int.sq_eq_one_of_sq_le_three Int.sq_eq_one_of_sq_le_three

/- warning: int.units_pow_eq_pow_mod_two -> Int.units_pow_eq_pow_mod_two is a dubious translation:
lean 3 declaration is
  forall (u : Units.{0} Int Int.monoid) (n : Nat), Eq.{1} (Units.{0} Int Int.monoid) (HPow.hPow.{0, 0, 0} (Units.{0} Int Int.monoid) Nat (Units.{0} Int Int.monoid) (instHPow.{0, 0} (Units.{0} Int Int.monoid) Nat (Monoid.Pow.{0} (Units.{0} Int Int.monoid) (DivInvMonoid.toMonoid.{0} (Units.{0} Int Int.monoid) (Group.toDivInvMonoid.{0} (Units.{0} Int Int.monoid) (Units.group.{0} Int Int.monoid))))) u n) (HPow.hPow.{0, 0, 0} (Units.{0} Int Int.monoid) Nat (Units.{0} Int Int.monoid) (instHPow.{0, 0} (Units.{0} Int Int.monoid) Nat (Monoid.Pow.{0} (Units.{0} Int Int.monoid) (DivInvMonoid.toMonoid.{0} (Units.{0} Int Int.monoid) (Group.toDivInvMonoid.{0} (Units.{0} Int Int.monoid) (Units.group.{0} Int Int.monoid))))) u (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.hasMod) n (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))))
but is expected to have type
  forall (u : Units.{0} Int Int.instMonoidInt) (n : Nat), Eq.{1} (Units.{0} Int Int.instMonoidInt) (HPow.hPow.{0, 0, 0} (Units.{0} Int Int.instMonoidInt) Nat (Units.{0} Int Int.instMonoidInt) (instHPow.{0, 0} (Units.{0} Int Int.instMonoidInt) Nat (Monoid.Pow.{0} (Units.{0} Int Int.instMonoidInt) (DivInvMonoid.toMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Group.toDivInvMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Units.instGroupUnits.{0} Int Int.instMonoidInt))))) u n) (HPow.hPow.{0, 0, 0} (Units.{0} Int Int.instMonoidInt) Nat (Units.{0} Int Int.instMonoidInt) (instHPow.{0, 0} (Units.{0} Int Int.instMonoidInt) Nat (Monoid.Pow.{0} (Units.{0} Int Int.instMonoidInt) (DivInvMonoid.toMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Group.toDivInvMonoid.{0} (Units.{0} Int Int.instMonoidInt) (Units.instGroupUnits.{0} Int Int.instMonoidInt))))) u (HMod.hMod.{0, 0, 0} Nat Nat Nat (instHMod.{0} Nat Nat.instModNat) n (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2))))
Case conversion may be inaccurate. Consider using '#align int.units_pow_eq_pow_mod_two Int.units_pow_eq_pow_mod_twoₓ'. -/
theorem units_pow_eq_pow_mod_two (u : ℤˣ) (n : ℕ) : u ^ n = u ^ (n % 2) := by
  conv =>
      lhs
      rw [← Nat.mod_add_div n 2] <;>
    rw [pow_add, pow_mul, units_sq, one_pow, mul_one]
#align int.units_pow_eq_pow_mod_two Int.units_pow_eq_pow_mod_two

end Int


import ..lectures.love07_metaprogramming_alt_demo

/-! # LoVe Exercise 7: Metaprogramming -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: A Term Exploder

In this question, we develop a string format for the `expr` metatype. By
default, there is no `has_repr` instance to print a nice string. For example: -/

#eval (expr.app (expr.var 0) (expr.var 1) : expr)   -- result: `[external]`
#eval (`(λx : ℕ, x + x) : expr)                     -- result: `[external]`

/-! 1.1. Define a metafunction `expr.repr` that converts an `expr` into a
`string`. It is acceptable to leave out some fields from the `expr`
constructors, such as the level `l` of a sort, the binder information `bi` of
a `λ` or `∀` binder, and the arguments of the `macro` constructor.

Hint: Use `name.to_string` to convert a name to a string, and `repr` for other
types that belong to the `has_repr` type class. -/

meta def expr.repr : expr → string
| (expr.var n)                := "(var " ++ repr n ++ ")"
| (expr.sort l)               := "sort"
| (expr.const n ls)           := "(const " ++ n.to_string ++ ")"
| (expr.mvar n m t)           :=
  "(mvar " ++ name.to_string n ++ " " ++ name.to_string m ++ " " ++
  expr.repr t ++ ")"
| (expr.local_const n m bi t) :=
  "(local_const " ++ name.to_string n ++ " " ++ name.to_string m ++ " " ++
  expr.repr t ++ ")"
| (expr.app e f)              :=
  "(app " ++ expr.repr e ++ " " ++ expr.repr f ++ ")"
| (expr.lam n bi e t)         :=
  "(lam " ++ name.to_string n ++ " " ++ expr.repr e ++ " " ++ expr.repr t ++ ")"
| (expr.pi n bi e t)          :=
  "(pi " ++ name.to_string n ++ " " ++ expr.repr e ++ " " ++ expr.repr t ++ ")"
| (expr.elet n g e f)         :=
  "(elet " ++ name.to_string n ++ " " ++ expr.repr g ++ " " ++ expr.repr e ++
  " " ++ expr.repr f ++ ")"
| (expr.macro d args)         := "macro"

/-! We register `expr.repr` in the `has_repr` type class, so that we can use
`repr` without qualification in the future, and so that it is available to
`#eval`. We need the `meta` keyword in front of the command we enter. -/

meta instance expr.has_repr : has_repr expr :=
{ repr := expr.repr }

/-! 1.2. Test your setup. -/

#eval (expr.app (expr.var 0) (expr.var 1) : expr)
#eval (`(λx : ℕ, x + x) : expr)

/-! ## Question 2: `destruct_and` on Steroids

Recall from the lecture that `destruct_and` fails on easy goals such as -/

lemma abc_ac₂ (a b c : Prop) (h : a ∧ b ∧ c) :
  a ∧ c :=
sorry

/-! We will now address this by developing a new tactic called `destro_and`,
which applies both **des**truction and in**tro**duction rules for conjunction.
It will also go automatically through the hypotheses instead of taking an
argument. We will develop it in three steps.

2.1. Develop a tactic `intro_ands` that replaces all goals of the form
`a ∧ b` with two new goals `a` and `b` systematically, until all top-level
conjunctions are gone.

For this, we can use tactics such as `tactic.repeat` (which repeatedly applies a
tactic on all goals and subgoals until the tactic fails on each of the goal) and
`tactic.applyc` (which can be used to apply a rule, in connection with backtick
quoting). -/

#check tactic.repeat
#check tactic.applyc

meta def intro_ands : tactic unit :=
tactic.repeat (tactic.applyc `and.intro)

lemma abcd_bd (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
begin
  intro_ands,
  /- The proof state should be as follows:

  2 goals
  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ d -/
  repeat { sorry }
end

lemma abcd_bacb (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
begin
  intro_ands,
  /- The proof state should be as follows:

  4 goals
  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ a

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ c

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b -/
  repeat { sorry }
end

/-! 2.2. Develop a tactic `destruct_ands` that replaces hypotheses of the form
`h : a ∧ b` by two new hypotheses `h_left : a` and `h_right : b` systematically,
until all top-level conjunctions are gone.

Here is some pseudocode that you can follow:

1. Retrieve the list of hypotheses from the context. This is provided by the
   metaconstant `tactic.local_context`.

2. Find the first hypothesis (= term) with a type (= proposition) of the form
   `_ ∧ _`. Here, you can use the `list.mfirst` function, in conjunction with
   pattern matching. You can use `tactic.infer_type` to query the type of a
   term.

3. Perform a case split on the first found hypothesis. This can be achieved
   using `tactic.cases`, a metaprogram that corresponds roughly to `cases'`.

4. Repeat.

The above procedure might fail if there exists no hypotheses of the required
form. Make sure to handle this failure gracefully, for example using
`tactic.try` or `<|> pure ()`. -/

meta def destruct_ands : tactic unit :=
tactic.repeat (do
  hs ← tactic.local_context,
  h ← list.mfirst (λh, do `(_ ∧ _) ← tactic.infer_type h, pure h) hs,
  tactic.cases h,
  pure ())

-- Alternative solutions:
meta def destruct_ands₂ : tactic unit :=
tactic.try
  (do
     hs ← tactic.local_context,
     h ← list.mfirst (λh, do `(_ ∧ _) ← tactic.infer_type h, pure h) hs,
     tactic.cases h,
     destruct_ands₂)

meta def destruct_ands₃ : tactic unit :=
(do
   hs ← tactic.local_context,
   h ← list.mfirst (λh, do `(_ ∧ _) ← tactic.infer_type h, pure h) hs,
   tactic.cases h,
   destruct_ands₃)
<|> pure ()

lemma abcd_bd₂ (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
begin
  destruct_ands,
  /- The proof state should be as follows:

  a b c d : Prop,
  h_left : a,
  h_right_right : d,
  h_right_left_left : b,
  h_right_left_right : c
  ⊢ b ∧ d -/
  sorry
end

/-! 2.3. Combine the two tactics developed above and `tactic.assumption` to
implement the desired `destro_and` tactic. -/

meta def destro_and : tactic unit :=
do
  destruct_ands,
  intro_ands,
  tactic.all_goals (tactic.try tactic.assumption),
  pure ()

lemma abcd_bd₃ (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
by destro_and

lemma abcd_bacb₂ (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
by destro_and

lemma abd_bacb (a b c d : Prop) (h : a ∧ b ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
begin
  destro_and,
  /- The proof state should be roughly as follows:

  a b c d : Prop,
  h_left : a,
  h_right_left : b,
  h_right_right : d
  ⊢ c -/
  sorry   -- unprovable
end

/-! 2.4. Provide some more examples for `destro_and` to convince yourself that
it works as expected also on more complicated examples. -/

lemma ab (a b : Prop) (h : a ∨ b) :
  a ∨ b :=
by destro_and

lemma abcdef_1 (a b c d e f : Prop) (h : a ∧ b ∧ c ∧ d ∧ e ∧ f) :
  f ∧ e ∧ f ∧ a ∧ d ∧ b ∧ c ∧ a :=
by destro_and

lemma abcdef_2 (a b c d e f : Prop) (h : a ∧ ((b ∧ ((c ∧ d) ∧ e)) ∧ f)) :
  f ∧ e ∧ f ∧ a ∧ d ∧ b ∧ c ∧ a :=
by destro_and

lemma abcdef_3 (a b c d e f : Prop) (h : a ∧ (b ∧ (c ∧ (d ∧ e ∧ f)))) :
  f ∧ (e ∧ (f ∧ (a ∧ d ∧ b ∧ c ∧ a))) :=
by destro_and

/-! ## Question 3 (**optional**): A Theorem Finder

We will implement a function that allows us to find theorems by constants
appearing in their statements. So given a list of constant names, the function
will list all theorems in which all these constants appear.

You can use the following metaconstants:

* `declaration` contains all data (name, type, value) associated with a
  declaration understood broadly (e.g., axiom, lemma, constant, etc.).

* `tactic.get_env` gives us access to the `environment`, a metatype that lists
  all `declaration`s (including all theorems).

* `environment.fold` allows us to walk through the environment and collect data.

* `expr.fold` allows us to walk through an expression and collect data.

3.1 (**optional**). Write a metafunction that checks whether an expression
contains a specific constant.

You can use `expr.fold` to walk through the expression, `||` and `ff` for
Booleans, and `expr.is_constant_of` to check whether an expression is a
constant. -/

meta def term_contains (e : expr) (nam : name) : bool :=
expr.fold e ff (λe' d c, c || expr.is_constant_of e' nam)

/-! 3.2 (**optional**). Write a metafunction that checks whether an expression
contains **all** constants in a list.

You can use `list.band` (Boolean and). -/

meta def term_contains_all (nams : list name) (e : expr) : bool :=
list.band (list.map (term_contains e) nams)

/-! 3.3 (**optional**). Produce the list of all theorems that contain all
constants `nams` in their statement.

`environment.fold` allows you to walk over the list of declarations. With
`declaration.type`, you get the type of a theorem, and with
`declaration.to_name` you get the name. -/

meta def list_constants (nams : list name) (e : environment) : list name :=
environment.fold e [] (λdecl nams',
  if term_contains_all nams decl.type then decl.to_name :: nams' else nams')

/-! Finally, we develop a tactic that uses the above metafunctions to log all
found theorems: -/

meta def find_constants (nams : list name) : tactic unit :=
do
  env ← tactic.get_env,
  list.mmap' tactic.trace (list_constants nams env)

/-! We test the solution. -/

run_cmd find_constants []   -- lists all theorems
run_cmd find_constants [`list.map, `function.comp]

end LoVe


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Johannes Hölzl
-/
import order.conditionally_complete_lattice
import logic.function.iterate
import order.rel_iso

/-!
# Order continuity

We say that a function is *left order continuous* if it sends all least upper bounds
to least upper bounds. The order dual notion is called *right order continuity*.

For monotone functions `ℝ → ℝ` these notions correspond to the usual left and right continuity.

We prove some basic lemmas (`map_sup`, `map_Sup` etc) and prove that an `rel_iso` is both left
and right order continuous.
-/

universes u v w x

variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}

open function order_dual set

/-!
### Definitions
-/

/-- A function `f` between preorders is left order continuous if it preserves all suprema.  We
define it using `is_lub` instead of `Sup` so that the proof works both for complete lattices and
conditionally complete lattices. -/
def left_ord_continuous [preorder α] [preorder β] (f : α → β) :=
∀ ⦃s : set α⦄ ⦃x⦄, is_lub s x → is_lub (f '' s) (f x)

/-- A function `f` between preorders is right order continuous if it preserves all infima.  We
define it using `is_glb` instead of `Inf` so that the proof works both for complete lattices and
conditionally complete lattices. -/
def right_ord_continuous [preorder α] [preorder β] (f : α → β) :=
∀ ⦃s : set α⦄ ⦃x⦄, is_glb s x → is_glb (f '' s) (f x)

namespace left_ord_continuous

section preorder

variables (α) [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β}

protected lemma id : left_ord_continuous (id : α → α) := λ s x h, by simpa only [image_id] using h

variable {α}

protected lemma order_dual : left_ord_continuous f → right_ord_continuous (to_dual ∘ f ∘ of_dual) :=
id

lemma map_is_greatest (hf : left_ord_continuous f) {s : set α} {x : α} (h : is_greatest s x):
  is_greatest (f '' s) (f x) :=
⟨mem_image_of_mem f h.1, (hf h.is_lub).1⟩

lemma mono (hf : left_ord_continuous f) : monotone f :=
λ a₁ a₂ h,
have is_greatest {a₁, a₂} a₂ := ⟨or.inr rfl, by simp [*]⟩,
(hf.map_is_greatest this).2 $ mem_image_of_mem _ (or.inl rfl)

lemma comp (hg : left_ord_continuous g) (hf : left_ord_continuous f) :
  left_ord_continuous (g ∘ f) :=
λ s x h, by simpa only [image_image] using hg (hf h)

protected lemma iterate {f : α → α} (hf : left_ord_continuous f) (n : ℕ) :
  left_ord_continuous (f^[n]) :=
nat.rec_on n (left_ord_continuous.id α) $ λ n ihn, ihn.comp hf

end preorder

section semilattice_sup

variables [semilattice_sup α] [semilattice_sup β] {f : α → β}

lemma map_sup (hf : left_ord_continuous f) (x y : α) :
  f (x ⊔ y) = f x ⊔ f y :=
(hf is_lub_pair).unique $ by simp only [image_pair, is_lub_pair]

lemma le_iff (hf : left_ord_continuous f) (h : injective f) {x y} :
  f x ≤ f y ↔ x ≤ y :=
by simp only [← sup_eq_right, ← hf.map_sup, h.eq_iff]

lemma lt_iff (hf : left_ord_continuous f) (h : injective f) {x y} :
  f x < f y ↔ x < y :=
by simp only [lt_iff_le_not_le, hf.le_iff h]

variable (f)

/-- Convert an injective left order continuous function to an order embedding. -/
def to_order_embedding (hf : left_ord_continuous f) (h : injective f) :
  α ↪o β :=
⟨⟨f, h⟩, λ x y, hf.le_iff h⟩

variable {f}

@[simp] lemma coe_to_order_embedding (hf : left_ord_continuous f) (h : injective f) :
  ⇑(hf.to_order_embedding f h) = f := rfl

end semilattice_sup

section complete_lattice

variables [complete_lattice α] [complete_lattice β] {f : α → β}

lemma map_Sup' (hf : left_ord_continuous f) (s : set α) :
  f (Sup s) = Sup (f '' s) :=
(hf $ is_lub_Sup s).Sup_eq.symm

lemma map_Sup (hf : left_ord_continuous f) (s : set α) :
  f (Sup s) = ⨆ x ∈ s, f x :=
by rw [hf.map_Sup', Sup_image]

lemma map_supr (hf : left_ord_continuous f) (g : ι → α) :
  f (⨆ i, g i) = ⨆ i, f (g i) :=
by simp only [supr, hf.map_Sup', ← range_comp]

end complete_lattice

section conditionally_complete_lattice

variables [conditionally_complete_lattice α] [conditionally_complete_lattice β] [nonempty ι]
  {f : α → β}

lemma map_cSup (hf : left_ord_continuous f) {s : set α} (sne : s.nonempty) (sbdd : bdd_above s) :
  f (Sup s) = Sup (f '' s) :=
((hf $ is_lub_cSup sne sbdd).cSup_eq $ sne.image f).symm

lemma map_csupr (hf : left_ord_continuous f) {g : ι → α} (hg : bdd_above (range g)) :
  f (⨆ i, g i) = ⨆ i, f (g i) :=
by simp only [supr, hf.map_cSup (range_nonempty _) hg, ← range_comp]

end conditionally_complete_lattice

end left_ord_continuous

namespace right_ord_continuous

section preorder

variables (α) [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β}

protected lemma id : right_ord_continuous (id : α → α) := λ s x h, by simpa only [image_id] using h

variable {α}

protected lemma order_dual : right_ord_continuous f → left_ord_continuous (to_dual ∘ f ∘ of_dual) :=
id

lemma map_is_least (hf : right_ord_continuous f) {s : set α} {x : α} (h : is_least s x):
  is_least (f '' s) (f x) :=
hf.order_dual.map_is_greatest h

lemma mono (hf : right_ord_continuous f) : monotone f :=
hf.order_dual.mono.dual

lemma comp (hg : right_ord_continuous g) (hf : right_ord_continuous f) :
  right_ord_continuous (g ∘ f) :=
hg.order_dual.comp hf.order_dual

protected lemma iterate {f : α → α} (hf : right_ord_continuous f) (n : ℕ) :
  right_ord_continuous (f^[n]) :=
hf.order_dual.iterate n

end preorder

section semilattice_inf

variables [semilattice_inf α] [semilattice_inf β] {f : α → β}

lemma map_inf (hf : right_ord_continuous f) (x y : α) :
  f (x ⊓ y) = f x ⊓ f y :=
hf.order_dual.map_sup x y

lemma le_iff (hf : right_ord_continuous f) (h : injective f) {x y} :
  f x ≤ f y ↔ x ≤ y :=
hf.order_dual.le_iff h

lemma lt_iff (hf : right_ord_continuous f) (h : injective f) {x y} :
  f x < f y ↔ x < y :=
hf.order_dual.lt_iff h

variable (f)

/-- Convert an injective left order continuous function to a `order_embedding`. -/
def to_order_embedding (hf : right_ord_continuous f) (h : injective f) : α ↪o β :=
⟨⟨f, h⟩, λ x y, hf.le_iff h⟩

variable {f}

@[simp] lemma coe_to_order_embedding (hf : right_ord_continuous f) (h : injective f) :
  ⇑(hf.to_order_embedding f h) = f := rfl

end semilattice_inf

section complete_lattice

variables [complete_lattice α] [complete_lattice β] {f : α → β}

lemma map_Inf' (hf : right_ord_continuous f) (s : set α) :
  f (Inf s) = Inf (f '' s) :=
hf.order_dual.map_Sup' s

lemma map_Inf (hf : right_ord_continuous f) (s : set α) :
  f (Inf s) = ⨅ x ∈ s, f x :=
hf.order_dual.map_Sup s

lemma map_infi (hf : right_ord_continuous f) (g : ι → α) :
  f (⨅ i, g i) = ⨅ i, f (g i) :=
hf.order_dual.map_supr g

end complete_lattice

section conditionally_complete_lattice

variables [conditionally_complete_lattice α] [conditionally_complete_lattice β] [nonempty ι]
  {f : α → β}

lemma map_cInf (hf : right_ord_continuous f) {s : set α} (sne : s.nonempty) (sbdd : bdd_below s) :
  f (Inf s) = Inf (f '' s) :=
hf.order_dual.map_cSup sne sbdd

lemma map_cinfi (hf : right_ord_continuous f) {g : ι → α} (hg : bdd_below (range g)) :
  f (⨅ i, g i) = ⨅ i, f (g i) :=
hf.order_dual.map_csupr hg

end conditionally_complete_lattice

end right_ord_continuous

namespace order_iso

section preorder

variables [preorder α] [preorder β] (e : α ≃o β)
  {s : set α} {x : α}

protected lemma left_ord_continuous : left_ord_continuous e :=
λ s x hx,
⟨monotone.mem_upper_bounds_image (λ x y, e.map_rel_iff.2) hx.1,
  λ y hy, e.rel_symm_apply.1 $ (is_lub_le_iff hx).2 $ λ x' hx', e.rel_symm_apply.2 $ hy $
    mem_image_of_mem _ hx'⟩

protected lemma right_ord_continuous : right_ord_continuous e :=
order_iso.left_ord_continuous e.dual

end preorder

end order_iso