/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Filippo A. E. Nuccio
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.localization
import Mathlib.ring_theory.noetherian
import Mathlib.ring_theory.principal_ideal_domain
import Mathlib.tactic.field_simp
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5

namespace Mathlib

/-!
# Fractional ideals

This file defines fractional ideals of an integral domain and proves basic facts about them.

## Main definitions
Let `S` be a submonoid of an integral domain `R`, `P` the localization of `R` at `S`, and `f` the
natural ring hom from `R` to `P`.
 * `is_fractional` defines which `R`-submodules of `P` are fractional ideals
 * `fractional_ideal f` is the type of fractional ideals in `P`
 * `has_coe (ideal R) (fractional_ideal f)` instance
 * `comm_semiring (fractional_ideal f)` instance:
   the typical ideal operations generalized to fractional ideals
 * `lattice (fractional_ideal f)` instance
 * `map` is the pushforward of a fractional ideal along an algebra morphism

Let `K` be the localization of `R` at `R \ {0}` and `g` the natural ring hom from `R` to `K`.
 * `has_div (fractional_ideal g)` instance:
   the ideal quotient `I / J` (typically written $I : J$, but a `:` operator cannot be defined)

## Main statements

  * `mul_left_mono` and `mul_right_mono` state that ideal multiplication is monotone
  * `prod_one_self_div_eq` states that `1 / I` is the inverse of `I` if one exists
  * `is_noetherian` states that very fractional ideal of a noetherian integral domain is noetherian

## Implementation notes

Fractional ideals are considered equal when they contain the same elements,
independent of the denominator `a : R` such that `a I ⊆ R`.
Thus, we define `fractional_ideal` to be the subtype of the predicate `is_fractional`,
instead of having `fractional_ideal` be a structure of which `a` is a field.

Most definitions in this file specialize operations from submodules to fractional ideals,
proving that the result of this operation is fractional if the input is fractional.
Exceptions to this rule are defining `(+) := (⊔)` and `⊥ := 0`,
in order to re-use their respective proof terms.
We can still use `simp` to show `I.1 + J.1 = (I + J).1` and `⊥.1 = 0.1`.

In `ring_theory.localization`, we define a copy of the localization map `f`'s codomain `P`
(`f.codomain`) so that the `R`-algebra instance on `P` can 'know' the map needed to induce
the `R`-algebra structure.

We don't assume that the localization is a field until we need it to define ideal quotients.
When this assumption is needed, we replace `S` with `non_zero_divisors R`, making the localization
a field.

## References

  * https://en.wikipedia.org/wiki/Fractional_ideal

## Tags

fractional ideal, fractional ideals, invertible ideal
-/

namespace ring

/-- A submodule `I` is a fractional ideal if `a I ⊆ R` for some `a ≠ 0`. -/
def is_fractional {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] (f : localization_map S P) (I : submodule R (localization_map.codomain f)) :=
  ∃ (a : R), ∃ (H : a ∈ S), ∀ (b : P), b ∈ I → localization_map.is_integer f (coe_fn (localization_map.to_map f) a * b)

/-- The fractional ideals of a domain `R` are ideals of `R` divided by some `a ∈ R`.

  More precisely, let `P` be a localization of `R` at some submonoid `S`,
  then a fractional ideal `I ⊆ P` is an `R`-submodule of `P`,
  such that there is a nonzero `a : R` with `a I ⊆ R`.
-/
def fractional_ideal {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] (f : localization_map S P) :=
  Subtype fun (I : submodule R (localization_map.codomain f)) => is_fractional f I

namespace fractional_ideal

protected instance submodule.has_coe {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : has_coe (fractional_ideal f) (submodule R (localization_map.codomain f)) :=
  has_coe.mk fun (I : fractional_ideal f) => subtype.val I

@[simp] theorem val_eq_coe {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) : subtype.val I = ↑I :=
  rfl

@[simp] theorem coe_mk {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : submodule R (localization_map.codomain f)) (hI : is_fractional f I) : ↑{ val := I, property := hI } = I :=
  rfl

protected instance has_mem {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : has_mem P (fractional_ideal f) :=
  has_mem.mk fun (x : P) (I : fractional_ideal f) => x ∈ ↑I

/-- Fractional ideals are equal if their submodules are equal.

  Combined with `submodule.ext` this gives that fractional ideals are equal if
  they have the same elements.
-/
theorem ext {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} {J : fractional_ideal f} : ↑I = ↑J → I = J :=
  iff.mpr subtype.ext_iff_val

theorem ext_iff {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} {J : fractional_ideal f} : (∀ (x : P), x ∈ I ↔ x ∈ J) ↔ I = J :=
  { mp := fun (h : ∀ (x : P), x ∈ I ↔ x ∈ J) => ext (submodule.ext h), mpr := fun (h : I = J) (x : P) => h ▸ iff.rfl }

theorem fractional_of_subset_one {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : submodule R (localization_map.codomain f)) (h : I ≤ submodule.span R (singleton 1)) : is_fractional f I := sorry

theorem is_fractional_of_le {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : submodule R (localization_map.codomain f)} {J : fractional_ideal f} (hIJ : I ≤ ↑J) : is_fractional f I := sorry

protected instance coe_to_fractional_ideal {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : has_coe (ideal R) (fractional_ideal f) :=
  has_coe.mk fun (I : ideal R) => { val := localization_map.coe_submodule f I, property := sorry }

@[simp] theorem coe_coe_ideal {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : ideal R) : ↑↑I = localization_map.coe_submodule f I :=
  rfl

@[simp] theorem mem_coe_ideal {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {x : localization_map.codomain f} {I : ideal R} : x ∈ ↑I ↔ ∃ (x' : R), ∃ (H : x' ∈ I), coe_fn (localization_map.to_map f) x' = x := sorry

protected instance has_zero {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : HasZero (fractional_ideal f) :=
  { zero := ↑0 }

@[simp] theorem mem_zero_iff {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {x : P} : x ∈ 0 ↔ x = 0 := sorry

@[simp] theorem coe_zero {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : ↑0 = ⊥ :=
  submodule.ext fun (_x : localization_map.codomain f) => mem_zero_iff

@[simp] theorem coe_to_fractional_ideal_bot {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : ↑⊥ = 0 :=
  rfl

@[simp] theorem exists_mem_to_map_eq {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {x : R} {I : ideal R} (h : S ≤ non_zero_divisors R) : (∃ (x' : R), x' ∈ I ∧ coe_fn (localization_map.to_map f) x' = coe_fn (localization_map.to_map f) x) ↔ x ∈ I := sorry

theorem coe_to_fractional_ideal_injective {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (h : S ≤ non_zero_divisors R) : function.injective coe := sorry

theorem coe_to_fractional_ideal_eq_zero {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : ideal R} (hS : S ≤ non_zero_divisors R) : ↑I = 0 ↔ I = ⊥ := sorry

theorem coe_to_fractional_ideal_ne_zero {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : ideal R} (hS : S ≤ non_zero_divisors R) : ↑I ≠ 0 ↔ I ≠ ⊥ :=
  iff.mpr not_iff_not (coe_to_fractional_ideal_eq_zero hS)

theorem coe_to_submodule_eq_bot {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} : ↑I = ⊥ ↔ I = 0 := sorry

theorem coe_to_submodule_ne_bot {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} : ↑I ≠ ⊥ ↔ I ≠ 0 :=
  iff.mpr not_iff_not coe_to_submodule_eq_bot

protected instance inhabited {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : Inhabited (fractional_ideal f) :=
  { default := 0 }

protected instance has_one {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : HasOne (fractional_ideal f) :=
  { one := ↑1 }

theorem mem_one_iff {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {x : P} : x ∈ 1 ↔ ∃ (x' : R), coe_fn (localization_map.to_map f) x' = x := sorry

theorem coe_mem_one {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (x : R) : coe_fn (localization_map.to_map f) x ∈ 1 :=
  iff.mpr mem_one_iff (Exists.intro x rfl)

theorem one_mem_one {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : 1 ∈ 1 :=
  iff.mpr mem_one_iff (Exists.intro 1 (ring_hom.map_one (localization_map.to_map f)))

/-- `(1 : fractional_ideal f)` is defined as the R-submodule `f(R) ≤ K`.

However, this is not definitionally equal to `1 : submodule R K`,
which is proved in the actual `simp` lemma `coe_one`. -/
theorem coe_one_eq_coe_submodule_one {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : ↑1 = localization_map.coe_submodule f 1 :=
  rfl

@[simp] theorem coe_one {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : ↑1 = 1 := sorry

/-!
### `lattice` section

Defines the order on fractional ideals as inclusion of their underlying sets,
and ports the lattice structure on submodules to fractional ideals.
-/

protected instance partial_order {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : partial_order (fractional_ideal f) :=
  partial_order.mk (fun (I J : fractional_ideal f) => subtype.val I ≤ subtype.val J)
    (preorder.lt._default fun (I J : fractional_ideal f) => subtype.val I ≤ subtype.val J) sorry sorry sorry

theorem le_iff_mem {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} {J : fractional_ideal f} : I ≤ J ↔ ∀ (x : P), x ∈ I → x ∈ J :=
  iff.rfl

@[simp] theorem coe_le_coe {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} {J : fractional_ideal f} : ↑I ≤ ↑J ↔ I ≤ J :=
  iff.rfl

theorem zero_le {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) : 0 ≤ I := sorry

protected instance order_bot {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : order_bot (fractional_ideal f) :=
  order_bot.mk 0 partial_order.le partial_order.lt sorry sorry sorry zero_le

@[simp] theorem bot_eq_zero {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : ⊥ = 0 :=
  rfl

@[simp] theorem le_zero_iff {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} : I ≤ 0 ↔ I = 0 :=
  le_bot_iff

theorem eq_zero_iff {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} : I = 0 ↔ ∀ (x : P), x ∈ I → x = 0 := sorry

theorem fractional_sup {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) (J : fractional_ideal f) : is_fractional f (subtype.val I ⊔ subtype.val J) := sorry

theorem fractional_inf {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) (J : fractional_ideal f) : is_fractional f (subtype.val I ⊓ subtype.val J) := sorry

protected instance lattice {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : lattice (fractional_ideal f) :=
  lattice.mk (fun (I J : fractional_ideal f) => { val := subtype.val I ⊔ subtype.val J, property := fractional_sup I J })
    partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry
    (fun (I J : fractional_ideal f) => { val := subtype.val I ⊓ subtype.val J, property := fractional_inf I J }) sorry
    sorry sorry

protected instance semilattice_sup_bot {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : semilattice_sup_bot (fractional_ideal f) :=
  semilattice_sup_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry lattice.sup sorry sorry sorry

protected instance has_add {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : Add (fractional_ideal f) :=
  { add := has_sup.sup }

@[simp] theorem sup_eq_add {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) (J : fractional_ideal f) : I ⊔ J = I + J :=
  rfl

@[simp] theorem coe_add {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) (J : fractional_ideal f) : ↑(I + J) = ↑I + ↑J :=
  rfl

theorem fractional_mul {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) (J : fractional_ideal f) : is_fractional f (subtype.val I * subtype.val J) := sorry

/-- `fractional_ideal.mul` is the product of two fractional ideals,
used to define the `has_mul` instance.

This is only an auxiliary definition: the preferred way of writing `I.mul J` is `I * J`.

Elaborated terms involving `fractional_ideal` tend to grow quite large,
so by making definitions irreducible, we hope to avoid deep unfolds.
-/
def mul {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) (J : fractional_ideal f) : fractional_ideal f :=
  { val := subtype.val I * subtype.val J, property := fractional_mul I J }

protected instance has_mul {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : Mul (fractional_ideal f) :=
  { mul := fun (I J : fractional_ideal f) => mul I J }

@[simp] theorem mul_eq_mul {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) (J : fractional_ideal f) : mul I J = I * J :=
  rfl

@[simp] theorem coe_mul {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) (J : fractional_ideal f) : ↑(I * J) = ↑I * ↑J :=
  rfl

theorem mul_left_mono {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) : monotone (Mul.mul I) := sorry

theorem mul_right_mono {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) : monotone fun (J : fractional_ideal f) => J * I := sorry

theorem mul_mem_mul {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} {J : fractional_ideal f} {i : localization_map.codomain f} {j : localization_map.codomain f} (hi : i ∈ I) (hj : j ∈ J) : i * j ∈ I * J :=
  submodule.mul_mem_mul hi hj

theorem mul_le {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} {J : fractional_ideal f} {K : fractional_ideal f} : I * J ≤ K ↔ ∀ (i : P), i ∈ I → ∀ (j : P), j ∈ J → i * j ∈ K :=
  submodule.mul_le

protected theorem mul_induction_on {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} {J : fractional_ideal f} {C : localization_map.codomain f → Prop} {r : localization_map.codomain f} (hr : r ∈ I * J) (hm : ∀ (i : localization_map.codomain f), i ∈ I → ∀ (j : localization_map.codomain f), j ∈ J → C (i * j)) (h0 : C 0) (ha : ∀ (x y : localization_map.codomain f), C x → C y → C (x + y)) (hs : ∀ (r : R) (x : localization_map.codomain f), C x → C (r • x)) : C r :=
  submodule.mul_induction_on hr hm h0 ha hs

protected instance comm_semiring {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : comm_semiring (fractional_ideal f) :=
  comm_semiring.mk Add.add sorry 0 sorry sorry sorry Mul.mul sorry 1 sorry sorry sorry sorry sorry sorry sorry

theorem add_le_add_left {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} {J : fractional_ideal f} (hIJ : I ≤ J) (J' : fractional_ideal f) : J' + I ≤ J' + J :=
  sup_le_sup_left hIJ J'

theorem mul_le_mul_left {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} {J : fractional_ideal f} (hIJ : I ≤ J) (J' : fractional_ideal f) : J' * I ≤ J' * J :=
  iff.mpr mul_le fun (k : P) (hk : k ∈ J') (j : P) (hj : j ∈ I) => mul_mem_mul hk (hIJ hj)

theorem le_self_mul_self {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} (hI : 1 ≤ I) : I ≤ I * I := sorry

theorem mul_self_le_self {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : fractional_ideal f} (hI : I ≤ 1) : I * I ≤ I := sorry

theorem coe_ideal_le_one {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : ideal R} : ↑I ≤ 1 := sorry

theorem le_one_iff_exists_coe_ideal {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {J : fractional_ideal f} : J ≤ 1 ↔ ∃ (I : ideal R), ↑I = J := sorry

theorem fractional_map {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (g : alg_hom R (localization_map.codomain f) (localization_map.codomain f')) (I : fractional_ideal f) : is_fractional f' (submodule.map (alg_hom.to_linear_map g) (subtype.val I)) := sorry

/-- `I.map g` is the pushforward of the fractional ideal `I` along the algebra morphism `g` -/
def map {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (g : alg_hom R (localization_map.codomain f) (localization_map.codomain f')) : fractional_ideal f → fractional_ideal f' :=
  fun (I : fractional_ideal f) =>
    { val := submodule.map (alg_hom.to_linear_map g) (subtype.val I), property := fractional_map g I }

@[simp] theorem coe_map {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (g : alg_hom R (localization_map.codomain f) (localization_map.codomain f')) (I : fractional_ideal f) : ↑(map g I) = submodule.map (alg_hom.to_linear_map g) ↑I :=
  rfl

@[simp] theorem mem_map {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} {I : fractional_ideal f} {g : alg_hom R (localization_map.codomain f) (localization_map.codomain f')} {y : localization_map.codomain f'} : y ∈ map g I ↔ ∃ (x : localization_map.codomain f), x ∈ I ∧ coe_fn g x = y :=
  submodule.mem_map

@[simp] theorem map_id {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) : map (alg_hom.id R (localization_map.codomain f)) I = I :=
  ext (submodule.map_id (subtype.val I))

@[simp] theorem map_comp {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} {P'' : Type u_4} [comm_ring P''] {f'' : localization_map S P''} (I : fractional_ideal f) (g : alg_hom R (localization_map.codomain f) (localization_map.codomain f')) (g' : alg_hom R (localization_map.codomain f') (localization_map.codomain f'')) : map (alg_hom.comp g' g) I = map g' (map g I) :=
  ext (submodule.map_comp (alg_hom.to_linear_map g) (alg_hom.to_linear_map g') (subtype.val I))

@[simp] theorem map_coe_ideal {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (g : alg_hom R (localization_map.codomain f) (localization_map.codomain f')) (I : ideal R) : map g ↑I = ↑I := sorry

@[simp] theorem map_one {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (g : alg_hom R (localization_map.codomain f) (localization_map.codomain f')) : map g 1 = 1 :=
  map_coe_ideal g 1

@[simp] theorem map_zero {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (g : alg_hom R (localization_map.codomain f) (localization_map.codomain f')) : map g 0 = 0 :=
  map_coe_ideal g 0

@[simp] theorem map_add {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (I : fractional_ideal f) (J : fractional_ideal f) (g : alg_hom R (localization_map.codomain f) (localization_map.codomain f')) : map g (I + J) = map g I + map g J :=
  ext (submodule.map_sup (subtype.val I) (subtype.val J) (alg_hom.to_linear_map g))

@[simp] theorem map_mul {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (I : fractional_ideal f) (J : fractional_ideal f) (g : alg_hom R (localization_map.codomain f) (localization_map.codomain f')) : map g (I * J) = map g I * map g J :=
  ext (submodule.map_mul (subtype.val I) (subtype.val J) g)

@[simp] theorem map_map_symm {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (I : fractional_ideal f) (g : alg_equiv R (localization_map.codomain f) (localization_map.codomain f')) : map (↑(alg_equiv.symm g)) (map (↑g) I) = I := sorry

@[simp] theorem map_symm_map {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (I : fractional_ideal f') (g : alg_equiv R (localization_map.codomain f) (localization_map.codomain f')) : map (↑g) (map (↑(alg_equiv.symm g)) I) = I := sorry

/-- If `g` is an equivalence, `map g` is an isomorphism -/
def map_equiv {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (g : alg_equiv R (localization_map.codomain f) (localization_map.codomain f')) : fractional_ideal f ≃+* fractional_ideal f' :=
  ring_equiv.mk (map ↑g) (map ↑(alg_equiv.symm g)) sorry sorry sorry sorry

@[simp] theorem coe_fun_map_equiv {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (g : alg_equiv R (localization_map.codomain f) (localization_map.codomain f')) : ⇑(map_equiv g) = map ↑g :=
  rfl

@[simp] theorem map_equiv_apply {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (g : alg_equiv R (localization_map.codomain f) (localization_map.codomain f')) (I : fractional_ideal f) : coe_fn (map_equiv g) I = map (↑g) I :=
  rfl

@[simp] theorem map_equiv_symm {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} (g : alg_equiv R (localization_map.codomain f) (localization_map.codomain f')) : ring_equiv.symm (map_equiv g) = map_equiv (alg_equiv.symm g) :=
  rfl

@[simp] theorem map_equiv_refl {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : map_equiv alg_equiv.refl = ring_equiv.refl (fractional_ideal f) := sorry

theorem is_fractional_span_iff {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {s : set (localization_map.codomain f)} : is_fractional f (submodule.span R s) ↔
  ∃ (a : R), ∃ (H : a ∈ S), ∀ (b : P), b ∈ s → localization_map.is_integer f (coe_fn (localization_map.to_map f) a * b) := sorry

theorem is_fractional_of_fg {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {I : submodule R (localization_map.codomain f)} (hI : submodule.fg I) : is_fractional f I := sorry

/-- `canonical_equiv f f'` is the canonical equivalence between the fractional
ideals in `f.codomain` and in `f'.codomain` -/
def canonical_equiv {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {P' : Type u_3} [comm_ring P'] (f : localization_map S P) (f' : localization_map S P') : fractional_ideal f ≃+* fractional_ideal f' :=
  map_equiv
    (alg_equiv.mk (ring_equiv.to_fun (localization_map.ring_equiv_of_ring_equiv f f' (ring_equiv.refl R) sorry))
      (ring_equiv.inv_fun (localization_map.ring_equiv_of_ring_equiv f f' (ring_equiv.refl R) sorry)) sorry sorry sorry
      sorry sorry)

@[simp] theorem mem_canonical_equiv_apply {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {P' : Type u_3} [comm_ring P'] {f' : localization_map S P'} {I : fractional_ideal f} {x : localization_map.codomain f'} : x ∈ coe_fn (canonical_equiv f f') I ↔
  ∃ (y : P),
    ∃ (H : y ∈ I),
      coe_fn
          (localization_map.map f
            (fun (_x : ↥S) =>
              (fun (_a : ↥S) => subtype.cases_on _a fun (val : R) (property : val ∈ S) => idRhs (val ∈ S) property) _x)
            f')
          y =
        x := sorry

@[simp] theorem canonical_equiv_symm {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {P' : Type u_3} [comm_ring P'] (f : localization_map S P) (f' : localization_map S P') : ring_equiv.symm (canonical_equiv f f') = canonical_equiv f' f := sorry

@[simp] theorem canonical_equiv_flip {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {P' : Type u_3} [comm_ring P'] (f : localization_map S P) (f' : localization_map S P') (I : fractional_ideal f') : coe_fn (canonical_equiv f f') (coe_fn (canonical_equiv f' f) I) = I := sorry

/-!
### `fraction_map` section

This section concerns fractional ideals in the field of fractions,
i.e. the type `fractional_ideal g` when `g` is a `fraction_map R K`.
-/

/-- Nonzero fractional ideals contain a nonzero integer. -/
theorem exists_ne_zero_mem_is_integer {R : Type u_1} [comm_ring R] {K : Type u_3} [field K] {g : fraction_map R K} {I : fractional_ideal g} [nontrivial R] (hI : I ≠ 0) : ∃ (x : R), ∃ (H : x ≠ 0), coe_fn (localization_map.to_map g) x ∈ I := sorry

theorem map_ne_zero {R : Type u_1} [comm_ring R] {K : Type u_3} {K' : Type u_4} [field K] [field K'] {g : fraction_map R K} {g' : fraction_map R K'} {I : fractional_ideal g} (h : alg_hom R (localization_map.codomain g) (localization_map.codomain g')) [nontrivial R] (hI : I ≠ 0) : map h I ≠ 0 := sorry

@[simp] theorem map_eq_zero_iff {R : Type u_1} [comm_ring R] {K : Type u_3} {K' : Type u_4} [field K] [field K'] {g : fraction_map R K} {g' : fraction_map R K'} {I : fractional_ideal g} (h : alg_hom R (localization_map.codomain g) (localization_map.codomain g')) [nontrivial R] : map h I = 0 ↔ I = 0 :=
  { mp := imp_of_not_imp_not (map h I = 0) (I = 0) (map_ne_zero h), mpr := fun (hI : I = 0) => Eq.symm hI ▸ map_zero h }

/-!
### `quotient` section

This section defines the ideal quotient of fractional ideals.

In this section we need that each non-zero `y : R` has an inverse in
the localization, i.e. that the localization is a field. We satisfy this
assumption by taking `S = non_zero_divisors R`, `R`'s localization at which
is a field because `R` is a domain.
-/

protected instance nontrivial {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} : nontrivial (fractional_ideal g) :=
  nontrivial.mk
    (Exists.intro 0
      (Exists.intro 1
        fun (h : 0 = 1) =>
          (fun (this : 1 ∈ 0) => one_ne_zero (iff.mp mem_zero_iff this))
            (eq.mpr (id (Eq._oldrec (Eq.refl (1 ∈ 0)) (Eq.symm (ring_hom.map_one (localization_map.to_map g)))))
              (eq.mpr
                ((fun (ᾰ ᾰ_1 : K) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : fractional_ideal g) (e_3 : ᾰ_2 = ᾰ_3) =>
                    congr (congr_arg has_mem.mem e_2) e_3)
                  (coe_fn (localization_map.to_map g) 1) (coe_fn (localization_map.to_map g) 1)
                  (Eq.refl (coe_fn (localization_map.to_map g) 1)) 0 1 h)
                (coe_mem_one 1)))))

theorem fractional_div_of_nonzero {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} {J : fractional_ideal g} (h : J ≠ 0) : is_fractional g (subtype.val I / subtype.val J) := sorry

protected instance fractional_ideal_has_div {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} : Div (fractional_ideal g) :=
  { div :=
      fun (I J : fractional_ideal g) =>
        dite (J = 0) (fun (h : J = 0) => 0)
          fun (h : ¬J = 0) => { val := subtype.val I / subtype.val J, property := fractional_div_of_nonzero h } }

@[simp] theorem div_zero {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} : I / 0 = 0 :=
  dif_pos rfl

theorem div_nonzero {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} {J : fractional_ideal g} (h : J ≠ 0) : I / J = { val := subtype.val I / subtype.val J, property := fractional_div_of_nonzero h } :=
  dif_neg h

@[simp] theorem coe_div {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} {J : fractional_ideal g} (hJ : J ≠ 0) : ↑(I / J) = ↑I / ↑J := sorry

theorem mem_div_iff_of_nonzero {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} {J : fractional_ideal g} (h : J ≠ 0) {x : K} : x ∈ I / J ↔ ∀ (y : K), y ∈ J → x * y ∈ I :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ∈ I / J ↔ ∀ (y : K), y ∈ J → x * y ∈ I)) (div_nonzero h)))
    submodule.mem_div_iff_forall_mul_mem

theorem mul_one_div_le_one {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} : I * (1 / I) ≤ 1 := sorry

theorem le_self_mul_one_div {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} (hI : I ≤ 1) : I ≤ I * (1 / I) := sorry

theorem le_div_iff_of_nonzero {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} {J : fractional_ideal g} {J' : fractional_ideal g} (hJ' : J' ≠ 0) : I ≤ J / J' ↔ ∀ (x : K), x ∈ I → ∀ (y : K), y ∈ J' → x * y ∈ J := sorry

theorem le_div_iff_mul_le {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} {J : fractional_ideal g} {J' : fractional_ideal g} (hJ' : J' ≠ 0) : I ≤ J / J' ↔ I * J' ≤ J := sorry

@[simp] theorem div_one {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} : I / 1 = I := sorry

theorem ne_zero_of_mul_eq_one {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} (I : fractional_ideal g) (J : fractional_ideal g) (h : I * J = 1) : I ≠ 0 := sorry

theorem eq_one_div_of_mul_eq_one {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} (I : fractional_ideal g) (J : fractional_ideal g) (h : I * J = 1) : J = 1 / I :=
  congr_arg units.inv (units.ext rfl)

theorem mul_div_self_cancel_iff {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} : I * (1 / I) = 1 ↔ ∃ (J : fractional_ideal g), I * J = 1 := sorry

@[simp] theorem map_div {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {K' : Type u_5} [field K'] {g' : fraction_map R₁ K'} (I : fractional_ideal g) (J : fractional_ideal g) (h : alg_equiv R₁ (localization_map.codomain g) (localization_map.codomain g')) : map (↑h) (I / J) = map (↑h) I / map (↑h) J := sorry

@[simp] theorem map_one_div {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {K' : Type u_5} [field K'] {g' : fraction_map R₁ K'} (I : fractional_ideal g) (h : alg_equiv R₁ (localization_map.codomain g) (localization_map.codomain g')) : map (↑h) (1 / I) = 1 / map (↑h) I :=
  eq.mpr (id (Eq._oldrec (Eq.refl (map (↑h) (1 / I) = 1 / map (↑h) I)) (map_div 1 I h)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (map (↑h) 1 / map (↑h) I = 1 / map (↑h) I)) (map_one ↑h)))
      (Eq.refl (1 / map (↑h) I)))

theorem is_fractional_span_singleton {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (x : localization_map.codomain f) : is_fractional f (submodule.span R (singleton x)) := sorry

/-- `span_singleton x` is the fractional ideal generated by `x` if `0 ∉ S` -/
def span_singleton {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (x : localization_map.codomain f) : fractional_ideal f :=
  { val := submodule.span R (singleton x), property := is_fractional_span_singleton x }

@[simp] theorem coe_span_singleton {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (x : localization_map.codomain f) : ↑(span_singleton x) = submodule.span R (singleton x) :=
  rfl

@[simp] theorem mem_span_singleton {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {x : localization_map.codomain f} {y : localization_map.codomain f} : x ∈ span_singleton y ↔ ∃ (z : R), z • y = x :=
  submodule.mem_span_singleton

theorem mem_span_singleton_self {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (x : localization_map.codomain f) : x ∈ span_singleton x :=
  iff.mpr mem_span_singleton (Exists.intro 1 (one_smul R x))

theorem eq_span_singleton_of_principal {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) [submodule.is_principal ↑I] : I = span_singleton (submodule.is_principal.generator ↑I) :=
  ext (Eq.symm (submodule.is_principal.span_singleton_generator (subtype.val I)))

theorem is_principal_iff {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (I : fractional_ideal f) : submodule.is_principal ↑I ↔ ∃ (x : localization_map.codomain f), I = span_singleton x := sorry

@[simp] theorem span_singleton_zero {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : span_singleton 0 = 0 := sorry

theorem span_singleton_eq_zero_iff {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {y : localization_map.codomain f} : span_singleton y = 0 ↔ y = 0 := sorry

theorem span_singleton_ne_zero_iff {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {y : localization_map.codomain f} : span_singleton y ≠ 0 ↔ y ≠ 0 :=
  not_congr span_singleton_eq_zero_iff

@[simp] theorem span_singleton_one {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} : span_singleton 1 = 1 := sorry

@[simp] theorem span_singleton_mul_span_singleton {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (x : localization_map.codomain f) (y : localization_map.codomain f) : span_singleton x * span_singleton y = span_singleton (x * y) := sorry

@[simp] theorem coe_ideal_span_singleton {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} (x : R) : ↑(submodule.span R (singleton x)) = span_singleton (coe_fn (localization_map.to_map f) x) := sorry

@[simp] theorem canonical_equiv_span_singleton {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] (f : localization_map S P) {P' : Type u_3} [comm_ring P'] (f' : localization_map S P') (x : localization_map.codomain f) : coe_fn (canonical_equiv f f') (span_singleton x) =
  span_singleton
    (coe_fn
      (localization_map.map f
        ((fun (this : ∀ (y : ↥S), coe_fn (ring_hom.id R) (subtype.val y) ∈ S) => this)
          fun (y : ↥S) => subtype.property y)
        f')
      x) := sorry

theorem mem_singleton_mul {R : Type u_1} [comm_ring R] {S : submonoid R} {P : Type u_2} [comm_ring P] {f : localization_map S P} {x : localization_map.codomain f} {y : localization_map.codomain f} {I : fractional_ideal f} : y ∈ span_singleton x * I ↔ ∃ (y' : localization_map.codomain f), ∃ (H : y' ∈ I), y = x * y' := sorry

theorem one_div_span_singleton {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} (x : localization_map.codomain g) : 1 / span_singleton x = span_singleton (x⁻¹) := sorry

@[simp] theorem div_span_singleton {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} (J : fractional_ideal g) (d : localization_map.codomain g) : J / span_singleton d = span_singleton (d⁻¹) * J := sorry

theorem exists_eq_span_singleton_mul {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} (I : fractional_ideal g) : ∃ (a : R₁), ∃ (aI : ideal R₁), a ≠ 0 ∧ I = span_singleton (coe_fn (localization_map.to_map g) a⁻¹) * ↑aI := sorry

protected instance is_principal {K : Type u_4} [field K] {R : Type u_1} [integral_domain R] [is_principal_ideal_ring R] {f : fraction_map R K} (I : fractional_ideal f) : submodule.is_principal ↑I := sorry

theorem is_noetherian_zero {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} : is_noetherian R₁ ↥0 := sorry

theorem is_noetherian_iff {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} {I : fractional_ideal g} : is_noetherian R₁ ↥I ↔ ∀ (J : fractional_ideal g), J ≤ I → submodule.fg ↑J := sorry

theorem is_noetherian_coe_to_fractional_ideal {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} [is_noetherian_ring R₁] (I : ideal R₁) : is_noetherian R₁ ↥↑I := sorry

theorem is_noetherian_span_singleton_inv_to_map_mul {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} (x : R₁) {I : fractional_ideal g} (hI : is_noetherian R₁ ↥I) : is_noetherian R₁ ↥(span_singleton (coe_fn (localization_map.to_map g) x⁻¹) * I) := sorry

/-- Every fractional ideal of a noetherian integral domain is noetherian. -/
theorem is_noetherian {R₁ : Type u_3} [integral_domain R₁] {K : Type u_4} [field K] {g : fraction_map R₁ K} [is_noetherian_ring R₁] (I : fractional_ideal g) : is_noetherian R₁ ↥I := sorry


import data.set.basic algebra.group

universes u v

namespace group

variables {α : Type u} [group α] (S : set α)

inductive generate : set α
| basic : ∀ x ∈ S, generate x
| one : generate 1
| inv : ∀ x, generate x → generate x⁻¹
| mul : ∀ x y, generate x → generate y → generate (x * y)

namespace generate

def group : group (generate S) :=
by refine
{ mul := λ x y, ⟨x * y, mul x y x.2 y.2⟩,
  one := ⟨1, one S⟩,
  inv := λ x, ⟨x⁻¹, inv x x.2⟩,
  .. };
{ intros, apply subtype.eq,
  { apply mul_assoc <|> apply mul_one <|>
    apply one_mul <|> apply mul_left_inv } }

end generate

end group

variables (G : Type u) [group G]

namespace abelianization

def ambient : Type (max u (v+1)) := Π (H : Type v) [comm_group H] (f : G → H) (Hf : @is_group_hom G H _ (@comm_group.to_group H _inst_2) f), H

instance ambient.comm_group : comm_group (ambient.{u v} G) :=
by refine
{ mul := λ x y H HH f Hf, @has_mul.mul _ (@semigroup.to_has_mul _ (@monoid.to_semigroup _ (@group.to_monoid H (@comm_group.to_group H HH)))) (@x H HH f Hf) (@y H HH f Hf),
  one := λ H HH f Hf, @has_one.one _ (@monoid.to_has_one _ (@group.to_monoid H (@comm_group.to_group H HH))),
  inv := λ x H HH f Hf, @has_inv.inv _ (@group.to_has_inv H (@comm_group.to_group H HH)) (@x H HH f Hf),
  .. };
{ intros, funext, dsimp, letI := HH,
  { apply mul_assoc <|> apply mul_one <|>
    apply one_mul <|> apply mul_left_inv <|> apply mul_comm } }

def ambient.of_G : G → ambient G :=
λ x H HH f Hf, f x

end abelianization

def abelianization : Type (max u (v+1)) :=
group.generate (abelianization.ambient.of_G G '' set.univ)

namespace abelianization

def of_G : G → abelianization G :=
λ x, ⟨ambient.of_G G x, group.generate.basic _ ⟨x, trivial, rfl⟩⟩

instance : comm_group (abelianization G) :=
{ mul_comm := λ x y, subtype.eq $ by funext; apply HH.mul_comm,
  .. group.generate.group _ }

def of_G.is_group_hom : is_group_hom (of_G G) :=
λ x y, subtype.eq $ by funext; apply Hf

variables (H : Type v) [comm_group H] (f : G → H) (Hf : is_group_hom f)

def to_comm_group : abelianization G → H :=
λ x, x.1 H f Hf

def to_comm_group.is_group_hom : is_group_hom (to_comm_group G H f Hf) :=
λ x y, rfl

def to_comm_group.commute (x : G) : to_comm_group G H f Hf (of_G G x) = f x :=
rfl

variables (g : abelianization.{u v} G → H)
variables (Hg1 : is_group_hom g)
variables (Hg2 : ∀ x, g (of_G G x) = f x)
include Hg1 Hg2

def to_comm_group.unique : g = to_comm_group G H f Hf :=
begin
  funext x,
  cases x with x hx,
  induction hx with x1 h x1 h ih x1 x2 h1 h2 ih1 ih2,
  case group.generate.basic
  { rcases h with ⟨x2, h1, h2⟩,
    specialize Hg2 x2,
    dsimp [of_G] at Hg2,
    have H1 : (⟨ambient.of_G G x2, of_G._proof_1 G x2⟩ : abelianization G) =
      ⟨x1, group.generate.basic x1 (Exists.intro x2 ⟨h1, h2⟩)⟩,
    { congr, exact h2 },
    rw H1 at Hg2,
    rw Hg2,
    dsimp [to_comm_group],
    have h3 := congr_arg (λ z : ambient G, z H f) h2,
    dsimp at h3,
    rw ← h3,
    refl },
  case group.generate.one
  { exact Hg1.one },
  case group.generate.inv
  { have H1 : (⟨x1⁻¹, group.generate.inv x1 h⟩ : abelianization G) =
      @has_inv.inv _ (@group.to_has_inv _ (@comm_group.to_group _ (abelianization.comm_group G))) ⟨x1, h⟩ := rfl,
    rw [H1, ← Hg1.inv, ih],
    refl },
  case group.generate.mul
  { have H1 : (⟨x1 * x2, group.generate.mul x1 x2 h1 h2⟩ : abelianization G) =
      @has_mul.mul _ (@semigroup.to_has_mul _ (@monoid.to_semigroup _ (@group.to_monoid _ (group.generate.group _)))) ⟨x1, h1⟩ ⟨x2, h2⟩ := rfl,
    rw [H1, Hg1, ih1, ih2],
    refl }
end

end abelianization

namespace commutator

def commutators : set G :=
abelianization.of_G G ⁻¹' {1}

variables (x y : G)

theorem commutator : x * y * x⁻¹ * y⁻¹ ∈ commutators G :=
by dsimp [commutators]; simp;
rw [abelianization.of_G.is_group_hom G];
rw [abelianization.of_G.is_group_hom G];
rw [abelianization.of_G.is_group_hom G];
rw [← is_group_hom.inv (abelianization.of_G.is_group_hom G)];
rw [← is_group_hom.inv (abelianization.of_G.is_group_hom G)];
rw [mul_comm (abelianization.of_G G x)];
simp

end commutator


import .logics
import .semantics
import .derivations

/-- If all of a modal system `Σ`'s axioms are valid in a set `𝒞` of models, `Σ` is sound with
    respect to `𝒞`. -/
theorem soundness (𝒞 : set model) (axms : set formula)
    (haxms : ∀axm ∈ axms, ∀a, substitution_inst axm a → (𝒞 ⊨ a)) :
  ∀b, (axms ⊢ b) → (𝒞 ⊨ b) :=
begin
  intros b hd,
  induction hd,
  { apply valid_imp_valid_in _,
    apply k.valid, },
  { apply valid_imp_valid_in _,
    apply dual.valid, },
  { apply valid_imp_valid_in _,
    apply tautology.valid,
    assumption, },
  { apply haxms hd_axm,
    assumption', },
  { intros m _ w _,
    apply mp_valid,
    assumption', },
  { apply nec_valid,
    assumption, },
end

/-- A modal system `Σ` is sound with respect to a set `𝒞` of models iff all `Σ`-derivable formulas
    are valid in `𝒞`. -/
class sound (𝒞 : set model) (axms : set formula) :=
(sound : ∀a, (axms ⊢ a) → (𝒞 ⊨ a))

instance logic.k.sound : sound set.univ logic.k :=
{ sound :=
  begin
    intros b hd,
    apply soundness set.univ logic.k,
    { intros axm haxm a ha,
      rw logic.k at haxm,
      cases haxm,
      repeat {
        cases ha with s hs,
        simp at haxm,
        simp [haxm] at hs,
        rw ←hs,
      },
      { apply k.valid, },
      { apply dual.valid, }, },
    { assumption, },
  end }


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin

! This file was ported from Lean 3 source module order.category.NonemptyFinLinOrd
! leanprover-community/mathlib commit e8ac6315bcfcbaf2d19a046719c3b553206dac75
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Order
import Mathbin.Data.Set.Finite
import Mathbin.Order.Category.LinOrd
import Mathbin.CategoryTheory.Limits.Shapes.Images
import Mathbin.CategoryTheory.Limits.Shapes.RegularMono

/-!
# Nonempty finite linear orders

This defines `NonemptyFinLinOrd`, the category of nonempty finite linear orders with monotone maps.
This is the index category for simplicial objects.
-/

universe u v

open CategoryTheory CategoryTheory.Limits

/-- A typeclass for nonempty finite linear orders. -/
class NonemptyFinLinOrd (α : Type _) extends Fintype α, LinearOrder α where
  Nonempty : Nonempty α := by infer_instance
#align nonempty_fin_lin_ord NonemptyFinLinOrd

attribute [instance] NonemptyFinLinOrd.nonempty

instance (priority := 100) NonemptyFinLinOrd.toBoundedOrder (α : Type _) [NonemptyFinLinOrd α] :
    BoundedOrder α :=
  Fintype.toBoundedOrder α
#align nonempty_fin_lin_ord.to_bounded_order NonemptyFinLinOrd.toBoundedOrder

instance PUnit.nonemptyFinLinOrd : NonemptyFinLinOrd PUnit where
#align punit.nonempty_fin_lin_ord PUnit.nonemptyFinLinOrd

instance Fin.nonemptyFinLinOrd (n : ℕ) : NonemptyFinLinOrd (Fin (n + 1)) where
#align fin.nonempty_fin_lin_ord Fin.nonemptyFinLinOrd

instance ULift.nonemptyFinLinOrd (α : Type u) [NonemptyFinLinOrd α] :
    NonemptyFinLinOrd (ULift.{v} α) :=
  { LinearOrder.lift' Equiv.ulift (Equiv.injective _) with }
#align ulift.nonempty_fin_lin_ord ULift.nonemptyFinLinOrd

instance (α : Type _) [NonemptyFinLinOrd α] : NonemptyFinLinOrd αᵒᵈ :=
  { OrderDual.fintype α with }

/-- The category of nonempty finite linear orders. -/
def NonemptyFinLinOrdCat :=
  Bundled NonemptyFinLinOrd
#align NonemptyFinLinOrd NonemptyFinLinOrdCat

namespace NonemptyFinLinOrdCat

instance : BundledHom.ParentProjection @NonemptyFinLinOrd.toLinearOrder :=
  ⟨⟩

deriving instance LargeCategory, ConcreteCategory for NonemptyFinLinOrdCat

instance : CoeSort NonemptyFinLinOrdCat (Type _) :=
  Bundled.hasCoeToSort

/-- Construct a bundled `NonemptyFinLinOrd` from the underlying type and typeclass. -/
def of (α : Type _) [NonemptyFinLinOrd α] : NonemptyFinLinOrdCat :=
  Bundled.of α
#align NonemptyFinLinOrd.of NonemptyFinLinOrdCat.of

@[simp]
theorem coe_of (α : Type _) [NonemptyFinLinOrd α] : ↥(of α) = α :=
  rfl
#align NonemptyFinLinOrd.coe_of NonemptyFinLinOrdCat.coe_of

instance : Inhabited NonemptyFinLinOrdCat :=
  ⟨of PUnit⟩

instance (α : NonemptyFinLinOrdCat) : NonemptyFinLinOrd α :=
  α.str

instance hasForgetToLinOrd : HasForget₂ NonemptyFinLinOrdCat LinOrd :=
  BundledHom.forget₂ _ _
#align NonemptyFinLinOrd.has_forget_to_LinOrd NonemptyFinLinOrdCat.hasForgetToLinOrd

/-- Constructs an equivalence between nonempty finite linear orders from an order isomorphism
between them. -/
@[simps]
def Iso.mk {α β : NonemptyFinLinOrdCat.{u}} (e : α ≃o β) : α ≅ β
    where
  hom := e
  inv := e.symm
  hom_inv_id' := by
    ext
    exact e.symm_apply_apply x
  inv_hom_id' := by
    ext
    exact e.apply_symm_apply x
#align NonemptyFinLinOrd.iso.mk NonemptyFinLinOrdCat.Iso.mk

/-- `order_dual` as a functor. -/
@[simps]
def dual : NonemptyFinLinOrdCat ⥤ NonemptyFinLinOrdCat
    where
  obj X := of Xᵒᵈ
  map X Y := OrderHom.dual
#align NonemptyFinLinOrd.dual NonemptyFinLinOrdCat.dual

/-- The equivalence between `FinPartOrd` and itself induced by `order_dual` both ways. -/
@[simps Functor inverse]
def dualEquiv : NonemptyFinLinOrdCat ≌ NonemptyFinLinOrdCat :=
  Equivalence.mk dual dual
    (NatIso.ofComponents (fun X => Iso.mk <| OrderIso.dualDual X) fun X Y f => rfl)
    (NatIso.ofComponents (fun X => Iso.mk <| OrderIso.dualDual X) fun X Y f => rfl)
#align NonemptyFinLinOrd.dual_equiv NonemptyFinLinOrdCat.dualEquiv

theorem mono_iff_injective {A B : NonemptyFinLinOrdCat.{u}} (f : A ⟶ B) :
    Mono f ↔ Function.Injective f :=
  by
  refine' ⟨_, concrete_category.mono_of_injective f⟩
  intro
  intro a₁ a₂ h
  let X : NonemptyFinLinOrdCat.{u} := ⟨ULift (Fin 1)⟩
  let g₁ : X ⟶ A := ⟨fun x => a₁, fun x₁ x₂ h => by rfl⟩
  let g₂ : X ⟶ A := ⟨fun x => a₂, fun x₁ x₂ h => by rfl⟩
  change g₁ (ULift.up (0 : Fin 1)) = g₂ (ULift.up (0 : Fin 1))
  have eq : g₁ ≫ f = g₂ ≫ f := by
    ext x
    exact h
  rw [cancel_mono] at eq
  rw [Eq]
#align NonemptyFinLinOrd.mono_iff_injective NonemptyFinLinOrdCat.mono_iff_injective

theorem epi_iff_surjective {A B : NonemptyFinLinOrdCat.{u}} (f : A ⟶ B) :
    Epi f ↔ Function.Surjective f := by
  constructor
  · intro
    by_contra' hf'
    rcases hf' with ⟨m, hm⟩
    let Y : NonemptyFinLinOrdCat.{u} := ⟨ULift (Fin 2)⟩
    let p₁ : B ⟶ Y :=
      ⟨fun b => if b < m then ULift.up 0 else ULift.up 1, fun x₁ x₂ h =>
        by
        simp only
        split_ifs with h₁ h₂ h₂
        any_goals apply Fin.zero_le
        · exfalso
          exact h₁ (lt_of_le_of_lt h h₂)
        · rfl⟩
    let p₂ : B ⟶ Y :=
      ⟨fun b => if b ≤ m then ULift.up 0 else ULift.up 1, fun x₁ x₂ h =>
        by
        simp only
        split_ifs with h₁ h₂ h₂
        any_goals apply Fin.zero_le
        · exfalso
          exact h₁ (h.trans h₂)
        · rfl⟩
    have h : p₁ m = p₂ m := by
      congr
      rw [← cancel_epi f]
      ext a : 2
      simp only [comp_apply, OrderHom.coe_fun_mk]
      split_ifs with h₁ h₂ h₂
      any_goals rfl
      · exfalso
        exact h₂ (le_of_lt h₁)
      · exfalso
        exact hm a (eq_of_le_of_not_lt h₂ h₁)
    simpa only [OrderHom.coe_fun_mk, lt_self_iff_false, if_false, le_refl, if_true, ULift.up_inj,
      Fin.one_eq_zero_iff, Nat.succ_succ_ne_one] using h
  · intro h
    exact concrete_category.epi_of_surjective f h
#align NonemptyFinLinOrd.epi_iff_surjective NonemptyFinLinOrdCat.epi_iff_surjective

instance : SplitEpiCategory NonemptyFinLinOrdCat.{u} :=
  ⟨fun X Y f hf =>
    by
    have H : ∀ y : Y, Nonempty (f ⁻¹' {y}) :=
      by
      rw [epi_iff_surjective] at hf
      intro y
      exact Nonempty.intro ⟨(hf y).some, (hf y).choose_spec⟩
    let φ : Y → X := fun y => (H y).some.1
    have hφ : ∀ y : Y, f (φ y) = y := fun y => (H y).some.2
    refine' is_split_epi.mk' ⟨⟨φ, _⟩, _⟩
    swap
    · ext b
      apply hφ
    · intro a b
      contrapose
      intro h
      simp only [not_le] at h⊢
      suffices b ≤ a by
        apply lt_of_le_of_ne this
        intro h'
        exfalso
        simpa only [h', lt_self_iff_false] using h
      simpa only [hφ] using f.monotone (le_of_lt h)⟩

instance : HasStrongEpiMonoFactorisations NonemptyFinLinOrdCat.{u} :=
  ⟨fun X Y f => by
    let I : NonemptyFinLinOrdCat.{u} := ⟨Set.image (coeFn f) ⊤, ⟨⟩⟩
    let e : X ⟶ I := ⟨fun x => ⟨f x, ⟨x, by tidy⟩⟩, fun x₁ x₂ h => f.monotone h⟩
    let m : I ⟶ Y := ⟨fun y => y, by tidy⟩
    haveI : epi e := by
      rw [epi_iff_surjective]
      tidy
    haveI : strong_epi e := strong_epi_of_epi e
    haveI : mono m := concrete_category.mono_of_injective _ (by tidy)
    exact
      Nonempty.intro
        { i
          m
          e }⟩

end NonemptyFinLinOrdCat

theorem nonemptyFinLinOrdCat_dual_comp_forget_to_linOrd :
    NonemptyFinLinOrdCat.dual ⋙ forget₂ NonemptyFinLinOrdCat LinOrd =
      forget₂ NonemptyFinLinOrdCat LinOrd ⋙ LinOrd.dual :=
  rfl
#align NonemptyFinLinOrd_dual_comp_forget_to_LinOrd nonemptyFinLinOrdCat_dual_comp_forget_to_linOrd


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura, Jeremy Avigad

! This file was ported from Lean 3 source module init.data.prod
! leanprover-community/mathlib commit 7cb84a2a93c1e2d37b3ad5017fc5372973dbb9fb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Logic

universe u v

section

variable {α : Type u} {β : Type v}

#print Prod.mk.eta /-
@[simp]
theorem Prod.mk.eta : ∀ {p : α × β}, (p.1, p.2) = p
  | (a, b) => rfl
#align prod.mk.eta Prod.mk.eta
-/

instance [Inhabited α] [Inhabited β] : Inhabited (Prod α β) :=
  ⟨(default, default)⟩

instance [h₁ : DecidableEq α] [h₂ : DecidableEq β] : DecidableEq (α × β)
  | (a, b), (a', b') =>
    match h₁ a a' with
    | is_true e₁ =>
      match h₂ b b' with
      | is_true e₂ => isTrue (Eq.recOn e₁ (Eq.recOn e₂ rfl))
      | is_false n₂ => isFalse fun h => Prod.noConfusion h fun e₁' e₂' => absurd e₂' n₂
    | is_false n₁ => isFalse fun h => Prod.noConfusion h fun e₁' e₂' => absurd e₁' n₁

end

#print Prod.map /-
def Prod.map.{u₁, u₂, v₁, v₂} {α₁ : Type u₁} {α₂ : Type u₂} {β₁ : Type v₁} {β₂ : Type v₂}
    (f : α₁ → α₂) (g : β₁ → β₂) (x : α₁ × β₁) : α₂ × β₂ :=
  (f x.1, g x.2)
#align prod.map Prod.map
-/


import topology.category.Top.limits
import algebraic_geometry.prime_spectrum.basic

open_locale tensor_product

-- lemma prime_spectrum.zero_locus_map {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S)
--   (I : ideal R) :
--   prime_spectrum.zero_locus ↑(I.map f) = prime_spectrum.zero_locus (f '' I) :=
-- prime_spectrum.zero_locus_span _

-- lemma ideal.radical_map_radical {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S)
--   (I : ideal R) :
--   (I.radical.map f).radical = (I.map f).radical :=
-- begin
--   refine le_antisymm _ (ideal.radical_mono (ideal.map_mono ideal.le_radical)),
--   rw [ideal.radical_le_radical_iff, ideal.map_le_iff_le_comap, ideal.comap_radical],
--   exact ideal.radical_mono ideal.le_comap_map
-- end

-- lemma prime_spectrum.inducing_comap_iff {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S) :
--   inducing (prime_spectrum.comap f) ↔ ∀ I : ideal S, I.radical = ((I.comap f).map f).radical :=
-- begin
--   split,
--   { intros h I,
--     obtain ⟨t, ht₁, ht₂⟩ := h.is_closed_iff.mp (prime_spectrum.is_closed_zero_locus I),
--     obtain ⟨J, rfl⟩ := (prime_spectrum.is_closed_iff_zero_locus_ideal t).mp ht₁,
--     apply_fun prime_spectrum.vanishing_ideal at ht₂,
--     simp only [compl_compl, prime_spectrum.preimage_comap_zero_locus,
--       ← prime_spectrum.zero_locus_map, prime_spectrum.vanishing_ideal_zero_locus_eq_radical] at ht₂,
--     rw [← ideal.radical_map_radical, ← ideal.comap_radical, ← ht₂,
--       ideal.comap_radical, ideal.radical_map_radical, ideal.map_comap_map] },
--   { intros H,
--     refine ⟨(prime_spectrum.comap f).2.le_induced.antisymm _⟩,
--     rintros s hs, rw [← is_open, ← is_closed_compl_iff, is_closed_induced_iff],
--     obtain ⟨I, hI⟩ :=
--       (prime_spectrum.is_closed_iff_zero_locus_ideal _).mp (is_closed_compl_iff.mpr hs),
--     refine ⟨_, prime_spectrum.is_closed_zero_locus (I.comap f), _⟩,
--     swap,
--     rw [hI, continuous_map.to_fun_eq_coe, prime_spectrum.preimage_comap_zero_locus,
--       ← prime_spectrum.zero_locus_map, ← prime_spectrum.zero_locus_radical, ← H,
--       prime_spectrum.zero_locus_radical] }
-- end

-- lemma prime_spectrum.inducing_comap_iff_forall_prime
--   {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S) :
--   inducing (prime_spectrum.comap f) ↔
--     ∀ (I J : ideal S), I.comap f ≤ J.comap f → J.is_prime → I ≤ J :=
-- begin
--   refine (prime_spectrum.inducing_comap_iff f).trans (forall_congr $ λ I, _),
--   rw [← @antisymm_iff (ideal S) (≤), and_iff_left (ideal.radical_mono ideal.map_comap_le),
--     ideal.radical_le_radical_iff, ideal.radical_eq_Inf, le_Inf_iff],
--   simp [ideal.map_le_iff_le_comap]
-- end

-- lemma prime_spectrum.inducing_comap_iff_forall
--   {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S) :
--   inducing (prime_spectrum.comap f) ↔
--     ∀ (x : S) (J : ideal S), J.is_prime → x ∉ J → ∃ y, x ∣ f y ∧ f y ∉ J :=
-- begin
--   rw prime_spectrum.inducing_comap_iff_forall_prime,
--   transitivity ∀ (x : S) (J : ideal S), (ideal.span {x}).comap f ≤ J.comap f → J.is_prime → x ∈ J,
--   { split,
--     { intros H x J hxJ hJ, have := H _ J hxJ hJ,
--       rwa [ideal.span_le, set.singleton_subset_iff] at this },
--     { intros H I J hIJ hJ x hx, refine H x J ((ideal.comap_mono _).trans hIJ) hJ,
--       rwa [ideal.span_le, set.singleton_subset_iff] } },
--   { simp_rw [@forall_swap _ (ideal.is_prime _), ← @not_imp_not (_ ∈ _), set_like.le_def],
--     refine forall₄_congr (λ x J hJ hxJ, _),
--     push_neg,
--     simp only [ideal.mem_comap, ideal.mem_span_singleton] }
-- end

-- lemma prime_spectrum.inducing_comap_iff_embedding
--   {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S) :
--   inducing (prime_spectrum.comap f) ↔ embedding (prime_spectrum.comap f) :=
-- begin
--   refine ⟨λ h, ⟨h, λ I J e, _⟩, λ h, h.1⟩,
--   have : I.as_ideal.comap f = J.as_ideal.comap f := by injection e,
--   rw prime_spectrum.inducing_comap_iff_forall_prime at h,
--   exact le_antisymm (h _ _ this.le infer_instance) (h _ _ this.ge infer_instance),
-- end

noncomputable
abbreviation localization.at_prime.map {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S)
  (p : ideal S) [p.is_prime] :
  localization.at_prime (p.comap f) →+* localization.at_prime p :=
is_localization.map (localization.at_prime p) f
      (show (p.comap f).prime_compl ≤ p.prime_compl.comap f, from le_refl _)

instance {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S)
  (p : ideal S) [p.is_prime] : is_local_ring_hom (localization.at_prime.map f p) :=
begin
  constructor,
  intros x hx,
  obtain ⟨x, s, rfl⟩ := is_localization.mk'_surjective (p.comap f).prime_compl x,
  rw [is_localization.map_mk', is_localization.at_prime.is_unit_mk'_iff _ p] at hx,
  rwa is_localization.at_prime.is_unit_mk'_iff _ (p.comap f),
end

def ring_hom.surjective_on_stalks {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S) : Prop :=
∀ (p : ideal S) [p.is_prime], by exactI function.surjective (localization.at_prime.map f p)

-- lemma prime_spectrum.inducing_of_surjective_on_stalks
--   {R S : Type*} [comm_ring R] [comm_ring S] (f : R →+* S)
--   [is_domain S] (hf₂ : f.surjective_on_stalks) :
--   inducing (prime_spectrum.comap f) :=
-- begin
--   rw prime_spectrum.inducing_comap_iff_forall_prime,
--   introsI I J hI hJ x hx,
--   by_contra h,
--   obtain ⟨y, hy⟩ := (hf₂ J) (is_localization.mk' _ x (1 : J.prime_compl)),
--   obtain ⟨y, s, rfl⟩ := is_localization.mk'_surjective (J.comap f).prime_compl y,
--   rw [is_localization.map_mk', is_localization.mk'_eq_iff_eq, submonoid.coe_one, mul_one,
--     subtype.coe_mk, (is_localization.injective (localization.at_prime J)
--       J.prime_compl_le_non_zero_divisors).eq_iff] at hy,
--   apply J.prime_compl.mul_mem h s.prop,
--   rw ← hy,
--   apply hI,
--   show f y ∈ I,
--   rw hy,
--   exact ideal.mul_mem_right _ _ hx
-- end

lemma ring_hom.surjective_on_stalks_iff {R S : Type*} [comm_ring R] [comm_ring S] {f : R →+* S} :
  f.surjective_on_stalks ↔ ∀ (p : ideal S) (hp : p.is_prime) (x : S),
    ∃ y s c, f s ∉ p ∧ c ∉ p ∧ x * f s * c = f y * c :=
begin
  apply forall₂_congr,
  introsI J hJ,
  split,
  { introsI H x,
    obtain ⟨y, hy⟩ := H (is_localization.mk' _ x (1 : J.prime_compl)),
    obtain ⟨y, ⟨s, hs⟩, rfl⟩ := is_localization.mk'_surjective (J.comap f).prime_compl y,
    rw [is_localization.map_mk', is_localization.mk'_eq_iff_eq, submonoid.coe_one, mul_one,
      subtype.coe_mk, is_localization.eq_iff_exists J.prime_compl] at hy,
    obtain ⟨⟨c, hc⟩, e⟩ := hy,
    exact ⟨y, s, c, hs, hc, e.symm⟩ },
  { intros H x,
    obtain ⟨x, ⟨t, ht⟩, rfl⟩ := is_localization.mk'_surjective J.prime_compl x,
    obtain ⟨y, s, c, hs, hc, e⟩ := H x,
    obtain ⟨z, u, c', hu, hc', e'⟩ := H t,
    have : s * z ∈ (J.comap f).prime_compl,
    { rintro (h : f (s * z) ∈ J),
      apply J.prime_compl.mul_mem hs (mul_mem (mul_mem ht hu) hc'),
      rw [e', ← mul_assoc, ← map_mul],
      exact ideal.mul_mem_right _ _ h },
    refine ⟨is_localization.mk' _ (y * u) ⟨s * z, this⟩, _⟩,
    rw [is_localization.map_mk', is_localization.mk'_eq_iff_eq,
      is_localization.eq_iff_exists J.prime_compl],
    refine ⟨⟨_, J.prime_compl.mul_mem hc hc'⟩, _⟩,
    simp only [subtype.coe_mk, map_mul],
    transitivity (f y * c) * (t * f u * c'),
    { ring },
    { rw [← e, e'], ring } }
end

/-- `f : R →+* S` is surjective on stalks if every `x : S` can be written as
`x = f a / f b` for some unit `f b`. In particular surjections and localizations
(and compositions of them) satisfy this condition. -/
lemma ring_hom.surjective_on_stalks_of_exists_eq_div
  {R S : Type*} [comm_ring R] [comm_ring S] {f : R →+* S}
  (hf : ∀ x : S, ∃ a b : R, is_unit (f b) ∧ x * f b = f a) : f.surjective_on_stalks :=
begin
  rw ring_hom.surjective_on_stalks_iff,
  introsI p hp x,
  obtain ⟨a, b, hb, e⟩ := hf x,
  refine ⟨a, b, 1, λ h, hp.1 (ideal.eq_top_of_is_unit_mem _ h hb), p.prime_compl.one_mem,
    by simpa only [mul_one]⟩,
end

lemma tensor_product_exists_of_surjective_on_stalks
  (R S T : Type*) [comm_ring R] [comm_ring S] [comm_ring T]
  [algebra R S] [algebra R T]
  (hf₂ : (algebra_map R T).surjective_on_stalks)
  (x : S ⊗[R] T) (J : ideal T) (hJ : J.is_prime) :
  ∃ (t : T) (r : R) a, (r • t ∉ J) ∧
    (1 : S) ⊗ₜ[R] (r • t) * x = a ⊗ₜ t :=
begin
  let g : T →+* S ⊗[R] T := ↑(algebra.tensor_product.include_right : T →ₐ[R] S ⊗ T),
  induction x using tensor_product.induction_on with x₁ x₂ x₁ x₂ hx₁ hx₂,
  { exact ⟨1, 1, 0, by { rw one_smul, exact J.prime_compl.one_mem },
      by rw [mul_zero, tensor_product.zero_tmul]⟩ },
  { obtain ⟨y, s, c, hs, hc, e⟩ :=
      ring_hom.surjective_on_stalks_iff.mp hf₂ J infer_instance x₂,
    simp_rw algebra.smul_def,
    refine ⟨c, s, y • x₁, J.prime_compl.mul_mem hs hc, _⟩,
    rw [mul_comm, algebra.tensor_product.tmul_mul_tmul, mul_one, ← mul_assoc, e,
      tensor_product.smul_tmul, algebra.smul_def] },
  { obtain ⟨t₁, r₁, a₁, hr₁, e₁⟩ := hx₁,
    obtain ⟨t₂, r₂, a₂, hr₂, e₂⟩ := hx₂,
    have : (r₁ * r₂) • (t₁ * t₂) = (r₁ • t₁) * (r₂ • t₂),
    { simp_rw [← smul_eq_mul], rw smul_smul_smul_comm },
    refine ⟨t₁ * t₂, r₁ * r₂, r₂ • a₁ + r₁ • a₂, this.symm ▸ J.prime_compl.mul_mem hr₁ hr₂, _⟩,
    rw [this, ← one_mul (1 : S), ← algebra.tensor_product.tmul_mul_tmul, mul_add, mul_comm (_ ⊗ₜ _),
      mul_assoc, e₁, algebra.tensor_product.tmul_mul_tmul, one_mul, smul_mul_assoc,
      ← tensor_product.smul_tmul, mul_comm (_ ⊗ₜ _), mul_assoc, e₂,
      algebra.tensor_product.tmul_mul_tmul, one_mul, smul_mul_assoc, ← tensor_product.smul_tmul,
      tensor_product.add_tmul, mul_comm t₁ t₂] }
end

-- lemma tensor_product_inducing_of_inducing_of_surjective_on_stalks
--   (R S T : Type*) [comm_ring R] [comm_ring S] [comm_ring T]
--   [algebra R S] [algebra R T] (hf : inducing (prime_spectrum.comap (algebra_map R T)))
--   (hf₂ : (algebra_map R T).surjective_on_stalks) :
--   inducing (prime_spectrum.comap (algebra_map S (S ⊗[R] T))) :=
-- begin
--   let g : T →+* S ⊗[R] T := ↑(algebra.tensor_product.include_right : T →ₐ[R] S ⊗ T),
--   rw prime_spectrum.inducing_comap_iff_forall at hf ⊢,
--   introsI x J hJ hxJ,
--   obtain ⟨t, r, a, ht, e⟩ := tensor_product_exists_of_surjective_on_stalks R S T hf₂ x (J.comap g)
--     infer_instance,
--   obtain ⟨y, ⟨c, hc⟩, hy⟩ := hf (r • t) (J.comap g) infer_instance ht,
--   refine ⟨y • a, ⟨1 ⊗ₜ[R] (r • t) * 1 ⊗ₜ[R] (r • c), _⟩, _⟩,
--   { rw [mul_left_comm, ← mul_assoc, e, algebra.tensor_product.tmul_mul_tmul, mul_one, mul_smul_comm,
--       ← smul_mul_assoc, ← hc, algebra.algebra_map_eq_smul_one y, ← tensor_product.smul_tmul],
--     refl },
--   { rintro (h : (y • a) ⊗ₜ[R] (1 : T) ∈ J),
--     apply J.prime_compl.mul_mem ht hxJ,
--     rw [tensor_product.smul_tmul, algebra.smul_def, ← one_mul a,
--       ← algebra.tensor_product.tmul_mul_tmul] at h,
--     have := ideal.mul_mem_right (1 ⊗ₜ t) _ ((hJ.mul_mem_iff_mem_or_mem.mp h).resolve_left hy),
--     rwa [algebra.tensor_product.tmul_mul_tmul, one_mul, mul_one, ← e] at this }
-- end

lemma tensor_product_surjective_on_stalks
  (R S T : Type*) [comm_ring R] [comm_ring S] [comm_ring T]
  [algebra R S] [algebra R T] (hf : (algebra_map R T).surjective_on_stalks) :
  (algebra_map S (S ⊗[R] T)).surjective_on_stalks :=
begin
  let g : T →+* S ⊗[R] T := ↑(algebra.tensor_product.include_right : T →ₐ[R] S ⊗ T),
  rw ring_hom.surjective_on_stalks_iff,
  introsI J hJ x,
  obtain ⟨t, r, a, ht, e⟩ := tensor_product_exists_of_surjective_on_stalks R S T hf x (J.comap g)
    infer_instance,
  refine ⟨a, algebra_map _ _ r, 1 ⊗ₜ (r • t), _, ht, _⟩,
  { rw [ideal.mem_comap, alg_hom.coe_to_ring_hom, map_smul,
      algebra.tensor_product.include_right_apply, algebra.smul_def,
      is_scalar_tower.algebra_map_apply R S (S ⊗[R] T)] at ht,
    exact λ h, ht (ideal.mul_mem_right _ _ h) },
  { rw [mul_comm, ← mul_assoc, e, algebra.tensor_product.algebra_map_apply,
      algebra.tensor_product.algebra_map_apply, algebra.tensor_product.tmul_mul_tmul, mul_one,
      algebra.tensor_product.tmul_mul_tmul, mul_one, one_mul, mul_comm, ← tensor_product.smul_tmul,
      algebra.id.map_eq_self, ← algebra.smul_def, algebra.id.map_eq_self] }
end

universe u

@[simps apply_coe_fst apply_coe_snd]
def prime_spectrum.tensor_product_to (R S T : Type u) [comm_ring R] [comm_ring S] [comm_ring T]
  [algebra R S] [algebra R T] :
  C(prime_spectrum (S ⊗[R] T), { x : prime_spectrum S × prime_spectrum T //
    prime_spectrum.comap (algebra_map R S) x.1 = prime_spectrum.comap (algebra_map R T) x.2 }) :=
begin
  refine (@Top.pullback_cone_is_limit (Top.of $ prime_spectrum S)
    (Top.of $ prime_spectrum T) (Top.of $ prime_spectrum R)
    (prime_spectrum.comap (algebra_map R S)) (prime_spectrum.comap (algebra_map R T))).lift
    (@category_theory.limits.pullback_cone.mk _ _ (Top.of $ prime_spectrum S)
    (Top.of $ prime_spectrum T) (Top.of $ prime_spectrum R)
    (prime_spectrum.comap (algebra_map R S)) (prime_spectrum.comap (algebra_map R T))
    (Top.of $ prime_spectrum (S ⊗[R] T))
    (prime_spectrum.comap $ algebra_map S (S ⊗[R] T))
    (prime_spectrum.comap $ ↑(algebra.tensor_product.include_right : T →ₐ[R] S ⊗ T)) _),
  ext1 s,
  simp only [category_theory.coe_comp, function.comp_apply, ← prime_spectrum.comap_comp_apply,
    alg_hom.comp_algebra_map, ← is_scalar_tower.algebra_map_eq],
end

lemma prime_spectrum.le_of_tensor_product_to_eq
  (R S T : Type*) [comm_ring R] [comm_ring S] [comm_ring T]
  [algebra R S] [algebra R T]
  (hf : (algebra_map R T).surjective_on_stalks) (p₁ p₂ : prime_spectrum (S ⊗[R] T))
  (h : prime_spectrum.tensor_product_to R S T p₁ = prime_spectrum.tensor_product_to R S T p₂) :
  p₁ ≤ p₂ :=
begin
  let g : T →+* S ⊗[R] T := ↑(algebra.tensor_product.include_right : T →ₐ[R] S ⊗ T),
  intros x hxp₁,
  by_contra hxp₂,
  obtain ⟨t, r, a, ht, e⟩ := tensor_product_exists_of_surjective_on_stalks R S T hf x
    (p₂.as_ideal.comap g) infer_instance,
  have h₁ : a ⊗ₜ[R] t ∈ p₁.as_ideal := e ▸ p₁.as_ideal.mul_mem_left (1 ⊗ₜ[R] (r • t)) hxp₁,
  have h₂ : a ⊗ₜ[R] t ∉ p₂.as_ideal := e ▸ p₂.as_ideal.prime_compl.mul_mem ht hxp₂,
  rw [← mul_one a, ← one_mul t, ← algebra.tensor_product.tmul_mul_tmul] at h₁ h₂,
  have h₃ : t ∉ p₂.as_ideal.comap g,
  { intro h, apply h₂, exact ideal.mul_mem_left _ _ h },
  have h₄ : a ∉ p₂.as_ideal.comap (algebra_map S (S ⊗[R] T)),
  { intro h, apply h₂, exact ideal.mul_mem_right _ _ h },
  replace h₃ : t ∉ p₁.as_ideal.comap g,
  { apply_fun prime_spectrum.as_ideal ∘ prod.snd ∘ subtype.val at h,
    have : p₁.as_ideal.comap g = p₂.as_ideal.comap g := by convert h, rwa this },
  replace h₄ : a ∉ p₁.as_ideal.comap (algebra_map S (S ⊗[R] T)),
  { apply_fun prime_spectrum.as_ideal ∘ prod.fst ∘ subtype.val at h,
    have : p₁.as_ideal.comap (algebra_map S (S ⊗[R] T)) =
      p₂.as_ideal.comap (algebra_map S (S ⊗[R] T)) := by convert h, rwa this },
  { apply p₁.as_ideal.prime_compl.mul_mem h₄ h₃, exact h₁ }
end

lemma prime_spectrum.tensor_product_to_embedding
  (R S T : Type*) [comm_ring R] [comm_ring S] [comm_ring T]
  [algebra R S] [algebra R T]
  (hf : (algebra_map R T).surjective_on_stalks) :
  embedding (prime_spectrum.tensor_product_to R S T) :=
begin
  refine ⟨_, λ p₁ p₂ e, (prime_spectrum.le_of_tensor_product_to_eq R S T hf p₁ p₂ e).antisymm
    (prime_spectrum.le_of_tensor_product_to_eq R S T hf p₂ p₁ e.symm)⟩,
  let g : T →+* S ⊗[R] T := ↑(algebra.tensor_product.include_right : T →ₐ[R] S ⊗ T),
  refine ⟨(prime_spectrum.tensor_product_to R S T).2.le_induced.antisymm _⟩,
  delta subtype.topological_space,
  rw induced_compose,
  conv_rhs { rw prime_spectrum.is_basis_basic_opens.eq_generate_from },
  rw le_generate_from_iff_subset_is_open,
  rintros _ ⟨_, ⟨f, rfl⟩, rfl⟩,
  change is_open _,
  rw is_open_iff_forall_mem_open,
  rintros J (hJ : f ∉ J.as_ideal),
  obtain ⟨t, r, a, ht, e⟩ := tensor_product_exists_of_surjective_on_stalks R S T hf f
    (J.as_ideal.comap g) infer_instance,
  refine ⟨_, _, ⟨prime_spectrum.basic_open a ×ˢ prime_spectrum.basic_open t,
    prime_spectrum.is_open_basic_open.prod prime_spectrum.is_open_basic_open, rfl⟩, _⟩,
  { rintro x ⟨hx₁ : a ⊗ₜ[R] (1 : T) ∉ x.as_ideal, hx₂ : (1 : S) ⊗ₜ[R] t ∉ x.as_ideal⟩
      (hx₃ : f ∈ x.as_ideal),
    apply x.as_ideal.prime_compl.mul_mem hx₁ hx₂,
    rw [algebra.tensor_product.tmul_mul_tmul, mul_one, one_mul, ← e],
    exact x.as_ideal.mul_mem_left _ hx₃ },
  { have : a ⊗ₜ[R] (1 : T) * (1 : S) ⊗ₜ[R] t ∉ J.as_ideal,
    { rw [algebra.tensor_product.tmul_mul_tmul, mul_one, one_mul, ← e],
      exact J.as_ideal.prime_compl.mul_mem ht hJ },
    rwa [J.is_prime.mul_mem_iff_mem_or_mem.not, not_or_distrib] at this }
end


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen

! This file was ported from Lean 3 source module number_theory.class_number.admissible_absolute_value
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Real.Basic
import Mathlib.Combinatorics.Pigeonhole
import Mathlib.Algebra.Order.EuclideanAbsoluteValue

/-!
# Admissible absolute values
This file defines a structure `AbsoluteValue.IsAdmissible` which we use to show the class number
of the ring of integers of a global field is finite.

## Main definitions

 * `AbsoluteValue.IsAdmissible abv` states the absolute value `abv : R → ℤ`
   respects the Euclidean domain structure on `R`, and that a large enough set
   of elements of `R^n` contains a pair of elements whose remainders are
   pointwise close together.

## Main results

 * `AbsoluteValue.absIsAdmissible` shows the "standard" absolute value on `ℤ`,
   mapping negative `x` to `-x`, is admissible.
 * `Polynomial.cardPowDegreeIsAdmissible` shows `cardPowDegree`,
   mapping `p : Polynomial 𝔽_q` to `q ^ degree p`, is admissible
-/

local infixl:50 " ≺ " => EuclideanDomain.r

namespace AbsoluteValue

variable {R : Type _} [EuclideanDomain R]

variable (abv : AbsoluteValue R ℤ)

/-- An absolute value `R → ℤ` is admissible if it respects the Euclidean domain
structure and a large enough set of elements in `R^n` will contain a pair of
elements whose remainders are pointwise close together. -/
structure IsAdmissible extends IsEuclidean abv where
  protected card : ℝ → ℕ
  /-- For all `ε > 0` and finite families `A`, we can partition the remainders of `A` mod `b`
  into `abv.card ε` sets, such that all elements in each part of remainders are close together. -/
  exists_partition' :
    ∀ (n : ℕ) {ε : ℝ} (_ : 0 < ε) {b : R} (_ : b ≠ 0) (A : Fin n → R),
      ∃ t : Fin n → Fin (card ε), ∀ i₀ i₁, t i₀ = t i₁ → (abv (A i₁ % b - A i₀ % b) : ℝ) < abv b • ε
#align absolute_value.is_admissible AbsoluteValue.IsAdmissible

-- Porting note: no docstrings for IsAdmissible
attribute [nolint docBlame] IsAdmissible.card

namespace IsAdmissible

variable {abv}

/-- For all `ε > 0` and finite families `A`, we can partition the remainders of `A` mod `b`
into `abv.card ε` sets, such that all elements in each part of remainders are close together. -/
theorem exists_partition {ι : Type _} [Fintype ι] {ε : ℝ} (hε : 0 < ε) {b : R} (hb : b ≠ 0)
    (A : ι → R) (h : abv.IsAdmissible) :
    ∃ t : ι → Fin (h.card ε), ∀ i₀ i₁, t i₀ = t i₁ → (abv (A i₁ % b - A i₀ % b) : ℝ) < abv b • ε :=
  by
  let e := Fintype.equivFin ι
  obtain ⟨t, ht⟩ := h.exists_partition' (Fintype.card ι) hε hb (A ∘ e.symm)
  refine' ⟨t ∘ e, fun i₀ i₁ h ↦ _⟩
  convert (config := {transparency := .default})
    ht (e i₀) (e i₁) h <;> simp only [e.symm_apply_apply]
#align absolute_value.is_admissible.exists_partition AbsoluteValue.IsAdmissible.exists_partition

/-- Any large enough family of vectors in `R^n` has a pair of elements
whose remainders are close together, pointwise. -/
theorem exists_approx_aux (n : ℕ) (h : abv.IsAdmissible) :
    ∀ {ε : ℝ} (_hε : 0 < ε) {b : R} (_hb : b ≠ 0) (A : Fin (h.card ε ^ n).succ → Fin n → R),
      ∃ i₀ i₁, i₀ ≠ i₁ ∧ ∀ k, (abv (A i₁ k % b - A i₀ k % b) : ℝ) < abv b • ε := by
  haveI := Classical.decEq R
  induction' n with n ih
  · intro ε _hε b _hb A
    refine' ⟨0, 1, _, _⟩
    · simp
    rintro ⟨i, ⟨⟩⟩
  intro ε hε b hb A
  let M := h.card ε
  -- By the "nicer" pigeonhole principle, we can find a collection `s`
  -- of more than `M^n` remainders where the first components lie close together:
  obtain ⟨s, s_inj, hs⟩ :
    ∃ s : Fin (M ^ n).succ → Fin (M ^ n.succ).succ,
      Function.Injective s ∧ ∀ i₀ i₁, (abv (A (s i₁) 0 % b - A (s i₀) 0 % b) : ℝ) < abv b • ε :=
    by
    -- We can partition the `A`s into `M` subsets where
    -- the first components lie close together:
    obtain ⟨t, ht⟩ :
      ∃ t : Fin (M ^ n.succ).succ → Fin M,
        ∀ i₀ i₁, t i₀ = t i₁ → (abv (A i₁ 0 % b - A i₀ 0 % b) : ℝ) < abv b • ε :=
      h.exists_partition hε hb fun x ↦ A x 0
    -- Since the `M` subsets contain more than `M * M^n` elements total,
    -- there must be a subset that contains more than `M^n` elements.
    obtain ⟨s, hs⟩ :=
      @Fintype.exists_lt_card_fiber_of_mul_lt_card _ _ _ _ _ t (M ^ n)
        (by simpa only [Fintype.card_fin, pow_succ] using Nat.lt_succ_self (M ^ n.succ))
    refine'
      ⟨fun i ↦ (Finset.univ.filter fun x ↦ t x = s).toList.nthLe i _, _, fun i₀ i₁ ↦ ht _ _ _⟩
    · refine' i.2.trans_le _
      rwa [Finset.length_toList]
    · intro i j h
      ext
      exact Fin.mk.inj_iff.mp (List.nodup_iff_injective_get.mp (Finset.nodup_toList _) h)
    have :
      ∀ i h,
        (Finset.univ.filter fun x ↦ t x = s).toList.nthLe i h ∈
          Finset.univ.filter fun x ↦ t x = s :=
      by
      intro i h
      exact Finset.mem_toList.mp (List.get_mem _ i h)
    obtain ⟨_, h₀⟩ := Finset.mem_filter.mp (this i₀ _)
    obtain ⟨_, h₁⟩ := Finset.mem_filter.mp (this i₁ _)
    exact h₀.trans h₁.symm
  -- Since `s` is large enough, there are two elements of `A ∘ s`
  -- where the second components lie close together.
  obtain ⟨k₀, k₁, hk, h⟩ := ih hε hb fun x ↦ Fin.tail (A (s x))
  refine' ⟨s k₀, s k₁, fun h ↦ hk (s_inj h), fun i ↦ Fin.cases _ (fun i ↦ _) i⟩
  · exact hs k₀ k₁
  · exact h i
#align absolute_value.is_admissible.exists_approx_aux AbsoluteValue.IsAdmissible.exists_approx_aux

/-- Any large enough family of vectors in `R^ι` has a pair of elements
whose remainders are close together, pointwise. -/
theorem exists_approx {ι : Type _} [Fintype ι] {ε : ℝ} (hε : 0 < ε) {b : R} (hb : b ≠ 0)
    (h : abv.IsAdmissible) (A : Fin (h.card ε ^ Fintype.card ι).succ → ι → R) :
    ∃ i₀ i₁, i₀ ≠ i₁ ∧ ∀ k, (abv (A i₁ k % b - A i₀ k % b) : ℝ) < abv b • ε := by
  let e := Fintype.equivFin ι
  obtain ⟨i₀, i₁, ne, h⟩ := h.exists_approx_aux (Fintype.card ι) hε hb fun x y ↦ A x (e.symm y)
  refine' ⟨i₀, i₁, ne, fun k ↦ _⟩
  convert h (e k) <;> simp only [e.symm_apply_apply]
#align absolute_value.is_admissible.exists_approx AbsoluteValue.IsAdmissible.exists_approx

end IsAdmissible

end AbsoluteValue


import combinatorics.simple_graph.basic
import combinatorics.simple_graph.subgraph
import data.finset.basic
import data.finset.card
import data.fintype.basic
import data.fintype.card
import data.finset.powerset
import simple_graph_aux
import complete_graph_aux
import coercions_aux
import induced_subgraph

universe u
variables {V : Type u} [fintype V] [decidable_eq V]
variables (G : simple_graph V) [decidable_rel G.adj]
variables {k : ℕ}

variable R : ↥(finset.powerset_len k (finset.univ : finset V))

variable red_edges : (finset ↥G.edge_finset)

variable red_edges_by_R :
finset ↥(G.edge_finset \ ((G.induced_subgraph R).edge_finset)) ×
finset ↥((G.induced_subgraph R).edge_finset)

theorem card_R : (R : finset V).card = k :=
begin
  cases R with R R_in,
  change R.card = k,
  rw finset.mem_powerset_len at R_in,
  rw R_in.right,
end

def red_edges_by_R_coe :
( finset ↥(G.edge_finset \ ((G.induced_subgraph R).edge_finset)) ×
  finset ↥((G.induced_subgraph R).edge_finset) ) →
  (finset ↥G.edge_finset) := λ c,
  ↑(⟨finset.map (function.embedding.subtype _) c.fst ∪
    finset.map (function.embedding.subtype _) c.snd,
    begin
      rw finset.union_subset_iff,
      split,
      { rw finset.subset_iff,
        intro x,
        intro x_in,
        have x_in' := finset.property_of_mem_map_subtype c.fst x_in,
        rw finset.mem_sdiff at x_in',
        exact x_in'.left,},
      { rw finset.subset_iff,
        intro x,
        intro x_in,
        have x_in' := finset.property_of_mem_map_subtype c.snd x_in,
        apply finset.mem_of_subset,
        exact (G.induced_subgraph R).edge_finset_subset,
        exact x_in', },
    end⟩ : {s // s ⊆ G.edge_finset})

instance red_edges_by_R_has_coe : has_coe
  ( finset ↥(G.edge_finset \ ((G.induced_subgraph R).edge_finset)) ×
    finset ↥((G.induced_subgraph R).edge_finset))
  (finset ↥G.edge_finset)
:= ⟨red_edges_by_R_coe G R⟩

theorem red_edges_by_R_coe_inj :
function.injective (red_edges_by_R_coe G R) :=
begin
  unfold function.injective,
  unfold red_edges_by_R_coe,
  change (coe :
    {s // s ⊆ G.edge_finset} →
      finset ↥(G.edge_finset))
    with subset_subtype.finset_subtype.coe,
  intros c₁ c₂,
  intro h_union,
  rw function.injective.eq_iff subset_subtype.finset_subtype.coe_injective
    at h_union,
  rw subtype.mk_eq_mk at h_union,
  rw prod.ext_iff,
  split,
  { rw finset.ext_iff,
    intro e,
    split,
    { intro e_in₁,
      have e_coe_in₁ := finset.mem_map_of_mem
        (function.embedding.subtype _) e_in₁,
      rw function.embedding.coe_subtype _ at e_coe_in₁,
      have e_coe_in_union :
        ↑e ∈ finset.map (function.embedding.subtype _) c₁.fst ∪
          finset.map (function.embedding.subtype _) c₁.snd,
      { rw finset.mem_union,
        left,
        exact e_coe_in₁, },
      rw h_union at e_coe_in_union,
      have e_coe_in₂ :
        ↑e ∈ finset.map (function.embedding.subtype _) c₂.fst,
      { rw finset.mem_union at e_coe_in_union,
        cases e_coe_in_union with e_coe_in₂ e_coe_in_false,
        { exact e_coe_in₂, },
        { exfalso,
          have e_in_R :=
            finset.property_of_mem_map_subtype _ e_coe_in_false,
          have e_not_in_R := e.property,
          rw finset.mem_sdiff at e_not_in_R,
          exact e_not_in_R.right e_in_R, }, },
      simp only [finset.mem_sdiff, simple_graph.mem_edge_finset,
        simple_graph.complete_graph_eq_top, coe_coe, finset.mem_map,
        function.embedding.coe_subtype, exists_prop, subtype.exists,
        subtype.coe_mk, exists_and_distrib_right, exists_eq_right,
        finset.mk_coe] at e_coe_in₂,
      exact e_coe_in₂.right, },
    { intro e_in₂,
      have e_coe_in₂ := finset.mem_map_of_mem
        (function.embedding.subtype _) e_in₂,
      rw function.embedding.coe_subtype _ at e_coe_in₂,
      have e_coe_in_union :
        ↑e ∈ finset.map (function.embedding.subtype _) c₂.fst ∪
          finset.map (function.embedding.subtype _) c₂.snd,
      { rw finset.mem_union,
        left,
        exact e_coe_in₂, },
      rw ← h_union at e_coe_in_union,
      have e_coe_in₁ :
        ↑e ∈ finset.map (function.embedding.subtype _) c₁.fst,
      { rw finset.mem_union at e_coe_in_union,
        cases e_coe_in_union with e_coe_in₁ e_coe_in_false,
        { exact e_coe_in₁, },
        { exfalso,
          have e_in_R :=
            finset.property_of_mem_map_subtype _ e_coe_in_false,
          have e_not_in_R := e.property,
          rw finset.mem_sdiff at e_not_in_R,
          exact e_not_in_R.right e_in_R,}, },
      simp only [finset.mem_sdiff, simple_graph.mem_edge_finset,
        simple_graph.complete_graph_eq_top, coe_coe, finset.mem_map,
        function.embedding.coe_subtype, exists_prop, subtype.exists,
        subtype.coe_mk, exists_and_distrib_right, exists_eq_right,
        finset.mk_coe] at e_coe_in₁,
      exact e_coe_in₁.right, }, },
  { rw finset.ext_iff,
    intro e,
    split,
    { intro e_in₁,
      have e_coe_in₁ := finset.mem_map_of_mem
        (function.embedding.subtype _) e_in₁,
      rw function.embedding.coe_subtype at e_coe_in₁,
      have e_coe_in_union :
        ↑e ∈ finset.map (function.embedding.subtype _) c₁.fst ∪
          finset.map (function.embedding.subtype _) c₁.snd,
      { rw finset.mem_union,
        right,
        exact e_coe_in₁, },
      rw h_union at e_coe_in_union,
      have e_coe_in₂ :
        ↑e ∈ finset.map (function.embedding.subtype _) c₂.snd,
      { rw finset.mem_union at e_coe_in_union,
        cases e_coe_in_union with e_coe_in_false e_coe_in₂,
        { exfalso,
          have e_not_in_R :=
            finset.property_of_mem_map_subtype _ e_coe_in_false,
          rw finset.mem_sdiff at e_not_in_R,
          have e_in_R := e.property,
          exact e_not_in_R.right e_in_R, },
        { exact e_coe_in₂, }, },
      simp only [coe_coe, finset.mem_map, function.embedding.coe_subtype,
        exists_prop, subtype.exists, subtype.coe_mk,
        exists_and_distrib_right, exists_eq_right, finset.mk_coe]
        at e_coe_in₂,
      exact e_coe_in₂.right, },
    { intro e_in₂,
      have e_coe_in₂ := finset.mem_map_of_mem
        (function.embedding.subtype _) e_in₂,
      rw function.embedding.coe_subtype at e_coe_in₂,
      have e_coe_in_union :
        ↑e ∈ finset.map (function.embedding.subtype _) c₂.fst ∪
          finset.map (function.embedding.subtype _) c₂.snd,
      { rw finset.mem_union,
        right,
        exact e_coe_in₂, },
      rw ← h_union at e_coe_in_union,
      have e_coe_in₁ :
        ↑e ∈ finset.map (function.embedding.subtype _) c₁.snd,
      { rw finset.mem_union at e_coe_in_union,
        cases e_coe_in_union with e_coe_in_false e_coe_in₁,
        { exfalso,
          have e_not_in_R :=
            finset.property_of_mem_map_subtype _ e_coe_in_false,
          rw finset.mem_sdiff at e_not_in_R,
          have e_in_R := e.property,
          exact e_not_in_R.right e_in_R, },
        { exact e_coe_in₁, }, },
      simp only [coe_coe, finset.mem_map, function.embedding.coe_subtype,
        exists_prop, subtype.exists, subtype.coe_mk,
        exists_and_distrib_right, exists_eq_right, finset.mk_coe]
        at e_coe_in₁,
      exact e_coe_in₁.right, }, },
end

def A : Prop :=
∀ (e₁ : ↥((G.induced_subgraph R).edge_finset))
  (e₂ : ↥((G.induced_subgraph R).edge_finset)),
( set.inclusion (G.induced_subgraph R).edge_finset_subset e₁ ∈ red_edges ∧
  set.inclusion (G.induced_subgraph R).edge_finset_subset e₂ ∈ red_edges ) ∨
( set.inclusion (G.induced_subgraph R).edge_finset_subset e₁ ∉ red_edges ∧
  set.inclusion (G.induced_subgraph R).edge_finset_subset e₂ ∉ red_edges )

instance A_decidable : decidable_pred (A G R) :=
begin
  unfold decidable_pred,
  intro red_edges,
  unfold A,
  refine fintype.decidable_forall_fintype,
end

def finset_univ_two_colouring : finset (finset ↥(G.edge_finset)) :=
finset.univ

def two_colourings_sat_A_R : finset (finset ↥(G.edge_finset)) :=
finset.filter (A G R) (finset_univ_two_colouring G)

def empty_univ_col_R :
finset (finset ↥(G.edge_finset \ ((G.induced_subgraph R).edge_finset)) ×
 finset ↥((G.induced_subgraph R).edge_finset)) :=
finset.product finset.univ {∅, finset.univ}

theorem all_red_colourings_sat_A_R :
two_colourings_sat_A_R (complete_graph V) R =
finset.map
  ⟨red_edges_by_R_coe (complete_graph V) R, red_edges_by_R_coe_inj _ _⟩
  (empty_univ_col_R (complete_graph V) R) :=
begin
  unfold two_colourings_sat_A_R,
  unfold finset_univ_two_colouring,
  unfold empty_univ_col_R,
  unfold red_edges_by_R_coe,
  change (coe :
    {s // s ⊆ (complete_graph V).edge_finset} →
      finset ↥((complete_graph V).edge_finset))
    with subset_subtype.finset_subtype.coe,
  rw finset.ext_iff,
  intro c,
  simp only [finset.mem_filter, finset.mem_univ, true_and, finset.mem_map,
    finset.mem_product, finset.mem_insert, finset.mem_singleton,
    function.embedding.coe_fn_mk, exists_prop, prod.exists],
  split,
  { intro hA,
    generalize h_cR :
      simple_graph.induced_subgraph.edge_subtype_finset
        (complete_graph V) R (finset.map (function.embedding.subtype _) c)
      = cR,
    generalize h_cRc :
      simple_graph.induced_subgraph.edge_complement_subtype_finset
        (complete_graph V) R (finset.map (function.embedding.subtype _) c)
      = cRc,
    use cRc,
    use cR,
    rw ← @finset.map_inj _ _
      (function.embedding.subtype (∈ (complete_graph V).edge_finset)) _ _,
    rw subset_subtype.coe_type,
    have h_union :
      finset.map (function.embedding.subtype _) cRc ∪
      finset.map (function.embedding.subtype _) cR =
      finset.map (function.embedding.subtype _) c,
    { rw ← h_cR,
      rw ← h_cRc,
      unfold simple_graph.induced_subgraph.edge_complement_subtype_finset,
      unfold simple_graph.induced_subgraph.edge_subtype_finset,
      rw finset.subtype_map,
      rw finset.subtype_map,
      simp_rw [finset.mem_sdiff],
      rw finset.union_comm,
      rw finset.filter_and,
      rw finset.union_distrib_left,
      rw finset.filter_union_filter_neg_eq
        (∈ ((complete_graph V).induced_subgraph ↑R).edge_finset)
          (finset.map (function.embedding.subtype _) c),
      have h_eq_c :
        finset.filter
          (∈ (complete_graph V).edge_finset)
          (finset.map (function.embedding.subtype _) c) =
        (finset.map (function.embedding.subtype _) c),
      { rw finset.filter_eq_self,
        intro x,
        intro x_in,
        have := finset.property_of_mem_map_subtype _ x_in,
        exact this, },
      rw h_eq_c,
      rw finset.union_comm,
      exact finset.union_inter_cancel_left, },
    cases finset.eq_empty_or_nonempty cR with cR_empty cR_nonempty,
    { clear hA,
      split,
      { left,
        exact cR_empty,},
      { exact h_union, }, },
    { split,
      { clear h_union,
        right,
        unfold finset.nonempty at cR_nonempty,
        cases cR_nonempty with e₁ e₁_in,
        apply finset.ext,
        intro e₂,
        split,
        { revert e₂,
          exact cR.subset_univ, },
        { intro e₂_in,
          specialize hA e₁ e₂,
          cases hA with h_red h_blue,
          { rw ← h_cR,
            unfold simple_graph.induced_subgraph.edge_subtype_finset,
            simp only [simple_graph.mem_edge_finset,
              simple_graph.complete_graph_eq_top, finset.mem_subtype,
                finset.mem_map, function.embedding.coe_subtype,
                exists_prop, subtype.exists, subtype.coe_mk,
                exists_and_distrib_right, exists_eq_right],
            have e₂_in_set : ↑e₂ ∈ (complete_graph V).edge_set,
            { have e₂_in_finset := finset.mem_of_subset
                ((complete_graph V).induced_subgraph R).edge_finset_subset
                e₂.property,
              unfold simple_graph.edge_finset at e₂_in_finset,
              rw set.mem_to_finset at e₂_in_finset,
              exact e₂_in_finset, },
            use e₂_in_set,
          exact h_red.right, },
          { exfalso,
            have e₁_not_in := h_blue.left,
            rw ← h_cR at e₁_in,
            unfold simple_graph.induced_subgraph.edge_subtype_finset
              at e₁_in,
            simp only [simple_graph.mem_edge_finset,
              simple_graph.complete_graph_eq_top, finset.mem_subtype,
              finset.mem_map, function.embedding.coe_subtype, exists_prop,
              subtype.exists, subtype.coe_mk, exists_and_distrib_right,
              exists_eq_right] at e₁_in,
            cases e₁_in with _ e₁_in,
            exact h_blue.left e₁_in, }, }, },
        { exact h_union, }, }, },
  { rintro ⟨cRc, cR, hcR, h_union⟩,
    cases hcR with cR_empty cR_univ,
    { intros e₁ e₂,
      right,
      rw ← h_union,
      clear h_union,
      rw cR_empty,
      clear cR_empty,
      simp only [finset.map_empty, finset.union_empty],
      unfold subset_subtype.finset_subtype.coe,
      split,
      { by_contra,
        simp only [finset.univ_eq_attach, finset.mem_map,
          finset.mem_attach, function.embedding.coe_fn_mk,
          exists_true_left] at h,
        unfold set.inclusion at h,
        rcases h with ⟨⟨a, a_in⟩, h_eq⟩,
        rw subtype.mk_eq_mk at h_eq,
        change a = e₁.val at h_eq,
        rw h_eq at a_in,
        have e_in := finset.property_of_mem_map_subtype cRc a_in,
        rw finset.mem_sdiff at e_in,
        exact e_in.right e₁.property, },
      { by_contra,
        simp only [finset.univ_eq_attach, finset.mem_map,
          finset.mem_attach, function.embedding.coe_fn_mk,
          exists_true_left] at h,
        unfold set.inclusion at h,
        rcases h with ⟨⟨a, a_in⟩, h_eq⟩,
        rw subtype.mk_eq_mk at h_eq,
        change a = e₂.val at h_eq,
        rw h_eq at a_in,
        have e_in := finset.property_of_mem_map_subtype cRc a_in,
        rw finset.mem_sdiff at e_in,
        exact e_in.right e₂.property, }, },
    { intros e₁ e₂,
      left,
      rw ← h_union,
      clear h_union,
      rw cR_univ,
      clear cR_univ,
      unfold subset_subtype.finset_subtype.coe,
      simp only [finset.univ_eq_attach, finset.mem_map, finset.mem_attach,
        function.embedding.coe_fn_mk, exists_true_left],
      split,
      { use e₁,
        { rw set.mem_def,
          rw ← finset.mem_def,
          rw finset.mem_union,
          right,
          change (function.embedding.subtype _) e₁ ∈ finset.map
              (function.embedding.subtype _) finset.univ,
          rw finset.mem_map' (function.embedding.subtype _),
          exact finset.mem_univ e₁, },
        refl, },
      { use e₂,
        { rw set.mem_def,
          rw ← finset.mem_def,
          rw finset.mem_union,
          right,
          change (function.embedding.subtype _) e₂ ∈ finset.map
              (function.embedding.subtype _) finset.univ,
          rw finset.mem_map' (function.embedding.subtype _),
          exact finset.mem_univ e₂, },
        refl, }, }, },
end

theorem card_red_colourings_sat_A_R (hk : k ≥ 2) :
(two_colourings_sat_A_R (complete_graph V) R).card =
  2 ^ ((fintype.card V).choose 2 - k.choose 2 + 1) :=
begin
  rw all_red_colourings_sat_A_R,
  unfold empty_univ_col_R,
  rw finset.card_map,
  rw finset.card_product,
  rw finset.card_univ,
  rw fintype.card_finset,
  rw fintype.card_coe,
  rw finset.card_sdiff (((complete_graph V).induced_subgraph R).edge_finset_subset),
  rw complete_graph.induced_subgraph.card_edge_finset,
  change (↑R : set V) with (↑(↑R : finset V) : set V),
  simp_rw finset.coe_sort_coe,
  rw fintype.card_coe,
  rw complete_graph.card_edge_finset,
  rw finset.card_doubleton,
  rw pow_succ',
  rw card_R,
  symmetry,
  apply finset.nonempty.ne_empty,
  rw finset.univ_nonempty_iff,
  rw finset.nonempty_coe_sort,
  unfold simple_graph.subgraph.edge_finset,
  rw ← finset.coe_nonempty,
  exact complete_graph.induced_subgraph_size.edge_finset_nonempty R hk,
end

variable (k)

def finset_univ_prod_R_colouring :
finset (finset.powerset_len k (finset.univ : finset V) ×
  finset ↥G.edge_finset) := finset.univ

theorem finset_univ_prod_R_colouring_eq_prod_univ :
finset_univ_prod_R_colouring G k =
  finset.product finset.univ finset.univ :=
begin
  unfold finset_univ_prod_R_colouring,
  exact finset.univ_product_univ,
end

theorem finset_univ_prod_R_colouring_eq_bUnion :
finset_univ_prod_R_colouring G k = finset.univ.bUnion
  (λ R, finset.map ⟨prod.mk R, prod.mk.inj_left R⟩ finset.univ) :=
begin
  simp_rw [finset.map_eq_image],
  rw finset_univ_prod_R_colouring_eq_prod_univ,
  exact finset.product_eq_bUnion finset.univ finset.univ,
end

def finset_univ_prod_R_colouring_sat_A_R :
finset (finset.powerset_len k (finset.univ : finset V) ×
  finset ↥G.edge_finset) :=
finset.filter (λ Rc, A G Rc.fst Rc.snd) (finset_univ_prod_R_colouring G k)

lemma function.uncurry.comp_prod_mk_eq_self
  {α : Type*} {β : Type*} {γ : Type*} (f : α → β → γ) (a : α) :
(function.uncurry f) ∘ (prod.mk a) = f a := by unfold function.uncurry

theorem finset_univ_prod_R_colouring_sat_A_R_eq_bUnion_filter :
finset_univ_prod_R_colouring_sat_A_R G k =
  finset.univ.bUnion (λ R, finset.map
    ⟨prod.mk R, prod.mk.inj_left R⟩
    (two_colourings_sat_A_R G R)) :=
begin
  unfold finset_univ_prod_R_colouring_sat_A_R,
  rw finset_univ_prod_R_colouring_eq_bUnion,
  rw finset.filter_bUnion,
  apply congr_arg,
  apply funext,
  intro R,
  unfold two_colourings_sat_A_R,
  rw finset.map_filter,
  apply congr_arg,
  rw function.embedding.coe_fn_mk,
  change (λ Rc :
      ↥(finset.powerset_len k finset.univ) × finset ↥(G.edge_finset),
    A G Rc.fst Rc.snd) with function.uncurry (A G),
  simp_rw [function.uncurry.comp_prod_mk_eq_self],
  unfold finset_univ_two_colouring,
end

theorem card_finset_univ_prod_R_colouring_sat_A_R {k} (hk : k ≥ 2) :
(finset_univ_prod_R_colouring_sat_A_R (complete_graph V) k).card =
  (fintype.card V).choose k * 2 ^ ((fintype.card V).choose 2 -
    k.choose 2 + 1) :=
begin
  rw finset_univ_prod_R_colouring_sat_A_R_eq_bUnion_filter,
  rw finset.card_bUnion,
  rw finset.sum_const_nat,
  swap 3,
  { exact 2 ^ ((fintype.card V).choose 2 - k.choose 2 + 1) },
  { rw finset.card_univ,
    rw fintype.card_coe,
    rw finset.card_powerset_len,
    rw finset.card_univ, },
  { intros R R_in,
    rw finset.card_map,
    rw card_red_colourings_sat_A_R,
    exact hk, },
  intros R R_in R' R'_in R_ne_R',
  rw finset.disjoint_iff_ne,
  rintros ⟨R₁, c⟩ Rc_in ⟨R'₁, c'⟩ R'c'_in,
  simp only [finset.mem_map, function.embedding.coe_fn_mk,
    prod.mk.inj_iff, exists_prop, exists_eq_right_right] at Rc_in R'c'_in,
  rw ← Rc_in.right,
  rw ← R'c'_in.right,
  rw ne.def,
  rw prod.mk.inj_iff,
  exact not_and_of_not_left _ R_ne_R',
end

def finset_univ_colouring_sat_A : finset (finset ↥G.edge_finset) :=
finset.image prod.snd (@finset_univ_prod_R_colouring_sat_A_R _ _ _ G _ k)

theorem finset_univ_prod_R_colouring_sat_A_R_ssubset_univ {k}
( h : ((fintype.card V).choose k) * 2 ^
    ((fintype.card V).choose 2 - k.choose 2 + 1) <
    2 ^ (fintype.card V).choose 2) (hk : k ≥ 2) :
finset_univ_colouring_sat_A (complete_graph V) k ⊂
  (finset_univ_two_colouring (complete_graph V)) :=
begin
  unfold finset_univ_two_colouring,
  rw finset.ssubset_iff_subset_ne,
  split,
  { exact finset.subset_univ _, },
  { rw ← finset.card_lt_iff_ne_univ,
    calc (finset_univ_colouring_sat_A (complete_graph V) k).card ≤
      (finset_univ_prod_R_colouring_sat_A_R (complete_graph V) k).card :
        finset.card_image_le
      ... = (fintype.card V).choose k * 2 ^
            ((fintype.card V).choose 2 - k.choose 2 + 1) :
        card_finset_univ_prod_R_colouring_sat_A_R hk
      ... < 2 ^ (fintype.card V).choose 2 : h
      ... = finset.univ.card :
        begin
          rw finset.card_univ,
          rw fintype.card_finset,
          rw fintype.card_coe,
          rw complete_graph.card_edge_finset
        end, },
end

theorem ramsey_lower_bound {k}
( h : ((fintype.card V).choose k) * 2 ^
    ((fintype.card V).choose 2 - k.choose 2 + 1) <
    2 ^ (fintype.card V).choose 2) (hk : k ≥ 2) :
∃ c : finset ↥((complete_graph V).edge_finset),
  ¬∃ R' : ↥(finset.powerset_len k (finset.univ : finset V)),
    A (complete_graph V) R' c :=
begin
  rcases
    finset.exists_of_ssubset
      (finset_univ_prod_R_colouring_sat_A_R_ssubset_univ h hk)
    with ⟨c, c_in, c_not_in⟩,
  use c,
  convert_to ¬∃ R',
    (R', c) ∈ (finset_univ_prod_R_colouring_sat_A_R (complete_graph V) k),
  { unfold finset_univ_prod_R_colouring_sat_A_R,
    simp_rw finset.mem_filter,
    unfold finset_univ_prod_R_colouring,
    simp_rw [eq_true_intro (finset.mem_univ _)],
    simp_rw [true_and], },
  unfold finset_univ_colouring_sat_A at c_not_in,
  rw finset.mem_image at c_not_in,
  rw not_exists at c_not_in,
  rw not_exists,
  intro R,
  specialize c_not_in (R, c),
  rw not_exists at c_not_in,
  rw eq_self_iff_true at c_not_in,
  rw not_true at c_not_in,
  rw imp_false at c_not_in,
  exact c_not_in,
end