/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.multiset.erase_dup
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Preparations for defining operations on `finset`.

The operations here ignore multiplicities,
and preparatory for defining the corresponding operations on `finset`.
-/

namespace multiset

/-! ### finset insert -/

/-- `ndinsert a s` is the lift of the list `insert` operation. This operation
  does not respect multiplicities, unlike `cons`, but it is suitable as
  an insert operation on `finset`. -/
def ndinsert {α : Type u_1} [DecidableEq α] (a : α) (s : multiset α) : multiset α :=
  quot.lift_on s (fun (l : List α) => ↑(list.insert a l)) sorry

@[simp] theorem coe_ndinsert {α : Type u_1} [DecidableEq α] (a : α) (l : List α) : ndinsert a ↑l = ↑(insert a l) :=
  rfl

@[simp] theorem ndinsert_zero {α : Type u_1} [DecidableEq α] (a : α) : ndinsert a 0 = a ::ₘ 0 :=
  rfl

@[simp] theorem ndinsert_of_mem {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} : a ∈ s → ndinsert a s = s :=
  quot.induction_on s fun (l : List α) (h : a ∈ Quot.mk setoid.r l) => congr_arg coe (list.insert_of_mem h)

@[simp] theorem ndinsert_of_not_mem {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} : ¬a ∈ s → ndinsert a s = a ::ₘ s :=
  quot.induction_on s fun (l : List α) (h : ¬a ∈ Quot.mk setoid.r l) => congr_arg coe (list.insert_of_not_mem h)

@[simp] theorem mem_ndinsert {α : Type u_1} [DecidableEq α] {a : α} {b : α} {s : multiset α} : a ∈ ndinsert b s ↔ a = b ∨ a ∈ s :=
  quot.induction_on s fun (l : List α) => list.mem_insert_iff

@[simp] theorem le_ndinsert_self {α : Type u_1} [DecidableEq α] (a : α) (s : multiset α) : s ≤ ndinsert a s :=
  quot.induction_on s fun (l : List α) => list.sublist.subperm (list.sublist_of_suffix (list.suffix_insert a l))

@[simp] theorem mem_ndinsert_self {α : Type u_1} [DecidableEq α] (a : α) (s : multiset α) : a ∈ ndinsert a s :=
  iff.mpr mem_ndinsert (Or.inl rfl)

theorem mem_ndinsert_of_mem {α : Type u_1} [DecidableEq α] {a : α} {b : α} {s : multiset α} (h : a ∈ s) : a ∈ ndinsert b s :=
  iff.mpr mem_ndinsert (Or.inr h)

@[simp] theorem length_ndinsert_of_mem {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} (h : a ∈ s) : coe_fn card (ndinsert a s) = coe_fn card s := sorry

@[simp] theorem length_ndinsert_of_not_mem {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} (h : ¬a ∈ s) : coe_fn card (ndinsert a s) = coe_fn card s + 1 := sorry

theorem erase_dup_cons {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} : erase_dup (a ::ₘ s) = ndinsert a (erase_dup s) := sorry

theorem nodup_ndinsert {α : Type u_1} [DecidableEq α] (a : α) {s : multiset α} : nodup s → nodup (ndinsert a s) :=
  quot.induction_on s fun (l : List α) => list.nodup_insert

theorem ndinsert_le {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} {t : multiset α} : ndinsert a s ≤ t ↔ s ≤ t ∧ a ∈ t := sorry

theorem attach_ndinsert {α : Type u_1} [DecidableEq α] (a : α) (s : multiset α) : attach (ndinsert a s) =
  ndinsert { val := a, property := mem_ndinsert_self a s }
    (map
      (fun (p : Subtype fun (x : α) => x ∈ s) =>
        { val := subtype.val p, property := mem_ndinsert_of_mem (subtype.property p) })
      (attach s)) := sorry

@[simp] theorem disjoint_ndinsert_left {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} {t : multiset α} : disjoint (ndinsert a s) t ↔ ¬a ∈ t ∧ disjoint s t := sorry

@[simp] theorem disjoint_ndinsert_right {α : Type u_1} [DecidableEq α] {a : α} {s : multiset α} {t : multiset α} : disjoint s (ndinsert a t) ↔ ¬a ∈ s ∧ disjoint s t := sorry

/-! ### finset union -/

/-- `ndunion s t` is the lift of the list `union` operation. This operation
  does not respect multiplicities, unlike `s ∪ t`, but it is suitable as
  a union operation on `finset`. (`s ∪ t` would also work as a union operation
  on finset, but this is more efficient.) -/
def ndunion {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : multiset α :=
  quotient.lift_on₂ s t (fun (l₁ l₂ : List α) => ↑(list.union l₁ l₂)) sorry

@[simp] theorem coe_ndunion {α : Type u_1} [DecidableEq α] (l₁ : List α) (l₂ : List α) : ndunion ↑l₁ ↑l₂ = ↑(l₁ ∪ l₂) :=
  rfl

@[simp] theorem zero_ndunion {α : Type u_1} [DecidableEq α] (s : multiset α) : ndunion 0 s = s :=
  quot.induction_on s fun (l : List α) => rfl

@[simp] theorem cons_ndunion {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) (a : α) : ndunion (a ::ₘ s) t = ndinsert a (ndunion s t) :=
  quotient.induction_on₂ s t fun (l₁ l₂ : List α) => rfl

@[simp] theorem mem_ndunion {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α} {a : α} : a ∈ ndunion s t ↔ a ∈ s ∨ a ∈ t :=
  quotient.induction_on₂ s t fun (l₁ l₂ : List α) => list.mem_union

theorem le_ndunion_right {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : t ≤ ndunion s t :=
  quotient.induction_on₂ s t
    fun (l₁ l₂ : List α) => list.sublist.subperm (list.sublist_of_suffix (list.suffix_union_right l₁ l₂))

theorem subset_ndunion_right {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : t ⊆ ndunion s t :=
  subset_of_le (le_ndunion_right s t)

theorem ndunion_le_add {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : ndunion s t ≤ s + t :=
  quotient.induction_on₂ s t fun (l₁ l₂ : List α) => list.sublist.subperm (list.union_sublist_append l₁ l₂)

theorem ndunion_le {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α} {u : multiset α} : ndunion s t ≤ u ↔ s ⊆ u ∧ t ≤ u := sorry

theorem subset_ndunion_left {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : s ⊆ ndunion s t :=
  fun (a : α) (h : a ∈ s) => iff.mpr mem_ndunion (Or.inl h)

theorem le_ndunion_left {α : Type u_1} [DecidableEq α] {s : multiset α} (t : multiset α) (d : nodup s) : s ≤ ndunion s t :=
  iff.mpr (le_iff_subset d) (subset_ndunion_left s t)

theorem ndunion_le_union {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : ndunion s t ≤ s ∪ t :=
  iff.mpr ndunion_le { left := subset_of_le (le_union_left s t), right := le_union_right s t }

theorem nodup_ndunion {α : Type u_1} [DecidableEq α] (s : multiset α) {t : multiset α} : nodup t → nodup (ndunion s t) :=
  quotient.induction_on₂ s t fun (l₁ l₂ : List α) => list.nodup_union l₁

@[simp] theorem ndunion_eq_union {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α} (d : nodup s) : ndunion s t = s ∪ t :=
  le_antisymm (ndunion_le_union s t) (union_le (le_ndunion_left t d) (le_ndunion_right s t))

theorem erase_dup_add {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : erase_dup (s + t) = ndunion s (erase_dup t) :=
  quotient.induction_on₂ s t fun (l₁ l₂ : List α) => congr_arg coe (list.erase_dup_append l₁ l₂)

/-! ### finset inter -/

/-- `ndinter s t` is the lift of the list `∩` operation. This operation
  does not respect multiplicities, unlike `s ∩ t`, but it is suitable as
  an intersection operation on `finset`. (`s ∩ t` would also work as a union operation
  on finset, but this is more efficient.) -/
def ndinter {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : multiset α :=
  filter (fun (_x : α) => _x ∈ t) s

@[simp] theorem coe_ndinter {α : Type u_1} [DecidableEq α] (l₁ : List α) (l₂ : List α) : ndinter ↑l₁ ↑l₂ = ↑(l₁ ∩ l₂) :=
  rfl

@[simp] theorem zero_ndinter {α : Type u_1} [DecidableEq α] (s : multiset α) : ndinter 0 s = 0 :=
  rfl

@[simp] theorem cons_ndinter_of_mem {α : Type u_1} [DecidableEq α] {a : α} (s : multiset α) {t : multiset α} (h : a ∈ t) : ndinter (a ::ₘ s) t = a ::ₘ ndinter s t := sorry

@[simp] theorem ndinter_cons_of_not_mem {α : Type u_1} [DecidableEq α] {a : α} (s : multiset α) {t : multiset α} (h : ¬a ∈ t) : ndinter (a ::ₘ s) t = ndinter s t := sorry

@[simp] theorem mem_ndinter {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α} {a : α} : a ∈ ndinter s t ↔ a ∈ s ∧ a ∈ t :=
  mem_filter

@[simp] theorem nodup_ndinter {α : Type u_1} [DecidableEq α] {s : multiset α} (t : multiset α) : nodup s → nodup (ndinter s t) :=
  nodup_filter fun (_x : α) => _x ∈ t

theorem le_ndinter {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α} {u : multiset α} : s ≤ ndinter t u ↔ s ≤ t ∧ s ⊆ u := sorry

theorem ndinter_le_left {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : ndinter s t ≤ s :=
  and.left (iff.mp le_ndinter (le_refl (ndinter s t)))

theorem ndinter_subset_left {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : ndinter s t ⊆ s :=
  subset_of_le (ndinter_le_left s t)

theorem ndinter_subset_right {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : ndinter s t ⊆ t :=
  and.right (iff.mp le_ndinter (le_refl (ndinter s t)))

theorem ndinter_le_right {α : Type u_1} [DecidableEq α] {s : multiset α} (t : multiset α) (d : nodup s) : ndinter s t ≤ t :=
  iff.mpr (le_iff_subset (nodup_ndinter t d)) (ndinter_subset_right s t)

theorem inter_le_ndinter {α : Type u_1} [DecidableEq α] (s : multiset α) (t : multiset α) : s ∩ t ≤ ndinter s t :=
  iff.mpr le_ndinter { left := inter_le_left s t, right := subset_of_le (inter_le_right s t) }

@[simp] theorem ndinter_eq_inter {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α} (d : nodup s) : ndinter s t = s ∩ t :=
  le_antisymm (le_inter (ndinter_le_left s t) (ndinter_le_right t d)) (inter_le_ndinter s t)

theorem ndinter_eq_zero_iff_disjoint {α : Type u_1} [DecidableEq α] {s : multiset α} {t : multiset α} : ndinter s t = 0 ↔ disjoint s t := sorry


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.associated
import Mathlib.tactic.ring
import Mathlib.PostPort

universes l

namespace Mathlib

/-- The ring of integers adjoined with a square root of `d`.
  These have the form `a + b √d` where `a b : ℤ`. The components
  are called `re` and `im` by analogy to the negative `d` case,
  but of course both parts are real here since `d` is nonnegative. -/
structure zsqrtd (d : ℤ)
where
  re : ℤ
  im : ℤ

prefix:100 "ℤ√" => Mathlib.zsqrtd

namespace zsqrtd

protected instance decidable_eq {d : ℤ} : DecidableEq (ℤ√d) :=
  id
    fun (_v : ℤ√d) =>
      cases_on _v
        fun (re im : ℤ) (w : ℤ√d) =>
          cases_on w
            fun (w_re w_im : ℤ) =>
              decidable.by_cases
                (fun (ᾰ : re = w_re) =>
                  Eq._oldrec
                    (decidable.by_cases (fun (ᾰ : im = w_im) => Eq._oldrec (is_true sorry) ᾰ)
                      fun (ᾰ : ¬im = w_im) => isFalse sorry)
                    ᾰ)
                fun (ᾰ : ¬re = w_re) => isFalse sorry

theorem ext {d : ℤ} {z : ℤ√d} {w : ℤ√d} : z = w ↔ re z = re w ∧ im z = im w := sorry

/-- Convert an integer to a `ℤ√d` -/
def of_int {d : ℤ} (n : ℤ) : ℤ√d :=
  mk n 0

theorem of_int_re {d : ℤ} (n : ℤ) : re (of_int n) = n :=
  rfl

theorem of_int_im {d : ℤ} (n : ℤ) : im (of_int n) = 0 :=
  rfl

/-- The zero of the ring -/
def zero {d : ℤ} : ℤ√d :=
  of_int 0

protected instance has_zero {d : ℤ} : HasZero (ℤ√d) :=
  { zero := zero }

@[simp] theorem zero_re {d : ℤ} : re 0 = 0 :=
  rfl

@[simp] theorem zero_im {d : ℤ} : im 0 = 0 :=
  rfl

protected instance inhabited {d : ℤ} : Inhabited (ℤ√d) :=
  { default := 0 }

/-- The one of the ring -/
def one {d : ℤ} : ℤ√d :=
  of_int 1

protected instance has_one {d : ℤ} : HasOne (ℤ√d) :=
  { one := one }

@[simp] theorem one_re {d : ℤ} : re 1 = 1 :=
  rfl

@[simp] theorem one_im {d : ℤ} : im 1 = 0 :=
  rfl

/-- The representative of `√d` in the ring -/
def sqrtd {d : ℤ} : ℤ√d :=
  mk 0 1

@[simp] theorem sqrtd_re {d : ℤ} : re sqrtd = 0 :=
  rfl

@[simp] theorem sqrtd_im {d : ℤ} : im sqrtd = 1 :=
  rfl

/-- Addition of elements of `ℤ√d` -/
def add {d : ℤ} : ℤ√d → ℤ√d → ℤ√d :=
  sorry

protected instance has_add {d : ℤ} : Add (ℤ√d) :=
  { add := add }

@[simp] theorem add_def {d : ℤ} (x : ℤ) (y : ℤ) (x' : ℤ) (y' : ℤ) : mk x y + mk x' y' = mk (x + x') (y + y') :=
  rfl

@[simp] theorem add_re {d : ℤ} (z : ℤ√d) (w : ℤ√d) : re (z + w) = re z + re w :=
  cases_on z
    fun (z_re z_im : ℤ) =>
      cases_on w fun (w_re w_im : ℤ) => idRhs (re (mk z_re z_im + mk w_re w_im) = re (mk z_re z_im + mk w_re w_im)) rfl

@[simp] theorem add_im {d : ℤ} (z : ℤ√d) (w : ℤ√d) : im (z + w) = im z + im w :=
  cases_on z
    fun (z_re z_im : ℤ) =>
      cases_on w fun (w_re w_im : ℤ) => idRhs (im (mk z_re z_im + mk w_re w_im) = im (mk z_re z_im + mk w_re w_im)) rfl

@[simp] theorem bit0_re {d : ℤ} (z : ℤ√d) : re (bit0 z) = bit0 (re z) :=
  add_re z z

@[simp] theorem bit0_im {d : ℤ} (z : ℤ√d) : im (bit0 z) = bit0 (im z) :=
  add_im z z

@[simp] theorem bit1_re {d : ℤ} (z : ℤ√d) : re (bit1 z) = bit1 (re z) := sorry

@[simp] theorem bit1_im {d : ℤ} (z : ℤ√d) : im (bit1 z) = bit0 (im z) := sorry

/-- Negation in `ℤ√d` -/
def neg {d : ℤ} : ℤ√d → ℤ√d :=
  sorry

protected instance has_neg {d : ℤ} : Neg (ℤ√d) :=
  { neg := neg }

@[simp] theorem neg_re {d : ℤ} (z : ℤ√d) : re (-z) = -re z :=
  cases_on z fun (z_re z_im : ℤ) => idRhs (re (-mk z_re z_im) = re (-mk z_re z_im)) rfl

@[simp] theorem neg_im {d : ℤ} (z : ℤ√d) : im (-z) = -im z :=
  cases_on z fun (z_re z_im : ℤ) => idRhs (im (-mk z_re z_im) = im (-mk z_re z_im)) rfl

/-- Conjugation in `ℤ√d`. The conjugate of `a + b √d` is `a - b √d`. -/
def conj {d : ℤ} : ℤ√d → ℤ√d :=
  sorry

@[simp] theorem conj_re {d : ℤ} (z : ℤ√d) : re (conj z) = re z :=
  cases_on z fun (z_re z_im : ℤ) => idRhs (re (conj (mk z_re z_im)) = re (conj (mk z_re z_im))) rfl

@[simp] theorem conj_im {d : ℤ} (z : ℤ√d) : im (conj z) = -im z :=
  cases_on z fun (z_re z_im : ℤ) => idRhs (im (conj (mk z_re z_im)) = im (conj (mk z_re z_im))) rfl

/-- Multiplication in `ℤ√d` -/
def mul {d : ℤ} : ℤ√d → ℤ√d → ℤ√d :=
  sorry

protected instance has_mul {d : ℤ} : Mul (ℤ√d) :=
  { mul := mul }

@[simp] theorem mul_re {d : ℤ} (z : ℤ√d) (w : ℤ√d) : re (z * w) = re z * re w + d * im z * im w :=
  cases_on z
    fun (z_re z_im : ℤ) =>
      cases_on w fun (w_re w_im : ℤ) => idRhs (re (mk z_re z_im * mk w_re w_im) = re (mk z_re z_im * mk w_re w_im)) rfl

@[simp] theorem mul_im {d : ℤ} (z : ℤ√d) (w : ℤ√d) : im (z * w) = re z * im w + im z * re w :=
  cases_on z
    fun (z_re z_im : ℤ) =>
      cases_on w fun (w_re w_im : ℤ) => idRhs (im (mk z_re z_im * mk w_re w_im) = im (mk z_re z_im * mk w_re w_im)) rfl

protected instance comm_ring {d : ℤ} : comm_ring (ℤ√d) :=
  comm_ring.mk Add.add sorry 0 sorry sorry Neg.neg (fun (a b : ℤ√d) => a + -b) sorry sorry Mul.mul sorry 1 sorry sorry
    sorry sorry sorry

protected instance add_comm_monoid {d : ℤ} : add_comm_monoid (ℤ√d) :=
  add_comm_group.to_add_comm_monoid (ℤ√d)

protected instance add_monoid {d : ℤ} : add_monoid (ℤ√d) :=
  sub_neg_monoid.to_add_monoid (ℤ√d)

protected instance monoid {d : ℤ} : monoid (ℤ√d) :=
  ring.to_monoid (ℤ√d)

protected instance comm_monoid {d : ℤ} : comm_monoid (ℤ√d) :=
  comm_semiring.to_comm_monoid (ℤ√d)

protected instance comm_semigroup {d : ℤ} : comm_semigroup (ℤ√d) :=
  comm_ring.to_comm_semigroup (ℤ√d)

protected instance semigroup {d : ℤ} : semigroup (ℤ√d) :=
  monoid.to_semigroup (ℤ√d)

protected instance add_comm_semigroup {d : ℤ} : add_comm_semigroup (ℤ√d) :=
  add_comm_monoid.to_add_comm_semigroup (ℤ√d)

protected instance add_semigroup {d : ℤ} : add_semigroup (ℤ√d) :=
  add_monoid.to_add_semigroup (ℤ√d)

protected instance comm_semiring {d : ℤ} : comm_semiring (ℤ√d) :=
  comm_ring.to_comm_semiring

protected instance semiring {d : ℤ} : semiring (ℤ√d) :=
  ring.to_semiring

protected instance ring {d : ℤ} : ring (ℤ√d) :=
  comm_ring.to_ring (ℤ√d)

protected instance distrib {d : ℤ} : distrib (ℤ√d) :=
  ring.to_distrib (ℤ√d)

protected instance nontrivial {d : ℤ} : nontrivial (ℤ√d) :=
  nontrivial.mk (Exists.intro 0 (Exists.intro 1 (of_as_true trivial)))

@[simp] theorem coe_nat_re {d : ℤ} (n : ℕ) : re ↑n = ↑n := sorry

@[simp] theorem coe_nat_im {d : ℤ} (n : ℕ) : im ↑n = 0 := sorry

theorem coe_nat_val {d : ℤ} (n : ℕ) : ↑n = mk (↑n) 0 := sorry

@[simp] theorem coe_int_re {d : ℤ} (n : ℤ) : re ↑n = n := sorry

@[simp] theorem coe_int_im {d : ℤ} (n : ℤ) : im ↑n = 0 := sorry

theorem coe_int_val {d : ℤ} (n : ℤ) : ↑n = mk n 0 := sorry

protected instance char_zero {d : ℤ} : char_zero (ℤ√d) := sorry

@[simp] theorem of_int_eq_coe {d : ℤ} (n : ℤ) : of_int n = ↑n := sorry

@[simp] theorem smul_val {d : ℤ} (n : ℤ) (x : ℤ) (y : ℤ) : ↑n * mk x y = mk (n * x) (n * y) := sorry

@[simp] theorem muld_val {d : ℤ} (x : ℤ) (y : ℤ) : sqrtd * mk x y = mk (d * y) x := sorry

@[simp] theorem dmuld {d : ℤ} : sqrtd * sqrtd = ↑d := sorry

@[simp] theorem smuld_val {d : ℤ} (n : ℤ) (x : ℤ) (y : ℤ) : sqrtd * ↑n * mk x y = mk (d * n * y) (n * x) := sorry

theorem decompose {d : ℤ} {x : ℤ} {y : ℤ} : mk x y = ↑x + sqrtd * ↑y := sorry

theorem mul_conj {d : ℤ} {x : ℤ} {y : ℤ} : mk x y * conj (mk x y) = ↑x * ↑x - ↑d * ↑y * ↑y := sorry

theorem conj_mul {d : ℤ} {a : ℤ√d} {b : ℤ√d} : conj (a * b) = conj a * conj b := sorry

protected theorem coe_int_add {d : ℤ} (m : ℤ) (n : ℤ) : ↑(m + n) = ↑m + ↑n :=
  ring_hom.map_add (int.cast_ring_hom (ℤ√d)) m n

protected theorem coe_int_sub {d : ℤ} (m : ℤ) (n : ℤ) : ↑(m - n) = ↑m - ↑n :=
  ring_hom.map_sub (int.cast_ring_hom (ℤ√d)) m n

protected theorem coe_int_mul {d : ℤ} (m : ℤ) (n : ℤ) : ↑(m * n) = ↑m * ↑n :=
  ring_hom.map_mul (int.cast_ring_hom (ℤ√d)) m n

protected theorem coe_int_inj {d : ℤ} {m : ℤ} {n : ℤ} (h : ↑m = ↑n) : m = n := sorry

/-- Read `sq_le a c b d` as `a √c ≤ b √d` -/
def sq_le (a : ℕ) (c : ℕ) (b : ℕ) (d : ℕ) :=
  c * a * a ≤ d * b * b

theorem sq_le_of_le {c : ℕ} {d : ℕ} {x : ℕ} {y : ℕ} {z : ℕ} {w : ℕ} (xz : z ≤ x) (yw : y ≤ w) (xy : sq_le x c y d) : sq_le z c w d :=
  le_trans (mul_le_mul (nat.mul_le_mul_left c xz) xz (nat.zero_le z) (nat.zero_le (c * x)))
    (le_trans xy (mul_le_mul (nat.mul_le_mul_left d yw) yw (nat.zero_le y) (nat.zero_le (d * w))))

theorem sq_le_add_mixed {c : ℕ} {d : ℕ} {x : ℕ} {y : ℕ} {z : ℕ} {w : ℕ} (xy : sq_le x c y d) (zw : sq_le z c w d) : c * (x * z) ≤ d * (y * w) := sorry

theorem sq_le_add {c : ℕ} {d : ℕ} {x : ℕ} {y : ℕ} {z : ℕ} {w : ℕ} (xy : sq_le x c y d) (zw : sq_le z c w d) : sq_le (x + z) c (y + w) d := sorry

theorem sq_le_cancel {c : ℕ} {d : ℕ} {x : ℕ} {y : ℕ} {z : ℕ} {w : ℕ} (zw : sq_le y d x c) (h : sq_le (x + z) c (y + w) d) : sq_le z c w d := sorry

theorem sq_le_smul {c : ℕ} {d : ℕ} {x : ℕ} {y : ℕ} (n : ℕ) (xy : sq_le x c y d) : sq_le (n * x) c (n * y) d := sorry

theorem sq_le_mul {d : ℕ} {x : ℕ} {y : ℕ} {z : ℕ} {w : ℕ} : (sq_le x 1 y d → sq_le z 1 w d → sq_le (x * w + y * z) d (x * z + d * y * w) 1) ∧
  (sq_le x 1 y d → sq_le w d z 1 → sq_le (x * z + d * y * w) 1 (x * w + y * z) d) ∧
    (sq_le y d x 1 → sq_le z 1 w d → sq_le (x * z + d * y * w) 1 (x * w + y * z) d) ∧
      (sq_le y d x 1 → sq_le w d z 1 → sq_le (x * w + y * z) d (x * z + d * y * w) 1) := sorry

/-- "Generalized" `nonneg`. `nonnegg c d x y` means `a √c + b √d ≥ 0`;
  we are interested in the case `c = 1` but this is more symmetric -/
def nonnegg (c : ℕ) (d : ℕ) : ℤ → ℤ → Prop :=
  sorry

theorem nonnegg_comm {c : ℕ} {d : ℕ} {x : ℤ} {y : ℤ} : nonnegg c d x y = nonnegg d c y x := sorry

theorem nonnegg_neg_pos {c : ℕ} {d : ℕ} {a : ℕ} {b : ℕ} : nonnegg c d (-↑a) ↑b ↔ sq_le a d b c := sorry

theorem nonnegg_pos_neg {c : ℕ} {d : ℕ} {a : ℕ} {b : ℕ} : nonnegg c d (↑a) (-↑b) ↔ sq_le b c a d :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nonnegg c d (↑a) (-↑b) ↔ sq_le b c a d)) nonnegg_comm)) nonnegg_neg_pos

theorem nonnegg_cases_right {c : ℕ} {d : ℕ} {a : ℕ} {b : ℤ} : (∀ (x : ℕ), b = -↑x → sq_le x c a d) → nonnegg c d (↑a) b :=
  fun (ᾰ : ∀ (x : ℕ), b = -↑x → sq_le x c a d) =>
    int.cases_on b (fun (b : ℕ) (ᾰ : ∀ (x : ℕ), Int.ofNat b = -↑x → sq_le x c a d) => idRhs True trivial)
      (fun (b : ℕ) (ᾰ : ∀ (x : ℕ), Int.negSucc b = -↑x → sq_le x c a d) => idRhs (sq_le (b + 1) c a d) (ᾰ (b + 1) rfl)) ᾰ

theorem nonnegg_cases_left {c : ℕ} {d : ℕ} {b : ℕ} {a : ℤ} (h : ∀ (x : ℕ), a = -↑x → sq_le x d b c) : nonnegg c d a ↑b :=
  cast nonnegg_comm (nonnegg_cases_right h)

def norm {d : ℤ} (n : ℤ√d) : ℤ :=
  re n * re n - d * im n * im n

@[simp] theorem norm_zero {d : ℤ} : norm 0 = 0 := sorry

@[simp] theorem norm_one {d : ℤ} : norm 1 = 1 := sorry

@[simp] theorem norm_int_cast {d : ℤ} (n : ℤ) : norm ↑n = n * n := sorry

@[simp] theorem norm_nat_cast {d : ℤ} (n : ℕ) : norm ↑n = ↑n * ↑n :=
  norm_int_cast ↑n

@[simp] theorem norm_mul {d : ℤ} (n : ℤ√d) (m : ℤ√d) : norm (n * m) = norm n * norm m := sorry

theorem norm_eq_mul_conj {d : ℤ} (n : ℤ√d) : ↑(norm n) = n * conj n := sorry

protected instance norm.is_monoid_hom {d : ℤ} : is_monoid_hom norm :=
  is_monoid_hom.mk norm_one

theorem norm_nonneg {d : ℤ} (hd : d ≤ 0) (n : ℤ√d) : 0 ≤ norm n := sorry

theorem norm_eq_one_iff {d : ℤ} {x : ℤ√d} : int.nat_abs (norm x) = 1 ↔ is_unit x := sorry

/-- Nonnegativity of an element of `ℤ√d`. -/
def nonneg {d : ℕ} : ℤ√↑d → Prop :=
  sorry

protected def le {d : ℕ} (a : ℤ√↑d) (b : ℤ√↑d) :=
  nonneg (b - a)

protected instance has_le {d : ℕ} : HasLessEq (ℤ√↑d) :=
  { LessEq := zsqrtd.le }

protected def lt {d : ℕ} (a : ℤ√↑d) (b : ℤ√↑d) :=
  ¬b ≤ a

protected instance has_lt {d : ℕ} : HasLess (ℤ√↑d) :=
  { Less := zsqrtd.lt }

protected instance decidable_nonnegg (c : ℕ) (d : ℕ) (a : ℤ) (b : ℤ) : Decidable (nonnegg c d a b) :=
  int.cases_on a
    (fun (a : ℕ) =>
      int.cases_on b (fun (b : ℕ) => eq.mpr sorry (eq.mpr sorry (eq.mpr sorry decidable.true)))
        fun (b : ℕ) => eq.mpr sorry (eq.mpr sorry (nat.decidable_le (c * (b + 1) * (b + 1)) (d * a * a))))
    fun (a : ℕ) =>
      int.cases_on b (fun (b : ℕ) => eq.mpr sorry (eq.mpr sorry (nat.decidable_le (d * (a + 1) * (a + 1)) (c * b * b))))
        fun (b : ℕ) => eq.mpr sorry decidable.false

protected instance decidable_nonneg {d : ℕ} (a : ℤ√↑d) : Decidable (nonneg a) :=
  sorry

protected instance decidable_le {d : ℕ} (a : ℤ√↑d) (b : ℤ√↑d) : Decidable (a ≤ b) :=
  zsqrtd.decidable_nonneg (b - a)

theorem nonneg_cases {d : ℕ} {a : ℤ√↑d} : nonneg a → ∃ (x : ℕ), ∃ (y : ℕ), a = mk ↑x ↑y ∨ a = mk (↑x) (-↑y) ∨ a = mk (-↑x) ↑y := sorry

theorem nonneg_add_lem {d : ℕ} {x : ℕ} {y : ℕ} {z : ℕ} {w : ℕ} (xy : nonneg (mk (↑x) (-↑y))) (zw : nonneg (mk (-↑z) ↑w)) : nonneg (mk (↑x) (-↑y) + mk (-↑z) ↑w) := sorry

theorem nonneg_add {d : ℕ} {a : ℤ√↑d} {b : ℤ√↑d} (ha : nonneg a) (hb : nonneg b) : nonneg (a + b) := sorry

theorem le_refl {d : ℕ} (a : ℤ√↑d) : a ≤ a :=
  (fun (this : nonneg (a - a)) => this)
    (eq.mpr (id ((fun (ᾰ ᾰ_1 : ℤ√↑d) (e_1 : ᾰ = ᾰ_1) => congr_arg nonneg e_1) (a - a) 0 (sub_self a))) trivial)

protected theorem le_trans {d : ℕ} {a : ℤ√↑d} {b : ℤ√↑d} {c : ℤ√↑d} (ab : a ≤ b) (bc : b ≤ c) : a ≤ c := sorry

theorem nonneg_iff_zero_le {d : ℕ} {a : ℤ√↑d} : nonneg a ↔ 0 ≤ a := sorry

theorem le_of_le_le {d : ℕ} {x : ℤ} {y : ℤ} {z : ℤ} {w : ℤ} (xz : x ≤ z) (yw : y ≤ w) : mk x y ≤ mk z w := sorry

theorem le_arch {d : ℕ} (a : ℤ√↑d) : ∃ (n : ℕ), a ≤ ↑n := sorry

protected theorem nonneg_total {d : ℕ} (a : ℤ√↑d) : nonneg a ∨ nonneg (-a) := sorry

protected theorem le_total {d : ℕ} (a : ℤ√↑d) (b : ℤ√↑d) : a ≤ b ∨ b ≤ a :=
  let t : nonneg (b - a) ∨ nonneg (-(b - a)) := zsqrtd.nonneg_total (b - a);
  eq.mp
    (Eq._oldrec (Eq.refl (nonneg (b - a) ∨ nonneg (-(b - a)))) ((fun (this : -(b - a) = a - b) => this) (neg_sub b a))) t

protected instance preorder {d : ℕ} : preorder (ℤ√↑d) :=
  preorder.mk zsqrtd.le zsqrtd.lt le_refl zsqrtd.le_trans

protected theorem add_le_add_left {d : ℕ} (a : ℤ√↑d) (b : ℤ√↑d) (ab : a ≤ b) (c : ℤ√↑d) : c + a ≤ c + b :=
  (fun (this : nonneg (c + b - (c + a))) => this)
    (eq.mpr (id (Eq._oldrec (Eq.refl (nonneg (c + b - (c + a)))) (add_sub_add_left_eq_sub b a c))) ab)

protected theorem le_of_add_le_add_left {d : ℕ} (a : ℤ√↑d) (b : ℤ√↑d) (c : ℤ√↑d) (h : c + a ≤ c + b) : a ≤ b := sorry

protected theorem add_lt_add_left {d : ℕ} (a : ℤ√↑d) (b : ℤ√↑d) (h : a < b) (c : ℤ√↑d) : c + a < c + b :=
  fun (h' : c + b ≤ c + a) => h (zsqrtd.le_of_add_le_add_left b a c h')

theorem nonneg_smul {d : ℕ} {a : ℤ√↑d} {n : ℕ} (ha : nonneg a) : nonneg (↑n * a) := sorry

theorem nonneg_muld {d : ℕ} {a : ℤ√↑d} (ha : nonneg a) : nonneg (sqrtd * a) := sorry

theorem nonneg_mul_lem {d : ℕ} {x : ℕ} {y : ℕ} {a : ℤ√↑d} (ha : nonneg a) : nonneg (mk ↑x ↑y * a) := sorry

theorem nonneg_mul {d : ℕ} {a : ℤ√↑d} {b : ℤ√↑d} (ha : nonneg a) (hb : nonneg b) : nonneg (a * b) := sorry

protected theorem mul_nonneg {d : ℕ} (a : ℤ√↑d) (b : ℤ√↑d) : 0 ≤ a → 0 ≤ b → 0 ≤ a * b := sorry

theorem not_sq_le_succ (c : ℕ) (d : ℕ) (y : ℕ) (h : 0 < c) : ¬sq_le (y + 1) c 0 d :=
  not_le_of_gt (mul_pos (mul_pos h (nat.succ_pos y)) (nat.succ_pos y))

/-- A nonsquare is a natural number that is not equal to the square of an
  integer. This is implemented as a typeclass because it's a necessary condition
  for much of the Pell equation theory. -/
class nonsquare (x : ℕ)
where
  ns : ∀ (n : ℕ), x ≠ n * n

theorem d_pos {d : ℕ} [dnsq : nonsquare d] : 0 < d :=
  lt_of_le_of_ne (nat.zero_le d) (ne.symm (nonsquare.ns d 0))

theorem divides_sq_eq_zero {d : ℕ} [dnsq : nonsquare d] {x : ℕ} {y : ℕ} (h : x * x = d * y * y) : x = 0 ∧ y = 0 := sorry

theorem divides_sq_eq_zero_z {d : ℕ} [dnsq : nonsquare d] {x : ℤ} {y : ℤ} (h : x * x = ↑d * y * y) : x = 0 ∧ y = 0 := sorry

theorem not_divides_square {d : ℕ} [dnsq : nonsquare d] (x : ℕ) (y : ℕ) : (x + 1) * (x + 1) ≠ d * (y + 1) * (y + 1) :=
  fun (e : (x + 1) * (x + 1) = d * (y + 1) * (y + 1)) => nat.no_confusion (and.left (divides_sq_eq_zero e))

theorem nonneg_antisymm {d : ℕ} [dnsq : nonsquare d] {a : ℤ√↑d} : nonneg a → nonneg (-a) → a = 0 := sorry

theorem le_antisymm {d : ℕ} [dnsq : nonsquare d] {a : ℤ√↑d} {b : ℤ√↑d} (ab : a ≤ b) (ba : b ≤ a) : a = b :=
  eq_of_sub_eq_zero (nonneg_antisymm ba (eq.mpr (id (Eq._oldrec (Eq.refl (nonneg (-(a - b)))) (neg_sub a b))) ab))

protected instance linear_order {d : ℕ} [dnsq : nonsquare d] : linear_order (ℤ√↑d) :=
  linear_order.mk preorder.le preorder.lt sorry sorry le_antisymm zsqrtd.le_total zsqrtd.decidable_le
    Mathlib.decidable_eq_of_decidable_le Mathlib.decidable_lt_of_decidable_le

protected theorem eq_zero_or_eq_zero_of_mul_eq_zero {d : ℕ} [dnsq : nonsquare d] {a : ℤ√↑d} {b : ℤ√↑d} : a * b = 0 → a = 0 ∨ b = 0 := sorry

protected instance integral_domain {d : ℕ} [dnsq : nonsquare d] : integral_domain (ℤ√↑d) :=
  integral_domain.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry comm_ring.mul
    sorry comm_ring.one sorry sorry sorry sorry sorry sorry zsqrtd.eq_zero_or_eq_zero_of_mul_eq_zero

protected theorem mul_pos {d : ℕ} [dnsq : nonsquare d] (a : ℤ√↑d) (b : ℤ√↑d) (a0 : 0 < a) (b0 : 0 < b) : 0 < a * b := sorry

protected instance linear_ordered_comm_ring {d : ℕ} [dnsq : nonsquare d] : linear_ordered_comm_ring (ℤ√↑d) :=
  linear_ordered_comm_ring.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry
    comm_ring.mul sorry comm_ring.one sorry sorry sorry sorry linear_order.le linear_order.lt sorry sorry sorry
    zsqrtd.add_le_add_left sorry zsqrtd.mul_pos sorry linear_order.decidable_le linear_order.decidable_eq
    linear_order.decidable_lt sorry sorry

protected instance linear_ordered_semiring {d : ℕ} [dnsq : nonsquare d] : linear_ordered_semiring (ℤ√↑d) :=
  linear_ordered_comm_ring.to_linear_ordered_semiring

protected instance ordered_semiring {d : ℕ} [dnsq : nonsquare d] : ordered_semiring (ℤ√↑d) :=
  ordered_ring.to_ordered_semiring

theorem norm_eq_zero {d : ℤ} (h_nonsquare : ∀ (n : ℤ), d ≠ n * n) (a : ℤ√d) : norm a = 0 ↔ a = 0 := sorry

theorem hom_ext {R : Type} [comm_ring R] {d : ℤ} (f : ℤ√d →+* R) (g : ℤ√d →+* R) (h : coe_fn f sqrtd = coe_fn g sqrtd) : f = g := sorry

/-- The unique `ring_hom` from `ℤ√d` to a ring `R`, constructed by replacing `√d` with the provided
root. Conversely, this associates to every mapping `ℤ√d →+* R` a value of `√d` in `R`. -/
@[simp] theorem lift_symm_apply_coe {R : Type} [comm_ring R] {d : ℤ} (f : ℤ√d →+* R) : ↑(coe_fn (equiv.symm lift) f) = coe_fn f sqrtd :=
  Eq.refl ↑(coe_fn (equiv.symm lift) f)

/-- `lift r` is injective if `d` is non-square, and R has characteristic zero (that is, the map from
`ℤ` into `R` is injective). -/
theorem lift_injective {R : Type} [comm_ring R] [char_zero R] {d : ℤ} (r : Subtype fun (r : R) => r * r = ↑d) (hd : ∀ (n : ℤ), d ≠ n * n) : function.injective ⇑(coe_fn lift r) := sorry


/-
Copyright (c) 2020 Kenji Nakagawa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenji Nakagawa, Anne Baanen, Filippo A. E. Nuccio
-/
import algebra.algebra.subalgebra.pointwise
import algebraic_geometry.prime_spectrum.noetherian
import order.hom.basic
import ring_theory.dedekind_domain.basic
import ring_theory.fractional_ideal

/-!
# Dedekind domains and ideals

In this file, we show a ring is a Dedekind domain iff all fractional ideals are invertible.
Then we prove some results on the unique factorization monoid structure of the ideals.

## Main definitions

 - `is_dedekind_domain_inv` alternatively defines a Dedekind domain as an integral domain where
   every nonzero fractional ideal is invertible.
 - `is_dedekind_domain_inv_iff` shows that this does note depend on the choice of field of
   fractions.
 - `is_dedekind_domain.height_one_spectrum` defines the type of nonzero prime ideals of `R`.

## Main results:
 - `is_dedekind_domain_iff_is_dedekind_domain_inv`
 - `ideal.unique_factorization_monoid`

## Implementation notes

The definitions that involve a field of fractions choose a canonical field of fractions,
but are independent of that choice. The `..._iff` lemmas express this independence.

Often, definitions assume that Dedekind domains are not fields. We found it more practical
to add a `(h : ¬ is_field A)` assumption whenever this is explicitly needed.

## References

* [D. Marcus, *Number Fields*][marcus1977number]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [J. Neukirch, *Algebraic Number Theory*][Neukirch1992]

## Tags

dedekind domain, dedekind ring
-/

variables (R A K : Type*) [comm_ring R] [comm_ring A] [field K]

open_locale non_zero_divisors polynomial

variables [is_domain A]

section inverse

namespace fractional_ideal

variables {R₁ : Type*} [comm_ring R₁] [is_domain R₁] [algebra R₁ K] [is_fraction_ring R₁ K]
variables {I J : fractional_ideal R₁⁰ K}

noncomputable instance : has_inv (fractional_ideal R₁⁰ K) := ⟨λ I, 1 / I⟩

lemma inv_eq : I⁻¹ = 1 / I := rfl

lemma inv_zero' : (0 : fractional_ideal R₁⁰ K)⁻¹ = 0 := fractional_ideal.div_zero

lemma inv_nonzero {J : fractional_ideal R₁⁰ K} (h : J ≠ 0) :
J⁻¹ = ⟨(1 : fractional_ideal R₁⁰ K) / J, fractional_ideal.fractional_div_of_nonzero h⟩ :=
fractional_ideal.div_nonzero _

lemma coe_inv_of_nonzero {J : fractional_ideal R₁⁰ K} (h : J ≠ 0) :
  (↑J⁻¹ : submodule R₁ K) = is_localization.coe_submodule K ⊤ / J :=
by { rwa inv_nonzero _, refl, assumption }

variables {K}

lemma mem_inv_iff (hI : I ≠ 0) {x : K} :
  x ∈ I⁻¹ ↔ ∀ y ∈ I, x * y ∈ (1 : fractional_ideal R₁⁰ K) :=
fractional_ideal.mem_div_iff_of_nonzero hI

lemma inv_anti_mono (hI : I ≠ 0) (hJ : J ≠ 0) (hIJ : I ≤ J) :
  J⁻¹ ≤ I⁻¹ :=
λ x, by { simp only [mem_inv_iff hI, mem_inv_iff hJ], exact λ h y hy, h y (hIJ hy) }

lemma le_self_mul_inv {I : fractional_ideal R₁⁰ K} (hI : I ≤ (1 : fractional_ideal R₁⁰ K)) :
  I ≤ I * I⁻¹ :=
fractional_ideal.le_self_mul_one_div hI

variables (K)

lemma coe_ideal_le_self_mul_inv (I : ideal R₁) :
  (I : fractional_ideal R₁⁰ K) ≤ I * I⁻¹ :=
le_self_mul_inv fractional_ideal.coe_ideal_le_one

/-- `I⁻¹` is the inverse of `I` if `I` has an inverse. -/
theorem right_inverse_eq (I J : fractional_ideal R₁⁰ K) (h : I * J = 1) :
  J = I⁻¹ :=
begin
  have hI : I ≠ 0 := fractional_ideal.ne_zero_of_mul_eq_one I J h,
  suffices h' : I * (1 / I) = 1,
  { exact (congr_arg units.inv $
      @units.ext _ _ (units.mk_of_mul_eq_one _ _ h) (units.mk_of_mul_eq_one _ _ h') rfl) },
  apply le_antisymm,
  { apply fractional_ideal.mul_le.mpr _,
    intros x hx y hy,
    rw mul_comm,
    exact (fractional_ideal.mem_div_iff_of_nonzero hI).mp hy x hx },
  rw ← h,
  apply fractional_ideal.mul_left_mono I,
  apply (fractional_ideal.le_div_iff_of_nonzero hI).mpr _,
  intros y hy x hx,
  rw mul_comm,
  exact fractional_ideal.mul_mem_mul hx hy
end

theorem mul_inv_cancel_iff {I : fractional_ideal R₁⁰ K} :
  I * I⁻¹ = 1 ↔ ∃ J, I * J = 1 :=
⟨λ h, ⟨I⁻¹, h⟩, λ ⟨J, hJ⟩, by rwa ← right_inverse_eq K I J hJ⟩

lemma mul_inv_cancel_iff_is_unit {I : fractional_ideal R₁⁰ K} :
  I * I⁻¹ = 1 ↔ is_unit I :=
(mul_inv_cancel_iff K).trans is_unit_iff_exists_inv.symm

variables {K' : Type*} [field K'] [algebra R₁ K'] [is_fraction_ring R₁ K']

@[simp] lemma map_inv (I : fractional_ideal R₁⁰ K) (h : K ≃ₐ[R₁] K') :
  (I⁻¹).map (h : K →ₐ[R₁] K') = (I.map h)⁻¹ :=
by rw [inv_eq, fractional_ideal.map_div, fractional_ideal.map_one, inv_eq]

open submodule submodule.is_principal

@[simp] lemma span_singleton_inv (x : K) :
  (fractional_ideal.span_singleton R₁⁰ x)⁻¹ = fractional_ideal.span_singleton _ (x⁻¹) :=
fractional_ideal.one_div_span_singleton x

lemma mul_generator_self_inv {R₁ : Type*} [comm_ring R₁] [algebra R₁ K] [is_localization R₁⁰ K]
  (I : fractional_ideal R₁⁰ K) [submodule.is_principal (I : submodule R₁ K)] (h : I ≠ 0) :
  I * fractional_ideal.span_singleton _ (generator (I : submodule R₁ K))⁻¹ = 1 :=
begin
  -- Rewrite only the `I` that appears alone.
  conv_lhs { congr, rw fractional_ideal.eq_span_singleton_of_principal I },
  rw [fractional_ideal.span_singleton_mul_span_singleton, mul_inv_cancel,
    fractional_ideal.span_singleton_one],
  intro generator_I_eq_zero,
  apply h,
  rw [fractional_ideal.eq_span_singleton_of_principal I, generator_I_eq_zero,
    fractional_ideal.span_singleton_zero]
end

lemma invertible_of_principal (I : fractional_ideal R₁⁰ K)
  [submodule.is_principal (I : submodule R₁ K)] (h : I ≠ 0) :
  I * I⁻¹ = 1 :=
(fractional_ideal.mul_div_self_cancel_iff).mpr
  ⟨fractional_ideal.span_singleton _ (generator (I : submodule R₁ K))⁻¹,
    mul_generator_self_inv _ I h⟩

lemma invertible_iff_generator_nonzero (I : fractional_ideal R₁⁰ K)
  [submodule.is_principal (I : submodule R₁ K)] :
  I * I⁻¹ = 1 ↔ generator (I : submodule R₁ K) ≠ 0 :=
begin
  split,
  { intros hI hg,
    apply fractional_ideal.ne_zero_of_mul_eq_one _ _ hI,
    rw [fractional_ideal.eq_span_singleton_of_principal I, hg,
        fractional_ideal.span_singleton_zero] },
  { intro hg,
    apply invertible_of_principal,
    rw [fractional_ideal.eq_span_singleton_of_principal I],
    intro hI,
    have := fractional_ideal.mem_span_singleton_self _ (generator (I : submodule R₁ K)),
    rw [hI, fractional_ideal.mem_zero_iff] at this,
    contradiction }
end

lemma is_principal_inv (I : fractional_ideal R₁⁰ K)
  [submodule.is_principal (I : submodule R₁ K)] (h : I ≠ 0) :
  submodule.is_principal (I⁻¹).1 :=
begin
  rw [fractional_ideal.val_eq_coe, fractional_ideal.is_principal_iff],
  use (generator (I : submodule R₁ K))⁻¹,
  have hI : I  * fractional_ideal.span_singleton _ ((generator (I : submodule R₁ K))⁻¹)  = 1,
  apply mul_generator_self_inv _ I h,
  exact (right_inverse_eq _ I (fractional_ideal.span_singleton _
    ((generator (I : submodule R₁ K))⁻¹)) hI).symm
end

@[simp] lemma inv_one : (1⁻¹ : fractional_ideal R₁⁰ K) = 1 :=
fractional_ideal.div_one

end fractional_ideal

/--
A Dedekind domain is an integral domain such that every fractional ideal has an inverse.

This is equivalent to `is_dedekind_domain`.
In particular we provide a `fractional_ideal.comm_group_with_zero` instance,
assuming `is_dedekind_domain A`, which implies `is_dedekind_domain_inv`. For **integral** ideals,
`is_dedekind_domain`(`_inv`) implies only `ideal.cancel_comm_monoid_with_zero`.
-/
def is_dedekind_domain_inv : Prop :=
∀ I ≠ (⊥ : fractional_ideal A⁰ (fraction_ring A)), I * I⁻¹ = 1

open fractional_ideal

variables {R A K}

lemma is_dedekind_domain_inv_iff [algebra A K] [is_fraction_ring A K] :
  is_dedekind_domain_inv A ↔
    (∀ I ≠ (⊥ : fractional_ideal A⁰ K), I * I⁻¹ = 1) :=
begin
  let h := fractional_ideal.map_equiv (fraction_ring.alg_equiv A K),
  refine h.to_equiv.forall_congr (λ I, _),
  rw ← h.to_equiv.apply_eq_iff_eq,
  simp [is_dedekind_domain_inv, show ⇑h.to_equiv = h, from rfl],
end

lemma fractional_ideal.adjoin_integral_eq_one_of_is_unit [algebra A K] [is_fraction_ring A K]
  (x : K) (hx : is_integral A x) (hI : is_unit (adjoin_integral A⁰ x hx)) :
  adjoin_integral A⁰ x hx = 1 :=
begin
  set I := adjoin_integral A⁰ x hx,
  have mul_self : I * I = I,
  { apply fractional_ideal.coe_to_submodule_injective, simp },
  convert congr_arg (* I⁻¹) mul_self;
  simp only [(mul_inv_cancel_iff_is_unit K).mpr hI, mul_assoc, mul_one],
end

namespace is_dedekind_domain_inv

variables [algebra A K] [is_fraction_ring A K] (h : is_dedekind_domain_inv A)

include h

lemma mul_inv_eq_one {I : fractional_ideal A⁰ K} (hI : I ≠ 0) : I * I⁻¹ = 1 :=
is_dedekind_domain_inv_iff.mp h I hI

lemma inv_mul_eq_one {I : fractional_ideal A⁰ K} (hI : I ≠ 0) : I⁻¹ * I = 1 :=
(mul_comm _ _).trans (h.mul_inv_eq_one hI)

protected lemma is_unit {I : fractional_ideal A⁰ K} (hI : I ≠ 0) : is_unit I :=
is_unit_of_mul_eq_one _ _ (h.mul_inv_eq_one hI)

lemma is_noetherian_ring : is_noetherian_ring A :=
begin
  refine is_noetherian_ring_iff.mpr ⟨λ (I : ideal A), _⟩,
  by_cases hI : I = ⊥,
  { rw hI, apply submodule.fg_bot },
  have hI : (I : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
    (coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr hI,
  exact I.fg_of_is_unit (is_fraction_ring.injective A (fraction_ring A)) (h.is_unit hI)
end

lemma integrally_closed : is_integrally_closed A :=
begin
  -- It suffices to show that for integral `x`,
  -- `A[x]` (which is a fractional ideal) is in fact equal to `A`.
  refine ⟨λ x hx, _⟩,
  rw [← set.mem_range, ← algebra.mem_bot, ← subalgebra.mem_to_submodule, algebra.to_submodule_bot,
      ← coe_span_singleton A⁰ (1 : fraction_ring A), fractional_ideal.span_singleton_one,
      ← fractional_ideal.adjoin_integral_eq_one_of_is_unit x hx (h.is_unit _)],
  { exact mem_adjoin_integral_self A⁰ x hx },
  { exact λ h, one_ne_zero (eq_zero_iff.mp h 1 (subalgebra.one_mem _)) },
end

open ring

lemma dimension_le_one : dimension_le_one A :=
begin
  -- We're going to show that `P` is maximal because any (maximal) ideal `M`
  -- that is strictly larger would be `⊤`.
  rintros P P_ne hP,
  refine ideal.is_maximal_def.mpr ⟨hP.ne_top, λ M hM, _⟩,
  -- We may assume `P` and `M` (as fractional ideals) are nonzero.
  have P'_ne : (P : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
    (coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr P_ne,
  have M'_ne : (M : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
    (coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr
      (lt_of_le_of_lt bot_le hM).ne',

  -- In particular, we'll show `M⁻¹ * P ≤ P`
  suffices : (M⁻¹ * P : fractional_ideal A⁰ (fraction_ring A)) ≤ P,
  { rw [eq_top_iff, ← coe_ideal_le_coe_ideal (fraction_ring A), fractional_ideal.coe_ideal_top],
    calc (1 : fractional_ideal A⁰ (fraction_ring A)) = _ * _ * _ : _
    ... ≤ _ * _ : mul_right_mono (P⁻¹ * M : fractional_ideal A⁰ (fraction_ring A)) this
    ... = M : _,
    { rw [mul_assoc, ← mul_assoc ↑P, h.mul_inv_eq_one P'_ne, one_mul, h.inv_mul_eq_one M'_ne] },
    { rw [← mul_assoc ↑P, h.mul_inv_eq_one P'_ne, one_mul] },
    { apply_instance } },

  -- Suppose we have `x ∈ M⁻¹ * P`, then in fact `x = algebra_map _ _ y` for some `y`.
  intros x hx,
  have le_one : (M⁻¹ * P : fractional_ideal A⁰ (fraction_ring A)) ≤ 1,
  { rw [← h.inv_mul_eq_one M'_ne],
    exact fractional_ideal.mul_left_mono _ ((coe_ideal_le_coe_ideal (fraction_ring A)).mpr hM.le) },
  obtain ⟨y, hy, rfl⟩ := (mem_coe_ideal _).mp (le_one hx),

  -- Since `M` is strictly greater than `P`, let `z ∈ M \ P`.
  obtain ⟨z, hzM, hzp⟩ := set_like.exists_of_lt hM,
  -- We have `z * y ∈ M * (M⁻¹ * P) = P`.
  have zy_mem := fractional_ideal.mul_mem_mul (mem_coe_ideal_of_mem A⁰ hzM) hx,
  rw [← ring_hom.map_mul, ← mul_assoc, h.mul_inv_eq_one M'_ne, one_mul] at zy_mem,
  obtain ⟨zy, hzy, zy_eq⟩ := (mem_coe_ideal A⁰).mp zy_mem,
  rw is_fraction_ring.injective A (fraction_ring A) zy_eq at hzy,
  -- But `P` is a prime ideal, so `z ∉ P` implies `y ∈ P`, as desired.
  exact mem_coe_ideal_of_mem A⁰ (or.resolve_left (hP.mem_or_mem hzy) hzp)
end

/-- Showing one side of the equivalence between the definitions
`is_dedekind_domain_inv` and `is_dedekind_domain` of Dedekind domains. -/
theorem is_dedekind_domain : is_dedekind_domain A :=
⟨h.is_noetherian_ring, h.dimension_le_one, h.integrally_closed⟩

end is_dedekind_domain_inv

variables [algebra A K] [is_fraction_ring A K]

/-- Specialization of `exists_prime_spectrum_prod_le_and_ne_bot_of_domain` to Dedekind domains:
Let `I : ideal A` be a nonzero ideal, where `A` is a Dedekind domain that is not a field.
Then `exists_prime_spectrum_prod_le_and_ne_bot_of_domain` states we can find a product of prime
ideals that is contained within `I`. This lemma extends that result by making the product minimal:
let `M` be a maximal ideal that contains `I`, then the product including `M` is contained within `I`
and the product excluding `M` is not contained within `I`. -/
lemma exists_multiset_prod_cons_le_and_prod_not_le [is_dedekind_domain A]
  (hNF : ¬ is_field A) {I M : ideal A} (hI0 : I ≠ ⊥) (hIM : I ≤ M) [hM : M.is_maximal] :
  ∃ (Z : multiset (prime_spectrum A)),
    (M ::ₘ (Z.map prime_spectrum.as_ideal)).prod ≤ I ∧
    ¬ (multiset.prod (Z.map prime_spectrum.as_ideal) ≤ I) :=
begin
  -- Let `Z` be a minimal set of prime ideals such that their product is contained in `J`.
  obtain ⟨Z₀, hZ₀⟩ := prime_spectrum.exists_prime_spectrum_prod_le_and_ne_bot_of_domain hNF hI0,
  obtain ⟨Z, ⟨hZI, hprodZ⟩, h_eraseZ⟩ := multiset.well_founded_lt.has_min
    (λ Z, (Z.map prime_spectrum.as_ideal).prod ≤ I ∧ (Z.map prime_spectrum.as_ideal).prod ≠ ⊥)
    ⟨Z₀, hZ₀⟩,
  have hZM : multiset.prod (Z.map prime_spectrum.as_ideal) ≤ M := le_trans hZI hIM,
  have hZ0 : Z ≠ 0, { rintro rfl, simpa [hM.ne_top] using hZM },
  obtain ⟨_, hPZ', hPM⟩ := (hM.is_prime.multiset_prod_le (mt multiset.map_eq_zero.mp hZ0)).mp hZM,
  -- Then in fact there is a `P ∈ Z` with `P ≤ M`.
  obtain ⟨P, hPZ, rfl⟩ := multiset.mem_map.mp hPZ',
  letI := classical.dec_eq (ideal A),
  have := multiset.map_erase prime_spectrum.as_ideal subtype.coe_injective P Z,
  obtain ⟨hP0, hZP0⟩ : P.as_ideal ≠ ⊥ ∧ ((Z.erase P).map prime_spectrum.as_ideal).prod ≠ ⊥,
  { rwa [ne.def, ← multiset.cons_erase hPZ', multiset.prod_cons, ideal.mul_eq_bot,
         not_or_distrib, ← this] at hprodZ },
  -- By maximality of `P` and `M`, we have that `P ≤ M` implies `P = M`.
  have hPM' := (is_dedekind_domain.dimension_le_one _ hP0 P.is_prime).eq_of_le hM.ne_top hPM,
  substI hPM',

  -- By minimality of `Z`, erasing `P` from `Z` is exactly what we need.
  refine ⟨Z.erase P, _, _⟩,
  { convert hZI,
    rw [this, multiset.cons_erase hPZ'] },
  { refine λ h, h_eraseZ (Z.erase P) ⟨h, _⟩ (multiset.erase_lt.mpr hPZ),
    exact hZP0 }
end

namespace fractional_ideal

open ideal

lemma exists_not_mem_one_of_ne_bot [is_dedekind_domain A]
  (hNF : ¬ is_field A) {I : ideal A} (hI0 : I ≠ ⊥) (hI1 : I ≠ ⊤) :
  ∃ x : K, x ∈ (I⁻¹ : fractional_ideal A⁰ K) ∧ x ∉ (1 : fractional_ideal A⁰ K) :=
begin
  -- WLOG, let `I` be maximal.
  suffices : ∀ {M : ideal A} (hM : M.is_maximal),
    ∃ x : K, x ∈ (M⁻¹ : fractional_ideal A⁰ K) ∧ x ∉ (1 : fractional_ideal A⁰ K),
  { obtain ⟨M, hM, hIM⟩ : ∃ (M : ideal A), is_maximal M ∧ I ≤ M := ideal.exists_le_maximal I hI1,
    resetI,
    have hM0 := (M.bot_lt_of_maximal hNF).ne',
    obtain ⟨x, hxM, hx1⟩ := this hM,
    refine ⟨x, inv_anti_mono _ _ ((coe_ideal_le_coe_ideal _).mpr hIM) hxM, hx1⟩;
      apply fractional_ideal.coe_ideal_ne_zero; assumption },

  -- Let `a` be a nonzero element of `M` and `J` the ideal generated by `a`.
  intros M hM,
  resetI,
  obtain ⟨⟨a, haM⟩, ha0⟩ := submodule.nonzero_mem_of_bot_lt (M.bot_lt_of_maximal hNF),
  replace ha0 : a ≠ 0 := subtype.coe_injective.ne ha0,
  let J : ideal A := ideal.span {a},
  have hJ0 : J ≠ ⊥ := mt ideal.span_singleton_eq_bot.mp ha0,
  have hJM : J ≤ M := ideal.span_le.mpr (set.singleton_subset_iff.mpr haM),
  have hM0 : ⊥ < M := M.bot_lt_of_maximal hNF,

  -- Then we can find a product of prime (hence maximal) ideals contained in `J`,
  -- such that removing element `M` from the product is not contained in `J`.
  obtain ⟨Z, hle, hnle⟩ := exists_multiset_prod_cons_le_and_prod_not_le hNF hJ0 hJM,
  -- Choose an element `b` of the product that is not in `J`.
  obtain ⟨b, hbZ, hbJ⟩ := set_like.not_le_iff_exists.mp hnle,
  have hnz_fa : algebra_map A K a ≠ 0 :=
    mt ((injective_iff_map_eq_zero _).mp (is_fraction_ring.injective A K) a) ha0,
  have hb0 : algebra_map A K b ≠ 0 :=
    mt ((injective_iff_map_eq_zero _).mp (is_fraction_ring.injective A K) b)
      (λ h, hbJ $ h.symm ▸ J.zero_mem),
  -- Then `b a⁻¹ : K` is in `M⁻¹` but not in `1`.
  refine ⟨algebra_map A K b * (algebra_map A K a)⁻¹, (mem_inv_iff _).mpr _, _⟩,
  { exact (fractional_ideal.coe_to_fractional_ideal_ne_zero le_rfl).mpr hM0.ne' },
  { rintro y₀ hy₀,
    obtain ⟨y, h_Iy, rfl⟩ := (fractional_ideal.mem_coe_ideal _).mp hy₀,
    rw [mul_comm, ← mul_assoc, ← ring_hom.map_mul],
    have h_yb : y * b ∈ J,
    { apply hle,
      rw multiset.prod_cons,
      exact submodule.smul_mem_smul h_Iy hbZ },
    rw ideal.mem_span_singleton' at h_yb,
    rcases h_yb with ⟨c, hc⟩,
    rw [← hc, ring_hom.map_mul, mul_assoc, mul_inv_cancel hnz_fa, mul_one],
    apply fractional_ideal.coe_mem_one },
  { refine mt (fractional_ideal.mem_one_iff _).mp _,
    rintros ⟨x', h₂_abs⟩,
    rw [← div_eq_mul_inv, eq_div_iff_mul_eq hnz_fa, ← ring_hom.map_mul] at h₂_abs,
    have := ideal.mem_span_singleton'.mpr ⟨x', is_fraction_ring.injective A K h₂_abs⟩,
    contradiction },
end

lemma one_mem_inv_coe_ideal {I : ideal A} (hI : I ≠ ⊥) :
  (1 : K) ∈ (I : fractional_ideal A⁰ K)⁻¹ :=
begin
  rw mem_inv_iff (fractional_ideal.coe_ideal_ne_zero hI),
  intros y hy,
  rw one_mul,
  exact coe_ideal_le_one hy,
  assumption
end

lemma mul_inv_cancel_of_le_one [h : is_dedekind_domain A]
  {I : ideal A} (hI0 : I ≠ ⊥) (hI : ((I * I⁻¹)⁻¹ : fractional_ideal A⁰ K) ≤ 1) :
  (I * I⁻¹ : fractional_ideal A⁰ K) = 1 :=
begin
  -- Handle a few trivial cases.
  by_cases hI1 : I = ⊤,
  { rw [hI1, coe_ideal_top, one_mul, fractional_ideal.inv_one] },
  by_cases hNF : is_field A,
  { letI := hNF.to_field, rcases hI1 (I.eq_bot_or_top.resolve_left hI0) },
  -- We'll show a contradiction with `exists_not_mem_one_of_ne_bot`:
  -- `J⁻¹ = (I * I⁻¹)⁻¹` cannot have an element `x ∉ 1`, so it must equal `1`.
  obtain ⟨J, hJ⟩ : ∃ (J : ideal A), (J : fractional_ideal A⁰ K) = I * I⁻¹ :=
    le_one_iff_exists_coe_ideal.mp mul_one_div_le_one,
  by_cases hJ0 : J = ⊥,
  { subst hJ0,
    refine absurd _ hI0,
    rw [eq_bot_iff, ← coe_ideal_le_coe_ideal K, hJ],
    exact coe_ideal_le_self_mul_inv K I,
    apply_instance },
  by_cases hJ1 : J = ⊤,
  { rw [← hJ, hJ1, coe_ideal_top] },
  obtain ⟨x, hx, hx1⟩ : ∃ (x : K),
    x ∈ (J : fractional_ideal A⁰ K)⁻¹ ∧ x ∉ (1 : fractional_ideal A⁰ K) :=
    exists_not_mem_one_of_ne_bot hNF hJ0 hJ1,
  contrapose! hx1 with h_abs,
  rw hJ at hx,
  exact hI hx,
end

/-- Nonzero integral ideals in a Dedekind domain are invertible.

We will use this to show that nonzero fractional ideals are invertible,
and finally conclude that fractional ideals in a Dedekind domain form a group with zero.
-/
lemma coe_ideal_mul_inv [h : is_dedekind_domain A] (I : ideal A) (hI0 : I ≠ ⊥) :
  (I * I⁻¹ : fractional_ideal A⁰ K) = 1 :=
begin
  -- We'll show `1 ≤ J⁻¹ = (I * I⁻¹)⁻¹ ≤ 1`.
  apply mul_inv_cancel_of_le_one hI0,
  by_cases hJ0 : (I * I⁻¹ : fractional_ideal A⁰ K) = 0,
  { rw [hJ0, inv_zero'], exact fractional_ideal.zero_le _ },
  intros x hx,
  -- In particular, we'll show all `x ∈ J⁻¹` are integral.
  suffices : x ∈ integral_closure A K,
  { rwa [is_integrally_closed.integral_closure_eq_bot, algebra.mem_bot, set.mem_range,
         ← fractional_ideal.mem_one_iff] at this;
      assumption },
  -- For that, we'll find a subalgebra that is f.g. as a module and contains `x`.
  -- `A` is a noetherian ring, so we just need to find a subalgebra between `{x}` and `I⁻¹`.
  rw mem_integral_closure_iff_mem_fg,
  have x_mul_mem : ∀ b ∈ (I⁻¹ : fractional_ideal A⁰ K), x * b ∈ (I⁻¹ : fractional_ideal A⁰ K),
  { intros b hb,
    rw mem_inv_iff at ⊢ hx,
    swap, { exact fractional_ideal.coe_ideal_ne_zero hI0 },
    swap, { exact hJ0 },
    simp only [mul_assoc, mul_comm b] at ⊢ hx,
    intros y hy,
    exact hx _ (fractional_ideal.mul_mem_mul hy hb) },
  -- It turns out the subalgebra consisting of all `p(x)` for `p : polynomial A` works.
  refine ⟨alg_hom.range (polynomial.aeval x : A[X] →ₐ[A] K),
          is_noetherian_submodule.mp (fractional_ideal.is_noetherian I⁻¹) _ (λ y hy, _),
          ⟨polynomial.X, polynomial.aeval_X x⟩⟩,
  obtain ⟨p, rfl⟩ := (alg_hom.mem_range _).mp hy,
  rw polynomial.aeval_eq_sum_range,
  refine submodule.sum_mem _ (λ i hi, submodule.smul_mem _ _ _),
  clear hi,
  induction i with i ih,
  { rw pow_zero, exact one_mem_inv_coe_ideal hI0 },
  { show x ^ i.succ ∈ (I⁻¹ : fractional_ideal A⁰ K),
    rw pow_succ, exact x_mul_mem _ ih },
end

/-- Nonzero fractional ideals in a Dedekind domain are units.

This is also available as `_root_.mul_inv_cancel`, using the
`comm_group_with_zero` instance defined below.
-/
protected theorem mul_inv_cancel [is_dedekind_domain A]
  {I : fractional_ideal A⁰ K} (hne : I ≠ 0) : I * I⁻¹ = 1 :=
begin
  obtain ⟨a, J, ha, hJ⟩ :
    ∃ (a : A) (aI : ideal A), a ≠ 0 ∧ I = span_singleton A⁰ (algebra_map _ _ a)⁻¹ * aI :=
    exists_eq_span_singleton_mul I,
  suffices h₂ : I * (span_singleton A⁰ (algebra_map _ _ a) * J⁻¹) = 1,
  { rw mul_inv_cancel_iff,
    exact ⟨span_singleton A⁰ (algebra_map _ _ a) * J⁻¹, h₂⟩ },
  subst hJ,
  rw [mul_assoc, mul_left_comm (J : fractional_ideal A⁰ K), coe_ideal_mul_inv, mul_one,
      fractional_ideal.span_singleton_mul_span_singleton, inv_mul_cancel,
      fractional_ideal.span_singleton_one],
  { exact mt ((injective_iff_map_eq_zero (algebra_map A K)).mp
      (is_fraction_ring.injective A K) _) ha },
  { exact fractional_ideal.coe_ideal_ne_zero_iff.mp (right_ne_zero_of_mul hne) }
end

lemma mul_right_le_iff [is_dedekind_domain A] {J : fractional_ideal A⁰ K}
  (hJ : J ≠ 0) : ∀ {I I'}, I * J ≤ I' * J ↔ I ≤ I' :=
begin
  intros I I',
  split,
  { intros h, convert mul_right_mono J⁻¹ h;
      rw [mul_assoc, fractional_ideal.mul_inv_cancel hJ, mul_one] },
  { exact λ h, mul_right_mono J h }
end

lemma mul_left_le_iff [is_dedekind_domain A] {J : fractional_ideal A⁰ K}
  (hJ : J ≠ 0) {I I'} : J * I ≤ J * I' ↔ I ≤ I' :=
by convert fractional_ideal.mul_right_le_iff hJ using 1; simp only [mul_comm]

lemma mul_right_strict_mono [is_dedekind_domain A] {I : fractional_ideal A⁰ K}
  (hI : I ≠ 0) : strict_mono (* I) :=
strict_mono_of_le_iff_le (λ _ _, (mul_right_le_iff hI).symm)

lemma mul_left_strict_mono [is_dedekind_domain A] {I : fractional_ideal A⁰ K}
  (hI : I ≠ 0) : strict_mono ((*) I) :=
strict_mono_of_le_iff_le (λ _ _, (mul_left_le_iff hI).symm)

/--
This is also available as `_root_.div_eq_mul_inv`, using the
`comm_group_with_zero` instance defined below.
-/
protected lemma div_eq_mul_inv [is_dedekind_domain A] (I J : fractional_ideal A⁰ K) :
  I / J = I * J⁻¹ :=
begin
  by_cases hJ : J = 0,
  { rw [hJ, div_zero, inv_zero', mul_zero] },
  refine le_antisymm ((mul_right_le_iff hJ).mp _) ((le_div_iff_mul_le hJ).mpr _),
  { rw [mul_assoc, mul_comm J⁻¹, fractional_ideal.mul_inv_cancel hJ, mul_one, mul_le],
    intros x hx y hy,
    rw [mem_div_iff_of_nonzero hJ] at hx,
    exact hx y hy },
  rw [mul_assoc, mul_comm J⁻¹, fractional_ideal.mul_inv_cancel hJ, mul_one],
  exact le_refl I
end

end fractional_ideal

/-- `is_dedekind_domain` and `is_dedekind_domain_inv` are equivalent ways
to express that an integral domain is a Dedekind domain. -/
theorem is_dedekind_domain_iff_is_dedekind_domain_inv :
  is_dedekind_domain A ↔ is_dedekind_domain_inv A :=
⟨λ h I hI, by exactI fractional_ideal.mul_inv_cancel hI, λ h, h.is_dedekind_domain⟩

end inverse

section is_dedekind_domain

variables {R A} [is_dedekind_domain A] [algebra A K] [is_fraction_ring A K]

open fractional_ideal
open ideal

noncomputable instance fractional_ideal.comm_group_with_zero :
  comm_group_with_zero (fractional_ideal A⁰ K) :=
{ inv := λ I, I⁻¹,
  inv_zero := inv_zero' _,
  div := (/),
  div_eq_mul_inv := fractional_ideal.div_eq_mul_inv,
  exists_pair_ne := ⟨0, 1, (coe_to_fractional_ideal_injective le_rfl).ne
    (by simpa using @zero_ne_one (ideal A) _ _)⟩,
  mul_inv_cancel := λ I, fractional_ideal.mul_inv_cancel,
  .. fractional_ideal.comm_semiring }

noncomputable instance ideal.cancel_comm_monoid_with_zero :
  cancel_comm_monoid_with_zero (ideal A) :=
function.injective.cancel_comm_monoid_with_zero (coe_ideal_hom A⁰ (fraction_ring A))
  coe_ideal_injective (ring_hom.map_zero _) (ring_hom.map_one _) (ring_hom.map_mul _)
  (ring_hom.map_pow _)

/-- For ideals in a Dedekind domain, to divide is to contain. -/
lemma ideal.dvd_iff_le {I J : ideal A} : (I ∣ J) ↔ J ≤ I :=
⟨ideal.le_of_dvd,
  λ h, begin
    by_cases hI : I = ⊥,
    { have hJ : J = ⊥, { rwa [hI, ← eq_bot_iff] at h },
      rw [hI, hJ] },
    have hI' : (I : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
      (fractional_ideal.coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr hI,
    have : (I : fractional_ideal A⁰ (fraction_ring A))⁻¹ * J ≤ 1 := le_trans
      (fractional_ideal.mul_left_mono (↑I)⁻¹ ((coe_ideal_le_coe_ideal _).mpr h))
      (le_of_eq (inv_mul_cancel hI')),
    obtain ⟨H, hH⟩ := fractional_ideal.le_one_iff_exists_coe_ideal.mp this,
    use H,
    refine coe_to_fractional_ideal_injective (le_refl (non_zero_divisors A))
      (show (J : fractional_ideal A⁰ (fraction_ring A)) = _, from _),
    rw [fractional_ideal.coe_ideal_mul, hH, ← mul_assoc, mul_inv_cancel hI', one_mul]
end⟩

lemma ideal.dvd_not_unit_iff_lt {I J : ideal A} :
  dvd_not_unit I J ↔ J < I :=
⟨λ ⟨hI, H, hunit, hmul⟩, lt_of_le_of_ne (ideal.dvd_iff_le.mp ⟨H, hmul⟩)
   (mt (λ h, have H = 1, from mul_left_cancel₀ hI (by rw [← hmul, h, mul_one]),
   show is_unit H, from this.symm ▸ is_unit_one) hunit),
 λ h, dvd_not_unit_of_dvd_of_not_dvd (ideal.dvd_iff_le.mpr (le_of_lt h))
   (mt ideal.dvd_iff_le.mp (not_le_of_lt h))⟩

instance : wf_dvd_monoid (ideal A) :=
{ well_founded_dvd_not_unit :=
  have well_founded ((>) : ideal A → ideal A → Prop) :=
  is_noetherian_iff_well_founded.mp
    (is_noetherian_ring_iff.mp is_dedekind_domain.is_noetherian_ring),
  by { convert this, ext, rw ideal.dvd_not_unit_iff_lt } }

instance ideal.unique_factorization_monoid :
  unique_factorization_monoid (ideal A) :=
{ irreducible_iff_prime := λ P,
  ⟨λ hirr, ⟨hirr.ne_zero, hirr.not_unit, λ I J, begin
    have : P.is_maximal,
    { refine ⟨⟨mt ideal.is_unit_iff.mpr hirr.not_unit, _⟩⟩,
      intros J hJ,
      obtain ⟨J_ne, H, hunit, P_eq⟩ := ideal.dvd_not_unit_iff_lt.mpr hJ,
      exact ideal.is_unit_iff.mp ((hirr.is_unit_or_is_unit P_eq).resolve_right hunit) },
    rw [ideal.dvd_iff_le, ideal.dvd_iff_le, ideal.dvd_iff_le,
        set_like.le_def, set_like.le_def, set_like.le_def],
    contrapose!,
    rintros ⟨⟨x, x_mem, x_not_mem⟩, ⟨y, y_mem, y_not_mem⟩⟩,
    exact ⟨x * y, ideal.mul_mem_mul x_mem y_mem,
           mt this.is_prime.mem_or_mem (not_or x_not_mem y_not_mem)⟩,
   end⟩,
   prime.irreducible⟩,
  .. ideal.wf_dvd_monoid }

noncomputable instance ideal.normalization_monoid : normalization_monoid (ideal A) :=
normalization_monoid_of_unique_units

@[simp] lemma ideal.dvd_span_singleton {I : ideal A} {x : A} :
  I ∣ ideal.span {x} ↔ x ∈ I :=
ideal.dvd_iff_le.trans (ideal.span_le.trans set.singleton_subset_iff)

lemma ideal.is_prime_of_prime {P : ideal A} (h : prime P) : is_prime P :=
begin
  refine ⟨_, λ x y hxy, _⟩,
  { unfreezingI { rintro rfl },
    rw ← ideal.one_eq_top at h,
    exact h.not_unit is_unit_one },
  { simp only [← ideal.dvd_span_singleton, ← ideal.span_singleton_mul_span_singleton] at ⊢ hxy,
    exact h.dvd_or_dvd hxy }
end

theorem ideal.prime_of_is_prime {P : ideal A} (hP : P ≠ ⊥) (h : is_prime P) : prime P :=
begin
  refine ⟨hP, mt ideal.is_unit_iff.mp h.ne_top, λ I J hIJ, _⟩,
  simpa only [ideal.dvd_iff_le] using (h.mul_le.mp (ideal.le_of_dvd hIJ)),
end

/-- In a Dedekind domain, the (nonzero) prime elements of the monoid with zero `ideal A`
are exactly the prime ideals. -/
theorem ideal.prime_iff_is_prime {P : ideal A} (hP : P ≠ ⊥) :
  prime P ↔ is_prime P :=
⟨ideal.is_prime_of_prime, ideal.prime_of_is_prime hP⟩

/-- In a Dedekind domain, the the prime ideals are the zero ideal together with the prime elements
of the monoid with zero `ideal A`. -/
theorem ideal.is_prime_iff_bot_or_prime {P : ideal A} :
  is_prime P ↔ P = ⊥ ∨ prime P :=
⟨λ hp, (eq_or_ne P ⊥).imp_right $ λ hp0, (ideal.prime_of_is_prime hp0 hp),
 λ hp, hp.elim (λ h, h.symm ▸ ideal.bot_prime) ideal.is_prime_of_prime⟩

lemma ideal.strict_anti_pow (I : ideal A) (hI0 : I ≠ ⊥) (hI1 : I ≠ ⊤) :
  strict_anti ((^) I : ℕ → ideal A) :=
strict_anti_nat_of_succ_lt $ λ e, ideal.dvd_not_unit_iff_lt.mp
  ⟨pow_ne_zero _ hI0, I, mt is_unit_iff.mp hI1, pow_succ' I e⟩

lemma ideal.pow_lt_self (I : ideal A) (hI0 : I ≠ ⊥) (hI1 : I ≠ ⊤) (e : ℕ) (he : 2 ≤ e) : I^e < I :=
by convert I.strict_anti_pow hI0 hI1 he; rw pow_one

lemma ideal.exists_mem_pow_not_mem_pow_succ (I : ideal A) (hI0 : I ≠ ⊥) (hI1 : I ≠ ⊤) (e : ℕ) :
  ∃ x ∈ I^e, x ∉ I^(e+1) :=
set_like.exists_of_lt (I.strict_anti_pow hI0 hI1 e.lt_succ_self)

lemma associates.le_singleton_iff (x : A) (n : ℕ) (I : ideal A) :
  associates.mk I^n ≤ associates.mk (ideal.span {x}) ↔ x ∈ I^n :=
begin
  rw [← associates.dvd_eq_le, ← associates.mk_pow, associates.mk_dvd_mk, ideal.dvd_span_singleton],
end

open fractional_ideal
variables {A K}

/-- Strengthening of `is_localization.exist_integer_multiples`:
Let `J ≠ ⊤` be an ideal in a Dedekind domain `A`, and `f ≠ 0` a finite collection
of elements of `K = Frac(A)`, then we can multiply the elements of `f` by some `a : K`
to find a collection of elements of `A` that is not completely contained in `J`. -/
lemma ideal.exist_integer_multiples_not_mem
  {J : ideal A} (hJ : J ≠ ⊤) {ι : Type*} (s : finset ι) (f : ι → K)
  {j} (hjs : j ∈ s) (hjf : f j ≠ 0) :
  ∃ a : K, (∀ i ∈ s, is_localization.is_integer A (a * f i)) ∧
    ∃ i ∈ s, (a * f i) ∉ (J : fractional_ideal A⁰ K) :=
begin
  -- Consider the fractional ideal `I` spanned by the `f`s.
  let I : fractional_ideal A⁰ K := fractional_ideal.span_finset A s f,
  have hI0 : I ≠ 0 := fractional_ideal.span_finset_ne_zero.mpr ⟨j, hjs, hjf⟩,
  -- We claim the multiplier `a` we're looking for is in `I⁻¹ \ (J / I)`.
  suffices : ↑J / I < I⁻¹,
  { obtain ⟨_, a, hI, hpI⟩ := set_like.lt_iff_le_and_exists.mp this,
    rw mem_inv_iff hI0 at hI,
    refine ⟨a, λ i hi, _, _⟩,
    -- By definition, `a ∈ I⁻¹` multiplies elements of `I` into elements of `1`,
    -- in other words, `a * f i` is an integer.
    { exact (mem_one_iff _).mp (hI (f i)
        (submodule.subset_span (set.mem_image_of_mem f hi))) },
    { contrapose! hpI,
      -- And if all `a`-multiples of `I` are an element of `J`,
      -- then `a` is actually an element of `J / I`, contradiction.
      refine (mem_div_iff_of_nonzero hI0).mpr (λ y hy, submodule.span_induction hy _ _ _ _),
      { rintros _ ⟨i, hi, rfl⟩, exact hpI i hi },
      { rw mul_zero, exact submodule.zero_mem _ },
      { intros x y hx hy, rw mul_add, exact submodule.add_mem _ hx hy },
      { intros b x hx, rw mul_smul_comm, exact submodule.smul_mem _ b hx } } },
  -- To show the inclusion of `J / I` into `I⁻¹ = 1 / I`, note that `J < I`.
  calc ↑J / I = ↑J * I⁻¹ : div_eq_mul_inv ↑J I
          ... < 1 * I⁻¹ : mul_right_strict_mono (inv_ne_zero hI0) _
          ... = I⁻¹ : one_mul _,
  { rw [← coe_ideal_top],
    -- And multiplying by `I⁻¹` is indeed strictly monotone.
    exact strict_mono_of_le_iff_le (λ _ _, (coe_ideal_le_coe_ideal K).symm)
      (lt_top_iff_ne_top.mpr hJ) },
end

end is_dedekind_domain

section is_dedekind_domain

variables {T : Type*} [comm_ring T] [is_domain T] [is_dedekind_domain T] {I J : ideal T}
open_locale classical
open multiset unique_factorization_monoid ideal

lemma prod_normalized_factors_eq_self (hI : I ≠ ⊥) : (normalized_factors I).prod = I :=
associated_iff_eq.1 (normalized_factors_prod hI)

lemma normalized_factors_prod {α : multiset (ideal T)}
  (h : ∀ p ∈ α, prime p) : normalized_factors α.prod = α :=
by { simp_rw [← multiset.rel_eq, ← associated_eq_eq],
     exact prime_factors_unique (prime_of_normalized_factor) h
      (normalized_factors_prod (α.prod_ne_zero_of_prime h)) }

lemma count_le_of_ideal_ge {I J : ideal T} (h : I ≤ J) (hI : I ≠ ⊥) (K : ideal T) :
  count K (normalized_factors J) ≤ count K (normalized_factors I) :=
le_iff_count.1 ((dvd_iff_normalized_factors_le_normalized_factors (ne_bot_of_le_ne_bot hI h) hI).1
  (dvd_iff_le.2 h)) _

lemma sup_eq_prod_inf_factors (hI : I ≠ ⊥) (hJ : J ≠ ⊥) :
  I ⊔ J = (normalized_factors I ∩ normalized_factors J).prod :=
begin
  have H : normalized_factors (normalized_factors I ∩ normalized_factors J).prod =
    normalized_factors I ∩ normalized_factors J,
  { apply _root_.normalized_factors_prod,
    intros p hp,
    rw mem_inter at hp,
    exact prime_of_normalized_factor p hp.left },
  have := (multiset.prod_ne_zero_of_prime (normalized_factors I ∩ normalized_factors J)
      (λ _ h, prime_of_normalized_factor _ (multiset.mem_inter.1 h).1)),
  apply le_antisymm,
  { rw [sup_le_iff, ← dvd_iff_le, ← dvd_iff_le],
    split,
    { rw [dvd_iff_normalized_factors_le_normalized_factors this hI, H],
      exact inf_le_left },
    { rw [dvd_iff_normalized_factors_le_normalized_factors this hJ, H],
      exact inf_le_right } },
  { rw [← dvd_iff_le, dvd_iff_normalized_factors_le_normalized_factors,
      _root_.normalized_factors_prod, le_iff_count],
    { intro a,
      rw multiset.count_inter,
      exact le_min (count_le_of_ideal_ge le_sup_left hI a)
        (count_le_of_ideal_ge le_sup_right hJ a) },
    { intros p hp,
      rw mem_inter at hp,
      exact prime_of_normalized_factor p hp.left },
    { exact ne_bot_of_le_ne_bot hI le_sup_left },
    { exact this } },
end

lemma irreducible_pow_sup (hI : I ≠ ⊥) (hJ : irreducible J) (n : ℕ) :
  J^n ⊔ I = J^(min ((normalized_factors I).count J) n) :=
by rw [sup_eq_prod_inf_factors (pow_ne_zero n hJ.ne_zero) hI, ← inf_eq_inter,
       normalized_factors_of_irreducible_pow hJ, normalize_eq J, repeat_inf, prod_repeat]

lemma irreducible_pow_sup_of_le (hJ : irreducible J) (n : ℕ)
  (hn : ↑n ≤ multiplicity J I) : J^n ⊔ I = J^n :=
begin
  by_cases hI : I = ⊥,
  { simp [*] at *, },
  rw [irreducible_pow_sup hI hJ, min_eq_right],
  rwa [multiplicity_eq_count_normalized_factors hJ hI, enat.coe_le_coe, normalize_eq J] at hn
end

lemma irreducible_pow_sup_of_ge (hI : I ≠ ⊥) (hJ : irreducible J) (n : ℕ)
  (hn : multiplicity J I ≤ n) : J^n ⊔ I = J ^ (multiplicity J I).get (enat.dom_of_le_coe hn) :=
begin
  rw [irreducible_pow_sup hI hJ, min_eq_left],
  congr,
  { rw [← enat.coe_inj, enat.coe_get, multiplicity_eq_count_normalized_factors hJ hI,
    normalize_eq J] },
  { rwa [multiplicity_eq_count_normalized_factors hJ hI, enat.coe_le_coe, normalize_eq J]
      at hn }
end

end is_dedekind_domain

section height_one_spectrum

/-!
### Height one spectrum of a Dedekind domain
If `R` is a Dedekind domain of Krull dimension 1, the maximal ideals of `R` are exactly its nonzero
prime ideals.
We define `height_one_spectrum` and provide lemmas to recover the facts that prime ideals of height
one are prime and irreducible. -/

namespace is_dedekind_domain

variables [is_domain R] [is_dedekind_domain R]

/-- The height one prime spectrum of a Dedekind domain `R` is the type of nonzero prime ideals of
`R`. Note that this equals the maximal spectrum if `R` has Krull dimension 1. -/
@[ext, nolint has_inhabited_instance unused_arguments]
structure height_one_spectrum :=
(as_ideal : ideal R)
(is_prime : as_ideal.is_prime)
(ne_bot   : as_ideal ≠ ⊥)

variables (v : height_one_spectrum R) {R}

lemma height_one_spectrum.prime (v : height_one_spectrum R) : prime v.as_ideal :=
ideal.prime_of_is_prime v.ne_bot v.is_prime

lemma height_one_spectrum.irreducible (v : height_one_spectrum R) :
  irreducible v.as_ideal :=
begin
  rw [unique_factorization_monoid.irreducible_iff_prime],
  apply v.prime,
end

lemma height_one_spectrum.associates_irreducible (v : height_one_spectrum R) :
  irreducible (associates.mk v.as_ideal) :=
begin
  rw [associates.irreducible_mk _],
  apply v.irreducible,
end

end is_dedekind_domain

end height_one_spectrum

section

open ideal

variables {R} {A} [is_dedekind_domain A] {I : ideal R} {J : ideal A}

/-- The map from ideals of `R` dividing `I` to the ideals of `A` dividing `J` induced by
  a homomorphism `f : R/I →+* A/J` -/
@[simps]
def ideal_factors_fun_of_quot_hom {f : R ⧸ I →+* A ⧸ J} (hf : function.surjective f ) :
  {p : ideal R | p ∣ I} →o {p : ideal A | p ∣ J} :=
{ to_fun := λ X, ⟨comap J^.quotient.mk (map f (map I^.quotient.mk X)),
    begin
      have : (J^.quotient.mk).ker ≤ comap J^.quotient.mk (map f (map I^.quotient.mk X)),
      { exact ker_le_comap J^.quotient.mk },
      rw mk_ker at this,
      exact dvd_iff_le.mpr this,
    end ⟩,
  monotone' :=
    begin
      rintros ⟨X, hX⟩ ⟨Y, hY⟩ h,
      rw [← subtype.coe_le_coe, subtype.coe_mk, subtype.coe_mk] at h ⊢,
      rw [subtype.coe_mk, comap_le_comap_iff_of_surjective J^.quotient.mk quotient.mk_surjective,
        map_le_iff_le_comap, subtype.coe_mk, comap_map_of_surjective _ hf (map I^.quotient.mk Y)],
      suffices : map I^.quotient.mk X ≤ map I^.quotient.mk Y,
      { exact le_sup_of_le_left this },
      rwa [map_le_iff_le_comap, comap_map_of_surjective I^.quotient.mk quotient.mk_surjective,
        ← ring_hom.ker_eq_comap_bot, mk_ker, sup_eq_left.mpr $ le_of_dvd hY],
    end }

@[simp]
lemma ideal_factors_fun_of_quot_hom_id :
  ideal_factors_fun_of_quot_hom  (ring_hom.id (A ⧸ J)).is_surjective = order_hom.id :=
order_hom.ext _ _ (funext $ λ X, by simp only [ideal_factors_fun_of_quot_hom, map_id,
  order_hom.coe_fun_mk, order_hom.id_coe, id.def, comap_map_of_surjective J^.quotient.mk
  quotient.mk_surjective, ← ring_hom.ker_eq_comap_bot J^.quotient.mk, mk_ker, sup_eq_left.mpr
  (dvd_iff_le.mp X.prop), subtype.coe_eta] )

variables {B : Type*} [comm_ring B] [is_domain B] [is_dedekind_domain B] {L : ideal B}

lemma ideal_factors_fun_of_quot_hom_comp {f : R ⧸ I →+* A ⧸ J}  {g : A ⧸ J →+* B ⧸ L}
  (hf : function.surjective f) (hg : function.surjective g) :
  (ideal_factors_fun_of_quot_hom hg).comp (ideal_factors_fun_of_quot_hom hf)
    = ideal_factors_fun_of_quot_hom (show function.surjective (g.comp f), from hg.comp hf) :=
begin
  refine order_hom.ext _ _ (funext $ λ x, _),
  rw [ideal_factors_fun_of_quot_hom, ideal_factors_fun_of_quot_hom, order_hom.comp_coe,
    order_hom.coe_fun_mk, order_hom.coe_fun_mk, function.comp_app,
    ideal_factors_fun_of_quot_hom,  order_hom.coe_fun_mk, subtype.mk_eq_mk, subtype.coe_mk,
    map_comap_of_surjective J^.quotient.mk quotient.mk_surjective, map_map],
end

variables [is_domain R] [is_dedekind_domain R]

/-- The bijection between ideals of `R` dividing `I` and the ideals of `A` dividing `J` induced by
  an isomorphism `f : R/I ≅ A/J`. -/
@[simps]
def ideal_factors_equiv_of_quot_equiv (f : R ⧸ I ≃+* A ⧸ J) :
  {p : ideal R | p ∣ I} ≃o {p : ideal A | p ∣ J} :=
order_iso.of_hom_inv
  (ideal_factors_fun_of_quot_hom (show function.surjective
    (f : R ⧸I →+* A ⧸ J), from f.surjective))
    (ideal_factors_fun_of_quot_hom (show function.surjective
    (f.symm : A ⧸J →+* R ⧸ I), from f.symm.surjective))
  (by simp only [← ideal_factors_fun_of_quot_hom_id, order_hom.coe_eq, order_hom.coe_eq,
    ideal_factors_fun_of_quot_hom_comp, ← ring_equiv.to_ring_hom_eq_coe,
    ← ring_equiv.to_ring_hom_eq_coe, ← ring_equiv.to_ring_hom_trans, ring_equiv.symm_trans_self,
    ring_equiv.to_ring_hom_refl])
  (by simp only [← ideal_factors_fun_of_quot_hom_id, order_hom.coe_eq, order_hom.coe_eq,
    ideal_factors_fun_of_quot_hom_comp, ← ring_equiv.to_ring_hom_eq_coe,
    ← ring_equiv.to_ring_hom_eq_coe, ← ring_equiv.to_ring_hom_trans, ring_equiv.self_trans_symm,
    ring_equiv.to_ring_hom_refl])

end

section chinese_remainder

open ideal unique_factorization_monoid
open_locale big_operators

variables {R}

lemma ring.dimension_le_one.prime_le_prime_iff_eq (h : ring.dimension_le_one R)
  {P Q : ideal R} [hP : P.is_prime] [hQ : Q.is_prime] (hP0 : P ≠ ⊥) :
  P ≤ Q ↔ P = Q :=
⟨(h P hP0 hP).eq_of_le hQ.ne_top, eq.le⟩

lemma ideal.coprime_of_no_prime_ge {I J : ideal R} (h : ∀ P, I ≤ P → J ≤ P → ¬ is_prime P) :
  I ⊔ J = ⊤ :=
begin
  by_contra hIJ,
  obtain ⟨P, hP, hIJ⟩ := ideal.exists_le_maximal _ hIJ,
  exact h P (le_trans le_sup_left hIJ) (le_trans le_sup_right hIJ) hP.is_prime
end

section dedekind_domain

variables {R} [is_domain R] [is_dedekind_domain R]

lemma ideal.is_prime.mul_mem_pow (I : ideal R) [hI : I.is_prime] {a b : R} {n : ℕ}
  (h : a * b ∈ I^n) : a ∈ I ∨ b ∈ I^n :=
begin
  cases n, { simp },
  by_cases hI0 : I = ⊥, { simpa [pow_succ, hI0] using h },
  simp only [← submodule.span_singleton_le_iff_mem, ideal.submodule_span_eq, ← ideal.dvd_iff_le,
    ← ideal.span_singleton_mul_span_singleton] at h ⊢,
  by_cases ha : I ∣ span {a},
  { exact or.inl ha },
  rw mul_comm at h,
  exact or.inr (prime.pow_dvd_of_dvd_mul_right ((ideal.prime_iff_is_prime hI0).mpr hI) _ ha h),
end

section

open_locale classical

lemma ideal.count_normalized_factors_eq {p x : ideal R} [hp : p.is_prime] {n : ℕ}
  (hle : x ≤ p^n) (hlt : ¬ (x ≤ p^(n+1))) :
  (normalized_factors x).count p = n :=
count_normalized_factors_eq'
  ((ideal.is_prime_iff_bot_or_prime.mp hp).imp_right prime.irreducible)
  (by { haveI : unique (ideal R)ˣ := ideal.unique_units, apply normalize_eq })
  (by convert ideal.dvd_iff_le.mpr hle) (by convert mt ideal.le_of_dvd hlt)
/- Warning: even though a pure term-mode proof typechecks (the `by convert` can simply be
  removed), it's slower to the point of a possible timeout. -/

end

lemma ideal.le_mul_of_no_prime_factors
  {I J K : ideal R} (coprime : ∀ P, J ≤ P → K ≤ P → ¬ is_prime P) (hJ : I ≤ J) (hK : I ≤ K) :
  I ≤ J * K :=
begin
  simp only [← ideal.dvd_iff_le] at coprime hJ hK ⊢,
  by_cases hJ0 : J = 0,
  { simpa only [hJ0, zero_mul] using hJ },
  obtain ⟨I', rfl⟩ := hK,
  rw mul_comm,
  exact mul_dvd_mul_left K
    (unique_factorization_monoid.dvd_of_dvd_mul_right_of_no_prime_factors hJ0
      (λ P hPJ hPK, mt ideal.is_prime_of_prime (coprime P hPJ hPK))
      hJ)
end

lemma ideal.le_of_pow_le_prime {I P : ideal R} [hP : P.is_prime] {n : ℕ} (h : I^n ≤ P) : I ≤ P :=
begin
  by_cases hP0 : P = ⊥,
  { simp only [hP0, le_bot_iff] at ⊢ h,
    exact pow_eq_zero h },
  rw ← ideal.dvd_iff_le at ⊢ h,
  exact ((ideal.prime_iff_is_prime hP0).mpr hP).dvd_of_dvd_pow h
end

lemma ideal.pow_le_prime_iff {I P : ideal R} [hP : P.is_prime] {n : ℕ} (hn : n ≠ 0) :
  I^n ≤ P ↔ I ≤ P :=
⟨ideal.le_of_pow_le_prime, λ h, trans (ideal.pow_le_self hn) h⟩

lemma ideal.prod_le_prime {ι : Type*} {s : finset ι} {f : ι → ideal R} {P : ideal R}
  [hP : P.is_prime] :
  ∏ i in s, f i ≤ P ↔ ∃ i ∈ s, f i ≤ P :=
begin
  by_cases hP0 : P = ⊥,
  { simp only [hP0, le_bot_iff],
    rw [← ideal.zero_eq_bot, finset.prod_eq_zero_iff] },
  simp only [← ideal.dvd_iff_le],
  exact ((ideal.prime_iff_is_prime hP0).mpr hP).dvd_finset_prod_iff _
end

/-- The intersection of distinct prime powers in a Dedekind domain is the product of these
prime powers. -/
lemma is_dedekind_domain.inf_prime_pow_eq_prod {ι : Type*}
  (s : finset ι) (f : ι → ideal R) (e : ι → ℕ)
  (prime : ∀ i ∈ s, prime (f i)) (coprime : ∀ i j ∈ s, i ≠ j → f i ≠ f j) :
  s.inf (λ i, f i ^ e i) = ∏ i in s, f i ^ e i :=
begin
  letI := classical.dec_eq ι,
  revert prime coprime,
  refine s.induction _ _,
  { simp },
  intros a s ha ih prime coprime,
  specialize ih (λ i hi, prime i (finset.mem_insert_of_mem hi))
    (λ i hi j hj, coprime i (finset.mem_insert_of_mem hi) j (finset.mem_insert_of_mem hj)),
  rw [finset.inf_insert, finset.prod_insert ha, ih],
  refine le_antisymm (ideal.le_mul_of_no_prime_factors _ inf_le_left inf_le_right) ideal.mul_le_inf,
  intros P hPa hPs hPp,
  haveI := hPp,
  obtain ⟨b, hb, hPb⟩ := ideal.prod_le_prime.mp hPs,
  haveI := ideal.is_prime_of_prime (prime a (finset.mem_insert_self a s)),
  haveI := ideal.is_prime_of_prime (prime b (finset.mem_insert_of_mem hb)),
  refine coprime a (finset.mem_insert_self a s) b (finset.mem_insert_of_mem hb) _
    (((is_dedekind_domain.dimension_le_one.prime_le_prime_iff_eq _).mp
        (ideal.le_of_pow_le_prime hPa)).trans
      ((is_dedekind_domain.dimension_le_one.prime_le_prime_iff_eq _).mp
        (ideal.le_of_pow_le_prime hPb)).symm),
  { unfreezingI { rintro rfl }, contradiction },
  { exact (prime a (finset.mem_insert_self a s)).ne_zero },
  { exact (prime b (finset.mem_insert_of_mem hb)).ne_zero },
end

/-- **Chinese remainder theorem** for a Dedekind domain: if the ideal `I` factors as
`∏ i, P i ^ e i`, then `R ⧸ I` factors as `Π i, R ⧸ (P i ^ e i)`. -/
noncomputable def is_dedekind_domain.quotient_equiv_pi_of_prod_eq {ι : Type*} [fintype ι]
  (I : ideal R) (P : ι → ideal R) (e : ι → ℕ)
  (prime : ∀ i, prime (P i)) (coprime : ∀ i j, i ≠ j → P i ≠ P j) (prod_eq : (∏ i, P i ^ e i) = I) :
  R ⧸ I ≃+* Π i, R ⧸ (P i ^ e i) :=
(ideal.quot_equiv_of_eq (by { simp only [← prod_eq, finset.inf_eq_infi, finset.mem_univ, cinfi_pos,
  ← is_dedekind_domain.inf_prime_pow_eq_prod _ _ _ (λ i _, prime i) (λ i _ j _, coprime i j)] }))
    .trans $
ideal.quotient_inf_ring_equiv_pi_quotient _ (λ i j hij, ideal.coprime_of_no_prime_ge (begin
  intros P hPi hPj hPp,
  haveI := hPp,
  haveI := ideal.is_prime_of_prime (prime i), haveI := ideal.is_prime_of_prime (prime j),
  exact coprime i j hij
    (((is_dedekind_domain.dimension_le_one.prime_le_prime_iff_eq (prime i).ne_zero).mp
      (ideal.le_of_pow_le_prime hPi)).trans
    ((is_dedekind_domain.dimension_le_one.prime_le_prime_iff_eq (prime j).ne_zero).mp
     (ideal.le_of_pow_le_prime hPj)).symm)
end))

open_locale classical

/-- **Chinese remainder theorem** for a Dedekind domain: `R ⧸ I` factors as `Π i, R ⧸ (P i ^ e i)`,
where `P i` ranges over the prime factors of `I` and `e i` over the multiplicities. -/
noncomputable def is_dedekind_domain.quotient_equiv_pi_factors {I : ideal R} (hI : I ≠ ⊥) :
  R ⧸ I ≃+* Π (P : (factors I).to_finset), R ⧸ ((P : ideal R) ^ (factors I).count P) :=
is_dedekind_domain.quotient_equiv_pi_of_prod_eq _ _ _
  (λ (P : (factors I).to_finset), prime_of_factor _ (multiset.mem_to_finset.mp P.prop))
  (λ i j hij, subtype.coe_injective.ne hij)
  (calc ∏ (P : (factors I).to_finset), (P : ideal R) ^ (factors I).count (P : ideal R)
      = ∏ P in (factors I).to_finset, P ^ (factors I).count P
    : (factors I).to_finset.prod_coe_sort (λ P, P ^ (factors I).count P)
  ... = ((factors I).map (λ P, P)).prod : (finset.prod_multiset_map_count (factors I) id).symm
  ... = (factors I).prod : by rw multiset.map_id'
  ... = I : (@associated_iff_eq (ideal R) _ ideal.unique_units _ _).mp (factors_prod hI))

@[simp] lemma is_dedekind_domain.quotient_equiv_pi_factors_mk {I : ideal R} (hI : I ≠ ⊥)
  (x : R) : is_dedekind_domain.quotient_equiv_pi_factors hI (ideal.quotient.mk I x) =
    λ P, ideal.quotient.mk _ x :=
rfl

end dedekind_domain

end chinese_remainder


variables (α : Type) (p q : α → Prop)

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  match h with ⟨w, hw⟩ :=
    ⟨w, hw.right, hw.left⟩
  end


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.equalizers
import Mathlib.category_theory.limits.shapes.pullbacks
import Mathlib.category_theory.limits.shapes.regular_mono
import Mathlib.PostPort

universes v u l

namespace Mathlib

/-!
# Kernel pairs

This file defines what it means for a parallel pair of morphisms `a b : R ⟶ X` to be the kernel pair
for a morphism `f`.
Some properties of kernel pairs are given, namely allowing one to transfer between
the kernel pair of `f₁ ≫ f₂` to the kernel pair of `f₁`.
It is also proved that if `f` is a coequalizer of some pair, and `a`,`b` is a kernel pair for `f` then
it is a coequalizer of `a`,`b`.

## Implementation

The definition is essentially just a wrapper for `is_limit (pullback_cone.mk _ _ _)`, but the
constructions given here are useful, yet awkward to present in that language, so a basic API
is developed here.

## TODO

- Internal equivalence relations (or congruences) and the fact that every kernel pair induces one,
  and the converse in an effective regular category (WIP by b-mehta).

-/

namespace category_theory

/--
`is_kernel_pair f a b` expresses that `(a, b)` is a kernel pair for `f`, i.e. `a ≫ f = b ≫ f`
and the square
  R → X
  ↓   ↓
  X → Y
is a pullback square.
This is essentially just a convenience wrapper over `is_limit (pullback_cone.mk _ _ _)`.
-/
structure is_kernel_pair {C : Type u} [category C] {R : C} {X : C} {Y : C} (f : X ⟶ Y) (a : R ⟶ X) (b : R ⟶ X)
where
  comm : a ≫ f = b ≫ f
  is_limit : limits.is_limit (limits.pullback_cone.mk a b comm)

theorem is_kernel_pair.comm_assoc {C : Type u} [category C] {R : C} {X : C} {Y : C} {f : X ⟶ Y} {a : R ⟶ X} {b : R ⟶ X} (c : is_kernel_pair f a b) {X' : C} (f' : Y ⟶ X') : a ≫ f ≫ f' = b ≫ f ≫ f' := sorry

namespace is_kernel_pair

/-- The data expressing that `(a, b)` is a kernel pair is subsingleton. -/
protected instance subsingleton {C : Type u} [category C] {R : C} {X : C} {Y : C} (f : X ⟶ Y) (a : R ⟶ X) (b : R ⟶ X) : subsingleton (is_kernel_pair f a b) :=
  subsingleton.intro
    fun (P Q : is_kernel_pair f a b) =>
      cases_on P
        fun (P_comm : a ≫ f = b ≫ f) (P_is_limit : limits.is_limit (limits.pullback_cone.mk a b P_comm)) =>
          cases_on Q
            fun (Q_comm : a ≫ f = b ≫ f) (Q_is_limit : limits.is_limit (limits.pullback_cone.mk a b Q_comm)) =>
              (fun {f : X ⟶ Y} {a b : R ⟶ X} (comm comm_1 : a ≫ f = b ≫ f)
                  (is_limit : limits.is_limit (limits.pullback_cone.mk a b comm))
                  (is_limit_1 : limits.is_limit (limits.pullback_cone.mk a b comm_1)) =>
                  Eq.trans
                    ((fun {f : X ⟶ Y} {a b : R ⟶ X} (comm : a ≫ f = b ≫ f)
                        (is_limit : limits.is_limit (limits.pullback_cone.mk a b comm)) => Eq.refl (mk comm is_limit))
                      comm is_limit)
                    (congr (Eq.refl (mk comm)) (subsingleton.elim is_limit is_limit_1)))
                P_comm Q_comm P_is_limit Q_is_limit

/-- If `f` is a monomorphism, then `(𝟙 _, 𝟙 _)`  is a kernel pair for `f`. -/
def id_of_mono {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [mono f] : is_kernel_pair f 𝟙 𝟙 :=
  mk sorry
    (limits.pullback_cone.is_limit_aux' (limits.pullback_cone.mk 𝟙 𝟙 sorry)
      fun (s : limits.pullback_cone f f) => { val := limits.pullback_cone.snd s, property := sorry })

protected instance inhabited {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [mono f] : Inhabited (is_kernel_pair f 𝟙 𝟙) :=
  { default := id_of_mono f }

/--
Given a pair of morphisms `p`, `q` to `X` which factor through `f`, they factor through any kernel
pair of `f`.
-/
def lift' {C : Type u} [category C] {R : C} {X : C} {Y : C} {f : X ⟶ Y} {a : R ⟶ X} {b : R ⟶ X} {S : C} (k : is_kernel_pair f a b) (p : S ⟶ X) (q : S ⟶ X) (w : p ≫ f = q ≫ f) : Subtype fun (t : S ⟶ R) => t ≫ a = p ∧ t ≫ b = q :=
  limits.pullback_cone.is_limit.lift' (is_limit k) p q w

/--
If `(a,b)` is a kernel pair for `f₁ ≫ f₂` and `a ≫ f₁ = b ≫ f₁`, then `(a,b)` is a kernel pair for
just `f₁`.
That is, to show that `(a,b)` is a kernel pair for `f₁` it suffices to only show the square
commutes, rather than to additionally show it's a pullback.
-/
def cancel_right {C : Type u} [category C] {R : C} {X : C} {Y : C} {Z : C} {a : R ⟶ X} {b : R ⟶ X} {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} (comm : a ≫ f₁ = b ≫ f₁) (big_k : is_kernel_pair (f₁ ≫ f₂) a b) : is_kernel_pair f₁ a b :=
  mk comm
    (limits.pullback_cone.is_limit_aux' (limits.pullback_cone.mk a b comm)
      fun (s : limits.pullback_cone f₁ f₁) =>
        let s' : limits.pullback_cone (f₁ ≫ f₂) (f₁ ≫ f₂) :=
          limits.pullback_cone.mk (limits.pullback_cone.fst s) (limits.pullback_cone.snd s)
            (limits.pullback_cone.condition_assoc s f₂);
        { val := limits.is_limit.lift (is_limit big_k) s', property := sorry })

/--
If `(a,b)` is a kernel pair for `f₁ ≫ f₂` and `f₂` is mono, then `(a,b)` is a kernel pair for
just `f₁`.
The converse of `comp_of_mono`.
-/
def cancel_right_of_mono {C : Type u} [category C] {R : C} {X : C} {Y : C} {Z : C} {a : R ⟶ X} {b : R ⟶ X} {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} [mono f₂] (big_k : is_kernel_pair (f₁ ≫ f₂) a b) : is_kernel_pair f₁ a b :=
  cancel_right sorry big_k

/--
If `(a,b)` is a kernel pair for `f₁` and `f₂` is mono, then `(a,b)` is a kernel pair for `f₁ ≫ f₂`.
The converse of `cancel_right_of_mono`.
-/
def comp_of_mono {C : Type u} [category C] {R : C} {X : C} {Y : C} {Z : C} {a : R ⟶ X} {b : R ⟶ X} {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} [mono f₂] (small_k : is_kernel_pair f₁ a b) : is_kernel_pair (f₁ ≫ f₂) a b :=
  mk sorry
    (limits.pullback_cone.is_limit_aux' (limits.pullback_cone.mk a b sorry)
      fun (s : limits.pullback_cone (f₁ ≫ f₂) (f₁ ≫ f₂)) =>
        { val :=
            subtype.val
              (limits.pullback_cone.is_limit.lift' (is_limit small_k) (limits.pullback_cone.fst s)
                (limits.pullback_cone.snd s) sorry),
          property := sorry })

/--
If `(a,b)` is the kernel pair of `f`, and `f` is a coequalizer morphism for some parallel pair, then
`f` is a coequalizer morphism of `a` and `b`.
-/
def to_coequalizer {C : Type u} [category C] {R : C} {X : C} {Y : C} {f : X ⟶ Y} {a : R ⟶ X} {b : R ⟶ X} (k : is_kernel_pair f a b) [r : regular_epi f] : limits.is_colimit (limits.cofork.of_π f (comm k)) :=
  limits.cofork.is_colimit.mk (limits.cofork.of_π f (comm k))
    (fun (s : limits.cofork a b) =>
      subtype.val (limits.cofork.is_colimit.desc' regular_epi.is_colimit (limits.cofork.π s) sorry))
    sorry sorry


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.homology.image_to_kernel
import algebra.homology.homological_complex
import category_theory.graded_object

/-!
# The homology of a complex

Given `C : homological_complex V c`, we have `C.cycles i` and `C.boundaries i`,
both defined as subobjects of `C.X i`.

We show these are functorial with respect to chain maps,
as `C.cycles_map f i` and `C.boundaries_map f i`.

As a consequence we construct `homology_functor i : homological_complex V c ⥤ V`,
computing the `i`-th homology.
-/

universes v u

open category_theory category_theory.limits

variables {ι : Type*}
variables {V : Type u} [category.{v} V] [has_zero_morphisms V]
variables {c : complex_shape ι} (C : homological_complex V c)

open_locale classical zero_object
noncomputable theory

namespace homological_complex

section cycles
variables [has_kernels V]

/-- The cycles at index `i`, as a subobject. -/
abbreviation cycles (i : ι) : subobject (C.X i) :=
kernel_subobject (C.d_from i)

lemma cycles_eq_kernel_subobject {i j : ι} (r : c.rel i j) :
  C.cycles i = kernel_subobject (C.d i j) :=
C.kernel_from_eq_kernel r

/--
The underlying object of `C.cycles i` is isomorphic to `kernel (C.d i j)`,
for any `j` such that `rel i j`.
-/
def cycles_iso_kernel {i j : ι} (r : c.rel i j) :
  (C.cycles i : V) ≅ kernel (C.d i j) :=
subobject.iso_of_eq _ _ (C.cycles_eq_kernel_subobject r) ≪≫
  kernel_subobject_iso (C.d i j)

lemma cycles_eq_top {i} (h : ¬c.rel i (c.next i)) : C.cycles i = ⊤ :=
begin
  rw eq_top_iff,
  apply le_kernel_subobject,
  rw [C.d_from_eq_zero h, comp_zero],
end

end cycles

section boundaries
variables [has_images V]

/-- The boundaries at index `i`, as a subobject. -/
abbreviation boundaries (C : homological_complex V c) (j : ι) : subobject (C.X j) :=
image_subobject (C.d_to j)

lemma boundaries_eq_image_subobject [has_equalizers V] {i j : ι} (r : c.rel i j) :
  C.boundaries j = image_subobject (C.d i j) :=
C.image_to_eq_image r

/--
The underlying object of `C.boundaries j` is isomorphic to `image (C.d i j)`,
for any `i` such that `rel i j`.
-/
def boundaries_iso_image [has_equalizers V] {i j : ι} (r : c.rel i j) :
  (C.boundaries j : V) ≅ image (C.d i j) :=
subobject.iso_of_eq _ _ (C.boundaries_eq_image_subobject r) ≪≫
  image_subobject_iso (C.d i j)

lemma boundaries_eq_bot [has_zero_object V] {j} (h : ¬c.rel (c.prev j) j) :
  C.boundaries j = ⊥ :=
begin
  rw eq_bot_iff,
  refine image_subobject_le _ 0 _,
  rw [C.d_to_eq_zero h, zero_comp],
end

end boundaries

section
variables [has_kernels V] [has_images V]

lemma boundaries_le_cycles (C : homological_complex V c) (i : ι) :
  C.boundaries i ≤ C.cycles i :=
image_le_kernel _ _ (C.d_to_comp_d_from i)

/--
The canonical map from `boundaries i` to `cycles i`.
-/
abbreviation boundaries_to_cycles (C : homological_complex V c) (i : ι) :
  (C.boundaries i : V) ⟶ (C.cycles i : V) :=
image_to_kernel _ _ (C.d_to_comp_d_from i)

/-- Prefer `boundaries_to_cycles`. -/
@[simp] lemma image_to_kernel_as_boundaries_to_cycles (C : homological_complex V c) (i : ι) (h) :
  (C.boundaries i).of_le (C.cycles i) h = C.boundaries_to_cycles i :=
rfl

variables [has_cokernels V]

/--
The homology of a complex at index `i`.
-/
abbreviation homology (C : homological_complex V c) (i : ι) : V :=
homology (C.d_to i) (C.d_from i) (C.d_to_comp_d_from i)

/-- The `j`th homology of a homological complex (as kernel of 'the differential from `Cⱼ`' modulo
the image of 'the differential to `Cⱼ`') is isomorphic to the kernel of `d : Cⱼ → Cₖ` modulo
the image of `d : Cᵢ → Cⱼ` when `rel i j` and `rel j k`. -/
def homology_iso (C : homological_complex V c) {i j k : ι} (hij : c.rel i j) (hjk : c.rel j k) :
  C.homology j ≅ _root_.homology (C.d i j) (C.d j k) (C.d_comp_d i j k) :=
homology.map_iso _ _ (arrow.iso_mk (C.X_prev_iso hij) (iso.refl _) $ by dsimp;
  rw [C.d_to_eq hij, category.comp_id])
(arrow.iso_mk (iso.refl _) (C.X_next_iso hjk) $ by dsimp; rw [C.d_from_comp_X_next_iso hjk,
   category.id_comp]) rfl
end

end homological_complex

/-- The 0th homology of a chain complex is isomorphic to the cokernel of `d : C₁ ⟶ C₀`. -/
def chain_complex.homology_zero_iso [has_kernels V] [has_images V] [has_cokernels V]
  (C : chain_complex V ℕ) [epi (factor_thru_image (C.d 1 0))] :
  C.homology 0 ≅ cokernel (C.d 1 0) :=
(homology.map_iso _ _ (arrow.iso_mk (C.X_prev_iso rfl) (iso.refl _) $
by rw C.d_to_eq rfl; exact (category.comp_id _).symm : arrow.mk (C.d_to 0) ≅ arrow.mk (C.d 1 0))
  (arrow.iso_mk (iso.refl _) (iso.refl _) $
by simp [C.d_from_eq_zero (λ (h : _ = _), one_ne_zero $ by
  rwa chain_complex.next_nat_zero at h)] : arrow.mk (C.d_from 0) ≅ arrow.mk 0) rfl).trans $
homology_of_zero_right _

/-- The 0th cohomology of a cochain complex is isomorphic to the kernel of `d : C₀ → C₁`. -/
def cochain_complex.homology_zero_iso [has_zero_object V]
  [has_kernels V] [has_images V] [has_cokernels V] (C : cochain_complex V ℕ) :
  C.homology 0 ≅ kernel (C.d 0 1) :=
(homology.map_iso _ _ (arrow.iso_mk (C.X_prev_iso_self (by rw cochain_complex.prev_nat_zero;
  exact one_ne_zero)) (iso.refl _) (by simp) : arrow.mk (C.d_to 0) ≅ arrow.mk 0)
  (arrow.iso_mk (iso.refl _) (C.X_next_iso rfl)
  (by simp) : arrow.mk (C.d_from 0) ≅ arrow.mk (C.d 0 1)) $ by simpa).trans $
homology_of_zero_left _

/-- The `n + 1`th homology of a chain complex (as kernel of 'the differential from `Cₙ₊₁`' modulo
the image of 'the differential to `Cₙ₊₁`') is isomorphic to the kernel of `d : Cₙ₊₁ → Cₙ` modulo
the image of `d : Cₙ₊₂ → Cₙ₊₁`. -/
def chain_complex.homology_succ_iso [has_kernels V] [has_images V] [has_cokernels V]
  (C : chain_complex V ℕ) (n : ℕ) :
  C.homology (n + 1) ≅ homology (C.d (n + 2) (n + 1)) (C.d (n + 1) n) (C.d_comp_d _ _ _) :=
C.homology_iso rfl rfl

/-- The `n + 1`th cohomology of a cochain complex (as kernel of 'the differential from `Cₙ₊₁`'
modulo the image of 'the differential to `Cₙ₊₁`') is isomorphic to the kernel of `d : Cₙ₊₁ → Cₙ₊₂`
modulo the image of `d : Cₙ → Cₙ₊₁`. -/
def cochain_complex.homology_succ_iso [has_kernels V] [has_images V] [has_cokernels V]
  (C : cochain_complex V ℕ) (n : ℕ) :
  C.homology (n + 1) ≅ homology (C.d n (n + 1)) (C.d (n + 1) (n + 2)) (C.d_comp_d _ _ _) :=
C.homology_iso rfl rfl

open homological_complex

/-! Computing the cycles is functorial. -/
section
variables [has_kernels V]
variables {C₁ C₂ C₃ : homological_complex V c} (f : C₁ ⟶ C₂)

/--
The morphism between cycles induced by a chain map.
-/
abbreviation cycles_map (f : C₁ ⟶ C₂) (i : ι) : (C₁.cycles i : V) ⟶ (C₂.cycles i : V) :=
subobject.factor_thru _ ((C₁.cycles i).arrow ≫ f.f i) (kernel_subobject_factors _ _ (by simp))

@[simp, reassoc, elementwise]
lemma cycles_map_arrow (f : C₁ ⟶ C₂) (i : ι) :
  (cycles_map f i) ≫ (C₂.cycles i).arrow = (C₁.cycles i).arrow ≫ f.f i :=
by { simp, }

@[simp] lemma cycles_map_id (i : ι) : cycles_map (𝟙 C₁) i = 𝟙 _ :=
by { dunfold cycles_map, simp, }

@[simp] lemma cycles_map_comp (f : C₁ ⟶ C₂) (g : C₂ ⟶ C₃) (i : ι) :
  cycles_map (f ≫ g) i = cycles_map f i ≫ cycles_map g i :=
by { dunfold cycles_map, simp [subobject.factor_thru_right], }

variables (V c)

/-- Cycles as a functor. -/
@[simps]
def cycles_functor (i : ι) : homological_complex V c ⥤ V :=
{ obj := λ C, C.cycles i,
  map := λ C₁ C₂ f, cycles_map f i, }

end

/-! Computing the boundaries is functorial. -/
section
variables [has_images V] [has_image_maps V]
variables {C₁ C₂ C₃ : homological_complex V c} (f : C₁ ⟶ C₂)

/--
The morphism between boundaries induced by a chain map.
-/
abbreviation boundaries_map (f : C₁ ⟶ C₂) (i : ι) : (C₁.boundaries i : V) ⟶ (C₂.boundaries i : V) :=
image_subobject_map (f.sq_to i)

variables (V c)

/-- Boundaries as a functor. -/
@[simps]
def boundaries_functor (i : ι) : homological_complex V c ⥤ V :=
{ obj := λ C, C.boundaries i,
  map := λ C₁ C₂ f, image_subobject_map (f.sq_to i), }

end

section

/-! The `boundaries_to_cycles` morphisms are natural. -/
variables [has_equalizers V] [has_images V] [has_image_maps V]
variables {C₁ C₂ : homological_complex V c} (f : C₁ ⟶ C₂)

@[simp, reassoc]
lemma boundaries_to_cycles_naturality (i : ι) :
  boundaries_map f i ≫ C₂.boundaries_to_cycles i = C₁.boundaries_to_cycles i ≫ cycles_map f i :=
by { ext, simp, }

variables (V c)

/-- The natural transformation from the boundaries functor to the cycles functor. -/
@[simps] def boundaries_to_cycles_nat_trans (i : ι) :
  boundaries_functor V c i ⟶ cycles_functor V c i :=
{ app := λ C, C.boundaries_to_cycles i,
  naturality' := λ C₁ C₂ f, boundaries_to_cycles_naturality f i, }

/-- The `i`-th homology, as a functor to `V`. -/
@[simps]
def homology_functor [has_cokernels V] (i : ι) :
  homological_complex V c ⥤ V :=
-- It would be nice if we could just write
-- `cokernel (boundaries_to_cycles_nat_trans V c i)`
-- here, but universe implementation details get in the way...
{ obj := λ C, C.homology i,
  map := λ C₁ C₂ f, _root_.homology.map _ _ (f.sq_to i) (f.sq_from i) rfl,
  map_id' :=
  begin
    intros, ext1,
    simp only [homology.π_map, kernel_subobject_map_id, hom.sq_from_id,
      category.id_comp, category.comp_id]
  end,
  map_comp' :=
  begin
    intros, ext1,
    simp only [hom.sq_from_comp, kernel_subobject_map_comp, homology.π_map_assoc,
      homology.π_map, category.assoc]
  end }

/-- The homology functor from `ι`-indexed complexes to `ι`-graded objects in `V`. -/
@[simps] def graded_homology_functor [has_cokernels V] :
  homological_complex V c ⥤ graded_object ι V :=
{ obj := λ C i, C.homology i,
  map := λ C C' f i, (homology_functor V c i).map f,
  map_id' :=
  begin
    intros, ext,
    simp only [pi.id_apply, homology.π_map, homology_functor_map, kernel_subobject_map_id,
      hom.sq_from_id, category.id_comp, category.comp_id]
  end,
  map_comp' :=
  begin
    intros, ext,
    simp only [hom.sq_from_comp, kernel_subobject_map_comp, homology.π_map_assoc,
      pi.comp_apply, homology.π_map, homology_functor_map, category.assoc]
  end }

end


import tactic
import .lesson6

noncomputable theory
open_locale classical

open PreHilbertPlane HilbertPlane

section plane_separation

variables {Ω : Type*} [HilbertPlane Ω]

variables {ℓ r s : Line Ω}
variables {B C D: {x : Ω // x ∈ ℓ}}
variables {A : Ω}

@[simp] def same_side_of_line (hAℓ : A ∈ ℓ) (B C : {x : Ω // x ∈ ℓ}) :=
    ((B : Ω) = C) ∨ (¬ (A : Ω) ∈ (B : Ω) ⬝ C)

lemma same_side_of_line.refl (hAℓ : A ∈ ℓ) : same_side_of_line hAℓ B B :=
begin
    simp,
end

lemma same_side_of_line.symm (hAℓ : A ∈ ℓ) :
    same_side_of_line hAℓ B C →  same_side_of_line hAℓ C B :=
begin
    simp only [Segment.mem_pts, and_imp, same_side_of_line, between_point_symmetric] at *,
    tauto,
end

lemma same_side_line_vs_plane (hr : r ≠ ℓ) (hAℓ : A ∈ ℓ) (hAr : A ∈ r) :
    same_side_of_line hAℓ B C ↔ same_side r B C :=
begin
    obtain rfl | hBC := em(B = C), by exact ⟨ λ h, same_side.refl, λ h, same_side_of_line.refl _⟩,
    cases B with B hB,
    cases C with C hC,
    split,
    {
        intro h,
        unfold same_side_of_line at h,
        unfold same_side,
        rcases h with ⟨h1,h2⟩ | hBAC,
        {
            tauto,
        },
        by_cases hh : (B : Ω) ∈ r ∧ (C : Ω) ∈ r, left, assumption,
        replace hh : (B : Ω) ∉ r ∨ (C : Ω) ∉ r, tauto,
        right,
        unfold pts,
        ext1,
        dsimp,
        rw iff_false,
        push_neg,
        intros H hx,
        rcases H with (H|H|H),
        any_goals {subst H, simp only at hx, exfalso},
        work_on_goal 3 {have hxℓ : x ∈ ℓ := between_points_share_line hB hC H},
        work_on_goal 1 {obtain rfl | ht := em(A = B)},
        work_on_goal 3 {obtain rfl | ht := em(A = C)},
        work_on_goal 5 {obtain rfl | ht := em(A = x)},
        any_goals
        {
            apply hBAC,
            norm_num,
            try {tauto},
        },
        all_goals
        {
            exfalso,
            apply hr,
            apply equal_lines_of_contain_two_points ht,
            try {repeat {assumption}},
        },
    },
    {
        intro H,
        unfold same_side at H,
        rcases H with (⟨H1,H2⟩|H),
        simp,
        repeat{split},
        repeat {assumption},
        {
            right,
            push_neg,
            exfalso,
            apply hr,
            norm_num at hBC,
            apply equal_lines_of_contain_two_points hBC,
            try {repeat {assumption}},
        },
        {
            unfold same_side_of_line,
            right,
            intro hABC,
            rw set.eq_empty_iff_forall_not_mem at H,
            specialize H A,
            apply H,
            simp only [true_and, set.mem_inter_eq, true_or, eq_self_iff_true,
            segments_are_symmetric],
            split,
            {
                finish,
            },
            assumption,
        },
    },
end

lemma same_side_of_line.trans (hAℓ : A ∈ ℓ) :
    same_side_of_line hAℓ B C → same_side_of_line hAℓ C D →  same_side_of_line hAℓ B D :=
begin
    obtain ⟨E, hE⟩ := exists_point_not_on_line ℓ,
    let r := line_through A E,
    have hEr : E ∈ r := line_through_right,
    have hAr : A ∈ r := line_through_left,
    obtain rfl | hr := em(r = ℓ), by tauto,
    repeat {rw same_side_line_vs_plane hr},
    {
        exact same_side.trans,
    },
    repeat {assumption},
end

@[simp] theorem same_side_of_line_equiv (hAℓ : A ∈ ℓ) :
(equivalence (same_side_of_line hAℓ))
:= ⟨λ x, same_side_of_line.refl hAℓ,
    λ x y hxy, same_side_of_line.symm hAℓ hxy,
    λ x y z hxy hyz, same_side_of_line.trans hAℓ hxy hyz⟩

lemma at_least_two_classes_line (hAℓ : A ∈ ℓ) : ∃ B C : {x : Ω // x ∈ ℓ}, ¬ same_side_of_line hAℓ B C :=
begin
    sorry
end

lemma at_most_two_classes_line (hAℓ : A ∈ ℓ) : ¬ same_side_of_line hAℓ B C →
¬ same_side_of_line hAℓ B D → same_side_of_line hAℓ C D :=
begin
    sorry
end

end plane_separation