/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.distribution_semantics.monad
import to_mathlib.uniform_of_vector
import data.vector.mem

/-!
# Computations Uniformly Drawing From Data Structures

This file defines different uniform computations derived from a `uniform_selecting` oracle.
The base construction is `uniform_fin`, suggestively denoted `$[0..n]`.
From this we build corresponding computations for `vector`, `list`, `finset`, and `fintype`,
using the notations `$ᵛ`, `$ˡ`, `$ˢ`, and `$ᵗ` respectively.

Note that the `list` and `finset` versions require explicit proofs of being nonempty,
so using `vector` and `fintype` is usually preferable when this is possible.
-/

namespace oracle_comp

variables {α β γ : Type}

open oracle_spec pmf
open_locale big_operators ennreal

section uniform_fin

/-- Randomly choose a number `0 ≤ i < n` by querying the uniform selection oracle.
  We implicitly use a `succ` call for the resulting type since `fin 0` is unihabited as a type -/
@[derive decidable] def uniform_fin (n : ℕ) : oracle_comp uniform_selecting (fin $ n + 1) :=
query n ()

notation `$[0..` n `]` := uniform_fin n

variables (n : ℕ) {m : ℕ} (i : fin m.succ)
  (oa : (fin m.succ) → oracle_comp uniform_selecting α) (x : α)

section support

@[simp] lemma support_uniform_fin : support $[0..n] = ⊤ := support_query n ()

lemma mem_support_uniform_fin_iff : i ∈ support $[0..m] :=
(support_uniform_fin n).symm ▸ set.mem_univ i

@[simp] lemma support_uniform_fin_bind : ($[0..m] >>= oa).support = ⋃ i, (oa i).support :=
by simp only [support_bind, set.Union_true]

end support

section fin_support

@[simp] lemma fin_support_uniform_fin : fin_support $[0..n] = finset.univ := fin_support_query n ()

lemma mem_fin_support_uniform_fin : i ∈ fin_support $[0..m] :=
(fin_support_uniform_fin i) ▸ finset.mem_univ i

lemma fin_support_uniform_fin_bind [decidable_eq α] [∀ i, (oa i).decidable] :
  ($[0..m] >>= oa).fin_support = finset.bUnion finset.univ (λ i, (oa i).fin_support) :=
by {rw [fin_support_bind, fin_support_uniform_fin], congr}

end fin_support

section eval_dist

@[simp] lemma eval_dist_uniform_fin : ⁅$[0..n]⁆ = pmf.uniform_of_fintype (fin $ n + 1) := rfl

lemma eval_dist_uniform_fin_apply : ⁅$[0..m]⁆ i = m.succ⁻¹ :=
by rw [eval_dist_uniform_fin m, pmf.uniform_of_fintype_apply i, fintype.card_fin (m + 1)]

lemma eval_dist_uniform_fin_bind_apply_eq_tsum : ⁅$[0..m] >>= oa⁆ x = (∑' i, ⁅oa i⁆ x) / m.succ :=
by simp only [eval_dist_bind_apply_eq_tsum, div_eq_mul_inv, ← ennreal.tsum_mul_right,
  eval_dist_uniform_fin_apply, one_mul, mul_comm (m.succ⁻¹ : ℝ≥0∞)]

lemma eval_dist_uniform_fin_bind_apply_eq_sum : ⁅$[0..m] >>= oa⁆ x = (∑ i, ⁅oa i⁆ x) / m.succ :=
by simp only [eval_dist_bind_apply_eq_sum, div_eq_mul_inv, ← finset.sum_mul, one_mul,
  eval_dist_uniform_fin_apply, mul_comm (m.succ⁻¹ : ℝ≥0∞), fin_support_uniform_fin]

end eval_dist

section prob_event

@[simp] lemma prob_event_uniform_fin (e : set (fin $ m + 1)) [decidable_pred e] :
  ⁅e | $[0..m]⁆ = (fintype.card e) / (m + 1) :=
by simp only [uniform_fin, prob_event_query, uniform_selecting_range,
  fintype.card_fin, nat.cast_add, nat.cast_one]

@[simp] lemma prob_event_uniform_fin_bind_eq_tsum (e : set α) :
  ⁅e | $[0..m] >>= oa⁆ = (∑' i, ⁅e | oa i⁆) / m.succ :=
by simp only [prob_event_bind_eq_tsum, div_eq_mul_inv, ← ennreal.tsum_mul_right,
  eval_dist_uniform_fin_apply, one_mul, mul_comm (m.succ⁻¹ : ℝ≥0∞)]

lemma prob_event_uniform_fin_bind_apply_eq_sum (e : set α) :
  ⁅e | $[0..m] >>= oa⁆ = (∑ i, ⁅e | oa i⁆) / m.succ :=
by simp only [prob_event_bind_eq_sum, div_eq_mul_inv, ← finset.sum_mul, one_mul,
  eval_dist_uniform_fin_apply, mul_comm (m.succ⁻¹ : ℝ≥0∞), fin_support_uniform_fin]

end prob_event

end uniform_fin

section uniform_select_vector

/-- Randomly select an element of a vector by using `uniform_of_fin`.
  Again we need to use `succ` for the vectors type to avoid sampling an empty vector -/
@[derive decidable] def uniform_select_vector [decidable_eq α] {n : ℕ} (v : vector α (n + 1)) :
  oracle_comp uniform_selecting α := v.nth <$> $[0..n]

notation `$ᵛ` v := uniform_select_vector v

variables [decidable_eq α] {n : ℕ} (v : vector α (n + 1))
  (ob : α → oracle_comp uniform_selecting β) (x : α) (y : β)

section support

@[simp] lemma support_uniform_select_vector : ($ᵛ v).support = {a | a ∈ v.to_list} :=
(support_map $[0..n] v.nth).trans (set.ext (λ a, by simp only [vector.mem_iff_nth,
  support_uniform_fin, set.top_eq_univ, set.image_univ, set.mem_range, set.mem_set_of_eq]))

lemma support_uniform_select_vector_eq_coe_to_finset :
  ($ᵛ v).support = ↑v.to_list.to_finset :=
by simp only [support_uniform_select_vector, list.coe_to_finset]

lemma mem_support_uniform_select_vector_iff : x ∈ ($ᵛ v).support ↔ x ∈ v.to_list :=
by simp only [support_uniform_select_vector, set.mem_set_of_eq]

lemma support_uniform_select_vector_cons : ($ᵛ (x ::ᵥ v)).support = {x} ∪ ($ᵛ v).support :=
set.ext (λ x, by simp only [support_uniform_select_vector, vector.to_list_cons, list.mem_cons_iff,
  set.mem_set_of_eq, set.singleton_union, set.mem_insert_iff])

lemma support_uniform_select_vector_singleton (v : vector α 1) : ($ᵛ v).support = {v.head} :=
by simp only [support_uniform_select_vector, vector.to_list_singleton,
  list.mem_singleton, set.set_of_eq_eq_singleton]

end support

section fin_support

@[simp] lemma fin_support_uniform_select_vector : ($ᵛ v).fin_support = finset.univ.image v.nth :=
begin
  rw [fin_support_eq_iff_support_eq_coe, finset.coe_image, support_uniform_select_vector],
  exact set.ext (λ a, by simp only [vector.mem_iff_nth, set.mem_set_of_eq,
    finset.coe_univ, set.image_univ, set.mem_range]),
end

lemma fin_support_uniform_select_vector_eq_to_finset : ($ᵛ v).fin_support = v.to_list.to_finset :=
by rw [fin_support_eq_iff_support_eq_coe, support_uniform_select_vector_eq_coe_to_finset]

lemma mem_fin_support_uniform_select_vector_iff : x ∈ ($ᵛ v).fin_support ↔ x ∈ v.to_list :=
by simp only [fin_support_uniform_select_vector, vector.mem_iff_nth,
  finset.mem_image, finset.mem_univ, exists_true_left]

lemma fin_support_uniform_select_vector_cons :
  ($ᵛ (x ::ᵥ v)).fin_support = {x} ∪ ($ᵛ v).fin_support :=
by rw [fin_support_eq_iff_support_eq_coe, support_uniform_select_vector_cons,
  finset.coe_union, coe_fin_support_eq_support, finset.coe_singleton]

lemma fin_support_uniform_select_vector_singleton (v : vector α 1) :
  ($ᵛ v).fin_support = {v.head} := by rw [fin_support_eq_iff_support_eq_coe,
    support_uniform_select_vector_singleton, finset.coe_singleton]

end fin_support

section eval_dist

@[simp] lemma eval_dist_uniform_select_vector : ⁅$ᵛ v⁆ = pmf.uniform_of_vector v :=
by rw [uniform_select_vector, pmf.uniform_of_vector_eq_nth_map_uniform_of_fintype,
  eval_dist_map, eval_dist_uniform_fin]

lemma eval_dist_uniform_select_vector_apply : ⁅$ᵛ v⁆ x = v.to_list.count x / n.succ :=
by { rw [eval_dist_uniform_select_vector, pmf.uniform_of_vector_apply], congr }

lemma eval_dist_uniform_select_vector_bind_apply_eq_tsum :
  ⁅($ᵛ v) >>= ob⁆ y = (∑' x, v.to_list.count x * ⁅ob x⁆ y) / n.succ :=
begin
  simp only [eval_dist_bind_apply_eq_tsum, div_eq_mul_inv, ← ennreal.tsum_mul_right,
    eval_dist_uniform_select_vector_apply],
  exact tsum_congr (λ _, by ring),
end

lemma eval_dist_uniform_select_vector_bind_apply_eq_sum :
  ⁅($ᵛ v) >>= ob⁆ y = (∑ x in v.to_list.to_finset, v.to_list.count x * ⁅ob x⁆ y) / n.succ :=
begin
  rw [eval_dist_uniform_select_vector_bind_apply_eq_tsum],
  refine congr_arg (λ x, x / (n.succ : ℝ≥0∞)) (tsum_eq_sum $ λ x hx, _),
  rw [list.count_eq_zero_of_not_mem (λ h, hx $ list.mem_to_finset.2 h), nat.cast_zero, zero_mul],
end

end eval_dist

section prob_event

@[simp] lemma prob_event_uniform_select_vector (e : set α) [decidable_pred e] :
  ⁅e | $ᵛ v⁆ = (v.to_list.countp e) / n.succ :=
by { rw [prob_event.def, eval_dist_uniform_select_vector,
  to_outer_measure_uniform_of_vector_apply], congr }

@[simp] lemma prob_event_uniform_select_vector_bind_eq_tsum (e : set β) :
  ⁅e | ($ᵛ v) >>= ob⁆ = (∑' x, (v.to_list.count x) * ⁅e | ob x⁆) / n.succ :=
begin
  simp_rw [prob_event_bind_eq_tsum ($ᵛ v) ob e, eval_dist_uniform_select_vector_apply,
    div_eq_mul_inv, ← ennreal.tsum_mul_right],
  exact tsum_congr (λ _, by ring)
end

lemma prob_event_uniform_select_vector_bind_eq_sum (e : set β) :
  ⁅e | ($ᵛ v) >>= ob⁆ = (∑ x in v.to_list.to_finset, (v.to_list.count x) * ⁅e | ob x⁆) / n.succ :=
begin
  rw [prob_event_uniform_select_vector_bind_eq_tsum],
  refine congr_arg (λ x, x / (n.succ : ℝ≥0∞)) (tsum_eq_sum $ λ x hx, _),
  rw [list.count_eq_zero_of_not_mem (λ h, hx $ list.mem_to_finset.2 h), nat.cast_zero, zero_mul],
end

end prob_event

end uniform_select_vector

section uniform_select_list

/-- If a list isn't empty, we can convert it to a vector and then sample from it.-/
@[derive decidable] def uniform_select_list [decidable_eq α] (xs : list α) (h : ¬ xs.empty) :
  oracle_comp uniform_selecting α :=
let v : vector α (xs.length.pred.succ) := ⟨xs, symm $ nat.succ_pred_eq_of_pos
  (list.length_pos_of_ne_nil (λ h', h $ list.empty_iff_eq_nil.2 h'))⟩ in uniform_select_vector v

notation `$ˡ` := uniform_select_list

variables [decidable_eq α] (xs : list α) (x : α) (y : β) (h : ¬ xs.empty)
  (oa : oracle_comp uniform_selecting α) (ob : α → oracle_comp uniform_selecting β)

/-- Assuming we sample from `[]`, we can treat this as any other computation,
using the provided contradictory proof that `[]` is non-empty. -/
lemma uniform_select_list_nil (h : ¬ ([] : list α).empty) :
  $ˡ [] h = oa := false.elim (h rfl)

lemma uniform_select_list_cons (h : ¬ (x :: xs).empty) :
  $ˡ (x :: xs) h = uniform_select_vector ⟨x :: xs, list.length_cons x xs⟩ := rfl

section support

@[simp] lemma support_uniform_select_list : ($ˡ xs h).support = {x | x ∈ xs} :=
begin
  induction xs with x xs,
  { simpa only [list.empty, coe_sort_tt, not_true] using h },
  { exact set.ext (λ x', by rw [uniform_select_list,
      mem_support_uniform_select_vector_iff, vector.to_list_mk, set.mem_set_of]) }
end

lemma support_uniform_select_list_eq_coe_to_finset : ($ˡ xs h).support = ↑xs.to_finset :=
by simp only [support_uniform_select_list, list.coe_to_finset]

lemma mem_support_uniform_select_list_iff : x ∈ ($ˡ xs h).support ↔ x ∈ xs :=
by rw [oracle_comp.support_uniform_select_list, set.mem_set_of_eq]

end support

section fin_support

@[simp] lemma fin_support_uniform_select_list : ($ˡ xs h).fin_support = xs.to_finset :=
(fin_support_eq_iff_support_eq_coe _ _).2 (set.ext $ λ x, by simp only [finset.mem_coe,
  support_uniform_select_list, set.mem_set_of_eq, list.mem_to_finset])

lemma mem_fin_support_uniform_select_list_iff : x ∈ ($ˡ xs h).fin_support ↔ x ∈ xs :=
by rw [fin_support_uniform_select_list, list.mem_to_finset]

end fin_support

section eval_dist

lemma eval_dist_uniform_select_list_nil (h : ¬ ([] : list α).empty) (p : pmf α) :
  ⁅$ˡ [] h⁆ = p := false.elim (h rfl)

@[simp] lemma eval_dist_uniform_select_list : ⁅$ˡ xs h⁆ = pmf.uniform_of_list xs h :=
begin
  induction xs with x xs,
  { exact eval_dist_uniform_select_list_nil h _ },
  { simpa only [uniform_select_list_cons, eval_dist_uniform_select_vector] }
end

lemma eval_dist_uniform_select_list_apply : ⁅$ˡ xs h⁆ x = xs.count x / xs.length :=
by { rw [eval_dist_uniform_select_list, pmf.uniform_of_list_apply], congr }

lemma eval_dist_uniform_select_list_bind_apply_eq_tsum :
  ⁅($ˡ xs h) >>= ob⁆ y = (∑' x, xs.count x * ⁅ob x⁆ y) / xs.length :=
begin
  rw [list.empty_iff_eq_nil] at h,
  simp only [uniform_select_list, eval_dist_uniform_select_vector_bind_apply_eq_tsum,
    vector.to_list_mk, nat.succ_pred_eq_of_pos (list.length_pos_of_ne_nil h)],
end

lemma eval_dist_uniform_select_list_bind_apply_eq_sum :
  ⁅($ˡ xs h) >>= ob⁆ y = (∑ x in xs.to_finset, xs.count x * ⁅ob x⁆ y) / xs.length :=
begin
  rw [list.empty_iff_eq_nil] at h,
  simp only [uniform_select_list, eval_dist_uniform_select_vector_bind_apply_eq_sum,
    vector.to_list_mk, nat.succ_pred_eq_of_pos (list.length_pos_of_ne_nil h)],
end

end eval_dist

section prob_event

@[simp] lemma prob_event_uniform_select_list (e : set α) [decidable_pred e] :
  ⁅e | $ˡ xs h⁆ = xs.countp e / xs.length :=
by { rw [prob_event.def, eval_dist_uniform_select_list,
  to_outer_measure_uniform_of_list_apply], congr }

@[simp] lemma prob_event_uniform_select_list_bind_eq_tsum (e : set β) :
  ⁅e | ($ˡ xs h) >>= ob⁆ = (∑' x, xs.count x * ⁅e | ob x⁆) / xs.length :=
begin
  rw [list.empty_iff_eq_nil] at h,
  simp only [uniform_select_list, prob_event_uniform_select_vector_bind_eq_tsum,
    vector.to_list_mk, nat.succ_pred_eq_of_pos (list.length_pos_of_ne_nil h)],
end

lemma prob_event_uniform_select_list_bind_eq_sum (e : set β) :
  ⁅e | ($ˡ xs h) >>= ob⁆ = (∑ x in xs.to_finset, xs.count x * ⁅e | ob x⁆) / xs.length :=
begin
  rw [list.empty_iff_eq_nil] at h,
  simp only [uniform_select_list, prob_event_uniform_select_vector_bind_eq_sum,
    vector.to_list_mk, nat.succ_pred_eq_of_pos (list.length_pos_of_ne_nil h)],
end

end prob_event

end uniform_select_list

section uniform_select_finset

/-- We can sample randomly from a `finset` by converting to a list and then sampling that. -/
@[derive decidable] noncomputable def uniform_select_finset [decidable_eq α]
  (bag : finset α) (h : bag.nonempty) : oracle_comp uniform_selecting α :=
uniform_select_list bag.to_list (finset.nonempty.not_empty_to_list h)

notation `$ˢ` := uniform_select_finset

variables [decidable_eq α] (bag : finset α) (h : bag.nonempty)
  (ob : α → oracle_comp uniform_selecting β) (x : α) (y : β)

/-- Assuming we sample from `∅`, we can treat this as any other computation,
using the provided contradictory proof that `∅` is non-empty. -/
lemma uniform_select_finset_empty (h : (∅ : finset α).nonempty)
  (oa : oracle_comp uniform_selecting α) : $ˢ ∅ h = oa :=
false.elim (finset.nonempty.ne_empty h rfl)

section support

@[simp] lemma support_uniform_select_finset : ($ˢ bag h).support = ↑bag :=
by simp only [uniform_select_finset, support_uniform_select_list,
  finset.mem_to_list, finset.set_of_mem]

lemma mem_support_uniform_select_finset_iff : x ∈ ($ˢ bag h).support ↔ x ∈ bag :=
by rw [support_uniform_select_finset, finset.mem_coe]

end support

section fin_support

@[simp] lemma fin_support_uniform_select_finset : ($ˢ bag h).fin_support = bag :=
by rw [fin_support_eq_iff_support_eq_coe, support_uniform_select_finset]

lemma mem_fin_support_uniform_select_finset_iff : x ∈ ($ˢ bag h).fin_support ↔ x ∈ bag :=
by rw [fin_support_uniform_select_finset]

end fin_support

section eval_dist

@[simp] lemma eval_dist_uniform_select_finset : ⁅$ˢ bag h⁆ = pmf.uniform_of_finset bag h :=
by rw [uniform_select_finset, eval_dist_uniform_select_list,
  pmf.uniform_of_finset_eq_uniform_of_list_to_list]

lemma eval_dist_uniform_select_finset_apply : ⁅$ˢ bag h⁆ x = ite (x ∈ bag) bag.card⁻¹ 0 :=
by { rw [eval_dist_uniform_select_finset, pmf.uniform_of_finset_apply], congr }

lemma eval_dist_uniform_select_finset_bind_apply_eq_tsum :
  ⁅$ˢ bag h >>= ob⁆ y = (∑' x, ite (x ∈ bag) (⁅ob x⁆ y) 0) / bag.card :=
by simp only [uniform_select_finset, eval_dist_uniform_select_list_bind_apply_eq_tsum,
  finset.count_to_list, finset.to_list_to_finset, nat.cast_ite, algebra_map.coe_one,
  algebra_map.coe_zero, boole_mul, finset.sum_ite_mem, finset.inter_self, finset.length_to_list]

lemma eval_dist_uniform_select_finset_bind_apply_eq_sum  :
  ⁅$ˢ bag h >>= ob⁆ y = (∑ x in bag, ⁅ob x⁆ y) / bag.card :=
by simp only [uniform_select_finset, eval_dist_uniform_select_list_bind_apply_eq_sum,
  finset.count_to_list, finset.to_list_to_finset, nat.cast_ite, algebra_map.coe_one,
  algebra_map.coe_zero, boole_mul, finset.sum_ite_mem, finset.inter_self, finset.length_to_list]

end eval_dist

section prob_event

@[simp] lemma prob_event_uniform_select_finset (e : set α) [decidable_pred e] :
  ⁅e | $ˢ bag h⁆ = (bag.filter (∈ e)).card / bag.card :=
by { rw [prob_event.def, eval_dist_uniform_select_finset,
  to_outer_measure_uniform_of_finset_apply], congr }

lemma prob_event_uniform_select_finset_bind_eq_tsum (e : set β) :
  ⁅e | ($ˢ bag h) >>= ob⁆ = (∑' x, ite (x ∈ bag) ⁅e | ob x⁆ 0) / bag.card :=
by simp only [uniform_select_finset, prob_event_uniform_select_list_bind_eq_tsum,
  finset.count_to_list, finset.to_list_to_finset, nat.cast_ite, algebra_map.coe_one,
  algebra_map.coe_zero, boole_mul, finset.sum_ite_mem, finset.inter_self, finset.length_to_list]

lemma prob_event_uniform_select_finset_bind_eq_sum (e : set β) :
  ⁅e | $ˢ bag h >>= ob⁆ = (∑ x in bag, ⁅e | ob x⁆) / bag.card :=
by simp only [uniform_select_finset, prob_event_uniform_select_list_bind_eq_sum,
  finset.count_to_list, finset.to_list_to_finset, nat.cast_ite, algebra_map.coe_one,
  algebra_map.coe_zero, boole_mul, finset.sum_ite_mem, finset.inter_self, finset.length_to_list]

end prob_event

end uniform_select_finset

section uniform_select_fintype

/-- We can select randomly from a fintyp by using the `finset` corresponding to the `fintype`.
  Again we need to use axiom of choice so this operation is noncomputable. -/
@[derive decidable] noncomputable def uniform_select_fintype (α : Type) [fintype α] [nonempty α]
  [decidable_eq α] : oracle_comp uniform_selecting α :=
uniform_select_finset finset.univ finset.univ_nonempty

notation `$ᵗ` := uniform_select_fintype

variables (α) [fintype α] [nonempty α] [decidable_eq α]
  (ob : α → oracle_comp uniform_selecting β) (x : α) (y : β)

section support

@[simp] lemma support_uniform_select_fintype : ($ᵗ α).support = ⊤ :=
by rw [uniform_select_fintype, support_uniform_select_finset,
  set.top_eq_univ, finset.coe_eq_univ]

lemma mem_support_uniform_select_fintype : x ∈ ($ᵗ α).support :=
by simp only [support_uniform_select_fintype]

end support

section fin_support

@[simp] lemma fin_support_uniform_select_fintype : ($ᵗ α).fin_support = finset.univ :=
by rw [fin_support_eq_iff_support_eq_coe, support_uniform_select_fintype,
  set.top_eq_univ, finset.coe_univ]

lemma mem_fin_support_uniform_select_fintype : x ∈ ($ᵗ α).fin_support :=
by simp only [fin_support_uniform_select_fintype, finset.mem_univ]

end fin_support

section eval_dist

@[simp] lemma eval_dist_uniform_select_fintype : ⁅$ᵗ α⁆ = pmf.uniform_of_fintype α :=
by rw [uniform_select_fintype, eval_dist_uniform_select_finset, pmf.uniform_of_fintype]

lemma eval_dist_uniform_select_fintype_apply : ⁅$ᵗ α⁆ x = (fintype.card α)⁻¹ :=
by rw [eval_dist_uniform_select_fintype, pmf.uniform_of_fintype_apply]

lemma eval_dist_uniform_select_fintype_bind_apply_eq_tsum :
  ⁅($ᵗ α) >>= ob⁆ y = (∑' x, ⁅ob x⁆ y) / fintype.card α :=
by simp only [uniform_select_fintype, eval_dist_uniform_select_finset_bind_apply_eq_tsum,
  finset.mem_univ, if_true, finset.card_univ]

lemma eval_dist_uniform_select_fintype_bind_apply_eq_sum :
  ⁅($ᵗ α) >>= ob⁆ y = (∑ x, ⁅ob x⁆ y) / fintype.card α :=
by simp only [uniform_select_fintype, eval_dist_uniform_select_finset_bind_apply_eq_sum,
  finset.mem_univ, if_true, finset.card_univ]

end eval_dist

section prob_event

@[simp] lemma prob_event_uniform_select_fintype (e : set α) [decidable_pred e] :
  ⁅e | $ᵗ α⁆ = fintype.card e / fintype.card α :=
by { simp only [prob_event.def, eval_dist_uniform_select_fintype,
  to_outer_measure_uniform_of_fintype_apply, finset.mem_univ, if_true, finset.card_univ], congr }

lemma prob_event_uniform_select_fintype_bind_eq_tsum (e : set β) :
  ⁅e | $ᵗ α >>= ob⁆ = (∑' a, ⁅e | ob a⁆) / fintype.card α :=
by simp only [uniform_select_fintype, prob_event_uniform_select_finset_bind_eq_tsum,
  finset.mem_univ, if_true, finset.card_univ]

lemma prob_event_uniform_select_fintype_bind_eq_sum (e : set β) :
  ⁅e | $ᵗ α >>= ob⁆ = (∑ a, ⁅e | ob a⁆) / fintype.card α :=
by simp only [uniform_select_fintype, prob_event_uniform_select_finset_bind_eq_sum,
  finset.mem_univ, if_true, finset.card_univ]

end prob_event

end uniform_select_fintype

end oracle_comp


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.pairwise
import Mathlib.data.list.forall2
import Mathlib.PostPort

universes u v u_1

namespace Mathlib

/-!
# Lists with no duplicates

`list.nodup` is defined in `data/list/defs`. In this file we prove various properties of this
predicate.
-/

namespace list

@[simp] theorem forall_mem_ne {α : Type u} {a : α} {l : List α} :
    (∀ (a' : α), a' ∈ l → ¬a = a') ↔ ¬a ∈ l :=
  { mp := fun (h : ∀ (a' : α), a' ∈ l → ¬a = a') (m : a ∈ l) => h a m rfl,
    mpr := fun (h : ¬a ∈ l) (a' : α) (m : a' ∈ l) (e : a = a') => h (Eq.symm e ▸ m) }

@[simp] theorem nodup_nil {α : Type u} : nodup [] := pairwise.nil

@[simp] theorem nodup_cons {α : Type u} {a : α} {l : List α} : nodup (a :: l) ↔ ¬a ∈ l ∧ nodup l :=
  sorry

protected theorem pairwise.nodup {α : Type u} {l : List α} {r : α → α → Prop} [is_irrefl α r]
    (h : pairwise r l) : nodup l :=
  pairwise.imp (fun (a b : α) => ne_of_irrefl) h

theorem rel_nodup {α : Type u} {β : Type v} {r : α → β → Prop} (hr : relator.bi_unique r) :
    relator.lift_fun (forall₂ r) Iff nodup nodup :=
  sorry

theorem nodup_cons_of_nodup {α : Type u} {a : α} {l : List α} (m : ¬a ∈ l) (n : nodup l) :
    nodup (a :: l) :=
  iff.mpr nodup_cons { left := m, right := n }

theorem nodup_singleton {α : Type u} (a : α) : nodup [a] :=
  nodup_cons_of_nodup (not_mem_nil a) nodup_nil

theorem nodup_of_nodup_cons {α : Type u} {a : α} {l : List α} (h : nodup (a :: l)) : nodup l :=
  and.right (iff.mp nodup_cons h)

theorem not_mem_of_nodup_cons {α : Type u} {a : α} {l : List α} (h : nodup (a :: l)) : ¬a ∈ l :=
  and.left (iff.mp nodup_cons h)

theorem not_nodup_cons_of_mem {α : Type u} {a : α} {l : List α} : a ∈ l → ¬nodup (a :: l) :=
  iff.mp imp_not_comm not_mem_of_nodup_cons

theorem nodup_of_sublist {α : Type u} {l₁ : List α} {l₂ : List α} :
    l₁ <+ l₂ → nodup l₂ → nodup l₁ :=
  pairwise_of_sublist

theorem not_nodup_pair {α : Type u} (a : α) : ¬nodup [a, a] :=
  not_nodup_cons_of_mem (mem_singleton_self a)

theorem nodup_iff_sublist {α : Type u} {l : List α} : nodup l ↔ ∀ (a : α), ¬[a, a] <+ l := sorry

theorem nodup_iff_nth_le_inj {α : Type u} {l : List α} :
    nodup l ↔
        ∀ (i j : ℕ) (h₁ : i < length l) (h₂ : j < length l),
          nth_le l i h₁ = nth_le l j h₂ → i = j :=
  sorry

@[simp] theorem nth_le_index_of {α : Type u} [DecidableEq α] {l : List α} (H : nodup l) (n : ℕ)
    (h : n < length l) : index_of (nth_le l n h) l = n :=
  iff.mp nodup_iff_nth_le_inj H (index_of (nth_le l n h) l) n
    (iff.mpr index_of_lt_length (nth_le_mem l n h)) h
    (index_of_nth_le (iff.mpr index_of_lt_length (nth_le_mem l n h)))

theorem nodup_iff_count_le_one {α : Type u} [DecidableEq α] {l : List α} :
    nodup l ↔ ∀ (a : α), count a l ≤ 1 :=
  sorry

theorem nodup_repeat {α : Type u} (a : α) {n : ℕ} : nodup (repeat a n) ↔ n ≤ 1 := sorry

@[simp] theorem count_eq_one_of_mem {α : Type u} [DecidableEq α] {a : α} {l : List α} (d : nodup l)
    (h : a ∈ l) : count a l = 1 :=
  le_antisymm (iff.mp nodup_iff_count_le_one d a) (iff.mpr count_pos h)

theorem nodup_of_nodup_append_left {α : Type u} {l₁ : List α} {l₂ : List α} :
    nodup (l₁ ++ l₂) → nodup l₁ :=
  nodup_of_sublist (sublist_append_left l₁ l₂)

theorem nodup_of_nodup_append_right {α : Type u} {l₁ : List α} {l₂ : List α} :
    nodup (l₁ ++ l₂) → nodup l₂ :=
  nodup_of_sublist (sublist_append_right l₁ l₂)

theorem nodup_append {α : Type u} {l₁ : List α} {l₂ : List α} :
    nodup (l₁ ++ l₂) ↔ nodup l₁ ∧ nodup l₂ ∧ disjoint l₁ l₂ :=
  sorry

theorem disjoint_of_nodup_append {α : Type u} {l₁ : List α} {l₂ : List α} (d : nodup (l₁ ++ l₂)) :
    disjoint l₁ l₂ :=
  and.right (and.right (iff.mp nodup_append d))

theorem nodup_append_of_nodup {α : Type u} {l₁ : List α} {l₂ : List α} (d₁ : nodup l₁)
    (d₂ : nodup l₂) (dj : disjoint l₁ l₂) : nodup (l₁ ++ l₂) :=
  iff.mpr nodup_append { left := d₁, right := { left := d₂, right := dj } }

theorem nodup_append_comm {α : Type u} {l₁ : List α} {l₂ : List α} :
    nodup (l₁ ++ l₂) ↔ nodup (l₂ ++ l₁) :=
  sorry

theorem nodup_middle {α : Type u} {a : α} {l₁ : List α} {l₂ : List α} :
    nodup (l₁ ++ a :: l₂) ↔ nodup (a :: (l₁ ++ l₂)) :=
  sorry

theorem nodup_of_nodup_map {α : Type u} {β : Type v} (f : α → β) {l : List α} :
    nodup (map f l) → nodup l :=
  pairwise_of_pairwise_map f fun (a b : α) => mt (congr_arg f)

theorem nodup_map_on {α : Type u} {β : Type v} {f : α → β} {l : List α}
    (H : ∀ (x : α), x ∈ l → ∀ (y : α), y ∈ l → f x = f y → x = y) (d : nodup l) : nodup (map f l) :=
  sorry

theorem nodup_map {α : Type u} {β : Type v} {f : α → β} {l : List α} (hf : function.injective f) :
    nodup l → nodup (map f l) :=
  nodup_map_on fun (x : α) (_x : x ∈ l) (y : α) (_x : y ∈ l) (h : f x = f y) => hf h

theorem nodup_map_iff {α : Type u} {β : Type v} {f : α → β} {l : List α}
    (hf : function.injective f) : nodup (map f l) ↔ nodup l :=
  { mp := nodup_of_nodup_map f, mpr := nodup_map hf }

@[simp] theorem nodup_attach {α : Type u} {l : List α} : nodup (attach l) ↔ nodup l := sorry

theorem nodup_pmap {α : Type u} {β : Type v} {p : α → Prop} {f : (a : α) → p a → β} {l : List α}
    {H : ∀ (a : α), a ∈ l → p a}
    (hf : ∀ (a : α) (ha : p a) (b : α) (hb : p b), f a ha = f b hb → a = b) (h : nodup l) :
    nodup (pmap f l H) :=
  sorry

theorem nodup_filter {α : Type u} (p : α → Prop) [decidable_pred p] {l : List α} :
    nodup l → nodup (filter p l) :=
  pairwise_filter_of_pairwise p

@[simp] theorem nodup_reverse {α : Type u} {l : List α} : nodup (reverse l) ↔ nodup l := sorry

theorem nodup_erase_eq_filter {α : Type u} [DecidableEq α] (a : α) {l : List α} (d : nodup l) :
    list.erase l a = filter (fun (_x : α) => _x ≠ a) l :=
  sorry

theorem nodup_erase_of_nodup {α : Type u} [DecidableEq α] (a : α) {l : List α} :
    nodup l → nodup (list.erase l a) :=
  nodup_of_sublist (erase_sublist a l)

theorem nodup_diff {α : Type u} [DecidableEq α] {l₁ : List α} {l₂ : List α} (h : nodup l₁) :
    nodup (list.diff l₁ l₂) :=
  sorry

theorem mem_erase_iff_of_nodup {α : Type u} [DecidableEq α] {a : α} {b : α} {l : List α}
    (d : nodup l) : a ∈ list.erase l b ↔ a ≠ b ∧ a ∈ l :=
  sorry

theorem mem_erase_of_nodup {α : Type u} [DecidableEq α] {a : α} {l : List α} (h : nodup l) :
    ¬a ∈ list.erase l a :=
  fun (H : a ∈ list.erase l a) => and.left (iff.mp (mem_erase_iff_of_nodup h) H) rfl

theorem nodup_join {α : Type u} {L : List (List α)} :
    nodup (join L) ↔ (∀ (l : List α), l ∈ L → nodup l) ∧ pairwise disjoint L :=
  sorry

theorem nodup_bind {α : Type u} {β : Type v} {l₁ : List α} {f : α → List β} :
    nodup (list.bind l₁ f) ↔
        (∀ (x : α), x ∈ l₁ → nodup (f x)) ∧ pairwise (fun (a b : α) => disjoint (f a) (f b)) l₁ :=
  sorry

theorem nodup_product {α : Type u} {β : Type v} {l₁ : List α} {l₂ : List β} (d₁ : nodup l₁)
    (d₂ : nodup l₂) : nodup (product l₁ l₂) :=
  sorry

theorem nodup_sigma {α : Type u} {σ : α → Type u_1} {l₁ : List α} {l₂ : (a : α) → List (σ a)}
    (d₁ : nodup l₁) (d₂ : ∀ (a : α), nodup (l₂ a)) : nodup (list.sigma l₁ l₂) :=
  sorry

theorem nodup_filter_map {α : Type u} {β : Type v} {f : α → Option β} {l : List α}
    (H : ∀ (a a' : α) (b : β), b ∈ f a → b ∈ f a' → a = a') : nodup l → nodup (filter_map f l) :=
  pairwise_filter_map_of_pairwise f
    fun (a a' : α) (n : a ≠ a') (b : β) (bm : b ∈ f a) (b' : β) (bm' : b' ∈ f a') (e : b = b') =>
      n (H a a' b' (e ▸ bm) bm')

theorem nodup_concat {α : Type u} {a : α} {l : List α} (h : ¬a ∈ l) (h' : nodup l) :
    nodup (concat l a) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nodup (concat l a))) (concat_eq_append a l)))
    (nodup_append_of_nodup h' (nodup_singleton a) (iff.mpr disjoint_singleton h))

theorem nodup_insert {α : Type u} [DecidableEq α] {a : α} {l : List α} (h : nodup l) :
    nodup (insert a l) :=
  sorry

theorem nodup_union {α : Type u} [DecidableEq α] (l₁ : List α) {l₂ : List α} (h : nodup l₂) :
    nodup (l₁ ∪ l₂) :=
  sorry

theorem nodup_inter_of_nodup {α : Type u} [DecidableEq α] {l₁ : List α} (l₂ : List α) :
    nodup l₁ → nodup (l₁ ∩ l₂) :=
  nodup_filter fun (_x : α) => _x ∈ l₂

@[simp] theorem nodup_sublists {α : Type u} {l : List α} : nodup (sublists l) ↔ nodup l := sorry

@[simp] theorem nodup_sublists' {α : Type u} {l : List α} : nodup (sublists' l) ↔ nodup l := sorry

theorem nodup_sublists_len {α : Type u_1} (n : ℕ) {l : List α} (nd : nodup l) :
    nodup (sublists_len n l) :=
  nodup_of_sublist (sublists_len_sublist_sublists' n l) (iff.mpr nodup_sublists' nd)

theorem diff_eq_filter_of_nodup {α : Type u} [DecidableEq α] {l₁ : List α} {l₂ : List α}
    (hl₁ : nodup l₁) : list.diff l₁ l₂ = filter (fun (_x : α) => ¬_x ∈ l₂) l₁ :=
  sorry

theorem mem_diff_iff_of_nodup {α : Type u} [DecidableEq α] {l₁ : List α} {l₂ : List α}
    (hl₁ : nodup l₁) {a : α} : a ∈ list.diff l₁ l₂ ↔ a ∈ l₁ ∧ ¬a ∈ l₂ :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (a ∈ list.diff l₁ l₂ ↔ a ∈ l₁ ∧ ¬a ∈ l₂)) (diff_eq_filter_of_nodup hl₁)))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (a ∈ filter (fun (_x : α) => ¬_x ∈ l₂) l₁ ↔ a ∈ l₁ ∧ ¬a ∈ l₂))
          (propext mem_filter)))
      (iff.refl (a ∈ l₁ ∧ ¬a ∈ l₂)))

theorem nodup_update_nth {α : Type u} {l : List α} {n : ℕ} {a : α} (hl : nodup l) (ha : ¬a ∈ l) :
    nodup (update_nth l n a) :=
  sorry

theorem nodup.map_update {α : Type u} {β : Type v} [DecidableEq α] {l : List α} (hl : nodup l)
    (f : α → β) (x : α) (y : β) :
    map (function.update f x y) l = ite (x ∈ l) (update_nth (map f l) (index_of x l) y) (map f l) :=
  sorry

end list

theorem option.to_list_nodup {α : Type u_1} (o : Option α) : list.nodup (option.to_list o) :=
  option.cases_on o (idRhs (list.nodup []) list.nodup_nil)
    fun (o : α) => idRhs (list.nodup [o]) (list.nodup_singleton o)

end Mathlib


import tactic
/-

# Solution to the `pals` question

Let X be a fixed set. If φ : X → A is a function then let’s define the equivalence relation
Rφ on X associated to φ by Rφ(s, t) ⇐⇒ φ(s) = φ(t) (you can check it’s an equivalence
relation if you like). Of course as φ and A vary we can get lots of different equivalence relations
on X in this way.
We say two surjections f : X → Y and g : X → Z are pals if there exists a bijection h : Y → Z
such that g = h ◦ f . Prove that f and g are pals if and only if the equivalence relations Rf
and Rg on X associated to f and g are equal (by which I mean that for all s, t ∈ X, we have
Rf (s, t) ⇐⇒ Rg(s, t)).
-/

-- Let `X` be a set
constant X : Type

-- Let `S` be the set of triples consisting of a set, and a surjection from `X` to that set
structure S :=
(Y : Type)
(f : X → Y)
(hf : f.surjective)

-- Internally an element `a` of `S` is a set `a.Y`, a function `a.f : X → a.Y` and
-- a proof `a.hf` that `a.f` is surjective. But we would like to treat elements of `S`
-- as functions! More precisely we want `a` to be identified with the function `a.f`
-- when we treat it as a function. So let's tell this to Lean
instance : has_coe_to_fun S (λ a, X → a.Y) := ⟨λ a, a.f⟩

-- Let's define what it means for two elements of S to be pals
def pals (a b : S) : Prop :=
-- Say f : X → Y and g : X → Z are in S
let ⟨Y, f, hf⟩ := a, ⟨Z, g, hg⟩ := b in
-- Then they're pals iff there exists a bijection `h` from Y to Z
-- such that `∀ x, g(x)=h(f(x))
∃ h : Y ≃ Z, ∀ x : X, g x = h (f x)

-- The claim: Two surjections are pals if and only if their associated binary relations
-- are equal in the sense of binary relations
theorem pals_iff_relations_equal : ∀ f g : S, pals f g ↔ ∀ s t : X,
  f s = f t ↔ g s = g t :=
begin
  -- Let `f : X → Y` and `g : X → Z` be surjections.
  rintro ⟨Y, f, hf⟩ ⟨Z, g, hg⟩,
  -- We need to prove the implications in both directions
  split,
  { -- First let's assume `f` and `g` are pals, and that `h` is the associated
    -- bijection
    rintro ⟨h, hpals⟩,
    -- We now need to prove that if x₁ and x₂ are arbitrary elements of X,
    rintro x₁ x₂,
    -- then f x₁ = f x₂ ↔ g x₁ = g x₂
    show f x₁ = f x₂ ↔ g x₁ = g x₂,
    -- Well, we know g = h ∘ f so we need to show
    -- f x₁ = f x₂ ↔ h (f x₁) = h (f x₂)
    simp only [hpals],
    -- Left to right is obvious
    split, rintro h, rw h,
    -- Right to left is exactly injectivity of `h`,
    apply h.injective, },
  { -- Now the other way: assume that ∀ x₁ and x₂, f x₁ = fx₂ ↔ g x₁ = g x₂
    rintro hrel : forall x₁ x₂, f x₁ = f x₂ ↔ g x₁ = g x₂,
    -- Let's prove that `f` and `g` are pals by finding a bijection from `Y` to `Z`.
    -- We know that `f` is surjective, so `∀ y ∈ Y, ∃ x ∈ X with f(x)=y.
    -- Let's define `finv : Y → X` by letting `finv(y)` be an arbitrary element
    -- `x` of `X` such that `f(x)=y`. By definition of `finv` we know that
    -- `∀ y ∈ Y, f(finv y)=y`. Let's call this `hyp1`. Note that this does
    -- *not* imply that `finv` is a *two-sided* bijection for `f`, as we don't
    -- know that `finv(f(x))=x` in general.
    choose finv hyp1 using hf,
    -- Similarly let's define `ginv : Z → X` such that `∀ z ∈ Z, g (ginv z)=z`,
    -- and let's let `hyp2` denote this statement.
    choose ginv hyp2 using hg,
    -- Let's define `h : Y → Z` to be `g ∘ finv`
    -- and let's define `j : Z → Y` to be `f ∘ ginv`
    let h : Y → Z := g ∘ finv,
    let j : Z → Y := f ∘ ginv,
    -- I claim that `h` and `j` are two-sided inverses, and hence `h` is a bijection.
    -- Let's first show that this claim implies that `f` and `g` are pals.
    suffices : j.left_inverse h ∧ j.right_inverse h,
    { -- Of course we use `h`
      use ⟨h, j, this.1, this.2⟩,
      -- and now we have to prove that ∀ x, g(x)=h(f(x))
      intro x,
      show g(x)=h(f(x)),
      -- Well by definition h=g∘finv
      show g(x)=g(finv(f(x))),
      -- and we know g(x₁)=g(x₂) ↔ f(x₁)=f(x₂)
      rw ← hrel,
      -- so it suffices to prove f(x)=f(finv(f(x))),
      -- but this is immediate from `hyp1`
      rw hyp1, },
    -- It remains to prove that `h` and `j` are two-sided inverses.
    split,
    { -- Let's start by showing that ∀ y ∈ Y, j(h(y))=y. Let y ∈ Y be arbitrary.
      intro y,
      -- By definition of j and h, we need to show that f(ginv(g(finv(y))))=y
      show f (ginv (g (finv(y)))) = y,
      -- By hyp1, we know y=f(finv(y)), so we need to show f(ginv(g(finv(y))))=f(finv(y))
      conv_rhs {rw ← hyp1 y},
      -- But we know f(x₁)=f(x₂) ↔ g(x₁)=g(x₂) so we can replace the first f's by g's
      rw hrel,
      -- and now we can cancel g ∘ ginv because of hyp2, and we're done
      rw hyp2, },
    { -- The other way is pretty much exactly the same
      intro z,
      conv_rhs {rw ← hyp2 z},
      rw [← hrel, hyp1], } }
end


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Fabian Glöckle
-/
import linear_algebra.finite_dimensional
import linear_algebra.projection

/-!
# Dual vector spaces

The dual space of an R-module M is the R-module of linear maps `M → R`.

## Main definitions

* `dual R M` defines the dual space of M over R.
* Given a basis for an `R`-module `M`, `basis.to_dual` produces a map from `M` to `dual R M`.
* Given families of vectors `e` and `ε`, `dual_pair e ε` states that these families have the
  characteristic properties of a basis and a dual.
* `dual_annihilator W` is the submodule of `dual R M` where every element annihilates `W`.

## Main results

* `to_dual_equiv` : the linear equivalence between the dual module and primal module,
  given a finite basis.
* `dual_pair.basis` and `dual_pair.eq_dual`: if `e` and `ε` form a dual pair, `e` is a basis and
  `ε` is its dual basis.
* `quot_equiv_annihilator`: the quotient by a subspace is isomorphic to its dual annihilator.

## Notation

We sometimes use `V'` as local notation for `dual K V`.

## TODO

Erdös-Kaplansky theorem about the dimension of a dual vector space in case of infinite dimension.
-/

noncomputable theory

namespace module

variables (R : Type*) (M : Type*)
variables [comm_semiring R] [add_comm_monoid M] [module R M]

/-- The dual space of an R-module M is the R-module of linear maps `M → R`. -/
@[derive [add_comm_monoid, module R]] def dual := M →ₗ[R] R

instance {S : Type*} [comm_ring S] {N : Type*} [add_comm_group N] [module S N] :
  add_comm_group (dual S N) := by {unfold dual, apply_instance}

instance : add_monoid_hom_class (dual R M) M R :=
linear_map.add_monoid_hom_class

namespace dual

instance : inhabited (dual R M) := by dunfold dual; apply_instance

instance : has_coe_to_fun (dual R M) (λ _, M → R) := ⟨linear_map.to_fun⟩

/-- Maps a module M to the dual of the dual of M. See `module.erange_coe` and
`module.eval_equiv`. -/
def eval : M →ₗ[R] (dual R (dual R M)) := linear_map.flip linear_map.id

@[simp] lemma eval_apply (v : M) (a : dual R M) : eval R M v a = a v :=
begin
  dunfold eval,
  rw [linear_map.flip_apply, linear_map.id_apply]
end

variables {R M} {M' : Type*} [add_comm_monoid M'] [module R M']

/-- The transposition of linear maps, as a linear map from `M →ₗ[R] M'` to
`dual R M' →ₗ[R] dual R M`. -/
def transpose : (M →ₗ[R] M') →ₗ[R] (dual R M' →ₗ[R] dual R M) :=
(linear_map.llcomp R M M' R).flip

lemma transpose_apply (u : M →ₗ[R] M') (l : dual R M') : transpose u l = l.comp u := rfl

variables {M'' : Type*} [add_comm_monoid M''] [module R M'']

lemma transpose_comp (u : M' →ₗ[R] M'') (v : M →ₗ[R] M') :
  transpose (u.comp v) = (transpose v).comp (transpose u) := rfl

end dual

end module

namespace basis

universes u v w

open module module.dual submodule linear_map cardinal function

variables {R M K V ι : Type*}

section comm_semiring

variables [comm_semiring R] [add_comm_monoid M] [module R M] [decidable_eq ι]
variables (b : basis ι R M)

/-- The linear map from a vector space equipped with basis to its dual vector space,
taking basis elements to corresponding dual basis elements. -/
def to_dual : M →ₗ[R] module.dual R M :=
b.constr ℕ $ λ v, b.constr ℕ $ λ w, if w = v then (1 : R) else 0

lemma to_dual_apply (i j : ι) :
  b.to_dual (b i) (b j) = if i = j then 1 else 0 :=
by { erw [constr_basis b, constr_basis b], ac_refl }

@[simp] lemma to_dual_total_left (f : ι →₀ R) (i : ι) :
  b.to_dual (finsupp.total ι M R b f) (b i) = f i :=
begin
  rw [finsupp.total_apply, finsupp.sum, linear_map.map_sum, linear_map.sum_apply],
  simp_rw [linear_map.map_smul, linear_map.smul_apply, to_dual_apply, smul_eq_mul,
           mul_boole, finset.sum_ite_eq'],
  split_ifs with h,
  { refl },
  { rw finsupp.not_mem_support_iff.mp h }
end

@[simp] lemma to_dual_total_right (f : ι →₀ R) (i : ι) :
  b.to_dual (b i) (finsupp.total ι M R b f) = f i :=
begin
  rw [finsupp.total_apply, finsupp.sum, linear_map.map_sum],
  simp_rw [linear_map.map_smul, to_dual_apply, smul_eq_mul, mul_boole, finset.sum_ite_eq],
  split_ifs with h,
  { refl },
  { rw finsupp.not_mem_support_iff.mp h }
end

lemma to_dual_apply_left (m : M) (i : ι) : b.to_dual m (b i) = b.repr m i :=
by rw [← b.to_dual_total_left, b.total_repr]

lemma to_dual_apply_right (i : ι) (m : M) : b.to_dual (b i) m = b.repr m i :=
by rw [← b.to_dual_total_right, b.total_repr]

lemma coe_to_dual_self (i : ι) : b.to_dual (b i) = b.coord i :=
by { ext, apply to_dual_apply_right }

/-- `h.to_dual_flip v` is the linear map sending `w` to `h.to_dual w v`. -/
def to_dual_flip (m : M) : (M →ₗ[R] R) := b.to_dual.flip m

lemma to_dual_flip_apply (m₁ m₂ : M) : b.to_dual_flip m₁ m₂ = b.to_dual m₂ m₁ := rfl

lemma to_dual_eq_repr (m : M) (i : ι) : b.to_dual m (b i) = b.repr m i :=
b.to_dual_apply_left m i

lemma to_dual_eq_equiv_fun [fintype ι] (m : M) (i : ι) : b.to_dual m (b i) = b.equiv_fun m i :=
by rw [b.equiv_fun_apply, to_dual_eq_repr]

lemma to_dual_inj (m : M) (a : b.to_dual m = 0) : m = 0 :=
begin
  rw [← mem_bot R, ← b.repr.ker, mem_ker, linear_equiv.coe_coe],
  apply finsupp.ext,
  intro b,
  rw [← to_dual_eq_repr, a],
  refl
end

theorem to_dual_ker : b.to_dual.ker = ⊥ :=
ker_eq_bot'.mpr b.to_dual_inj

theorem to_dual_range [fin : fintype ι] : b.to_dual.range = ⊤ :=
begin
  rw eq_top_iff',
  intro f,
  rw linear_map.mem_range,
  let lin_comb : ι →₀ R := finsupp.on_finset fin.elems (λ i, f.to_fun (b i)) _,
  { use finsupp.total ι M R b lin_comb,
    apply b.ext,
    { intros i,
      rw [b.to_dual_eq_repr _ i, repr_total b],
      { refl } } },
  { intros a _,
    apply fin.complete }
end

end comm_semiring

section comm_ring

variables [comm_ring R] [add_comm_group M] [module R M] [decidable_eq ι]
variables (b : basis ι R M)

/-- A vector space is linearly equivalent to its dual space. -/
@[simps]
def to_dual_equiv [fintype ι] : M ≃ₗ[R] (dual R M) :=
linear_equiv.of_bijective b.to_dual
  (ker_eq_bot.mp b.to_dual_ker) (range_eq_top.mp b.to_dual_range)

/-- Maps a basis for `V` to a basis for the dual space. -/
def dual_basis [fintype ι] : basis ι R (dual R M) :=
b.map b.to_dual_equiv

-- We use `j = i` to match `basis.repr_self`
lemma dual_basis_apply_self [fintype ι] (i j : ι) :
  b.dual_basis i (b j) = if j = i then 1 else 0 :=
by { convert b.to_dual_apply i j using 2, rw @eq_comm _ j i }

lemma total_dual_basis [fintype ι] (f : ι →₀ R) (i : ι) :
  finsupp.total ι (dual R M) R b.dual_basis f (b i) = f i :=
begin
  rw [finsupp.total_apply, finsupp.sum_fintype, linear_map.sum_apply],
  { simp_rw [linear_map.smul_apply, smul_eq_mul, dual_basis_apply_self, mul_boole,
      finset.sum_ite_eq, if_pos (finset.mem_univ i)] },
  { intro, rw zero_smul },
end

lemma dual_basis_repr [fintype ι] (l : dual R M) (i : ι) :
  b.dual_basis.repr l i = l (b i) :=
by rw [← total_dual_basis b, basis.total_repr b.dual_basis l]

lemma dual_basis_equiv_fun [fintype ι] (l : dual R M) (i : ι) :
  b.dual_basis.equiv_fun l i = l (b i) :=
by rw [basis.equiv_fun_apply, dual_basis_repr]

lemma dual_basis_apply [fintype ι] (i : ι) (m : M) : b.dual_basis i m = b.repr m i :=
b.to_dual_apply_right i m

@[simp] lemma coe_dual_basis [fintype ι] :
  ⇑b.dual_basis = b.coord :=
by { ext i x, apply dual_basis_apply }

@[simp] lemma to_dual_to_dual [fintype ι] :
  b.dual_basis.to_dual.comp b.to_dual = dual.eval R M :=
begin
  refine b.ext (λ i, b.dual_basis.ext (λ j, _)),
  rw [linear_map.comp_apply, to_dual_apply_left, coe_to_dual_self, ← coe_dual_basis,
      dual.eval_apply, basis.repr_self, finsupp.single_apply, dual_basis_apply_self]
end

theorem eval_ker {ι : Type*} (b : basis ι R M) :
  (dual.eval R M).ker = ⊥ :=
begin
  rw ker_eq_bot',
  intros m hm,
  simp_rw [linear_map.ext_iff, dual.eval_apply, zero_apply] at hm,
  exact (basis.forall_coord_eq_zero_iff _).mp (λ i, hm (b.coord i))
end

lemma eval_range {ι : Type*} [fintype ι] (b : basis ι R M) :
  (eval R M).range = ⊤ :=
begin
  classical,
  rw [← b.to_dual_to_dual, range_comp, b.to_dual_range, map_top, to_dual_range _],
  apply_instance
end

/-- A module with a basis is linearly equivalent to the dual of its dual space. -/
def eval_equiv  {ι : Type*} [fintype ι] (b : basis ι R M) : M ≃ₗ[R] dual R (dual R M) :=
linear_equiv.of_bijective (eval R M)
  (ker_eq_bot.mp b.eval_ker) (range_eq_top.mp b.eval_range)

@[simp] lemma eval_equiv_to_linear_map {ι : Type*} [fintype ι] (b : basis ι R M) :
  (b.eval_equiv).to_linear_map = dual.eval R M := rfl

end comm_ring

/-- `simp` normal form version of `total_dual_basis` -/
@[simp] lemma total_coord [comm_ring R] [add_comm_group M] [module R M] [fintype ι]
  (b : basis ι R M) (f : ι →₀ R) (i : ι) :
  finsupp.total ι (dual R M) R b.coord f (b i) = f i :=
by { haveI := classical.dec_eq ι, rw [← coe_dual_basis, total_dual_basis] }

-- TODO(jmc): generalize to rings, once `module.rank` is generalized
theorem dual_dim_eq [field K] [add_comm_group V] [module K V] [fintype ι] (b : basis ι K V) :
  cardinal.lift (module.rank K V) = module.rank K (dual K V) :=
begin
  classical,
  have := linear_equiv.lift_dim_eq b.to_dual_equiv,
  simp only [cardinal.lift_umax] at this,
  rw [this, ← cardinal.lift_umax],
  apply cardinal.lift_id,
end

end basis

namespace module

variables {K V : Type*}
variables [field K] [add_comm_group V] [module K V]
open module module.dual submodule linear_map cardinal basis finite_dimensional

theorem eval_ker : (eval K V).ker = ⊥ :=
by { classical, exact (basis.of_vector_space K V).eval_ker }

-- TODO(jmc): generalize to rings, once `module.rank` is generalized
theorem dual_dim_eq [finite_dimensional K V] :
  cardinal.lift (module.rank K V) = module.rank K (dual K V) :=
(basis.of_vector_space K V).dual_dim_eq

lemma erange_coe [finite_dimensional K V] : (eval K V).range = ⊤ :=
begin
  letI : is_noetherian K V := is_noetherian.iff_fg.2 infer_instance,
  exact (basis.of_vector_space K V).eval_range
end

variables (K V)

/-- A vector space is linearly equivalent to the dual of its dual space. -/
def eval_equiv [finite_dimensional K V] : V ≃ₗ[K] dual K (dual K V) :=
linear_equiv.of_bijective (eval K V)
  (ker_eq_bot.mp eval_ker) (range_eq_top.mp erange_coe)

variables {K V}

@[simp] lemma eval_equiv_to_linear_map [finite_dimensional K V] :
  (eval_equiv K V).to_linear_map = dual.eval K V := rfl

end module

section dual_pair

open module

variables {R M ι : Type*}
variables [comm_ring R] [add_comm_group M] [module R M] [decidable_eq ι]

/-- `e` and `ε` have characteristic properties of a basis and its dual -/
@[nolint has_inhabited_instance]
structure dual_pair (e : ι → M) (ε : ι → (dual R M)) :=
(eval : ∀ i j : ι, ε i (e j) = if i = j then 1 else 0)
(total : ∀ {m : M}, (∀ i, ε i m = 0) → m = 0)
[finite : ∀ m : M, fintype {i | ε i m ≠ 0}]

end dual_pair

namespace dual_pair

open module module.dual linear_map function

variables {R M ι : Type*}
variables [comm_ring R] [add_comm_group M] [module R M]
variables {e : ι → M} {ε : ι → dual R M}

/-- The coefficients of `v` on the basis `e` -/
def coeffs [decidable_eq ι] (h : dual_pair e ε) (m : M) : ι →₀ R :=
{ to_fun := λ i, ε i m,
  support := by { haveI := h.finite m, exact {i : ι | ε i m ≠ 0}.to_finset },
  mem_support_to_fun := by {intro i, rw set.mem_to_finset, exact iff.rfl } }

@[simp]

/-- linear combinations of elements of `e`.
This is a convenient abbreviation for `finsupp.total _ M R e l` -/
def lc {ι} (e : ι → M) (l : ι →₀ R) : M := l.sum (λ (i : ι) (a : R), a • (e i))

lemma lc_def (e : ι → M) (l : ι →₀ R) : lc e l = finsupp.total _ _ _ e l := rfl

variables [decidable_eq ι] (h : dual_pair e ε)
include h

lemma dual_lc (l : ι →₀ R) (i : ι) : ε i (dual_pair.lc e l) = l i :=
begin
  erw linear_map.map_sum,
  simp only [h.eval, map_smul, smul_eq_mul],
  rw finset.sum_eq_single i,
  { simp },
  { intros q q_in q_ne,
    simp [q_ne.symm] },
  { intro p_not_in,
    simp [finsupp.not_mem_support_iff.1 p_not_in] },
end

@[simp]
lemma coeffs_lc (l : ι →₀ R) : h.coeffs (dual_pair.lc e l) = l :=
by { ext i, rw [h.coeffs_apply, h.dual_lc] }

/-- For any m : M n, \sum_{p ∈ Q n} (ε p m) • e p = m -/
@[simp]
lemma lc_coeffs (m : M) : dual_pair.lc e (h.coeffs m) = m :=
begin
  refine eq_of_sub_eq_zero (h.total _),
  intros i,
  simp [-sub_eq_add_neg, linear_map.map_sub, h.dual_lc, sub_eq_zero]
end

/-- `(h : dual_pair e ε).basis` shows the family of vectors `e` forms a basis. -/
@[simps]
def basis : basis ι R M :=
basis.of_repr
{ to_fun := coeffs h,
  inv_fun := lc e,
  left_inv := lc_coeffs h,
  right_inv := coeffs_lc h,
  map_add' := λ v w, by { ext i, exact (ε i).map_add v w },
  map_smul' := λ c v, by { ext i, exact (ε i).map_smul c v } }

@[simp] lemma coe_basis : ⇑h.basis = e :=
by { ext i, rw basis.apply_eq_iff, ext j,
     rw [h.basis_repr_apply, coeffs_apply, h.eval, finsupp.single_apply],
     convert if_congr eq_comm rfl rfl } -- `convert` to get rid of a `decidable_eq` mismatch

lemma mem_of_mem_span {H : set ι} {x : M} (hmem : x ∈ submodule.span R (e '' H)) :
  ∀ i : ι, ε i x ≠ 0 → i ∈ H :=
begin
  intros i hi,
  rcases (finsupp.mem_span_image_iff_total _).mp hmem with ⟨l, supp_l, rfl⟩,
  apply not_imp_comm.mp ((finsupp.mem_supported' _ _).mp supp_l i),
  rwa [← lc_def, h.dual_lc] at hi
end

lemma coe_dual_basis [fintype ι] : ⇑h.basis.dual_basis = ε :=
funext (λ i, h.basis.ext (λ j, by rw [h.basis.dual_basis_apply_self, h.coe_basis, h.eval,
                                      if_congr eq_comm rfl rfl]))

end dual_pair

namespace submodule

universes u v w

variables {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M]
variable {W : submodule R M}

/-- The `dual_restrict` of a submodule `W` of `M` is the linear map from the
  dual of `M` to the dual of `W` such that the domain of each linear map is
  restricted to `W`. -/
def dual_restrict (W : submodule R M) :
  module.dual R M →ₗ[R] module.dual R W :=
linear_map.dom_restrict' W

@[simp] lemma dual_restrict_apply
  (W : submodule R M) (φ : module.dual R M) (x : W) :
  W.dual_restrict φ x = φ (x : M) := rfl

/-- The `dual_annihilator` of a submodule `W` is the set of linear maps `φ` such
  that `φ w = 0` for all `w ∈ W`. -/
def dual_annihilator {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M]
  [module R M] (W : submodule R M) : submodule R $ module.dual R M :=
W.dual_restrict.ker

@[simp] lemma mem_dual_annihilator (φ : module.dual R M) :
  φ ∈ W.dual_annihilator ↔ ∀ w ∈ W, φ w = 0 :=
begin
  refine linear_map.mem_ker.trans _,
  simp_rw [linear_map.ext_iff, dual_restrict_apply],
  exact ⟨λ h w hw, h ⟨w, hw⟩, λ h w, h w.1 w.2⟩
end

lemma dual_restrict_ker_eq_dual_annihilator (W : submodule R M) :
  W.dual_restrict.ker = W.dual_annihilator :=
rfl

lemma dual_annihilator_sup_eq_inf_dual_annihilator (U V : submodule R M) :
  (U ⊔ V).dual_annihilator = U.dual_annihilator ⊓ V.dual_annihilator :=
begin
  ext φ,
  rw [mem_inf, mem_dual_annihilator, mem_dual_annihilator, mem_dual_annihilator],
  split; intro h,
  { refine ⟨_, _⟩;
    intros x hx,
    exact h x (mem_sup.2 ⟨x, hx, 0, zero_mem _, add_zero _⟩),
    exact h x (mem_sup.2 ⟨0, zero_mem _, x, hx, zero_add _⟩) },
  { simp_rw mem_sup,
    rintro _ ⟨x, hx, y, hy, rfl⟩,
    rw [linear_map.map_add, h.1 _ hx, h.2 _ hy, add_zero] }
end

/-- The pullback of a submodule in the dual space along the evaluation map. -/
def dual_annihilator_comap (Φ : submodule R (module.dual R M)) : submodule R M :=
Φ.dual_annihilator.comap (module.dual.eval R M)

lemma mem_dual_annihilator_comap_iff {Φ : submodule R (module.dual R M)} (x : M) :
  x ∈ Φ.dual_annihilator_comap ↔ ∀ φ ∈ Φ, (φ x : R) = 0 :=
by simp_rw [dual_annihilator_comap, mem_comap, mem_dual_annihilator, module.dual.eval_apply]

end submodule

namespace subspace

open submodule linear_map

universes u v w

-- We work in vector spaces because `exists_is_compl` only hold for vector spaces
variables {K : Type u} {V : Type v} [field K] [add_comm_group V] [module K V]

/-- Given a subspace `W` of `V` and an element of its dual `φ`, `dual_lift W φ` is
the natural extension of `φ` to an element of the dual of `V`.
That is, `dual_lift W φ` sends `w ∈ W` to `φ x` and `x` in the complement of `W` to `0`. -/
noncomputable def dual_lift (W : subspace K V) :
  module.dual K W →ₗ[K] module.dual K V :=
let h := classical.indefinite_description _ W.exists_is_compl in
  (linear_map.of_is_compl_prod h.2).comp (linear_map.inl _ _ _)

variable {W : subspace K V}

@[simp] lemma dual_lift_of_subtype {φ : module.dual K W} (w : W) :
  W.dual_lift φ (w : V) = φ w :=
by { erw of_is_compl_left_apply _ w, refl }

lemma dual_lift_of_mem {φ : module.dual K W} {w : V} (hw : w ∈ W) :
  W.dual_lift φ w = φ ⟨w, hw⟩ :=
dual_lift_of_subtype ⟨w, hw⟩

@[simp] lemma dual_restrict_comp_dual_lift (W : subspace K V) :
  W.dual_restrict.comp W.dual_lift = 1 :=
by { ext φ x, simp }

lemma dual_restrict_left_inverse (W : subspace K V) :
  function.left_inverse W.dual_restrict W.dual_lift :=
λ x, show W.dual_restrict.comp W.dual_lift x = x,
  by { rw [dual_restrict_comp_dual_lift], refl }

lemma dual_lift_right_inverse (W : subspace K V) :
  function.right_inverse W.dual_lift W.dual_restrict :=
W.dual_restrict_left_inverse

lemma dual_restrict_surjective :
  function.surjective W.dual_restrict :=
W.dual_lift_right_inverse.surjective

lemma dual_lift_injective : function.injective W.dual_lift :=
W.dual_restrict_left_inverse.injective

/-- The quotient by the `dual_annihilator` of a subspace is isomorphic to the
  dual of that subspace. -/
noncomputable def quot_annihilator_equiv (W : subspace K V) :
  (module.dual K V ⧸ W.dual_annihilator) ≃ₗ[K] module.dual K W :=
(quot_equiv_of_eq _ _ W.dual_restrict_ker_eq_dual_annihilator).symm.trans $
  W.dual_restrict.quot_ker_equiv_of_surjective dual_restrict_surjective

/-- The natural isomorphism forom the dual of a subspace `W` to `W.dual_lift.range`. -/
noncomputable def dual_equiv_dual (W : subspace K V) :
  module.dual K W ≃ₗ[K] W.dual_lift.range :=
linear_equiv.of_injective _ dual_lift_injective

lemma dual_equiv_dual_def (W : subspace K V) :
  W.dual_equiv_dual.to_linear_map = W.dual_lift.range_restrict := rfl

@[simp] lemma dual_equiv_dual_apply (φ : module.dual K W) :
  W.dual_equiv_dual φ = ⟨W.dual_lift φ, mem_range.2 ⟨φ, rfl⟩⟩ := rfl

section

open_locale classical

open finite_dimensional

variables {V₁ : Type*} [add_comm_group V₁] [module K V₁]

instance [H : finite_dimensional K V] : finite_dimensional K (module.dual K V) :=
linear_equiv.finite_dimensional (basis.of_vector_space K V).to_dual_equiv

variables [finite_dimensional K V] [finite_dimensional K V₁]

@[simp] lemma dual_finrank_eq :
  finrank K (module.dual K V) = finrank K V :=
linear_equiv.finrank_eq (basis.of_vector_space K V).to_dual_equiv.symm

/-- The quotient by the dual is isomorphic to its dual annihilator.  -/
noncomputable def quot_dual_equiv_annihilator (W : subspace K V) :
  (module.dual K V ⧸ W.dual_lift.range) ≃ₗ[K] W.dual_annihilator :=
linear_equiv.quot_equiv_of_quot_equiv $
  linear_equiv.trans W.quot_annihilator_equiv W.dual_equiv_dual

/-- The quotient by a subspace is isomorphic to its dual annihilator. -/
noncomputable def quot_equiv_annihilator (W : subspace K V) :
  (V ⧸ W) ≃ₗ[K] W.dual_annihilator :=
begin
  refine _ ≪≫ₗ W.quot_dual_equiv_annihilator,
  refine linear_equiv.quot_equiv_of_equiv _ (basis.of_vector_space K V).to_dual_equiv,
  exact (basis.of_vector_space K W).to_dual_equiv.trans W.dual_equiv_dual
end

open finite_dimensional

@[simp]
lemma finrank_dual_annihilator_comap_eq {Φ : subspace K (module.dual K V)} :
  finrank K Φ.dual_annihilator_comap = finrank K Φ.dual_annihilator :=
begin
  rw [submodule.dual_annihilator_comap, ← module.eval_equiv_to_linear_map],
  exact linear_equiv.finrank_eq (linear_equiv.of_submodule' _ _),
end

lemma finrank_add_finrank_dual_annihilator_comap_eq
  (W : subspace K (module.dual K V)) :
  finrank K W + finrank K W.dual_annihilator_comap = finrank K V :=
begin
  rw [finrank_dual_annihilator_comap_eq, W.quot_equiv_annihilator.finrank_eq.symm, add_comm,
      submodule.finrank_quotient_add_finrank, subspace.dual_finrank_eq],
end

end

end subspace

variables {R : Type*} [comm_ring R] {M₁ : Type*} {M₂ : Type*}
variables [add_comm_group M₁] [module R M₁] [add_comm_group M₂] [module R M₂]

open module

/-- Given a linear map `f : M₁ →ₗ[R] M₂`, `f.dual_map` is the linear map between the dual of
`M₂` and `M₁` such that it maps the functional `φ` to `φ ∘ f`. -/
def linear_map.dual_map (f : M₁ →ₗ[R] M₂) : dual R M₂ →ₗ[R] dual R M₁ :=
linear_map.lcomp R R f

@[simp] lemma linear_map.dual_map_apply (f : M₁ →ₗ[R] M₂) (g : dual R M₂) (x : M₁) :
  f.dual_map g x = g (f x) :=
linear_map.lcomp_apply f g x

@[simp] lemma linear_map.dual_map_id :
  (linear_map.id : M₁ →ₗ[R] M₁).dual_map = linear_map.id :=
by { ext, refl }

lemma linear_map.dual_map_comp_dual_map {M₃ : Type*} [add_comm_group M₃] [module R M₃]
  (f : M₁ →ₗ[R] M₂) (g : M₂ →ₗ[R] M₃) :
  f.dual_map.comp g.dual_map = (g.comp f).dual_map :=
rfl

/-- The `linear_equiv` version of `linear_map.dual_map`. -/
def linear_equiv.dual_map (f : M₁ ≃ₗ[R] M₂) : dual R M₂ ≃ₗ[R] dual R M₁ :=
{ inv_fun := f.symm.to_linear_map.dual_map,
  left_inv :=
    begin
      intro φ, ext x,
      simp only [linear_map.dual_map_apply, linear_equiv.coe_to_linear_map,
                 linear_map.to_fun_eq_coe, linear_equiv.apply_symm_apply]
    end,
  right_inv :=
    begin
      intro φ, ext x,
      simp only [linear_map.dual_map_apply, linear_equiv.coe_to_linear_map,
                 linear_map.to_fun_eq_coe, linear_equiv.symm_apply_apply]
    end,
  .. f.to_linear_map.dual_map }

@[simp] lemma linear_equiv.dual_map_apply (f : M₁ ≃ₗ[R] M₂) (g : dual R M₂) (x : M₁) :
  f.dual_map g x = g (f x) :=
linear_map.lcomp_apply f g x

@[simp] lemma linear_equiv.dual_map_refl :
  (linear_equiv.refl R M₁).dual_map = linear_equiv.refl R (dual R M₁) :=
by { ext, refl }

@[simp] lemma linear_equiv.dual_map_symm {f : M₁ ≃ₗ[R] M₂} :
  (linear_equiv.dual_map f).symm = linear_equiv.dual_map f.symm := rfl

lemma linear_equiv.dual_map_trans {M₃ : Type*} [add_comm_group M₃] [module R M₃]
  (f : M₁ ≃ₗ[R] M₂) (g : M₂ ≃ₗ[R] M₃) :
  g.dual_map.trans f.dual_map = (f.trans g).dual_map :=
rfl

namespace linear_map

variable (f : M₁ →ₗ[R] M₂)

lemma ker_dual_map_eq_dual_annihilator_range :
  f.dual_map.ker = f.range.dual_annihilator :=
begin
  ext φ, split; intro hφ,
  { rw mem_ker at hφ,
    rw submodule.mem_dual_annihilator,
    rintro y ⟨x, rfl⟩,
    rw [← dual_map_apply, hφ, zero_apply] },
  { ext x,
    rw dual_map_apply,
    rw submodule.mem_dual_annihilator at hφ,
    exact hφ (f x) ⟨x, rfl⟩ }
end

lemma range_dual_map_le_dual_annihilator_ker :
  f.dual_map.range ≤ f.ker.dual_annihilator :=
begin
  rintro _ ⟨ψ, rfl⟩,
  simp_rw [submodule.mem_dual_annihilator, mem_ker],
  rintro x hx,
  rw [dual_map_apply, hx, map_zero]
end

section finite_dimensional

variables {K : Type*} [field K] {V₁ : Type*} {V₂ : Type*}
variables [add_comm_group V₁] [module K V₁] [add_comm_group V₂] [module K V₂]

open finite_dimensional

variable [finite_dimensional K V₂]

@[simp] lemma finrank_range_dual_map_eq_finrank_range (f : V₁ →ₗ[K] V₂) :
  finrank K f.dual_map.range = finrank K f.range :=
begin
  have := submodule.finrank_quotient_add_finrank f.range,
  rw [(subspace.quot_equiv_annihilator f.range).finrank_eq,
      ← ker_dual_map_eq_dual_annihilator_range] at this,
  conv_rhs at this { rw ← subspace.dual_finrank_eq },
  refine add_left_injective (finrank K f.dual_map.ker) _,
  change _ + _ = _ + _,
  rw [finrank_range_add_finrank_ker f.dual_map, add_comm, this],
end

lemma range_dual_map_eq_dual_annihilator_ker [finite_dimensional K V₁] (f : V₁ →ₗ[K] V₂) :
  f.dual_map.range = f.ker.dual_annihilator :=
begin
  refine eq_of_le_of_finrank_eq f.range_dual_map_le_dual_annihilator_ker _,
  have := submodule.finrank_quotient_add_finrank f.ker,
  rw (subspace.quot_equiv_annihilator f.ker).finrank_eq at this,
  refine add_left_injective (finrank K f.ker) _,
  simp_rw [this, finrank_range_dual_map_eq_finrank_range],
  exact finrank_range_add_finrank_ker f,
end

end finite_dimensional

end linear_map


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

Define the p-adic valuation on ℤ and ℚ, and the p-adic norm on ℚ
-/

import data.rat data.int.gcd algebra.field_power data.nat.enat
import ring_theory.unique_factorization_domain
import tactic.ring tactic.abel

universe u
open nat roption

lemma nat.prime.ne_one {p : ℕ} (hp : p.prime) : p ≠ 1 :=
ne.symm $ (ne_of_lt hp.gt_one)

attribute [class] nat.prime

private lemma exi_div (p : ℕ) (n : ℤ) : ∃ k : ℕ, k ≤ n.nat_abs ∧ ↑(p ^ k) ∣ n :=
⟨0, nat.zero_le _, by simp⟩

private lemma bound {p : ℕ} (hp : p > 1) {n : ℤ} (hn : n ≠ 0) :
  ∀ k : ℕ, k > n.nat_abs → ¬ (↑(p ^ k) ∣ n) :=
assume k (hkn : k > n.nat_abs),
have n.nat_abs < p^k, from lt.trans (lt_pow_self hp _) (pow_lt_pow_of_lt_right hp hkn),
assume hdvd : ↑(p ^ k) ∣ n,
have hdvd' : (p ^ k) ∣ n.nat_abs, from int.dvd_nat_abs_of_of_nat_dvd hdvd,
let hle := le_of_dvd (int.nat_abs_pos_of_ne_zero hn) hdvd' in
not_le_of_gt this hle

variables {α : Type*}

def padic_val [comm_semiring α] [decidable_rel ((∣) : α → α → Prop)] (a b : α) : enat :=
⟨∃ n : ℕ, ¬a ^ (n + 1) ∣ b, λ h, nat.find h⟩

namespace padic_val

section comm_semiring
variables [comm_semiring α] [decidable_rel ((∣) : α → α → Prop)]

@[reducible] def finite (a b : α) : Prop := (padic_val a b).dom

lemma finite_def {a b : α} : finite a b ↔ ∃ n : ℕ, ¬a ^ (n + 1) ∣ b := iff.rfl

lemma not_finite_iff_forall {a b : α} : (¬ finite a b) ↔ ∀ n : ℕ, a ^ n ∣ b :=
⟨λ h n, nat.cases_on n (one_dvd _) (by simpa [finite, padic_val] using h),
  by simp [finite, padic_val]; tauto⟩

lemma not_unit_of_finite {a b : α} (h : finite a b) : ¬is_unit a :=
let ⟨n, hn⟩ := h in mt (is_unit_iff_forall_dvd.1 ∘ is_unit_pow (n + 1)) $
λ h, hn (h b)

lemma ne_zero_of_finite {a b : α} (h : finite a b) : b ≠ 0 :=
let ⟨n, hn⟩ := h in λ hb, by simpa [hb] using hn

lemma pow_dvd_of_le_padic_val {a b : α}
  {k : ℕ} : (k : enat) ≤ padic_val a b → a ^ k ∣ b :=
nat.cases_on k (λ _, one_dvd _)
  (λ k ⟨h₁, h₂⟩, by_contradiction (λ hk, (nat.find_min _ (lt_of_succ_le (h₂ ⟨k, hk⟩)) hk)))

lemma spec {a b : α} (h : finite a b) : a ^ get (padic_val a b) h ∣ b :=
pow_dvd_of_le_padic_val (by rw enat.coe_get)

lemma is_greatest {a b : α} {m : ℕ} (hm : padic_val a b < m) : ¬a ^ m ∣ b :=
λ h, have finite a b, from enat.dom_of_le_some (le_of_lt hm),
by rw [← enat.coe_get this, enat.coe_lt_coe] at hm;
  exact nat.find_spec this (dvd.trans (pow_dvd_pow _ hm) h)

lemma is_greatest' {a b : α} {m : ℕ} (h : finite a b) (hm : get (padic_val a b) h < m) :
  ¬a ^ m ∣ b :=
is_greatest (by rwa [← enat.coe_lt_coe, enat.coe_get] at hm)

lemma unique {a b : α} {k : ℕ} (hk : a ^ k ∣ b) (hsucc : ¬a ^ (k + 1) ∣ b) :
  (k : enat) = padic_val a b :=
le_antisymm (le_of_not_gt (λ hk', is_greatest hk' hk)) $
  have finite a b, from ⟨k, hsucc⟩,
  by rw [← enat.coe_get this, enat.coe_le_coe];
    exact nat.find_min' _ hsucc

lemma unique' {a b : α} {k : ℕ} (hk : a ^ k ∣ b) (hsucc : ¬ a ^ (k + 1) ∣ b) :
  k = get (padic_val a b) ⟨k, hsucc⟩ :=
by rw [← enat.coe_inj, enat.coe_get, unique hk hsucc]

lemma le_padic_val_of_pow_dvd {a b : α}
  {k : ℕ} (hk : a ^ k ∣ b) : (k : enat) ≤ padic_val a b :=
le_of_not_gt $ λ hk', is_greatest hk' hk

lemma pow_dvd_iff_le_padic_val {a b : α}
  {k : ℕ} : a ^ k ∣ b ↔ (k : enat) ≤ padic_val a b :=
⟨le_padic_val_of_pow_dvd, pow_dvd_of_le_padic_val⟩

lemma eq_some_iff {a b : α} {n : ℕ} :
  padic_val a b = (n : enat) ↔ a ^ n ∣ b ∧ ¬a ^ (n + 1) ∣ b :=
⟨λ h, let ⟨h₁, h₂⟩ := eq_some_iff.1 h in
    h₂ ▸ ⟨spec _, is_greatest
      (by conv_lhs {rw ← enat.coe_get h₁ }; rw [enat.coe_lt_coe]; exact lt_succ_self _)⟩,
  λ h, eq_some_iff.2 ⟨⟨n, h.2⟩, eq.symm $ unique' h.1 h.2⟩⟩

lemma eq_top_iff {a b : α} :
  padic_val a b = ⊤ ↔ ∀ n : ℕ, a ^ n ∣ b :=
⟨λ h n, nat.cases_on n (one_dvd _)
  (λ n, by_contradiction (not_exists.1 (eq_none_iff'.1 h) n : _)),
   λ h, eq_none_iff.2 (λ n ⟨⟨_, h₁⟩, _⟩, h₁ (h _))⟩

@[simp] protected lemma zero (a : α) : padic_val a 0 = ⊤ :=
roption.eq_none_iff.2 (λ n ⟨⟨k, hk⟩, _⟩, hk (dvd_zero _))

lemma one_right {a : α} (ha : ¬is_unit a) : padic_val a 1 = 0 :=
eq_some_iff.2 ⟨dvd_refl _, mt is_unit_iff_dvd_one.2 $ by simpa⟩

@[simp] lemma get_one_right {a : α} (ha : finite a 1) : get (padic_val a 1) ha = 0 :=
get_eq_iff_eq_some.2 (eq_some_iff.2 ⟨dvd_refl _,
  by simpa [is_unit_iff_dvd_one.symm] using not_unit_of_finite ha⟩)

@[simp] lemma one_left (b : α) : padic_val 1 b = ⊤ := by simp [eq_top_iff]

@[simp] lemma padic_val_unit {a : α} (b : α) (ha : is_unit a) : padic_val a b = ⊤ :=
eq_top_iff.2 (λ _, is_unit_iff_forall_dvd.1 (is_unit_pow _ ha) _)

lemma padic_val_eq_zero_of_not_dvd {a b : α} (ha : ¬a ∣ b) : padic_val a b = 0 :=
eq_some_iff.2 (by simpa)

-- lemma padic_val_eq_zero_of_not_dvd' {p : ℕ} {n : ℕ} (hnd : ¬ p ∣ n) : padic_val p n = 0 :=
-- by apply padic_val_eq_zero_of_not_dvd; simpa [int.coe_nat_dvd] using hnd

lemma finite_of_finite_mul_left {a b c : α} : finite a (b * c) → finite a c :=
λ ⟨n, hn⟩, ⟨n, λ h, hn (dvd.trans h (by simp [_root_.mul_pow]))⟩

lemma finite_of_finite_mul_right {a b c : α} : finite a (b * c) → finite a b :=
by rw mul_comm; exact finite_of_finite_mul_left

lemma eq_top_iff_not_finite {a b : α} : padic_val a b = ⊤ ↔ ¬ finite a b :=
roption.eq_none_iff'

local attribute [instance, priority 0] classical.prop_decidable

lemma padic_val_le_padic_val_iff {a b c d : α} : padic_val a b ≤ padic_val c d ↔
  (∀ n : ℕ, a ^ n ∣ b → c ^ n ∣ d) :=
⟨λ h n hab, (pow_dvd_of_le_padic_val (le_trans (le_padic_val_of_pow_dvd hab) h)),
  λ h, if hab : finite a b
    then by rw [← enat.coe_get hab]; exact le_padic_val_of_pow_dvd (h _ (spec _))
    else
    have ∀ n : ℕ, c ^ n ∣ d, from λ n, h n (not_finite_iff_forall.1 hab _),
    by rw [eq_top_iff_not_finite.2 hab, eq_top_iff_not_finite.2
      (not_finite_iff_forall.2 this)]⟩

lemma min_le_padic_val_add {p a b : α} :
  min (padic_val p a) (padic_val p b) ≤ padic_val p (a + b) :=
(le_total (padic_val p a) (padic_val p b)).elim
  (λ h, by rw [min_eq_left h, padic_val_le_padic_val_iff];
    exact λ n hn, dvd_add hn (padic_val_le_padic_val_iff.1 h n hn))
  (λ h, by rw [min_eq_right h, padic_val_le_padic_val_iff];
    exact λ n hn, dvd_add (padic_val_le_padic_val_iff.1 h n hn) hn)

lemma dvd_of_padic_val_pos {a b : α} (h : (0 : enat) < padic_val a b) : a ∣ b :=
by rw [← _root_.pow_one a]; exact pow_dvd_of_le_padic_val (enat.pos_iff_one_le.1 h)

lemma finite_nat_iff {a b : ℕ} : finite a b ↔ (a ≠ 1 ∧ 0 < b) :=
begin
  rw [← not_iff_not, not_finite_iff_forall, not_and_distrib, ne.def,
    not_not, not_lt, nat.le_zero_iff],
  exact ⟨λ h, or_iff_not_imp_right.2 (λ hb,
    have ha : a ≠ 0, from λ ha, by simpa [ha] using h 1,
    by_contradiction (λ ha1 : a ≠ 1,
      have ha_gt_one : 1 < a, from
        have ∀ a : ℕ, a ≤ 1 → a ≠ 0 → a ≠ 1 → false, from dec_trivial,
        lt_of_not_ge (λ ha', this a ha' ha ha1),
      not_lt_of_ge (le_of_dvd (nat.pos_of_ne_zero hb) (h b))
          (by simp only [nat.pow_eq_pow]; exact lt_pow_self ha_gt_one b))),
    λ h, by cases h; simp *⟩
end

lemma finite_int_iff_nat_abs_finite {a b : ℤ} : finite a b ↔ finite a.nat_abs b.nat_abs :=
begin
  rw [finite_def, finite_def],
  conv in (a ^ _ ∣ b)
    { rw [← int.nat_abs_dvd_abs_iff, int.nat_abs_pow, ← pow_eq_pow] }
end

lemma finite_int_iff {a b : ℤ} : finite a b ↔ (a.nat_abs ≠ 1 ∧ b ≠ 0) :=
begin
  have := int.nat_abs_eq a,
  have := @int.nat_abs_ne_zero_of_ne_zero b,
  rw [finite_int_iff_nat_abs_finite, finite_nat_iff, nat.pos_iff_ne_zero'],
  split; finish
end

instance decidable_nat : decidable_rel (λ a b : ℕ, (padic_val a b).dom) :=
λ a b, decidable_of_iff _ finite_nat_iff.symm

instance decidable_int : decidable_rel (λ a b : ℤ, (padic_val a b).dom) :=
λ a b, decidable_of_iff _ finite_int_iff.symm

end comm_semiring

section comm_ring

variables [comm_ring α] [decidable_rel ((∣) : α → α → Prop)]

local attribute [instance, priority 0] classical.prop_decidable

@[simp] protected lemma neg (a b : α) : padic_val a (-b) = padic_val a b :=
roption.ext' (by simp only [padic_val]; conv in (_ ∣ - _) {rw dvd_neg})
  (λ h₁ h₂, enat.coe_inj.1 (by rw [enat.coe_get]; exact
    eq.symm (unique ((dvd_neg _ _).2 (spec _))
      (mt (dvd_neg _ _).1 (is_greatest' _ (lt_succ_self _))))))

end comm_ring

section integral_domain

variables [integral_domain α] [decidable_rel ((∣) : α → α → Prop)]

@[simp] lemma padic_val_self {a : α} (ha : ¬is_unit a) (ha0 : a ≠ 0) :
  padic_val a a = 1 :=
eq_some_iff.2 ⟨by simp, λ ⟨b, hb⟩, ha (is_unit_iff_dvd_one.2
  ⟨b, (domain.mul_left_inj ha0).1 $ by clear _fun_match;
    simpa [_root_.pow_succ, mul_assoc] using hb⟩)⟩

@[simp] lemma get_padic_val_self {a : α} (ha : finite a a) :
  get (padic_val a a) ha = 1 :=
roption.get_eq_iff_eq_some.2 (eq_some_iff.2
  ⟨by simp, λ ⟨b, hb⟩,
    by rw [← mul_one a, _root_.pow_add, _root_.pow_one, mul_assoc, mul_assoc,
        domain.mul_left_inj (ne_zero_of_finite ha)] at hb;
      exact mt is_unit_iff_dvd_one.2 (not_unit_of_finite ha)
        ⟨b, by clear _fun_match; simp * at *⟩⟩)

lemma finite_mul_aux {p : α} (hp : prime p) : ∀ {n m : ℕ} {a b : α},
  ¬p ^ (n + 1) ∣ a → ¬p ^ (m + 1) ∣ b → ¬p ^ (n + m + 1) ∣ a * b
| n m := λ a b ha hb ⟨s, hs⟩,
  have p ∣ a * b, from ⟨p ^ (n + m) * s,
    by simp [hs, _root_.pow_add, mul_comm, mul_assoc, mul_left_comm]⟩,
  (hp.2.2 a b this).elim
    (λ ⟨x, hx⟩, have hn0 : 0 < n,
        from nat.pos_of_ne_zero (λ hn0, by clear _fun_match _fun_match; simpa [hx, hn0] using ha),
      have wf : (n - 1) < n, from nat.sub_lt_self hn0 dec_trivial,
      have hpx : ¬ p ^ (n - 1 + 1) ∣ x,
        from λ ⟨y, hy⟩, ha (hx.symm ▸ ⟨y, (domain.mul_left_inj hp.1).1
          $ by rw [nat.sub_add_cancel hn0] at hy;
            simp [hy, _root_.pow_add, mul_comm, mul_assoc, mul_left_comm]⟩),
      have 1 ≤ n + m, from le_trans hn0 (le_add_right n m),
      finite_mul_aux hpx hb ⟨s, (domain.mul_left_inj hp.1).1 begin
          rw [← nat.sub_add_comm hn0, nat.sub_add_cancel this],
          clear _fun_match _fun_match finite_mul_aux,
          simp [*, mul_comm, mul_assoc, mul_left_comm, _root_.pow_add] at *
        end⟩)
    (λ ⟨x, hx⟩, have hm0 : 0 < m,
        from nat.pos_of_ne_zero (λ hm0, by clear _fun_match _fun_match; simpa [hx, hm0] using hb),
      have wf : (m - 1) < m, from nat.sub_lt_self hm0 dec_trivial,
      have hpx : ¬ p ^ (m - 1 + 1) ∣ x,
        from λ ⟨y, hy⟩, hb (hx.symm ▸ ⟨y, (domain.mul_left_inj hp.1).1
          $ by rw [nat.sub_add_cancel hm0] at hy;
            simp [hy, _root_.pow_add, mul_comm, mul_assoc, mul_left_comm]⟩),
      finite_mul_aux ha hpx ⟨s, (domain.mul_left_inj hp.1).1 begin
          rw [add_assoc, nat.sub_add_cancel hm0],
          clear _fun_match _fun_match finite_mul_aux,
          simp [*, mul_comm, mul_assoc, mul_left_comm, _root_.pow_add] at *
        end⟩)

lemma finite_mul {p a b : α} (hp : prime p) : finite p a → finite p b → finite p (a * b) :=
λ ⟨n, hn⟩ ⟨m, hm⟩, ⟨n + m, finite_mul_aux hp hn hm⟩

lemma finite_mul_iff {p a b : α} (hp : prime p) : finite p (a * b) ↔ finite p a ∧ finite p b :=
⟨λ h, ⟨finite_of_finite_mul_right h, finite_of_finite_mul_left h⟩,
  λ h, finite_mul hp h.1 h.2⟩

lemma finite_pow {p a : α} (hp : prime p) : Π {k : ℕ} (ha : finite p a), finite p (a ^ k)
| 0     ha := ⟨0, by simp [mt is_unit_iff_dvd_one.2 hp.2.1]⟩
| (k+1) ha := by rw [_root_.pow_succ]; exact finite_mul hp ha (finite_pow ha)

protected lemma mul' {p a b : α} (hp : prime p)
  (h : finite p (a * b)) :
  get (padic_val p (a * b)) h =
  get (padic_val p a) ((finite_mul_iff hp).1 h).1 +
  get (padic_val p b) ((finite_mul_iff hp).1 h).2 :=
have hdiva : p ^ get (padic_val p a) ((finite_mul_iff hp).1 h).1 ∣ a, from spec _,
have hdivb : p ^ get (padic_val p b) ((finite_mul_iff hp).1 h).2 ∣ b, from spec _,
have hpoweq : p ^ (get (padic_val p a) ((finite_mul_iff hp).1 h).1 +
    get (padic_val p b) ((finite_mul_iff hp).1 h).2) =
    p ^ get (padic_val p a) ((finite_mul_iff hp).1 h).1 *
    p ^ get (padic_val p b) ((finite_mul_iff hp).1 h).2,
  by simp [_root_.pow_add],
have hdiv : p ^ (get (padic_val p a) ((finite_mul_iff hp).1 h).1 +
    get (padic_val p b) ((finite_mul_iff hp).1 h).2) ∣ a * b,
  by rw [hpoweq]; apply mul_dvd_mul; assumption,
have hsucc : ¬p ^ ((get (padic_val p a) ((finite_mul_iff hp).1 h).1 +
    get (padic_val p b) ((finite_mul_iff hp).1 h).2) + 1) ∣ a * b,
  from λ h, not_or (is_greatest' _ (lt_succ_self _)) (is_greatest' _ (lt_succ_self _))
    (succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul hp (by convert hdiva)
      (by convert hdivb) h),
by rw [← enat.coe_inj, enat.coe_get, eq_some_iff];
  exact ⟨hdiv, hsucc⟩

local attribute [instance, priority 0] classical.prop_decidable

protected lemma mul {p a b : α} (hp : prime p) :
  padic_val p (a * b) = padic_val p a + padic_val p b :=
if h : finite p a ∧ finite p b then
by rw [← enat.coe_get h.1, ← enat.coe_get h.2, ← enat.coe_get (finite_mul hp h.1 h.2),
    ← enat.coe_add, enat.coe_inj, padic_val.mul' hp]
else begin
  rw [eq_top_iff_not_finite.2 (mt (finite_mul_iff hp).1 h)],
  cases not_and_distrib.1 h with h h;
    simp [eq_top_iff_not_finite.2 h]
end

protected lemma pow' {p a : α} (hp : prime p) (ha : finite p a) : ∀ {k : ℕ},
  get (padic_val p (a ^ k)) (finite_pow hp ha) = k * get (padic_val p a) ha
| 0     := by dsimp [_root_.pow_zero]; simp [one_right hp.2.1]; refl
| (k+1) := by dsimp only [_root_.pow_succ];
  erw [padic_val.mul' hp, pow', add_mul, one_mul, add_comm]

lemma pow {p a : α} (hp : prime p) : ∀ {k : ℕ},
  padic_val p (a ^ k) = add_monoid.smul k (padic_val p a)
| 0        := by simp [one_right hp.2.1]
| (succ k) := by simp [_root_.pow_succ, succ_smul, pow, padic_val.mul hp]

end integral_domain

variables [integral_domain α] [unique_factorization_domain α]
variables [decidable_rel ((∣) : α → α → Prop)]
open associates

local attribute [instance, priority 0] classical.prop_decidable

lemma finite_of_is_not_unit {a b : α} (ha : ¬is_unit a) (hb0 : b ≠ 0) : finite a b :=
if ha0 : a = 0 then ⟨0, by simp *⟩
else
  have has : option.is_some (factors (associates.mk a)),
    from is_some_factors_iff.2 (mt mk_eq_zero_iff_eq_zero.1 ha0),
  have hbs : option.is_some (factors (associates.mk b)),
    from is_some_factors_iff.2 (mt mk_eq_zero_iff_eq_zero.1 hb0),
  ⟨(option.get hbs).card,
    λ hn, lt_irrefl (option.get hbs).card
    (calc (option.get hbs).card
          < (option.get hbs).card + 1 : lt_succ_self _
      ... ≤ (multiset.card (option.get hbs) + 1) * multiset.card (option.get has) :
        le_mul_of_ge_one_right' (nat.zero_le _)
          (multiset.card_pos.2
            (mt (congr_arg (λ s, factor_set.prod (option.some s)))
              (by rw [option.some_get, factors_prod];
                exact mt (is_unit_iff_eq_one _).2
                  (mt is_unit_mk.1 ha))))
      ... ≤ (option.get hbs).card : begin
        rw [← multiset.card_smul],
        refine multiset.card_le_of_le (with_top.coe_le_coe.1 _),
        rw [factor_set.coe_smul, factor_set.coe_get,
          factor_set.coe_get, ← factors_pow, ← associates.mk_pow],
        exact factors_mono (mk_le_mk_of_dvd hn)
      end)⟩

lemma finite_of_prime {p a : α} (hp : prime p) (ha0 : a ≠ 0) : finite p a :=
finite_of_is_not_unit hp.2.1 ha0

end padic_val

section nat
open padic_val

lemma padic_val_eq_zero_of_coprime {p a b : ℕ} (hp : p ≠ 1)
  (hle : padic_val p a ≤ padic_val p b)
  (hab : nat.coprime a b) : padic_val p a = 0 :=
begin
  rw [padic_val_le_padic_val_iff] at hle,
  rw [← le_zero_iff_eq, ← not_lt, enat.pos_iff_one_le, ← enat.coe_one,
    ← pow_dvd_iff_le_padic_val],
  assume h,
  have := nat.dvd_gcd h (hle _ h),
  rw [coprime.gcd_eq_one hab, nat.dvd_one, _root_.pow_one] at this,
  exact hp this
end

end nat

local infix `/.`:70 := rat.mk

open padic_val

def padic_val_rat (p : ℕ) (q : ℚ) : ℤ :=
if h : q ≠ 0 ∧ p ≠ 1
then (padic_val (p : ℤ) q.num).get
    (padic_val.finite_int_iff.2 ⟨h.2, rat.num_ne_zero_of_ne_zero h.1⟩) -
  (padic_val (p : ℤ) q.denom).get
    (padic_val.finite_int_iff.2 ⟨h.2, ne.symm $ ne_of_lt (int.coe_nat_pos.2 q.3)⟩)
else 0

namespace padic_val_rat
open padic_val
section padic_val_rat
variables {p : ℕ}

@[simp] lemma rat.neg_num : ∀ q : ℚ, (-q).num = -q.num
| ⟨(n : ℕ), _, _, _⟩ := rfl
| ⟨-[1+ n], _, _, _⟩ := rfl

lemma nat.one_lt_iff_ne_zero_and_ne_one : ∀ {n : ℕ}, 1 < n ↔ n ≠ 0 ∧ n ≠ 1
| 0     := dec_trivial
| 1     := dec_trivial
| (n+2) := dec_trivial

@[simp] lemma rat.one_num : (1 : ℚ).num = 1 := rfl

@[simp] lemma rat.one_denom : (1 : ℚ).denom = 1 := rfl

lemma rat.add_num_denom (q r : ℚ) : q + r =
  ((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ) :=
have hqd : (q.denom : ℤ) ≠ 0, from int.coe_nat_ne_zero_iff_pos.2 q.3,
have hrd : (r.denom : ℤ) ≠ 0, from int.coe_nat_ne_zero_iff_pos.2 r.3,
by conv_lhs { rw [rat.num_denom q, rat.num_denom r, rat.add_def hqd hrd] };
  simp [mul_comm]

#print tactic.simp_config

--set_option pp.implicit true
set_option trace.simplify.rewrite true

@[simp] protected lemma neg (q : ℚ) : padic_val_rat p (-q) = padic_val_rat p q :=
begin
  unfold padic_val_rat,
  split_ifs,
  { simp [-add_comm] },
  { exfalso, simp * at * },
  { exfalso, simp * at * },
  { refl }
end

@[simp] protected lemma one : padic_val_rat p 1 = 0 :=
by unfold padic_val_rat; split_ifs; simp *

@[simp] lemma padic_val_rat_self (hp : 1 < p) : padic_val_rat p p = 1 :=
by unfold padic_val_rat; split_ifs; simp [*, nat.one_lt_iff_ne_zero_and_ne_one] at *

lemma padic_val_rat_of_int (z : ℤ) (hp : p ≠ 1) (hz : z ≠ 0) :
  padic_val_rat p (z : ℚ) = (padic_val (p : ℤ) z).get
    (finite_int_iff.2 ⟨hp, hz⟩) :=
by rw [padic_val_rat, dif_pos]; simp *

end padic_val_rat

section padic_val_rat
open padic_val
variables (p : ℕ) [p_prime : nat.prime p]
include p_prime

lemma prime_int_of_nat_prime : _root_.prime (p : ℤ) :=
⟨int.coe_nat_ne_zero_iff_pos.2 p_prime.pos,
  mt is_unit_iff_dvd_one.1 (mt int.coe_nat_dvd.1 p_prime.not_dvd_one),
  (λ a b ha, begin
    have : p ∣ a.nat_abs * b.nat_abs,
    { rwa [← int.nat_abs_mul, ← int.coe_nat_dvd, int.dvd_nat_abs] },
    cases p_prime.dvd_mul.1 this;
    rw [← int.coe_nat_dvd, int.dvd_nat_abs] at h; simp [h]
  end)⟩

lemma finite_int_prime_iff {p : ℕ} [p_prime : p.prime] {a : ℤ} : finite (p : ℤ) a ↔ a ≠ 0 :=
by simp [finite_int_iff, ne.symm (ne_of_lt (p_prime.gt_one))]

protected lemma defn {q : ℚ} {n d : ℤ} (hqz : q ≠ 0) (qdf : q = n /. d) :
  padic_val_rat p q = (padic_val (p : ℤ) n).get (finite_int_iff.2
    ⟨ne.symm $ ne_of_lt p_prime.gt_one, λ hn, by simp * at *⟩) -
  (padic_val (p : ℤ) d).get (finite_int_iff.2 ⟨ne.symm $ ne_of_lt p_prime.gt_one,
    λ hd, by simp * at *⟩) :=
have hn : n ≠ 0, from rat.mk_num_ne_zero_of_ne_zero hqz qdf,
have hd : d ≠ 0, from rat.mk_denom_ne_zero_of_ne_zero hqz qdf,
let ⟨c, hc1, hc2⟩ := rat.num_denom_mk hn hd qdf in
by rw [padic_val_rat, dif_pos];
  simp [hc1, hc2, padic_val.mul' (prime_int_of_nat_prime p),
    (ne.symm (ne_of_lt p_prime.gt_one)), hqz]

-- #print padic_val_mul'

protected lemma mul {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_rat p (q * r) = padic_val_rat p q + padic_val_rat p r :=
have q*r = (q.num * r.num) /. (↑q.denom * ↑r.denom), by simp [rat.mul_num_denom],
have hq' : q.num /. q.denom ≠ 0, by simpa [(rat.num_denom _).symm],
have hr' : r.num /. r.denom ≠ 0, by simpa [(rat.num_denom _).symm],
have hp' : prime (p : ℤ), from prime_int_of_nat_prime p,
begin
  rw [padic_val_rat.defn p (mul_ne_zero hq hr) this],
  conv_rhs { rw [rat.num_denom q, padic_val_rat.defn p hq',
    rat.num_denom r, padic_val_rat.defn p hr'] },
  rw [padic_val.mul', padic_val.mul']; simp *
end

protected lemma pow {q : ℚ} (hq : q ≠ 0) {k : ℕ} :
    padic_val_rat p (q ^ k) = k * padic_val_rat p q :=
by induction k; simp [*, padic_val_rat.mul _ hq (pow_ne_zero _ hq),
  _root_.pow_succ, add_mul]

protected lemma inv {q : ℚ} (hq : q ≠ 0) :
  padic_val_rat p (q⁻¹) = -padic_val_rat p q :=
by rw [eq_neg_iff_add_eq_zero, ← padic_val_rat.mul p (inv_ne_zero hq) hq,
    inv_mul_cancel hq, padic_val_rat.one]

protected lemma div {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_rat p (q / r) = padic_val_rat p q - padic_val_rat p r :=
by rw [div_eq_mul_inv, padic_val_rat.mul p hq (inv_ne_zero hr),
    padic_val_rat.inv p hr, sub_eq_add_neg]

lemma padic_val_rat_le_padic_val_rat_iff {n₁ n₂ d₁ d₂ : ℤ}
  (hn₁ : n₁ ≠ 0) (hn₂ : n₂ ≠ 0) (hd₁ : d₁ ≠ 0) (hd₂ : d₂ ≠ 0) :
  padic_val_rat p (n₁ /. d₁) ≤ padic_val_rat p (n₂ /. d₂) ↔
  ∀ (n : ℕ), ↑p ^ n ∣ n₁ * d₂ → ↑p ^ n ∣ n₂ * d₁ :=
have hf1 : finite (p : ℤ) (n₁ * d₂),
  from finite_int_prime_iff.2 (mul_ne_zero hn₁ hd₂),
have hf2 : finite (p : ℤ) (n₂ * d₁),
  from finite_int_prime_iff.2 (mul_ne_zero hn₂ hd₁),
by conv {to_lhs, rw [padic_val_rat.defn p (rat.mk_ne_zero_of_ne_zero hn₁ hd₁) rfl,
    padic_val_rat.defn p (rat.mk_ne_zero_of_ne_zero hn₂ hd₂) rfl,
    sub_le_iff_le_add', ← add_sub_assoc, le_sub_iff_add_le,
    ← int.coe_nat_add, ← int.coe_nat_add, int.coe_nat_le,
    ← padic_val.mul' (prime_int_of_nat_prime p) hf1, add_comm,
    ← padic_val.mul' (prime_int_of_nat_prime p) hf2,
    enat.get_le_get, padic_val_le_padic_val_iff] }

theorem le_padic_val_rat_add_of_le {q r : ℚ}
  (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q + r ≠ 0)
  (h : padic_val_rat p q ≤ padic_val_rat p r) :
  padic_val_rat p q ≤ padic_val_rat p (q + r) :=
have hqn : q.num ≠ 0, from rat.num_ne_zero_of_ne_zero hq,
have hqd : (q.denom : ℤ) ≠ 0, from int.coe_nat_ne_zero.2 $ rat.denom_ne_zero _,
have hrn : r.num ≠ 0, from rat.num_ne_zero_of_ne_zero hr,
have hrd : (r.denom : ℤ) ≠ 0, from int.coe_nat_ne_zero.2 $ rat.denom_ne_zero _,
have hqdv : q.num /. q.denom ≠ 0, from rat.mk_ne_zero_of_ne_zero hqn hqd,
have hrdv : r.num /. r.denom ≠ 0, from rat.mk_ne_zero_of_ne_zero hrn hrd,
have hqreq : q + r = (((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ)),
  from rat.add_num_denom _ _,
have hqrd : q.num * ↑(r.denom) + ↑(q.denom) * r.num ≠ 0,
  from rat.mk_num_ne_zero_of_ne_zero hqr hqreq,
begin
  conv_lhs { rw rat.num_denom q },
  rw [hqreq, padic_val_rat_le_padic_val_rat_iff p hqn hqrd hqd (mul_ne_zero hqd hrd),
    ← padic_val_le_padic_val_iff, mul_left_comm, padic_val.mul (prime_int_of_nat_prime p),
    add_mul],
  rw [rat.num_denom q, rat.num_denom r, padic_val_rat_le_padic_val_rat_iff p hqn hrn hqd hrd,
    ← padic_val_le_padic_val_iff] at h,
  calc _ ≤ min (padic_val ↑p (q.num * ↑(r.denom) * ↑(q.denom)))
    (padic_val ↑p (↑(q.denom) * r.num * ↑(q.denom))) : (le_min
    (by rw [@padic_val.mul _ _ _ _ (_ * _) _ (prime_int_of_nat_prime p), add_comm])
    (by rw [mul_assoc, @padic_val.mul _ _ _ _ (q.denom : ℤ)
        (_ * _) (prime_int_of_nat_prime p)];
      exact add_le_add_left' h))
    ... ≤ _ : min_le_padic_val_add
end

theorem min_le_padic_val_rat_add {q r : ℚ}
  (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q + r ≠ 0) :
  min (padic_val_rat p q) (padic_val_rat p r) ≤ padic_val_rat p (q + r) :=
(le_total (padic_val_rat p q) (padic_val_rat p r)).elim
  (λ h, by rw [min_eq_left h]; exact le_padic_val_rat_add_of_le _ hq hr hqr h)
  (λ h, by rw [min_eq_right h, add_comm]; exact le_padic_val_rat_add_of_le _ hr hq
    (by rwa add_comm) h)

end padic_val_rat
end padic_val_rat

def padic_norm (p : ℕ) (q : ℚ) : ℚ :=
if q = 0 then 0 else fpow (↑p : ℚ) (-(padic_val_rat p q))

namespace padic_norm

section padic_norm
open padic_val_rat
variables (p : ℕ) [hp : p.prime]
include hp

@[simp] protected lemma zero : padic_norm p 0 = 0 := by simp [padic_norm]

@[simp] protected lemma one : padic_norm p 1 = 1 := by simp [padic_norm]

@[simp] protected lemma eq_fpow_of_nonzero {q : ℚ} (hq : q ≠ 0) :
  padic_norm p q = fpow p (-(padic_val_rat p q)) :=
by simp [hq, padic_norm]

protected lemma nonzero {q : ℚ} (hq : q ≠ 0) : padic_norm p q ≠ 0 :=
begin
  rw padic_norm.eq_fpow_of_nonzero p hq,
  apply fpow_ne_zero_of_ne_zero, simp,
  apply ne_of_gt,
  simpa using hp.pos
end

@[simp] protected lemma neg (q : ℚ) : padic_norm p (-q) = padic_norm p q :=
if hq : q = 0 then by simp [hq]
else by simp [padic_norm, hq, hp.gt_one]

lemma zero_of_padic_norm_eq_zero {q : ℚ} (h : padic_norm p q = 0) : q = 0 :=
by_contradiction $
  assume hq : q ≠ 0,
  have padic_norm p q = fpow p (-(padic_val_rat p q)), by simp [hq],
  fpow_ne_zero_of_ne_zero
    (show (↑p : ℚ) ≠ 0, by simp [prime.ne_zero hp])
    (-(padic_val_rat p q)) (by rw [←this, h])

protected lemma nonneg (q : ℚ) : padic_norm p q ≥ 0 :=
if hq : q = 0 then by simp [hq]
else
  begin
    unfold padic_norm; split_ifs,
    apply fpow_nonneg_of_nonneg,
    apply nat.cast_nonneg
  end

@[simp] protected theorem mul (q r : ℚ) : padic_norm p (q*r) = padic_norm p q * padic_norm p r :=
if hq : q = 0 then
  by simp [hq]
else if hr : r = 0 then
  by simp [hr]
else
  have q*r ≠ 0, from mul_ne_zero hq hr,
  have (↑p : ℚ) ≠ 0, by simp [prime.ne_zero hp],
  by simp [padic_norm, *, padic_val_rat.mul, fpow_add this]

@[simp] protected theorem div (q r : ℚ) : padic_norm p (q / r) = padic_norm p q / padic_norm p r :=
if hr : r = 0 then by simp [hr] else
eq_div_of_mul_eq _ _ (padic_norm.nonzero _ hr) (by rw [←padic_norm.mul, div_mul_cancel _ hr])

protected theorem of_int (z : ℤ) : padic_norm p ↑z ≤ 1 :=
if hz : z = 0 then by simp [hz] else
begin
  unfold padic_norm,
  rw [if_neg ((@int.cast_ne_zero ℚ _ _ _ _).2 hz)],
  refine fpow_le_one_of_nonpos
    (by rw [← nat.cast_one]; exact nat.cast_le.2 (le_of_lt hp.gt_one)) _,
  rw [padic_val_rat_of_int _ hp.ne_one hz, neg_nonpos],
  exact int.coe_nat_nonneg _
end

--TODO: p implicit
private lemma nonarchimedean_aux {q r : ℚ} (h : padic_val_rat p q ≤ padic_val_rat p r) :
  padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
have hnqp : padic_norm p q ≥ 0, from padic_norm.nonneg _ _,
have hnrp : padic_norm p r ≥ 0, from padic_norm.nonneg _ _,
if hq : q = 0 then
  by simp [hq, max_eq_right hnrp, le_max_right]
else if hr : r = 0 then
  by simp [hr, max_eq_left hnqp, le_max_left]
else if hqr : q + r = 0 then
  le_trans (by simpa [hqr] using padic_norm.nonneg) (le_max_left _ _)
else
  begin
    unfold padic_norm, split_ifs,
    apply le_max_iff.2,
    left,
    have hpge1 : (↑p : ℚ) ≥ ↑(1 : ℕ), from (nat.cast_le.2 $ le_of_lt $ prime.gt_one hp),
    apply fpow_le_of_le hpge1,
    apply neg_le_neg,
    have : padic_val_rat p q =
            min (padic_val_rat p q) (padic_val_rat p r),
      from (min_eq_left h).symm,
    rw this,
    apply min_le_padic_val_rat_add; assumption
  end

protected theorem nonarchimedean {q r : ℚ} :
  padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
begin
    wlog hle := le_total (padic_val_rat p q) (padic_val_rat p r) using [q r],
    exact nonarchimedean_aux p hle
end

theorem triangle_ineq (q r : ℚ) : padic_norm p (q + r) ≤ padic_norm p q + padic_norm p r :=
calc padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) : padic_norm.nonarchimedean p
                       ... ≤ padic_norm p q + padic_norm p r :
                         max_le_add_of_nonneg (padic_norm.nonneg p _) (padic_norm.nonneg p _)

protected theorem sub {q r : ℚ} : padic_norm p (q - r) ≤ max (padic_norm p q) (padic_norm p r) :=
by rw [sub_eq_add_neg, ←padic_norm.neg p r]; apply padic_norm.nonarchimedean

lemma add_eq_max_of_ne {q r : ℚ} (hne : padic_norm p q ≠ padic_norm p r) :
  padic_norm p (q + r) = max (padic_norm p q) (padic_norm p r) :=
begin
  wlog hle := le_total (padic_norm p r) (padic_norm p q) using [q r],
  have hlt : padic_norm p r < padic_norm p q, from lt_of_le_of_ne hle hne.symm,
  have : padic_norm p q ≤ max (padic_norm p (q + r)) (padic_norm p r), from calc
   padic_norm p q = padic_norm p (q + r - r) : by congr; ring
               ... ≤ max (padic_norm p (q + r)) (padic_norm p (-r)) : padic_norm.nonarchimedean p
               ... = max (padic_norm p (q + r)) (padic_norm p r) : by simp,
  have hnge : padic_norm p r ≤ padic_norm p (q + r),
  { apply le_of_not_gt,
    intro hgt,
    rw max_eq_right_of_lt hgt at this,
    apply not_lt_of_ge this,
    assumption },
  have : padic_norm p q ≤ padic_norm p (q + r), by rwa [max_eq_left hnge] at this,
  apply _root_.le_antisymm,
  { apply padic_norm.nonarchimedean p },
  { rw max_eq_left_of_lt hlt,
    assumption }
end

protected theorem image {q : ℚ} (hq : q ≠ 0) : ∃ n : ℤ, padic_norm p q = fpow p (-n) :=
⟨ (padic_val_rat p q), by simp [padic_norm, hq] ⟩

instance : is_absolute_value (padic_norm p) :=
{ abv_nonneg := padic_norm.nonneg p,
  abv_eq_zero :=
    begin
      intros,
      constructor; intro,
      { apply zero_of_padic_norm_eq_zero p, assumption },
      { simp [*] }
    end,
  abv_add := padic_norm.triangle_ineq p,
  abv_mul := padic_norm.mul p }

lemma le_of_dvd {n : ℕ} {z : ℤ} (hd : ↑(p^n) ∣ z) : padic_norm p z ≤ fpow ↑p (-n) :=
have hp' : (↑p : ℚ) ≥ 1, from show ↑p ≥ ↑(1 : ℕ), from cast_le.2 (le_of_lt hp.gt_one),
have hpn : (↑p : ℚ) ≥ 0, from le_trans zero_le_one hp',
begin
  unfold padic_norm, split_ifs with hz hz,
  { simpa [padic_norm, hz] using fpow_nonneg_of_nonneg hpn _ },
  { apply fpow_le_of_le hp',
    apply neg_le_neg,
    rw padic_val_rat_of_int _ hp.ne_one (int.cast_ne_zero.1 hz),
    apply int.coe_nat_le.2,
    rw [← enat.coe_le_coe, enat.coe_get],
    apply padic_val.le_padic_val_of_pow_dvd,
    { simpa using hd } }
end

end padic_norm
end padic_norm


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker, Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.int.gcd
import Mathlib.ring_theory.multiplicity
import Mathlib.ring_theory.principal_ideal_domain
import Mathlib.PostPort

namespace Mathlib

/-!
# Divisibility over ℕ and ℤ

This file collects results for the integers and natural numbers that use abstract algebra in
their proofs or cases of ℕ and ℤ being examples of structures in abstract algebra.

## Main statements

* `nat.prime_iff`: `nat.prime` coincides with the general definition of `prime`
* `nat.irreducible_iff_prime`: a non-unit natural number is only divisible by `1` iff it is prime
* `nat.factors_eq`: the multiset of elements of `nat.factors` is equal to the factors
   given by the `unique_factorization_monoid` instance
* ℤ is a `normalization_monoid`
* ℤ is a `gcd_monoid`

## Tags

prime, irreducible, natural numbers, integers, normalization monoid, gcd monoid,
greatest common divisor, prime factorization, prime factors, unique factorization,
unique factors
-/

theorem nat.prime_iff {p : ℕ} : nat.prime p ↔ prime p := sorry

theorem nat.irreducible_iff_prime {p : ℕ} : irreducible p ↔ prime p := sorry

namespace nat

protected instance wf_dvd_monoid : wf_dvd_monoid ℕ := sorry

protected instance unique_factorization_monoid : unique_factorization_monoid ℕ :=
  unique_factorization_monoid.mk fun (_x : ℕ) => irreducible_iff_prime

end nat

namespace int

protected instance normalization_monoid : normalization_monoid ℤ :=
  normalization_monoid.mk (fun (a : ℤ) => ite (0 ≤ a) 1 (-1)) sorry sorry sorry

theorem normalize_of_nonneg {z : ℤ} (h : 0 ≤ z) : coe_fn normalize z = z := sorry

theorem normalize_of_neg {z : ℤ} (h : z < 0) : coe_fn normalize z = -z := sorry

theorem normalize_coe_nat (n : ℕ) : coe_fn normalize ↑n = ↑n :=
  normalize_of_nonneg (coe_nat_le_coe_nat_of_le (nat.zero_le n))

theorem coe_nat_abs_eq_normalize (z : ℤ) : ↑(nat_abs z) = coe_fn normalize z := sorry

protected instance gcd_monoid : gcd_monoid ℤ :=
  gcd_monoid.mk norm_unit sorry sorry sorry (fun (a b : ℤ) => ↑(gcd a b))
    (fun (a b : ℤ) => ↑(lcm a b)) sorry sorry sorry sorry sorry sorry sorry

theorem coe_gcd (i : ℤ) (j : ℤ) : ↑(gcd i j) = gcd i j := rfl

theorem coe_lcm (i : ℤ) (j : ℤ) : ↑(lcm i j) = lcm i j := rfl

theorem nat_abs_gcd (i : ℤ) (j : ℤ) : nat_abs (gcd i j) = gcd i j := rfl

theorem nat_abs_lcm (i : ℤ) (j : ℤ) : nat_abs (lcm i j) = lcm i j := rfl

theorem exists_unit_of_abs (a : ℤ) : ∃ (u : ℤ), ∃ (h : is_unit u), ↑(nat_abs a) = u * a := sorry

theorem gcd_eq_one_iff_coprime {a : ℤ} {b : ℤ} : gcd a b = 1 ↔ is_coprime a b := sorry

theorem sqr_of_gcd_eq_one {a : ℤ} {b : ℤ} {c : ℤ} (h : gcd a b = 1) (heq : a * b = c ^ bit0 1) :
    ∃ (a0 : ℤ), a = a0 ^ bit0 1 ∨ a = -a0 ^ bit0 1 :=
  sorry

theorem sqr_of_coprime {a : ℤ} {b : ℤ} {c : ℤ} (h : is_coprime a b) (heq : a * b = c ^ bit0 1) :
    ∃ (a0 : ℤ), a = a0 ^ bit0 1 ∨ a = -a0 ^ bit0 1 :=
  sqr_of_gcd_eq_one (iff.mpr gcd_eq_one_iff_coprime h) heq

end int

theorem irreducible_iff_nat_prime (a : ℕ) : irreducible a ↔ nat.prime a := sorry

theorem nat.prime_iff_prime {p : ℕ} : nat.prime p ↔ prime p := sorry

theorem nat.prime_iff_prime_int {p : ℕ} : nat.prime p ↔ prime ↑p := sorry

/-- Maps an associate class of integers consisting of `-n, n` to `n : ℕ` -/
def associates_int_equiv_nat : associates ℤ ≃ ℕ :=
  equiv.mk (fun (z : associates ℤ) => int.nat_abs (associates.out z))
    (fun (n : ℕ) => associates.mk ↑n) sorry sorry

theorem int.prime.dvd_mul {m : ℤ} {n : ℤ} {p : ℕ} (hp : nat.prime p) (h : ↑p ∣ m * n) :
    p ∣ int.nat_abs m ∨ p ∣ int.nat_abs n :=
  iff.mp (nat.prime.dvd_mul hp)
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (p ∣ int.nat_abs m * int.nat_abs n)) (Eq.symm (int.nat_abs_mul m n))))
      (iff.mp int.coe_nat_dvd_left h))

theorem int.prime.dvd_mul' {m : ℤ} {n : ℤ} {p : ℕ} (hp : nat.prime p) (h : ↑p ∣ m * n) :
    ↑p ∣ m ∨ ↑p ∣ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑p ∣ m ∨ ↑p ∣ n)) (propext int.coe_nat_dvd_left)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (p ∣ int.nat_abs m ∨ ↑p ∣ n)) (propext int.coe_nat_dvd_left)))
      (int.prime.dvd_mul hp h))

theorem int.prime.dvd_pow {n : ℤ} {k : ℕ} {p : ℕ} (hp : nat.prime p) (h : ↑p ∣ n ^ k) :
    p ∣ int.nat_abs n :=
  nat.prime.dvd_of_dvd_pow hp
    (eq.mpr (id (Eq._oldrec (Eq.refl (p ∣ int.nat_abs n ^ k)) (Eq.symm (int.nat_abs_pow n k))))
      (iff.mp int.coe_nat_dvd_left h))

theorem int.prime.dvd_pow' {n : ℤ} {k : ℕ} {p : ℕ} (hp : nat.prime p) (h : ↑p ∣ n ^ k) : ↑p ∣ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑p ∣ n)) (propext int.coe_nat_dvd_left)))
    (int.prime.dvd_pow hp h)

theorem prime_two_or_dvd_of_dvd_two_mul_pow_self_two {m : ℤ} {p : ℕ} (hp : nat.prime p)
    (h : ↑p ∣ bit0 1 * m ^ bit0 1) : p = bit0 1 ∨ p ∣ int.nat_abs m :=
  sorry

protected instance nat.unique_units : unique (units ℕ) :=
  unique.mk { default := 1 } nat.units_eq_one

theorem nat.factors_eq {n : ℕ} : unique_factorization_monoid.factors n = ↑(nat.factors n) := sorry

theorem nat.factors_multiset_prod_of_irreducible {s : multiset ℕ}
    (h : ∀ (x : ℕ), x ∈ s → irreducible x) :
    unique_factorization_monoid.factors (multiset.prod s) = s :=
  sorry

namespace multiplicity

theorem finite_int_iff_nat_abs_finite {a : ℤ} {b : ℤ} :
    finite a b ↔ finite (int.nat_abs a) (int.nat_abs b) :=
  sorry

theorem finite_int_iff {a : ℤ} {b : ℤ} : finite a b ↔ int.nat_abs a ≠ 1 ∧ b ≠ 0 := sorry

protected instance decidable_nat : DecidableRel fun (a b : ℕ) => roption.dom (multiplicity a b) :=
  fun (a b : ℕ) => decidable_of_iff (a ≠ 1 ∧ 0 < b) sorry

protected instance decidable_int : DecidableRel fun (a b : ℤ) => roption.dom (multiplicity a b) :=
  fun (a b : ℤ) => decidable_of_iff (int.nat_abs a ≠ 1 ∧ b ≠ 0) sorry

end Mathlib