/-
Copyright (c) 2020 Aaron Anderson, Jalex Stark. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark
-/

import algebra.polynomial.big_operators
import data.matrix.char_p
import field_theory.finite.basic
import group_theory.perm.cycles
import linear_algebra.matrix.charpoly.basic
import linear_algebra.matrix.trace
import linear_algebra.matrix.to_lin
import ring_theory.polynomial.basic
import ring_theory.power_basis

/-!
# Characteristic polynomials

We give methods for computing coefficients of the characteristic polynomial.

## Main definitions

- `matrix.charpoly_degree_eq_dim` proves that the degree of the characteristic polynomial
  over a nonzero ring is the dimension of the matrix
- `matrix.det_eq_sign_charpoly_coeff` proves that the determinant is the constant term of the
  characteristic polynomial, up to sign.
- `matrix.trace_eq_neg_charpoly_coeff` proves that the trace is the negative of the (d-1)th
  coefficient of the characteristic polynomial, where d is the dimension of the matrix.
  For a nonzero ring, this is the second-highest coefficient.

-/

noncomputable theory

universes u v w z

open polynomial matrix
open_locale big_operators polynomial

variables {R : Type u} [comm_ring R]
variables {n G : Type v} [decidable_eq n] [fintype n]
variables {α β : Type v} [decidable_eq α]

open finset

variable {M : matrix n n R}

lemma charmatrix_apply_nat_degree [nontrivial R] (i j : n) :
  (charmatrix M i j).nat_degree = ite (i = j) 1 0 :=
by { by_cases i = j; simp [h, ← degree_eq_iff_nat_degree_eq_of_pos (nat.succ_pos 0)], }

lemma charmatrix_apply_nat_degree_le (i j : n) :
  (charmatrix M i j).nat_degree ≤ ite (i = j) 1 0 :=
by split_ifs; simp [h, nat_degree_X_sub_C_le]

namespace matrix

variable (M)
lemma charpoly_sub_diagonal_degree_lt :
(M.charpoly - ∏ (i : n), (X - C (M i i))).degree < ↑(fintype.card n - 1) :=
begin
  rw [charpoly, det_apply', ← insert_erase (mem_univ (equiv.refl n)),
    sum_insert (not_mem_erase (equiv.refl n) univ), add_comm],
  simp only [charmatrix_apply_eq, one_mul, equiv.perm.sign_refl, id.def, int.cast_one,
    units.coe_one, add_sub_cancel, equiv.coe_refl],
  rw ← mem_degree_lt, apply submodule.sum_mem (degree_lt R (fintype.card n - 1)),
  intros c hc, rw [← C_eq_int_cast, C_mul'],
  apply submodule.smul_mem (degree_lt R (fintype.card n - 1)) ↑↑(equiv.perm.sign c),
  rw mem_degree_lt, apply lt_of_le_of_lt degree_le_nat_degree _, rw with_bot.coe_lt_coe,
  apply lt_of_le_of_lt _ (equiv.perm.fixed_point_card_lt_of_ne_one (ne_of_mem_erase hc)),
  apply le_trans (polynomial.nat_degree_prod_le univ (λ i : n, (charmatrix M (c i) i))) _,
  rw card_eq_sum_ones, rw sum_filter, apply sum_le_sum,
  intros, apply charmatrix_apply_nat_degree_le,
end

lemma charpoly_coeff_eq_prod_coeff_of_le {k : ℕ} (h : fintype.card n - 1 ≤ k) :
  M.charpoly.coeff k = (∏ i : n, (X - C (M i i))).coeff k :=
begin
  apply eq_of_sub_eq_zero, rw ← coeff_sub, apply polynomial.coeff_eq_zero_of_degree_lt,
  apply lt_of_lt_of_le (charpoly_sub_diagonal_degree_lt M) _, rw with_bot.coe_le_coe, apply h,
end

lemma det_of_card_zero (h : fintype.card n = 0) (M : matrix n n R) : M.det = 1 :=
by { rw fintype.card_eq_zero_iff at h, suffices : M = 1, { simp [this] }, ext i, exact h.elim i }

theorem charpoly_degree_eq_dim [nontrivial R] (M : matrix n n R) :
M.charpoly.degree = fintype.card n :=
begin
  by_cases fintype.card n = 0,
  { rw h, unfold charpoly, rw det_of_card_zero, {simp}, {assumption} },
  rw ← sub_add_cancel M.charpoly (∏ (i : n), (X - C (M i i))),
  have h1 : (∏ (i : n), (X - C (M i i))).degree = fintype.card n,
  { rw degree_eq_iff_nat_degree_eq_of_pos, swap, apply nat.pos_of_ne_zero h,
    rw nat_degree_prod', simp_rw nat_degree_X_sub_C, unfold fintype.card, simp,
    simp_rw (monic_X_sub_C _).leading_coeff, simp, },
  rw degree_add_eq_right_of_degree_lt, exact h1, rw h1,
  apply lt_trans (charpoly_sub_diagonal_degree_lt M), rw with_bot.coe_lt_coe,
  rw ← nat.pred_eq_sub_one, apply nat.pred_lt, apply h,
end

theorem charpoly_nat_degree_eq_dim [nontrivial R] (M : matrix n n R) :
  M.charpoly.nat_degree = fintype.card n :=
nat_degree_eq_of_degree_eq_some (charpoly_degree_eq_dim M)

lemma charpoly_monic (M : matrix n n R) : M.charpoly.monic :=
begin
  nontriviality,
  by_cases fintype.card n = 0, {rw [charpoly, det_of_card_zero h], apply monic_one},
  have mon : (∏ (i : n), (X - C (M i i))).monic,
  { apply monic_prod_of_monic univ (λ i : n, (X - C (M i i))), simp [monic_X_sub_C], },
  rw ← sub_add_cancel (∏ (i : n), (X - C (M i i))) M.charpoly at mon,
  rw monic at *, rw leading_coeff_add_of_degree_lt at mon, rw ← mon,
  rw charpoly_degree_eq_dim, rw ← neg_sub, rw degree_neg,
  apply lt_trans (charpoly_sub_diagonal_degree_lt M), rw with_bot.coe_lt_coe,
  rw ← nat.pred_eq_sub_one, apply nat.pred_lt, apply h,
end

theorem trace_eq_neg_charpoly_coeff [nonempty n] (M : matrix n n R) :
  (trace n R R) M = -M.charpoly.coeff (fintype.card n - 1) :=
begin
  nontriviality,
  rw charpoly_coeff_eq_prod_coeff_of_le, swap, refl,
  rw [fintype.card, prod_X_sub_C_coeff_card_pred univ (λ i : n, M i i)], simp,
  rw [← fintype.card, fintype.card_pos_iff], apply_instance,
end

-- I feel like this should use polynomial.alg_hom_eval₂_algebra_map
lemma mat_poly_equiv_eval (M : matrix n n R[X]) (r : R) (i j : n) :
  (mat_poly_equiv M).eval ((scalar n) r) i j = (M i j).eval r :=
begin
  unfold polynomial.eval, unfold eval₂,
  transitivity polynomial.sum (mat_poly_equiv M) (λ (e : ℕ) (a : matrix n n R),
    (a * (scalar n) r ^ e) i j),
  { unfold polynomial.sum, rw sum_apply, dsimp, refl },
  { simp_rw [←ring_hom.map_pow, ←(scalar.commute _ _).eq],
    simp only [coe_scalar, matrix.one_mul, ring_hom.id_apply,
      pi.smul_apply, smul_eq_mul, mul_eq_mul, algebra.smul_mul_assoc],
    have h : ∀ x : ℕ, (λ (e : ℕ) (a : R), r ^ e * a) x 0 = 0 := by simp,
    simp only [polynomial.sum, mat_poly_equiv_coeff_apply, mul_comm],
    apply (finset.sum_subset (support_subset_support_mat_poly_equiv _ _ _) _).symm,
    assume n hn h'n,
    rw not_mem_support_iff at h'n,
    simp only [h'n, zero_mul] }
end

lemma eval_det (M : matrix n n R[X]) (r : R) :
  polynomial.eval r M.det = (polynomial.eval (scalar n r) (mat_poly_equiv M)).det :=
begin
  rw [polynomial.eval, ← coe_eval₂_ring_hom, ring_hom.map_det],
  apply congr_arg det, ext, symmetry, convert mat_poly_equiv_eval _ _ _ _,
end

theorem det_eq_sign_charpoly_coeff (M : matrix n n R) :
  M.det = (-1)^(fintype.card n) * M.charpoly.coeff 0:=
begin
  rw [coeff_zero_eq_eval_zero, charpoly, eval_det, mat_poly_equiv_charmatrix, ← det_smul],
  simp
end

end matrix

variables {p : ℕ} [fact p.prime]

lemma mat_poly_equiv_eq_X_pow_sub_C {K : Type*} (k : ℕ) [field K] (M : matrix n n K) :
  mat_poly_equiv
      ((expand K (k) : K[X] →+* K[X]).map_matrix (charmatrix (M ^ k))) =
    X ^ k - C (M ^ k) :=
begin
  ext m,
  rw [coeff_sub, coeff_C, mat_poly_equiv_coeff_apply, ring_hom.map_matrix_apply, matrix.map_apply,
    alg_hom.coe_to_ring_hom, dmatrix.sub_apply, coeff_X_pow],
  by_cases hij : i = j,
  { rw [hij, charmatrix_apply_eq, alg_hom.map_sub, expand_C, expand_X, coeff_sub, coeff_X_pow,
     coeff_C],
    split_ifs with mp m0;
    simp only [matrix.one_apply_eq, dmatrix.zero_apply] },
  { rw [charmatrix_apply_ne _ _ _ hij, alg_hom.map_neg, expand_C, coeff_neg, coeff_C],
    split_ifs with m0 mp;
    simp only [hij, zero_sub, dmatrix.zero_apply, sub_zero, neg_zero, matrix.one_apply_ne, ne.def,
      not_false_iff] }
end

@[simp] lemma finite_field.matrix.charpoly_pow_card {K : Type*} [field K] [fintype K]
  (M : matrix n n K) : (M ^ (fintype.card K)).charpoly = M.charpoly :=
begin
  casesI (is_empty_or_nonempty n).symm,
  { cases char_p.exists K with p hp, letI := hp,
    rcases finite_field.card K p with ⟨⟨k, kpos⟩, ⟨hp, hk⟩⟩,
    haveI : fact p.prime := ⟨hp⟩,
    dsimp at hk, rw hk at *,
    apply (frobenius_inj K[X] p).iterate k,
    repeat { rw iterate_frobenius, rw ← hk },
    rw ← finite_field.expand_card,
    unfold charpoly, rw [alg_hom.map_det, ← coe_det_monoid_hom,
      ← (det_monoid_hom : matrix n n K[X] →* K[X]).map_pow],
    apply congr_arg det,
    refine mat_poly_equiv.injective _,
    rw [alg_equiv.map_pow, mat_poly_equiv_charmatrix, hk, sub_pow_char_pow_of_commute, ← C_pow],
    { exact (id (mat_poly_equiv_eq_X_pow_sub_C (p ^ k) M) : _) },
    { exact (C M).commute_X } },
  { -- TODO[gh-6025]: remove this `haveI` once `subsingleton_of_empty_right` is a global instance
    haveI : subsingleton (matrix n n K) := subsingleton_of_empty_right,
    exact congr_arg _ (subsingleton.elim _ _), },
end

@[simp] lemma zmod.charpoly_pow_card (M : matrix n n (zmod p)) :
  (M ^ p).charpoly = M.charpoly :=
by { have h := finite_field.matrix.charpoly_pow_card M, rwa zmod.card at h, }

lemma finite_field.trace_pow_card {K : Type*} [field K] [fintype K] [nonempty n]
  (M : matrix n n K) : trace n K K (M ^ (fintype.card K)) = (trace n K K M) ^ (fintype.card K) :=
by rw [matrix.trace_eq_neg_charpoly_coeff, matrix.trace_eq_neg_charpoly_coeff,
       finite_field.matrix.charpoly_pow_card, finite_field.pow_card]

lemma zmod.trace_pow_card {p:ℕ} [fact p.prime] [nonempty n] (M : matrix n n (zmod p)) :
  trace n (zmod p) (zmod p) (M ^ p) = (trace n (zmod p) (zmod p) M)^p :=
by { have h := finite_field.trace_pow_card M, rwa zmod.card at h, }

namespace matrix

theorem is_integral : is_integral R M := ⟨M.charpoly, ⟨charpoly_monic M, aeval_self_charpoly M⟩⟩

theorem minpoly_dvd_charpoly {K : Type*} [field K] (M : matrix n n K) :
  (minpoly K M) ∣ M.charpoly :=
minpoly.dvd _ _ (aeval_self_charpoly M)

/-- Any matrix polynomial `p` is equivalent under evaluation to `p %ₘ M.charpoly`; that is, `p`
is equivalent to a polynomial with degree less than the dimension of the matrix. -/
lemma aeval_eq_aeval_mod_charpoly (M : matrix n n R) (p : R[X]) :
  aeval M p = aeval M (p %ₘ M.charpoly) :=
(aeval_mod_by_monic_eq_self_of_root M.charpoly_monic M.aeval_self_charpoly).symm

/-- Any matrix power can be computed as the sum of matrix powers less than `fintype.card n`.

TODO: add the statement for negative powers phrased with `zpow`. -/
lemma pow_eq_aeval_mod_charpoly (M : matrix n n R) (k : ℕ) : M^k = aeval M (X^k %ₘ M.charpoly) :=
by rw [←aeval_eq_aeval_mod_charpoly, map_pow, aeval_X]

end matrix

section power_basis

open algebra

/-- The characteristic polynomial of the map `λ x, a * x` is the minimal polynomial of `a`.

In combination with `det_eq_sign_charpoly_coeff` or `trace_eq_neg_charpoly_coeff`
and a bit of rewriting, this will allow us to conclude the
field norm resp. trace of `x` is the product resp. sum of `x`'s conjugates.
-/
lemma charpoly_left_mul_matrix {K S : Type*} [field K] [comm_ring S] [algebra K S]
  (h : power_basis K S) :
  (left_mul_matrix h.basis h.gen).charpoly = minpoly K h.gen :=
begin
  apply minpoly.unique,
  { apply matrix.charpoly_monic },
  { apply (left_mul_matrix _).injective_iff.mp (left_mul_matrix_injective h.basis),
    rw [← polynomial.aeval_alg_hom_apply, aeval_self_charpoly] },
  { intros q q_monic root_q,
    rw [matrix.charpoly_degree_eq_dim, fintype.card_fin, degree_eq_nat_degree q_monic.ne_zero],
    apply with_bot.some_le_some.mpr,
    exact h.dim_le_nat_degree_of_root q_monic.ne_zero root_q }
end

end power_basis


universe u

def concat {α} : List α → α → List α
  | [],    a => [a]
  | x::xs, a => x :: concat xs a

def last {α} : (xs : List α) → xs ≠ [] → α
  | [],       h => by contradiction
  | [a],      h => a
  | _::a::as, h => last (a::as) (fun h => by injection h)

def dropLast {α} : List α → List α
  | []    => []
  | [a]   => []
  | a::as => a :: dropLast as

variable {α}

theorem concatEq (xs : List α) (h : xs ≠ []) : concat (dropLast xs) (last xs h) = xs := by
  match xs, h with
  | [],  h        => contradiction
  | [x], h        => rfl
  | x₁::x₂::xs, h => simp [concat, last, concatEq (x₂::xs) List.noConfusion]

theorem lengthCons {α} (x : α) (xs : List α) : (x::xs).length = xs.length + 1 :=
  rfl

theorem eqNilOfLengthZero {α} : (xs : List α) → xs.length = 0 → xs = []
  | [],    h => rfl
  | x::xs, h => by rw [lengthCons] at h; contradiction

theorem dropLastLen {α} (xs : List α) : (n : Nat) → xs.length = n+1 → (dropLast xs).length = n := by
  match xs with
  | []    => intros; contradiction
  | [a]   =>
    intro n h
    have : 1 = n + 1 := h
    have : 0 = n := by injection this
    subst this
    rfl
  | x₁::x₂::xs =>
    intro n h
    cases n with
    | zero   =>
      simp [lengthCons] at h
      injection h
    | succ n =>
      have : (x₁ :: x₂ :: xs).length = xs.length + 2 := by simp [lengthCons]
      have : xs.length = n := by rw [this] at h; injection h with h; injection h
      simp [dropLast, lengthCons, dropLastLen (x₂::xs) xs.length (lengthCons ..), this]

@[inline]
def concatElim {α}
    (motive : List α → Sort u)
    (base   : Unit → motive [])
    (ind    : (xs : List α) → (a : α) → motive xs → motive (concat xs a))
    (xs : List α)
    : motive xs :=
  let rec @[specialize] aux : (n : Nat) → (xs : List α) → xs.length = n → motive xs
    | 0, xs, h   => by
      have aux := eqNilOfLengthZero _ h
      subst aux
      apply base ()
    | n+1, xs, h => by
      have notNil : xs ≠ [] := by intro h1; subst h1; injection h
      let ih  := aux n (dropLast xs) (dropLastLen _ _ h)
      let aux := ind (dropLast xs) (last xs notNil) ih
      rw [concatEq] at aux
      exact aux
  aux xs.length xs rfl

-- The generated code is tail recursive
def test (xs : List Nat) : IO Unit :=
  concatElim (motive := fun _ => IO Unit)
    (fun _ => pure ())
    (fun xs x r => do IO.println s!"step xs: {xs} x: {x}"; r)
    xs

#eval test [1, 2, 3, 4]


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.real.ennreal
import Mathlib.order.filter.countable_Inter
import Mathlib.order.liminf_limsup
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Order properties of extended non-negative reals

This file compiles filter-related results about `ennreal` (see data/real/ennreal.lean).
-/

namespace ennreal

theorem eventually_le_limsup {α : Type u_1} {f : filter α} [countable_Inter_filter f]
    (u : α → ennreal) : filter.eventually (fun (y : α) => u y ≤ filter.limsup f u) f :=
  sorry

theorem limsup_eq_zero_iff {α : Type u_1} {f : filter α} [countable_Inter_filter f]
    {u : α → ennreal} : filter.limsup f u = 0 ↔ filter.eventually_eq f u 0 :=
  sorry

theorem limsup_const_mul_of_ne_top {α : Type u_1} {f : filter α} {u : α → ennreal} {a : ennreal}
    (ha_top : a ≠ ⊤) : (filter.limsup f fun (x : α) => a * u x) = a * filter.limsup f u :=
  sorry

theorem limsup_const_mul {α : Type u_1} {f : filter α} [countable_Inter_filter f] {u : α → ennreal}
    {a : ennreal} : (filter.limsup f fun (x : α) => a * u x) = a * filter.limsup f u :=
  sorry

theorem limsup_add_le {α : Type u_1} {f : filter α} [countable_Inter_filter f] (u : α → ennreal)
    (v : α → ennreal) : filter.limsup f (u + v) ≤ filter.limsup f u + filter.limsup f v :=
  sorry

end Mathlib


/-
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 data.nat.parity
import algebra.group.conj_finite
import tactic.fin_cases

/-!
# Integers mod `n`

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

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`

-/

open function

namespace zmod

instance : char_zero (zmod 0) := (by apply_instance : char_zero ℤ)

/-- `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 : ℕ} [ne_zero n] (a : zmod n) : a.val < n :=
begin
  casesI n,
  { cases ne_zero.ne 0 rfl },
  exact fin.is_lt a
end

lemma val_le {n : ℕ} [ne_zero 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],
    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 [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 add_order_of_one (n : ℕ) : add_order_of (1 : zmod n) = n :=
char_p.eq _ (char_p.add_order_of_one _) (zmod.char_p n)

/--  This lemma works in the case in which `zmod n` is not infinite, i.e. `n ≠ 0`.  The version
where `a ≠ 0` is `add_order_of_coe'`. -/
@[simp] lemma add_order_of_coe (a : ℕ) {n : ℕ} (n0 : n ≠ 0) :
  add_order_of (a : zmod n) = n / n.gcd a :=
begin
  cases a,
  simp [nat.pos_of_ne_zero n0],
  rw [← nat.smul_one_eq_coe, add_order_of_nsmul' _ a.succ_ne_zero, zmod.add_order_of_one],
end

/--  This lemma works in the case in which `a ≠ 0`.  The version where
 `zmod n` is not infinite, i.e. `n ≠ 0`, is `add_order_of_coe`. -/
@[simp] lemma add_order_of_coe' {a : ℕ} (n : ℕ) (a0 : a ≠ 0) :
  add_order_of (a : zmod n) = n / n.gcd a :=
by rw [← nat.smul_one_eq_coe, add_order_of_nsmul' _ a0, zmod.add_order_of_one]

/-- We have that `ring_char (zmod n) = n`. -/
lemma ring_char_zmod_n (n : ℕ) : ring_char (zmod n) = n :=
by { rw ring_char.eq_iff, exact zmod.char_p n, }

@[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 [add_group_with_one 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; simp

lemma cast_eq_val [ne_zero n] (a : zmod n) : (a : R) = a.val :=
begin
  casesI n,
  { cases ne_zero.ne 0 rfl },
  refl,
end

variables {S : Type*} [add_group_with_one 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 : ℕ} [ne_zero n] (a : zmod n) : (a.val : zmod n) = a :=
begin
  casesI n,
  { cases ne_zero.ne 0 rfl },
  { apply fin.coe_coe_eq_self }
end

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

lemma nat_cast_zmod_surjective [ne_zero 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`. -/
@[norm_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.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 [ne_zero n] :
  (coe : ℕ → R) ∘ (val : zmod n → ℕ) = coe :=
begin
  casesI n,
  { cases ne_zero.ne 0 rfl },
  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 [ne_zero 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.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 :=
map_nat_cast (cast_hom h R) k

@[simp, norm_cast]
lemma cast_int_cast (h : m ∣ n) (k : ℤ) : ((k : zmod n) : R) = k := map_int_cast (cast_hom h R) 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 injective_iff_map_eq_zero,
  intro x,
  obtain ⟨k, rfl⟩ := zmod.int_cast_surjective x,
  rw [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 : ne_zero n :=
  ⟨begin
    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)

/-- The identity between `zmod m` and `zmod n` when `m = n`, as a ring isomorphism. -/
def ring_equiv_congr {m n : ℕ} (h : m = n) : zmod m ≃+* zmod n :=
begin
  cases m; cases n,
  { exact ring_equiv.refl _ },
  { exfalso, exact n.succ_ne_zero h.symm },
  { exfalso, exact m.succ_ne_zero h },
  { exact
    { map_mul' := λ a b, begin
        rw [order_iso.to_fun_eq_coe], ext,
        rw [fin.coe_cast, fin.coe_mul, fin.coe_mul, fin.coe_cast, fin.coe_cast, ← h] end,
      map_add' := λ a b, begin
        rw [order_iso.to_fun_eq_coe], ext,
        rw [fin.coe_cast, fin.coe_add, fin.coe_add, fin.coe_cast, fin.coe_cast, ← h] end,
      ..fin.cast h } }
end

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] :=
by simpa [int.coe_nat_modeq_iff] using 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 % 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 :=
by rw [← int.cast_zero, zmod.int_coe_eq_int_coe_iff, int.modeq_zero_iff_dvd]

lemma int_coe_eq_int_coe_iff_dvd_sub (a b : ℤ) (c : ℕ) : (a : zmod c) = ↑b ↔ ↑c ∣ b-a :=
begin
  rw [zmod.int_coe_eq_int_coe_iff, int.modeq_iff_dvd],
end

lemma nat_coe_zmod_eq_zero_iff_dvd (a b : ℕ) : (a : zmod b) = 0 ↔ b ∣ a :=
by rw [← nat.cast_zero, zmod.nat_coe_eq_nat_coe_iff, nat.modeq_zero_iff_dvd]

lemma val_int_cast {n : ℕ} (a : ℤ) [ne_zero n] : ↑(a : zmod n).val = a % n :=
begin
  have hle : (0 : ℤ) ≤ ↑(a : zmod n).val := int.coe_nat_nonneg _,
  have hlt : ↑(a : zmod n).val < (n : ℤ) := int.coe_nat_lt.mpr (zmod.val_lt a),
  refine (int.mod_eq_of_lt hle hlt).symm.trans _,
  rw [←zmod.int_coe_eq_int_coe_iff', int.cast_coe_nat, zmod.nat_cast_val, zmod.cast_id],
end

lemma coe_int_cast {n : ℕ} (a : ℤ) : ↑(a : zmod n) = a % n :=
begin
  cases n,
  { rw [int.coe_nat_zero, int.mod_zero, int.cast_id, int.cast_id] },
  { rw [←val_int_cast, val, coe_coe] },
end

@[simp] lemma val_neg_one (n : ℕ) : (-1 : zmod n.succ).val = n :=
begin
  rw [val, fin.coe_neg],
  cases n,
  { rw [nat.mod_one] },
  { rw [fin.coe_one, nat.succ_add_sub_one, nat.mod_eq_of_lt (nat.lt.base _)] },
end

/-- `-1 : zmod n` lifts to `n - 1 : R`. This avoids the characteristic assumption in `cast_neg`. -/
lemma cast_neg_one {R : Type*} [ring R] (n : ℕ) : ↑(-1 : zmod n) = (n - 1 : R) :=
begin
  cases n,
  { rw [int.cast_neg, int.cast_one, nat.cast_zero, zero_sub] },
  { rw [←nat_cast_val, val_neg_one, nat.cast_succ, add_sub_cancel] },
end

lemma cast_sub_one {R : Type*} [ring R] {n : ℕ} (k : zmod n) :
  ((k - 1 : zmod n) : R) = (if k = 0 then n else k) - 1 :=
begin
  split_ifs with hk,
  { rw [hk, zero_sub, zmod.cast_neg_one] },
  { cases n,
    { rw [int.cast_sub, int.cast_one] },
    { rw [←zmod.nat_cast_val, zmod.val, fin.coe_sub_one, if_neg],
      { rw [nat.cast_sub, nat.cast_one, coe_coe],
        rwa [fin.ext_iff, fin.coe_zero, ←ne, ←nat.one_le_iff_ne_zero] at hk },
      { exact hk } } },
end

lemma nat_coe_zmod_eq_iff (p : ℕ) (n : ℕ) (z : zmod p) [ne_zero p] :
  ↑n = z ↔ ∃ k, n = z.val + p * k :=
begin
  split,
  { rintro rfl,
    refine ⟨n / p, _⟩,
    rw [val_nat_cast, nat.mod_add_div] },
  { rintro ⟨k, rfl⟩,
    rw [nat.cast_add, nat_cast_zmod_val, nat.cast_mul, nat_cast_self, zero_mul, add_zero] }
end

lemma int_coe_zmod_eq_iff (p : ℕ) (n : ℤ) (z : zmod p) [ne_zero p] :
  ↑n = z ↔ ∃ k, n = z.val + p * k :=
begin
  split,
  { rintro rfl,
    refine ⟨n / p, _⟩,
    rw [val_int_cast, int.mod_add_div] },
  { rintro ⟨k, rfl⟩,
    rw [int.cast_add, int.cast_mul, int.cast_coe_nat, int.cast_coe_nat, nat_cast_val,
      zmod.nat_cast_self, zero_mul, add_zero, cast_id] }
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 : ℕ) [ne_zero n] :
  function.injective (zmod.val : zmod n → ℕ) :=
begin
  casesI n,
  { cases ne_zero.ne 0 rfl },
  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 : ℕ} [ne_zero n] (a b : zmod n) : (a + b).val = (a.val + b.val) % n :=
begin
  casesI n,
  { cases ne_zero.ne 0 rfl },
  { 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 ⟩⟩

instance nontrivial' : nontrivial (zmod 0) := int.nontrivial

/-- 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
             ... = 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 (a : ℕ) (n : ℕ) : ((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], },
  { 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 `(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) : (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 : (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 : (zmod n)ˣ) :
  (u : zmod n)⁻¹ = (u⁻¹ : (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' : (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]

-- TODO: this equivalence is true for `zmod 0 = ℤ`, but needs to use different functions.
/-- 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 : ℕ} [ne_zero n] : (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,
        eq_int_cast, prod.ext_iff]
    end
    else
      begin
        haveI : ne_zero (m * n) := ⟨hmn0⟩,
        haveI : ne_zero m := ⟨left_ne_zero_of_mul hmn0⟩,
        haveI : ne_zero n := ⟨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, left_inv.right_inverse_of_card_le (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 }

-- todo: this can be made a `unique` instance.
instance subsingleton_units : subsingleton ((zmod 2)ˣ) :=
⟨dec_trivial⟩

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 : ne_zero n := ⟨by
  { 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 $ ne_zero.pos n).2 dec_trivial),
  have hn2' : (n : ℕ) - n / 2 = n / 2 + 1,
  { conv {to_lhs, congr, rw [← nat.succ_sub_one n, nat.succ_sub $ ne_zero.pos n]},
    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

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 neg_eq_self_iff {n : ℕ} (a : zmod n) : -a = a ↔ a = 0 ∨ 2 * a.val = n :=
begin
  rw [neg_eq_iff_add_eq_zero, ← two_mul],
  cases n,
  { rw [@mul_eq_zero ℤ, @mul_eq_zero ℕ, val_eq_zero],
    exact ⟨λ h, h.elim dec_trivial or.inl, λ h, or.inr (h.elim id $ λ h, h.elim dec_trivial id)⟩ },
  conv_lhs
  { rw [← a.nat_cast_zmod_val, ← nat.cast_two, ← nat.cast_mul, nat_coe_zmod_eq_zero_iff_dvd] },
  split,
  { rintro ⟨m, he⟩, cases m,
    { rw [mul_zero, mul_eq_zero] at he,
      rcases he with ⟨⟨⟩⟩|he,
      exact or.inl (a.val_eq_zero.1 he) },
    cases m, { right, rwa mul_one at he },
    refine (a.val_lt.not_le $ nat.le_of_mul_le_mul_left _ zero_lt_two).elim,
    rw [he, mul_comm], apply nat.mul_le_mul_left, dec_trivial },
  { rintro (rfl|h), { rw [val_zero, mul_zero], apply dvd_zero }, { rw h } },
end

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 : ℕ} [ne_zero 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 : ℕ} [ne_zero 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 (ne_zero.pos n),
  contrapose! h,
  rwa [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 : ℕ} [ne_zero n] (x : zmod n) :
  val_min_abs x = if x.val ≤ n / 2 then x.val else x.val - n :=
begin
  casesI n,
  { cases ne_zero.ne 0 rfl },
  { refl }
end

@[simp, norm_cast] 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 injective_val_min_abs {n : ℕ} : (val_min_abs : zmod n → ℤ).injective :=
function.injective_iff_has_left_inverse.2 ⟨_, coe_val_min_abs⟩

lemma _root_.nat.le_div_two_iff_mul_two_le {n m : ℕ} : m ≤ n / 2 ↔ (m : ℤ) * 2 ≤ n :=
by rw [nat.le_div_iff_mul_le zero_lt_two, ← int.coe_nat_le, int.coe_nat_mul, nat.cast_two]

lemma val_min_abs_nonneg_iff {n : ℕ} [ne_zero n] (x : zmod n) :
  0 ≤ x.val_min_abs ↔ x.val ≤ n / 2 :=
begin
  rw [val_min_abs_def_pos], split_ifs,
  { exact iff_of_true (nat.cast_nonneg _) h },
  { exact iff_of_false (sub_lt_zero.2 $ int.coe_nat_lt.2 x.val_lt).not_le h },
end

lemma val_min_abs_mul_two_eq_iff {n : ℕ} (a : zmod n) : a.val_min_abs * 2 = n ↔ 2 * a.val = n :=
begin
  cases n, { simp },
  by_cases a.val ≤ n.succ / 2,
  { rw [val_min_abs, if_pos h, ← int.coe_nat_inj', nat.cast_mul, nat.cast_two, mul_comm] },
  apply iff_of_false (λ he, _) (mt _ h),
  { rw [← a.val_min_abs_nonneg_iff, ← mul_nonneg_iff_left_nonneg_of_pos, he] at h,
    exacts [h (nat.cast_nonneg _), zero_lt_two] },
  { rw [mul_comm], exact λ h, (nat.le_div_iff_mul_le zero_lt_two).2 h.le },
end

lemma val_min_abs_mem_Ioc {n : ℕ} [ne_zero n] (x : zmod n) :
  x.val_min_abs * 2 ∈ set.Ioc (-n : ℤ) n :=
begin
  simp_rw [val_min_abs_def_pos, nat.le_div_two_iff_mul_two_le], split_ifs,
  { refine ⟨(neg_lt_zero.2 $ by exact_mod_cast ne_zero.pos n).trans_le (mul_nonneg _ _), h⟩,
    exacts [nat.cast_nonneg _, zero_le_two] },
  { refine ⟨_, trans (mul_nonpos_of_nonpos_of_nonneg _ zero_le_two) $ nat.cast_nonneg _⟩,
    { linarith only [h] },
    { rw [sub_nonpos, int.coe_nat_le], exact x.val_lt.le } },
end

lemma val_min_abs_spec {n : ℕ} [ne_zero n] (x : zmod n) (y : ℤ) :
  x.val_min_abs = y ↔ x = y ∧ y * 2 ∈ set.Ioc (-n : ℤ) n :=
⟨by { rintro rfl, exact ⟨x.coe_val_min_abs.symm, x.val_min_abs_mem_Ioc⟩ }, λ h, begin
  rw ← sub_eq_zero,
  apply @int.eq_zero_of_abs_lt_dvd n,
  { rw [← int_coe_zmod_eq_zero_iff_dvd, int.cast_sub, coe_val_min_abs, h.1, sub_self] },
  rw [← mul_lt_mul_right (@zero_lt_two ℤ _ _ _ _ _)],
  nth_rewrite 0 ← abs_eq_self.2 (@zero_le_two ℤ _ _ _ _),
  rw [← abs_mul, sub_mul, abs_lt], split;
  linarith only [x.val_min_abs_mem_Ioc.1, x.val_min_abs_mem_Ioc.2, h.2.1, h.2.2],
end⟩

lemma nat_abs_val_min_abs_le {n : ℕ} [ne_zero n] (x : zmod n) : x.val_min_abs.nat_abs ≤ n / 2 :=
begin
  rw [nat.le_div_two_iff_mul_two_le],
  cases x.val_min_abs.nat_abs_eq,
  { rw ← h, exact x.val_min_abs_mem_Ioc.2 },
  { rw [← neg_le_neg_iff, ← neg_mul, ← h], exact x.val_min_abs_mem_Ioc.1.le },
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 },
  rw ← val_min_abs_zero n.succ,
  apply injective_val_min_abs.eq_iff,
end

lemma nat_cast_nat_abs_val_min_abs {n : ℕ} [ne_zero 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 [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,
      int.cast_coe_nat, int.cast_coe_nat, nat_cast_self, sub_zero, nat_cast_zmod_val], }
end

lemma val_min_abs_neg_of_ne_half {n : ℕ} {a : zmod n} (ha : 2 * a.val ≠ n) :
  (-a).val_min_abs = -a.val_min_abs :=
begin
  casesI eq_zero_or_ne_zero n, { subst h, refl },
  refine (val_min_abs_spec _ _).2 ⟨_, _, _⟩,
  { rw [int.cast_neg, coe_val_min_abs] },
  { rw [neg_mul, neg_lt_neg_iff],
    exact a.val_min_abs_mem_Ioc.2.lt_of_ne (mt a.val_min_abs_mul_two_eq_iff.1 ha) },
  { linarith only [a.val_min_abs_mem_Ioc.1] },
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
  by_cases h2a : 2 * a.val = n,
  { rw a.neg_eq_self_iff.2 (or.inr h2a) },
  { rw [val_min_abs_neg_of_ne_half h2a, int.nat_abs_neg] }
end

lemma val_eq_ite_val_min_abs {n : ℕ} [ne_zero n] (a : zmod n) :
  (a.val : ℤ) = a.val_min_abs + if a.val ≤ n / 2 then 0 else n :=
by { rw 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]

variables {n a : ℕ}

lemma val_min_abs_nat_abs_eq_min {n : ℕ} [hpos : ne_zero n] (a : zmod n) :
  a.val_min_abs.nat_abs = min a.val (n - a.val) :=
begin
  rw val_min_abs_def_pos,
  split_ifs with h h,
  { rw int.nat_abs_of_nat, symmetry,
    apply min_eq_left (le_trans h (le_trans
      (nat.half_le_of_sub_le_half _) (nat.sub_le_sub_left n h))),
    rw nat.sub_sub_self (nat.div_le_self _ _) },
  { rw [←int.nat_abs_neg, neg_sub, ←nat.cast_sub a.val_le], symmetry,
    apply min_eq_right (le_trans (le_trans (nat.sub_le_sub_left n (lt_of_not_ge h))
      (nat.le_half_of_half_lt_sub _)) (le_of_not_ge h)),
    rw nat.sub_sub_self (nat.div_lt_self (lt_of_le_of_ne' (nat.zero_le _) hpos.1) one_lt_two),
    apply nat.lt_succ_self }
end

lemma val_min_abs_nat_cast_of_le_half (ha : a ≤ n / 2) : (a : zmod n).val_min_abs = a :=
begin
  cases n,
  { simp },
  { simp [val_min_abs_def_pos, val_nat_cast,
      nat.mod_eq_of_lt (ha.trans_lt $ nat.div_lt_self' _ 0), ha] }
end

lemma val_min_abs_nat_cast_of_half_lt (ha : n / 2 < a) (ha' : a < n) :
  (a : zmod n).val_min_abs = a - n :=
begin
  cases n,
  { cases not_lt_bot ha' },
  { simp [val_min_abs_def_pos, val_nat_cast, nat.mod_eq_of_lt ha', ha.not_le] }
end

@[simp] lemma val_min_nat_abs_nat_cast_eq_self [ne_zero n] :
  (a : zmod n).val_min_abs = a ↔ a ≤ n / 2 :=
begin
  refine ⟨λ ha, _, val_min_abs_nat_cast_of_le_half⟩,
  rw [←int.nat_abs_of_nat a, ←ha],
  exact nat_abs_val_min_abs_le a,
end

lemma nat_abs_min_of_le_div_two (n : ℕ) (x y : ℤ)
  (he : (x : zmod n) = y) (hl : x.nat_abs ≤ n / 2) : x.nat_abs ≤ y.nat_abs :=
begin
  rw int_coe_eq_int_coe_iff_dvd_sub at he,
  obtain ⟨m, he⟩ := he,
  rw sub_eq_iff_eq_add at he,
  subst he,
  obtain rfl|hm := eq_or_ne m 0,
  { rw [mul_zero, zero_add] },
  apply hl.trans,
  rw ← add_le_add_iff_right x.nat_abs,
  refine trans (trans ((add_le_add_iff_left _).2 hl) _) (int.nat_abs_sub_le _ _),
  rw [add_sub_cancel, int.nat_abs_mul, int.nat_abs_of_nat],
  refine trans _ (nat.le_mul_of_pos_right $ int.nat_abs_pos_of_ne_zero hm),
  rw ← mul_two, apply nat.div_mul_le_self,
end

lemma nat_abs_val_min_abs_add_le {n : ℕ} (a b : zmod n) :
  (a + b).val_min_abs.nat_abs ≤ (a.val_min_abs + b.val_min_abs).nat_abs :=
begin
  cases n, { refl },
  apply nat_abs_min_of_le_div_two n.succ,
  { simp_rw [int.cast_add, coe_val_min_abs] },
  { apply nat_abs_val_min_abs_le },
end

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, { exact (nat.not_prime_zero hp.out).elim }, },
  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 _ _ ⟨g, _⟩) _, 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) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

Natural homomorphism from the natural numbers into a monoid with one.
-/
import tactic.interactive algebra.order algebra.ordered_group

namespace nat
variables {α : Type*}

section
variables [has_zero α] [has_one α] [has_add α]

/-- Canonical homomorphism from `ℕ` to a type `α` with `0`, `1` and `+`. -/
protected def cast : ℕ → α
| 0     := 0
| (n+1) := cast n + 1

@[priority 0] instance cast_coe : has_coe ℕ α := ⟨nat.cast⟩

@[simp] theorem cast_zero : ((0 : ℕ) : α) = 0 := rfl

theorem cast_add_one (n : ℕ) : ((n + 1 : ℕ) : α) = n + 1 := rfl
@[simp] theorem cast_succ (n : ℕ) : ((succ n : ℕ) : α) = n + 1 := rfl
end

@[simp] theorem cast_one [add_monoid α] [has_one α] : ((1 : ℕ) : α) = 1 := zero_add _

@[simp] theorem cast_add [add_monoid α] [has_one α] (m) : ∀ n, ((m + n : ℕ) : α) = m + n
| 0     := (add_zero _).symm
| (n+1) := show ((m + n : ℕ) : α) + 1 = m + (n + 1), by rw [cast_add n, add_assoc]

@[simp] theorem cast_bit0 [add_monoid α] [has_one α] (n : ℕ) : ((bit0 n : ℕ) : α) = bit0 n := cast_add _ _

@[simp] theorem cast_bit1 [add_monoid α] [has_one α] (n : ℕ) : ((bit1 n : ℕ) : α) = bit1 n :=
by rw [bit1, cast_add_one, cast_bit0]; refl

@[simp] theorem cast_pred [add_group α] [has_one α] : ∀ {n}, n > 0 → ((n - 1 : ℕ) : α) = n - 1
| (n+1) h := (add_sub_cancel (n:α) 1).symm

@[simp] theorem cast_sub [add_group α] [has_one α] {m n} (h : m ≤ n) : ((n - m : ℕ) : α) = n - m :=
eq_sub_of_add_eq $ by rw [← cast_add, nat.sub_add_cancel h]

@[simp] theorem cast_mul [semiring α] (m) : ∀ n, ((m * n : ℕ) : α) = m * n
| 0     := (mul_zero _).symm
| (n+1) := (cast_add _ _).trans $
show ((m * n : ℕ) : α) + m = m * (n + 1), by rw [cast_mul n, left_distrib, mul_one]

theorem mul_cast_comm [semiring α] (a : α) (n : ℕ) : a * n = n * a :=
by induction n; simp [left_distrib, right_distrib, *]

@[simp] theorem cast_nonneg [linear_ordered_semiring α] : ∀ n : ℕ, 0 ≤ (n : α)
| 0     := le_refl _
| (n+1) := add_nonneg (cast_nonneg n) zero_le_one

@[simp] theorem cast_le [linear_ordered_semiring α] : ∀ {m n : ℕ}, (m : α) ≤ n ↔ m ≤ n
| 0     n     := by simp [zero_le]
| (m+1) 0     := by simpa [not_succ_le_zero] using
  lt_add_of_lt_of_nonneg zero_lt_one (@cast_nonneg α _ m)
| (m+1) (n+1) := (add_le_add_iff_right 1).trans $
  (@cast_le m n).trans $ (add_le_add_iff_right 1).symm

@[simp] theorem cast_lt [linear_ordered_semiring α] {m n : ℕ} : (m : α) < n ↔ m < n :=
by simpa [-cast_le] using not_congr (@cast_le α _ n m)

@[simp] theorem cast_pos [linear_ordered_ring α] {n : ℕ} : (0 : α) < n ↔ 0 < n :=
by rw [← cast_zero, cast_lt]

theorem eq_cast [add_monoid α] [has_one α] (f : ℕ → α)
  (H0 : f 0 = 0) (H1 : f 1 = 1)
  (Hadd : ∀ x y, f (x + y) = f x + f y) : ∀ n : ℕ, f n = n
| 0     := H0
| (n+1) := by rw [Hadd, H1, eq_cast]; refl

theorem eq_cast' [add_group α] [has_one α] (f : ℕ → α)
  (H1 : f 1 = 1) (Hadd : ∀ x y, f (x + y) = f x + f y) : ∀ n : ℕ, f n = n :=
eq_cast _ (by rw [← add_left_inj (f 0), add_zero, ← Hadd]) H1 Hadd

@[simp] theorem cast_id (n : ℕ) : ↑n = n :=
(eq_cast id rfl rfl (λ _ _, rfl) n).symm

@[simp] theorem cast_min [decidable_linear_ordered_semiring α] {a b : ℕ} : (↑(min a b) : α) = min a b :=
by by_cases a ≤ b; simp [h, min]

@[simp] theorem cast_max [decidable_linear_ordered_semiring α] {a b : ℕ} : (↑(max a b) : α) = max a b :=
by by_cases a ≤ b; simp [h, max]

end nat


-- Conjunction

variables p q : Prop

example (hp : p) (hq: q) : p ∧ q := and.intro hp hq

#check assume (hp : p) (hq : q), and.intro hp hq

example (h : p ∧ q) : p := and.elim_left h
example (h : p ∧ q) : q := and.elim_right h

example (h : p ∧ q) : q ∧ p :=
and.intro (and.right h) (and.left h)

variables (hp : p) (hq : q)

#check (⟨hp, hq⟩ : p ∧ q)

#check (0 : ℕ)
def zero : ℕ := (0 : ℕ)
#check zero

variable l : list ℕ

#check list.head l
#check l.head

example (h : p ∧ q) : q ∧ p :=
⟨ h.right, h.left ⟩

example (h : p ∧ q) : q ∧ p ∧ q :=
⟨ h.right, ⟨ h.left, h.right ⟩ ⟩

example (h : p ∧ q) : q ∧ p ∧ q :=
⟨ h.right, h.left, h.right ⟩


import algebra.module.localized_module
import ring_theory.localization.at_prime
import ring_theory.finiteness

variables (R M A : Type*) [comm_ring R] [add_comm_group M] [module R M] [ring A] [algebra R A]

include M

def module.support : set (ideal R) :=
{ I | ∃ h : I.is_prime, by exactI nontrivial (localized_module I.prime_compl M) }

omit M

lemma localized_module_nontrival_iff (S : submonoid R) :
  nontrivial (localized_module S M) ↔ ∃ x : M, disjoint (S : set R) (R ∙ x).annihilator :=
begin
  rw [nontrivial_iff_exists_ne (localized_module.mk (0 : M) (1 : S))],
  erw (@quotient.surjective_quotient_mk' _ (localized_module.r.setoid S M)).exists,
  simp_rw [prod.exists, ← set.subset_compl_iff_disjoint_right],
  change (∃ (a : M) (b : S), localized_module.mk a b ≠ _) ↔
    ∃ x : M, ∀ y : R, y ∈ S → y ∉ (R ∙ x).annihilator,
  simp_rw [ne.def, localized_module.mk_eq, not_exists, smul_zero, one_smul,
    submodule.mem_annihilator_span_singleton, eq_comm],
  exact ⟨λ ⟨a, _, h⟩, ⟨a, λ y hy, h ⟨y, hy⟩⟩, λ ⟨a, h⟩, ⟨a, 1, λ y, h y y.2⟩⟩
end

lemma localized_module_nontrival (M : submonoid R) :
  nontrivial (localized_module M A) ↔ disjoint (M : set R) (algebra_map R A).ker :=
begin
  simp_rw set.disjoint_iff,
  split,
  { rintros ⟨a, b, e⟩ x ⟨h₁, h₂ : algebra_map R A x = 0⟩,
    apply e,
    obtain ⟨⟨a₁, a₂⟩, rfl : localized_module.mk a₁ a₂ = a⟩ := quotient.exists_rep a,
    obtain ⟨⟨b₁, b₂⟩, rfl : localized_module.mk b₁ b₂ = b⟩ := quotient.exists_rep b,
    rw [localized_module.mk_eq],
    use ⟨x, h₁⟩,
    simp [submonoid.smul_def, algebra.smul_def, h₂] },
  { intro H,
    refine ⟨⟨localized_module.mk 0 1, localized_module.mk 1 1, _⟩⟩,
    rw [ne.def, localized_module.mk_eq],
    suffices : ∀ x : M, algebra_map R A x ≠ 0,
    { simpa [submonoid.smul_def, ← algebra.algebra_map_eq_smul_one] },
    intros x e, cases H ⟨x.prop, e⟩ },
end

lemma module.support_eq_of_algebra :
  module.support R A = { I | (algebra_map R A).ker ≤ I ∧ I.is_prime } :=
begin
  ext,
  simp [module.support, localized_module_nontrival, ideal.prime_compl,
    set.disjoint_compl_left_iff_subset, and_comm],
end

variables {R M}

lemma module.mem_support_iff {I : ideal R} [hI : I.is_prime] :
  I ∈ module.support R M ↔ nontrivial (localized_module I.prime_compl M) :=
⟨Exists.some_spec, Exists.intro hI⟩

lemma module.mem_support_iff_exists_of_is_prime {I : ideal R} [hI : I.is_prime] :
  I ∈ module.support R M ↔ ∃ x : M, (R ∙ x).annihilator ≤ I :=
begin
  rw [module.mem_support_iff, localized_module_nontrival_iff],
  apply exists_congr,
  intro x, exact set.disjoint_compl_left_iff_subset,
end

lemma module.mem_support_iff_exists {I : ideal R} :
  I ∈ module.support R M ↔ I.is_prime ∧ ∃ x : M, (R ∙ x).annihilator ≤ I :=
begin
  refine ⟨λ h, _, λ ⟨_, h⟩, by exactI module.mem_support_iff_exists_of_is_prime.mpr h⟩,
  haveI := h.some,
  rw module.mem_support_iff_exists_of_is_prime at h,
  exact ⟨infer_instance, h⟩
end

variables (R M)

lemma module.support_eq_exists :
  module.support R M = { I | I.is_prime ∧ ∃ x : M, (R ∙ x).annihilator ≤ I } :=
set.ext (λ I, module.mem_support_iff_exists)

variables {R M}

lemma module.exists_annihilator_le_of_mem_support (I ∈ module.support R M) :
  ∃ x : M, (R ∙ x).annihilator ≤ I :=
(module.mem_support_iff_exists.mp H).2

lemma module.mem_support_of_le {I J : ideal R} (h : I ≤ J) (hI : I ∈ module.support R M)
  [hJ : J.is_prime] :
  J ∈ module.support R M :=
begin
  haveI := hI.some,
  rw module.mem_support_iff_exists_of_is_prime at hI ⊢,
  exact exists_imp_exists (λ a, ge_trans h) hI
end

lemma module.annihilator_le_of_mem_support (I ∈ module.support R M) :
  (⊤ : submodule R M).annihilator ≤ I :=
(submodule.annihilator_mono le_top).trans
  (module.exists_annihilator_le_of_mem_support I H).some_spec

lemma module.mem_support_iff_annihilator_le_of_fg (I : ideal R) [I.is_prime]
  [hM : module.finite R M] :
  I ∈ module.support R M ↔ (⊤ : submodule R M).annihilator ≤ I :=
begin
  refine ⟨module.annihilator_le_of_mem_support I,
    λ e, module.mem_support_iff_exists_of_is_prime.mpr _⟩,
  change ∃ x : M, ∀ y : R, y ∈ _ → y ∈ I,
  simp_rw submodule.mem_annihilator_span_singleton,
  by_contra h,
  push_neg at h,
  choose y h₁ h₂ using h,
  obtain ⟨S, hS⟩ := hM.1,
  have : S.prod y ∈ I.prime_compl := prod_mem (λ c _, h₂ c),
  apply this,
  apply e,
  rw [← hS, submodule.mem_annihilator_span],
  rintro ⟨s, hs⟩,
  obtain ⟨z, e⟩ : y s ∣ S.prod y := finset.dvd_prod_of_mem _ hs,
  rw [e, subtype.coe_mk, mul_comm, mul_smul, h₁, smul_zero],
end

variables (R M)

lemma module.support_eq_of_fg
  [hM : module.finite R M] :
  module.support R M = { I | (⊤ : submodule R M).annihilator ≤ I ∧ I.is_prime } :=
begin
  ext I,
  have : ∀ {p q}, (p ∨ q → (p ↔ q)) → (p ↔ q) := by tauto!,
  refine this (λ H, _),
  haveI : I.is_prime := H.elim Exists.some and.right,
  rw module.mem_support_iff_annihilator_le_of_fg,
  exact (and_iff_left infer_instance).symm
end

lemma module.support_nonempty_iff :
  (module.support R M).nonempty ↔ nontrivial M :=
begin
  rw [module.support_eq_exists, nontrivial_iff_exists_ne (0 : M)],
  split, swap,
  { rintro ⟨a, ha⟩,
    obtain ⟨M, h₁, h₂⟩ := ideal.exists_le_maximal _ ((R ∙ a).annihilator.ne_top_iff_one.mpr _),
    { exactI ⟨M, infer_instance, _, h₂⟩ },
    rwa [submodule.mem_annihilator_span_singleton, one_smul] },
  { rintro ⟨I, hI, x, hx⟩,
    have := hx.trans_lt (lt_top_iff_ne_top.mpr hI.1),
    rw [lt_top_iff_ne_top, ideal.ne_top_iff_one, submodule.mem_annihilator_span_singleton,
      one_smul] at this,
    exact ⟨x, this⟩ }
end

lemma module.support_eq_empty_iff :
  module.support R M = ∅ ↔ subsingleton M :=
begin
  rw [← set.not_nonempty_iff_eq_empty, ← not_nontrivial_iff_subsingleton, not_iff_not,
    module.support_nonempty_iff],
end

lemma module.support_nonempty [h : nontrivial M] : (module.support R M).nonempty :=
(module.support_nonempty_iff R M).mpr h

lemma module.support_eq_nempty [h : subsingleton M] : module.support R M = ∅ :=
(module.support_eq_empty_iff R M).mpr h

variables {R}

def module.is_locally_nilpotent (r : R) (M : Type*) [add_comm_group M] [module R M] : Prop :=
∀ m : M, ∃ n : ℕ, r ^ n • m = 0

variables (R)

lemma module.mem_Inf_support_tfae (x : R) :
  tfae [subsingleton (localized_module (submonoid.powers x) M),
    module.is_locally_nilpotent x M,
    x ∈ Inf (module.support R M)] :=
begin
  tfae_have : 1 → 2,
  { rw [← not_nontrivial_iff_subsingleton, localized_module_nontrival_iff],
    simp_rw [← set.subset_compl_iff_disjoint_left, set.subset_def],
    dsimp,
    simp_rw submodule.mem_annihilator_span_singleton,
    push_neg,
    apply forall_imp,
    rintros m ⟨_, hn, ⟨n, rfl⟩⟩, exact ⟨n, hn⟩ },
  tfae_have : 2 → 3,
  { simp_rw [ideal.mem_Inf, module.mem_support_iff_exists],
    rintros H I ⟨hI, a, ha⟩,
    obtain ⟨n, hn⟩ := H a,
    cases (zero_le n).lt_or_eq,
    { rw ← hI.pow_mem_iff_mem n h, apply ha, rwa submodule.mem_annihilator_span_singleton },
    { subst h, rw [pow_zero, one_smul] at hn, subst hn, apply ha,
      rw submodule.mem_annihilator_span_singleton, rw smul_zero } },
  tfae_have : 3 → 1,
  { rw [← not_nontrivial_iff_subsingleton, ideal.mem_Inf],
    introsI H inst,
    obtain ⟨I, hI⟩ := (module.support_nonempty_iff (localization.away x) _).mpr inst,
    haveI := hI.some,
    apply hI.some.1,
    refine ideal.eq_top_of_is_unit_mem _ _
      (is_localization.map_units _ ⟨x, submonoid.mem_powers x⟩),
    rw ← ideal.mem_comap,
    apply H,
    rw module.mem_support_iff_exists_of_is_prime at hI ⊢,
    obtain ⟨y, hy⟩ := hI,
    obtain ⟨⟨m, s⟩, rfl : localized_module.mk m s = y⟩ := quotient.exists_rep y,
    refine ⟨m, le_trans _ (ideal.comap_mono hy)⟩,
    intros z hz,
    rw submodule.mem_annihilator_span_singleton at hz,
    rw [ideal.mem_comap, submodule.mem_annihilator_span_singleton,
      algebra_map_smul, localized_module.smul'_mk, hz, localized_module.zero_mk] },
  tfae_finish
end

variables {R M}

lemma module.mem_Inf_support_iff_locally_nilpotent {x : R} :
  x ∈ Inf (module.support R M) ↔ module.is_locally_nilpotent x M :=
(module.mem_Inf_support_tfae R M x).out 2 1

lemma module.Inf_support_eq_annihilator_radical [h : module.finite R M] :
  Inf (module.support R M) = (⊤ : submodule R M).annihilator.radical :=
begin
  rw [ideal.radical_eq_Inf, module.support_eq_of_fg]
end

lemma module.is_locally_nilpotent_iff_mem_radical [module.finite R M] (x : R) :
  module.is_locally_nilpotent x M ↔ x ∈ (⊤ : submodule R M).annihilator.radical :=
by rw [← module.mem_Inf_support_iff_locally_nilpotent, module.Inf_support_eq_annihilator_radical]

lemma module.is_locally_nilpotent_of_algebra {x : R} :
  module.is_locally_nilpotent x A ↔ x ∈ (algebra_map R A).ker.radical :=
by rw [ideal.radical_eq_Inf, ← module.mem_Inf_support_iff_locally_nilpotent,
  module.support_eq_of_algebra]


open classical
variables p q r s : Prop

theorem corsica : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
assume h : p → r ∨ s,
by_cases
    (assume h1 : p,
        (h h1).elim
            (assume hr : r, or.inl (assume hp : p, hr))
            (assume hs : s, or.inr (assume hp : p, hs)))
    (assume h1 : ¬p, or.inl (assume hp : p, absurd hp h1))

theorem sardinia : ¬(p ∧ q) → ¬p ∨ ¬q :=
assume hpqf : p ∧ q → false,
by_cases
    (assume h1 : p,
    by_cases
        (assume h2 : q, (hpqf ⟨h1, h2⟩).elim)
        (assume h2 : ¬q, or.inr h2)
        )
    (assume h1 : ¬p, or.inl h1)

theorem trivium : p ∨ ¬p := em p

theorem sicilia : ¬(p → q) → p ∧ ¬q :=
assume hpqf : (p → q) → false,
by_cases
    (assume h1 : p,
    by_cases
        (assume h2 : q,
        have hpq : p → q, from (assume hp : p, h2),
        absurd hpq hpqf)
        (assume h2 : ¬q, ⟨h1, h2⟩))
    (assume h1 : ¬p,
    by_cases
        (assume h2 : q,
        have hpq : p → q, from (assume hp : p, h2),
        absurd hpq hpqf)
        (assume h2 : ¬q,
        have hpq : p → q, from (assume hp : p, absurd hp h1),
        absurd hpq hpqf))

theorem creta : (p → q) → (¬p ∨ q) :=
assume hpq : p → q,
by_cases
    (assume h1 : p, or.inr (hpq h1))
    (assume h1 : ¬p, or.inl h1)

theorem ilium : (¬q → ¬p) → (p → q) :=
assume hnqnp : ¬q → ¬p,
assume hp : p,
by_cases
    (assume h1 : q, h1)
    (assume h1 : ¬q, absurd hp (hnqnp h1))

#check ilium (p → q) p

theorem roma : (((p → q) → p) → p) :=
assume h1 : ((p → q) → p),
by_cases
    (assume h2 : p → q, h1 h2)
    (assume h2 : (p → q) → false, sorry
    -- h2 (p → q) p h1
        )


import defs
open list

lemma size_erase_add_eq_size_sum {φ} : Π (Γ : list nnf) (h : φ ∈ Γ), node_size (Γ.erase φ) + sizeof φ = node_size Γ
| [] h := absurd h $ not_mem_nil _
| (hd :: tl) h :=
begin
  by_cases eq : φ = hd,
  {dsimp [list.erase], rw if_pos, rw eq, apply add_comm, rw eq},
  {dsimp [list.erase], rw if_neg, dsimp, rw [add_assoc],   have : node_size (list.erase tl φ) + sizeof φ = node_size tl,
    {apply size_erase_add_eq_size_sum, cases h, contradiction, assumption},
    rw this, intro h', rw h' at eq, contradiction}
end

theorem split_lt_and {φ ψ} (Γ : list nnf) (h : nnf.and φ ψ ∈ Γ) :
node_size (φ :: ψ :: Γ.erase (nnf.and φ ψ)) < node_size Γ :=
begin
  dsimp [node_size],
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [←add_assoc, add_comm],
  apply add_lt_add_left, dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof],
  rw [add_assoc],
  rw [nat.one_add],
  apply nat.lt_succ_self
end

theorem split_lt_or_left {φ ψ} (Γ : list nnf) (h : nnf.or φ ψ ∈ Γ) :
node_size (φ :: Γ.erase (nnf.or φ ψ)) < node_size Γ :=
begin
  dsimp,
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [add_comm],
  apply add_lt_add_left, dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof],
  rw [add_comm, ←add_assoc],
  apply nat.lt_add_of_pos_left,
  apply nat.succ_pos
end

theorem split_lt_or_right {φ ψ} (Γ : list nnf) (h : nnf.or φ ψ ∈ Γ) :
node_size (ψ :: Γ.erase (nnf.or φ ψ)) < node_size Γ :=
begin
  dsimp,
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [add_comm],
  apply add_lt_add_left, dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof],
  apply nat.lt_add_of_pos_left,
  rw nat.one_add,
  apply nat.succ_pos
end


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.perm.sign
import Mathlib.PostPort

universes u_2 u_1

namespace Mathlib

/-!
# Cyclic permutations

## Main definitions

In the following, `f : equiv.perm β`.

* `equiv.perm.is_cycle`: `f.is_cycle` when two nonfixed points of `β`
  are related by repeated application of `f`.
* `equiv.perm.same_cycle`: `f.same_cycle x y` when `x` and `y` are in the same cycle of `f`.

The following two definitions require that `β` is a `fintype`:

* `equiv.perm.cycle_of`: `f.cycle_of x` is the cycle of `f` that `x` belongs to.
* `equiv.perm.cycle_factors`: `f.cycle_factors` is a list of disjoint cyclic permutations that
  multiply to `f`.

-/

namespace equiv.perm

/-!
### `is_cycle`
-/

/-- A permutation is a cycle when any two nonfixed points of the permutation are related by repeated
  application of the permutation. -/
def is_cycle {β : Type u_2} (f : perm β) :=
  ∃ (x : β), coe_fn f x ≠ x ∧ ∀ (y : β), coe_fn f y ≠ y → ∃ (i : ℤ), coe_fn (f ^ i) x = y

theorem is_cycle.swap {α : Type u_1} [DecidableEq α] {x : α} {y : α} (hxy : x ≠ y) : is_cycle (swap x y) := sorry

theorem is_cycle.inv {β : Type u_2} {f : perm β} (hf : is_cycle f) : is_cycle (f⁻¹) := sorry

theorem is_cycle.exists_gpow_eq {β : Type u_2} {f : perm β} (hf : is_cycle f) {x : β} {y : β} (hx : coe_fn f x ≠ x) (hy : coe_fn f y ≠ y) : ∃ (i : ℤ), coe_fn (f ^ i) x = y := sorry

theorem is_cycle.exists_pow_eq {β : Type u_2} [fintype β] {f : perm β} (hf : is_cycle f) {x : β} {y : β} (hx : coe_fn f x ≠ x) (hy : coe_fn f y ≠ y) : ∃ (i : ℕ), coe_fn (f ^ i) x = y := sorry

theorem is_cycle_swap_mul_aux₁ {α : Type u_1} [DecidableEq α] (n : ℕ) {b : α} {x : α} {f : perm α} (hb : coe_fn (swap x (coe_fn f x) * f) b ≠ b) (h : coe_fn (f ^ n) (coe_fn f x) = b) : ∃ (i : ℤ), coe_fn ((swap x (coe_fn f x) * f) ^ i) (coe_fn f x) = b := sorry

theorem is_cycle_swap_mul_aux₂ {α : Type u_1} [DecidableEq α] (n : ℤ) {b : α} {x : α} {f : perm α} (hb : coe_fn (swap x (coe_fn f x) * f) b ≠ b) (h : coe_fn (f ^ n) (coe_fn f x) = b) : ∃ (i : ℤ), coe_fn ((swap x (coe_fn f x) * f) ^ i) (coe_fn f x) = b := sorry

theorem is_cycle.eq_swap_of_apply_apply_eq_self {α : Type u_1} [DecidableEq α] {f : perm α} (hf : is_cycle f) {x : α} (hfx : coe_fn f x ≠ x) (hffx : coe_fn f (coe_fn f x) = x) : f = swap x (coe_fn f x) := sorry

theorem is_cycle.swap_mul {α : Type u_1} [DecidableEq α] {f : perm α} (hf : is_cycle f) {x : α} (hx : coe_fn f x ≠ x) (hffx : coe_fn f (coe_fn f x) ≠ x) : is_cycle (swap x (coe_fn f x) * f) := sorry

theorem is_cycle.sign {α : Type u_1} [DecidableEq α] [fintype α] {f : perm α} (hf : is_cycle f) : coe_fn sign f = -(-1) ^ finset.card (support f) := sorry

/-!
### `same_cycle`
-/

/-- The equivalence relation indicating that two points are in the same cycle of a permutation. -/
def same_cycle {β : Type u_2} (f : perm β) (x : β) (y : β) :=
  ∃ (i : ℤ), coe_fn (f ^ i) x = y

theorem same_cycle.refl {β : Type u_2} (f : perm β) (x : β) : same_cycle f x x :=
  Exists.intro 0 rfl

theorem same_cycle.symm {β : Type u_2} (f : perm β) {x : β} {y : β} : same_cycle f x y → same_cycle f y x := sorry

theorem same_cycle.trans {β : Type u_2} (f : perm β) {x : β} {y : β} {z : β} : same_cycle f x y → same_cycle f y z → same_cycle f x z := sorry

theorem same_cycle.apply_eq_self_iff {β : Type u_2} {f : perm β} {x : β} {y : β} : same_cycle f x y → (coe_fn f x = x ↔ coe_fn f y = y) := sorry

theorem is_cycle.same_cycle {β : Type u_2} {f : perm β} (hf : is_cycle f) {x : β} {y : β} (hx : coe_fn f x ≠ x) (hy : coe_fn f y ≠ y) : same_cycle f x y :=
  is_cycle.exists_gpow_eq hf hx hy

protected instance same_cycle.decidable_rel {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) : DecidableRel (same_cycle f) :=
  fun (x y : α) => decidable_of_iff (∃ (n : ℕ), ∃ (H : n ∈ list.range (order_of f)), coe_fn (f ^ n) x = y) sorry

theorem same_cycle_apply {β : Type u_2} {f : perm β} {x : β} {y : β} : same_cycle f x (coe_fn f y) ↔ same_cycle f x y := sorry

theorem same_cycle_cycle {β : Type u_2} {f : perm β} {x : β} (hx : coe_fn f x ≠ x) : is_cycle f ↔ ∀ {y : β}, same_cycle f x y ↔ coe_fn f y ≠ y := sorry

theorem same_cycle_inv {β : Type u_2} (f : perm β) {x : β} {y : β} : same_cycle (f⁻¹) x y ↔ same_cycle f x y := sorry

theorem same_cycle_inv_apply {β : Type u_2} {f : perm β} {x : β} {y : β} : same_cycle f x (coe_fn (f⁻¹) y) ↔ same_cycle f x y := sorry

/-!
### `cycle_of`
-/

/-- `f.cycle_of x` is the cycle of the permutation `f` to which `x` belongs. -/
def cycle_of {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) (x : α) : perm α :=
  coe_fn of_subtype (subtype_perm f sorry)

theorem cycle_of_apply {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) (x : α) (y : α) : coe_fn (cycle_of f x) y = ite (same_cycle f x y) (coe_fn f y) y :=
  rfl

theorem cycle_of_inv {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) (x : α) : cycle_of f x⁻¹ = cycle_of (f⁻¹) x := sorry

@[simp] theorem cycle_of_pow_apply_self {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) (x : α) (n : ℕ) : coe_fn (cycle_of f x ^ n) x = coe_fn (f ^ n) x := sorry

@[simp] theorem cycle_of_gpow_apply_self {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) (x : α) (n : ℤ) : coe_fn (cycle_of f x ^ n) x = coe_fn (f ^ n) x := sorry

theorem same_cycle.cycle_of_apply {α : Type u_1} [DecidableEq α] [fintype α] {f : perm α} {x : α} {y : α} (h : same_cycle f x y) : coe_fn (cycle_of f x) y = coe_fn f y :=
  dif_pos h

theorem cycle_of_apply_of_not_same_cycle {α : Type u_1} [DecidableEq α] [fintype α] {f : perm α} {x : α} {y : α} (h : ¬same_cycle f x y) : coe_fn (cycle_of f x) y = y :=
  dif_neg h

@[simp] theorem cycle_of_apply_self {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) (x : α) : coe_fn (cycle_of f x) x = coe_fn f x :=
  same_cycle.cycle_of_apply (same_cycle.refl f x)

theorem is_cycle.cycle_of_eq {α : Type u_1} [DecidableEq α] [fintype α] {f : perm α} (hf : is_cycle f) {x : α} (hx : coe_fn f x ≠ x) : cycle_of f x = f := sorry

theorem cycle_of_one {α : Type u_1} [DecidableEq α] [fintype α] (x : α) : cycle_of 1 x = 1 := sorry

theorem is_cycle_cycle_of {α : Type u_1} [DecidableEq α] [fintype α] (f : perm α) {x : α} (hx : coe_fn f x ≠ x) : is_cycle (cycle_of f x) := sorry

/-!
### `cycle_factors`
-/

/-- Given a list `l : list α` and a permutation `f : perm α` whose nonfixed points are all in `l`,
  recursively factors `f` into cycles. -/
def cycle_factors_aux {α : Type u_1} [DecidableEq α] [fintype α] (l : List α) (f : perm α) : (∀ {x : α}, coe_fn f x ≠ x → x ∈ l) →
  Subtype fun (l : List (perm α)) => list.prod l = f ∧ (∀ (g : perm α), g ∈ l → is_cycle g) ∧ list.pairwise disjoint l :=
  sorry

/-- Factors a permutation `f` into a list of disjoint cyclic permutations that multiply to `f`. -/
def cycle_factors {α : Type u_1} [DecidableEq α] [fintype α] [linear_order α] (f : perm α) : Subtype fun (l : List (perm α)) => list.prod l = f ∧ (∀ (g : perm α), g ∈ l → is_cycle g) ∧ list.pairwise disjoint l :=
  cycle_factors_aux (finset.sort LessEq finset.univ) f sorry

/-!
### Fixed points
-/

theorem one_lt_nonfixed_point_card_of_ne_one {α : Type u_1} [DecidableEq α] [fintype α] {σ : perm α} (h : σ ≠ 1) : 1 < finset.card (finset.filter (fun (x : α) => coe_fn σ x ≠ x) finset.univ) := sorry

theorem fixed_point_card_lt_of_ne_one {α : Type u_1} [DecidableEq α] [fintype α] {σ : perm α} (h : σ ≠ 1) : finset.card (finset.filter (fun (x : α) => coe_fn σ x = x) finset.univ) < fintype.card α - 1 := sorry


import topology.instances.real

open filter real
open_locale topological_space

theorem part_i_a (a : ℕ → ℝ) (h1 : a 1 = 1)
  (h2 : ∀ n : ℕ, a (n + 1) = (a n ^ 2 + 2) / (2 * a n)) :
  ∃ M : ℝ, ∀ n : ℕ, abs (a n) ≤ M :=
begin
  sorry
end

theorem part_i_b (a : ℕ → ℝ) (h1 : a 1 = 1) (h2 : ∀ n, a (n+1) = (a n ^ 2 + 2) / (2 * a n)) :
  ∀ n, n ≥ 2 → a n ≥ a (n+1) :=
begin
  sorry
end

theorem part_ii (a : ℕ → ℝ) (h1 : a 1 = 1) (h2 : ∀ n, a (n+1) = (a n ^ 2 + 2) / (2 * a n)) :
  tendsto a at_top (𝓝 2) :=
begin
  sorry
end


import data.fintype.basic
import data.set
import data.finset
import tactic
import finset_extra

noncomputable theory
localized "attribute [instance, priority 100000] classical.prop_decidable
  noncomputable theory" in classical
open_locale classical
open finset

universes u v

structure matroid_on (γ : Type u) :=
(fin_cert: fintype γ)
(r : finset γ → ℤ)
(R1 : ∀ (X : finset γ), 0 ≤ r X ∧ r X ≤ size X)
(R2 : ∀ {X Y : finset γ}, X ⊆ Y → r X ≤ r Y)
(R3 : ∀ (X Y : finset γ), r (X ∪ Y) + r (X ∩ Y) ≤ r X + r Y)

class matroids (α : Type v)  :=
(γ : α → Type u)
(to_matroid : Π (M : α), matroid_on (γ M))

-- M is the name of the matroid and has type α.
-- (γ M) is the 'ground type' of the matroid M;
--the function to_matroid maps the name M to the structure of -- matroid M (i.e. a rank function and proofs of axioms).

instance matroid_on.matroids (γ : Type u)[fintype γ] : matroids (matroid_on γ) :=
{ γ := λ _, γ,
  to_matroid := id }

namespace matroid

local attribute [simp] image_union image_inter

variables {α : Type v} [matroids α]
-- Accessor functions for terms that have a matroid representation

--def finproof (M: α) := matroids.finproof M
def fin_cert (M: α) := (matroids.to_matroid M).fin_cert
def γ (M : α) := matroids.γ M -- matroid elements have type γ
def E (M: α) : (finset (γ M)) := (fin_cert M).elems -- E is the ground set viewed as a set, not a type.
def r (M : α) (X : finset (γ M) ) : ℤ := (matroids.to_matroid M).r X --@((matroids.to_matroid M).r) sorry sorry X
def R1 (M : α) (X : finset (γ M)) : 0 ≤ r M X ∧ r M X ≤ X.card := (matroids.to_matroid M).R1 X
def R2 (M : α) {X Y : finset (γ M)} (h : X ⊆ Y) : r M X ≤ r M Y := (matroids.to_matroid M).R2 h
def R3 (M : α) (X Y : finset (γ M)) : r M (X ∪ Y) + r M (X ∩ Y) ≤ r M X + r M Y := (matroids.to_matroid M).R3 X Y

@[simp] lemma r_empty_eq_zero (M : α) : r M (∅ : finset (γ M)) = 0 :=
begin
    have := R1 M ∅,
    simp only [card_empty, int.coe_nat_zero] at this,
    linarith,
end
--by { have h := R1 M ∅, rwa [card_empty, le_zero_iff_eq] at h }

--@[simp] lemma triv1 {M : α} [fintype (γ M)] {X : finset (γ M)} : X ⊆ E M := subset_univ X

lemma rank_subadditive (M : α) (X Y : finset (γ M)) : r M (X ∪ Y) ≤ r M X + r M Y := sorry
--le_trans (nat.le.intro rfl) (R3 M X Y)

lemma r_le_union (M : α) (X Y : finset (γ M)) : r M X ≤ r M (X ∪ Y) :=
by { apply R2 M, apply subset_union_left }

lemma r_le_union_right (M : α) (X Y : finset (γ M)) : r M Y ≤ r M (X ∪ Y) :=
by { rw union_comm, apply r_le_union }

--instance coe_subtype_finset {α : Type*} {Y: set α} :
--    has_coe (finset ↥Y) (finset α) := ⟨λ X, X.image subtype.val⟩

/-@[simp] lemma coe_subtype_size {α : Type*} {Y: set α} (X: finset Y) : size X = size (X: finset α) :=
begin
    sorry,
end

lemma coe_subtype_union {α: Type*} {Y: set α} (X₁ X₂ : finset Y) :
    (((X₁ ∪ X₂ : finset Y)) :finset α ) = (X₁ : finset α) ∪ (X₂ : finset α) :=
begin
    sorry,
    /-exact @image_union (↥Y) α
    (subtype.decidable_eq)
    _
    (λ (a : (↥Y)), (a : α)) X₁ X₂,-/

end
--set_option pp.all true
#print coe_subtype_union
#check @subtype.decidable_eq

@[simp] lemma coe_subtype_inter {α: Type*} {Y: set α} (X₁ X₂ : finset Y) :
    (((X₁ ∩ X₂ : finset Y)) :finset α) = (X₁ : finset α) ∩ (X₂ : finset α) :=
begin
    apply image_inter,
    apply subtype.ext,
end -/

structure submatroid (M : α) :=
(F : finset (γ M))

--set_option pp.beta true
--set_option pp.universes true
--set_option pp.notation false
--set_option pp.implicit true
set_option pp.proofs true

instance submatroid.matroid (M : α) : matroids (submatroid M) :=
{ γ := λ (M' : submatroid M), ↥(↑(M'.F) : set (γ M)),
  to_matroid := λ (M' : submatroid M),
  {
    fin_cert := @fintype.subtype (γ M) (λ x, (x ∈ M'.F)) M'.F (by simp),
    r := λ X, r M (X.image subtype.val),
    R1 := λ X,
    begin
        split,
        apply (R1 M (X.image subtype.val)).1,
        --have := (R1 M (X.image subtype.val)).2,

        sorry,
        --simp,
        --apply (R1 M (X.image subtype.val)).2,
    end,
    R2 := λ X₁ X₂ h, R2 M ((image_subset_image h)),
    R3 := λ X₁ X₂,
    begin
        --r M ↑(X₁ ∪ X₂) + r M ↑(X₁ ∩ X₂) ≤ r M ↑X₁ + r M ↑X₂
        convert (R3 M (X₁.image subtype.val) (X₂.image subtype.val)),
        apply image_union,
        apply image_inter,
        apply subtype.ext,
        --rw ← coe_subtype_union,
        --congr,
        --rw ← coe_subtype_inter,
        --congr,
    end, }}

def delete (M: α) (D: finset (γ M)) : submatroid M :=
submatroid.mk ((E M) \ D)

structure matroid_contraction (M : α) :=
(C : finset (γ M))

def contract (M : α) (C : finset (γ M)) : matroid_contraction M :=
matroid_contraction.mk C

instance matroid_contraction.matroid (M : α) : matroids (matroid_contraction M) :=
{ γ := λ M', ↥((↑M'.C : set (γ M))ᶜ),
  to_matroid := λ M',
  { fin_cert := @fintype.subtype (γ M) (λ x, (x ∉ M'.C)) ((E M) \ (M'.C))
  begin
     intros g,
     split,
     simp,
     simp,
     intros hg,
     split,
     apply (fin_cert M).complete,
     exact hg,
  end,

    r := sorry, --λ X, r M (X ∪ M'.C) - r M M'.C,

    R1 := λ X,
    begin
      sorry,
      /-split,
      linarith [R2 M (subset_union_right ↑X M'.C)],

      have h1 := rank_subadditive M X M'.C,
      have := (R1 M X).2,
      rw coe_subtype_size X,
      unfold size,
      linarith-/
    end,
    R2 := λ X,
    begin
         sorry,
         /-
        intros Y hXY,
        have hXYC: (X ∪ M'.C: finset (γ M)) ⊆ (Y ∪ M'.C: finset (γ M)),
        {
            apply union_subset_union_left,
            apply image_subset_image,
            exact hXY,
        },
        linarith [R2 M hXYC], -/
    end,
    R3 :=
    begin

        sorry,
        --intros X Y,
        /-
        α: Type v
        _inst_1: matroids α
        M: α
        M': matroid_contraction M
        XY: finset ↥(↑(M'.C))ᶜ
        ⊢ r M (↑(X ∪ Y) ∪ M'.C) - r M M'.C + (r M (↑(X ∩ Y) ∪ M'.C) - r M M'.C)
           ≤ r M (↑X ∪ M'.C) - r M M'.C + (r M (↑Y ∪ M'.C) - r M M'.C)
        -/

        /-suffices: r M (↑(X ∪ Y) ∪ M'.C) + r M (↑(X ∩ Y) ∪ M'.C) ≤ r M (↑X ∪ M'.C) + r M (↑Y ∪ M'.C),
        {
            linarith,
        },-/

        --sorry,

        --rw ← coe_subtype_union,

        --calc r M (↑(X ∪ Y) ∪ M'.C) - r M M'.C + (r M (↑(X ∩ Y) ∪ M'.C) - r M M'.C) ≤ r M (↑(X ∪ Y) ∪ M'.C) + (r M (↑(X ∩ Y) ∪ M'.C) - 2*(r M M'.C) : by linarith
        --... = r M (↑X ∪ M'.C) - r M M'.C + (r M (↑Y ∪ M'.C) - r M M'.C) : sorry,
        --... =

        --sorry,
        --exact this,

        --{linarith,},
        --rw @image_union (finset (↑(M'.C))ᶜ) () _ _ _ X Y ,
        --sorry,

        /-intros X Y,
        let X' := X.image subtype.val,
        let Y' := Y.image subtype.val,
        rw [image_union, image_inter],
        have := R3 M (X' ∪ M'.C) (Y' ∪ M'.C),
        simp only [@union_unions _ _ X' Y' _, inter_unions]  at this,

        linarith,
        intros x y,
        exact subtype.eq,-/
    end,
    }
 }

def dual (M : α) : matroid_on (γ M) :=
{
   fin_cert :=
    begin
       sorry,
    end,
    r := λ X, size X - r M (E M) + r M (Xᶜ),
  R1 :=
  begin
    sorry,
    /-intros X,
    split,
    have h1 : r X ≤ size X := (R1 M X).2,
    have h2 := rank_subadditive M X (Xᶜ),
    have h3 := lambda_conn_nonegative M X,
    --unfold lambda_conn at h3,

    calc size X - r (E M) + r Xᶜ = size X - r X + (r X + r Xᶜ - r (E M)) : by linarith
                        ...      ≥ size X - r X                          : by linarith [lambda_conn_nonegative M X]
                        ...      ≥ 0                                     : by linarith [(R1 M X).2],

    linarith[ R2 M ((by simp) :(Xᶜ ⊆ E M))], -/
  end,
  R2 := sorry,
  R3 := sorry }

instance matroid_on.matroids (M : α) : matroids (matroid_on (γ M)) :=
{ γ := λ _, γ M,
  to_matroid := id }

variable (M : α)
variable (X : finset (γ M))
#check matroids.to_matroid (dual (delete M X))
#check matroids.to_matroid (contract (dual M) X)
#check (matroids.γ (dual (delete M X)))
#check (matroids.γ (contract (dual M) X))

def dual_equiv (M : α) : matroid_contraction M ≃ submatroid (dual M) :=
begin

end
lemma dual_types (M: α) (X: finset (γ M)) : (matroids.γ (dual (delete M X))) = (matroids.γ (contract (dual M) X)) :=
begin
    sorry,
end
lemma contract_delete_dual (M: α) (X: finset (γ M)) : (matroids.to_matroid (dual (delete M X))) = (matroids.to_matroid (contract (dual M) X)) :=
begin
   sorry,
end

end matroid


import .full_language .jump

def fml_is_sat (Γ : list fml) : bool :=
match tableau (list.map fml.to_nnf Γ) with
| node.closed _ _ _ := ff
| node.open_ _ := tt
end

theorem classical_correctness (Γ : list fml) :
fml_is_sat Γ = tt ↔ ∃ (st : Type) (k : kripke st) s, fml_sat k s Γ :=
begin
  cases h : fml_is_sat Γ,
  constructor,
  { intro, contradiction },
  { intro hsat, cases eq : tableau (list.map fml.to_nnf Γ),
    rcases hsat with ⟨w, k, s, hsat⟩,
    apply false.elim, apply a, rw trans_sat_iff at hsat, exact hsat,
    { dsimp [fml_is_sat] at h, rw eq at h, contradiction } },
  { split, intro, dsimp [fml_is_sat] at h,
     cases eq : tableau (list.map fml.to_nnf Γ),
     { rw eq at h, contradiction },
  { split, split, split, have := a_1.2, rw ←trans_sat_iff at this,
    exact this },
  { simp } }
end

open fml

def fml.exm : fml := or (var 1) (neg (var 1))

def K : fml := impl (box (impl (var 1) (var 2))) (impl (box $ var 1) (box $ var 2))

def tst : list fml := [dia $ and (var 0) (neg $ var 1), dia $ var 1, box $ var 2, and (var 1) (var 2)]

#eval fml_is_sat tst


-- Define Cc Q as the power quandle of the "conjugacy classes" of Q.

import comm_power_quandle

universe u

section conj_pq

variables {Q : Type u} [power_quandle Q]

--structure conj_pq_wrapper (Q : Type u) [power_quandle Q] := (a : Q)

/-
inductive pq_is_conj : Q → Q → Prop
| refl (a : Q) : pq_is_conj a a
| symm (a b : Q) (hab : pq_is_conj a b) : pq_is_conj b a
| rhd (a b c : Q) (hbc : pq_is_conj b c) : pq_is_conj (a ▷ b) c

lemma pq_is_conj_refl (a : Q) : pq_is_conj a a := pq_is_conj.refl a

lemma pq_is_conj_symm (a b : Q) (hab : pq_is_conj a b) : pq_is_conj b a := pq_is_conj.symm a b hab

lemma pq_is_conj_trans (a b c : Q) (hab : pq_is_conj a b) (hbc : pq_is_conj b c) : pq_is_conj a c :=
begin
  suffices :
  induction hab,
end
-/

def pq_is_conj : Q → Q → Prop := λ x y, ∃ z : list Q, y = list.foldl (λ a b, b ▷ a) x z

lemma pq_is_conj_refl (a : Q) : pq_is_conj a a :=
begin
  use list.nil,
  refl,
end

lemma pq_is_conj_symm (a b : Q) (hab : pq_is_conj a b) : pq_is_conj b a :=
begin
  cases hab with x hx,
  use (list.map (λ y, y ^ (-1 : ℤ)) x).reverse,
  rw hx,
  clear hx,
  induction x generalizing a,
  {
    refl,
  },
  {
    simp only [list.reverse_cons, list.foldl_append, list.foldl, list.map],
    rw ←x_ih (x_hd ▷ a),
    rw ←power_quandle.pow_one x_hd,
    rw power_quandle.pow_comp,
    norm_num,
    rw power_quandle.rhd_pow_add,
    norm_num,
    rw power_quandle.pow_zero,
    rw power_quandle.one_rhd,
  },
end

lemma pq_is_conj_trans (a b c : Q) (hab : pq_is_conj a b) (hbc : pq_is_conj b c) : pq_is_conj a c :=
begin
  cases hab with x hx,
  cases hbc with y hy,
  use x ++ y,
  simp only [list.foldl_append],
  rw ←hx,
  exact hy,
end

lemma pq_is_conj_rhd_congr (a b a' b' : Q) (hab : pq_is_conj a b) (hab' : pq_is_conj a' b') : pq_is_conj (a ▷ a') (b ▷ b') :=
begin
  cases hab' with y hy,
  use ([a ^ (-1 : ℤ)] ++ y ++ [b]),
  simp only [list.foldl_append, list.foldl],
  rw hy,
  congr,
  rw ←power_quandle.pow_one a,
  rw power_quandle.pow_comp,
  norm_num,
  rw power_quandle.rhd_pow_add,
  norm_num,
  rw power_quandle.pow_zero,
  rw power_quandle.one_rhd,
end

lemma pq_is_conj_pow_congr (a b : Q) (n : ℤ) (hab : pq_is_conj a b) : pq_is_conj (a ^ n) (b ^ n) :=
begin
  cases hab with x hx,
  use x,
  rw hx,
  clear hx,
  induction x generalizing a,
  {
    refl,
  },
  {
    simp only [list.foldl],
    rw x_ih (x_hd ▷ a),
    congr,
    rw power_quandle.pow_rhd,
  },
end

def pq_is_conj_setoid : setoid Q := ⟨pq_is_conj, begin
  split,
  apply pq_is_conj_refl,
  split,
  apply pq_is_conj_symm,
  apply pq_is_conj_trans,
end⟩

local attribute [instance] pq_is_conj_setoid

def conj_pq (Q : Type u) [power_quandle Q] : Type u := @quotient Q (pq_is_conj_setoid)

def conj_pq_of (a : Q) : conj_pq Q := ⟦a⟧

lemma conj_pq_of_def (a : Q) : conj_pq_of a = ⟦a⟧ := rfl

instance conj_pq_has_rhd : has_rhd (conj_pq Q) := ⟨λ x y, quotient.lift_on₂ x y (λ a b, ⟦a ▷ b⟧) begin
  intros a b c d hab hcd,
  apply quotient.sound,
  apply pq_is_conj_rhd_congr,
  assumption,
  assumption,
end⟩

instance conj_pq_has_pow : has_pow (conj_pq Q) (ℤ) := ⟨λ x n, quotient.lift_on x (λ a, ⟦a ^ n⟧) begin
  intros a b hab,
  apply quotient.sound,
  apply pq_is_conj_pow_congr,
  assumption,
end⟩

instance conj_pq_has_one : has_one (conj_pq Q) := ⟨(⟦1⟧ : conj_pq Q)⟩

lemma conj_pq_rhd_def (a b : Q) : (⟦a⟧ ▷ ⟦b⟧ : conj_pq Q) = ⟦a ▷ b⟧ := rfl

lemma conj_pq_pow_def (a : Q) (n : ℤ) : (⟦a⟧ ^ n : conj_pq Q) = ⟦a ^ n⟧ := rfl

lemma conj_pq_one_def : (1 : conj_pq Q) = ⟦1⟧ := rfl

lemma quot_mk_helper_conj_pq (a : Q) : quot.mk setoid.r a = ⟦a⟧ := rfl

lemma pq_is_conj_refl_helper (a b : Q) (hab : a = b) : ⟦a⟧ = ⟦b⟧ :=
begin
  congr,
  assumption,
end

instance conj_pq_is_pq : power_quandle (conj_pq Q) := {
  rhd_dist := begin
    rintros ⟨a⟩ ⟨b⟩ ⟨c⟩,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def, conj_pq_pow_def, conj_pq_one_def],
    apply pq_is_conj_refl_helper,
    exact power_quandle.rhd_dist a b c,
  end,
  rhd_idem := begin
    rintros ⟨a⟩,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def, conj_pq_pow_def, conj_pq_one_def],
    apply pq_is_conj_refl_helper,
    exact power_quandle.rhd_idem a,
  end,
  pow_one := begin
    rintros ⟨a⟩,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def, conj_pq_pow_def, conj_pq_one_def],
    apply pq_is_conj_refl_helper,
    exact power_quandle.pow_one a,
  end,
  pow_zero := begin
    rintros ⟨a⟩,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def, conj_pq_pow_def, conj_pq_one_def],
    apply pq_is_conj_refl_helper,
    exact power_quandle.pow_zero a,
  end,
  pow_comp := begin
    rintros ⟨a⟩ n m,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def, conj_pq_pow_def, conj_pq_one_def],
    apply pq_is_conj_refl_helper,
    exact power_quandle.pow_comp a n m,
  end,
  rhd_one := begin
    rintros ⟨a⟩,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def, conj_pq_pow_def, conj_pq_one_def],
    apply pq_is_conj_refl_helper,
    exact power_quandle.rhd_one a,
  end,
  one_rhd := begin
    rintros ⟨a⟩,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def, conj_pq_pow_def, conj_pq_one_def],
    apply pq_is_conj_refl_helper,
    exact power_quandle.one_rhd a,
  end,
  pow_rhd := begin
    rintros ⟨a⟩ ⟨b⟩ n,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def, conj_pq_pow_def, conj_pq_one_def],
    apply pq_is_conj_refl_helper,
    exact power_quandle.pow_rhd a b n,
  end,
  rhd_pow_add := begin
    rintros ⟨a⟩ ⟨b⟩ n m,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def, conj_pq_pow_def, conj_pq_one_def],
    apply pq_is_conj_refl_helper,
    exact power_quandle.rhd_pow_add a b n m,
  end,
  ..conj_pq_has_rhd,
  ..conj_pq_has_pow,
  ..conj_pq_has_one }

lemma conj_pq_of_is_pq_morphism : is_pq_morphism (@conj_pq_of Q _) :=
begin
  split,
  {
    intros a b,
    refl,
  },
  {
    intros a n,
    refl,
  },
end

instance conj_pq_is_comm : comm_power_quandle (conj_pq Q) := {
  rhd_comm := begin
    rintros ⟨a⟩ ⟨b⟩,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def],
    apply quotient.sound,
    use ([a ^ (-1 : ℤ)] : list Q),
    simp only [list.foldl],
    rw ←power_quandle.pow_one a,
    rw power_quandle.pow_comp,
    norm_num,
    rw power_quandle.rhd_pow_add,
    norm_num,
    rw power_quandle.pow_zero,
    rw power_quandle.one_rhd,
  end }

variables {Q1 : Type*} [comm_power_quandle Q1]

def conj_pq_lift (f : Q → Q1) (hf : is_pq_morphism f) : conj_pq Q → Q1 := λ x, quotient.lift_on x (λ a, f a) begin
  intros a b hab,
  clear x,
  simp only,
  cases hab with x hx,
  rw hx,
  clear hx b,
  induction x generalizing a,
  {
    refl,
  },
  {
    simp only [list.foldl],
    rw ←x_ih,
    rw hf.1,
    rw comm_power_quandle.rhd_comm,
  },
end

lemma conj_pq_lift_is_pq_morphism (f : Q → Q1) (hf : is_pq_morphism f) : is_pq_morphism (conj_pq_lift f hf) :=
begin
  split,
  {
    rintros ⟨a⟩ ⟨b⟩,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_rhd_def],
    unfold conj_pq_lift,
    simp only [quotient.lift_on_beta],
    rw hf.1,
  },
  {
    rintros ⟨a⟩ n,
    simp only [quot_mk_helper_conj_pq],
    simp only [conj_pq_pow_def],
    unfold conj_pq_lift,
    simp only [quotient.lift_on_beta],
    rw hf.2,
  },
end

lemma conj_pq_lift_of (f : Q → Q1) (hf : is_pq_morphism f) (a : Q) : conj_pq_lift f hf (conj_pq_of a) = f a := rfl

end conj_pq


lemma or_symm (P Q : Prop) : (P ∨ Q) → (Q ∨ P) :=
begin
    intro pq,
    cases pq with p q,
    {
        right,
        exact p,
    },
    {
        left,
        exact q,
    },
end