/-
Copyright (c) 2019 Amelia Livingston. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Amelia Livingston
-/
import data.setoid.basic
import algebra.group.pi
import algebra.group.prod
import data.equiv.mul_add
import group_theory.submonoid.operations

/-!
# Congruence relations

This file defines congruence relations: equivalence relations that preserve a binary operation,
which in this case is multiplication or addition. The principal definition is a `structure`
extending a `setoid` (an equivalence relation), and the inductive definition of the smallest
congruence relation containing a binary relation is also given (see `con_gen`).

The file also proves basic properties of the quotient of a type by a congruence relation, and the
complete lattice of congruence relations on a type. We then establish an order-preserving bijection
between the set of congruence relations containing a congruence relation `c` and the set of
congruence relations on the quotient by `c`.

The second half of the file concerns congruence relations on monoids, in which case the
quotient by the congruence relation is also a monoid. There are results about the universal
property of quotients of monoids, and the isomorphism theorems for monoids.

## Implementation notes

The inductive definition of a congruence relation could be a nested inductive type, defined using
the equivalence closure of a binary relation `eqv_gen`, but the recursor generated does not work.
A nested inductive definition could conceivably shorten proofs, because they would allow invocation
of the corresponding lemmas about `eqv_gen`.

The lemmas `refl`, `symm` and `trans` are not tagged with `@[refl]`, `@[symm]`, and `@[trans]`
respectively as these tags do not work on a structure coerced to a binary relation.

There is a coercion from elements of a type to the element's equivalence class under a
congruence relation.

A congruence relation on a monoid `M` can be thought of as a submonoid of `M × M` for which
membership is an equivalence relation, but whilst this fact is established in the file, it is not
used, since this perspective adds more layers of definitional unfolding.

## Tags

congruence, congruence relation, quotient, quotient by congruence relation, monoid,
quotient monoid, isomorphism theorems
-/

variables (M : Type*) {N : Type*} {P : Type*}

set_option old_structure_cmd true

open function setoid

/-- A congruence relation on a type with an addition is an equivalence relation which
    preserves addition. -/
structure add_con [has_add M] extends setoid M :=
(add' : ∀ {w x y z}, r w x → r y z → r (w + y) (x + z))

/-- A congruence relation on a type with a multiplication is an equivalence relation which
    preserves multiplication. -/
@[to_additive add_con] structure con [has_mul M] extends setoid M :=
(mul' : ∀ {w x y z}, r w x → r y z → r (w * y) (x * z))

/-- The equivalence relation underlying an additive congruence relation. -/
add_decl_doc add_con.to_setoid

/-- The equivalence relation underlying a multiplicative congruence relation. -/
add_decl_doc con.to_setoid

variables {M}

/-- The inductively defined smallest additive congruence relation containing a given binary
    relation. -/
inductive add_con_gen.rel [has_add M] (r : M → M → Prop) : M → M → Prop
| of : Π x y, r x y → add_con_gen.rel x y
| refl : Π x, add_con_gen.rel x x
| symm : Π x y, add_con_gen.rel x y → add_con_gen.rel y x
| trans : Π x y z, add_con_gen.rel x y → add_con_gen.rel y z → add_con_gen.rel x z
| add : Π w x y z, add_con_gen.rel w x → add_con_gen.rel y z → add_con_gen.rel (w + y) (x + z)

/-- The inductively defined smallest multiplicative congruence relation containing a given binary
    relation. -/
@[to_additive add_con_gen.rel]
inductive con_gen.rel [has_mul M] (r : M → M → Prop) : M → M → Prop
| of : Π x y, r x y → con_gen.rel x y
| refl : Π x, con_gen.rel x x
| symm : Π x y, con_gen.rel x y → con_gen.rel y x
| trans : Π x y z, con_gen.rel x y → con_gen.rel y z → con_gen.rel x z
| mul : Π w x y z, con_gen.rel w x → con_gen.rel y z → con_gen.rel (w * y) (x * z)

/-- The inductively defined smallest multiplicative congruence relation containing a given binary
    relation. -/
@[to_additive add_con_gen "The inductively defined smallest additive congruence relation containing
a given binary relation."]
def con_gen [has_mul M] (r : M → M → Prop) : con M :=
⟨con_gen.rel r, ⟨con_gen.rel.refl, con_gen.rel.symm, con_gen.rel.trans⟩, con_gen.rel.mul⟩

namespace con

section
variables [has_mul M] [has_mul N] [has_mul P] (c : con M)

@[to_additive]
instance : inhabited (con M) :=
⟨con_gen empty_relation⟩

/-- A coercion from a congruence relation to its underlying binary relation. -/
@[to_additive "A coercion from an additive congruence relation to its underlying binary relation."]
instance : has_coe_to_fun (con M) := ⟨_, λ c, λ x y, c.r x y⟩

@[simp, to_additive] lemma rel_eq_coe (c : con M) : c.r = c := rfl

/-- Congruence relations are reflexive. -/
@[to_additive "Additive congruence relations are reflexive."]
protected lemma refl (x) : c x x := c.2.1 x

/-- Congruence relations are symmetric. -/
@[to_additive "Additive congruence relations are symmetric."]
protected lemma symm : ∀ {x y}, c x y → c y x := λ _ _ h, c.2.2.1 h

/-- Congruence relations are transitive. -/
@[to_additive "Additive congruence relations are transitive."]
protected lemma trans : ∀ {x y z}, c x y → c y z → c x z :=
λ _ _ _ h, c.2.2.2 h

/-- Multiplicative congruence relations preserve multiplication. -/
@[to_additive "Additive congruence relations preserve addition."]
protected lemma mul : ∀ {w x y z}, c w x → c y z → c (w * y) (x * z) :=
λ _ _ _ _ h1 h2, c.3 h1 h2

/-- Given a type `M` with a multiplication, a congruence relation `c` on `M`, and elements of `M`
    `x, y`, `(x, y) ∈ M × M` iff `x` is related to `y` by `c`. -/
@[to_additive "Given a type `M` with an addition, `x, y ∈ M`, and an additive congruence relation
`c` on `M`, `(x, y) ∈ M × M` iff `x` is related to `y` by `c`."]
instance : has_mem (M × M) (con M) := ⟨λ x c, c x.1 x.2⟩

variables {c}

/-- The map sending a congruence relation to its underlying binary relation is injective. -/
@[to_additive "The map sending an additive congruence relation to its underlying binary relation
is injective."]
lemma ext' {c d : con M} (H : c.r = d.r) : c = d :=
by cases c; cases d; simpa using H

/-- Extensionality rule for congruence relations. -/
@[ext, to_additive "Extensionality rule for additive congruence relations."]
lemma ext {c d : con M} (H : ∀ x y, c x y ↔ d x y) : c = d :=
ext' $ by ext; apply H

attribute [ext] add_con.ext

/-- The map sending a congruence relation to its underlying equivalence relation is injective. -/
@[to_additive "The map sending an additive congruence relation to its underlying equivalence
relation is injective."]
lemma to_setoid_inj {c d : con M} (H : c.to_setoid = d.to_setoid) : c = d :=
ext $ ext_iff.1 H

/-- Iff version of extensionality rule for congruence relations. -/
@[to_additive "Iff version of extensionality rule for additive congruence relations."]
lemma ext_iff {c d : con M} : (∀ x y, c x y ↔ d x y) ↔ c = d :=
⟨ext, λ h _ _, h ▸ iff.rfl⟩

/-- Two congruence relations are equal iff their underlying binary relations are equal. -/
@[to_additive "Two additive congruence relations are equal iff their underlying binary relations
are equal."]
lemma ext'_iff {c d : con M} : c.r = d.r ↔ c = d :=
⟨ext', λ h, h ▸ rfl⟩

/-- The kernel of a multiplication-preserving function as a congruence relation. -/
@[to_additive "The kernel of an addition-preserving function as an additive congruence relation."]
def mul_ker (f : M → P) (h : ∀ x y, f (x * y) = f x * f y) : con M :=
{ r := λ x y, f x = f y,
  iseqv := ⟨λ _, rfl, λ _ _, eq.symm, λ _ _ _, eq.trans⟩,
  mul' := λ _ _ _ _ h1 h2, by rw [h, h1, h2, h] }

/-- Given types with multiplications `M, N`, the product of two congruence relations `c` on `M` and
    `d` on `N`: `(x₁, x₂), (y₁, y₂) ∈ M × N` are related by `c.prod d` iff `x₁` is related to `y₁`
    by `c` and `x₂` is related to `y₂` by `d`. -/
@[to_additive prod "Given types with additions `M, N`, the product of two congruence relations
`c` on `M` and `d` on `N`: `(x₁, x₂), (y₁, y₂) ∈ M × N` are related by `c.prod d` iff `x₁`
is related to `y₁` by `c` and `x₂` is related to `y₂` by `d`."]
protected def prod (c : con M) (d : con N) : con (M × N) :=
{ mul' := λ _ _ _ _ h1 h2, ⟨c.mul h1.1 h2.1, d.mul h1.2 h2.2⟩, ..c.to_setoid.prod d.to_setoid }

/-- The product of an indexed collection of congruence relations. -/
@[to_additive "The product of an indexed collection of additive congruence relations."]
def pi {ι : Type*} {f : ι → Type*} [Π i, has_mul (f i)]
  (C : Π i, con (f i)) : con (Π i, f i) :=
{ mul' := λ _ _ _ _ h1 h2 i, (C i).mul (h1 i) (h2 i), ..@pi_setoid _ _ $ λ i, (C i).to_setoid }

variables (c)

@[simp, to_additive] lemma coe_eq : c.to_setoid.r = c := rfl

-- Quotients

/-- Defining the quotient by a congruence relation of a type with a multiplication. -/
@[to_additive "Defining the quotient by an additive congruence relation of a type with
an addition."]
protected def quotient := quotient $ c.to_setoid

/-- Coercion from a type with a multiplication to its quotient by a congruence relation.

See Note [use has_coe_t]. -/
@[to_additive "Coercion from a type with an addition to its quotient by an additive congruence
relation", priority 0]
instance : has_coe_t M c.quotient := ⟨@quotient.mk _ c.to_setoid⟩

/-- The quotient of a type with decidable equality by a congruence relation also has
    decidable equality. -/
@[to_additive "The quotient of a type with decidable equality by an additive congruence relation
also has decidable equality."]
instance [d : ∀ a b, decidable (c a b)] : decidable_eq c.quotient :=
@quotient.decidable_eq M c.to_setoid d

/-- The function on the quotient by a congruence relation `c` induced by a function that is
    constant on `c`'s equivalence classes. -/
@[elab_as_eliminator, to_additive "The function on the quotient by a congruence relation `c`
induced by a function that is constant on `c`'s equivalence classes."]
protected def lift_on {β} {c : con M} (q : c.quotient) (f : M → β)
  (h : ∀ a b, c a b → f a = f b) : β := quotient.lift_on' q f h

/-- The binary function on the quotient by a congruence relation `c` induced by a binary function
    that is constant on `c`'s equivalence classes. -/
@[elab_as_eliminator, to_additive "The binary function on the quotient by a congruence relation `c`
induced by a binary function that is constant on `c`'s equivalence classes."]
protected def lift_on₂ {β} {c : con M} (q r : c.quotient) (f : M → M → β)
  (h : ∀ a₁ a₂ b₁ b₂, c a₁ b₁ → c a₂ b₂ → f a₁ a₂ = f b₁ b₂) : β := quotient.lift_on₂' q r f h

variables {c}

/-- The inductive principle used to prove propositions about the elements of a quotient by a
    congruence relation. -/
@[elab_as_eliminator, to_additive "The inductive principle used to prove propositions about
the elements of a quotient by an additive congruence relation."]
protected lemma induction_on {C : c.quotient → Prop} (q : c.quotient) (H : ∀ x : M, C x) : C q :=
quotient.induction_on' q H

/-- A version of `con.induction_on` for predicates which take two arguments. -/
@[elab_as_eliminator, to_additive "A version of `add_con.induction_on` for predicates which take
two arguments."]
protected lemma induction_on₂ {d : con N} {C : c.quotient → d.quotient → Prop}
  (p : c.quotient) (q : d.quotient) (H : ∀ (x : M) (y : N), C x y) : C p q :=
quotient.induction_on₂' p q H

variables (c)

/-- Two elements are related by a congruence relation `c` iff they are represented by the same
    element of the quotient by `c`. -/
@[simp, to_additive "Two elements are related by an additive congruence relation `c` iff they
are represented by the same element of the quotient by `c`."]
protected lemma eq {a b : M} : (a : c.quotient) = b ↔ c a b :=
quotient.eq'

/-- The multiplication induced on the quotient by a congruence relation on a type with a
    multiplication. -/
@[to_additive "The addition induced on the quotient by an additive congruence relation on a type
with an addition."]
instance has_mul : has_mul c.quotient :=
⟨λ x y, quotient.lift_on₂' x y (λ w z, ((w * z : M) : c.quotient))
     $ λ _ _ _ _ h1 h2, c.eq.2 $ c.mul h1 h2⟩

/-- The kernel of the quotient map induced by a congruence relation `c` equals `c`. -/
@[simp, to_additive "The kernel of the quotient map induced by an additive congruence relation
`c` equals `c`."]
lemma mul_ker_mk_eq : mul_ker (coe : M → c.quotient) (λ x y, rfl) = c :=
ext $ λ x y, quotient.eq'

variables {c}

/-- The coercion to the quotient of a congruence relation commutes with multiplication (by
    definition). -/
@[simp, to_additive "The coercion to the quotient of an additive congruence relation commutes with
addition (by definition)."]
lemma coe_mul (x y : M) : (↑(x * y) : c.quotient) = ↑x * ↑y := rfl

/-- Definition of the function on the quotient by a congruence relation `c` induced by a function
    that is constant on `c`'s equivalence classes. -/
@[simp, to_additive "Definition of the function on the quotient by an additive congruence
relation `c` induced by a function that is constant on `c`'s equivalence classes."]
protected lemma lift_on_coe {β} (c : con M) (f : M → β)
  (h : ∀ a b, c a b → f a = f b) (x : M) :
  con.lift_on (x : c.quotient) f h = f x := rfl

/-- Makes an isomorphism of quotients by two congruence relations, given that the relations are
    equal. -/
@[to_additive "Makes an additive isomorphism of quotients by two additive congruence relations,
given that the relations are equal."]
protected def congr {c d : con M} (h : c = d) :  c.quotient ≃* d.quotient :=
{ map_mul' := λ x y, by rcases x; rcases y; refl,
  ..quotient.congr (equiv.refl M) $ by apply ext_iff.2 h }

-- The complete lattice of congruence relations on a type

/-- For congruence relations `c, d` on a type `M` with a multiplication, `c ≤ d` iff `∀ x y ∈ M`,
    `x` is related to `y` by `d` if `x` is related to `y` by `c`. -/
@[to_additive "For additive congruence relations `c, d` on a type `M` with an addition, `c ≤ d` iff
`∀ x y ∈ M`, `x` is related to `y` by `d` if `x` is related to `y` by `c`."]
instance : has_le (con M) := ⟨λ c d, ∀ ⦃x y⦄, c x y → d x y⟩

/-- Definition of `≤` for congruence relations. -/
@[to_additive "Definition of `≤` for additive congruence relations."]
theorem le_def {c d : con M} : c ≤ d ↔ ∀ {x y}, c x y → d x y := iff.rfl

/-- The infimum of a set of congruence relations on a given type with a multiplication. -/
@[to_additive "The infimum of a set of additive congruence relations on a given type with
an addition."]
instance : has_Inf (con M) :=
⟨λ S, ⟨λ x y, ∀ c : con M, c ∈ S → c x y,
⟨λ x c hc, c.refl x, λ _ _ h c hc, c.symm $ h c hc,
 λ _ _ _ h1 h2 c hc, c.trans (h1 c hc) $ h2 c hc⟩,
 λ _ _ _ _ h1 h2 c hc, c.mul (h1 c hc) $ h2 c hc⟩⟩

/-- The infimum of a set of congruence relations is the same as the infimum of the set's image
    under the map to the underlying equivalence relation. -/
@[to_additive "The infimum of a set of additive congruence relations is the same as the infimum of
the set's image under the map to the underlying equivalence relation."]
lemma Inf_to_setoid (S : set (con M)) : (Inf S).to_setoid = Inf (to_setoid '' S) :=
setoid.ext' $ λ x y, ⟨λ h r ⟨c, hS, hr⟩, by rw ←hr; exact h c hS,
  λ h c hS, h c.to_setoid ⟨c, hS, rfl⟩⟩

/-- The infimum of a set of congruence relations is the same as the infimum of the set's image
    under the map to the underlying binary relation. -/
@[to_additive "The infimum of a set of additive congruence relations is the same as the infimum
of the set's image under the map to the underlying binary relation."]
lemma Inf_def (S : set (con M)) : (Inf S).r = Inf (r '' S) :=
by { ext, simp only [Inf_image, infi_apply, infi_Prop_eq], refl }

@[to_additive]
instance : partial_order (con M) :=
{ le := (≤),
  lt := λ c d, c ≤ d ∧ ¬d ≤ c,
  le_refl := λ c _ _, id,
  le_trans := λ c1 c2 c3 h1 h2 x y h, h2 $ h1 h,
  lt_iff_le_not_le := λ _ _, iff.rfl,
  le_antisymm := λ c d hc hd, ext $ λ x y, ⟨λ h, hc h, λ h, hd h⟩ }

/-- The complete lattice of congruence relations on a given type with a multiplication. -/
@[to_additive "The complete lattice of additive congruence relations on a given type with
an addition."]
instance : complete_lattice (con M) :=
{ inf := λ c d, ⟨(c.to_setoid ⊓ d.to_setoid).1, (c.to_setoid ⊓ d.to_setoid).2,
                  λ _ _ _ _ h1 h2, ⟨c.mul h1.1 h2.1, d.mul h1.2 h2.2⟩⟩,
  inf_le_left := λ _ _ _ _ h, h.1,
  inf_le_right := λ _ _ _ _ h, h.2,
  le_inf := λ _ _ _ hb hc _ _ h, ⟨hb h, hc h⟩,
  top := { mul' := by tauto, ..setoid.complete_lattice.top},
  le_top := λ _ _ _ h, trivial,
  bot := { mul' := λ _ _ _ _ h1 h2, h1 ▸ h2 ▸ rfl, ..setoid.complete_lattice.bot},
  bot_le := λ c x y h, h ▸ c.refl x,
  .. complete_lattice_of_Inf (con M) $ assume s,
    ⟨λ r hr x y h, (h : ∀ r ∈ s, (r : con M) x y) r hr, λ r hr x y h r' hr', hr hr' h⟩ }

/-- The infimum of two congruence relations equals the infimum of the underlying binary
    operations. -/
@[to_additive "The infimum of two additive congruence relations equals the infimum of the
underlying binary operations."]
lemma inf_def {c d : con M} : (c ⊓ d).r = c.r ⊓ d.r := rfl

/-- Definition of the infimum of two congruence relations. -/
@[to_additive "Definition of the infimum of two additive congruence relations."]
theorem inf_iff_and {c d : con M} {x y} : (c ⊓ d) x y ↔ c x y ∧ d x y := iff.rfl

/-- The inductively defined smallest congruence relation containing a binary relation `r` equals
    the infimum of the set of congruence relations containing `r`. -/
@[to_additive add_con_gen_eq "The inductively defined smallest additive congruence relation
containing a binary relation `r` equals the infimum of the set of additive congruence relations
containing `r`."]
theorem con_gen_eq (r : M → M → Prop) :
  con_gen r = Inf {s : con M | ∀ x y, r x y → s x y} :=
le_antisymm
  (λ x y H, con_gen.rel.rec_on H (λ _ _ h _ hs, hs _ _ h) (con.refl _) (λ _ _ _, con.symm _)
    (λ _ _ _ _ _, con.trans _)
    $ λ w x y z _ _ h1 h2 c hc, c.mul (h1 c hc) $ h2 c hc)
  (Inf_le (λ _ _, con_gen.rel.of _ _))

/-- The smallest congruence relation containing a binary relation `r` is contained in any
    congruence relation containing `r`. -/
@[to_additive add_con_gen_le "The smallest additive congruence relation containing a binary
relation `r` is contained in any additive congruence relation containing `r`."]
theorem con_gen_le {r : M → M → Prop} {c : con M} (h : ∀ x y, r x y → c.r x y) :
  con_gen r ≤ c :=
by rw con_gen_eq; exact Inf_le h

/-- Given binary relations `r, s` with `r` contained in `s`, the smallest congruence relation
    containing `s` contains the smallest congruence relation containing `r`. -/
@[to_additive add_con_gen_mono "Given binary relations `r, s` with `r` contained in `s`, the
smallest additive congruence relation containing `s` contains the smallest additive congruence
relation containing `r`."]
theorem con_gen_mono {r s : M → M → Prop} (h : ∀ x y, r x y → s x y) :
  con_gen r ≤ con_gen s :=
con_gen_le $ λ x y hr, con_gen.rel.of _ _ $ h x y hr

/-- Congruence relations equal the smallest congruence relation in which they are contained. -/
@[simp, to_additive add_con_gen_of_add_con "Additive congruence relations equal the smallest
additive congruence relation in which they are contained."]
lemma con_gen_of_con (c : con M) : con_gen c = c :=
le_antisymm (by rw con_gen_eq; exact Inf_le (λ _ _, id)) con_gen.rel.of

/-- The map sending a binary relation to the smallest congruence relation in which it is
    contained is idempotent. -/
@[simp, to_additive add_con_gen_idem "The map sending a binary relation to the smallest additive
congruence relation in which it is contained is idempotent."]
lemma con_gen_idem (r : M → M → Prop) :
  con_gen (con_gen r) = con_gen r :=
con_gen_of_con _

/-- The supremum of congruence relations `c, d` equals the smallest congruence relation containing
    the binary relation '`x` is related to `y` by `c` or `d`'. -/
@[to_additive sup_eq_add_con_gen "The supremum of additive congruence relations `c, d` equals the
smallest additive congruence relation containing the binary relation '`x` is related to `y`
by `c` or `d`'."]
lemma sup_eq_con_gen (c d : con M) :
  c ⊔ d = con_gen (λ x y, c x y ∨ d x y) :=
begin
  rw con_gen_eq,
  apply congr_arg Inf,
  simp only [le_def, or_imp_distrib, ← forall_and_distrib]
end

/-- The supremum of two congruence relations equals the smallest congruence relation containing
    the supremum of the underlying binary operations. -/
@[to_additive "The supremum of two additive congruence relations equals the smallest additive
congruence relation containing the supremum of the underlying binary operations."]
lemma sup_def {c d : con M} : c ⊔ d = con_gen (c.r ⊔ d.r) :=
by rw sup_eq_con_gen; refl

/-- The supremum of a set of congruence relations `S` equals the smallest congruence relation
    containing the binary relation 'there exists `c ∈ S` such that `x` is related to `y` by
    `c`'. -/
@[to_additive Sup_eq_add_con_gen "The supremum of a set of additive congruence relations `S` equals
the smallest additive congruence relation containing the binary relation 'there exists `c ∈ S`
such that `x` is related to `y` by `c`'."]
lemma Sup_eq_con_gen (S : set (con M)) :
  Sup S = con_gen (λ x y, ∃ c : con M, c ∈ S ∧ c x y) :=
begin
  rw con_gen_eq,
  apply congr_arg Inf,
  ext,
  exact ⟨λ h _ _ ⟨r, hr⟩, h hr.1 hr.2,
         λ h r hS _ _ hr, h _ _ ⟨r, hS, hr⟩⟩,
end

/-- The supremum of a set of congruence relations is the same as the smallest congruence relation
    containing the supremum of the set's image under the map to the underlying binary relation. -/
@[to_additive "The supremum of a set of additive congruence relations is the same as the smallest
additive congruence relation containing the supremum of the set's image under the map to the
underlying binary relation."]
lemma Sup_def {S : set (con M)} : Sup S = con_gen (Sup (r '' S)) :=
begin
  rw [Sup_eq_con_gen, Sup_image],
  congr' with x y,
  simp only [Sup_image, supr_apply, supr_Prop_eq, exists_prop, rel_eq_coe]
end

variables (M)

/-- There is a Galois insertion of congruence relations on a type with a multiplication `M` into
    binary relations on `M`. -/
@[to_additive "There is a Galois insertion of additive congruence relations on a type with
an addition `M` into binary relations on `M`."]
protected noncomputable def gi : @galois_insertion (M → M → Prop) (con M) _ _ con_gen r :=
{ choice := λ r h, con_gen r,
  gc := λ r c, ⟨λ H _ _ h, H $ con_gen.rel.of _ _ h, λ H, con_gen_of_con c ▸ con_gen_mono H⟩,
  le_l_u := λ x, (con_gen_of_con x).symm ▸ le_refl x,
  choice_eq := λ _ _, rfl }

variables {M} (c)

/-- Given a function `f`, the smallest congruence relation containing the binary relation on `f`'s
    image defined by '`x ≈ y` iff the elements of `f⁻¹(x)` are related to the elements of `f⁻¹(y)`
    by a congruence relation `c`.' -/
@[to_additive "Given a function `f`, the smallest additive congruence relation containing the
binary relation on `f`'s image defined by '`x ≈ y` iff the elements of `f⁻¹(x)` are related to the
elements of `f⁻¹(y)` by an additive congruence relation `c`.'"]
def map_gen (f : M → N) : con N :=
con_gen $ λ x y, ∃ a b, f a = x ∧ f b = y ∧ c a b

/-- Given a surjective multiplicative-preserving function `f` whose kernel is contained in a
    congruence relation `c`, the congruence relation on `f`'s codomain defined by '`x ≈ y` iff the
    elements of `f⁻¹(x)` are related to the elements of `f⁻¹(y)` by `c`.' -/
@[to_additive "Given a surjective addition-preserving function `f` whose kernel is contained in
an additive congruence relation `c`, the additive congruence relation on `f`'s codomain defined
by '`x ≈ y` iff the elements of `f⁻¹(x)` are related to the elements of `f⁻¹(y)` by `c`.'"]
def map_of_surjective (f : M → N) (H : ∀ x y, f (x * y) = f x * f y) (h : mul_ker f H ≤ c)
  (hf : surjective f) : con N :=
{ mul' := λ w x y z ⟨a, b, hw, hx, h1⟩ ⟨p, q, hy, hz, h2⟩,
    ⟨a * p, b * q, by rw [H, hw, hy], by rw [H, hx, hz], c.mul h1 h2⟩,
  ..c.to_setoid.map_of_surjective f h hf }

/-- A specialization of 'the smallest congruence relation containing a congruence relation `c`
    equals `c`'. -/
@[to_additive "A specialization of 'the smallest additive congruence relation containing
an additive congruence relation `c` equals `c`'."]
lemma map_of_surjective_eq_map_gen {c : con M} {f : M → N} (H : ∀ x y, f (x * y) = f x * f y)
  (h : mul_ker f H ≤ c) (hf : surjective f) :
  c.map_gen f = c.map_of_surjective f H h hf :=
by rw ←con_gen_of_con (c.map_of_surjective f H h hf); refl

/-- Given types with multiplications `M, N` and a congruence relation `c` on `N`, a
    multiplication-preserving map `f : M → N` induces a congruence relation on `f`'s domain
    defined by '`x ≈ y` iff `f(x)` is related to `f(y)` by `c`.' -/
@[to_additive "Given types with additions `M, N` and an additive congruence relation `c` on `N`,
an addition-preserving map `f : M → N` induces an additive congruence relation on `f`'s domain
defined by '`x ≈ y` iff `f(x)` is related to `f(y)` by `c`.' "]
def comap (f : M → N) (H : ∀ x y, f (x * y) = f x * f y) (c : con N) : con M :=
{ mul' := λ w x y z h1 h2, show c (f (w * y)) (f (x * z)), by rw [H, H]; exact c.mul h1 h2,
  ..c.to_setoid.comap f }

section
open quotient

/-- Given a congruence relation `c` on a type `M` with a multiplication, the order-preserving
    bijection between the set of congruence relations containing `c` and the congruence relations
    on the quotient of `M` by `c`. -/
@[to_additive "Given an additive congruence relation `c` on a type `M` with an addition,
the order-preserving bijection between the set of additive congruence relations containing `c` and
the additive congruence relations on the quotient of `M` by `c`."]
def correspondence : {d // c ≤ d} ≃o (con c.quotient) :=
{ to_fun := λ d, d.1.map_of_surjective coe _
    (by rw mul_ker_mk_eq; exact d.2) $ @exists_rep _ c.to_setoid,
  inv_fun := λ d, ⟨comap (coe : M → c.quotient) (λ x y, rfl) d, λ _ _ h,
    show d _ _, by rw c.eq.2 h; exact d.refl _ ⟩,
  left_inv := λ d, subtype.ext_iff_val.2 $ ext $ λ _ _,
    ⟨λ h, let ⟨a, b, hx, hy, H⟩ := h in
      d.1.trans (d.1.symm $ d.2 $ c.eq.1 hx) $ d.1.trans H $ d.2 $ c.eq.1 hy,
     λ h, ⟨_, _, rfl, rfl, h⟩⟩,
  right_inv := λ d, let Hm : mul_ker (coe : M → c.quotient) (λ x y, rfl) ≤
        comap (coe : M → c.quotient) (λ x y, rfl) d :=
      λ x y h, show d _ _, by rw mul_ker_mk_eq at h; exact c.eq.2 h ▸ d.refl _ in
    ext $ λ x y, ⟨λ h, let ⟨a, b, hx, hy, H⟩ := h in hx ▸ hy ▸ H,
      con.induction_on₂ x y $ λ w z h, ⟨w, z, rfl, rfl, h⟩⟩,
  map_rel_iff' := λ s t, ⟨λ h _ _ hs, let ⟨a, b, hx, hy, ht⟩ := h ⟨_, _, rfl, rfl, hs⟩ in
      t.1.trans (t.1.symm $ t.2 $ eq_rel.1 hx) $ t.1.trans ht $ t.2 $ eq_rel.1 hy,
      λ h _ _ hs, let ⟨a, b, hx, hy, Hs⟩ := hs in ⟨a, b, hx, hy, h Hs⟩⟩ }

end

end

section mul_one_class

variables {M} [mul_one_class M] [mul_one_class N] [mul_one_class P] (c : con M)

/-- The quotient of a monoid by a congruence relation is a monoid. -/
@[to_additive "The quotient of an `add_monoid` by an additive congruence relation is
an `add_monoid`."]
instance mul_one_class : mul_one_class c.quotient :=
{ one := ((1 : M) : c.quotient),
  mul := (*),
  mul_one := λ x, quotient.induction_on' x $ λ _, congr_arg coe $ mul_one _,
  one_mul := λ x, quotient.induction_on' x $ λ _, congr_arg coe $ one_mul _ }

variables {c}

/-- The 1 of the quotient of a monoid by a congruence relation is the equivalence class of the
    monoid's 1. -/
@[simp, to_additive "The 0 of the quotient of an `add_monoid` by an additive congruence relation
is the equivalence class of the `add_monoid`'s 0."]
lemma coe_one : ((1 : M) : c.quotient) = 1 := rfl

variables (M c)

/-- The submonoid of `M × M` defined by a congruence relation on a monoid `M`. -/
@[to_additive "The `add_submonoid` of `M × M` defined by an additive congruence
relation on an `add_monoid` `M`."]
protected def submonoid : submonoid (M × M) :=
{ carrier := { x | c x.1 x.2 },
  one_mem' := c.iseqv.1 1,
  mul_mem' := λ _ _, c.mul }

variables {M c}

/-- The congruence relation on a monoid `M` from a submonoid of `M × M` for which membership
    is an equivalence relation. -/
@[to_additive "The additive congruence relation on an `add_monoid` `M` from
an `add_submonoid` of `M × M` for which membership is an equivalence relation."]
def of_submonoid (N : submonoid (M × M)) (H : equivalence (λ x y, (x, y) ∈ N)) : con M :=
{ r := λ x y, (x, y) ∈ N,
  iseqv := H,
  mul' := λ _ _ _ _, N.mul_mem }

/-- Coercion from a congruence relation `c` on a monoid `M` to the submonoid of `M × M` whose
    elements are `(x, y)` such that `x` is related to `y` by `c`. -/
@[to_additive "Coercion from a congruence relation `c` on an `add_monoid` `M`
to the `add_submonoid` of `M × M` whose elements are `(x, y)` such that `x`
is related to `y` by `c`."]
instance to_submonoid : has_coe (con M) (submonoid (M × M)) := ⟨λ c, c.submonoid M⟩

@[to_additive] lemma mem_coe {c : con M} {x y} :
  (x, y) ∈ (↑c : submonoid (M × M)) ↔ (x, y) ∈ c := iff.rfl

@[to_additive]
theorem to_submonoid_inj (c d : con M) (H : (c : submonoid (M × M)) = d) : c = d :=
ext $ λ x y, show (x, y) ∈ (c : submonoid (M × M)) ↔ (x, y) ∈ ↑d, by rw H

@[to_additive]
lemma le_iff {c d : con M} : c ≤ d ↔ (c : submonoid (M × M)) ≤ d :=
⟨λ h x H, h H, λ h x y hc, h $ show (x, y) ∈ c, from hc⟩

/-- The kernel of a monoid homomorphism as a congruence relation. -/
@[to_additive "The kernel of an `add_monoid` homomorphism as an additive congruence relation."]
def ker (f : M →* P) : con M := mul_ker f f.3

/-- The definition of the congruence relation defined by a monoid homomorphism's kernel. -/
@[to_additive "The definition of the additive congruence relation defined by an `add_monoid`
homomorphism's kernel."]
lemma ker_rel (f : M →* P) {x y} : ker f x y ↔ f x = f y := iff.rfl

/-- There exists an element of the quotient of a monoid by a congruence relation (namely 1). -/
@[to_additive "There exists an element of the quotient of an `add_monoid` by a congruence relation
(namely 0)."]
instance quotient.inhabited : inhabited c.quotient := ⟨((1 : M) : c.quotient)⟩

variables (c)

/-- The natural homomorphism from a monoid to its quotient by a congruence relation. -/
@[to_additive "The natural homomorphism from an `add_monoid` to its quotient by an additive
congruence relation."]
def mk' : M →* c.quotient := ⟨coe, rfl, λ _ _, rfl⟩

variables (x y : M)

/-- The kernel of the natural homomorphism from a monoid to its quotient by a congruence
    relation `c` equals `c`. -/
@[simp, to_additive "The kernel of the natural homomorphism from an `add_monoid` to its quotient by
an additive congruence relation `c` equals `c`."]
lemma mk'_ker : ker c.mk' = c := ext $ λ _ _, c.eq

variables {c}

/-- The natural homomorphism from a monoid to its quotient by a congruence relation is
    surjective. -/
@[to_additive "The natural homomorphism from an `add_monoid` to its quotient by a congruence
relation is surjective."]
lemma mk'_surjective : surjective c.mk' :=
λ x, by rcases x; exact ⟨x, rfl⟩

@[simp, to_additive] lemma comp_mk'_apply (g : c.quotient →* P) {x} :
  g.comp c.mk' x = g x := rfl

/-- The elements related to `x ∈ M`, `M` a monoid, by the kernel of a monoid homomorphism are
    those in the preimage of `f(x)` under `f`. -/
@[to_additive "The elements related to `x ∈ M`, `M` an `add_monoid`, by the kernel of
an `add_monoid` homomorphism are those in the preimage of `f(x)` under `f`. "]
lemma ker_apply_eq_preimage {f : M →* P} (x) : (ker f) x = f ⁻¹' {f x} :=
set.ext $ λ x,
  ⟨λ h, set.mem_preimage.2 $ set.mem_singleton_iff.2 h.symm,
   λ h, (set.mem_singleton_iff.1 $ set.mem_preimage.1 h).symm⟩

/-- Given a monoid homomorphism `f : N → M` and a congruence relation `c` on `M`, the congruence
    relation induced on `N` by `f` equals the kernel of `c`'s quotient homomorphism composed with
    `f`. -/
@[to_additive "Given an `add_monoid` homomorphism `f : N → M` and an additive congruence relation
`c` on `M`, the additive congruence relation induced on `N` by `f` equals the kernel of `c`'s
quotient homomorphism composed with `f`."]
lemma comap_eq {f : N →* M} : comap f f.map_mul c = ker (c.mk'.comp f) :=
ext $ λ x y, show c _ _ ↔ c.mk' _ = c.mk' _, by rw ←c.eq; refl

variables (c) (f : M →* P)

/-- The homomorphism on the quotient of a monoid by a congruence relation `c` induced by a
    homomorphism constant on `c`'s equivalence classes. -/
@[to_additive "The homomorphism on the quotient of an `add_monoid` by an additive congruence
relation `c` induced by a homomorphism constant on `c`'s equivalence classes."]
def lift (H : c ≤ ker f) : c.quotient →* P :=
{ to_fun := λ x, con.lift_on x f $ λ _ _ h, H h,
  map_one' := by rw ←f.map_one; refl,
  map_mul' := λ x y, con.induction_on₂ x y $ λ m n, f.map_mul m n ▸ rfl }

variables {c f}

/-- The diagram describing the universal property for quotients of monoids commutes. -/
@[simp, to_additive "The diagram describing the universal property for quotients of `add_monoid`s
commutes."]
lemma lift_mk' (H : c ≤ ker f) (x) :
  c.lift f H (c.mk' x) = f x := rfl

/-- The diagram describing the universal property for quotients of monoids commutes. -/
@[simp, to_additive "The diagram describing the universal property for quotients of `add_monoid`s
commutes."]
lemma lift_coe (H : c ≤ ker f) (x : M) :
  c.lift f H x = f x := rfl

/-- The diagram describing the universal property for quotients of monoids commutes. -/
@[simp, to_additive "The diagram describing the universal property for quotients of `add_monoid`s
commutes."]
theorem lift_comp_mk' (H : c ≤ ker f) :
  (c.lift f H).comp c.mk' = f := by ext; refl

/-- Given a homomorphism `f` from the quotient of a monoid by a congruence relation, `f` equals the
    homomorphism on the quotient induced by `f` composed with the natural map from the monoid to
    the quotient. -/
@[simp, to_additive "Given a homomorphism `f` from the quotient of an `add_monoid` by an additive
congruence relation, `f` equals the homomorphism on the quotient induced by `f` composed with the
natural map from the `add_monoid` to the quotient."]
lemma lift_apply_mk' (f : c.quotient →* P) :
  c.lift (f.comp c.mk') (λ x y h, show f ↑x = f ↑y, by rw c.eq.2 h) = f :=
by ext; rcases x; refl

/-- Homomorphisms on the quotient of a monoid by a congruence relation are equal if they
    are equal on elements that are coercions from the monoid. -/
@[to_additive "Homomorphisms on the quotient of an `add_monoid` by an additive congruence relation
are equal if they are equal on elements that are coercions from the `add_monoid`."]
lemma lift_funext (f g : c.quotient →* P) (h : ∀ a : M, f a = g a) : f = g :=
begin
  rw [←lift_apply_mk' f, ←lift_apply_mk' g],
  congr' 1,
  exact monoid_hom.ext_iff.2 h,
end

/-- The uniqueness part of the universal property for quotients of monoids. -/
@[to_additive "The uniqueness part of the universal property for quotients of `add_monoid`s."]
theorem lift_unique (H : c ≤ ker f) (g : c.quotient →* P)
  (Hg : g.comp c.mk' = f) : g = c.lift f H :=
lift_funext g (c.lift f H) $ λ x, by rw [lift_coe H, ←comp_mk'_apply, Hg]

/-- Given a congruence relation `c` on a monoid and a homomorphism `f` constant on `c`'s
    equivalence classes, `f` has the same image as the homomorphism that `f` induces on the
    quotient. -/
@[to_additive "Given an additive congruence relation `c` on an `add_monoid` and a homomorphism `f`
constant on `c`'s equivalence classes, `f` has the same image as the homomorphism that `f` induces
on the quotient."]
theorem lift_range (H : c ≤ ker f) : (c.lift f H).mrange = f.mrange :=
submonoid.ext $ λ x, ⟨by rintros ⟨⟨y⟩, hy⟩; exact ⟨y, hy⟩, λ ⟨y, hy⟩, ⟨↑y, hy⟩⟩

/-- Surjective monoid homomorphisms constant on a congruence relation `c`'s equivalence classes
    induce a surjective homomorphism on `c`'s quotient. -/
@[to_additive "Surjective `add_monoid` homomorphisms constant on an additive congruence
relation `c`'s equivalence classes induce a surjective homomorphism on `c`'s quotient."]
lemma lift_surjective_of_surjective (h : c ≤ ker f) (hf : surjective f) :
  surjective (c.lift f h) :=
λ y, exists.elim (hf y) $ λ w hw, ⟨w, (lift_mk' h w).symm ▸ hw⟩

variables (c f)

/-- Given a monoid homomorphism `f` from `M` to `P`, the kernel of `f` is the unique congruence
    relation on `M` whose induced map from the quotient of `M` to `P` is injective. -/
@[to_additive "Given an `add_monoid` homomorphism `f` from `M` to `P`, the kernel of `f`
is the unique additive congruence relation on `M` whose induced map from the quotient of `M`
to `P` is injective."]
lemma ker_eq_lift_of_injective (H : c ≤ ker f) (h : injective (c.lift f H)) :
  ker f = c :=
to_setoid_inj $ ker_eq_lift_of_injective f H h

variables {c}

/-- The homomorphism induced on the quotient of a monoid by the kernel of a monoid homomorphism. -/
@[to_additive "The homomorphism induced on the quotient of an `add_monoid` by the kernel
of an `add_monoid` homomorphism."]
def ker_lift : (ker f).quotient →* P :=
(ker f).lift f $ λ _ _, id

variables {f}

/-- The diagram described by the universal property for quotients of monoids, when the congruence
    relation is the kernel of the homomorphism, commutes. -/
@[simp, to_additive "The diagram described by the universal property for quotients
of `add_monoid`s, when the additive congruence relation is the kernel of the homomorphism,
commutes."]
lemma ker_lift_mk (x : M) :  ker_lift f x = f x := rfl

/-- Given a monoid homomorphism `f`, the induced homomorphism on the quotient by `f`'s kernel has
    the same image as `f`. -/
@[simp, to_additive "Given an `add_monoid` homomorphism `f`, the induced homomorphism
on the quotient by `f`'s kernel has the same image as `f`."]
lemma ker_lift_range_eq : (ker_lift f).mrange = f.mrange :=
lift_range $ λ _ _, id

/-- A monoid homomorphism `f` induces an injective homomorphism on the quotient by `f`'s kernel. -/
@[to_additive "An `add_monoid` homomorphism `f` induces an injective homomorphism on the quotient
by `f`'s kernel."]
lemma ker_lift_injective (f : M →* P) : injective (ker_lift f) :=
λ x y, quotient.induction_on₂' x y $ λ _ _, (ker f).eq.2

/-- Given congruence relations `c, d` on a monoid such that `d` contains `c`, `d`'s quotient
    map induces a homomorphism from the quotient by `c` to the quotient by `d`. -/
@[to_additive "Given additive congruence relations `c, d` on an `add_monoid` such that `d`
contains `c`, `d`'s quotient map induces a homomorphism from the quotient by `c` to the quotient
by `d`."]
def map (c d : con M) (h : c ≤ d) : c.quotient →* d.quotient :=
c.lift d.mk' $ λ x y hc, show (ker d.mk') x y, from
  (mk'_ker d).symm ▸ h hc

/-- Given congruence relations `c, d` on a monoid such that `d` contains `c`, the definition of
    the homomorphism from the quotient by `c` to the quotient by `d` induced by `d`'s quotient
    map. -/
@[to_additive "Given additive congruence relations `c, d` on an `add_monoid` such that `d`
contains `c`, the definition of the homomorphism from the quotient by `c` to the quotient by `d`
induced by `d`'s quotient map."]
lemma map_apply {c d : con M} (h : c ≤ d) (x) :
  c.map d h x = c.lift d.mk' (λ x y hc, d.eq.2 $ h hc) x := rfl

variables (c)

/-- The first isomorphism theorem for monoids. -/
@[to_additive "The first isomorphism theorem for `add_monoid`s."]
noncomputable def quotient_ker_equiv_range (f : M →* P) : (ker f).quotient ≃* f.mrange :=
{ map_mul' := monoid_hom.map_mul _,
  ..equiv.of_bijective
      ((@mul_equiv.to_monoid_hom (ker_lift f).mrange _ _ _
        $ mul_equiv.submonoid_congr ker_lift_range_eq).comp (ker_lift f).mrange_restrict) $
      (equiv.bijective _).comp
        ⟨λ x y h, ker_lift_injective f $ by rcases x; rcases y; injections,
         λ ⟨w, z, hz⟩, ⟨z, by rcases hz; rcases _x; refl⟩⟩ }

/-- The first isomorphism theorem for monoids in the case of a surjective homomorphism. -/
@[to_additive "The first isomorphism theorem for `add_monoid`s in the case of a surjective
homomorphism."]
noncomputable def quotient_ker_equiv_of_surjective (f : M →* P) (hf : surjective f) :
  (ker f).quotient ≃* P :=
{ map_mul' := monoid_hom.map_mul _,
  ..equiv.of_bijective (ker_lift f)
      ⟨ker_lift_injective f, lift_surjective_of_surjective (le_refl _) hf⟩ }

/-- The second isomorphism theorem for monoids. -/
@[to_additive "The second isomorphism theorem for `add_monoid`s."]
noncomputable def comap_quotient_equiv (f : N →* M) :
  (comap f f.map_mul c).quotient ≃* (c.mk'.comp f).mrange :=
(con.congr comap_eq).trans $ quotient_ker_equiv_range $ c.mk'.comp f

/-- The third isomorphism theorem for monoids. -/
@[to_additive "The third isomorphism theorem for `add_monoid`s."]
def quotient_quotient_equiv_quotient (c d : con M) (h : c ≤ d) :
  (ker (c.map d h)).quotient ≃* d.quotient :=
{ map_mul' := λ x y, con.induction_on₂ x y $ λ w z, con.induction_on₂ w z $ λ a b,
    show _ = d.mk' a * d.mk' b, by rw ←d.mk'.map_mul; refl,
  ..quotient_quotient_equiv_quotient c.to_setoid d.to_setoid h }

end mul_one_class

section monoids

/-- The quotient of a monoid by a congruence relation is a monoid. -/
@[to_additive "The quotient of an `add_monoid` by an additive congruence relation is
an `add_monoid`."]
instance monoid {M : Type*} [monoid M] (c : con M): monoid c.quotient :=
{ one := ((1 : M) : c.quotient),
  mul := (*),
  mul_assoc := λ x y z, quotient.induction_on₃' x y z
               $ λ _ _ _, congr_arg coe $ mul_assoc _ _ _,
  .. c.mul_one_class }

/-- The quotient of a `comm_monoid` by a congruence relation is a `comm_monoid`. -/
@[to_additive "The quotient of an `add_comm_monoid` by an additive congruence
relation is an `add_comm_monoid`."]
instance comm_monoid {M : Type*} [comm_monoid M] (c : con M) :
  comm_monoid c.quotient :=
{ mul_comm := λ x y, con.induction_on₂ x y $ λ w z, by rw [←coe_mul, ←coe_mul, mul_comm],
  ..c.monoid}

end monoids

section groups

variables {M} [group M] [group N] [group P] (c : con M)

/-- Multiplicative congruence relations preserve inversion. -/
@[to_additive "Additive congruence relations preserve negation."]
protected lemma inv : ∀ {w x}, c w x → c w⁻¹ x⁻¹ :=
λ x y h, by simpa using c.symm (c.mul (c.mul (c.refl x⁻¹) h) (c.refl y⁻¹))

/-- The inversion induced on the quotient by a congruence relation on a type with a
    inversion. -/
@[to_additive "The negation induced on the quotient by an additive congruence relation on a type
with an negation."]
instance has_inv : has_inv c.quotient :=
⟨λ x, quotient.lift_on' x (λ w, ((w⁻¹ : M) : c.quotient))
     $ λ x y h, c.eq.2 $ c.inv h⟩

/-- The quotient of a group by a congruence relation is a group. -/
@[to_additive "The quotient of an `add_group` by an additive congruence relation is
an `add_group`."]
instance group : group c.quotient :=
{ inv := λ x, x⁻¹,
  mul_left_inv := λ x, show x⁻¹ * x = 1,
    from quotient.induction_on' x $ λ _, congr_arg coe $ mul_left_inv _,
  .. con.monoid c}

end groups

end con


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.module.equiv
import group_theory.group_action.opposite

/-!
# Module operations on `Mᵐᵒᵖ`

This file contains definitions that build on top of the group action definitions in
`group_theory.group_action.opposite`.
-/

namespace mul_opposite
universes u v

variables (R : Type u) {M : Type v} [semiring R] [add_comm_monoid M] [module R M]

/-- `mul_opposite.distrib_mul_action` extends to a `module` -/
instance : module R (mul_opposite M) :=
{ add_smul := λ r₁ r₂ x, unop_injective $ add_smul r₁ r₂ (unop x),
  zero_smul := λ x, unop_injective $ zero_smul _ (unop x),
  ..mul_opposite.distrib_mul_action M R }

/-- The function `op` is a linear equivalence. -/
def op_linear_equiv : M ≃ₗ[R] Mᵐᵒᵖ :=
{ map_smul' := mul_opposite.op_smul, .. op_add_equiv }

@[simp] lemma coe_op_linear_equiv :
  (op_linear_equiv R : M → Mᵐᵒᵖ) = op := rfl
@[simp] lemma coe_op_linear_equiv_symm :
  ((op_linear_equiv R).symm : Mᵐᵒᵖ → M) = unop := rfl

@[simp]

@[simp] lemma op_linear_equiv_to_add_equiv :
  (op_linear_equiv R : M ≃ₗ[R] Mᵐᵒᵖ).to_add_equiv = op_add_equiv := rfl
@[simp] lemma op_linear_equiv_symm_to_add_equiv :
  (op_linear_equiv R : M ≃ₗ[R] Mᵐᵒᵖ).symm.to_add_equiv = op_add_equiv.symm := rfl

end mul_opposite


/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import adeles_R

/-!
# The finite idèle group of a Dedekind domain
We define the finite idèle group of a Dedekind domain `R` and show that if `R` has Krull dimension
1, then there is an injective group homomorphism from the units of the field of fractions of `R` to
its finite adèle ring.

We prove that there is a continuous surjective group homomorphism from the finite idèle group of `R`
to the group of invertible fractional ideals of `R` and compute the kernel of this map.

## Main definitions
- `finite_idele_group'` : The finite idèle group of `R`, defined as unit group of `A_R_f R`.
- `inj_units_K` : The diagonal inclusion of `K*` in `finite_idele_group' R K`.
- `map_to_fractional_ideals` : The group homomorphism from `finite_idele_group' R K` to the group
  of `Fr(R)` of invertible fractional_ideals of `R` sending a finite idèle `x` to the product
  `∏_v v^(val_v(x_v))`, where `val_v` denotes the additive `v`-adic valuation.

## Main results
- `inj_units_K.group_hom` : `inj_units_K` is a group homomorphism.
- `inj_units_K.injective` : `inj_units_K` is injective for every Dedekind domain of Krull
  dimension 1.
- `map_to_fractional_ideals.surjective` : `map_to_fractional_ideals` is surjective.
- `map_to_fractional_ideals.continuous` : `map_to_fractional_ideals` is continuous when the group
  of fractional ideals is given the discrete topology.
- `map_to_fractional_ideals.mem_kernel_iff` : A finite idèle `x` is in the kernel of
`map_to_fractional_ideals` if and only if `|x_v|_v = 1` for all `v`.

## Implementation notes
As in `adeles_R`, we are only interested on Dedekind domains of Krull dimension 1.

## References
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]

## Tags
finite idèle group, dedekind domain, fractional ideal
-/

noncomputable theory
open_locale big_operators classical

variables (R : Type) (K : Type) [comm_ring R] [is_domain R] [is_dedekind_domain R] [field K]
  [algebra R K] [is_fraction_ring R K] (v : maximal_spectrum R)

open set function

/-! ### The finite idèle group of a Dedekind domain -/

/--The finite idèle group of `R` is the unit group of its finite adèle ring. -/
def finite_idele_group' := units (finite_adele_ring' R K)

instance : topological_space (finite_idele_group' R K) := units.topological_space
instance : comm_group (finite_idele_group' R K) := units.comm_group
instance : inhabited (finite_idele_group' R K) := ⟨1⟩
instance : topological_group (finite_idele_group' R K) := units.topological_group
instance : uniform_space (finite_idele_group' R K) := topological_group.to_uniform_space _
instance : uniform_group (finite_idele_group' R K) := topological_group_is_uniform

lemma right_inv (x : units K) : inj_K R K x.val * inj_K R K x.inv = 1 :=
begin
  rw [← inj_K.map_mul, units.val_eq_coe, units.inv_eq_coe_inv, units.mul_inv],
  exact inj_K.map_one R K
end

lemma left_inv (x : units K) : inj_K R K x.inv * inj_K R K x.val = 1 :=
by rw [mul_comm, right_inv]

/-- The diagonal inclusion `k ↦ (k)_v` of `K*` into the finite idèle group of `R`. -/
def inj_units_K : units K → finite_idele_group' R K :=
λ x, ⟨inj_K R K x.val, inj_K R K x.inv, right_inv R K x, left_inv R K x⟩

@[simp]
lemma inj_units_K.map_one : inj_units_K R K 1 = 1 :=
by {rw inj_units_K, simp only [inj_K.map_one], refl,}

@[simp]
lemma inj_units_K.map_mul (x y : units K) :
  inj_units_K R K (x*y) = (inj_units_K R K x) * (inj_units_K R K y) :=
begin
  rw inj_units_K, ext v,
  simp_rw [units.val_eq_coe, units.coe_mul, units.coe_mk, inj_K.map_mul],
end

/-- The map `inj_units_K` is a group homomorphism. -/
def inj_units_K.group_hom : monoid_hom (units K) (finite_idele_group' R K) :=
{ to_fun   := inj_units_K R K,
  map_one' := inj_units_K.map_one R K,
  map_mul' := inj_units_K.map_mul R K, }

/-- If `maximal_spectrum R` is nonempty, then `inj_units_K` is injective. Note that the nonemptiness
hypothesis is satisfied for every Dedekind domain that is not a field. -/
lemma inj_units_K.injective [inh : nonempty (maximal_spectrum R)] :
  injective (inj_units_K.group_hom R K) :=
begin
  rw ← monoid_hom.ker_eq_bot_iff,
  ext x,
  rw [monoid_hom.mem_ker, subgroup.mem_bot, inj_units_K.group_hom, monoid_hom.coe_mk, inj_units_K,
    ← units.eq_iff, units.coe_mk, units.val_eq_coe],
  rw ← units.eq_iff,
  exact injective.eq_iff (inj_K.injective R K),
end

lemma prod_val_inv_eq_one (x : finite_idele_group' R K) :
  (x.val.val v) * (x.inv.val v) = 1  :=
begin
  rw [ ← pi.mul_apply, mul_apply_val, units.val_inv, subtype.val_eq_coe, ← one_def,
    subtype.coe_mk, pi.one_apply],
end

lemma v_comp.ne_zero (x : finite_idele_group' R K) :
  (x.val.val v) ≠ 0 := left_ne_zero_of_mul_eq_one (prod_val_inv_eq_one R K v x)

lemma valuation_val_inv (x : finite_idele_group' R K) :
  (valued.v (x.val.val v) : (with_zero (multiplicative ℤ))) * (valued.v (x.inv.val v)) = 1 :=
by rw [← valuation.map_mul, prod_val_inv_eq_one, valuation.map_one]

lemma valuation_inv (x : finite_idele_group' R K) :
  (valued.v (x.inv.val v)) = (valued.v (x.val.val v))⁻¹ :=
begin
  rw [← mul_one (valued.v (x.val.val v))⁻¹,eq_inv_mul_iff_mul_eq₀, valuation_val_inv],
  { exact (valuation.ne_zero_iff _).mpr (v_comp.ne_zero R K v x) }
end

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
`x_v ∉ R_v` or `x⁻¹_v ∉ R_v`. -/
lemma restricted_product (x : finite_idele_group' R K) :
  finite ({ v : maximal_spectrum R | (¬ (x.val.val v) ∈ v.adic_completion_integers K) } ∪
    { v : maximal_spectrum R | ¬ (x.inv.val v) ∈ v.adic_completion_integers K }) :=
finite.union x.val.property x.inv.property

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
`|x_v|_v ≠ 1`. -/
lemma finite_exponents (x : finite_idele_group' R K) : finite
  { v : maximal_spectrum R | (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) ≠ 1 } :=
begin
  have h_subset : { v : maximal_spectrum R |
    (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) ≠ 1 } ⊆
  { v : maximal_spectrum R | ¬ (x.val.val v) ∈ v.adic_completion_integers K } ∪
  { v : maximal_spectrum R | ¬ (x.inv.val v) ∈ v.adic_completion_integers K },
  { intros v hv,
    rw [mem_union, mem_set_of_eq, mem_set_of_eq, adic_completion.is_integer,
      adic_completion.is_integer],
    rw mem_set_of_eq at hv,
    cases (lt_or_gt_of_ne hv) with hlt hgt,
    { right,
      have h_one : (valued.v (x.val.val v) : (with_zero (multiplicative ℤ))) *
        (valued.v (x.inv.val v)) = 1 :=valuation_val_inv R K v x,
      have h_inv : (1 : with_zero (multiplicative ℤ)) < (valued.v (x.inv.val v)),
      { have hx : (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) ≠ 0,
        { rw [valuation.ne_zero_iff],
          exact left_ne_zero_of_mul_eq_one (prod_val_inv_eq_one R K v x),},
        rw mul_eq_one_iff_inv_eq₀ hx at h_one,
        rw [← h_one, ← with_zero.inv_one, inv_lt_inv₀ (ne.symm zero_ne_one) hx],
        exact hlt, },
      exact not_le.mpr h_inv,},
    { left, exact not_le.mpr hgt, }},
  exact finite.subset (restricted_product R K x) h_subset,
end

/-- For any `k ∈ K*` and any maximal ideal `v` of `R`, the valuation `|k|_v` is nonzero. -/
lemma units.valuation_ne_zero {k : K} (hk : k ≠ 0) :
(valued.v ((coe : K → (v.adic_completion K)) k) : with_zero (multiplicative ℤ)) ≠ 0 :=
begin
  rw [valuation.ne_zero_iff, ← uniform_space.completion.coe_zero,
    injective.ne_iff uniform_space.completion.coe_inj],
  exact hk,
  apply_instance,
end

/-- The integer number corresponding to a nonzero `x` in `with_zero (multiplicative ℤ)`. -/
def with_zero.to_integer {x : with_zero (multiplicative ℤ)} (hx : x ≠ 0) : ℤ :=
multiplicative.to_add (classical.some (with_zero.ne_zero_iff_exists.mp hx))

/-- Given a finite idèle `x`, for each maximal ideal `v` of `R` we obtain an integer that
represents the additive `v`-adic valuation of the component `x_v` of `x`. -/
def finite_idele.to_add_valuations (x : finite_idele_group' R K) : Π (v : maximal_spectrum R), ℤ :=
λ v, -(with_zero.to_integer ((valuation.ne_zero_iff valued.v).mpr (v_comp.ne_zero R K v x)))

lemma finite_idele.to_add_valuations.map_one :
  finite_idele.to_add_valuations R K (1 : finite_idele_group' R K) =
    λ (v : maximal_spectrum R), (0 : ℤ) :=
begin
  rw finite_idele.to_add_valuations,
  ext v,
  rw [with_zero.to_integer, ← to_add_one, ← to_add_inv],
  apply congr_arg multiplicative.to_add,
  rw [inv_eq_one, ← with_zero.coe_inj, classical.some_spec
  (with_zero.to_integer._proof_1 (finite_idele.to_add_valuations._proof_1 R K 1 v))],
  exact valuation.map_one _,
end

lemma finite_idele.to_add_valuations.map_mul (x y : finite_idele_group' R K) :
finite_idele.to_add_valuations R K (x * y) =
(finite_idele.to_add_valuations R K x) + (finite_idele.to_add_valuations R K y) :=
begin
  rw [finite_idele.to_add_valuations, finite_idele.to_add_valuations,
    finite_idele.to_add_valuations],
  ext v,
  simp only [pi.add_apply],
  rw [← neg_add, neg_inj, with_zero.to_integer, with_zero.to_integer, with_zero.to_integer,
    ← to_add_mul],
  apply congr_arg,
  rw [← with_zero.coe_inj, with_zero.coe_mul,
    classical.some_spec (with_zero.to_integer._proof_1 _),
    classical.some_spec (with_zero.to_integer._proof_1 _),
    classical.some_spec (with_zero.to_integer._proof_1 _)],
  exact valuation.map_mul valued.v _ _,
end

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
the additive `v`-adic valuation of `x_v` is nonzero. -/
lemma finite_add_support (x : finite_idele_group' R K ) :
  ∀ᶠ (v : maximal_spectrum R) in filter.cofinite, finite_idele.to_add_valuations R K x v = 0 :=
begin
  have h := finite_exponents R K x,
  rw finite_idele.to_add_valuations,
  simp_rw [neg_eq_zero, with_zero.to_integer],
  have h_subset : {v : maximal_spectrum R | ¬multiplicative.to_add (classical.some
    (with_zero.to_integer._proof_1 ((valued.v.ne_zero_iff ).mpr (v_comp.ne_zero R K v x)))) = 0}
    ⊆ {v : maximal_spectrum R | (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) ≠ 1},
  { intros v hv,
    set y := (classical.some (with_zero.to_integer._proof_1
      ((valued.v.ne_zero_iff ).mpr (v_comp.ne_zero R K v x)))) with hy,
    rw mem_set_of_eq,
    by_contradiction h,
    have y_spec := classical.some_spec
      (with_zero.to_integer._proof_1 ((valued.v.ne_zero_iff ).mpr (v_comp.ne_zero R K v x))),
    rw [← hy, h, ← with_zero.coe_one, with_zero.coe_inj] at y_spec,
    simp_rw [← to_add_one] at hv,
    rw [mem_set_of_eq, ← hy, y_spec] at hv,
    exact hv (eq.refl _), },
  exact finite.subset (finite_exponents R K x) h_subset,
end

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
`v^(finite_idele.to_add_valuations R K x v)` is not the fractional ideal `(1)`.  -/
lemma finite_support (x : finite_idele_group' R K ) : (mul_support (λ (v : maximal_spectrum R),
  (v.as_ideal :
    fractional_ideal (non_zero_divisors R) K) ^ finite_idele.to_add_valuations R K x v)).finite :=
begin
  have h_subset :
    {v : maximal_spectrum R | (v.as_ideal : fractional_ideal (non_zero_divisors R) K) ^
      finite_idele.to_add_valuations R K x v ≠ 1} ⊆
    { v : maximal_spectrum R | (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) ≠ 1 },
  { intros v,
    rw mem_set_of_eq, rw mem_set_of_eq,
    contrapose!,
    intro hv,
    suffices : finite_idele.to_add_valuations R K x v = 0,
    { rw this, exact zpow_zero _ },
    rw finite_idele.to_add_valuations,
    simp only [with_zero.to_integer],
    rw [← to_add_one, ← to_add_inv],
    apply congr_arg,
    rw [inv_eq_one, ← with_zero.coe_inj, classical.some_spec (with_zero.to_integer._proof_1 _)],
    exact hv, },
  exact finite.subset (finite_exponents R K x) h_subset,
end

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
`v^-(finite_idele.to_add_valuations R K x v)` is not the fractional ideal `(1)`.  -/
lemma finite_support' (x : finite_idele_group' R K ) :
  (mul_support (λ (v : maximal_spectrum R), (v.as_ideal :
    fractional_ideal (non_zero_divisors R) K) ^ -finite_idele.to_add_valuations R K x v)).finite :=
begin
  have h : {v : maximal_spectrum R | (v.as_ideal : fractional_ideal (non_zero_divisors R) K) ^
    -finite_idele.to_add_valuations R K x v ≠ 1} =
    {v : maximal_spectrum R | (v.as_ideal : fractional_ideal (non_zero_divisors R) K) ^
      finite_idele.to_add_valuations R K x v ≠ 1},
  { ext v,
    rw [mem_set_of_eq, mem_set_of_eq, ne.def, ne.def, zpow_neg₀, inv_eq_one₀], },
  rw [mul_support, h],
  exact finite_support R K x,
end

/-- The map from `finite_idele_group' R K` to the fractional_ideals of `R` sending a finite idèle
`x` to the product `∏_v v^(val_v(x_v))`, where `val_v` denotes the additive `v`-adic valuation. -/
def map_to_fractional_ideals.val :
  (finite_idele_group' R K) → (fractional_ideal (non_zero_divisors R) K) := λ x,
∏ᶠ (v : maximal_spectrum R), (v.as_ideal : fractional_ideal (non_zero_divisors R) K)^
  (finite_idele.to_add_valuations R K x v)

/-- The group homomorphism from `finite_idele_group' R K` to the fractional_ideals of `R` sending a
finite idèle `x` to the product `∏_v v^(val_v(x_v))` -/
def map_to_fractional_ideals.group_hom : monoid_hom
  (finite_idele_group' R K)  (fractional_ideal (non_zero_divisors R) K) :=
{ to_fun := map_to_fractional_ideals.val R K,
  map_one' := by { simp_rw [map_to_fractional_ideals.val, finite_idele.to_add_valuations.map_one,
    zpow_zero, finprod_one],},
  map_mul' := λ x y,
  begin
    rw [map_to_fractional_ideals.val],
    dsimp only,
    rw finite_idele.to_add_valuations.map_mul,
    simp_rw pi.add_apply,
    rw ← finprod_mul_distrib (finite_support R K x) (finite_support R K y),
    apply finprod_congr,
    intro v,
    rw zpow_add₀,
    { rw [ne.def, fractional_ideal.coe_ideal_eq_zero_iff],
      exact v.ne_bot },
  end }

/-- The map from `finite_idele_group' R K` to the fractional_ideals of `R` sending a finite idèle
`x` to the product `∏_v v^-(val_v(x_v))`, where `val_v` denotes the additive `v`-adic valuation. -/
def map_to_fractional_ideals.inv :
  (finite_idele_group' R K) → (fractional_ideal (non_zero_divisors R) K) := λ x,
∏ᶠ (v : maximal_spectrum R), (v.as_ideal : fractional_ideal (non_zero_divisors R) K)^
  (-finite_idele.to_add_valuations R K x v)

lemma finite_idele.to_add_valuations.mul_inv (x : finite_idele_group' R K):
  map_to_fractional_ideals.val R K x * map_to_fractional_ideals.inv R K x = 1 :=
begin
  rw [map_to_fractional_ideals.val, map_to_fractional_ideals.inv],
  dsimp only,
  rw ← finprod_mul_distrib (finite_support R K x) (finite_support' R K x),
  rw ← finprod_one,
  apply finprod_congr ,
  intro v,
  rw ← zpow_add₀,
  rw [add_right_neg, zpow_zero],
  { rw [ne.def, fractional_ideal.coe_ideal_eq_zero_iff],
      exact v.ne_bot },
end

lemma finite_idele.to_add_valuations.inv_mul (x : finite_idele_group' R K):
  map_to_fractional_ideals.inv R K x * map_to_fractional_ideals.val R K x = 1 :=
by simpa [mul_comm] using (finite_idele.to_add_valuations.mul_inv R K x)

/-- The map from `finite_idele_group' R K` to the units of the fractional_ideals of `R` sending a
finite idèle `x` to the product `∏_v v^(val_v(x_v))`, where `val_v` denotes the additive `v`-adic
valuation. -/
noncomputable! def map_to_fractional_ideals.def :
  (finite_idele_group' R K) → (units (fractional_ideal (non_zero_divisors R) K)) :=
λ x, ⟨map_to_fractional_ideals.val R K x, map_to_fractional_ideals.inv R K x,
  finite_idele.to_add_valuations.mul_inv R K x, finite_idele.to_add_valuations.inv_mul R K x⟩

/-- `map_to_fractional_ideals.def` is a group homomorphism. -/
def map_to_fractional_ideals : monoid_hom
  (finite_idele_group' R K)  (units (fractional_ideal (non_zero_divisors R) K)) :=
{ to_fun := map_to_fractional_ideals.def R K,
  map_one' := by {
    rw [map_to_fractional_ideals.def, ← units.eq_iff, units.coe_mk, units.coe_one],
    exact (map_to_fractional_ideals.group_hom R K).map_one', },
  map_mul' := λ x y,
  begin
    rw [map_to_fractional_ideals.def, ← units.eq_iff, units.coe_mul, units.coe_mk, units.coe_mk,
      units.coe_mk],
    exact (map_to_fractional_ideals.group_hom R K).map_mul' x y,
  end }

variables {R K}
lemma val_property {a : Π v : maximal_spectrum R, v.adic_completion K}
  (ha : ∀ᶠ v : maximal_spectrum R in filter.cofinite,
    (valued.v (a v) : with_zero (multiplicative ℤ)) = 1) :
  ∀ᶠ v : maximal_spectrum R in filter.cofinite, a v ∈ v.adic_completion_integers K :=
begin
  rw filter.eventually_cofinite at ha ⊢,
  simp_rw adic_completion.is_integer,
  have h_subset :
    {x : maximal_spectrum R | ¬(valued.v (a x) : with_zero (multiplicative ℤ)) ≤ 1} ⊆
    {x : maximal_spectrum R | ¬(valued.v (a x) : with_zero (multiplicative ℤ)) = 1},
  { intros v hv,
    exact ne_of_gt (not_le.mp hv), },
  exact finite.subset ha h_subset,
end

lemma inv_property {a : Π v : maximal_spectrum R, v.adic_completion K}
  (ha : ∀ᶠ v : maximal_spectrum R in filter.cofinite,
    (valued.v (a v) : with_zero (multiplicative ℤ)) = 1) :
  ∀ᶠ v : maximal_spectrum R in filter.cofinite, (a v)⁻¹ ∈ v.adic_completion_integers K :=
begin
  rw filter.eventually_cofinite at ha ⊢,
  simp_rw [adic_completion.is_integer, not_le],
  have h_subset : {x : maximal_spectrum R |
    1 < (valued.v (a x)⁻¹ : with_zero (multiplicative ℤ)) } ⊆
    {x : maximal_spectrum R | ¬(valued.v (a x) : with_zero (multiplicative ℤ)) = 1},
  { intros v hv,
    rw [mem_set_of_eq, valuation.map_inv] at hv,
    rw [mem_set_of_eq, ←inv_inj, inv_one],
    exact ne_of_gt hv, },
  exact finite.subset ha h_subset,
end

lemma right_inv' {a : Π v : maximal_spectrum R, v.adic_completion K}
  (ha : ∀ᶠ v : maximal_spectrum R in filter.cofinite,
    (valued.v (a v) : with_zero (multiplicative ℤ)) = 1)
  (h_ne_zero : ∀ v : maximal_spectrum R, a v ≠ 0)  :
  (⟨a, val_property ha⟩ : finite_adele_ring' R K) *
  ⟨(λ v : maximal_spectrum R, (a v)⁻¹), inv_property ha ⟩ = 1 :=
begin
  ext v,
  unfold_projs,
  simp only [mul'],
  rw [subtype.coe_mk, subtype.coe_mk, pi.mul_apply, if_neg (h_ne_zero v)],
  apply mul_hat_inv_cancel,
  exact h_ne_zero v,
end

lemma left_inv' {a : Π v : maximal_spectrum R, v.adic_completion K}
  (ha : ∀ᶠ v : maximal_spectrum R in filter.cofinite,
    (valued.v (a v) : with_zero (multiplicative ℤ)) = 1)
  (h_ne_zero : ∀ v : maximal_spectrum R, a v ≠ 0) :
  (⟨(λ v : maximal_spectrum R, (a v)⁻¹), inv_property ha⟩ : finite_adele_ring' R K) *
  ⟨a, val_property ha⟩ = 1 :=
by { rw mul_comm, exact right_inv' ha h_ne_zero}

/-- If `a = (a_v)_v ∈ ∏_v K_v` is such that `|a_v|_v ≠ 1` for all but finitely many `v` and
`a_v ≠ 0` for all `v`, then `a` is a finite idèle  of `R`. -/
def idele.mk (a : Π v : maximal_spectrum R, v.adic_completion K)
  (ha : ∀ᶠ v : maximal_spectrum R in filter.cofinite,
    (valued.v (a v) : with_zero (multiplicative ℤ)) = 1)
  (h_ne_zero : ∀ v : maximal_spectrum R, a v ≠ 0) :
  finite_idele_group' R K :=
⟨⟨a, val_property ha⟩, ⟨(λ v : maximal_spectrum R, (a v)⁻¹), inv_property ha⟩,
  right_inv' ha h_ne_zero, left_inv' ha h_ne_zero⟩

lemma map_to_fractional_ideals.inv_eq_inv (x : finite_idele_group' R K)
  (I : units (fractional_ideal (non_zero_divisors R) K))
  (hxI : map_to_fractional_ideals.val R K (x) = I.val) :
  map_to_fractional_ideals.inv R K (x) = I.inv :=
begin
  have h_inv : I.val * (map_to_fractional_ideals.inv R K (x)) = 1,
  { rw ← hxI, exact finite_idele.to_add_valuations.mul_inv R K _ },
  exact eq_comm.mp (units.inv_eq_of_mul_eq_one h_inv),
end

variables (R K)
/-- A finite idèle `(pi_v)_v`, where each `pi_v` is a uniformizer for the `v`-adic valuation. -/
def pi.unif : Π v : maximal_spectrum R, v.adic_completion K :=
λ v : maximal_spectrum R, (coe : K → (v.adic_completion K))
  (classical.some (v.valuation_exists_uniformizer K))

lemma pi.unif.ne_zero : ∀ v : maximal_spectrum R, pi.unif R K v ≠ 0 :=
begin
  intro v,
  rw [pi.unif, ← uniform_space.completion.coe_zero,
    injective.ne_iff (@uniform_space.completion.coe_inj K v.us' v.ss)],
  exact v.valuation_uniformizer_ne_zero K,
end

variables {R K}
lemma idele.mk'.val {exps : Π v : maximal_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : maximal_spectrum R) in filter.cofinite, exps v = 0) :
  ∀ᶠ (v : maximal_spectrum R) in filter.cofinite,
    pi.unif R K v ^ exps v ∈ v.adic_completion_integers K :=
begin
  rw filter.eventually_cofinite at h_exps ⊢,
  simp_rw adic_completion.is_integer,
  have h_subset : {x : maximal_spectrum R |
    ¬ (valued.v (pi.unif R K x ^ exps x) : with_zero (multiplicative ℤ)) ≤ 1} ⊆
    {x : maximal_spectrum R | ¬exps x = 0},
  { intros v hv,
    rw mem_set_of_eq at hv ⊢,
    intro h_zero,
    rw [h_zero, zpow_zero, valuation.map_one, not_le, lt_self_iff_false] at hv,
    exact hv, },
    exact finite.subset h_exps h_subset,
end

lemma idele.mk'.inv {exps : Π v : maximal_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : maximal_spectrum R) in filter.cofinite, exps v = 0) :
  ∀ᶠ (v : maximal_spectrum R) in filter.cofinite,
    pi.unif R K v ^-exps v ∈ v.adic_completion_integers K :=
begin
  rw filter.eventually_cofinite at h_exps ⊢,
  simp_rw adic_completion.is_integer,
  have h_subset : {x : maximal_spectrum R |
    ¬ (valued.v (pi.unif R K x ^ -exps x) : with_zero (multiplicative ℤ))  ≤ 1} ⊆
    {x : maximal_spectrum R | ¬exps x = 0},
  { intros v hv,
    rw mem_set_of_eq at hv ⊢,
    intro h_zero,
    rw [h_zero, neg_zero, zpow_zero, valuation.map_one, not_le, lt_self_iff_false] at hv,
    exact hv, },
    exact finite.subset h_exps h_subset,
end

lemma idele.mk'.mul_inv {exps : Π v : maximal_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : maximal_spectrum R) in filter.cofinite, exps v = 0) :
  (⟨λ (v : maximal_spectrum R), pi.unif R K v ^ exps v,
    idele.mk'.val h_exps⟩ : finite_adele_ring' R K) *
    ⟨λ (v : maximal_spectrum R), pi.unif R K v ^ -exps v, idele.mk'.inv h_exps⟩ = 1 :=
begin
  ext v,
  unfold_projs,
  simp only [mul'],
  rw [subtype.coe_mk, subtype.coe_mk, pi.mul_apply, zpow_eq_pow, zpow_eq_pow,
    ← zpow_add₀ (pi.unif.ne_zero R K v)],
  have : (exps v).neg = - exps v := rfl,
  rw [this, add_right_neg, zpow_zero],
  refl,
end

lemma idele.mk'.inv_mul {exps : Π v : maximal_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : maximal_spectrum R) in filter.cofinite, exps v = 0) :
  (⟨λ (v : maximal_spectrum R), pi.unif R K v ^-exps v,
    idele.mk'.inv h_exps⟩ : finite_adele_ring' R K) *
    ⟨λ (v : maximal_spectrum R), pi.unif R K v ^ exps v, idele.mk'.val h_exps⟩ = 1 :=
begin
  rw mul_comm, exact idele.mk'.mul_inv h_exps,
end

variables (R K)
/-- Given a collection `exps` of integers indexed by the maximal ideals `v` of `R`, of which only
finitely many are allowed to be nonzero, `(pi_v^(exps v))_v` is a finite idèle of `R`. -/
def idele.mk' {exps : Π v : maximal_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : maximal_spectrum R) in filter.cofinite, exps v = 0) : finite_idele_group' R K :=
⟨⟨λ v : maximal_spectrum R, (pi.unif R K v)^exps v, idele.mk'.val h_exps⟩,
  ⟨λ v : maximal_spectrum R, (pi.unif R K v)^-exps v, idele.mk'.inv h_exps⟩,
  idele.mk'.mul_inv h_exps, idele.mk'.inv_mul h_exps⟩

variables {R K}
lemma idele.mk'.valuation_ne_zero {exps : Π v : maximal_spectrum R, ℤ}
  (h_exps : ∀ᶠ (v : maximal_spectrum R) in filter.cofinite, exps v = 0) :
  (valued.v ((idele.mk' R K h_exps).val.val v) : with_zero (multiplicative ℤ)) ≠ 0 :=
begin
  simp only [ne.def, valuation.zero_iff, idele.mk'],
  intro h,
  exact pi.unif.ne_zero R K v (zpow_eq_zero h),
end

variables (R K)
/-- `map_to_fractional_ideals` is surjective. -/
lemma map_to_fractional_ideals.surjective : surjective (map_to_fractional_ideals R K) :=
begin
  rintro ⟨I, I_inv, hval_inv, hinv_val⟩,
  obtain ⟨a, J, ha, haJ⟩ := fractional_ideal.exists_eq_span_singleton_mul I,
  have hI_ne_zero : I ≠ 0 := left_ne_zero_of_mul_eq_one hval_inv,
  have hI := fractional_ideal.factorization I hI_ne_zero haJ,
  have h_exps : ∀ᶠ v : maximal_spectrum R in filter.cofinite,
  ((associates.mk v.as_ideal).count (associates.mk J).factors : ℤ) -
    ((associates.mk v.as_ideal).count (associates.mk (ideal.span {a})).factors) = 0 :=
   fractional_ideal.finite_factors hI_ne_zero haJ,
  use idele.mk' R K h_exps,
  rw map_to_fractional_ideals,
  simp only [map_to_fractional_ideals.def, monoid_hom.coe_mk],
  have H : map_to_fractional_ideals.val R K (idele.mk' R K h_exps) = I,
  { simp only [map_to_fractional_ideals.val, finite_idele.to_add_valuations, ← hI],
    apply finprod_congr,
    intro v,
    apply congr_arg,
    have hv : (valued.v ((idele.mk' R K h_exps).val.val v) : with_zero (multiplicative ℤ)) ≠ 0 :=
    idele.mk'.valuation_ne_zero v h_exps,
    rw with_zero.to_integer,
    set x := classical.some (with_zero.to_integer._proof_1 hv) with hx_def,
    have hx := classical.some_spec (with_zero.to_integer._proof_1 hv),
    rw ← hx_def at hx ⊢,
    simp only [idele.mk', pi.unif] at hx,
    rw [valuation.map_zpow, v.valued_adic_completion_def, valued.extension_extends,
      v.adic_valued_def, classical.some_spec (v.valuation_exists_uniformizer K),
        ← with_zero.coe_zpow, with_zero.coe_inj] at hx,
    rw [hx, ← of_add_zsmul, to_add_of_add, algebra.id.smul_eq_mul, mul_neg,
          mul_one, neg_neg] },
  exact ⟨H, map_to_fractional_ideals.inv_eq_inv _ ⟨I, I_inv, hval_inv, hinv_val⟩ H⟩,
end

variables {R K}
/-- A finite idèle `x` is in the kernel of `map_to_fractional_ideals` if and only if `|x_v|_v = 1`
for all `v`. -/
lemma map_to_fractional_ideals.mem_kernel_iff (x : finite_idele_group' R K) :
  map_to_fractional_ideals R K x = 1 ↔
  ∀ v : maximal_spectrum R, finite_idele.to_add_valuations R K x v = 0 :=
begin
  rw [map_to_fractional_ideals, monoid_hom.coe_mk, map_to_fractional_ideals.def],
  simp_rw map_to_fractional_ideals.val,
  rw [units.ext_iff, units.coe_mk, units.coe_one],
  refine ⟨λ h_ker, _, λ h_val, _⟩,
  { intro v,
    rw [← fractional_ideal.count_finprod K v (finite_idele.to_add_valuations R K x),
      ← fractional_ideal.count_one K v, h_ker],
    exact finite_add_support R K x, },
  { rw ← @finprod_one _ (maximal_spectrum R) _,
    apply finprod_congr,
    intro v,
    rw [h_val v, zpow_zero _] }
end

variables (R K)
/-- The additive `v`-adic valuation of `x_v` equals 0 if and only if `|x_v|_v = 1`-/
lemma finite_idele.to_add_valuations.comp_eq_zero_iff (x : finite_idele_group' R K) :
  finite_idele.to_add_valuations R K x v = 0 ↔
  (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) = 1 :=
begin
  set y := classical.some (with_zero.to_integer._proof_1
    (finite_idele.to_add_valuations._proof_1 R K x v)) with hy,
  have hy_spec := classical.some_spec (with_zero.to_integer._proof_1
    (finite_idele.to_add_valuations._proof_1 R K x v)),
  rw ← hy at hy_spec,
  rw [finite_idele.to_add_valuations, neg_eq_zero ,with_zero.to_integer, ← to_add_one, ← hy,
    ← hy_spec, ← with_zero.coe_one, with_zero.coe_inj],
  refine ⟨λ h_eq, by rw [← of_add_to_add y, ← of_add_to_add 1, h_eq], λ h_eq, by rw h_eq⟩,
end

/-- `|x_v|_v = 1` if and only if both `x_v` and `x⁻¹_v` are in `R_v`. -/
lemma finite_idele.valuation_eq_one_iff (x : finite_idele_group' R K) :
  (valued.v (x.val.val v) : with_zero (multiplicative ℤ)) = 1 ↔
  x.val.val v ∈ v.adic_completion_integers K ∧ x⁻¹.val.val v ∈ v.adic_completion_integers K :=
begin
  rw [adic_completion.is_integer, adic_completion.is_integer],
  refine ⟨λ h_one, _, λ h_int, _⟩,
  { have h_mul := valuation_val_inv R K v x,
    rw [h_one, one_mul] at h_mul,
    exact ⟨ le_of_eq h_one, le_of_eq h_mul ⟩ , },
  { have : x.inv = x⁻¹.val := rfl,
    rw [← this, valuation_inv, ← inv_one, inv_le_inv₀, inv_one] at h_int,
    rw [eq_iff_le_not_lt, not_lt],
    exact h_int,
    { exact (valuation.ne_zero_iff _).mpr (v_comp.ne_zero R K v x)},
    { exact one_ne_zero }}
end

/-- `map_to_fractional_ideals` is continuous, where the codomain is given the discrete topology. -/
lemma map_to_fractional_ideals.continuous : continuous (map_to_fractional_ideals R K) :=
begin
  apply uniform_continuous.continuous,
  rw uniform_group.uniform_continuous_iff_open_ker,
  have h_ker : ((map_to_fractional_ideals R K).ker : set (finite_idele_group' R K)) =
    { x : units(finite_adele_ring' R K) |
       ∀ v : maximal_spectrum R, finite_idele.to_add_valuations R K x v = 0 },
  { ext x,
    exact map_to_fractional_ideals.mem_kernel_iff x, },
  change is_open ↑((map_to_fractional_ideals R K).ker),
  rw h_ker,
  use {p : (finite_adele_ring' R K × (finite_adele_ring' R K)ᵐᵒᵖ) |
    ∀ v : maximal_spectrum R, (p.1.val v) ∈ v.adic_completion_integers K ∧
    ((mul_opposite.unop p.2).val v) ∈ v.adic_completion_integers K},
  split,
  { have : prod.topological_space.is_open
      {p : finite_adele_ring' R K × (finite_adele_ring' R K)ᵐᵒᵖ | ∀ (v : maximal_spectrum R),
        p.fst.val v ∈ v.adic_completion_integers K ∧
        (mul_opposite.unop p.snd).val v ∈ v.adic_completion_integers K}  ↔ is_open
      {p : finite_adele_ring' R K × (finite_adele_ring' R K)ᵐᵒᵖ | ∀ (v : maximal_spectrum R),
        p.fst.val v ∈ v.adic_completion_integers K ∧
        (mul_opposite.unop p.snd).val v ∈ v.adic_completion_integers K} := by refl,
    rw this, clear this,
    rw [is_open_prod_iff],
    intros x y hxy,
    rw mem_set_of_eq at hxy,
    use {x : finite_adele_ring' R K | ∀ (v : maximal_spectrum R),
      x.val v ∈ v.adic_completion_integers K},
    use {x : (finite_adele_ring' R K )ᵐᵒᵖ | ∀ (v : maximal_spectrum R),
      (mul_opposite.unop x).val v ∈ v.adic_completion_integers K},
    refine ⟨finite_adele_ring'.is_open_integer_subring R K,
      finite_adele_ring'.is_open_integer_subring_opp R K, λ v, (hxy v).1, λ v, (hxy v).2, _⟩,
    { intros p hp v,
      exact ⟨ hp.1 v, hp.2 v⟩, }},
  { rw preimage_set_of_eq,
    ext x,
    rw [mem_set_of_eq, units.embed_product, monoid_hom.coe_mk, mul_opposite.unop_op],
    simp_rw [finite_idele.to_add_valuations.comp_eq_zero_iff, finite_idele.valuation_eq_one_iff],
    refl, },
end


import data.array.basic data.list.dict data.pnat

universes u v

/-- A hash map with an `n`-sized array of association list buckets, a hash
function, and proofs that the buckets have no duplicate keys and that every
bucket is correctly hashed. -/
structure hashmap {α : Type u} (β : α → Type v) :=
/- Number of buckets -/
(n : ℕ)
/- Hash function from key to bucket index -/
(hash : α → fin n)
/- Array of association list buckets -/
(buckets : array n (list (sigma β)))
/- Each bucket has no duplicate keys. -/
(nodupkeys : ∀ (i : fin n), (buckets.read i).nodupkeys)
/- Each bucket member has a hash equal to the bucket index. -/
(hash_index : ∀ {i : fin n} {s : sigma β}, s ∈ buckets.read i → hash s.1 = i)

namespace hashmap
open list

/- default number of buckets -/

/-- Default number of buckets (8) -/
def default_n : ℕ :=
8

/-- Default positive number of buckets (default_n) -/
def default_pn : ℕ+ :=
⟨default_n, dec_trivial⟩

/- constructing empty hashmaps -/

/-- Construct an empty hashmap -/
def mk_empty {α} (β : α → Type v) (n : ℕ := default_n) (f : α → fin n) : hashmap β :=
⟨n, f, mk_array n [], λ i, nodupkeys_nil, λ _ _ h, by cases h⟩

/-- Create a hash function from a function `f : α → ℕ` using the result modulo
the number of buckets -/
def hash_mod {α} (n : ℕ+ := default_pn) (f : α → ℕ) (a : α) : fin n.val :=
⟨f a % n.val, nat.mod_lt _ n.property⟩

/-- Construct an empty nat-modulo hashmap -/
def mk_empty_mod {α} (β : α → Type v) (n : ℕ+ := default_pn) (f : α → ℕ) : hashmap β :=
mk_empty β n (hash_mod n f)

section αβ
variables {α : Type u} {β : α → Type v}

/- extensionality -/

theorem ext_core {m₁ m₂ : hashmap β} :
  m₁.n = m₂.n →
  m₁.hash == m₂.hash →
  m₁.buckets == m₂.buckets →
  m₁ = m₂ :=
begin
  cases m₁,
  cases m₂,
  dsimp,
  intros hn hh hb,
  congr,
  repeat { assumption },
  { apply proof_irrel_heq, substs hn hb },
  { apply proof_irrel_heq, substs hn hh hb }
end

theorem ext {m₁ m₂ : hashmap β}
  (hn : m₁.n = m₂.n)
  (hh : ∀ (a : α), (eq.rec_on hn (m₁.hash a) : fin m₂.n) = m₂.hash a)
  (hb : ∀ (i : fin m₁.n), m₁.buckets.read i = m₂.buckets.read (eq.rec_on hn i)) :
  m₁ = m₂ :=
ext_core hn
  (function.hfunext rfl (λ a₁ a₂ p, heq_of_eq_rec_left hn (by rw eq_of_heq p; apply hh)))
  (by cases m₁; cases m₂; dsimp at hn; subst hn; exact heq_of_eq (array.ext hb))

/- nodupkeys -/

theorem nodupkeys_of_mem_buckets {l : list (sigma β)} {m : hashmap β} (h : l ∈ m.buckets) :
  l.nodupkeys :=
let ⟨i, e⟩ := h in e ▸ m.nodupkeys i

/- empty -/

/-- A hashmap is empty if all buckets are empty -/
def empty (m : hashmap β) : Prop :=
∀ (i : fin m.n), m.buckets.read i = []

section empty
variables {m : hashmap β}

theorem empty_mk_empty (β) (n : ℕ) (f : α → fin n) : empty (mk_empty β n f) :=
λ _, rfl

theorem empty_mk_empty_mod (β) (n : ℕ+) (f : α → ℕ) : empty (mk_empty_mod β n f) :=
λ _, rfl

@[simp] theorem empty_zero (h : m.n = 0) : empty m :=
λ i, by cases (h.rec_on i : fin 0).is_lt

end empty

/- to_lists -/

/-- Bucket list of a hashmap -/
def to_lists (m : hashmap β) : list (list (sigma β)) :=
m.buckets.to_list

section to_lists
variables {m : hashmap β} {i : ℕ} {l : list (sigma β)}

@[simp] theorem mem_to_lists : l ∈ m.to_lists ↔ l ∈ m.buckets :=
array.mem_to_list

theorem hash_idx_of_to_lists_enum (he : (i, l) ∈ m.to_lists.enum)
  {s : sigma β} (hl : s ∈ l) : (m.hash s.1).1 = i :=
have e₁ : ∃ p, m.buckets.read ⟨i, p⟩ = l := array.mem_to_list_enum.1 he,
have e₂ : ∃ p, m.hash s.1 = ⟨i, p⟩ := e₁.imp (λ _ h, m.hash_index $ h.symm ▸ hl),
let ⟨_, h⟩ := e₂ in by rw h

theorem disjoint_to_lists_map_keys (m : hashmap β) :
  pairwise disjoint (m.to_lists.map keys) :=
begin
  rw [←enum_map_snd m.to_lists, pairwise_map, pairwise_map],
  refine pairwise.imp_of_mem _ ((pairwise_map _).mp (nodup_enum_map_fst _)),
  rw prod.forall,
  intros n₁ l₁,
  rw prod.forall,
  intros n₂ l₂,
  intros me₁ me₂ e a mka₁ mka₂,
  apply e,
  cases exists_mem_of_mem_keys mka₁ with b₁ mab₁,
  cases exists_mem_of_mem_keys mka₂ with b₂ mab₂,
  rw [←hash_idx_of_to_lists_enum me₁ mab₁, ←hash_idx_of_to_lists_enum me₂ mab₂]
end

end to_lists

/- to_list -/

/-- Association list of a hashmap -/
def to_list (m : hashmap β) : list (sigma β) :=
m.to_lists.join

section to_list
variables {m : hashmap β} {i : ℕ} {l : list (sigma β)} {s : sigma β}

section val
variables {n : ℕ} {h : α → fin n} {bs : array n (list (sigma β))}
  {ndk : ∀ i, (bs.read i).nodupkeys}
  {hi : ∀ i (s : sigma β), s ∈ bs.read i → h s.1 = i}

@[simp] theorem to_list_val : (mk n h bs ndk hi).to_list = bs.to_list.join :=
rfl

theorem empty_to_list : empty m ↔ m.to_list = [] :=
array.to_list_join_nil.symm

end val

theorem nodupkeys_to_list (m : hashmap β) : m.to_list.nodupkeys :=
nodupkeys_join.mpr $ and.intro
  (λ l ml, by simp [to_lists] at ml; cases ml with i e; induction e; exact m.nodupkeys i)
  m.disjoint_to_lists_map_keys

end to_list

/- foldl -/

/-- Left-fold of a hashmap -/
def foldl {γ : Type*} (m : hashmap β) (f : γ → sigma β → γ) (d : γ) : γ :=
m.buckets.foldl d (λ b r, b.foldl f r)

/- keys -/

/-- List of keys in a hashmap -/
def keys (m : hashmap β) : list α :=
m.to_list.keys

section keys
variables {m : hashmap β}

section val
variables {n : ℕ} {h : α → fin n} {bs : array n (list (sigma β))}
  {ndk : ∀ i, (bs.read i).nodupkeys}
  {hi : ∀ i (s : sigma β), s ∈ bs.read i → h s.1 = i}

@[simp] theorem keys_val :
  (mk n h bs ndk hi).keys = bs.to_list.join.keys :=
rfl

end val

theorem nodup_keys (m : hashmap β) : m.keys.nodup :=
nodupkeys_iff.mpr m.nodupkeys_to_list

end keys

/- has_repr -/

instance [has_repr α] [∀ a, has_repr (β a)] : has_repr (hashmap β) :=
⟨λ m, "{" ++ string.intercalate ", " (m.to_list.map repr) ++ "}"⟩

section decidable_eq_α
variables [decidable_eq α]

/- lookup -/

/-- Look up a key in a hashmap to find the value, if it exists -/
def lookup (a : α) (m : hashmap β) : option (β a) :=
klookup a $ m.buckets.read $ m.hash a

section lookup
variables {a : α} {s : sigma β} {m : hashmap β}

section val
variables {n : ℕ} {h : α → fin n} {bs : array n (list (sigma β))}
  {ndk : ∀ i, (bs.read i).nodupkeys}
  {hi : ∀ i (s : sigma β), s ∈ bs.read i → h s.1 = i}

@[simp] theorem lookup_val :
  lookup a (mk n h bs ndk hi) = klookup a (bs.read (h a)) :=
rfl

end val

@[simp] theorem lookup_empty (a : α) (h : empty m) : lookup a m = none :=
by simp [lookup, h (m.hash a)]

theorem lookup_iff_mem_buckets : s.2 ∈ m.lookup s.1 ↔ ∃ l, l ∈ m.buckets ∧ s ∈ l :=
calc s.2 ∈ m.lookup s.1 ↔ s ∈ m.buckets.read (m.hash s.1) :
    by cases m with _ h _ ndk; simp [ndk (h s.1)]
  ... ↔ m.buckets.read (m.hash s.1) ∈ m.buckets ∧ s ∈ m.buckets.read (m.hash s.1) :
    ⟨λ h, ⟨array.read_mem _ _, h⟩, λ ⟨_, h⟩, h⟩
  ... ↔ ∃ l, l ∈ m.buckets ∧ s ∈ l :
    ⟨λ ⟨p, q⟩, ⟨_, p, q⟩, λ ⟨_, ⟨i, p⟩, q⟩,
     by rw ←p at q; rw m.hash_index q; exact ⟨array.read_mem m.buckets i, q⟩⟩

end lookup

/- mem -/

instance : has_mem (sigma β) (hashmap β) :=
⟨λ s m, s.2 ∈ m.lookup s.1⟩

section mem
variables {s : sigma β} {m : hashmap β}

section val
variables {n : ℕ} {h : α → fin n} {bs : array n (list (sigma β))}
  {ndk : ∀ i, (bs.read i).nodupkeys}
  {hi : ∀ i (s : sigma β), s ∈ bs.read i → h s.1 = i}

@[simp] theorem mem_val : s ∈ mk n h bs ndk hi ↔ s ∈ bs.read (h s.1) :=
mem_klookup_of_nodupkeys (ndk (h s.1))

end val

theorem mem_def : s ∈ m ↔ s.2 ∈ m.lookup s.1 :=
iff.rfl

@[simp] theorem mem_to_list : s ∈ m.to_list ↔ s ∈ m :=
calc s ∈ m.to_list ↔ ∃ l, l ∈ m.to_lists ∧ s ∈ l : mem_join
  ... ↔ ∃ l, l ∈ m.buckets ∧ s ∈ l : by simp only [mem_to_lists]
  ... ↔ s ∈ m : lookup_iff_mem_buckets.symm

end mem

/- has_key -/

/-- Test for the presence of a key in a hashmap -/
def has_key (m : hashmap β) (a : α) : bool :=
(m.lookup a).is_some

section has_key
variables {a : α} {m : hashmap β}

section val
variables {n : ℕ} {h : α → fin n} {bs : array n (list (sigma β))}
  {ndk : ∀ i, (bs.read i).nodupkeys}
  {hi : ∀ i (s : sigma β), s ∈ bs.read i → h s.1 = i}

@[simp] theorem has_key_val :
  (mk n h bs ndk hi).has_key a = (klookup a (bs.read (h a))).is_some :=
rfl

end val

theorem has_key_def : m.has_key a = (m.lookup a).is_some :=
rfl

@[simp] theorem mem_keys_iff_has_key : a ∈ m.keys ↔ m.has_key a :=
calc a ∈ m.keys ↔ ∃ (b : β a), sigma.mk a b ∈ m.to_list : mem_keys
  ... ↔ ∃ (b : β a), b ∈ m.lookup a : exists_congr $ λ b, mem_to_list
  ... ↔ m.has_key a : klookup_is_some.symm

end has_key

/- erase -/

/-- Erase a hashmap entry with the given key -/
def erase (m : hashmap β) (a : α) : hashmap β :=
{ buckets := m.buckets.modify (m.hash a) (kerase a),
  nodupkeys := λ i, by by_cases e : m.hash a = i; simp [e, m.nodupkeys i],
  hash_index := λ i s h, m.hash_index $
    by by_cases e : m.hash a = i; simp [e] at h; [exact mem_of_mem_kerase h, exact h],
  ..m }

section erase
variables {a : α} {s : sigma β} {m : hashmap β}

section val
variables {n : ℕ} {h : α → fin n} {bs : array n (list (sigma β))}
  {ndk : ∀ i, (bs.read i).nodupkeys}
  {hi : ∀ i (s : sigma β), s ∈ bs.read i → h s.1 = i}

@[simp] theorem mem_erase_val :
  s ∈ (mk n h bs ndk hi).erase a ↔ s.1 ≠ a ∧ s ∈ bs.read (h s.1) :=
begin
  unfold erase,
  by_cases e : h s.1 = h a,
  { simp [e, ndk (h a)] },
  { simp [ne.symm e, mt (congr_arg _) e] }
end

end val

theorem lookup_erase (m : hashmap β) : (m.erase a).lookup a = none :=
by simp [erase, lookup, m.nodupkeys (m.hash a)]

@[simp] theorem mem_erase : s ∈ m.erase a ↔ s.1 ≠ a ∧ s ∈ m :=
by cases m; simp

end erase

/- insert -/

/-- Insert a new entry in a hashmap -/
protected def insert (s : sigma β) (m : hashmap β) : hashmap β :=
{ buckets := m.buckets.modify (m.hash s.1) (kinsert s),
  nodupkeys := λ i, by by_cases e : m.hash s.1 = i; simp [e, m.nodupkeys i],
  hash_index := λ i s' h, begin
    by_cases e : m.hash s.1 = i; simp [e] at h,
    { cases h with h h,
      { induction h, exact e },
      { exact m.hash_index (mem_of_mem_kerase h) } },
    { exact m.hash_index h }
  end,
  ..m }

instance : has_insert (sigma β) (hashmap β) :=
⟨hashmap.insert⟩

section insert
variables {s t : sigma β} {m : hashmap β}

section val
variables {n : ℕ} {h : α → fin n} {bs : array n (list (sigma β))}
  {ndk : ∀ i, (bs.read i).nodupkeys}
  {hi : ∀ i (s : sigma β), s ∈ bs.read i → h s.1 = i}

@[simp] theorem mem_insert_val :
  s ∈ insert t (mk n h bs ndk hi) ↔ s = t ∨ s.1 ≠ t.1 ∧ s ∈ bs.read (h s.1) :=
begin
  unfold insert has_insert.insert hashmap.insert,
  by_cases e : h s.1 = h t.1,
  { simp [e, ndk (h t.1)] },
  { have e' : s.1 ≠ t.1 := mt (congr_arg _) e, simp [ne.symm e, e', mt sigma.eq_fst e'] }
end

end val

@[simp] theorem mem_insert : s ∈ insert t m ↔ s = t ∨ s.1 ≠ t.1 ∧ s ∈ m :=
by cases m; simp

end insert

/-- Insert a list of entries in a hashmap -/
def insert_list (l : list (sigma β)) (m : hashmap β) : hashmap β :=
l.foldl (flip insert) m

/-- Construct a hashmap from an association list -/
def of_list (n : ℕ := default_n) (f : α → fin n) (l : list (sigma β)) : hashmap β :=
insert_list l $ mk_empty _ n f

/-- Construct a nat-modulo hashmap from an association list -/
def of_list_mod (n : ℕ+ := default_pn) (f : α → ℕ) (l : list (sigma β)) : hashmap β :=
insert_list l $ mk_empty_mod _ n f

end decidable_eq_α

end αβ

end hashmap