import .nnf .dnf

variables {α β : Type}

open atom_type list

lemma exp_I_list_conj [atom_type α β] (xs : list β) : ∀ (ps : list (fm α)),
I (list_conj ps) xs = list.all_true (list.map (λ p, I p xs) ps)
| [] :=
  begin
    apply @eq.trans _ _ true, refl,
    apply eq.symm, rewrite eq_true,
    apply list.all_true_nil
  end
| (p::ps) :=
  begin
    unfold list_conj, simp,
    rewrite exp_I_and_o, unfold list.all_true,
    apply propext, apply iff.intro,
    intros H p Hp, cases Hp with Hp Hp,
    rewrite Hp, apply H^.elim_left,
    rewrite exp_I_list_conj at H,
    apply H^.elim_right, apply Hp,
    intro H, apply and.intro,
    apply H, apply or.inl (eq.refl _),
    rewrite exp_I_list_conj, intros q Hq,
    apply H, apply or.inr, apply Hq
  end

def qe_prsv (β : Type) [atom_type α β] (qe : list α → fm α) (as : list α) : Prop :=
  ∀ (bs : list β), ((I (qe as) bs) ↔ (∃ x, ∀ a ∈ as, (val (x::bs) a)))

/-
Requires : qe takes a list of atoms that are all dependent on 0-variable,
  and returns formula which (1) does not contain the 0-variable, and
  (2) is equivalent to the conjunction of input list.
-/
def qelim (β) [atom_type α β] (qe : list α → fm α) (as : list α) : fm α :=
  and_o
    (qe (@list.filter _ (dep0 β) (dec_dep0 _ _) as))
    (list_conj (list.map (λ (a : α), A' (decr β a)) (@list.filter _ (λ a, ¬ (dep0 β a))
      (begin
         intro a, cases (dec_dep0 _ _ a) with H H,
         apply decidable.is_true H,
         apply decidable.is_false (not_not_intro H)
       end) as)))

variable (nm : α → Prop)

lemma qelim_prsv [atom_type α β] {qe : list α → fm α}
  (hqe : ∀ as, (∀ a ∈ as, (dep0 β a)) → (∀ a ∈ as, normal β a) → qe_prsv β qe as)
  {as : list α} {hr : ∀ a ∈ as, normal β a} (bs : list β) :
  (I (qelim β qe as) bs) ↔ (∃ b, ∀ a ∈ as, val (b::bs) a) :=
begin
  apply iff.intro; intro h,

  unfold qelim at h,
  rewrite exp_I_and_o at h, cases h with h1 h2,
  rewrite hqe at h1, cases h1 with b h1,
  existsi b, intros a ha,
  cases (atom_type.dec_dep0 _ β a) with hd hd,
  rewrite exp_I_list_conj at h2,
  rewrite map_compose at h2,
  rewrite iff.symm (decr_prsv α β),
  apply h2, apply
  @list.mem_map_of_mem _ _ (λ (x : α), I (A' decr β x) bs) a _ _,
  apply mem_filter_of_mem,
  apply ha, apply hd,
  apply hd, apply h1,
  apply mem_filter_of_mem, apply ha,
  apply hd, intro a, apply of_mem_filter,
  apply forall_mem_filter_of_forall_mem,
  apply hr,

  cases h with b hb, unfold qelim,
  rewrite exp_I_and_o, apply and.intro,
  rewrite hqe, existsi b,
  apply forall_mem_filter_of_forall_mem,
  apply hb, intro a,
  apply of_mem_filter,
  apply forall_mem_filter_of_forall_mem,
  apply hr,
  rewrite exp_I_list_conj, intros p hp,
  cases (list.exists_of_mem_map hp) with q hq,
  clear hp, simp at hq, cases hq with hq1 hq2,
  subst hq2, cases hq1 with a h2, cases h2 with h2 h3,
  cases h2 with h2 h4, subst h3,
  unfold I, unfold interp, rewrite decr_prsv,
  apply hb _ h2, apply h4
end

lemma fnormal_conj_of_allp_fnormal [atom_type α β] :
  ∀ (ps : list (fm α)), (∀ p ∈ ps, fnormal β p) → fnormal β (list_conj ps)
| [] hnm := by unfold list_conj
| (p::ps) hnm :=
  begin
    unfold list_conj,
    apply cases_and_o, trivial,
    apply hnm, apply or.inl rfl,
    apply fnormal_conj_of_allp_fnormal,
    apply list.forall_mem_of_forall_mem_cons hnm,
    unfold fnormal, apply and.intro,
    apply hnm, apply or.inl rfl,
    apply fnormal_conj_of_allp_fnormal,
    apply list.forall_mem_of_forall_mem_cons  hnm
  end

lemma fnormal_disj_of_allp_fnormal [atom_type α β] :
  ∀ (ps : list (fm α)), (∀ p ∈ ps, fnormal β p) → fnormal β (list_disj ps)
| [] hnm := by unfold list_disj
| (p::ps) hnm :=
  begin
    unfold list_disj,
    apply cases_or_o, trivial,
    apply hnm, apply or.inl rfl,
    apply fnormal_disj_of_allp_fnormal,
    apply list.forall_mem_of_forall_mem_cons hnm,
    unfold fnormal, apply and.intro,
    apply hnm, apply or.inl rfl,
    apply fnormal_disj_of_allp_fnormal,
    apply list.forall_mem_of_forall_mem_cons hnm
  end

meta def qelim_prsv_normal_tac :=
`[apply fnormal_conj_of_allp_fnormal,
  intros p hp, rewrite list.mem_map at hp,
  cases hp with a ha, cases ha with ha1 ha2,
  subst ha2, apply atom_type.decr_prsv_normal,
  apply hnm, apply list.mem_of_mem_filter ha1,
  apply list.of_mem_filter ha1]

lemma qelim_prsv_normal [atom_type α β] {qe : list α → fm α}
  {hqe : ∀ (as : list α), (∀ a ∈ as, dep0 β a) → (∀ a ∈ as, normal β a) → fnormal β (qe as)}
  {as : list α} (hnm : (∀ a ∈ as, normal β a)) :
  fnormal β (qelim β qe as) :=
begin
  unfold qelim, apply cases_and_o,
  trivial, apply hqe, intro a,
  apply list.of_mem_filter,
  apply list.forall_mem_filter_of_forall_mem hnm,
  qelim_prsv_normal_tac,
  unfold fnormal, apply and.intro,
  apply hqe, intro as,
  apply list.of_mem_filter,
  apply list.forall_mem_filter_of_forall_mem hnm,
  qelim_prsv_normal_tac
end

def lift_dnf_qe (β : Type) [atom_type α β] (qe : list α → fm α) : fm α → fm α
| (fm.true α) := ⊤'
| (fm.false α) := ⊥'
| (fm.atom a) := A' a
| (fm.and p q) := (lift_dnf_qe p) ∧' (lift_dnf_qe q)
| (fm.or p q) := (lift_dnf_qe p) ∨' (lift_dnf_qe q)
| (fm.not p) := ¬' (lift_dnf_qe p)
| (fm.ex p) := dnf_to_fm (dnf (@nnf _ β _ $ lift_dnf_qe p)) (@qelim _ β _ @qe)

lemma atoms_conj_qfree [atom_type α β] : ∀ (as : list α), qfree (list_conj (list.map (λ (a : α), A' decr β a) as ))
| [] := trivial
| (a::as) :=
  begin
    unfold list.map, unfold list_conj,
    apply cases_and_o, trivial, trivial,
    apply atoms_conj_qfree, unfold qfree,
    apply and.intro trivial,
    apply atoms_conj_qfree
  end

meta def ldq_normal_tac :=
`[unfold fnormal at hnm, cases hnm with hnmp hnmq,
  unfold lift_dnf_qe, unfold fnormal,
  apply and.intro; apply ldq_normal; assumption]

lemma ldq_normal [atom_type α β] (qe : list α → fm α)
  (hqe : ∀ (as : list α), (∀ a ∈ as, dep0 β a) → (∀ a ∈ as, normal β a) → fnormal β (qe as)) :
  ∀ p, fnormal β p → fnormal β (lift_dnf_qe β qe p)
| (fm.true α) hnm := trivial
| (fm.false α) hnm := trivial
| (fm.atom a) hnm := hnm
| (fm.and p q) hnm := by ldq_normal_tac
| (fm.or p q) hnm := by ldq_normal_tac
| (fm.not p) hnm :=
  begin
    unfold lift_dnf_qe, unfold fnormal,
    apply ldq_normal, apply hnm
  end
| (fm.ex p) hnm :=
  begin
    unfold lift_dnf_qe, unfold dnf_to_fm,
    apply fnormal_disj_of_allp_fnormal,
    intros a ha, rewrite list.mem_map at ha,
    cases ha with as has, cases has with has1 has2,
    subst has2, apply qelim_prsv_normal, apply hqe,
    apply dnf_prsv_normal, apply nnf_prsv_normal,
    apply ldq_normal, unfold fnormal at hnm, apply hnm,
    apply has1
  end

lemma ldq_qfree [atom_type α β] (qe : list α → fm α)
  (H : ∀ (l : list α), allp (dep0 β) l → qfree (qe l)) :
  ∀ (p : fm α), qfree (lift_dnf_qe β qe p)
| (fm.true α) := trivial
| (fm.false α) := trivial
| (fm.atom a) := trivial
| (fm.and p q) :=
  by {apply and.intro, apply ldq_qfree, apply ldq_qfree}
| (fm.or p q) :=
  by {apply and.intro, apply ldq_qfree, apply ldq_qfree}
| (fm.not p) :=
  by {unfold lift_dnf_qe, apply ldq_qfree}
| (fm.ex p) :=
  begin
    unfold lift_dnf_qe, apply qfree_dnf_to_fm,
    unfold qelim, intro l,
    apply cases_and_o qfree, trivial, apply H,
    unfold allp, intro a, apply of_mem_filter,
    apply atoms_conj_qfree,
    unfold qfree, apply and.intro, apply H,
    unfold allp, intro a, apply of_mem_filter,
    apply atoms_conj_qfree
  end

lemma I_list_disj [atom_type α β] (xs : list β) :
  ∀ (ps : list (fm α)), I (list_disj ps) xs ↔ some_true (list.map (λ p, I p xs) ps)
| [] :=
  begin
    unfold list_disj, unfold map, unfold I,
    unfold interp, rewrite some_true_nil
  end
| (p::ps) :=
  begin
    unfold list_disj, rewrite exp_I_or_o,
    unfold map, rewrite some_true_cons,
    rewrite I_list_disj
  end

lemma dist_ex_or (P Q : α → Prop) : (∃ x, (P x ∨ Q x)) ↔ ((∃ x, P x) ∨ (∃ x, Q x)) :=
begin
  apply iff.intro, intro H, cases H with x Hx, cases Hx with Hx Hx,
  apply or.inl, existsi x, apply Hx,
  apply or.inr, existsi x, apply Hx,
  intro H, cases H with H H,
  cases H with x Hx, existsi x, apply (or.inl Hx),
  cases H with x Hx, existsi x, apply (or.inr Hx)
end

/-
lemma ex_some_true [atom_type α β] : ∀ (Ps : list (β → Prop)),
  (∃ (x : β), some_true (list.map (λ (P : β → Prop), P x) Ps))
  ↔ (some_true (list.map Exists Ps))
| [] :=
  begin
    apply iff.intro; intro h, cases h with x hx,
    cases hx with p hp, unfold map at hp, cases hp^.elim_left,
    cases h with p hp, unfold map at hp, cases hp^.elim_left,
  end
| (P::Ps) :=
  begin
    unfold map, apply iff.intro; intro h,

    cases h with x hx, cases hx with q hq,
    cases hq with hm hq, rewrite mem_cons_iff at hm,
    cases hm with hm hm, subst hm,
    constructor, apply and.intro, apply or.inl rfl,
    existsi x, apply hq,
    rewrite (@mem_map _ _ (λ (P : β → Prop), P x) q Ps) at hm,
    cases hm with Q hQ, cases hQ with hQ1 hQ2, subst hQ2,
    existsi (Exists Q), apply and.intro,
    apply mem_cons_of_mem,
    rewrite @mem_map _ _ Exists,
    existsi Q; simp, apply hQ1, existsi x, apply hq,

  end
-/

instance atom_type_to_dec_eq [atom_type α β] : decidable_eq α := atom_type.dec_eq α β

lemma ldq_prsv_gen_ex [atom_type α β]
(qe : list α → fm α)
(hqep : ∀ (as : list α), allp (dep0 β) as → allp (normal β) as → qe_prsv β qe as)
(p : fm α) (hpn : fnormal β p) (hpnq : nqfree p) (bs : list β) :
  some_true (list.map (λ (x : list α), I (qelim β qe x) bs) (dnf p))
  ↔ ∃ (b : β), I p (b :: bs) :=
begin
  apply iff.intro; intro h,

  cases h with q hq, cases hq with hq1 hq2,
  cases (list.exists_of_mem_map hq1) with as has,
  cases has with has1 has2, simp at has2,
  subst has2,
  rewrite (@qelim_prsv α β) at hq2,
  cases hq2 with b hb, existsi b,
  rewrite iff.symm (dnf_prsv _),
  existsi (allp (val (b :: bs)) as),
  apply and.intro,
  apply list.mem_map_of_mem, apply has1,
  apply hb, apply hpnq, apply hqep,
  apply dnf_prsv_normal,
  apply hpn,

  apply has1, cases h with b hb,
  rewrite iff.symm (dnf_prsv _) at hb,
  cases hb with q hq, cases hq with hq1 hq2,
  cases (list.exists_of_mem_map hq1) with as has,
  cases has with has1 has2, subst has2,
  existsi (I (qelim β qe as) bs),
  apply and.intro,
  apply list.mem_map_of_mem  (λ (x : list α), I (qelim β qe x) bs),
  apply has1, rewrite (@qelim_prsv _ β),
  existsi b, apply hq2, apply hqep,
  apply dnf_prsv_normal,
  apply hpn, apply has1, apply hpnq
end

meta def ldq_prsv_core_aux :=
`[repeat {rewrite ldq_prsv_gen},
  intros a ha,
  apply hp, unfold atoms,
  apply mem_union_right, apply ha,
  intros a ha,
  apply hp, unfold atoms,
  apply mem_union_left, apply ha]

lemma ldq_prsv_gen [atom_type α β]
  (qe : list α → fm α)
  (hqef : ∀ as, allp (dep0 β) as → qfree (qe as))
  (hqen : ∀ as, allp (dep0 β) as → allp (normal β) as → fnormal β (qe as))
  (hqep : ∀ as, allp (dep0 β) as → allp (normal β) as → qe_prsv β qe as) :
  ∀ p, fnormal β p → ∀ (bs : list β), I (lift_dnf_qe β qe p) bs ↔ I p bs
| ⊤' _ bs := iff.refl _
| ⊥' _ bs := iff.refl _
| (A' a) hp bs := iff.refl _
| (p ∧' q) hp bs :=
  begin
    cases hp with hp1 hp2,
    unfold lift_dnf_qe,
    repeat {rewrite exp_I_and},
    repeat {rewrite ldq_prsv_gen},
    apply hp2, apply hp1
  end
| (p ∨' q) hp bs :=
  begin
    cases hp with hp1 hp2,
    unfold lift_dnf_qe,
    repeat {rewrite exp_I_or},
    repeat {rewrite ldq_prsv_gen},
    apply hp2, apply hp1
  end
| (¬' p) hp bs :=
  begin
    unfold lift_dnf_qe,
    repeat {rewrite exp_I_not},
    repeat {rewrite ldq_prsv_gen},
    apply hp
  end
| (∃' p) hp bs :=
  calc
        I (lift_dnf_qe β qe (∃' p)) bs
      ↔ ∃ (b : β), I (nnf β (lift_dnf_qe β qe p)) (b :: bs) :
        begin
          unfold lift_dnf_qe, unfold dnf_to_fm,
          rewrite I_list_disj,
          rewrite map_compose, apply
          (@ldq_prsv_gen_ex α β), apply hqep,
          apply nnf_prsv_normal, apply ldq_normal,
          apply hqen, apply hp, apply nnf_nqfree,
          apply ldq_qfree, apply hqef
        end
  ... ↔ I (∃' p) bs :
        begin
          rewrite exp_I_ex, apply ex_iff_ex,
          intro b, rewrite nnf_prsv,
          rewrite ldq_prsv_gen, apply hp,
          apply ldq_qfree, apply hqef
        end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import linear_algebra.general_linear_group
import linear_algebra.matrix.reindex
import tactic.field_simp
import linear_algebra.matrix.nonsingular_inverse
import linear_algebra.matrix.basis

/-!
# Determinant of families of vectors

This file defines the determinant of an endomorphism, and of a family of vectors
with respect to some basis. For the determinant of a matrix, see the file
`linear_algebra.matrix.determinant`.

## Main definitions

In the list below, and in all this file, `R` is a commutative ring (semiring
is sometimes enough), `M` and its variations are `R`-modules, `ι`, `κ`, `n` and `m` are finite
types used for indexing.

 * `basis.det`: the determinant of a family of vectors with respect to a basis,
   as a multilinear map
 * `linear_map.det`: the determinant of an endomorphism `f : End R M` as a
   multiplicative homomorphism (if `M` does not have a finite `R`-basis, the
   result is `1` instead)
 * `linear_equiv.det`: the determinant of an isomorphism `f : M ≃ₗ[R] M` as a
   multiplicative homomorphism (if `M` does not have a finite `R`-basis, the
   result is `1` instead)

## Tags

basis, det, determinant
-/

noncomputable theory

open_locale big_operators
open_locale matrix

open linear_map
open submodule

universes u v w

open linear_map matrix set function

variables {R : Type*} [comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {M' : Type*} [add_comm_group M'] [module R M']
variables {ι : Type*} [decidable_eq ι] [fintype ι]
variables (e : basis ι R M)

section conjugate

variables {A : Type*} [comm_ring A]
variables {m n : Type*} [fintype m] [fintype n]

/-- If `R^m` and `R^n` are linearly equivalent, then `m` and `n` are also equivalent. -/
def equiv_of_pi_lequiv_pi {R : Type*} [comm_ring R] [nontrivial R]
  (e : (m → R) ≃ₗ[R] (n → R)) : m ≃ n :=
basis.index_equiv (basis.of_equiv_fun e.symm) (pi.basis_fun _ _)

namespace matrix

/-- If `M` and `M'` are each other's inverse matrices, they are square matrices up to
equivalence of types. -/
def index_equiv_of_inv [nontrivial A] [decidable_eq m] [decidable_eq n]
  {M : matrix m n A} {M' : matrix n m A}
  (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) :
  m ≃ n :=
equiv_of_pi_lequiv_pi (to_lin'_of_inv hMM' hM'M)

lemma det_comm [decidable_eq n] (M N : matrix n n A) : det (M ⬝ N) = det (N ⬝ M) :=
by rw [det_mul, det_mul, mul_comm]

/-- If there exists a two-sided inverse `M'` for `M` (indexed differently),
then `det (N ⬝ M) = det (M ⬝ N)`. -/
lemma det_comm' [decidable_eq m] [decidable_eq n]
  {M : matrix n m A} {N : matrix m n A} {M' : matrix m n A}
  (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) :
  det (M ⬝ N) = det (N ⬝ M) :=
begin
  nontriviality A,
  -- Although `m` and `n` are different a priori, we will show they have the same cardinality.
  -- This turns the problem into one for square matrices, which is easy.
  let e := index_equiv_of_inv hMM' hM'M,
  rw [← det_submatrix_equiv_self e, ← submatrix_mul_equiv _ _ _ (equiv.refl n) _, det_comm,
    submatrix_mul_equiv, equiv.coe_refl, submatrix_id_id]
end

/-- If `M'` is a two-sided inverse for `M` (indexed differently), `det (M ⬝ N ⬝ M') = det N`.

See `matrix.det_conj` and `matrix.det_conj'` for the case when `M' = M⁻¹` or vice versa. -/
lemma det_conj_of_mul_eq_one [decidable_eq m] [decidable_eq n]
  {M : matrix m n A} {M' : matrix n m A} {N : matrix n n A}
  (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) :
  det (M ⬝ N ⬝ M') = det N :=
by rw [← det_comm' hM'M hMM', ← matrix.mul_assoc, hM'M, matrix.one_mul]

end matrix

end conjugate

namespace linear_map

/-! ### Determinant of a linear map -/

variables {A : Type*} [comm_ring A] [module A M]
variables {κ : Type*} [fintype κ]

/-- The determinant of `linear_map.to_matrix` does not depend on the choice of basis. -/
lemma det_to_matrix_eq_det_to_matrix [decidable_eq κ]
  (b : basis ι A M) (c : basis κ A M) (f : M →ₗ[A] M) :
  det (linear_map.to_matrix b b f) = det (linear_map.to_matrix c c f) :=
by rw [← linear_map_to_matrix_mul_basis_to_matrix c b c,
       ← basis_to_matrix_mul_linear_map_to_matrix b c b,
       matrix.det_conj_of_mul_eq_one]; rw [basis.to_matrix_mul_to_matrix, basis.to_matrix_self]

/-- The determinant of an endomorphism given a basis.

See `linear_map.det` for a version that populates the basis non-computably.

Although the `trunc (basis ι A M)` parameter makes it slightly more convenient to switch bases,
there is no good way to generalize over universe parameters, so we can't fully state in `det_aux`'s
type that it does not depend on the choice of basis. Instead you can use the `det_aux_def'` lemma,
or avoid mentioning a basis at all using `linear_map.det`.
-/
@[irreducible] def det_aux : trunc (basis ι A M) → (M →ₗ[A] M) →* A :=
trunc.lift
  (λ b : basis ι A M,
    (det_monoid_hom).comp (to_matrix_alg_equiv b : (M →ₗ[A] M) →* matrix ι ι A))
  (λ b c, monoid_hom.ext $ det_to_matrix_eq_det_to_matrix b c)

/-- Unfold lemma for `det_aux`.

See also `det_aux_def'` which allows you to vary the basis.
-/
lemma det_aux_def (b : basis ι A M) (f : M →ₗ[A] M) :
  linear_map.det_aux (trunc.mk b) f = matrix.det (linear_map.to_matrix b b f) :=
by  { rw [det_aux], refl }

lemma det_aux_def' {ι' : Type*} [fintype ι'] [decidable_eq ι']
  (tb : trunc $ basis ι A M) (b' : basis ι' A M) (f : M →ₗ[A] M) :
  linear_map.det_aux tb f = matrix.det (linear_map.to_matrix b' b' f) :=
by { apply trunc.induction_on tb, intro b, rw [det_aux_def, det_to_matrix_eq_det_to_matrix b b'] }

@[simp]
lemma det_aux_id (b : trunc $ basis ι A M) : linear_map.det_aux b (linear_map.id) = 1 :=
(linear_map.det_aux b).map_one

@[simp]
lemma det_aux_comp (b : trunc $ basis ι A M) (f g : M →ₗ[A] M) :
  linear_map.det_aux b (f.comp g) = linear_map.det_aux b f * linear_map.det_aux b g :=
(linear_map.det_aux b).map_mul f g

section
open_locale classical

-- Discourage the elaborator from unfolding `det` and producing a huge term by marking it
-- as irreducible.
/-- The determinant of an endomorphism independent of basis.

If there is no finite basis on `M`, the result is `1` instead.
-/
@[irreducible] protected def det : (M →ₗ[A] M) →* A :=
if H : ∃ (s : finset M), nonempty (basis s A M)
then linear_map.det_aux (trunc.mk H.some_spec.some)
else 1

lemma coe_det [decidable_eq M] : ⇑(linear_map.det : (M →ₗ[A] M) →* A) =
  if H : ∃ (s : finset M), nonempty (basis s A M)
  then linear_map.det_aux (trunc.mk H.some_spec.some)
  else 1 :=
by { ext, unfold linear_map.det,
     split_ifs,
     { congr }, -- use the correct `decidable_eq` instance
     refl }

end

-- Auxiliary lemma, the `simp` normal form goes in the other direction
-- (using `linear_map.det_to_matrix`)
lemma det_eq_det_to_matrix_of_finset [decidable_eq M]
  {s : finset M} (b : basis s A M) (f : M →ₗ[A] M) :
  f.det = matrix.det (linear_map.to_matrix b b f) :=
have ∃ (s : finset M), nonempty (basis s A M),
from ⟨s, ⟨b⟩⟩,
by rw [linear_map.coe_det, dif_pos, det_aux_def' _ b]; assumption

@[simp] lemma det_to_matrix
  (b : basis ι A M) (f : M →ₗ[A] M) :
  matrix.det (to_matrix b b f) = f.det :=
by { haveI := classical.dec_eq M,
     rw [det_eq_det_to_matrix_of_finset b.reindex_finset_range, det_to_matrix_eq_det_to_matrix b] }

@[simp] lemma det_to_matrix' {ι : Type*} [fintype ι] [decidable_eq ι]
  (f : (ι → A) →ₗ[A] (ι → A)) :
  det f.to_matrix' = f.det :=
by simp [← to_matrix_eq_to_matrix']

@[simp] lemma det_to_lin (b : basis ι R M) (f : matrix ι ι R) :
  linear_map.det (matrix.to_lin b b f) = f.det :=
by rw [← linear_map.det_to_matrix b, linear_map.to_matrix_to_lin]

@[simp] lemma det_to_lin' (f : matrix ι ι R) :
  linear_map.det (f.to_lin') = f.det :=
by simp only [← to_lin_eq_to_lin', det_to_lin]

/-- To show `P f.det` it suffices to consider `P (to_matrix _ _ f).det` and `P 1`. -/
@[elab_as_eliminator]
lemma det_cases [decidable_eq M] {P : A → Prop} (f : M →ₗ[A] M)
  (hb : ∀ (s : finset M) (b : basis s A M), P (to_matrix b b f).det) (h1 : P 1) :
  P f.det :=
begin
  unfold linear_map.det,
  split_ifs with h,
  { convert hb _ h.some_spec.some,
    apply det_aux_def' },
  { exact h1 }
end

@[simp]
lemma det_comp (f g : M →ₗ[A] M) : (f.comp g).det = f.det * g.det :=
linear_map.det.map_mul f g

@[simp]
lemma det_id : (linear_map.id : M →ₗ[A] M).det = 1 :=
linear_map.det.map_one

/-- Multiplying a map by a scalar `c` multiplies its determinant by `c ^ dim M`. -/
@[simp] lemma det_smul {𝕜 : Type*} [field 𝕜] {M : Type*} [add_comm_group M] [module 𝕜 M]
  (c : 𝕜) (f : M →ₗ[𝕜] M) :
  linear_map.det (c • f) = c ^ (finite_dimensional.finrank 𝕜 M) * linear_map.det f :=
begin
  by_cases H : ∃ (s : finset M), nonempty (basis s 𝕜 M),
  { haveI : finite_dimensional 𝕜 M,
    { rcases H with ⟨s, ⟨hs⟩⟩, exact finite_dimensional.of_fintype_basis hs },
    simp only [← det_to_matrix (finite_dimensional.fin_basis 𝕜 M), linear_equiv.map_smul,
              fintype.card_fin, det_smul] },
  { classical,
    have : finite_dimensional.finrank 𝕜 M = 0 := finrank_eq_zero_of_not_exists_basis H,
    simp [coe_det, H, this] }
end

lemma det_zero' {ι : Type*} [finite ι] [nonempty ι] (b : basis ι A M) :
  linear_map.det (0 : M →ₗ[A] M) = 0 :=
by { haveI := classical.dec_eq ι, casesI nonempty_fintype ι,
     rwa [← det_to_matrix b, linear_equiv.map_zero, det_zero] }

/-- In a finite-dimensional vector space, the zero map has determinant `1` in dimension `0`,
and `0` otherwise. We give a formula that also works in infinite dimension, where we define
the determinant to be `1`. -/
@[simp] lemma det_zero {𝕜 : Type*} [field 𝕜] {M : Type*} [add_comm_group M] [module 𝕜 M] :
  linear_map.det (0 : M →ₗ[𝕜] M) = (0 : 𝕜) ^ (finite_dimensional.finrank 𝕜 M) :=
by simp only [← zero_smul 𝕜 (1 : M →ₗ[𝕜] M), det_smul, mul_one, monoid_hom.map_one]

lemma det_eq_one_of_subsingleton [subsingleton M] (f : M →ₗ[R] M) : (f : M →ₗ[R] M).det = 1 :=
begin
  have b : basis (fin 0) R M := basis.empty M,
  rw ← f.det_to_matrix b,
  exact matrix.det_is_empty,
end

lemma det_eq_one_of_finrank_eq_zero {𝕜 : Type*} [field 𝕜] {M : Type*} [add_comm_group M]
  [module 𝕜 M] (h : finite_dimensional.finrank 𝕜 M = 0) (f : M →ₗ[𝕜] M) :
  (f : M →ₗ[𝕜] M).det = 1 :=
begin
  classical,
  refine @linear_map.det_cases M  _ 𝕜 _ _ _ (λ t, t = 1) f _ rfl,
  intros s b,
  haveI : is_empty s,
  { rw ← fintype.card_eq_zero_iff,
    exact (finite_dimensional.finrank_eq_card_basis b).symm.trans h },
  exact matrix.det_is_empty
end

/-- Conjugating a linear map by a linear equiv does not change its determinant. -/
@[simp] lemma det_conj {N : Type*} [add_comm_group N] [module A N]
  (f : M →ₗ[A] M) (e : M ≃ₗ[A] N) :
  linear_map.det ((e : M →ₗ[A] N) ∘ₗ (f ∘ₗ (e.symm : N →ₗ[A] M))) = linear_map.det f :=
begin
  classical,
  by_cases H : ∃ (s : finset M), nonempty (basis s A M),
  { rcases H with ⟨s, ⟨b⟩⟩,
    rw [← det_to_matrix b f, ← det_to_matrix (b.map e), to_matrix_comp (b.map e) b (b.map e),
        to_matrix_comp (b.map e) b b, ← matrix.mul_assoc, matrix.det_conj_of_mul_eq_one],
    { rw [← to_matrix_comp, linear_equiv.comp_coe, e.symm_trans_self,
          linear_equiv.refl_to_linear_map, to_matrix_id] },
    { rw [← to_matrix_comp, linear_equiv.comp_coe, e.self_trans_symm,
          linear_equiv.refl_to_linear_map, to_matrix_id] } },
  { have H' : ¬ (∃ (t : finset N), nonempty (basis t A N)),
    { contrapose! H,
      rcases H with ⟨s, ⟨b⟩⟩,
      exact ⟨_, ⟨(b.map e.symm).reindex_finset_range⟩⟩ },
    simp only [coe_det, H, H', pi.one_apply, dif_neg, not_false_iff] }
end

/-- If a linear map is invertible, so is its determinant. -/
lemma is_unit_det {A : Type*} [comm_ring A] [module A M]
  (f : M →ₗ[A] M) (hf : is_unit f) : is_unit f.det :=
begin
  obtain ⟨g, hg⟩ : ∃ g, f.comp g = 1 := hf.exists_right_inv,
  have : linear_map.det f * linear_map.det g = 1,
    by simp only [← linear_map.det_comp, hg, monoid_hom.map_one],
  exact is_unit_of_mul_eq_one _ _ this,
end

/-- If a linear map has determinant different from `1`, then the space is finite-dimensional. -/

/-- If the determinant of a map vanishes, then the map is not onto. -/
lemma range_lt_top_of_det_eq_zero {𝕜 : Type*} [field 𝕜] [module 𝕜 M]
  {f : M →ₗ[𝕜] M} (hf : f.det = 0) : f.range < ⊤ :=
begin
  haveI : finite_dimensional 𝕜 M, by simp [f.finite_dimensional_of_det_ne_one, hf],
  contrapose hf,
  simp only [lt_top_iff_ne_top, not_not, ← is_unit_iff_range_eq_top] at hf,
  exact is_unit_iff_ne_zero.1 (f.is_unit_det hf)
end

/-- If the determinant of a map vanishes, then the map is not injective. -/
lemma bot_lt_ker_of_det_eq_zero {𝕜 : Type*} [field 𝕜] [module 𝕜 M]
  {f : M →ₗ[𝕜] M} (hf : f.det = 0) : ⊥ < f.ker :=
begin
  haveI : finite_dimensional 𝕜 M, by simp [f.finite_dimensional_of_det_ne_one, hf],
  contrapose hf,
  simp only [bot_lt_iff_ne_bot, not_not, ← is_unit_iff_ker_eq_bot] at hf,
  exact is_unit_iff_ne_zero.1 (f.is_unit_det hf)
end

end linear_map

namespace linear_equiv

/-- On a `linear_equiv`, the domain of `linear_map.det` can be promoted to `Rˣ`. -/
protected def det : (M ≃ₗ[R] M) →* Rˣ :=
(units.map (linear_map.det : (M →ₗ[R] M) →* R)).comp
  (linear_map.general_linear_group.general_linear_equiv R M).symm.to_monoid_hom

@[simp] lemma coe_det (f : M ≃ₗ[R] M) : ↑f.det = linear_map.det (f : M →ₗ[R] M) := rfl
@[simp] lemma coe_inv_det (f : M ≃ₗ[R] M) : ↑(f.det⁻¹) = linear_map.det (f.symm : M →ₗ[R] M) := rfl

@[simp] lemma det_refl : (linear_equiv.refl R M).det = 1 := units.ext $ linear_map.det_id

@[simp] lemma det_trans (f g : M ≃ₗ[R] M) : (f.trans g).det = g.det * f.det := map_mul _ g f

@[simp] lemma det_symm (f : M ≃ₗ[R] M) : f.symm.det = f.det⁻¹ := map_inv _ f

/-- Conjugating a linear equiv by a linear equiv does not change its determinant. -/
@[simp] lemma det_conj (f : M ≃ₗ[R] M) (e : M ≃ₗ[R] M') :
  ((e.symm.trans f).trans e).det = f.det :=
by rw [←units.eq_iff, coe_det, coe_det, ←comp_coe, ←comp_coe, linear_map.det_conj]

end linear_equiv

/-- The determinants of a `linear_equiv` and its inverse multiply to 1. -/
@[simp] lemma linear_equiv.det_mul_det_symm {A : Type*} [comm_ring A] [module A M]
  (f : M ≃ₗ[A] M) : (f : M →ₗ[A] M).det * (f.symm : M →ₗ[A] M).det = 1 :=
by simp [←linear_map.det_comp]

/-- The determinants of a `linear_equiv` and its inverse multiply to 1. -/
@[simp] lemma linear_equiv.det_symm_mul_det {A : Type*} [comm_ring A] [module A M]
  (f : M ≃ₗ[A] M) : (f.symm : M →ₗ[A] M).det * (f : M →ₗ[A] M).det = 1 :=
by simp [←linear_map.det_comp]

-- Cannot be stated using `linear_map.det` because `f` is not an endomorphism.
lemma linear_equiv.is_unit_det (f : M ≃ₗ[R] M') (v : basis ι R M) (v' : basis ι R M') :
  is_unit (linear_map.to_matrix v v' f).det :=
begin
  apply is_unit_det_of_left_inverse,
  simpa using (linear_map.to_matrix_comp v v' v f.symm f).symm
end

/-- Specialization of `linear_equiv.is_unit_det` -/
lemma linear_equiv.is_unit_det' {A : Type*} [comm_ring A] [module A M]
  (f : M ≃ₗ[A] M) : is_unit (linear_map.det (f : M →ₗ[A] M)) :=
is_unit_of_mul_eq_one _ _ f.det_mul_det_symm

/-- The determinant of `f.symm` is the inverse of that of `f` when `f` is a linear equiv. -/
lemma linear_equiv.det_coe_symm {𝕜 : Type*} [field 𝕜] [module 𝕜 M]
  (f : M ≃ₗ[𝕜] M) : (f.symm : M →ₗ[𝕜] M).det = (f : M →ₗ[𝕜] M).det ⁻¹ :=
by field_simp [is_unit.ne_zero f.is_unit_det']

/-- Builds a linear equivalence from a linear map whose determinant in some bases is a unit. -/
@[simps]
def linear_equiv.of_is_unit_det {f : M →ₗ[R] M'} {v : basis ι R M} {v' : basis ι R M'}
  (h : is_unit (linear_map.to_matrix v v' f).det) : M ≃ₗ[R] M' :=
{ to_fun := f,
  map_add' := f.map_add,
  map_smul' := f.map_smul,
  inv_fun := to_lin v' v (to_matrix v v' f)⁻¹,
  left_inv := λ x,
    calc to_lin v' v (to_matrix v v' f)⁻¹ (f x)
        = to_lin v v ((to_matrix v v' f)⁻¹ ⬝ to_matrix v v' f) x :
      by { rw [to_lin_mul v v' v, to_lin_to_matrix, linear_map.comp_apply] }
    ... = x : by simp [h],
  right_inv := λ x,
    calc f (to_lin v' v (to_matrix v v' f)⁻¹ x)
        = to_lin v' v' (to_matrix v v' f ⬝ (to_matrix v v' f)⁻¹) x :
      by { rw [to_lin_mul v' v v', linear_map.comp_apply, to_lin_to_matrix v v'] }
    ... = x : by simp [h] }

@[simp] lemma linear_equiv.coe_of_is_unit_det {f : M →ₗ[R] M'} {v : basis ι R M} {v' : basis ι R M'}
  (h : is_unit (linear_map.to_matrix v v' f).det) :
  (linear_equiv.of_is_unit_det h : M →ₗ[R] M') = f :=
by { ext x, refl }

/-- Builds a linear equivalence from a linear map on a finite-dimensional vector space whose
determinant is nonzero. -/
@[reducible] def linear_map.equiv_of_det_ne_zero
  {𝕜 : Type*} [field 𝕜] {M : Type*} [add_comm_group M] [module 𝕜 M]
  [finite_dimensional 𝕜 M] (f : M →ₗ[𝕜] M) (hf : linear_map.det f ≠ 0) :
  M ≃ₗ[𝕜] M :=
have is_unit (linear_map.to_matrix (finite_dimensional.fin_basis 𝕜 M)
  (finite_dimensional.fin_basis 𝕜 M) f).det :=
    by simp only [linear_map.det_to_matrix, is_unit_iff_ne_zero.2 hf],
linear_equiv.of_is_unit_det this

lemma linear_map.associated_det_of_eq_comp (e : M ≃ₗ[R] M) (f f' : M →ₗ[R] M)
  (h : ∀ x, f x = f' (e x)) : associated f.det f'.det :=
begin
  suffices : associated (f' ∘ₗ ↑e).det f'.det,
  { convert this using 2, ext x, exact h x },
  rw [← mul_one f'.det, linear_map.det_comp],
  exact associated.mul_left _ (associated_one_iff_is_unit.mpr e.is_unit_det')
end

lemma linear_map.associated_det_comp_equiv {N : Type*} [add_comm_group N] [module R N]
  (f : N →ₗ[R] M) (e e' : M ≃ₗ[R] N) :
  associated (f ∘ₗ ↑e).det (f ∘ₗ ↑e').det :=
begin
  refine linear_map.associated_det_of_eq_comp (e.trans e'.symm) _ _ _,
  intro x,
  simp only [linear_map.comp_apply, linear_equiv.coe_coe, linear_equiv.trans_apply,
             linear_equiv.apply_symm_apply],
end

/-- The determinant of a family of vectors with respect to some basis, as an alternating
multilinear map. -/
def basis.det : alternating_map R M R ι :=
{ to_fun := λ v, det (e.to_matrix v),
  map_add' := begin
    intros inst v i x y,
    cases subsingleton.elim inst ‹_›,
    simp only [e.to_matrix_update, linear_equiv.map_add, finsupp.coe_add],
    exact det_update_column_add _ _ _ _,
  end,
  map_smul' := begin
    intros inst u i c x,
    cases subsingleton.elim inst ‹_›,
    simp only [e.to_matrix_update, algebra.id.smul_eq_mul, linear_equiv.map_smul],
    apply det_update_column_smul
  end,
  map_eq_zero_of_eq' := begin
    intros v i j h hij,
    rw [←function.update_eq_self i v, h, ←det_transpose, e.to_matrix_update,
        ←update_row_transpose, ←e.to_matrix_transpose_apply],
    apply det_zero_of_row_eq hij,
    rw [update_row_ne hij.symm, update_row_self],
  end }

lemma basis.det_apply (v : ι → M) : e.det v = det (e.to_matrix v) := rfl

lemma basis.det_self : e.det e = 1 :=
by simp [e.det_apply]

@[simp] lemma basis.det_is_empty [is_empty ι] : e.det = alternating_map.const_of_is_empty R M 1 :=
begin
  ext v,
  exact matrix.det_is_empty,
end

/-- `basis.det` is not the zero map. -/
lemma basis.det_ne_zero [nontrivial R] : e.det ≠ 0 :=
λ h, by simpa [h] using e.det_self

lemma is_basis_iff_det {v : ι → M} :
  linear_independent R v ∧ span R (set.range v) = ⊤ ↔ is_unit (e.det v) :=
begin
  split,
  { rintro ⟨hli, hspan⟩,
    set v' := basis.mk hli hspan.ge with v'_eq,
    rw e.det_apply,
    convert linear_equiv.is_unit_det (linear_equiv.refl _ _) v' e using 2,
    ext i j,
    simp },
  { intro h,
    rw [basis.det_apply, basis.to_matrix_eq_to_matrix_constr] at h,
    set v' := basis.map e (linear_equiv.of_is_unit_det h) with v'_def,
    have : ⇑ v' = v,
    { ext i, rw [v'_def, basis.map_apply, linear_equiv.of_is_unit_det_apply, e.constr_basis] },
    rw ← this,
    exact ⟨v'.linear_independent, v'.span_eq⟩ },
end

lemma basis.is_unit_det (e' : basis ι R M) : is_unit (e.det e') :=
(is_basis_iff_det e).mp ⟨e'.linear_independent, e'.span_eq⟩

/-- Any alternating map to `R` where `ι` has the cardinality of a basis equals the determinant
map with respect to that basis, multiplied by the value of that alternating map on that basis. -/
lemma alternating_map.eq_smul_basis_det (f : alternating_map R M R ι) : f = f e • e.det :=
begin
  refine basis.ext_alternating e (λ i h, _),
  let σ : equiv.perm ι := equiv.of_bijective i (finite.injective_iff_bijective.1 h),
  change f (e ∘ σ) = (f e • e.det) (e ∘ σ),
  simp [alternating_map.map_perm, basis.det_self]
end

@[simp] lemma alternating_map.map_basis_eq_zero_iff {ι : Type*} [finite ι]
  (e : basis ι R M) (f : alternating_map R M R ι) :
  f e = 0 ↔ f = 0 :=
⟨λ h, begin
  casesI nonempty_fintype ι,
  letI := classical.dec_eq ι,
  simpa [h] using f.eq_smul_basis_det e
end, λ h, h.symm ▸ alternating_map.zero_apply _⟩

lemma alternating_map.map_basis_ne_zero_iff {ι : Type*} [finite ι]
  (e : basis ι R M) (f : alternating_map R M R ι) :
  f e ≠ 0 ↔ f ≠ 0 :=
not_congr $ f.map_basis_eq_zero_iff e

variables {A : Type*} [comm_ring A] [module A M]

@[simp] lemma basis.det_comp (e : basis ι A M) (f : M →ₗ[A] M) (v : ι → M) :
  e.det (f ∘ v) = f.det * e.det v :=
by { rw [basis.det_apply, basis.det_apply, ← f.det_to_matrix e, ← matrix.det_mul,
         e.to_matrix_eq_to_matrix_constr (f ∘ v), e.to_matrix_eq_to_matrix_constr v,
         ← to_matrix_comp, e.constr_comp] }

@[simp] lemma basis.det_comp_basis [module A M']
  (b : basis ι A M) (b' : basis ι A M') (f : M →ₗ[A] M') :
  b'.det (f ∘ b) = linear_map.det (f ∘ₗ (b'.equiv b (equiv.refl ι) : M' →ₗ[A] M)) :=
begin
  rw [basis.det_apply, ← linear_map.det_to_matrix b', linear_map.to_matrix_comp _ b,
      matrix.det_mul, linear_map.to_matrix_basis_equiv, matrix.det_one, mul_one],
  congr' 1, ext i j,
  rw [basis.to_matrix_apply, linear_map.to_matrix_apply]
end

lemma basis.det_reindex {ι' : Type*} [fintype ι'] [decidable_eq ι']
  (b : basis ι R M) (v : ι' → M) (e : ι ≃ ι') :
  (b.reindex e).det v = b.det (v ∘ e) :=
by rw [basis.det_apply, basis.to_matrix_reindex', det_reindex_alg_equiv, basis.det_apply]

lemma basis.det_reindex_symm {ι' : Type*} [fintype ι'] [decidable_eq ι']
  (b : basis ι R M) (v : ι → M) (e : ι' ≃ ι) :
  (b.reindex e.symm).det (v ∘ e) = b.det v :=
by rw [basis.det_reindex, function.comp.assoc, e.self_comp_symm, function.comp.right_id]

@[simp]
lemma basis.det_map (b : basis ι R M) (f : M ≃ₗ[R] M') (v : ι → M') :
  (b.map f).det v = b.det (f.symm ∘ v) :=
by { rw [basis.det_apply, basis.to_matrix_map, basis.det_apply] }

lemma basis.det_map' (b : basis ι R M) (f : M ≃ₗ[R] M') :
  (b.map f).det = b.det.comp_linear_map f.symm :=
alternating_map.ext $ b.det_map f

@[simp] lemma pi.basis_fun_det : (pi.basis_fun R ι).det = matrix.det_row_alternating :=
begin
  ext M,
  rw [basis.det_apply, basis.coe_pi_basis_fun.to_matrix_eq_transpose, det_transpose],
end

/-- If we fix a background basis `e`, then for any other basis `v`, we can characterise the
coordinates provided by `v` in terms of determinants relative to `e`. -/
lemma basis.det_smul_mk_coord_eq_det_update {v : ι → M}
  (hli : linear_independent R v) (hsp : ⊤ ≤ span R (range v)) (i : ι) :
  (e.det v) • (basis.mk hli hsp).coord i = e.det.to_multilinear_map.to_linear_map v i :=
begin
  apply (basis.mk hli hsp).ext,
  intros k,
  rcases eq_or_ne k i with rfl | hik;
  simp only [algebra.id.smul_eq_mul, basis.coe_mk, linear_map.smul_apply, linear_map.coe_mk,
    multilinear_map.to_linear_map_apply],
  { rw [basis.mk_coord_apply_eq, mul_one, update_eq_self], congr, },
  { rw [basis.mk_coord_apply_ne hik, mul_zero, eq_comm],
    exact e.det.map_eq_zero_of_eq _ (by simp [hik, function.update_apply]) hik, },
end

/-- If a basis is multiplied columnwise by scalars `w : ι → Rˣ`, then the determinant with respect
to this basis is multiplied by the product of the inverse of these scalars. -/
lemma basis.det_units_smul (e : basis ι R M) (w : ι → Rˣ) :
  (e.units_smul w).det = (↑(∏ i, w i)⁻¹ : R) • e.det :=
begin
  ext f,
  change matrix.det (λ i j, (e.units_smul w).repr (f j) i)
    = (↑(∏ i, w i)⁻¹ : R) • matrix.det (λ i j, e.repr (f j) i),
  simp only [e.repr_units_smul],
  convert matrix.det_mul_column (λ i, (↑((w i)⁻¹) : R)) (λ i j, e.repr (f j) i),
  simp [← finset.prod_inv_distrib]
end

/-- The determinant of a basis constructed by `units_smul` is the product of the given units. -/
@[simp] lemma basis.det_units_smul_self (w : ι → Rˣ) : e.det (e.units_smul w) = ∏ i, w i :=
by simp [basis.det_apply]

/-- The determinant of a basis constructed by `is_unit_smul` is the product of the given units. -/
@[simp] lemma basis.det_is_unit_smul {w : ι → R} (hw : ∀ i, is_unit (w i)) :
  e.det (e.is_unit_smul hw) = ∏ i, w i :=
e.det_units_smul_self _


import Mathlib.Tactic.Find

theorem add_comm_zero : 0 + n = n + 0 := Nat.add_comm _ _

#find _ + _ = _ + _
#find ?n + _ = _ + ?n
#find (_ : Nat) + _ = _ + _
#find Nat → Nat
#find ?n ≤ ?m → ?n + _ ≤ ?m + _


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan
-/
import padic_int.clopen_properties
import padic_integral
import bernoulli_measure.eventually_constant_sequence
import bernoulli_measure.bernoulli_distribution
import nat_properties

/-!
# Equivalence class on ℤ/(d * p^n)ℤ
This file defines `equi_class` and its properties on `zmod (d * p^n)`.
We also use `zmod'`, which is the universal (sub)set of `zmod`, to make computations on sums easier.

## Main definitions and theorems
 * `equi_class`
 * `zmod'`
 * `equi_class.zmod'_succ_eq_bUnion`
 * `bernoulli_distribution_sum`

## Implementation notes
 * Changed bernoulli_measure_one to bernoulli_measure_def and bernoulli_measure_two to equi_class

## References
Introduction to Cyclotomic Fields, Washington (Chapter 12, Section 2)

## Tags
p-adic, L-function, Bernoulli measure
-/

local attribute [instance] zmod.topological_space

variables {p : ℕ} {d : ℕ} (R : Type*) [normed_comm_ring R] {c : ℕ}
open eventually_constant_seq
open_locale big_operators

/-- A variant of `zmod` which has type `finset _`. -/
def zmod' (n : ℕ) (h : 0 < n) : finset (zmod n) :=
  @finset.univ _ (@zmod.fintype n (fact_iff.2 h))

open nat padic_int zmod discrete_quotient_of_to_zmod_pow

/-- Given `a ∈ zmod (d * p^n)`, the set of all `b ∈ zmod (d * p^m)` such that
  `b = a mod (d * p^n)`. -/
def equi_class {n : ℕ} (m : ℕ) (a : zmod (d * p^n)) :=
 {b : zmod (d * p^m) | (b : zmod (d * p^n)) = a}
-- change def to a + k*dp^m
-- need h to be n ≤ m, not n < m for g_char_fn

variable [fact p.prime]

namespace int
lemma fract_eq_self' {a : ℚ} (h : 0 ≤ a) (ha : a < 1) : int.fract a = a :=
int.fract_eq_iff.2 ⟨h, ha, ⟨0, by simp⟩⟩
end int

namespace finset
lemma sum_equiv {α β γ : Type*} {s : finset α} {s' : finset β} {φ : s ≃ s'} {f : α → γ}
  [add_comm_monoid γ] : ∑ x : s, f x = ∑ y : s', f(φ.inv_fun y) :=
begin
  apply finset.sum_bij',
  swap 4, { rintros, exact φ.to_fun a, },
  swap 5, { rintros, exact φ.inv_fun a, },
  all_goals { simp },
end
end finset

lemma sum_rat_fin (n : ℕ) : (((∑ (x : fin n), (x : ℤ)) : ℤ) : ℚ) = (n - 1) * (n : ℚ) / 2 :=
begin
  have : ∀ (x : fin n), (x : ℤ) = ((x : ℕ) : ℤ),
  { simp only [_root_.coe_coe, eq_self_iff_true, implies_true_iff], },
  conv_lhs { congr, congr, skip, funext, rw this x, },
  rw ←finset.sum_range,
  induction n with d hd,
  { simp only [finset.range_zero, finset.sum_empty, int.cast_zero, nat.cast_zero, mul_zero,
      zero_div], },
  { rw [finset.sum_range_succ, int.cast_add, hd _],
    { simp only [int.cast_coe_nat, cast_succ, add_tsub_cancel_right],
      rw div_add',
      { rw [mul_comm _ (d : ℚ), ←mul_add], ring, },
      { simp only [ne.def, bit0_eq_zero, one_ne_zero, not_false_iff], }, },
    { simp only [_root_.coe_coe, eq_self_iff_true, implies_true_iff], }, },
end

namespace equi_class
lemma mem {n m : ℕ} (a : zmod (d * p^n)) (b : zmod (d * p^m)) :
  b ∈ equi_class m a ↔ (b : zmod (d * p^n)) = a := ⟨λ hb, hb, λ hb, hb⟩

variable [fact (0 < d)]

lemma some {n : ℕ} (x : zmod (d * p^n)) (y : equi_class n.succ x) : ∃ k : ℕ, k < p ∧
  (y : zmod (d * p^n.succ)).val = x.val + k * d * p^n :=
begin
  conv { congr, funext, conv { congr, skip, to_rhs,
    rw ←((@mem p d _ n n.succ x y).1 (y.prop)), }, },
  rw [← zmod.nat_cast_val (y : zmod (d * p^n.succ)), zmod.val_nat_cast],
  refine ⟨(y : zmod (d * p^n.succ)).val / (d * p^n), nat.div_lt_of_lt_mul _, _⟩,
  { rw [nat.mul_assoc, ←pow_succ'], apply zmod.val_lt (y : zmod (d * p^n.succ)), },
  { rw [mul_assoc, nat.mod_add_div' (y : zmod (d * p^n.succ)).val (d * p^n)], },
end

/-- Giving an equivalence between `equi_class` and `fin p`. -/
def equi_iso_fin (m : ℕ) (a : zmod (d * p^m)) : equi_class m.succ a ≃ fin p :=
{ to_fun := λ y, ⟨((y.val).val - a.val) / (d * p^m), nat.div_lt_of_lt_mul begin
    rw [mul_assoc, ←pow_succ'],
    exact lt_of_le_of_lt (nat.sub_le (y.val).val a.val) (zmod.val_lt y.val), end⟩,
  inv_fun := λ k, ⟨(a.val + k * d * p^m : ℕ), begin
    have g : (d * (p^m)) ∣ (d * p^(m.succ)) := mul_dvd_mul dvd_rfl (pow_dvd_pow p (nat.le_succ _)),
    rw [mem, zmod.cast_nat_cast g _, nat.cast_add, zmod.nat_cast_zmod_val, mul_assoc,
      nat.cast_mul, zmod.nat_cast_self, mul_zero, add_zero],
    refine zmod.char_p _, end⟩,
  left_inv := λ x, begin
    rw subtype.ext_iff_val, simp only [fin.coe_mk, subtype.val_eq_coe, _root_.coe_coe],
    rw mul_assoc,
    obtain ⟨k, hk, h⟩ := some a x,
    rw nat.div_mul_cancel,
    { rw [← nat.add_sub_assoc _ _, nat.add_sub_cancel_left],
      { rw zmod.nat_cast_val _, norm_cast, apply_instance, },
      { rw h, apply nat.le_add_right, }, },
    { rw [h, nat.add_sub_cancel_left, mul_assoc], simp, }, end,
  right_inv := λ x, begin
    simp only [nat.cast_pow],
    rw subtype.ext_iff_val,
    simp only [fin.coe_mk, subtype.val_eq_coe, _root_.coe_coe],
    apply nat.div_eq_of_eq_mul_left (fact.out _) (tsub_eq_of_eq_add _),
    { apply_instance, },
    rw [mul_assoc, zmod.val_nat_cast, nat.mod_eq_of_lt],
    rw add_comm,
    have h2 : ↑x * (d * p ^ m) ≤ (d * p ^ m) * (p - 1),
    { rw mul_comm, apply nat.mul_le_mul_left,
      rw [←nat.lt_succ_iff, nat.succ_eq_add_one, nat.sub_add_cancel], apply x.2,
      { apply le_of_lt (fact_iff.1 (nat.prime.one_lt' p)), }, },
    convert add_lt_add_of_lt_of_le (zmod.val_lt a) h2,
    ring_nf, rw nat.sub_add_cancel,
    { rw ←pow_succ, },
    { apply le_of_lt (fact_iff.1 (nat.prime.one_lt' p)), }, end}

noncomputable instance {n m : ℕ} (a : zmod (d * p^n)) : fintype (equi_class m a) :=
set.finite.fintype (set.finite.subset (set.univ_finite_iff_nonempty_fintype.2
  (nonempty.intro infer_instance)) (set.subset_univ _))

open padic_int zmod nat
lemma zmod'_succ_eq_bUnion [fact (0 < d)] (m : ℕ) :
  zmod' (d * (p^m.succ)) (mul_prime_pow_pos m.succ) = (zmod' (d*p^m) (mul_prime_pow_pos m)).bUnion
    (λ a : zmod (d * p ^ m), set.to_finset ((equi_class m.succ) a)) :=
finset.ext (λ y, iff.trans begin simp only [exists_prop, set.mem_to_finset],
  refine ⟨λ h, ⟨(y : zmod (d * p^m)), finset.mem_univ y, (equi_class.mem _ _).2 rfl⟩,
    λ h, finset.mem_univ y⟩, end (iff.symm finset.mem_bUnion))

lemma eq [fact (0 < d)] {m : ℕ} (hd : d.coprime p)
  {f : locally_constant (zmod d × ℤ_[p]) R} (h : classical.some (le hd f) ≤ m) (x : zmod (d * p^m))
  (y : zmod (d * p^m.succ)) (hy : y ∈ set.to_finset ((equi_class m.succ) x)) : f y = f x :=
begin
  -- note that y ≠ ↑x !
  rw [set.mem_to_finset, equi_class.mem] at hy,
  rw [←locally_constant.factors, function.comp_apply],
  apply congr_arg,
  have h' := classical.some_spec (le hd f),
  rw [←discrete_quotient.of_le_proj (le_trans (le_of_ge p d h) h'), function.comp_apply],
  refine congr_arg _ _,
  change ↑y ∈ ((discrete_quotient_of_to_zmod_pow p d m).proj)⁻¹'
    {(discrete_quotient_of_to_zmod_pow p d m).proj x},
  simp_rw [discrete_quotient.fiber_eq, set.mem_set_of_eq, discrete_quotient_of_to_zmod_pow.rel,
    prod.fst_zmod_cast, prod.snd_zmod_cast, ←hy],
  have val_le_val : (y.val : zmod (d * p^m)).val ≤ y.val := val_coe_val_le_val _,
  have dvds : (d * p^m) ∣ y.val - (y.val : zmod (d * p^m)).val,
  { rw [←zmod.nat_coe_zmod_eq_zero_iff_dvd, nat.cast_sub val_le_val],
    simp only [zmod.cast_id', id.def, sub_self, zmod.nat_cast_val], },
  split,
  { rw [←sub_eq_zero, ←ring_hom.map_sub, ←ring_hom.mem_ker, ker_to_zmod_pow,
      ideal.mem_span_singleton],
    repeat { rw ←zmod.nat_cast_val, },
    rw [←dvd_neg, neg_sub, ←nat.cast_pow, ←nat.cast_sub val_le_val],
    apply nat.coe_nat_dvd (dvd_trans (dvd_mul_left _ _) dvds), },
  { repeat { rw ←zmod.nat_cast_val, },
    rw [zmod.nat_coe_eq_nat_coe_iff, nat.modeq_iff_dvd' val_le_val],
    apply dvd_trans (dvd_mul_right _ _) dvds, },
end
-- This lemma has a lot of mini lemmas that can be generalized.

lemma card [fact (0 < d)] {m : ℕ} (x : zmod (d * p^m)) :
  finset.card (@finset.univ (equi_class m.succ x) _) = p :=
begin
  rw [finset.card_univ, ←fintype.of_equiv_card (equi_iso_fin m x)],
  convert fintype.card_fin p,
end

lemma equi_iso_fun_inv_val [fact (0 < d)] {m : ℕ} (x : zmod (d * p^m)) (k : fin p) :
  ((equi_iso_fin m x).inv_fun k).val = x.val + ↑k * (d * p^m) :=
by { unfold equi_iso_fin, dsimp, norm_cast, rw mul_assoc, }

variables (p d)
lemma helper_2 [fact (0 < d)] (m : ℕ) (y : fin p) : ((y * (d * p ^ m) : zmod (d * p^m.succ)) : ℤ) =
  ↑y * (↑(d : zmod (d * p^m.succ)) * ↑(p : zmod (d * p^m.succ))^m) :=
begin
  have prime_gt_one : 1 < p := prime.one_lt (fact.out _),
  have le_mul_p : p ≤ d * p^m.succ,
  { rw mul_comm,
    apply le_mul_of_le_of_one_le (le_pow (le_of_lt prime_gt_one)
      (nat.succ_le_iff.2 (succ_pos _))) (nat.succ_le_iff.2 (fact.out _)),
    { assumption, }, },
  rw [←zmod.nat_cast_val, zmod.val_mul, nat.mod_eq_of_lt _, nat.cast_mul],
  { apply congr_arg2,
    { rw [cast_val_eq_of_le _ le_mul_p, int.nat_cast_eq_coe_nat, _root_.coe_coe], },
    { rw [zmod.val_mul, nat.mod_eq_of_lt _],
      { rw [nat.cast_mul, zmod.nat_cast_val, zmod.nat_cast_val, ←nat.cast_pow],
        apply congr_arg2 _ rfl _,
        by_cases m = 0,
        { rw [h, pow_zero, pow_zero, nat.cast_one],
          haveI : fact (1 < d * p^1),
          { apply fact_iff.2 (one_lt_mul (nat.succ_le_iff.2 (fact.out _)) _),
            { assumption, },
            { rw pow_one p, assumption, }, },
          apply cast_int_one, },
        { rw [nat_cast_zmod_cast_int (lt_mul_pow_right (fact.out _) prime_gt_one
            (nat.succ_lt_succ (nat.pos_of_ne_zero h))), nat_cast_zmod_cast_int
            (pow_lt_mul_pow_succ_right _), int.coe_nat_pow],
          any_goals { assumption, }, }, },
      { rw [←nat.cast_pow, zmod.val_cast_of_lt _, zmod.val_cast_of_lt (pow_lt_mul_pow_succ_right _)],
        apply mul_pow_lt_mul_pow_succ,
        any_goals { assumption, },
        { apply lt_mul_of_one_lt_right (fact.out _) (nat.one_lt_pow _ _ (nat.succ_pos _)
            (nat.prime.one_lt (fact.out _))),
          any_goals { assumption }, }, }, }, },
  { rw [←nat.cast_pow, ←nat.cast_mul, zmod.val_cast_of_lt (mul_pow_lt_mul_pow_succ _),
      cast_val_eq_of_le _ le_mul_p],
    { apply fin_prime_mul_prime_pow_lt_mul_prime_pow_succ, },
    any_goals { assumption, }, },
end

-- should p be implicit or explicit?
variables {p d}
theorem sum_fract [fact (0 < d)] {m : ℕ} (x : zmod (d * p^m)) :
  ∑ (x_1 : (equi_class m.succ x)), int.fract (((x_1 : zmod (d * p^m.succ)).val : ℚ) /
    ((d : ℚ) * (p : ℚ)^m.succ)) = (x.val : ℚ) / (d * p^m) + (p - 1) / 2 :=
begin
  conv_lhs { congr, skip, funext, rw [← nat.cast_pow, ← nat.cast_mul,
    int.fract_eq_self' ((zero_le_div_and_div_lt_one (x_1 : zmod (d * p ^ m.succ))).1)
    ((zero_le_div_and_div_lt_one (x_1 : zmod (d * p ^ m.succ))).2),  nat.cast_mul, nat.cast_pow], },
  rw fintype.sum_equiv (equi_iso_fin m x) (λ y, _)
    (λ k, (((equi_iso_fin m x).inv_fun k).val : ℚ) / (d * p ^ m.succ)),
  { rw ←finset.sum_div,
    have h1 : ∀ y : fin p, ((x.val : zmod (d * p^m.succ)) : ℤ) + ↑((y : zmod (d * p^m.succ)) *
      (d * p ^ m : zmod (d * p^m.succ))) < ↑(d * p ^ m.succ : ℕ),
    { intro y,
      rw [zmod.nat_cast_val, ←zmod.nat_cast_val, ←zmod.nat_cast_val (↑y * (_ * _)), ←nat.cast_add],
      { convert (int.coe_nat_lt).2 (val_add_fin_mul_lt x y) using 1,
        apply congr (funext int.nat_cast_eq_coe_nat) (congr_arg2 _ _ _),
        { rw [←zmod.nat_cast_val, coe_val_eq_val_of_lt (mul_pow_lt_mul_pow_succ _) _],
          any_goals { apply_instance, }, },
        { rw [←nat.cast_pow, ←nat.cast_mul, fin_prime_coe_coe, ←nat.cast_mul, zmod.val_cast_of_lt],
          apply fin_prime_mul_prime_pow_lt_mul_prime_pow_succ, }, },
      { apply_instance, }, },
    conv_lhs { congr, congr, skip, funext, rw [equi_iso_fun_inv_val, ←zmod.int_cast_cast,
      coe_add_eq_pos' (h1 _), int.cast_add, helper_2 p d m _], },
    { rw [finset.sum_add_distrib, finset.sum_const, finset.card_univ, fintype.card_fin _],
      norm_cast,
      rw [←finset.sum_mul, _root_.add_div],
      apply congr_arg2 _ ((div_eq_iff _).2 _) _,
      { norm_cast, apply ne_of_gt (fact_iff.1 _), apply_instance, apply_instance, },
      { rw [div_mul_comm, _root_.nsmul_eq_mul],
        apply congr_arg2 _ _ _,
        { norm_num,
          rw [mul_div_mul_left _, pow_succ, mul_div_cancel _],
          { norm_cast,
            apply pow_ne_zero m (nat.prime.ne_zero (fact_iff.1 _)), assumption, },
          { norm_num,
            apply ne_of_gt (fact_iff.1 infer_instance), apply_instance, assumption, }, },
        { rw [zmod.int_cast_cast, zmod.nat_cast_val, ←zmod.nat_cast_val (x : zmod (d * p^m.succ))],
          refine congr_arg _ _,
          rw [←zmod.nat_cast_val x, coe_val_eq_val_of_lt _ _],
          { apply_instance, },
          { rw [mul_comm d (p^m), mul_comm d (p^m.succ)],
            apply mul_lt_mul (pow_lt_pow (nat.prime.one_lt (fact_iff.1 _)) (nat.lt_succ_self m))
              le_rfl (fact.out _) (nat.zero_le _),
            any_goals { assumption, }, }, }, },
      { rw [int.cast_mul, mul_div_assoc, sum_rat_fin, nat.cast_mul, int.cast_mul],
        have one : ((p : ℚ) - 1) * (p : ℚ) / 2 * (1 / (p : ℚ)) = ((p : ℚ) - 1) / 2,
        { rw [_root_.div_mul_div_comm, mul_one, mul_div_mul_right],
          norm_cast, apply ne_of_gt (nat.prime.pos (fact_iff.1 _)), assumption, },
        convert one using 2,
        rw div_eq_div_iff _ _,
        { rw [one_mul, zmod.int_cast_cast, int.cast_pow, zmod.int_cast_cast, pow_succ',
            nat.cast_mul, nat.cast_pow, mul_assoc],
          apply congr_arg2 _ _ _,
          { rw ←zmod.nat_cast_val _,
            { rw zmod.val_nat_cast,
              apply congr_arg _ (nat.mod_eq_of_lt ((lt_mul_iff_one_lt_right (fact_iff.1 _)).2 _)),
              { assumption, },
              { rw ←pow_succ',
                apply _root_.one_lt_pow (nat.prime.one_lt (fact_iff.1 _)) (succ_ne_zero _),
                { assumption, }, }, },
            { rw ←pow_succ', apply_instance, } },
          { apply congr_arg2 _ _ rfl,
            { by_cases m = 0,
              { rw [h, pow_zero, pow_zero], },
              apply congr_arg2 _ _ rfl,
              { rw ←zmod.nat_cast_val _,
                { rw zmod.val_nat_cast,
                  apply congr_arg _ (nat.mod_eq_of_lt _),
                  rw [←mul_assoc, lt_mul_iff_one_lt_left (prime.pos (fact_iff.1 _))],
                  { apply one_lt_mul (nat.succ_le_iff.2 (fact_iff.1 _)) _,
                    { assumption, },
                    { apply _root_.one_lt_pow (nat.prime.one_lt (fact_iff.1 _)) h,
                      assumption, }, },
                  { assumption, }, },
                { rw ←pow_succ', apply_instance, }, }, }, }, },
        { rw ←nat.cast_mul, norm_cast,
          apply ne_of_gt (fact_iff.1 _), apply_instance, apply_instance, },
        { norm_cast, apply ne_of_gt (nat.prime.pos (fact_iff.1 _)), assumption, }, }, }, },
  { rintros y,
    simp only [equiv.symm_apply_apply, subtype.val_eq_coe, equiv.inv_fun_as_coe,
      zmod.nat_cast_val], },
end
-- break up into smaller pieces

variable {m : ℕ}
lemma helper_bernoulli_distribution_sum' (hc' : c.coprime d) (hc : c.coprime p) (x : zmod (d * p^m)) :
  ∑ (x_1 : (equi_class m.succ x)), int.fract (((c : zmod (d * p^(2 * m.succ)))⁻¹.val : ℚ) *
  ↑(x_1 : zmod (d * p^m.succ)) / (↑d * ↑p ^ m.succ)) =
  ∑ (x_1 : (equi_class m.succ (↑((c : zmod (d * p^(2 * m.succ)))⁻¹.val) * x))),
  int.fract (↑((x_1 : zmod (d * p^m.succ)).val) / (↑d * ↑p ^ m.succ)) :=
begin
  have h1 : d * p ^ m ∣ d * p ^ m.succ,
  { apply mul_dvd_mul_left, rw pow_succ', apply dvd_mul_right, },
  have h2 : ∀ z : ℕ, d * p ^ z ∣ d * p ^ (2 * z),
  { intro z, apply mul_dvd_mul_left _ (pow_dvd_pow p _), linarith, },
  have h3 : d * p ^ m ∣ d * p ^ (2 * m.succ),
  { apply mul_dvd_mul_left _ (pow_dvd_pow p _),
    rw [nat.succ_eq_add_one, mul_add], linarith, },
  have h4 : (((c : zmod (d * p^(2 * m.succ)))⁻¹  : zmod (d * p^(2 * m.succ))) :
    zmod (d * p^m.succ)).val ≤ (c : zmod (d * p^(2 * m.succ)))⁻¹.val := val_coe_val_le_val' _,
  apply finset.sum_bij (λ a ha, _) (λ a ha, finset.mem_univ _) (λ a ha, _) (λ a1 a2 ha1 ha2 h, _) _,
  { refine ⟨(((c : zmod (d * p^(2*m.succ)))⁻¹).val : zmod (d * p^m.succ)) * a,
      (equi_class.mem _ _).2 _⟩,
    rw [zmod.cast_mul h1, cast_nat_cast h1 _],
    conv_rhs { congr, skip, rw ←((@equi_class.mem p d _ _ m.succ x a).1 a.prop), },
    any_goals { refine zmod.char_p _, }, },
  { rw [int.fract_eq_fract, subtype.coe_mk, div_sub_div_same, ← nat_cast_val
      (a : zmod (d * p^m.succ)), zmod.val_mul, ← nat.cast_mul, ← nat.cast_sub
      (le_trans (mod_le _ _) _), nat_cast_val, nat.cast_sub (le_trans (mod_le _ _) _),
      ← sub_add_sub_cancel _ ((((c : zmod (d * p^(2 * m.succ)))⁻¹ : zmod (d * p^(2 * m.succ))) :
      zmod (d * p^m.succ)).val * (a : zmod (d * p^m.succ)).val : ℚ) _, ← nat.cast_mul],
    obtain ⟨z₁, hz₁⟩ := @dvd_sub_mod (d * p^m.succ) ((((c : zmod (d * p^(2 * m.succ)))⁻¹ :
      zmod (d * p^(2 * m.succ))) : zmod (d * p^m.succ)).val * (a : zmod (d * p^m.succ)).val),
    obtain ⟨z₂, hz₂⟩ := dvd_val_sub_cast_val (d * p^m.succ) (c : zmod (d * p^(2 * m.succ)))⁻¹,
    rw [← nat.cast_sub (mod_le _ _), hz₁, ← nat.cast_sub, ← nat.mul_sub_right_distrib, hz₂,
      mul_assoc (d * p^(m.succ)) _ _, nat.cast_mul, nat.cast_mul _ z₁, ← mul_add,
      ← nat.cast_pow, ← nat.cast_mul d _, mul_comm,
      mul_div_cancel _ ((@cast_ne_zero ℚ _ _ _ _).2 (ne_of_gt (fact_iff.1 _)))],
    refine ⟨((z₂ * (a : zmod (d * p ^ m.succ)).val + z₁ : ℕ) : ℤ), by { norm_cast } ⟩,
    any_goals { refine mul_le_mul_right' h4 _, },
    { apply_instance, },
    { rw nat_cast_val, refine mul_le_mul_right' h4 _, }, },
  { simp only [subtype.mk_eq_mk, nat_cast_val] at h,
    rw subtype.ext ((is_unit.mul_right_inj (is_unit_iff_exists_inv'.2
      ⟨((c : zmod (d * p^(2 * (m.succ)))) : zmod (d * p^(m.succ))), _⟩)).1 h),
    rw [cast_inv (nat.coprime.mul_pow _ hc' hc) (h2 _), cast_nat_cast (h2 m.succ)],
    apply zmod.mul_inv_of_unit _ (is_unit_mul m.succ hc' hc),
    { refine zmod.char_p _, }, },
  { simp only [cast_nat_cast, nat_cast_val, subtype.coe_mk, finset.mem_univ, exists_true_left,
      set_coe.exists, forall_true_left, set_coe.forall, subtype.mk_eq_mk, exists_prop],
    rintros a ha, rw equi_class.mem at ha,
    refine ⟨((c : zmod (d * p^(2 * m.succ))) : zmod (d * p^m.succ)) * a, _, _⟩,
    { rw [equi_class.mem, zmod.cast_mul h1],
      { rw [ha, ←mul_assoc, cast_inv (nat.coprime.mul_pow _ hc' hc) h3,
          cast_nat_cast (h2 m.succ) _, cast_nat_cast h1 _, cast_nat_cast h3 _,
          zmod.mul_inv_of_unit _ (is_unit_mul m hc' hc), one_mul],
        any_goals { refine zmod.char_p _ }, },
      { refine zmod.char_p _, }, },
    { rw [←mul_assoc, zmod.cast_inv (nat.coprime.mul_pow _ hc' hc) (h2 _),
        zmod.inv_mul_of_unit _ _, one_mul a, true_and],
      rw cast_nat_cast (h2 m.succ) c,
      apply is_unit_mul _ hc' hc,
      { refine zmod.char_p _, }, }, },
end

open equi_class
lemma bernoulli_distribution_sum' (x : zmod (d * p^m)) (hc : c.coprime p) (hc' : c.coprime d) :
  ∑ (y : equi_class m.succ x), (bernoulli_distribution p d c m.succ y) = (bernoulli_distribution p d c m x) :=
begin
  rw [bernoulli_distribution, ← ring_hom.map_sum],
  apply congr_arg,
  rw [finset.sum_add_distrib, finset.sum_sub_distrib, equi_class.sum_fract, ←finset.mul_sum],
  have h2 : ∀ z : ℕ, d * p ^ z ∣ d * p ^ (2 * z),
  { intro z, apply mul_dvd_mul_left _ (pow_dvd_pow p _), linarith, },
  have h3 : d * p ^ m ∣ d * p ^ (2 * m.succ),
  { apply mul_dvd_mul_left _ (pow_dvd_pow p _),
    rw [nat.succ_eq_add_one, mul_add], linarith, },
  convert_to ((x.val : ℚ) / (d * p ^ m) + (p - 1) / 2) - (c : ℚ) *
    ∑ (x_1 : (equi_class m.succ ( ((c : zmod (d * p^(2*m.succ)))⁻¹.val) * x))),
    int.fract (((x_1 : zmod (d * p^m.succ)).val : ℚ) / ((d : ℚ) * (p : ℚ)^m.succ)) +
    (∑ (x : (equi_class m.succ x)), ((c : ℚ) - 1) / 2) = _ - _ + _,
  { rw [add_right_cancel_iff, sub_right_inj],
    refine congr_arg _ (helper_bernoulli_distribution_sum' hc' hc _), },
  rw [sum_fract, ←nat.cast_pow, ←nat.cast_mul, int.fract_eq_self' (zero_le_div_and_div_lt_one x).1
    (zero_le_div_and_div_lt_one x).2, mul_add, finset.sum_const, equi_class.card,
    _root_.nsmul_eq_mul, sub_add_eq_add_sub, sub_add_eq_add_sub, sub_add_eq_sub_sub, sub_right_comm],
  apply congr_arg2 _ _ (congr_arg _ _),
  { rw [add_assoc, add_sub_assoc], congr, linarith, },
  { rw [←fract_eq_val _, ← zmod.nat_cast_val, ← zmod.nat_cast_val, ← nat.cast_mul],
    apply fract_eq_of_zmod_eq,
    rw [nat.cast_mul, zmod.nat_cast_val, zmod.nat_cast_val, zmod.nat_cast_val, zmod.cast_mul',
      zmod.nat_cast_val, zmod.cast_id],
    apply congr_arg2 _ _ rfl,
    rw [cast_inv (nat.coprime.mul_pow _ hc' hc) h3, cast_inv (nat.coprime.mul_pow _ hc' hc) (h2 _),
      cast_nat_cast h3, cast_nat_cast (h2 _)],
    any_goals { refine zmod.char_p _, },
    { apply_instance, }, },
end

variable [algebra ℚ_[p] R]

--`E_c_sum_equi_class` replaced with `bernoulli_distribution_sum`
lemma bernoulli_distribution_sum (x : zmod (d * p^m)) (hc : c.gcd p = 1) (hc' : c.gcd d = 1) :
  ∑ (y : zmod (d * p ^ m.succ)) in (λ a : zmod (d * p ^ m), ((equi_class m.succ) a).to_finset) x,
  ((algebra_map ℚ_[p] R) (bernoulli_distribution p d c m.succ y)) = (algebra_map ℚ_[p] R) (bernoulli_distribution p d c m x) :=
begin
  rw ←bernoulli_distribution_sum',
  { rw ring_hom.map_sum,
    apply finset.sum_bij (λ a ha, subtype.mk a _) (λ a ha, finset.mem_univ _) (λ a ha, _)
      (λ a b ha hb h, _) (λ b hb, _),
    { refine set.mem_to_finset.1 ha, },
    { simp only [subtype.coe_mk], },
    { simp only [subtype.mk_eq_mk, subtype.ext_iff, subtype.coe_mk] at h, rw h, },
    { simp only [set.mem_to_finset],
      refine ⟨b.val, b.prop, by { rw subtype.ext_iff_val, }⟩, }, },
  any_goals { assumption, },
end

open clopen_from
-- does not require [fact (0 < d)]
lemma clopen {n : ℕ} (a : zmod (d * p^n)) (hm : n ≤ m) (b : (equi_class m a)) :
  (b.val : zmod d × ℤ_[p]) ∈ (clopen_from a) :=
begin
  simp_rw [subtype.val_eq_coe, mem_clopen_from, ←(mem _ _).1 b.prop],
  refine ⟨_, _⟩,
  { conv_rhs { congr, rw ←nat_cast_val, },
    rw [prod.fst_zmod_cast, cast_nat_cast (dvd_mul_right d _) _, nat_cast_val],
    refine zmod.char_p _, },
  { rw [prod.snd_zmod_cast],
    convert_to _ = ((b: zmod (d * p^m)) : zmod (p^n)),
    { rw ←zmod.int_cast_cast (b: zmod (d * p^m)),
      conv_rhs { rw ←zmod.int_cast_cast (b: zmod (d * p^m)), },
      change (ring_hom.comp (to_zmod_pow n) (int.cast_ring_hom ℤ_[p])) ((b : zmod (d * p^m)) : ℤ) =
        (int.cast_ring_hom (zmod (p^n))) ((b : zmod (d * p^m)) : ℤ),
      apply _root_.congr_fun _ _,
      congr,
      convert @ring_hom.ext_zmod 0 _ _ _ _, },
    { rw [←cast_hom_apply' (zmod (p^n)) (dvd_mul_left (p^n) d) _, ←cast_hom_apply' (zmod (d * p^n))
        (mul_dvd_mul_left d (pow_dvd_pow p hm)) _, ←cast_hom_apply' (zmod (p^n))
        (dvd_mul_of_dvd_right (pow_dvd_pow p hm) d) _, ←ring_hom.comp_apply],
        apply _root_.congr_fun _,
        congr,
        convert ring_hom.ext_zmod _ _, }, },
end
end equi_class