/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn
-/
import algebra.group data.set.basic

universes u v
variable {α : Type u}

section
variable [semiring α]

theorem mul_two (n : α) : n * 2 = n + n :=
(left_distrib n 1 1).trans (by simp)

theorem bit0_eq_two_mul (n : α) : bit0 n = 2 * n :=
(two_mul _).symm

variable (α)
lemma zero_ne_one_or_forall_eq_0 : (0 : α) ≠ 1 ∨ (∀a:α, a = 0) :=
by haveI := classical.dec;
   refine not_or_of_imp (λ h a, _); simpa using congr_arg ((*) a) h.symm
variable {α}

end

namespace units
variables [ring α] {a b : α}

instance : has_neg (units α) := ⟨λu, ⟨-↑u, -↑u⁻¹, by simp, by simp⟩ ⟩

@[simp] protected theorem coe_neg (u : units α) : (↑-u : α) = -u := rfl

@[simp] protected theorem neg_inv (u : units α) : (-u)⁻¹ = -u⁻¹ := rfl

@[simp] protected theorem neg_neg (u : units α) : - -u = u :=
units.ext $ neg_neg _

@[simp] protected theorem neg_mul (u₁ u₂ : units α) : -u₁ * u₂ = -(u₁ * u₂) :=
units.ext $ neg_mul_eq_neg_mul_symm _ _

@[simp] protected theorem mul_neg (u₁ u₂ : units α) : u₁ * -u₂ = -(u₁ * u₂) :=
units.ext $ (neg_mul_eq_mul_neg _ _).symm

@[simp] protected theorem neg_mul_neg (u₁ u₂ : units α) : -u₁ * -u₂ = u₁ * u₂ := by simp

protected theorem neg_eq_neg_one_mul (u : units α) : -u = -1 * u := by simp

end units

instance [semiring α] : semiring (with_zero α) :=
{ left_distrib := λ a b c, begin
    cases a with a, {refl},
    cases b with b; cases c with c; try {refl},
    exact congr_arg some (left_distrib _ _ _)
  end,
  right_distrib := λ a b c, begin
    cases c with c,
    { change (a + b) * 0 = a * 0 + b * 0, simp },
    cases a with a; cases b with b; try {refl},
    exact congr_arg some (right_distrib _ _ _)
  end,
  ..with_zero.add_comm_monoid,
  ..with_zero.mul_zero_class,
  ..with_zero.monoid }

attribute [refl] dvd_refl
attribute [trans] dvd.trans

class is_semiring_hom {α : Type u} {β : Type v} [semiring α] [semiring β] (f : α → β) : Prop :=
(map_zero : f 0 = 0)
(map_one : f 1 = 1)
(map_add : ∀ {x y}, f (x + y) = f x + f y)
(map_mul : ∀ {x y}, f (x * y) = f x * f y)

namespace is_semiring_hom

variables {β : Type v} [semiring α] [semiring β]
variables (f : α → β) [is_semiring_hom f] {x y : α}

instance id : is_semiring_hom (@id α) := by refine {..}; intros; refl

instance comp {γ} [semiring γ] (g : β → γ) [is_semiring_hom g] :
  is_semiring_hom (g ∘ f) :=
{ map_zero := by simp [map_zero f]; exact map_zero g,
  map_one := by simp [map_one f]; exact map_one g,
  map_add := λ x y, by simp [map_add f]; rw map_add g; refl,
  map_mul := λ x y, by simp [map_mul f]; rw map_mul g; refl }

instance : is_add_monoid_hom f :=
{ ..‹is_semiring_hom f› }

instance : is_monoid_hom f :=
{ ..‹is_semiring_hom f› }

end is_semiring_hom

@[simp] lemma zero_dvd_iff_eq_zero [comm_semiring α] (a : α) : 0 ∣ a ↔ a = 0 :=
iff.intro
  eq_zero_of_zero_dvd
  (assume ha, ha ▸ dvd_refl a)

section
  variables [ring α] (a b c d e : α)

  lemma mul_neg_one (a : α) : a * -1 = -a := by simp

  lemma neg_one_mul (a : α) : -1 * a = -a := by simp

  theorem mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d :=
  calc
    a * e + c = b * e + d ↔ a * e + c = d + b * e : by simp
      ... ↔ a * e + c - b * e = d : iff.intro (λ h, begin simp [h] end) (λ h,
                                                    begin simp [h.symm] end)
      ... ↔ (a - b) * e + c = d   : begin simp [@sub_eq_add_neg α, @right_distrib α] end

  theorem sub_mul_add_eq_of_mul_add_eq_mul_add : a * e + c = b * e + d → (a - b) * e + c = d :=
  assume h,
  calc
    (a - b) * e + c = (a * e + c) - b * e : begin simp [@sub_eq_add_neg α, @right_distrib α] end
                ... = d                   : begin rw h, simp [@add_sub_cancel α] end

  theorem ne_zero_and_ne_zero_of_mul_ne_zero {a b : α} (h : a * b ≠ 0) : a ≠ 0 ∧ b ≠ 0 :=
  begin
    split,
    { intro ha, apply h, simp [ha] },
    { intro hb, apply h, simp [hb] }
  end

end

@[simp] lemma zero_dvd_iff [comm_semiring α] {a : α} : 0 ∣ a ↔ a = 0 :=
⟨eq_zero_of_zero_dvd, λ h, by rw h⟩

section comm_ring
  variable [comm_ring α]

  @[simp] lemma dvd_neg (a b : α) : (a ∣ -b) ↔ (a ∣ b) :=
  ⟨dvd_of_dvd_neg, dvd_neg_of_dvd⟩

  @[simp] lemma neg_dvd (a b : α) : (-a ∣ b) ↔ (a ∣ b) :=
  ⟨dvd_of_neg_dvd, neg_dvd_of_dvd⟩
end comm_ring

class is_ring_hom {α : Type u} {β : Type v} [ring α] [ring β] (f : α → β) : Prop :=
(map_one : f 1 = 1)
(map_mul : ∀ {x y}, f (x * y) = f x * f y)
(map_add : ∀ {x y}, f (x + y) = f x + f y)

namespace is_ring_hom

variables {β : Type v} [ring α] [ring β]

def of_semiring (f : α → β) [H : is_semiring_hom f] : is_ring_hom f := {..H}

variables (f : α → β) [is_ring_hom f] {x y : α}

lemma map_zero : f 0 = 0 :=
calc f 0 = f (0 + 0) - f 0 : by rw [map_add f]; simp
     ... = 0 : by simp

lemma map_neg : f (-x) = -f x :=
calc f (-x) = f (-x + x) - f x : by rw [map_add f]; simp
        ... = -f x : by simp [map_zero f]

lemma map_sub : f (x - y) = f x - f y :=
by simp [map_add f, map_neg f]

instance id : is_ring_hom (@id α) := by refine {..}; intros; refl

instance comp {γ} [ring γ] (g : β → γ) [is_ring_hom g] :
  is_ring_hom (g ∘ f) :=
{ map_add := λ x y, by simp [map_add f]; rw map_add g; refl,
  map_mul := λ x y, by simp [map_mul f]; rw map_mul g; refl,
  map_one := by simp [map_one f]; exact map_one g }

instance : is_semiring_hom f :=
{ map_zero := map_zero f, ..‹is_ring_hom f› }

instance : is_add_group_hom f :=
⟨λ _ _, map_add f⟩

end is_ring_hom

set_option old_structure_cmd true

class nonzero_comm_ring (α : Type*) extends zero_ne_one_class α, comm_ring α

instance integral_domain.to_nonzero_comm_ring (α : Type*) [id : integral_domain α] :
  nonzero_comm_ring α :=
{ ..id }

/-- A domain is a ring with no zero divisors, i.e. satisfying
  the condition `a * b = 0 ↔ a = 0 ∨ b = 0`. Alternatively, a domain
  is an integral domain without assuming commutativity of multiplication. -/
class domain (α : Type u) extends ring α, no_zero_divisors α, zero_ne_one_class α

section domain
  variable [domain α]

  @[simp] theorem mul_eq_zero {a b : α} : a * b = 0 ↔ a = 0 ∨ b = 0 :=
  ⟨eq_zero_or_eq_zero_of_mul_eq_zero, λo,
    or.elim o (λh, by rw h; apply zero_mul) (λh, by rw h; apply mul_zero)⟩

  @[simp] theorem zero_eq_mul {a b : α} : 0 = a * b ↔ a = 0 ∨ b = 0 :=
  by rw [eq_comm, mul_eq_zero]

  theorem mul_ne_zero' {a b : α} (h₁ : a ≠ 0) (h₂ : b ≠ 0) : a * b ≠ 0 :=
  λ h, or.elim (eq_zero_or_eq_zero_of_mul_eq_zero h) h₁ h₂

  theorem domain.mul_right_inj {a b c : α} (ha : a ≠ 0) : b * a = c * a ↔ b = c :=
  by rw [← sub_eq_zero, ← mul_sub_right_distrib, mul_eq_zero];
     simp [ha]; exact sub_eq_zero

  theorem domain.mul_left_inj {a b c : α} (ha : a ≠ 0) : a * b = a * c ↔ b = c :=
  by rw [← sub_eq_zero, ← mul_sub_left_distrib, mul_eq_zero];
     simp [ha]; exact sub_eq_zero

  theorem eq_zero_of_mul_eq_self_right' {a b : α} (h₁ : b ≠ 1) (h₂ : a * b = a) : a = 0 :=
  by apply (mul_eq_zero.1 _).resolve_right (sub_ne_zero.2 h₁);
     rw [mul_sub_left_distrib, mul_one, sub_eq_zero, h₂]

  theorem eq_zero_of_mul_eq_self_left' {a b : α} (h₁ : b ≠ 1) (h₂ : b * a = a) : a = 0 :=
  by apply (mul_eq_zero.1 _).resolve_left (sub_ne_zero.2 h₁);
     rw [mul_sub_right_distrib, one_mul, sub_eq_zero, h₂]

  theorem mul_ne_zero_comm' {a b : α} (h : a * b ≠ 0) : b * a ≠ 0 :=
  mul_ne_zero' (ne_zero_of_mul_ne_zero_left h) (ne_zero_of_mul_ne_zero_right h)

end domain

/- integral domains -/

section
  variables [s : integral_domain α] (a b c d e : α)
  include s

  instance integral_domain.to_domain : domain α := {..s}

  theorem eq_of_mul_eq_mul_right_of_ne_zero {a b c : α} (ha : a ≠ 0) (h : b * a = c * a) : b = c :=
  have b * a - c * a = 0, by simp [h],
  have (b - c) * a = 0, by rw [mul_sub_right_distrib, this],
  have b - c = 0, from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right ha,
  eq_of_sub_eq_zero this

  theorem eq_of_mul_eq_mul_left_of_ne_zero {a b c : α} (ha : a ≠ 0) (h : a * b = a * c) : b = c :=
  have a * b - a * c = 0, by simp [h],
  have a * (b - c) = 0, by rw [mul_sub_left_distrib, this],
  have b - c = 0, from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_left ha,
  eq_of_sub_eq_zero this

  theorem mul_dvd_mul_iff_left {a b c : α} (ha : a ≠ 0) : a * b ∣ a * c ↔ b ∣ c :=
  exists_congr $ λ d, by rw [mul_assoc, domain.mul_left_inj ha]

  theorem mul_dvd_mul_iff_right {a b c : α} (hc : c ≠ 0) : a * c ∣ b * c ↔ a ∣ b :=
  exists_congr $ λ d, by rw [mul_right_comm, domain.mul_right_inj hc]

end

/- units in various rings -/

namespace units

section comm_semiring
variables [comm_semiring α] (a b : α) (u : units α)

@[simp] lemma coe_dvd : ↑u ∣ a := ⟨↑u⁻¹ * a, by simp⟩

@[simp] lemma dvd_coe_mul : a ∣ b * u ↔ a ∣ b :=
iff.intro
  (assume ⟨c, eq⟩, ⟨c * ↑u⁻¹, by rw [← mul_assoc, ← eq, units.mul_inv_cancel_right]⟩)
  (assume ⟨c, eq⟩, eq.symm ▸ dvd_mul_of_dvd_left (dvd_mul_right _ _) _)

@[simp] lemma dvd_coe : a ∣ ↑u ↔ a ∣ 1 :=
suffices a ∣ 1 * ↑u ↔ a ∣ 1, by simpa,
dvd_coe_mul _ _ _

@[simp] lemma coe_mul_dvd : a * u ∣ b ↔ a ∣ b :=
iff.intro
  (assume ⟨c, eq⟩, ⟨c * ↑u, eq.symm ▸ by ac_refl⟩)
  (assume h, suffices a * ↑u ∣ b * 1, by simpa, mul_dvd_mul h (coe_dvd _ _))

end comm_semiring

section domain
variables [domain α]

@[simp] theorem ne_zero : ∀(u : units α), (↑u : α) ≠ 0
| ⟨u, v, (huv : 0 * v = 1), hvu⟩ rfl := by simpa using huv

end domain

end units


import algebra.comm_rings.basic
import misc.set

namespace comm_ring

universe u

open set

structure ideal (R : Type u) [l:comm_ring R] :=
  (body : set R)
  (contains_zero : l.zero ∈ body)
  (minus_closure : ∀ a : R, a ∈ body → -a ∈ body)
  (add_closure : ∀ a b : R, a ∈ body → b ∈ body → (a + b) ∈ body)
  (mul_absorb : ∀ r : R, ∀ {i : R}, i ∈ body → (r * i) ∈ body)

instance ideal_to_set {R : Type u} [comm_ring R] : has_coe (ideal R) (set R) := ⟨λ I : ideal R, I.body⟩

structure proper_ideal (R : Type u) [l:comm_ring R] :=
  (body : set R)
  (contains_zero : l.zero ∈ body)
  (minus_closure : ∀ a : R, a ∈ body → -a ∈ body)
  (add_closure : ∀ a b : R, a ∈ body → b ∈ body → (a + b) ∈ body)
  (mul_absorb : ∀ r : R, ∀ {i : R}, i ∈ body → (r * i) ∈ body)
  (proper : body ≠ univ)

def proper_ideals_are_ideals {R : Type u} [l:comm_ring R] : proper_ideal R → ideal R :=
begin
  intro I,
  split,
  exact I.contains_zero,
  exact I.minus_closure,
  exact I.add_closure,
  exact I.mul_absorb,
end

instance proper_ideals_to_ideals {R : Type u} [comm_ring R] : has_coe (proper_ideal R) (ideal R) := ⟨proper_ideals_are_ideals⟩

structure Spec (R : Type u) [l:comm_ring R] :=
  (body : set R)
  (contains_zero : l.zero ∈ body)
  (minus_closure : ∀ a : R, a ∈ body → -a ∈ body)
  (add_closure : ∀ a b : R, a ∈ body → b ∈ body → (a + b) ∈ body)
  (mul_absorb : ∀ r : R, ∀ {i : R}, i ∈ body → (r * i) ∈ body)
  (prime : ∀ r₁ r₂ : R, r₁ * r₂ ∈ body → r₁ ∈ body ∨ r₂ ∈ body)
  (proper : body ≠ univ)

def prime_ideals_are_proper_ideals (R : Type u) [comm_ring R] : Spec R → proper_ideal R :=
begin
  intro I,
  split,
  exact I.contains_zero,
  exact I.minus_closure,
  exact I.add_closure,
  exact I.mul_absorb,
  exact I.proper,
end

instance prime_ideals_to_proper_ideals {R : Type u} [comm_ring R] : has_coe (Spec R) (proper_ideal R) := ⟨prime_ideals_are_proper_ideals R⟩

structure MaxSpec (R : Type u) [l:comm_ring R] :=
  (body : set R)
  (contains_zero : l.zero ∈ body)
  (minus_closure : ∀ a : R, a ∈ body → -a ∈ body)
  (add_closure : ∀ a b : R, a ∈ body → b ∈ body → (a + b) ∈ body)
  (mul_absorb : ∀ r  : R, ∀ {i}, i ∈ body → (r * i) ∈ body)
  (maximal: ∀ I : ideal R, body ⊆ I → ↑I = body ∨ ↑I = @univ R)
  (proper : body ≠ univ)

def is_prime {R: Type u} [comm_ring R] : proper_ideal R → Prop
  := λ I: proper_ideal R, ∀ r₁ r₂ : R, (r₁ * r₂) ∈ I.body → r₁ ∈ I.body ∨ r₂ ∈ I.body

def is_maximal {R : Type u} [comm_ring R] : proper_ideal R → Prop
  := λ I : proper_ideal R, ∀ J : ideal R, I.body ⊆ J → ↑J = I.body ∨ J.body = univ

def is_proper {R : Type u} [comm_ring R] : ideal R → Prop := λ I : ideal R, ↑I ≠ @univ R

def ideal_to_proper {R : Type u} [comm_ring R] :  Π {I : ideal R} , is_proper I → proper_ideal R :=
begin
  intros I hI,
  split,
  exact I.contains_zero,
  exact I.minus_closure,
  exact I.add_closure,
  exact I.mul_absorb,
  exact hI,
end

def proper_to_prime {R : Type u} [comm_ring R] : Π {I : proper_ideal R} , is_prime I → Spec R :=
begin
  intros I hI,
  split,
  exact I.contains_zero,
  exact I.minus_closure,
  exact I.add_closure,
  exact I.mul_absorb,
  exact hI,
  exact I.proper,
end

def proper_to_maximal {R : Type u} [comm_ring R] : Π {I : proper_ideal R} , is_maximal I → MaxSpec R :=
begin
  intros I hI,
  split,
  exact I.contains_zero,
  exact I.minus_closure,
  exact I.add_closure,
  exact I.mul_absorb,
  exact hI,
  exact I.proper,
end

theorem proper_ideal_equality {R : Type u} [comm_ring R] : ∀ {I₁ I₂ : proper_ideal R}, I₁.body = I₂.body → I₁ = I₂ :=
begin
  intros I₁ I₂ h,
  cases I₁,
  cases I₂,
  rw proper_ideal.mk.inj_eq,
  exact h,
end

theorem ideal_equality {R : Type u} [comm_ring R] : ∀ {I₁ I₂ : ideal R}, I₁.body = I₂.body → I₁ = I₂ :=
begin
  intros I₁ I₂ h,
  cases I₁,
  cases I₂,
  rw ideal.mk.inj_eq,
  exact h,
end

lemma ideal_containing_unit_is_univ {R : Type u} [comm_ring R] (I : ideal R) : ∀ {x : R}, unit x → x ∈ I.body → ↑I = @univ R :=
begin
  intros x hxunit hxinI,
  apply subset_antisymmetric,
  split,
  intros _ _,
  trivial,
  intros y _,
  cases hxunit with a ha,
  have haxinI : a * x ∈ ↑I,
    apply I.mul_absorb,
    exact hxinI,
  rw ha at haxinI,
  have ha1inI : y * 1 ∈ ↑I,
    apply I.mul_absorb,
    exact haxinI,
  rw mul_one at ha1inI,
  exact ha1inI,
end

lemma unit_not_in_proper_ideal {R : Type u} [comm_ring R] : ∀ {x : R}, ∀ {I : proper_ideal R}, unit x → x ∉ I.body :=
begin
  intros x I hx h,
  apply I.proper,
  let J : ideal R := proper_ideals_are_ideals I,
  have trv : I.body = J.body := rfl,
  rw trv,
  apply ideal_containing_unit_is_univ J,
  exact hx,
  exact h,
end

end comm_ring


import data.set
import data.set.function

axiom mynat : Type
axiom zero : mynat
axiom succ : mynat -> mynat
axiom succ_neq_0 {a : mynat} : not (succ a = zero)
axiom succ_sur {a : mynat} : not (a = zero) -> exists b : mynat, succ b = a
axiom succ_inj : function.injective succ
axiom myinduction {A : set mynat} : zero ∈ A -> (forall n : mynat, n ∈ A -> succ n ∈ A) -> A = set.univ

def Inter {T} (AA : set (set T)) : set T := {t : T | forall A ∈ AA, t ∈ A}
def final (A : set mynat) : Prop :=
  and
    (A.nonempty)
    (forall n : mynat, n ∈ A -> succ n ∈ A)
def plus (n : mynat) : set mynat :=
  Inter {F | and (n ∈ F) (final F)}
def minus (n : mynat) : set mynat :=
  compl $ plus n

def leq (m n : mynat) : Prop := minus m ⊆ minus n
infix `≤`:80 := leq

lemma leq_zero {n : mynat} : (n ≤ zero) <-> n = zero :=
begin sorry, end

lemma minus_zero : minus zero = ∅ :=
begin sorry, end

variables {AA : Type} {A : set AA}
variable {n : mynat}

theorem inductive_definitions_general
  (g : (Σ n : mynat, minus n -> A) -> A) :
  ∃! (f : mynat -> A),
    forall m : mynat,
      f m = g ⟨m, (minus m).restrict f⟩
  :=
begin
  apply exists_unique_of_exists_of_unique,

    let I := {n : mynat | exists (h : mynat -> A), forall m ≤ n, h m = g ⟨m, (minus m).restrict h⟩},
    have h_I : I = set.univ,
    apply myinduction,
      simp,

      have h_ : mynat -> A, sorry,
      simp [leq_zero],
      use (fun _, g ⟨zero, (minus zero).restrict h_⟩),
      rw minus_zero,

end


import pq_to_group
import pq_union

universes u v

section pq_group_union

variables {Q1 : Type u} {Q2 : Type v} [power_quandle Q1] [power_quandle Q2]

lemma group_prod_pow_nat {G : Type u} {H : Type v} [group G] [group H] (a : G) (b : H) (n : ℕ) : (a, b)^n = (a^n, b^n) :=
begin
  induction n with n hn,
  {refl,},
  repeat {rw pow_succ},
  rw hn,
  simp only [prod.mk_mul_mk],
end

lemma group_prod_pow {G : Type u} {H : Type v} [group G] [group H] (a : G) (b : H) (n : ℤ) : (a, b)^n = (a^n, b^n) :=
begin
  induction n,
  {apply group_prod_pow_nat,},
  repeat {rw gpow_neg_succ_of_nat},
  rw group_prod_pow_nat,
  simp only [prod.inv_mk],
end

lemma group_prod_rhd {G : Type u} {H : Type v} [group G] [group H] (a b : G) (c d : H) : (a, c) ▷ (b, d) = (a ▷ b, c ▷ d) :=
begin
  simp only [rhd_def_group],
  refl,
end

def pq_group_oplus_to_prod : pq_group (pq_union Q1 Q2) →* pq_group Q1 × pq_group Q2 :=
begin
  fapply pq_morph_to_L_morph_adj,
  {
    fapply pq_union_map_from,
    {
      intros x,
      exact (of x, 1),
    },
    {
      split,
      {
        intros a b,
        rw ←rhd_of_eq_of_rhd,
        rw group_prod_rhd,
        rw power_quandle.one_rhd,
      },
      {
        intros a n,
        rw of_pow_eq_pow_of,
        rw group_prod_pow,
        simp only [one_gpow],
      },
    },
    {
      intros x,
      exact (1, of x),
    },
    {
      split,
      {
        intros a b,
        rw ←rhd_of_eq_of_rhd,
        rw group_prod_rhd,
        rw power_quandle.one_rhd,
      },
      {
        intros a n,
        rw of_pow_eq_pow_of,
        rw group_prod_pow,
        simp only [one_gpow],
      },
    },
  },
  {
    apply pq_union_map_from_is_pq_morphism,
    {
      intros a b,
      rw rhd_def_group,
      simp only [one_inv, mul_one, one_mul, prod.inv_mk, mul_right_inv, prod.mk_mul_mk],
    },
    {
      intros a b,
      rw rhd_def_group,
      simp only [one_inv, mul_one, one_mul, prod.inv_mk, mul_right_inv, prod.mk_mul_mk],
    },
  },
end

def pq_group_left_to_oplus : pq_group Q1 →* pq_group (pq_union Q1 Q2) :=
begin
  fapply L_of_morph,
  {
    fapply pq_union_map_to,
    exact sum.inl,
  },
  {
    split,
    {
      intros a b,
      refl,
    },
    {
      intros a n,
      refl,
    },
  },
end

def pq_group_right_to_oplus : pq_group Q2 →* pq_group (pq_union Q1 Q2) :=
begin
  fapply L_of_morph,
  {
    fapply pq_union_map_to,
    exact sum.inr,
  },
  {
    split,
    {
      intros a b,
      refl,
    },
    {
      intros a n,
      refl,
    },
  },
end

def pq_group_prod_to_oplus : pq_group Q1 × pq_group Q2 →* pq_group (pq_union Q1 Q2) :=
begin
  fconstructor,
  {
    intro x,
    cases x with a b,
    let pa := @pq_group_left_to_oplus Q1 Q2 _ _ a,
    let pb := @pq_group_right_to_oplus Q1 Q2 _ _ b,
    exact pa * pb,
  },
  {
    have one_rw : (1 : pq_group Q1 × pq_group Q2) = (1, 1) := rfl,
    rw one_rw,
    simp only [mul_one, monoid_hom.map_one],
  },
  {
    intros x y,
    cases x with x1 x2,
    cases y with y1 y2,
    have prod_rw : ((x1, x2) * (y1, y2) : pq_group Q1 × pq_group Q2) = (x1 * y1, x2 * y2) := rfl,
    rw prod_rw,
    clear prod_rw,
    simp only [monoid_hom.map_mul],
    suffices : pq_group_left_to_oplus y1 * pq_group_right_to_oplus x2 = pq_group_right_to_oplus x2 * pq_group_left_to_oplus y1,
    {
      group,
      rw @mul_assoc _ _ (pq_group_left_to_oplus x1) _ _,
      rw this,
      group,
    },
    clear x1 y2,
    induction y1,
    {
      rw quot_mk_helper,
      induction y1,
      {
        rw incl_unit_eq_unit,
        simp only [mul_one, one_mul, monoid_hom.map_one],
      },
      {
        rw ←of_def,
        unfold pq_group_left_to_oplus,
        rw L_of_morph_of,
        induction x2,
        {
          rw quot_mk_helper,
          induction x2,
          {
            rw incl_unit_eq_unit,
            simp only [mul_one, one_mul, monoid_hom.map_one],
          },
          {
            rw ←of_def,
            unfold pq_group_right_to_oplus,
            rw L_of_morph_of,
            rw center_reformulate,
            rw ←rhd_def_group,
            rw rhd_of_eq_of_rhd,
            apply congr_arg,
            refl,
          },
          {
            rw ←mul_def,
            simp only [monoid_hom.map_mul],
            rw ←mul_assoc,
            rw x2_ih_a,
            rw mul_assoc,
            rw x2_ih_b,
            rw ←mul_assoc,
          },
          {
            rw ←inv_def,
            simp only [monoid_hom.map_inv],
            group,
            rw ←inv_inj,
            group,
            simp only [gpow_one, gpow_neg],
            rw @mul_assoc _ _ (pq_group_right_to_oplus ⟦x2_a⟧)⁻¹ _ _,
            rw x2_ih,
            group,
          },

        },
        {refl,},

      },
      {
        rw ←mul_def,
        simp only [monoid_hom.map_mul],
        rw mul_assoc,
        rw y1_ih_b,
        rw ←mul_assoc,
        rw y1_ih_a,
        rw mul_assoc,
      },
      {
        rw ←inv_def,
        simp only [monoid_hom.map_inv],
        group,
        simp only [gpow_one, gpow_neg],
        rw @mul_assoc _ _ (pq_group_left_to_oplus ⟦y1_a⟧)⁻¹ _ _,
        rw ←y1_ih,
        group,
      },
    },
    {refl,},
  },
end

theorem pq_group_union_prod_inv_left : @pq_group_prod_to_oplus Q1 Q2 _ _ ∘ pq_group_oplus_to_prod = id :=
begin
  funext,
  simp only [id.def, function.comp_app],
  induction x,
  {
    rw quot_mk_helper,
    induction x,
    {
      rw incl_unit_eq_unit,
      simp only [monoid_hom.map_one],
    },
    {
      rw ←of_def,
      unfold pq_group_oplus_to_prod,
      rw pq_morph_to_L_morph_adj_comm_of,
      induction x,
      {
        rw quot_mk_helper_pq_union,
        unfold pq_union_map_from,
        unfold pq_union_map_from_pre,
        cases x;
        simp only [quotient.lift_on_beta, sum.elim_inl, sum.elim_inr];
        unfold pq_group_prod_to_oplus;
        simp only [mul_one, one_mul, monoid_hom.coe_mk, monoid_hom.map_one];
        refl,
      },
      {refl,},
    },
    {
      rw ←mul_def,
      simp only [monoid_hom.map_mul, x_ih_a, x_ih_b],
    },
    {
      rw ←inv_def,
      simp only [x_ih, monoid_hom.map_inv],
    },
  },
  {refl,},
end

theorem pq_group_union_prod_inv_right : @pq_group_oplus_to_prod Q1 Q2 _ _ ∘ pq_group_prod_to_oplus = id :=
begin
  funext,
  simp only [id.def, function.comp_app],
  cases x with x1 x2,
  unfold pq_group_prod_to_oplus,
  simp only [monoid_hom.map_mul, monoid_hom.coe_mk],
  suffices : pq_group_oplus_to_prod (pq_group_left_to_oplus x1) = (x1, (1 : pq_group Q2)) ∧ pq_group_oplus_to_prod (pq_group_right_to_oplus x2) = ((1 : pq_group Q1), x2),
  {
    cases this with h1 h2,
    rw h1,
    rw h2,
    simp only [mul_right_eq_self, mul_left_eq_self, prod.mk.inj_iff, eq_self_iff_true, and_self, prod.mk_mul_mk],
  },
  split,
  {
    clear x2,
    induction x1,
    {
      rw quot_mk_helper,
      induction x1,
      {
        rw incl_unit_eq_unit,
        simp only [monoid_hom.map_one],
        refl,
      },
      {
        rw ←of_def,
        refl,
      },
      {
        rw ←mul_def,
        simp only [monoid_hom.map_mul, x1_ih_a, x1_ih_b],
        simp only [mul_one, prod.mk_mul_mk],
      },
      {
        rw ←inv_def,
        simp only [x1_ih, monoid_hom.map_inv],
        simp only [one_inv, prod.inv_mk],
      },
    },
    {refl,},
  },
  {
    clear x1,
    induction x2,
    {
      rw quot_mk_helper,
      induction x2,
      {
        rw incl_unit_eq_unit,
        simp only [monoid_hom.map_one],
        refl,
      },
      {
        rw ←of_def,
        refl,
      },
      {
        rw ←mul_def,
        simp only [monoid_hom.map_mul, x2_ih_a, x2_ih_b],
        simp only [mul_one, prod.mk_mul_mk],
      },
      {
        rw ←inv_def,
        simp only [x2_ih, monoid_hom.map_inv],
        simp only [one_inv, prod.inv_mk],
      },
    },
    {refl,},
  },
end

def pq_group_union : pq_group (pq_union Q1 Q2) ≃* pq_group Q1 × pq_group Q2 := {
  to_fun := pq_group_oplus_to_prod,
  inv_fun := pq_group_prod_to_oplus,
  left_inv := congr_fun pq_group_union_prod_inv_left,
  right_inv := congr_fun pq_group_union_prod_inv_right,
  map_mul' := is_mul_hom.map_mul _ }

end pq_group_union


-- import the definition of the gcd maze
import mazes.gcd_maze.definition
import data.int.gcd
open maze direction

/-

# Bezout's Theorem Example maze.

You are in a maze of integers, all distinct.

You can go north, south east or west.

North adds 20 to your integer, South subtracts 20.
East adds 77 to your integer, West subtracts 77

The exit is at 1, the gcd of 20 and 77.
When you're at the exit, type `out`.

Solver remark : there are infinitely many rooms.
-/

/- Lemma : no-side-bar
Can you prove this case of Bezout's Theorem?
-/
example : can_escape 20 77 0 :=
begin
  iterate 27 {n},
  iterate 7 {w},
  out
end


import algebra.category.Group
import category_theory.isomorphism_classes
import .fingroup .simple_group

open category_theory

@[to_additive is_trivial_add_class]
def is_trivial_class (C : isomorphism_classes.obj (Cat.of Group)) : Prop :=
quotient.lift_on' C (λ (G : Group), subsingleton G)
  (λ G H ⟨h⟩, eq_iff_iff.mpr
    ⟨λ hG, @equiv.subsingleton.symm _ _ (iso.Group_iso_to_mul_equiv h).to_equiv hG,
    λ hH, @equiv.subsingleton _ _ (iso.Group_iso_to_mul_equiv h).to_equiv hH⟩)

@[simp, to_additive is_trivial_add_class_mk']
lemma is_trivial_class_mk' {G : Group} : is_trivial_class (quotient.mk' G) = subsingleton G :=
by simp only [quotient.lift_on'_mk', is_trivial_class]

@[to_additive is_trivial_add_class_one]
lemma is_trivial_class_one : is_trivial_class (quotient.mk' (1 : Group)) :=
punit.subsingleton

@[to_additive add_class_eq]
lemma class_eq {G H : Type*} [group G] [group H] : G ≃* H →
  (quotient.mk' (Group.of G) : isomorphism_classes.obj (Cat.of Group)) = quotient.mk' (Group.of H) :=
λ h, quotient.eq'.mpr ⟨h.to_Group_iso⟩

@[to_additive add_equiv_to_AddGroup_iso]
def mul_equiv_to_Group_iso {G H : Group} (e : G ≃* H) : G ≅ H :=
{ hom := e.to_monoid_hom, inv :=  e.symm.to_monoid_hom }

@[to_additive add_class_eq']
lemma class_eq' {G H : Group} : G ≃* H →
  (quotient.mk' G : isomorphism_classes.obj (Cat.of Group)) = quotient.mk' H :=
λ h, quotient.eq'.mpr ⟨mul_equiv_to_Group_iso h⟩

@[to_additive]
instance Group.fintype {G : Type*} [group G] [fintype G] : fintype (Group.of G) :=
show fintype G, from infer_instance

variable (C : isomorphism_classes.obj (Cat.of Group))

@[to_additive is_finite_add_class]
def is_finite_class : Prop :=
quotient.lift_on' C (λ (G : Group), nonempty (fintype G))
  (λ G H ⟨h⟩, eq_iff_iff.mpr
    ⟨λ ⟨hG⟩, ⟨@fintype.of_equiv _ _ hG h.Group_iso_to_mul_equiv.to_equiv⟩,
    λ ⟨hH⟩, ⟨@fintype.of_equiv _ _ hH h.Group_iso_to_mul_equiv.to_equiv.symm⟩⟩)

@[to_additive is_finite_add_class_mk']
lemma is_finite_class_mk' {G : Group} (hG : fintype G) :
  is_finite_class (quotient.mk' G) :=
by simp [is_finite_class, quotient.lift_on'_mk']; use hG

@[to_additive add_class_card]
noncomputable def class_card (h : is_finite_class C) : ℕ :=
begin
  let G : Group := quotient.out' C,
  dsimp [is_finite_class] at h,
  rw [←quotient.out_eq' C, quotient.lift_on'_mk'] at h,
  exact @fintype.card G h.some,
end

@[to_additive add_class_card_mk']
lemma class_card_mk' {G : Group} (hG : fintype G) :
  class_card (quotient.mk' G) (is_finite_class_mk' hG) = @fintype.card G hG :=
begin
  apply fintype.card_eq.mpr ⟨(iso.Group_iso_to_mul_equiv _).to_equiv⟩,
  exact (@quotient.mk_out' _ (is_isomorphic_setoid _) G).some,
end

variable {C}
variables (hC : is_finite_class C) (h : (class_card C hC).prime)
include h

@[to_additive not_is_trivial_add_class_of_prime_card]
lemma not_is_trivial_class_of_prime_card : ¬ is_trivial_class C :=
begin
  dsimp [is_trivial_class], dsimp [is_finite_class] at hC,
  rw [←quotient.out_eq' C, quotient.lift_on'_mk'] at *,
  haveI := hC.some,
  apply subgroup.not_subsingleton_of_prime_card,
  simpa only [←class_card_mk', quotient.out_eq'],
end

@[to_additive is_simple_add_class_of_prime_card]
lemma is_simple_class_of_prime_card : is_simple_class C :=
begin
  dsimp [is_simple_class], dsimp [is_finite_class] at hC,
  rw [←quotient.out_eq' C, quotient.lift_on'_mk'] at *,
  haveI := hC.some,
  apply subgroup.is_simple_of_prime_card,
  simpa only [←class_card_mk', quotient.out_eq'],
end


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

! This file was ported from Lean 3 source module topology.is_locally_homeomorph
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.LocalHomeomorph

/-!
# Local homeomorphisms

This file defines local homeomorphisms.

## Main definitions

* `IsLocallyHomeomorph`: A function `f : X → Y` satisfies `IsLocallyHomeomorph` if for each
  point `x : X`, the restriction of `f` to some open neighborhood `U` of `x` gives a homeomorphism
  between `U` and an open subset of `Y`.

  Note that `IsLocallyHomeomorph` is a global condition. This is in contrast to
  `LocalHomeomorph`, which is a homeomorphism between specific open subsets.
-/

open Topology

variable {X Y Z : Type _} [TopologicalSpace X] [TopologicalSpace Y] [TopologicalSpace Z] (g : Y → Z)
  (f : X → Y) (s : Set X) (t : Set Y)

/-- A function `f : X → Y` satisfies `IsLocallyHomeomorphOn f s` if each `x ∈ s` is contained in
the source of some `e : LocalHomeomorph X Y` with `f = e`. -/
def IsLocallyHomeomorphOn :=
  ∀ x ∈ s, ∃ e : LocalHomeomorph X Y, x ∈ e.source ∧ f = e
#align is_locally_homeomorph_on IsLocallyHomeomorphOn

namespace IsLocallyHomeomorphOn

/-- Proves that `f` satisfies `IsLocallyHomeomorphOn f s`. The condition `h` is weaker than the
definition of `IsLocallyHomeomorphOn f s`, since it only requires `e : LocalHomeomorph X Y` to
agree with `f` on its source `e.source`, as opposed to on the whole space `X`. -/
theorem mk (h : ∀ x ∈ s, ∃ e : LocalHomeomorph X Y, x ∈ e.source ∧ ∀ y ∈ e.source, f y = e y) :
    IsLocallyHomeomorphOn f s := by
  intro x hx
  obtain ⟨e, hx, he⟩ := h x hx
  exact
    ⟨{ e with
        toFun := f
        map_source' := fun x hx => by rw [he x hx] ; exact e.map_source' hx
        left_inv' := fun x hx => by rw [he x hx] ; exact e.left_inv' hx
        right_inv' := fun y hy => by rw [he _ (e.map_target' hy)] ; exact e.right_inv' hy
        continuous_toFun := (continuousOn_congr he).mpr e.continuous_toFun },
      hx, rfl⟩
#align is_locally_homeomorph_on.mk IsLocallyHomeomorphOn.mk

variable {g f s t}

theorem map_nhds_eq (hf : IsLocallyHomeomorphOn f s) {x : X} (hx : x ∈ s) : (𝓝 x).map f = 𝓝 (f x) :=
  let ⟨e, hx, he⟩ := hf x hx
  he.symm ▸ e.map_nhds_eq hx
#align is_locally_homeomorph_on.map_nhds_eq IsLocallyHomeomorphOn.map_nhds_eq

protected theorem continuousAt (hf : IsLocallyHomeomorphOn f s) {x : X} (hx : x ∈ s) :
    ContinuousAt f x :=
  (hf.map_nhds_eq hx).le
#align is_locally_homeomorph_on.continuous_at IsLocallyHomeomorphOn.continuousAt

protected theorem continuousOn (hf : IsLocallyHomeomorphOn f s) : ContinuousOn f s :=
  ContinuousAt.continuousOn fun _x => hf.continuousAt
#align is_locally_homeomorph_on.continuous_on IsLocallyHomeomorphOn.continuousOn

protected theorem comp (hg : IsLocallyHomeomorphOn g t) (hf : IsLocallyHomeomorphOn f s)
    (h : Set.MapsTo f s t) : IsLocallyHomeomorphOn (g ∘ f) s := by
  intro x hx
  obtain ⟨eg, hxg, rfl⟩ := hg (f x) (h hx)
  obtain ⟨ef, hxf, rfl⟩ := hf x hx
  exact ⟨ef.trans eg, ⟨hxf, hxg⟩, rfl⟩
#align is_locally_homeomorph_on.comp IsLocallyHomeomorphOn.comp

end IsLocallyHomeomorphOn

/-- A function `f : X → Y` satisfies `IsLocallyHomeomorph f` if each `x : x` is contained in
  the source of some `e : LocalHomeomorph X Y` with `f = e`. -/
def IsLocallyHomeomorph :=
  ∀ x : X, ∃ e : LocalHomeomorph X Y, x ∈ e.source ∧ f = e
#align is_locally_homeomorph IsLocallyHomeomorph

variable {f}

theorem isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ :
    IsLocallyHomeomorph f ↔ IsLocallyHomeomorphOn f Set.univ := by
  simp only [IsLocallyHomeomorph, IsLocallyHomeomorphOn, Set.mem_univ, forall_true_left]
#align is_locally_homeomorph_iff_is_locally_homeomorph_on_univ isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ

protected theorem IsLocallyHomeomorph.isLocallyHomeomorphOn (hf : IsLocallyHomeomorph f) :
    IsLocallyHomeomorphOn f Set.univ :=
  isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ.mp hf
#align is_locally_homeomorph.is_locally_homeomorph_on IsLocallyHomeomorph.isLocallyHomeomorphOn

variable (f)

namespace IsLocallyHomeomorph

/-- Proves that `f` satisfies `IsLocallyHomeomorph f`. The condition `h` is weaker than the
definition of `IsLocallyHomeomorph f`, since it only requires `e : LocalHomeomorph X Y` to
agree with `f` on its source `e.source`, as opposed to on the whole space `X`. -/
theorem mk (h : ∀ x : X, ∃ e : LocalHomeomorph X Y, x ∈ e.source ∧ ∀ y ∈ e.source, f y = e y) :
    IsLocallyHomeomorph f :=
  isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ.mpr
    (IsLocallyHomeomorphOn.mk f Set.univ fun x _hx => h x)
#align is_locally_homeomorph.mk IsLocallyHomeomorph.mk

variable {g f}

theorem map_nhds_eq (hf : IsLocallyHomeomorph f) (x : X) : (𝓝 x).map f = 𝓝 (f x) :=
  hf.isLocallyHomeomorphOn.map_nhds_eq (Set.mem_univ x)
#align is_locally_homeomorph.map_nhds_eq IsLocallyHomeomorph.map_nhds_eq

protected theorem continuous (hf : IsLocallyHomeomorph f) : Continuous f :=
  continuous_iff_continuousOn_univ.mpr hf.isLocallyHomeomorphOn.continuousOn
#align is_locally_homeomorph.continuous IsLocallyHomeomorph.continuous

protected theorem isOpenMap (hf : IsLocallyHomeomorph f) : IsOpenMap f :=
  IsOpenMap.of_nhds_le fun x => ge_of_eq (hf.map_nhds_eq x)
#align is_locally_homeomorph.is_open_map IsLocallyHomeomorph.isOpenMap

protected theorem comp (hg : IsLocallyHomeomorph g) (hf : IsLocallyHomeomorph f) :
    IsLocallyHomeomorph (g ∘ f) :=
  isLocallyHomeomorph_iff_isLocallyHomeomorphOn_univ.mpr
    (hg.isLocallyHomeomorphOn.comp hf.isLocallyHomeomorphOn (Set.univ.mapsTo_univ f))
#align is_locally_homeomorph.comp IsLocallyHomeomorph.comp

end IsLocallyHomeomorph


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.multiset.fold
! leanprover-community/mathlib commit f2f413b9d4be3a02840d0663dace76e8fe3da053
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Multiset.Dedup
import Mathbin.Data.List.MinMax

/-!
# The fold operation for a commutative associative operation over a multiset.

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
-/

namespace Multiset

variable {α β : Type _}

/-! ### fold -/

section Fold

variable (op : α → α → α) [hc : IsCommutative α op] [ha : IsAssociative α op]

-- mathport name: op
local notation a " * " b => op a b

include hc ha

#print Multiset.fold /-
/-- `fold op b s` folds a commutative associative operation `op` over
  the multiset `s`. -/
def fold : α → Multiset α → α :=
  foldr op (left_comm _ hc.comm ha.and_assoc)
#align multiset.fold Multiset.fold
-/

#print Multiset.fold_eq_foldr /-
theorem fold_eq_foldr (b : α) (s : Multiset α) :
    fold op b s = foldr op (left_comm _ hc.comm ha.and_assoc) b s :=
  rfl
#align multiset.fold_eq_foldr Multiset.fold_eq_foldr
-/

#print Multiset.coe_fold_r /-
@[simp]
theorem coe_fold_r (b : α) (l : List α) : fold op b l = l.foldr op b :=
  rfl
#align multiset.coe_fold_r Multiset.coe_fold_r
-/

#print Multiset.coe_fold_l /-
theorem coe_fold_l (b : α) (l : List α) : fold op b l = l.foldl op b :=
  (coe_foldr_swap op _ b l).trans <| by simp [hc.comm]
#align multiset.coe_fold_l Multiset.coe_fold_l
-/

#print Multiset.fold_eq_foldl /-
theorem fold_eq_foldl (b : α) (s : Multiset α) :
    fold op b s = foldl op (right_comm _ hc.comm ha.and_assoc) b s :=
  Quot.inductionOn s fun l => coe_fold_l _ _ _
#align multiset.fold_eq_foldl Multiset.fold_eq_foldl
-/

#print Multiset.fold_zero /-
@[simp]
theorem fold_zero (b : α) : (0 : Multiset α).fold op b = b :=
  rfl
#align multiset.fold_zero Multiset.fold_zero
-/

#print Multiset.fold_cons_left /-
@[simp]
theorem fold_cons_left : ∀ (b a : α) (s : Multiset α), (a ::ₘ s).fold op b = a * s.fold op b :=
  foldr_cons _ _
#align multiset.fold_cons_left Multiset.fold_cons_left
-/

#print Multiset.fold_cons_right /-
theorem fold_cons_right (b a : α) (s : Multiset α) : (a ::ₘ s).fold op b = s.fold op b * a := by
  simp [hc.comm]
#align multiset.fold_cons_right Multiset.fold_cons_right
-/

#print Multiset.fold_cons'_right /-
theorem fold_cons'_right (b a : α) (s : Multiset α) : (a ::ₘ s).fold op b = s.fold op (b * a) := by
  rw [fold_eq_foldl, foldl_cons, ← fold_eq_foldl]
#align multiset.fold_cons'_right Multiset.fold_cons'_right
-/

#print Multiset.fold_cons'_left /-
theorem fold_cons'_left (b a : α) (s : Multiset α) : (a ::ₘ s).fold op b = s.fold op (a * b) := by
  rw [fold_cons'_right, hc.comm]
#align multiset.fold_cons'_left Multiset.fold_cons'_left
-/

#print Multiset.fold_add /-
theorem fold_add (b₁ b₂ : α) (s₁ s₂ : Multiset α) :
    (s₁ + s₂).fold op (b₁ * b₂) = s₁.fold op b₁ * s₂.fold op b₂ :=
  Multiset.induction_on s₂ (by rw [add_zero, fold_zero, ← fold_cons'_right, ← fold_cons_right op])
    (by simp (config := { contextual := true }) <;> cc)
#align multiset.fold_add Multiset.fold_add
-/

#print Multiset.fold_bind /-
theorem fold_bind {ι : Type _} (s : Multiset ι) (t : ι → Multiset α) (b : ι → α) (b₀ : α) :
    (s.bind t).fold op ((s.map b).fold op b₀) = (s.map fun i => (t i).fold op (b i)).fold op b₀ :=
  by
  induction' s using Multiset.induction_on with a ha ih
  · rw [zero_bind, map_zero, map_zero, fold_zero]
  · rw [cons_bind, map_cons, map_cons, fold_cons_left, fold_cons_left, fold_add, ih]
#align multiset.fold_bind Multiset.fold_bind
-/

#print Multiset.fold_singleton /-
theorem fold_singleton (b a : α) : ({a} : Multiset α).fold op b = a * b :=
  foldr_singleton _ _ _ _
#align multiset.fold_singleton Multiset.fold_singleton
-/

#print Multiset.fold_distrib /-
theorem fold_distrib {f g : β → α} (u₁ u₂ : α) (s : Multiset β) :
    (s.map fun x => f x * g x).fold op (u₁ * u₂) = (s.map f).fold op u₁ * (s.map g).fold op u₂ :=
  Multiset.induction_on s (by simp) (by simp (config := { contextual := true }) <;> cc)
#align multiset.fold_distrib Multiset.fold_distrib
-/

#print Multiset.fold_hom /-
theorem fold_hom {op' : β → β → β} [IsCommutative β op'] [IsAssociative β op'] {m : α → β}
    (hm : ∀ x y, m (op x y) = op' (m x) (m y)) (b : α) (s : Multiset α) :
    (s.map m).fold op' (m b) = m (s.fold op b) :=
  Multiset.induction_on s (by simp) (by simp (config := { contextual := true }) [hm])
#align multiset.fold_hom Multiset.fold_hom
-/

#print Multiset.fold_union_inter /-
theorem fold_union_inter [DecidableEq α] (s₁ s₂ : Multiset α) (b₁ b₂ : α) :
    ((s₁ ∪ s₂).fold op b₁ * (s₁ ∩ s₂).fold op b₂) = s₁.fold op b₁ * s₂.fold op b₂ := by
  rw [← fold_add op, union_add_inter, fold_add op]
#align multiset.fold_union_inter Multiset.fold_union_inter
-/

#print Multiset.fold_dedup_idem /-
@[simp]
theorem fold_dedup_idem [DecidableEq α] [hi : IsIdempotent α op] (s : Multiset α) (b : α) :
    (dedup s).fold op b = s.fold op b :=
  Multiset.induction_on s (by simp) fun a s IH =>
    by
    by_cases a ∈ s <;> simp [IH, h]
    show fold op b s = op a (fold op b s)
    rw [← cons_erase h, fold_cons_left, ← ha.assoc, hi.idempotent]
#align multiset.fold_dedup_idem Multiset.fold_dedup_idem
-/

end Fold

section Order

/- warning: multiset.max_le_of_forall_le -> Multiset.max_le_of_forall_le is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : CanonicallyLinearOrderedAddMonoid.{u1} α] (l : Multiset.{u1} α) (n : α), (forall (x : α), (Membership.Mem.{u1, u1} α (Multiset.{u1} α) (Multiset.hasMem.{u1} α) x l) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (CanonicallyOrderedAddMonoid.toOrderedAddCommMonoid.{u1} α (CanonicallyLinearOrderedAddMonoid.toCanonicallyOrderedAddMonoid.{u1} α _inst_1))))) x n)) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (CanonicallyOrderedAddMonoid.toOrderedAddCommMonoid.{u1} α (CanonicallyLinearOrderedAddMonoid.toCanonicallyOrderedAddMonoid.{u1} α _inst_1))))) (Multiset.fold.{u1} α (LinearOrder.max.{u1} α (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{u1} α _inst_1)) (sup_isCommutative.{u1} α (CanonicallyLinearOrderedAddMonoid.semilatticeSup.{u1} α _inst_1)) (sup_isAssociative.{u1} α (CanonicallyLinearOrderedAddMonoid.semilatticeSup.{u1} α _inst_1)) (Bot.bot.{u1} α (CanonicallyOrderedAddMonoid.toHasBot.{u1} α (CanonicallyLinearOrderedAddMonoid.toCanonicallyOrderedAddMonoid.{u1} α _inst_1))) l) n)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : CanonicallyLinearOrderedAddMonoid.{u1} α] (l : Multiset.{u1} α) (n : α), (forall (x : α), (Membership.mem.{u1, u1} α (Multiset.{u1} α) (Multiset.instMembershipMultiset.{u1} α) x l) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (CanonicallyOrderedAddMonoid.toOrderedAddCommMonoid.{u1} α (CanonicallyLinearOrderedAddMonoid.toCanonicallyOrderedAddMonoid.{u1} α _inst_1))))) x n)) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedAddCommMonoid.toPartialOrder.{u1} α (CanonicallyOrderedAddMonoid.toOrderedAddCommMonoid.{u1} α (CanonicallyLinearOrderedAddMonoid.toCanonicallyOrderedAddMonoid.{u1} α _inst_1))))) (Multiset.fold.{u1} α (Max.max.{u1} α (LinearOrder.toMax.{u1} α (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{u1} α _inst_1))) (instIsCommutativeMaxToMax.{u1} α (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{u1} α _inst_1)) (instIsAssociativeMaxToMax.{u1} α (CanonicallyLinearOrderedAddMonoid.toLinearOrder.{u1} α _inst_1)) (Bot.bot.{u1} α (CanonicallyOrderedAddMonoid.toBot.{u1} α (CanonicallyLinearOrderedAddMonoid.toCanonicallyOrderedAddMonoid.{u1} α _inst_1))) l) n)
Case conversion may be inaccurate. Consider using '#align multiset.max_le_of_forall_le Multiset.max_le_of_forall_leₓ'. -/
theorem max_le_of_forall_le {α : Type _} [CanonicallyLinearOrderedAddMonoid α] (l : Multiset α)
    (n : α) (h : ∀ x ∈ l, x ≤ n) : l.fold max ⊥ ≤ n :=
  by
  induction l using Quotient.inductionOn
  simpa using List.max_le_of_forall_le _ _ h
#align multiset.max_le_of_forall_le Multiset.max_le_of_forall_le

/- warning: multiset.max_nat_le_of_forall_le -> Multiset.max_nat_le_of_forall_le is a dubious translation:
lean 3 declaration is
  forall (l : Multiset.{0} Nat) (n : Nat), (forall (x : Nat), (Membership.Mem.{0, 0} Nat (Multiset.{0} Nat) (Multiset.hasMem.{0} Nat) x l) -> (LE.le.{0} Nat Nat.hasLe x n)) -> (LE.le.{0} Nat Nat.hasLe (Multiset.fold.{0} Nat (LinearOrder.max.{0} Nat Nat.linearOrder) (sup_isCommutative.{0} Nat (CanonicallyLinearOrderedAddMonoid.semilatticeSup.{0} Nat Nat.canonicallyLinearOrderedAddMonoid)) (sup_isAssociative.{0} Nat (CanonicallyLinearOrderedAddMonoid.semilatticeSup.{0} Nat Nat.canonicallyLinearOrderedAddMonoid)) (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) l) n)
but is expected to have type
  forall (l : Multiset.{0} Nat) (n : Nat), (forall (x : Nat), (Membership.mem.{0, 0} Nat (Multiset.{0} Nat) (Multiset.instMembershipMultiset.{0} Nat) x l) -> (LE.le.{0} Nat instLENat x n)) -> (LE.le.{0} Nat instLENat (Multiset.fold.{0} Nat (Max.max.{0} Nat (LinearOrder.toMax.{0} Nat Nat.linearOrder)) (instIsCommutativeMaxToMax.{0} Nat Nat.linearOrder) (instIsAssociativeMaxToMax.{0} Nat Nat.linearOrder) (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0)) l) n)
Case conversion may be inaccurate. Consider using '#align multiset.max_nat_le_of_forall_le Multiset.max_nat_le_of_forall_leₓ'. -/
theorem max_nat_le_of_forall_le (l : Multiset ℕ) (n : ℕ) (h : ∀ x ∈ l, x ≤ n) : l.fold max 0 ≤ n :=
  max_le_of_forall_le l n h
#align multiset.max_nat_le_of_forall_le Multiset.max_nat_le_of_forall_le

end Order

open Nat

/- warning: multiset.le_smul_dedup -> Multiset.le_smul_dedup is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (s : Multiset.{u1} α), Exists.{1} Nat (fun (n : Nat) => LE.le.{u1} (Multiset.{u1} α) (Preorder.toLE.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.partialOrder.{u1} α))) s (SMul.smul.{0, u1} Nat (Multiset.{u1} α) (AddMonoid.SMul.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.orderedCancelAddCommMonoid.{u1} α)))))) n (Multiset.dedup.{u1} α (fun (a : α) (b : α) => _inst_1 a b) s)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] (s : Multiset.{u1} α), Exists.{1} Nat (fun (n : Nat) => LE.le.{u1} (Multiset.{u1} α) (Preorder.toLE.{u1} (Multiset.{u1} α) (PartialOrder.toPreorder.{u1} (Multiset.{u1} α) (Multiset.instPartialOrderMultiset.{u1} α))) s (HSMul.hSMul.{0, u1, u1} Nat (Multiset.{u1} α) (Multiset.{u1} α) (instHSMul.{0, u1} Nat (Multiset.{u1} α) (AddMonoid.SMul.{u1} (Multiset.{u1} α) (AddRightCancelMonoid.toAddMonoid.{u1} (Multiset.{u1} α) (AddCancelMonoid.toAddRightCancelMonoid.{u1} (Multiset.{u1} α) (AddCancelCommMonoid.toAddCancelMonoid.{u1} (Multiset.{u1} α) (OrderedCancelAddCommMonoid.toCancelAddCommMonoid.{u1} (Multiset.{u1} α) (Multiset.instOrderedCancelAddCommMonoidMultiset.{u1} α))))))) n (Multiset.dedup.{u1} α (fun (a : α) (b : α) => _inst_1 a b) s)))
Case conversion may be inaccurate. Consider using '#align multiset.le_smul_dedup Multiset.le_smul_dedupₓ'. -/
theorem le_smul_dedup [DecidableEq α] (s : Multiset α) : ∃ n : ℕ, s ≤ n • dedup s :=
  ⟨(s.map fun a => count a s).fold max 0,
    le_iff_count.2 fun a => by
      rw [count_nsmul]; by_cases a ∈ s
      · refine' le_trans _ (Nat.mul_le_mul_left _ <| count_pos.2 <| mem_dedup.2 h)
        have : count a s ≤ fold max 0 (map (fun a => count a s) (a ::ₘ erase s a)) <;>
          [simp [le_max_left], simpa [cons_erase h] ]
      · simp [count_eq_zero.2 h, Nat.zero_le]⟩
#align multiset.le_smul_dedup Multiset.le_smul_dedup

end Multiset


/-
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, Haitao Zhang

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

/-!
# General operations on functions
-/

universe u₁ u₂ u₃ u₄

namespace Function

variable {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} {δ : Sort u₄} {ζ : Sort u₁}

#print Function.comp /-
/-- Composition of functions: `(f ∘ g) x = f (g x)`. -/
@[inline, reducible]
def comp (f : β → φ) (g : α → β) : α → φ := fun x => f (g x)
#align function.comp Function.comp
-/

/-- Composition of dependent functions: `(f ∘' g) x = f (g x)`, where type of `g x` depends on `x`
and type of `f (g x)` depends on `x` and `g x`. -/
@[inline, reducible]
def dcomp {β : α → Sort u₂} {φ : ∀ {x : α}, β x → Sort u₃} (f : ∀ {x : α} (y : β x), φ y)
    (g : ∀ x, β x) : ∀ x, φ (g x) := fun x => f (g x)
#align function.dcomp Function.dcomp

-- mathport name: «expr ∘' »
infixr:80 " ∘' " => Function.dcomp

@[reducible]
def compRight (f : β → β → β) (g : α → β) : β → α → β := fun b a => f b (g a)
#align function.comp_right Function.compRight

@[reducible]
def compLeft (f : β → β → β) (g : α → β) : α → β → β := fun a b => f (g a) b
#align function.comp_left Function.compLeft

#print Function.onFun /-
/-- Given functions `f : β → β → φ` and `g : α → β`, produce a function `α → α → φ` that evaluates
`g` on each argument, then applies `f` to the results. Can be used, e.g., to transfer a relation
from `β` to `α`. -/
@[reducible]
def onFun (f : β → β → φ) (g : α → β) : α → α → φ := fun x y => f (g x) (g y)
#align function.on_fun Function.onFun
-/

#print Function.combine /-
@[reducible]
def combine (f : α → β → φ) (op : φ → δ → ζ) (g : α → β → δ) : α → β → ζ := fun x y =>
  op (f x y) (g x y)
#align function.combine Function.combine
-/

#print Function.const /-
/-- Constant `λ _, a`. -/
@[reducible]
def const (β : Sort u₂) (a : α) : β → α := fun x => a
#align function.const Function.const
-/

#print Function.swap /-
@[reducible]
def swap {φ : α → β → Sort u₃} (f : ∀ x y, φ x y) : ∀ y x, φ x y := fun y x => f x y
#align function.swap Function.swap
-/

#print Function.app /-
@[reducible]
def app {β : α → Sort u₂} (f : ∀ x, β x) (x : α) : β x :=
  f x
#align function.app Function.app
-/

-- mathport name: «expr on »
infixl:2 " on " => onFun

-- mathport name: «expr -[ ]- »
notation f " -[" op "]- " g => combine f op g

#print Function.left_id /-
theorem left_id (f : α → β) : id ∘ f = f :=
  rfl
#align function.left_id Function.left_id
-/

#print Function.right_id /-
theorem right_id (f : α → β) : f ∘ id = f :=
  rfl
#align function.right_id Function.right_id
-/

/- warning: function.comp_app -> Function.comp_apply is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {β : Sort.{u2}} {φ : Sort.{u3}} (f : β -> φ) (g : α -> β) (a : α), Eq.{u3} φ (Function.comp.{u1, u2, u3} α β φ f g a) (f (g a))
but is expected to have type
  forall {α : Sort.{u3}} {β : Sort.{u2}} {φ : Sort.{u1}} {f : α -> β} {g : φ -> α} {a : φ}, Eq.{u2} β (Function.comp.{u1, u3, u2} φ α β f g a) (f (g a))
Case conversion may be inaccurate. Consider using '#align function.comp_app Function.comp_applyₓ'. -/
@[simp]
theorem comp_apply (f : β → φ) (g : α → β) (a : α) : (f ∘ g) a = f (g a) :=
  rfl
#align function.comp_app Function.comp_apply

#print Function.comp.assoc /-
theorem comp.assoc (f : φ → δ) (g : β → φ) (h : α → β) : (f ∘ g) ∘ h = f ∘ g ∘ h :=
  rfl
#align function.comp.assoc Function.comp.assoc
-/

#print Function.comp.left_id /-
@[simp]
theorem comp.left_id (f : α → β) : id ∘ f = f :=
  rfl
#align function.comp.left_id Function.comp.left_id
-/

#print Function.comp.right_id /-
@[simp]
theorem comp.right_id (f : α → β) : f ∘ id = f :=
  rfl
#align function.comp.right_id Function.comp.right_id
-/

#print Function.comp_const_right /-
theorem comp_const_right (f : β → φ) (b : β) : f ∘ const α b = const α (f b) :=
  rfl
#align function.comp_const_right Function.comp_const_right
-/

#print Function.Injective /-
/-- A function `f : α → β` is called injective if `f x = f y` implies `x = y`. -/
def Injective (f : α → β) : Prop :=
  ∀ ⦃a₁ a₂⦄, f a₁ = f a₂ → a₁ = a₂
#align function.injective Function.Injective
-/

#print Function.Injective.comp /-
theorem Injective.comp {g : β → φ} {f : α → β} (hg : Injective g) (hf : Injective f) :
    Injective (g ∘ f) := fun a₁ a₂ => fun h => hf (hg h)
#align function.injective.comp Function.Injective.comp
-/

#print Function.Surjective /-
/-- A function `f : α → β` is called surjective if every `b : β` is equal to `f a`
for some `a : α`. -/
@[reducible]
def Surjective (f : α → β) : Prop :=
  ∀ b, ∃ a, f a = b
#align function.surjective Function.Surjective
-/

#print Function.Surjective.comp /-
theorem Surjective.comp {g : β → φ} {f : α → β} (hg : Surjective g) (hf : Surjective f) :
    Surjective (g ∘ f) := fun c : φ =>
  Exists.elim (hg c) fun b hb =>
    Exists.elim (hf b) fun a ha =>
      Exists.intro a (show g (f a) = c from Eq.trans (congr_arg g ha) hb)
#align function.surjective.comp Function.Surjective.comp
-/

#print Function.Bijective /-
/-- A function is called bijective if it is both injective and surjective. -/
def Bijective (f : α → β) :=
  Injective f ∧ Surjective f
#align function.bijective Function.Bijective
-/

#print Function.Bijective.comp /-
theorem Bijective.comp {g : β → φ} {f : α → β} : Bijective g → Bijective f → Bijective (g ∘ f)
  | ⟨h_ginj, h_gsurj⟩, ⟨h_finj, h_fsurj⟩ => ⟨h_ginj.comp h_finj, h_gsurj.comp h_fsurj⟩
#align function.bijective.comp Function.Bijective.comp
-/

#print Function.LeftInverse /-
/-- `left_inverse g f` means that g is a left inverse to f. That is, `g ∘ f = id`. -/
def LeftInverse (g : β → α) (f : α → β) : Prop :=
  ∀ x, g (f x) = x
#align function.left_inverse Function.LeftInverse
-/

#print Function.HasLeftInverse /-
/-- `has_left_inverse f` means that `f` has an unspecified left inverse. -/
def HasLeftInverse (f : α → β) : Prop :=
  ∃ finv : β → α, LeftInverse finv f
#align function.has_left_inverse Function.HasLeftInverse
-/

#print Function.RightInverse /-
/-- `right_inverse g f` means that g is a right inverse to f. That is, `f ∘ g = id`. -/
def RightInverse (g : β → α) (f : α → β) : Prop :=
  LeftInverse f g
#align function.right_inverse Function.RightInverse
-/

#print Function.HasRightInverse /-
/-- `has_right_inverse f` means that `f` has an unspecified right inverse. -/
def HasRightInverse (f : α → β) : Prop :=
  ∃ finv : β → α, RightInverse finv f
#align function.has_right_inverse Function.HasRightInverse
-/

#print Function.LeftInverse.injective /-
theorem LeftInverse.injective {g : β → α} {f : α → β} : LeftInverse g f → Injective f :=
  fun h a b faeqfb =>
  calc
    a = g (f a) := (h a).symm
    _ = g (f b) := (congr_arg g faeqfb)
    _ = b := h b

#align function.left_inverse.injective Function.LeftInverse.injective
-/

#print Function.HasLeftInverse.injective /-
theorem HasLeftInverse.injective {f : α → β} : HasLeftInverse f → Injective f := fun h =>
  Exists.elim h fun finv inv => inv.Injective
#align function.has_left_inverse.injective Function.HasLeftInverse.injective
-/

#print Function.rightInverse_of_injective_of_leftInverse /-
theorem rightInverse_of_injective_of_leftInverse {f : α → β} {g : β → α} (injf : Injective f)
    (lfg : LeftInverse f g) : RightInverse f g := fun x =>
  have h : f (g (f x)) = f x := lfg (f x)
  injf h
#align function.right_inverse_of_injective_of_left_inverse Function.rightInverse_of_injective_of_leftInverse
-/

#print Function.RightInverse.surjective /-
theorem RightInverse.surjective {f : α → β} {g : β → α} (h : RightInverse g f) : Surjective f :=
  fun y => ⟨g y, h y⟩
#align function.right_inverse.surjective Function.RightInverse.surjective
-/

#print Function.HasRightInverse.surjective /-
theorem HasRightInverse.surjective {f : α → β} : HasRightInverse f → Surjective f
  | ⟨finv, inv⟩ => inv.Surjective
#align function.has_right_inverse.surjective Function.HasRightInverse.surjective
-/

#print Function.leftInverse_of_surjective_of_rightInverse /-
theorem leftInverse_of_surjective_of_rightInverse {f : α → β} {g : β → α} (surjf : Surjective f)
    (rfg : RightInverse f g) : LeftInverse f g := fun y =>
  Exists.elim (surjf y) fun x hx =>
    calc
      f (g y) = f (g (f x)) := hx ▸ rfl
      _ = f x := (Eq.symm (rfg x) ▸ rfl)
      _ = y := hx

#align function.left_inverse_of_surjective_of_right_inverse Function.leftInverse_of_surjective_of_rightInverse
-/

#print Function.injective_id /-
theorem injective_id : Injective (@id α) := fun a₁ a₂ h => h
#align function.injective_id Function.injective_id
-/

#print Function.surjective_id /-
theorem surjective_id : Surjective (@id α) := fun a => ⟨a, rfl⟩
#align function.surjective_id Function.surjective_id
-/

#print Function.bijective_id /-
theorem bijective_id : Bijective (@id α) :=
  ⟨injective_id, surjective_id⟩
#align function.bijective_id Function.bijective_id
-/

end Function

namespace Function

variable {α : Type u₁} {β : Type u₂} {φ : Type u₃}

#print Function.curry /-
/-- Interpret a function on `α × β` as a function with two arguments. -/
@[inline]
def curry : (α × β → φ) → α → β → φ := fun f a b => f (a, b)
#align function.curry Function.curry
-/

#print Function.uncurry /-
/-- Interpret a function with two arguments as a function on `α × β` -/
@[inline]
def uncurry : (α → β → φ) → α × β → φ := fun f a => f a.1 a.2
#align function.uncurry Function.uncurry
-/

#print Function.curry_uncurry /-
@[simp]
theorem curry_uncurry (f : α → β → φ) : curry (uncurry f) = f :=
  rfl
#align function.curry_uncurry Function.curry_uncurry
-/

#print Function.uncurry_curry /-
@[simp]
theorem uncurry_curry (f : α × β → φ) : uncurry (curry f) = f :=
  funext fun ⟨a, b⟩ => rfl
#align function.uncurry_curry Function.uncurry_curry
-/

#print Function.LeftInverse.id /-
protected theorem LeftInverse.id {g : β → α} {f : α → β} (h : LeftInverse g f) : g ∘ f = id :=
  funext h
#align function.left_inverse.id Function.LeftInverse.id
-/

#print Function.RightInverse.id /-
protected theorem RightInverse.id {g : β → α} {f : α → β} (h : RightInverse g f) : f ∘ g = id :=
  funext h
#align function.right_inverse.id Function.RightInverse.id
-/

end Function


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

! This file was ported from Lean 3 source module data.char
! leanprover-community/mathlib commit c4658a649d216f57e99621708b09dcb3dcccbd23
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.UInt
import Mathlib.Init.Algebra.Order

/-!
# More `Char` instances

This file provides a `LinearOrder` instance on `Char`. `Char` is the type of Unicode scalar values.
Provides an additional definition to truncate a `Char` to `UInt8` and a theorem on conversion to
`Nat`.
-/

/-- Convert a character into a `UInt8`, by truncating (reducing modulo 256) if necessary. -/
def Char.toUInt8 (n : Char) : UInt8 := n.1.toUInt8

theorem Char.utf8Size_pos (c : Char) : 0 < c.utf8Size := by
  simp only [utf8Size]
  repeat (split; decide)
  decide

theorem String.csize_pos : (c : Char) → 0 < String.csize c := Char.utf8Size_pos

/--
Provides a `LinearOrder` instance on `Char`. `Char` is the type of Unicode scalar values.
-/
instance : LinearOrder Char where
  le_refl := fun _ => @le_refl ℕ _ _
  le_trans := fun _ _ _  => @le_trans ℕ _ _ _ _
  le_antisymm := fun _ _ h₁ h₂ => Char.eq_of_val_eq <| UInt32.eq_of_val_eq <| Fin.ext <|
    @le_antisymm ℕ _ _ _ h₁ h₂
  lt_iff_le_not_le := fun _ _ => @lt_iff_le_not_le ℕ _ _ _
  le_total := fun _ _ => @le_total ℕ _ _ _
  min := fun a b => if a ≤ b then a else b
  max := fun a b => if a ≤ b then b else a
  decidable_le := inferInstance

theorem Char.ofNat_toNat {c : Char} (h : isValidCharNat c.toNat) : Char.ofNat c.toNat = c := by
  rw [Char.ofNat, dif_pos h]
  rfl
#align char.of_nat_to_nat Char.ofNat_toNat


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Floris van Doorn

! This file was ported from Lean 3 source module topology.sets.opens
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Hom.CompleteLattice
import Mathlib.Topology.Bases
import Mathlib.Topology.Homeomorph
import Mathlib.Topology.ContinuousFunction.Basic
import Mathlib.Order.CompactlyGenerated
import Mathlib.Order.Copy

/-!
# Open sets

## Summary

We define the subtype of open sets in a topological space.

## Main Definitions

### Bundled open sets

- `TopologicalSpace.Opens α` is the type of open subsets of a topological space `α`.
- `TopologicalSpace.Opens.IsBasis` is a predicate saying that a set of `opens`s form a topological
  basis.
- `TopologicalSpace.Opens.comap`: preimage of an open set under a continuous map as a `FrameHom`.
- `Homeomorph.opensCongr`: order-preserving equivalence between open sets in the domain and the
  codomain of a homeomorphism.

### Bundled open neighborhoods

- `TopologicalSpace.OpenNhdsOf x` is the type of open subsets of a topological space `α` containing
  `x : α`.
- `TopologicalSpace.OpenNhdsOf.comap f x U` is the preimage of open neighborhood `U` of `f x` under
  `f : C(α, β)`.

## Main results

We define order structures on both `opens α` (`complete_structure`, `frame`) and `open_nhds_of x`
(`OrderTop`, `DistribLattice`).

## TODO

- Rename `TopologicalSpace.Opens` to `Open`?
- Port the `auto_cases` tactic version (as a plugin if the ported `auto_cases` will allow plugins).
-/

open Filter Function Order Set

open Topology

variable {ι α β γ : Type _} [TopologicalSpace α] [TopologicalSpace β] [TopologicalSpace γ]

namespace TopologicalSpace

variable (α)

/-- The type of open subsets of a topological space. -/
structure Opens where
  /-- The underlying set of a bundled `TopoogicalSpace.Opens` object. -/
  carrier : Set α
  /-- The `TopologicalSpace.Opens.carrier _` is an open set. -/
  is_open' : IsOpen carrier
#align topological_space.opens TopologicalSpace.Opens

variable {α}

namespace Opens

instance : SetLike (Opens α) α where
  coe := Opens.carrier
  coe_injective' := fun ⟨_, _⟩ ⟨_, _⟩ _ => by congr

instance : CanLift (Set α) (Opens α) (↑) IsOpen :=
  ⟨fun s h => ⟨⟨s, h⟩, rfl⟩⟩

theorem «forall» {p : Opens α → Prop} : (∀ U, p U) ↔ ∀ (U : Set α) (hU : IsOpen U), p ⟨U, hU⟩ :=
  ⟨fun h _ _ => h _, fun h _ => h _ _⟩
#align topological_space.opens.forall TopologicalSpace.Opens.forall

@[simp] theorem carrier_eq_coe (U : Opens α) : U.1 = ↑U := rfl
#align topological_space.opens.carrier_eq_coe TopologicalSpace.Opens.carrier_eq_coe

/-- the coercion `Opens α → Set α` applied to a pair is the same as taking the first component -/
@[simp]
theorem coe_mk {U : Set α} {hU : IsOpen U} : ↑(⟨U, hU⟩ : Opens α) = U :=
  rfl
#align topological_space.opens.coe_mk TopologicalSpace.Opens.coe_mk

@[simp]
theorem mem_mk {x : α} {U : Set α} {h : IsOpen U} : x ∈ mk U h ↔ x ∈ U := Iff.rfl
#align topological_space.opens.mem_mk TopologicalSpace.Opens.mem_mk

-- porting note: removed @[simp] because LHS simplifies to `∃ x, x ∈ U`
protected theorem nonempty_coeSort {U : Opens α} : Nonempty U ↔ (U : Set α).Nonempty :=
  Set.nonempty_coe_sort
#align topological_space.opens.nonempty_coe_sort TopologicalSpace.Opens.nonempty_coeSort

-- porting note: new lemma; todo: prove it for a `SetLike`?
protected theorem nonempty_coe {U : Opens α} : (U : Set α).Nonempty ↔ ∃ x, x ∈ U :=
  Iff.rfl

@[ext] -- porting note: todo: replace with `∀ x, x ∈ U ↔ x ∈ V`
theorem ext {U V : Opens α} (h : (U : Set α) = V) : U = V :=
  SetLike.coe_injective h
#align topological_space.opens.ext TopologicalSpace.Opens.ext

-- porting note: removed @[simp], simp can prove it
theorem coe_inj {U V : Opens α} : (U : Set α) = V ↔ U = V :=
  SetLike.ext'_iff.symm
#align topological_space.opens.coe_inj TopologicalSpace.Opens.coe_inj

protected theorem isOpen (U : Opens α) : IsOpen (U : Set α) :=
  U.is_open'
#align topological_space.opens.is_open TopologicalSpace.Opens.isOpen

@[simp] theorem mk_coe (U : Opens α) : mk (↑U) U.isOpen = U := rfl
#align topological_space.opens.mk_coe TopologicalSpace.Opens.mk_coe

/-- See Note [custom simps projection]. -/
def Simps.coe (U : Opens α) : Set α := U
#align topological_space.opens.simps.coe TopologicalSpace.Opens.Simps.coe

initialize_simps_projections Opens (carrier → coe)

/-- The interior of a set, as an element of `Opens`. -/
nonrec def interior (s : Set α) : Opens α :=
  ⟨interior s, isOpen_interior⟩
#align topological_space.opens.interior TopologicalSpace.Opens.interior

theorem gc : GaloisConnection ((↑) : Opens α → Set α) interior := fun U _ =>
  ⟨fun h => interior_maximal h U.isOpen, fun h => le_trans h interior_subset⟩
#align topological_space.opens.gc TopologicalSpace.Opens.gc

/-- The galois coinsertion between sets and opens. -/
def gi : GaloisCoinsertion (↑) (@interior α _) where
  choice s hs := ⟨s, interior_eq_iff_isOpen.mp <| le_antisymm interior_subset hs⟩
  gc := gc
  u_l_le _ := interior_subset
  choice_eq _s hs := le_antisymm hs interior_subset
#align topological_space.opens.gi TopologicalSpace.Opens.gi

instance : CompleteLattice (Opens α) :=
  CompleteLattice.copy (GaloisCoinsertion.liftCompleteLattice gi)
    -- le
    (fun U V => (U : Set α) ⊆ V) rfl
    -- top
    ⟨univ, isOpen_univ⟩ (ext interior_univ.symm)
    -- bot
    ⟨∅, isOpen_empty⟩ rfl
    -- sup
    (fun U V => ⟨↑U ∪ ↑V, U.2.union V.2⟩) rfl
    -- inf
    (fun U V => ⟨↑U ∩ ↑V, U.2.inter V.2⟩)
    (funext₂ fun U V => ext (U.2.inter V.2).interior_eq.symm)
    -- supₛ
    (fun S => ⟨⋃ s ∈ S, ↑s, isOpen_bunionᵢ fun s _ => s.2⟩)
    (funext fun _ => ext supₛ_image.symm)
    -- infₛ
    _ rfl

@[simp]
theorem mk_inf_mk {U V : Set α} {hU : IsOpen U} {hV : IsOpen V} :
    (⟨U, hU⟩ ⊓ ⟨V, hV⟩ : Opens α) = ⟨U ⊓ V, IsOpen.inter hU hV⟩ :=
  rfl
#align topological_space.opens.mk_inf_mk TopologicalSpace.Opens.mk_inf_mk

@[simp, norm_cast]
theorem coe_inf (s t : Opens α) : (↑(s ⊓ t) : Set α) = ↑s ∩ ↑t :=
  rfl
#align topological_space.opens.coe_inf TopologicalSpace.Opens.coe_inf

@[simp, norm_cast]
theorem coe_sup (s t : Opens α) : (↑(s ⊔ t) : Set α) = ↑s ∪ ↑t :=
  rfl
#align topological_space.opens.coe_sup TopologicalSpace.Opens.coe_sup

@[simp, norm_cast]
theorem coe_bot : ((⊥ : Opens α) : Set α) = ∅ :=
  rfl
#align topological_space.opens.coe_bot TopologicalSpace.Opens.coe_bot

-- porting note: new lemma
@[simp, norm_cast]
theorem coe_eq_empty {U : Opens α} : (U : Set α) = ∅ ↔ U = ⊥ :=
  SetLike.coe_injective.eq_iff' rfl

@[simp, norm_cast]
theorem coe_top : ((⊤ : Opens α) : Set α) = Set.univ :=
  rfl
#align topological_space.opens.coe_top TopologicalSpace.Opens.coe_top

-- porting note: new lemma
@[simp, norm_cast]
theorem coe_eq_univ {U : Opens α} : (U : Set α) = univ ↔ U = ⊤ :=
  SetLike.coe_injective.eq_iff' rfl

@[simp, norm_cast]
theorem coe_supₛ {S : Set (Opens α)} : (↑(supₛ S) : Set α) = ⋃ i ∈ S, ↑i :=
  rfl
#align topological_space.opens.coe_Sup TopologicalSpace.Opens.coe_supₛ

@[simp, norm_cast]
theorem coe_finset_sup (f : ι → Opens α) (s : Finset ι) : (↑(s.sup f) : Set α) = s.sup ((↑) ∘ f) :=
  map_finset_sup (⟨⟨(↑), coe_sup⟩, coe_bot⟩ : SupBotHom (Opens α) (Set α)) _ _
#align topological_space.opens.coe_finset_sup TopologicalSpace.Opens.coe_finset_sup

@[simp, norm_cast]
theorem coe_finset_inf (f : ι → Opens α) (s : Finset ι) : (↑(s.inf f) : Set α) = s.inf ((↑) ∘ f) :=
  map_finset_inf (⟨⟨(↑), coe_inf⟩, coe_top⟩ : InfTopHom (Opens α) (Set α)) _ _
#align topological_space.opens.coe_finset_inf TopologicalSpace.Opens.coe_finset_inf

instance : Inhabited (Opens α) := ⟨⊥⟩

-- porting note: new instance
instance [IsEmpty α] : Unique (Opens α) where
  uniq _ := ext <| Subsingleton.elim _ _

-- porting note: new instance
instance [Nonempty α] : Nontrivial (Opens α) where
  exists_pair_ne := ⟨⊥, ⊤, mt coe_inj.2 empty_ne_univ⟩

@[simp, norm_cast]
theorem coe_supᵢ {ι} (s : ι → Opens α) : ((⨆ i, s i : Opens α) : Set α) = ⋃ i, s i := by
  simp [supᵢ]
#align topological_space.opens.coe_supr TopologicalSpace.Opens.coe_supᵢ

theorem supᵢ_def {ι} (s : ι → Opens α) : (⨆ i, s i) = ⟨⋃ i, s i, isOpen_unionᵢ fun i => (s i).2⟩ :=
  ext <| coe_supᵢ s
#align topological_space.opens.supr_def TopologicalSpace.Opens.supᵢ_def

@[simp]
theorem supᵢ_mk {ι} (s : ι → Set α) (h : ∀ i, IsOpen (s i)) :
    (⨆ i, ⟨s i, h i⟩ : Opens α) = ⟨⋃ i, s i, isOpen_unionᵢ h⟩ :=
  supᵢ_def _
#align topological_space.opens.supr_mk TopologicalSpace.Opens.supᵢ_mk

@[simp]
theorem mem_supᵢ {ι} {x : α} {s : ι → Opens α} : x ∈ supᵢ s ↔ ∃ i, x ∈ s i := by
  rw [← SetLike.mem_coe]
  simp
#align topological_space.opens.mem_supr TopologicalSpace.Opens.mem_supᵢ

@[simp]
theorem mem_supₛ {Us : Set (Opens α)} {x : α} : x ∈ supₛ Us ↔ ∃ u ∈ Us, x ∈ u := by
  simp_rw [supₛ_eq_supᵢ, mem_supᵢ, exists_prop]
#align topological_space.opens.mem_Sup TopologicalSpace.Opens.mem_supₛ

instance : Frame (Opens α) :=
  { inferInstanceAs (CompleteLattice (Opens α)) with
    supₛ := supₛ
    inf_supₛ_le_supᵢ_inf := fun a s =>
      (ext <| by simp only [coe_inf, coe_supᵢ, coe_supₛ, Set.inter_unionᵢ₂]).le }

theorem openEmbedding_of_le {U V : Opens α} (i : U ≤ V) :
    OpenEmbedding (Set.inclusion $ SetLike.coe_subset_coe.2 i) :=
  { toEmbedding := embedding_inclusion i
    open_range := by
      rw [Set.range_inclusion i]
      exact U.isOpen.preimage continuous_subtype_val }
#align topological_space.opens.open_embedding_of_le TopologicalSpace.Opens.openEmbedding_of_le

theorem not_nonempty_iff_eq_bot (U : Opens α) : ¬Set.Nonempty (U : Set α) ↔ U = ⊥ := by
  rw [← coe_inj, coe_bot, ← Set.not_nonempty_iff_eq_empty]
#align topological_space.opens.not_nonempty_iff_eq_bot TopologicalSpace.Opens.not_nonempty_iff_eq_bot

theorem ne_bot_iff_nonempty (U : Opens α) : U ≠ ⊥ ↔ Set.Nonempty (U : Set α) := by
  rw [Ne.def, ← not_nonempty_iff_eq_bot, not_not]
#align topological_space.opens.ne_bot_iff_nonempty TopologicalSpace.Opens.ne_bot_iff_nonempty

/-- An open set in the indiscrete topology is either empty or the whole space. -/
theorem eq_bot_or_top {α} [t : TopologicalSpace α] (h : t = ⊤) (U : Opens α) : U = ⊥ ∨ U = ⊤ := by
  subst h; letI : TopologicalSpace α := ⊤
  rw [← coe_eq_empty, ← coe_eq_univ, ← isOpen_top_iff]
  exact U.2
#align topological_space.opens.eq_bot_or_top TopologicalSpace.Opens.eq_bot_or_top

-- porting note: new instance
instance [Nonempty α] [Subsingleton α] : IsSimpleOrder (Opens α) where
  eq_bot_or_eq_top := eq_bot_or_top <| Subsingleton.elim _ _

/-- A set of `opens α` is a basis if the set of corresponding sets is a topological basis. -/
def IsBasis (B : Set (Opens α)) : Prop :=
  IsTopologicalBasis (((↑) : _ → Set α) '' B)
#align topological_space.opens.is_basis TopologicalSpace.Opens.IsBasis

theorem isBasis_iff_nbhd {B : Set (Opens α)} :
    IsBasis B ↔ ∀ {U : Opens α} {x}, x ∈ U → ∃ U' ∈ B, x ∈ U' ∧ U' ≤ U := by
  constructor <;> intro h
  · rintro ⟨sU, hU⟩ x hx
    rcases h.mem_nhds_iff.mp (IsOpen.mem_nhds hU hx) with ⟨sV, ⟨⟨V, H₁, H₂⟩, hsV⟩⟩
    refine' ⟨V, H₁, _⟩
    cases V
    dsimp at H₂
    subst H₂
    exact hsV
  · refine' isTopologicalBasis_of_open_of_nhds _ _
    · rintro sU ⟨U, -, rfl⟩
      exact U.2
    · intro x sU hx hsU
      rcases @h ⟨sU, hsU⟩ x hx with ⟨V, hV, H⟩
      exact ⟨V, ⟨V, hV, rfl⟩, H⟩
#align topological_space.opens.is_basis_iff_nbhd TopologicalSpace.Opens.isBasis_iff_nbhd

theorem isBasis_iff_cover {B : Set (Opens α)} :
    IsBasis B ↔ ∀ U : Opens α, ∃ Us, Us ⊆ B ∧ U = supₛ Us := by
  constructor
  · intro hB U
    refine ⟨{ V : Opens α | V ∈ B ∧ V ≤ U }, fun U hU => hU.left, ext ?_⟩
    rw [coe_supₛ, hB.open_eq_unionₛ' U.isOpen]
    simp_rw [unionₛ_eq_bunionᵢ, unionᵢ, mem_setOf_eq, supᵢ_and, supᵢ_image]
    rfl
  · intro h
    rw [isBasis_iff_nbhd]
    intro U x hx
    rcases h U with ⟨Us, hUs, rfl⟩
    rcases mem_supₛ.1 hx with ⟨U, Us, xU⟩
    exact ⟨U, hUs Us, xU, le_supₛ Us⟩
#align topological_space.opens.is_basis_iff_cover TopologicalSpace.Opens.isBasis_iff_cover

/-- If `α` has a basis consisting of compact opens, then an open set in `α` is compact open iff
  it is a finite union of some elements in the basis -/
theorem IsBasis.isCompact_open_iff_eq_finite_unionᵢ {ι : Type _} (b : ι → Opens α)
    (hb : IsBasis (Set.range b)) (hb' : ∀ i, IsCompact (b i : Set α)) (U : Set α) :
    IsCompact U ∧ IsOpen U ↔ ∃ s : Set ι, s.Finite ∧ U = ⋃ i ∈ s, b i := by
  apply isCompact_open_iff_eq_finite_unionᵢ_of_isTopologicalBasis fun i : ι => (b i).1
  · convert (config := {transparency := .default}) hb
    ext
    simp
  · exact hb'
#align topological_space.opens.is_basis.is_compact_open_iff_eq_finite_Union TopologicalSpace.Opens.IsBasis.isCompact_open_iff_eq_finite_unionᵢ

@[simp]
theorem isCompactElement_iff (s : Opens α) :
    CompleteLattice.IsCompactElement s ↔ IsCompact (s : Set α) := by
  rw [isCompact_iff_finite_subcover, CompleteLattice.isCompactElement_iff]
  refine' ⟨_, fun H ι U hU => _⟩
  · introv H hU hU'
    obtain ⟨t, ht⟩ := H ι (fun i => ⟨U i, hU i⟩) (by simpa)
    refine' ⟨t, Set.Subset.trans ht _⟩
    rw [coe_finset_sup, Finset.sup_eq_supᵢ]
    rfl
  · obtain ⟨t, ht⟩ :=
      H (fun i => U i) (fun i => (U i).isOpen) (by simpa using show (s : Set α) ⊆ ↑(supᵢ U) from hU)
    refine' ⟨t, Set.Subset.trans ht _⟩
    simp only [Set.unionᵢ_subset_iff]
    show ∀ i ∈ t, U i ≤ t.sup U
    exact fun i => Finset.le_sup
#align topological_space.opens.is_compact_element_iff TopologicalSpace.Opens.isCompactElement_iff

/-- The preimage of an open set, as an open set. -/
def comap (f : C(α, β)) : FrameHom (Opens β) (Opens α) where
  toFun s := ⟨f ⁻¹' s, s.2.preimage f.continuous⟩
  map_supₛ' s := ext <| by simp only [coe_supₛ, preimage_unionᵢ, bunionᵢ_image, coe_mk]
  map_inf' a b := rfl
  map_top' := rfl
#align topological_space.opens.comap TopologicalSpace.Opens.comap

@[simp]
theorem comap_id : comap (ContinuousMap.id α) = FrameHom.id _ :=
  FrameHom.ext fun _ => ext rfl
#align topological_space.opens.comap_id TopologicalSpace.Opens.comap_id

theorem comap_mono (f : C(α, β)) {s t : Opens β} (h : s ≤ t) : comap f s ≤ comap f t :=
  OrderHomClass.mono (comap f) h
#align topological_space.opens.comap_mono TopologicalSpace.Opens.comap_mono

@[simp]
theorem coe_comap (f : C(α, β)) (U : Opens β) : ↑(comap f U) = f ⁻¹' U :=
  rfl
#align topological_space.opens.coe_comap TopologicalSpace.Opens.coe_comap

protected theorem comap_comp (g : C(β, γ)) (f : C(α, β)) :
    comap (g.comp f) = (comap f).comp (comap g) :=
  rfl
#align topological_space.opens.comap_comp TopologicalSpace.Opens.comap_comp

protected theorem comap_comap (g : C(β, γ)) (f : C(α, β)) (U : Opens γ) :
    comap f (comap g U) = comap (g.comp f) U :=
  rfl
#align topological_space.opens.comap_comap TopologicalSpace.Opens.comap_comap

theorem comap_injective [T0Space β] : Injective (comap : C(α, β) → FrameHom (Opens β) (Opens α)) :=
  fun f g h =>
  ContinuousMap.ext fun a =>
    Inseparable.eq <|
      inseparable_iff_forall_open.2 fun s hs =>
        have : comap f ⟨s, hs⟩ = comap g ⟨s, hs⟩ := FunLike.congr_fun h ⟨_, hs⟩
        show a ∈ f ⁻¹' s ↔ a ∈ g ⁻¹' s from Set.ext_iff.1 (coe_inj.2 this) a
#align topological_space.opens.comap_injective TopologicalSpace.Opens.comap_injective

/-- A homeomorphism induces an order-preserving equivalence on open sets, by taking comaps. -/
@[simps (config := { fullyApplied := false }) apply]
def _root_.Homeomorph.opensCongr (f : α ≃ₜ β) : Opens α ≃o Opens β where
  toFun := Opens.comap f.symm.toContinuousMap
  invFun := Opens.comap f.toContinuousMap
  left_inv := fun U => ext <| f.toEquiv.preimage_symm_preimage _
  right_inv := fun U => ext <| f.toEquiv.symm_preimage_preimage _
  map_rel_iff' := by
    simp only [← SetLike.coe_subset_coe]; exact f.symm.surjective.preimage_subset_preimage_iff
#align homeomorph.opens_congr Homeomorph.opensCongr

@[simp]
theorem _root_.Homeomorph.opensCongr_symm (f : α ≃ₜ β) : f.opensCongr.symm = f.symm.opensCongr :=
  rfl
#align homeomorph.opens_congr_symm Homeomorph.opensCongr_symm

instance [Finite α] : Finite (Opens α) :=
  Finite.of_injective _ SetLike.coe_injective

end Opens

/-- The open neighborhoods of a point. See also `Opens` or `nhds`. -/
structure OpenNhdsOf (x : α) extends Opens α where
  /-- The point `x` belongs to every `U : TopologicalSpace.OpenNhdsOf x`. -/
  mem' : x ∈ carrier
#align topological_space.open_nhds_of TopologicalSpace.OpenNhdsOf

namespace OpenNhdsOf

variable {x : α}

theorem toOpens_injective : Injective (toOpens : OpenNhdsOf x → Opens α)
  | ⟨_, _⟩, ⟨_, _⟩, rfl => rfl
#align topological_space.open_nhds_of.to_opens_injective TopologicalSpace.OpenNhdsOf.toOpens_injective

instance : SetLike (OpenNhdsOf x) α where
  coe U := U.1
  coe_injective' := SetLike.coe_injective.comp toOpens_injective

instance canLiftSet : CanLift (Set α) (OpenNhdsOf x) (↑) fun s => IsOpen s ∧ x ∈ s :=
  ⟨fun s hs => ⟨⟨⟨s, hs.1⟩, hs.2⟩, rfl⟩⟩
#align topological_space.open_nhds_of.can_lift_set TopologicalSpace.OpenNhdsOf.canLiftSet

protected theorem mem (U : OpenNhdsOf x) : x ∈ U :=
  U.mem'
#align topological_space.open_nhds_of.mem TopologicalSpace.OpenNhdsOf.mem

protected theorem isOpen (U : OpenNhdsOf x) : IsOpen (U : Set α) :=
  U.is_open'
#align topological_space.open_nhds_of.is_open TopologicalSpace.OpenNhdsOf.isOpen

instance : OrderTop (OpenNhdsOf x) where
  top := ⟨⊤, Set.mem_univ _⟩
  le_top _ := subset_univ _

instance : Inhabited (OpenNhdsOf x) := ⟨⊤⟩
instance : Inf (OpenNhdsOf x) := ⟨fun U V => ⟨U.1 ⊓ V.1, U.2, V.2⟩⟩
instance : Sup (OpenNhdsOf x) := ⟨fun U V => ⟨U.1 ⊔ V.1, Or.inl U.2⟩⟩

-- porting note: new instance
instance [Subsingleton α] : Unique (OpenNhdsOf x) where
  uniq U := SetLike.ext' <| Subsingleton.eq_univ_of_nonempty ⟨x, U.mem⟩

instance : DistribLattice (OpenNhdsOf x) :=
  toOpens_injective.distribLattice _ (fun _ _ => rfl) fun _ _ => rfl

theorem basis_nhds : (𝓝 x).HasBasis (fun _ : OpenNhdsOf x => True) (↑) :=
  (nhds_basis_opens x).to_hasBasis (fun U hU => ⟨⟨⟨U, hU.2⟩, hU.1⟩, trivial, Subset.rfl⟩) fun U _ =>
    ⟨U, ⟨⟨U.mem, U.isOpen⟩, Subset.rfl⟩⟩
#align topological_space.open_nhds_of.basis_nhds TopologicalSpace.OpenNhdsOf.basis_nhds

/-- Preimage of an open neighborhood of `f x` under a continuous map `f` as a `LatticeHom`. -/
def comap (f : C(α, β)) (x : α) : LatticeHom (OpenNhdsOf (f x)) (OpenNhdsOf x) where
  toFun U := ⟨Opens.comap f U.1, U.mem⟩
  map_sup' _ _ := rfl
  map_inf' _ _ := rfl
#align topological_space.open_nhds_of.comap TopologicalSpace.OpenNhdsOf.comap

end OpenNhdsOf

end TopologicalSpace

-- porting note: TODO: once we port `auto_cases`, port this
-- namespace Tactic

-- namespace AutoCases

-- /-- Find an `auto_cases_tac` which matches `TopologicalSpace.Opens`. -/
-- unsafe def opens_find_tac : expr → Option auto_cases_tac
--   | q(TopologicalSpace.Opens _) => tac_cases
--   | _ => none
-- #align tactic.auto_cases.opens_find_tac tactic.auto_cases.opens_find_tac

-- end AutoCases

-- /-- A version of `tactic.auto_cases` that works for `TopologicalSpace.Opens`. -/
-- @[hint_tactic]
-- unsafe def auto_cases_opens : tactic String :=
--   auto_cases tactic.auto_cases.opens_find_tac
-- #align tactic.auto_cases_opens tactic.auto_cases_opens

-- end Tactic


/- Fake real numbers.
There are technical difficulties in accessing real numbers
in the online version of Lean. Anyone who is using Lean online but
wants real numbers can just cut and paste the below code.
This gives us a class "real", which is a fake version of the
real numbers. See if you can spot any differences!
-/

constant real : Type
-- note to self -- so I now have a new constant, which
-- is like a new axiom saying "there exists a type in our
-- system called `real' ". Currently this type has nothing to do
-- with the real numbers, other than the name.

@[instance] constant real_field : linear_ordered_field real
-- Informally, real_field is the assertion that our
-- new real type is actually a linearly ordered field.
-- This means, amongst other things, that now, given
-- two real numbers a and b (i.e. two things of type real)
-- we should be able to add, subtract and multiply them,
-- and also see if a is less than b.
-- We might have to mention real_field, which is somehow
-- the dictionary of all these facts.

 -- note to self -- how to make this a Q-algebra?
 -- Oh! Can't do this because no Q or R!

-- #check ((↑(2:nat)):real)

example : ∀ a b : real, a * b = b * a :=
begin
exact mul_comm
end

example (a b : real) : a * b = b * a :=
begin
simp [mul_comm]
end

#check mul_comm

variables a b : real

#check a*b

#check linear_ordered_field real

attribute [instance] real_field

#check (45 : real)

example (a b c : real) : a * (b + c) = a * c + a * b :=
by simp [mul_add]

#check @mul_add
variable x : real

#eval (nat.add  3 4)

#check real_field.add

-- #check (x^2) -- need to make this work


import tactic
import tactic.induction

import .defs .lemmas

noncomputable theory
open_locale classical

theorem A_hws_iff_pw_ge_2 {pw : ℕ} :
  A_hws pw ↔ 2 ≤ pw :=
begin
  cases pw, simp [A_pw_0_not_hws],
  cases pw, simp [A_pw_1_not_hws], simp [nat.succ_le_succ],
  refine A_pw_ge_hws _ A_pw_2_hws, simp [nat.succ_le_succ],
end

theorem exi_pw_A_hws : ∃ (pw : ℕ), A_hws pw :=
⟨2, A_pw_2_hws⟩


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang, Eric Wieser

From: https://github.com/leanprover-community/mathlib/blob/6b93ea7e4bbe7822960e821141e5a931537cd755/src/ring_theory/graded_algebra/homogeneous_localization.lean
-/
import ring_theory.localization.at_prime

import cicm2022.internal.graded_ring

/-!
# Homogeneous Localization

## Notation
- `ι` is a commutative monoid;
- `R` is a commutative semiring;
- `A` is a commutative ring and an `R`-algebra;
- `𝒜 : ι → submodule R A` is the grading of `A`;
- `x : ideal A` is a prime ideal.

## Main definitions and results

This file constructs the subring of `Aₓ` where the numerator and denominator have the same grading,
i.e. `{a/b ∈ Aₓ | ∃ (i : ι), a ∈ 𝒜ᵢ ∧ b ∈ 𝒜ᵢ}`.

* `homogeneous_localization.num_denom_same_deg`: a structure with a numerator and denominator field
  where they are required to have the same grading.

However `num_denom_same_deg 𝒜 x` cannot have a ring structure for many reasons, for example if `c`
is a `num_denom_same_deg`, then generally, `c + (-c)` is not necessarily `0` for degree reasons ---
`0` is considered to have grade zero (see `deg_zero`) but `c + (-c)` has the same degree as `c`. To
circumvent this, we quotient `num_denom_same_deg 𝒜 x` by the kernel of `c ↦ c.num / c.denom`.

* `homogeneous_localization.num_denom_same_deg.embedding` : for `x : prime ideal of A` and any
  `c : num_denom_same_deg 𝒜 x`, or equivalent a numerator and a denominator of the same degree,
  we get an element `c.num / c.denom` of `Aₓ`.
* `homogeneous_localization`: `num_denom_same_deg 𝒜 x` quotiented by kernel of `embedding 𝒜 x`.
* `homogeneous_localization.val`: if `f : homogeneous_localization 𝒜 x`, then `f.val` is an element
  of `Aₓ`. In another word, one can view `homogeneous_localization 𝒜 x` as a subring of `Aₓ`
  through `homogeneous_localization.val`.
* `homogeneous_localization.num`: if `f : homogeneous_localization 𝒜 x`, then `f.num : A` is the
  numerator of `f`.
* `homogeneous_localization.num`: if `f : homogeneous_localization 𝒜 x`, then `f.denom : A` is the
  denominator of `f`.
* `homogeneous_localization.deg`: if `f : homogeneous_localization 𝒜 x`, then `f.deg : ι` is the
  degree of `f` such that `f.num ∈ 𝒜 f.deg` and `f.denom ∈ 𝒜 f.deg`
  (see `homogeneous_localization.num_mem` and `homogeneous_localization.denom_mem`).
* `homogeneous_localization.num_mem`: if `f : homogeneous_localization 𝒜 x`, then `f.num_mem` is a
  proof that `f.num ∈ f.deg`.
* `homogeneous_localization.denom_mem`: if `f : homogeneous_localization 𝒜 x`, then `f.denom_mem`
  is a proof that `f.denom ∈ f.deg`.
* `homogeneous_localization.eq_num_div_denom`: if `f : homogeneous_localization 𝒜 x`, then
  `f.val : Aₓ` is equal to `f.num / f.denom`.

* `homogeneous_localization.local_ring`: `homogeneous_localization 𝒜 x` is a local ring.

## References

* [Robin Hartshorne, *Algebraic Geometry*][Har77]

-/

noncomputable theory

open_locale direct_sum big_operators pointwise
open direct_sum set_like

variables {ι R A: Type*}
variables [add_comm_monoid ι] [decidable_eq ι]
variables [comm_ring R] [comm_ring A] [algebra R A]
variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
variables (x : ideal A) [ideal.is_prime x]

local notation `at ` x := localization.at_prime x

namespace homogeneous_localization

section
/--
Let `x` be a prime ideal, then `num_denom_same_deg 𝒜 x` is a structure with a numerator and a
denominator with same grading such that the denominator is not contained in `x`.
-/
@[nolint has_inhabited_instance]
structure num_denom_same_deg :=
(deg : ι)
(num denom : 𝒜 deg)
(denom_not_mem : (denom : A) ∉ x)

end

namespace num_denom_same_deg

open set_like.graded_monoid submodule

variable {𝒜}
@[ext] lemma ext {c1 c2 : num_denom_same_deg 𝒜 x} (hdeg : c1.deg = c2.deg)
  (hnum : (c1.num : A) = c2.num) (hdenom : (c1.denom : A) = c2.denom) :
  c1 = c2 :=
begin
  rcases c1 with ⟨i1, ⟨n1, hn1⟩, ⟨d1, hd1⟩, h1⟩,
  rcases c2 with ⟨i2, ⟨n2, hn2⟩, ⟨d2, hd2⟩, h2⟩,
  dsimp only [subtype.coe_mk] at *,
  simp only,
  exact ⟨hdeg, by subst hdeg; subst hnum, by subst hdeg; subst hdenom⟩,
end

instance : has_one (num_denom_same_deg 𝒜 x) :=
{ one :=
  { deg := 0,
    num := ⟨1, one_mem⟩,
    denom := ⟨1, one_mem⟩,
    denom_not_mem := λ r, (infer_instance : x.is_prime).ne_top $ x.eq_top_iff_one.mpr r } }

@[simp] lemma deg_one : (1 : num_denom_same_deg 𝒜 x).deg = 0 := rfl
@[simp] lemma num_one : ((1 : num_denom_same_deg 𝒜 x).num : A) = 1 := rfl
@[simp] lemma denom_one : ((1 : num_denom_same_deg 𝒜 x).denom : A) = 1 := rfl

instance : has_zero (num_denom_same_deg 𝒜 x) :=
{ zero := ⟨0, 0, ⟨1, one_mem⟩, λ r, (infer_instance : x.is_prime).ne_top $ x.eq_top_iff_one.mpr r⟩ }

@[simp] lemma deg_zero : (0 : num_denom_same_deg 𝒜 x).deg = 0 := rfl
@[simp] lemma num_zero : (0 : num_denom_same_deg 𝒜 x).num = 0 := rfl
@[simp] lemma denom_zero : ((0 : num_denom_same_deg 𝒜 x).denom : A) = 1 := rfl

instance : has_mul (num_denom_same_deg 𝒜 x) :=
{ mul := λ p q,
  { deg := p.deg + q.deg,
    num := ⟨p.num * q.num, mul_mem p.num.prop q.num.prop⟩,
    denom := ⟨p.denom * q.denom, mul_mem p.denom.prop q.denom.prop⟩,
    denom_not_mem := λ r, or.elim
      ((infer_instance : x.is_prime).mem_or_mem r) p.denom_not_mem q.denom_not_mem } }

@[simp] lemma deg_mul (c1 c2 : num_denom_same_deg 𝒜 x) : (c1 * c2).deg = c1.deg + c2.deg := rfl
@[simp] lemma num_mul (c1 c2 : num_denom_same_deg 𝒜 x) :
  ((c1 * c2).num : A) = c1.num * c2.num := rfl
@[simp] lemma denom_mul (c1 c2 : num_denom_same_deg 𝒜 x) :
  ((c1 * c2).denom : A) = c1.denom * c2.denom := rfl

instance : has_add (num_denom_same_deg 𝒜 x) :=
{ add := λ c1 c2,
  { deg := c1.deg + c2.deg,
    num := ⟨c1.denom * c2.num + c2.denom * c1.num,
      add_mem (mul_mem c1.denom.2 c2.num.2)
        (add_comm c2.deg c1.deg ▸ mul_mem c2.denom.2 c1.num.2)⟩,
    denom := ⟨c1.denom * c2.denom, mul_mem c1.denom.2 c2.denom.2⟩,
    denom_not_mem := λ r, or.elim
      ((infer_instance : x.is_prime).mem_or_mem r) c1.denom_not_mem c2.denom_not_mem } }

@[simp] lemma deg_add (c1 c2 : num_denom_same_deg 𝒜 x) : (c1 + c2).deg = c1.deg + c2.deg := rfl
@[simp] lemma num_add (c1 c2 : num_denom_same_deg 𝒜 x) :
  ((c1 + c2).num : A) = c1.denom * c2.num + c2.denom * c1.num := rfl
@[simp] lemma denom_add (c1 c2 : num_denom_same_deg 𝒜 x) :
  ((c1 + c2).denom : A) = c1.denom * c2.denom := rfl

instance : has_neg (num_denom_same_deg 𝒜 x) :=
{ neg := λ c, ⟨c.deg, ⟨-c.num, neg_mem c.num.2⟩, c.denom, c.denom_not_mem⟩ }

@[simp] lemma deg_neg (c : num_denom_same_deg 𝒜 x) : (-c).deg = c.deg := rfl
@[simp] lemma num_neg (c : num_denom_same_deg 𝒜 x) : ((-c).num : A) = -c.num := rfl
@[simp] lemma denom_neg (c : num_denom_same_deg 𝒜 x) : ((-c).denom : A) = c.denom := rfl

instance : comm_monoid (num_denom_same_deg 𝒜 x) :=
{ one := 1,
  mul := (*),
  mul_assoc := λ c1 c2 c3, ext _ (add_assoc _ _ _) (mul_assoc _ _ _) (mul_assoc _ _ _),
  one_mul := λ c, ext _ (zero_add _) (one_mul _) (one_mul _),
  mul_one := λ c, ext _ (add_zero _) (mul_one _) (mul_one _),
  mul_comm := λ c1 c2, ext _ (add_comm _ _) (mul_comm _ _) (mul_comm _ _) }

instance : has_pow (num_denom_same_deg 𝒜 x) ℕ :=
{ pow := λ c n, ⟨n • c.deg, ⟨c.num ^ n, pow_mem n c.num.2⟩, ⟨c.denom ^ n, pow_mem n c.denom.2⟩,
    begin
      cases n,
      { simp only [pow_zero],
        exact λ r, (infer_instance : x.is_prime).ne_top $ (ideal.eq_top_iff_one _).mpr r, },
      { exact λ r, c.denom_not_mem $
          ((infer_instance : x.is_prime).pow_mem_iff_mem n.succ (nat.zero_lt_succ _)).mp r }
    end⟩ }

@[simp] lemma deg_pow (c : num_denom_same_deg 𝒜 x) (n : ℕ) : (c ^ n).deg = n • c.deg := rfl
@[simp] lemma num_pow (c : num_denom_same_deg 𝒜 x) (n : ℕ) : ((c ^ n).num : A) = c.num ^ n := rfl
@[simp] lemma denom_pow (c : num_denom_same_deg 𝒜 x) (n : ℕ) :
  ((c ^ n).denom : A) = c.denom ^ n := rfl

section has_smul
variables {α : Type*} [has_smul α R] [has_smul α A] [is_scalar_tower α R A]

instance : has_smul α (num_denom_same_deg 𝒜 x) :=
{ smul := λ m c, ⟨c.deg, m • c.num, c.denom, c.denom_not_mem⟩ }

@[simp] lemma deg_smul (c : num_denom_same_deg 𝒜 x) (m : α) : (m • c).deg = c.deg := rfl
@[simp] lemma num_smul (c : num_denom_same_deg 𝒜 x) (m : α) : ((m • c).num : A) = m • c.num := rfl
@[simp] lemma denom_smul (c : num_denom_same_deg 𝒜 x) (m : α) :
  ((m • c).denom : A) = c.denom := rfl

end has_smul

variable (𝒜)

/--
For `x : prime ideal of A` and any `p : num_denom_same_deg 𝒜 x`, or equivalent a numerator and a
denominator of the same degree, we get an element `p.num / p.denom` of `Aₓ`.
-/
def embedding (p : num_denom_same_deg 𝒜 x) : at x :=
localization.mk p.num ⟨p.denom, p.denom_not_mem⟩

end num_denom_same_deg

end homogeneous_localization

/--
For `x : prime ideal of A`, `homogeneous_localization 𝒜 x` is `num_denom_same_deg 𝒜 x` modulo the
kernel of `embedding 𝒜 x`. This is essentially the subring of `Aₓ` where the numerator and
denominator share the same grading.
-/
@[nolint has_inhabited_instance]
def homogeneous_localization : Type* :=
quotient (setoid.ker $ homogeneous_localization.num_denom_same_deg.embedding 𝒜 x)

namespace homogeneous_localization

open homogeneous_localization homogeneous_localization.num_denom_same_deg

variables {𝒜} {x}
/--
View an element of `homogeneous_localization 𝒜 x` as an element of `Aₓ` by forgetting that the
numerator and denominator are of the same grading.
-/
def val (y : homogeneous_localization 𝒜 x) : at x :=
quotient.lift_on' y (num_denom_same_deg.embedding 𝒜 x) $ λ _ _, id

@[simp] lemma val_mk' (i : num_denom_same_deg 𝒜 x) :
  val (quotient.mk' i) = localization.mk i.num ⟨i.denom, i.denom_not_mem⟩ :=
rfl

variable (x)
lemma val_injective :
  function.injective (@homogeneous_localization.val _ _ _ _ _ _ _ _ 𝒜 _ x _) :=
λ a b, quotient.rec_on_subsingleton₂' a b $ λ a b h, quotient.sound' h

instance has_pow : has_pow (homogeneous_localization 𝒜 x) ℕ :=
{ pow := λ z n, (quotient.map' (^ n)
    (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _), begin
      change localization.mk _ _ = localization.mk _ _,
      simp only [num_pow, denom_pow],
      convert congr_arg (λ z, z ^ n) h;
      erw localization.mk_pow;
      refl,
    end) : homogeneous_localization 𝒜 x → homogeneous_localization 𝒜 x) z }

section has_smul
variables {α : Type*} [has_smul α R] [has_smul α A] [is_scalar_tower α R A]
variables [is_scalar_tower α A A]

instance : has_smul α (homogeneous_localization 𝒜 x) :=
{ smul := λ m, quotient.map' ((•) m)
    (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _), begin
      change localization.mk _ _ = localization.mk _ _,
      simp only [num_smul, denom_smul],
      convert congr_arg (λ z : at x, m • z) h;
      rw localization.smul_mk;
      refl,
    end) }

@[simp] lemma smul_val (y : homogeneous_localization 𝒜 x) (n : α) :
  (n • y).val = n • y.val :=
begin
  induction y using quotient.induction_on,
  unfold homogeneous_localization.val has_smul.smul,
  simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
  change localization.mk _ _ = n • localization.mk _ _,
  dsimp only,
  rw localization.smul_mk,
  congr' 1,
end

end has_smul

instance : has_neg (homogeneous_localization 𝒜 x) :=
{ neg := quotient.map' has_neg.neg
    (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _), begin
      change localization.mk _ _ = localization.mk _ _,
      simp only [num_neg, denom_neg, ←localization.neg_mk],
      exact congr_arg (λ c, -c) h
    end) }

instance : has_add (homogeneous_localization 𝒜 x) :=
{ add := quotient.map₂' (+) (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _)
    c3 c4 (h' : localization.mk _ _ = localization.mk _ _), begin
    change localization.mk _ _ = localization.mk _ _,
    simp only [num_add, denom_add, ←localization.add_mk],
    convert congr_arg2 (+) h h';
    erw [localization.add_mk];
    refl
  end) }

instance : has_sub (homogeneous_localization 𝒜 x) :=
{ sub := λ z1 z2, z1 + (-z2) }

instance : has_mul (homogeneous_localization 𝒜 x) :=
{ mul := quotient.map₂' (*) (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _)
    c3 c4 (h' : localization.mk _ _ = localization.mk _ _), begin
    change localization.mk _ _ = localization.mk _ _,
    simp only [num_mul, denom_mul],
    convert congr_arg2 (*) h h';
    erw [localization.mk_mul];
    refl,
  end) }

instance : has_one (homogeneous_localization 𝒜 x) :=
{ one := quotient.mk' 1 }

instance : has_zero (homogeneous_localization 𝒜 x) :=
{ zero := quotient.mk' 0 }

lemma zero_eq :
  (0 : homogeneous_localization 𝒜 x) = quotient.mk' 0 := rfl

lemma one_eq :
  (1 : homogeneous_localization 𝒜 x) = quotient.mk' 1 := rfl

variable {x}
lemma zero_val : (0 : homogeneous_localization 𝒜 x).val = 0 :=
localization.mk_zero _

lemma one_val : (1 : homogeneous_localization 𝒜 x).val = 1 :=
localization.mk_one

@[simp] lemma add_val (y1 y2 : homogeneous_localization 𝒜 x) :
  (y1 + y2).val = y1.val + y2.val :=
begin
  induction y1 using quotient.induction_on,
  induction y2 using quotient.induction_on,
  unfold homogeneous_localization.val has_add.add,
  simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
  change localization.mk _ _ = localization.mk _ _ + localization.mk _ _,
  dsimp only,
  rw [localization.add_mk],
  refl
end

@[simp] lemma mul_val (y1 y2 : homogeneous_localization 𝒜 x) :
  (y1 * y2).val = y1.val * y2.val :=
begin
  induction y1 using quotient.induction_on,
  induction y2 using quotient.induction_on,
  unfold homogeneous_localization.val has_mul.mul,
  simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
  change localization.mk _ _ = localization.mk _ _ * localization.mk _ _,
  dsimp only,
  rw [localization.mk_mul],
  refl,
end

@[simp] lemma neg_val (y : homogeneous_localization 𝒜 x) :
  (-y).val = -y.val :=
begin
  induction y using quotient.induction_on,
  unfold homogeneous_localization.val has_neg.neg,
  simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
  change localization.mk _ _ = - localization.mk _ _,
  dsimp only,
  rw [localization.neg_mk],
  refl,
end

@[simp] lemma sub_val (y1 y2 : homogeneous_localization 𝒜 x) :
  (y1 - y2).val = y1.val - y2.val :=
by rw [show y1 - y2 = y1 + (-y2), from rfl, add_val, neg_val]; refl

@[simp] lemma pow_val (y : homogeneous_localization 𝒜 x) (n : ℕ) :
  (y ^ n).val = y.val ^ n :=
begin
  induction y using quotient.induction_on,
  unfold homogeneous_localization.val has_pow.pow,
  simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
  change localization.mk _ _ = (localization.mk _ _) ^ n,
  rw localization.mk_pow,
  dsimp only,
  congr' 1,
end

instance : has_nat_cast (homogeneous_localization 𝒜 x) := ⟨nat.unary_cast⟩
instance : has_int_cast (homogeneous_localization 𝒜 x) := ⟨int.cast_def⟩

@[simp] lemma nat_cast_val (n : ℕ) : (n : homogeneous_localization 𝒜 x).val = n :=
show val (nat.unary_cast n) = _, by induction n; simp [nat.unary_cast, zero_val, one_val, *]

@[simp] lemma int_cast_val (n : ℤ) : (n : homogeneous_localization 𝒜 x).val = n :=
show val (int.cast_def n) = _, by cases n; simp [int.cast_def, zero_val, one_val, *]

instance : comm_ring (homogeneous_localization 𝒜 x) :=
(homogeneous_localization.val_injective x).comm_ring _ zero_val one_val add_val mul_val neg_val
  sub_val (λ z n, smul_val x z n) (λ z n, smul_val x z n) pow_val nat_cast_val int_cast_val

end homogeneous_localization

namespace homogeneous_localization

open homogeneous_localization homogeneous_localization.num_denom_same_deg

variables {𝒜} {x}

/-- numerator of an element in `homogeneous_localization x`-/
def num (f : homogeneous_localization 𝒜 x) : A :=
(quotient.out' f).num

/-- denominator of an element in `homogeneous_localization x`-/
def denom (f : homogeneous_localization 𝒜 x) : A :=
(quotient.out' f).denom

/-- For an element in `homogeneous_localization x`, degree is the natural number `i` such that
  `𝒜 i` contains both numerator and denominator. -/
def deg (f : homogeneous_localization 𝒜 x) : ι :=
(quotient.out' f).deg

lemma denom_not_mem (f : homogeneous_localization 𝒜 x) :
  f.denom ∉ x :=
(quotient.out' f).denom_not_mem

lemma num_mem (f : homogeneous_localization 𝒜 x) : f.num ∈ 𝒜 f.deg :=
(quotient.out' f).num.2

lemma denom_mem (f : homogeneous_localization 𝒜 x) : f.denom ∈ 𝒜 f.deg :=
(quotient.out' f).denom.2

lemma eq_num_div_denom (f : homogeneous_localization 𝒜 x) :
  f.val = localization.mk f.num ⟨f.denom, f.denom_not_mem⟩ :=
begin
  have := (quotient.out_eq' f),
  apply_fun homogeneous_localization.val at this,
  rw ← this,
  unfold homogeneous_localization.val,
  simp only [quotient.lift_on'_mk'],
  refl,
end

lemma ext_iff_val (f g : homogeneous_localization 𝒜 x) : f = g ↔ f.val = g.val :=
{ mp := λ h, h ▸ rfl,
  mpr := λ h, begin
    induction f using quotient.induction_on,
    induction g using quotient.induction_on,
    rw quotient.eq,
    unfold homogeneous_localization.val at h,
    simpa only [quotient.lift_on'_mk] using h,
  end }

lemma is_unit_iff_is_unit_val (f : homogeneous_localization 𝒜 x) :
  is_unit f.val ↔ is_unit f :=
⟨λ h1, begin
  rcases h1 with ⟨⟨a, b, eq0, eq1⟩, (eq2 : a = f.val)⟩,
  rw eq2 at eq0 eq1,
  clear' a eq2,
  induction b using localization.induction_on with data,
  rcases data with ⟨a, ⟨b, hb⟩⟩,
  dsimp only at eq0 eq1,
  have b_f_denom_not_mem : b * f.denom ∈ x.prime_compl := λ r, or.elim
    (ideal.is_prime.mem_or_mem infer_instance r) (λ r2, hb r2) (λ r2, f.denom_not_mem r2),
  rw [f.eq_num_div_denom, localization.mk_mul,
    show (⟨b, hb⟩ : x.prime_compl) * ⟨f.denom, _⟩ = ⟨b * f.denom, _⟩, from rfl,
    show (1 : at x) = localization.mk 1 1, by erw localization.mk_self 1,
    localization.mk_eq_mk', is_localization.eq] at eq1,
  rcases eq1 with ⟨⟨c, hc⟩, eq1⟩,
  simp only [← subtype.val_eq_coe] at eq1,
  change a * f.num * 1 * c = _ at eq1,
  simp only [one_mul, mul_one] at eq1,
  have mem1 : a * f.num * c ∈ x.prime_compl :=
    eq1.symm ▸ λ r, or.elim (ideal.is_prime.mem_or_mem infer_instance r) (by tauto)(by tauto),
  have mem2 : f.num ∉ x,
  { contrapose! mem1,
    erw [not_not],
    exact ideal.mul_mem_right _ _ (ideal.mul_mem_left _ _ mem1), },
  refine ⟨⟨f, quotient.mk' ⟨f.deg, ⟨f.denom, f.denom_mem⟩, ⟨f.num, f.num_mem⟩, mem2⟩, _, _⟩, rfl⟩;
  simp only [ext_iff_val, mul_val, val_mk', ← subtype.val_eq_coe, f.eq_num_div_denom,
    localization.mk_mul, one_val];
  convert localization.mk_self _;
  simpa only [mul_comm]
end, λ ⟨⟨_, b, eq1, eq2⟩, rfl⟩, begin
  simp only [ext_iff_val, mul_val, one_val] at eq1 eq2,
  exact ⟨⟨f.val, b.val, eq1, eq2⟩, rfl⟩
end⟩

instance : nontrivial (homogeneous_localization 𝒜 x) :=
⟨⟨0, 1, λ r, by simpa [ext_iff_val, zero_val, one_val, zero_ne_one] using r⟩⟩

instance : local_ring (homogeneous_localization 𝒜 x) :=
local_ring.of_is_unit_or_is_unit_one_sub_self $ λ a, begin
  simp only [← is_unit_iff_is_unit_val, sub_val, one_val],
  induction a using quotient.induction_on',
  simp only [homogeneous_localization.val_mk', ← subtype.val_eq_coe],
  by_cases mem1 : a.num.1 ∈ x,
  { right,
    have : a.denom.1 - a.num.1 ∈ x.prime_compl := λ h, a.denom_not_mem
      ((sub_add_cancel a.denom.val a.num.val) ▸ ideal.add_mem _ h mem1 : a.denom.1 ∈ x),
    apply is_unit_of_mul_eq_one _ (localization.mk a.denom.1 ⟨a.denom.1 - a.num.1, this⟩),
    simp only [sub_mul, localization.mk_mul, one_mul, localization.sub_mk, ← subtype.val_eq_coe,
      submonoid.coe_mul],
    convert localization.mk_self _,
    simp only [← subtype.val_eq_coe, submonoid.coe_mul],
    ring, },
  { left,
    change _ ∈ x.prime_compl at mem1,
    apply is_unit_of_mul_eq_one _ (localization.mk a.denom.1 ⟨a.num.1, mem1⟩),
    rw [localization.mk_mul],
    convert localization.mk_self _,
    simpa only [mul_comm], },
end

end homogeneous_localization