/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/

import geometry.manifold.algebra.structures

/-!
# Algebraic structures over smooth functions

In this file, we define instances of algebraic structures over smooth functions.
-/

noncomputable theory

open_locale manifold

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
{N : Type*} [topological_space N] [charted_space H N]
{E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
{H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
{N' : Type*} [topological_space N'] [charted_space H'' N']

namespace smooth_map

@[to_additive]
instance has_mul {G : Type*} [has_mul G] [topological_space G] [charted_space H' G]
  [has_smooth_mul I' G] :
  has_mul C^∞⟮I, N; I', G⟯ :=
⟨λ f g, ⟨f * g, f.smooth.mul g.smooth⟩⟩

@[simp, to_additive]
lemma coe_mul {G : Type*} [has_mul G] [topological_space G] [charted_space H' G]
  [has_smooth_mul I' G] (f g : C^∞⟮I, N; I', G⟯) :
  ⇑(f * g) = f * g := rfl

@[simp, to_additive] lemma mul_comp {G : Type*} [has_mul G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] (f g : C^∞⟮I'', N'; I', G⟯) (h : C^∞⟮I, N; I'', N'⟯) :
(f * g).comp h = (f.comp h) * (g.comp h) :=
by ext; simp only [cont_mdiff_map.comp_apply, coe_mul, pi.mul_apply]

@[to_additive]
instance has_one {G : Type*} [monoid G] [topological_space G] [charted_space H' G] :
  has_one C^∞⟮I, N; I', G⟯ :=
⟨cont_mdiff_map.const (1 : G)⟩

@[simp, to_additive]
lemma coe_one {G : Type*} [monoid G] [topological_space G] [charted_space H' G] :
  ⇑(1 : C^∞⟮I, N; I', G⟯) = 1 := rfl

section group_structure

/-!
### Group structure

In this section we show that smooth functions valued in a Lie group inherit a group structure
under pointwise multiplication.
-/

@[to_additive]
instance semigroup {G : Type*} [semigroup G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] :
  semigroup C^∞⟮I, N; I', G⟯ :=
{ mul_assoc := λ a b c, by ext; exact mul_assoc _ _ _,
  ..smooth_map.has_mul}

@[to_additive]
instance monoid {G : Type*} [monoid G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] :
  monoid C^∞⟮I, N; I', G⟯ :=
{ one_mul := λ a, by ext; exact one_mul _,
  mul_one := λ a, by ext; exact mul_one _,
  ..smooth_map.semigroup,
  ..smooth_map.has_one }

/-- Coercion to a function as an `monoid_hom`. Similar to `monoid_hom.coe_fn`. -/
@[to_additive "Coercion to a function as an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn`.",
  simps]
def coe_fn_monoid_hom {G : Type*} [monoid G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] : C^∞⟮I, N; I', G⟯ →* (N → G) :=
{ to_fun := coe_fn, map_one' := coe_one, map_mul' := coe_mul }

@[to_additive]
instance comm_monoid {G : Type*} [comm_monoid G] [topological_space G]
  [charted_space H' G] [has_smooth_mul I' G] :
  comm_monoid C^∞⟮I, N; I', G⟯ :=
{ mul_comm := λ a b, by ext; exact mul_comm _ _,
  ..smooth_map.monoid,
  ..smooth_map.has_one }

@[to_additive]
instance group {G : Type*} [group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] :
  group C^∞⟮I, N; I', G⟯ :=
{ inv := λ f, ⟨λ x, (f x)⁻¹, f.smooth.inv⟩,
  mul_left_inv := λ a, by ext; exact mul_left_inv _,
  div := λ f g, ⟨f / g, f.smooth.div g.smooth⟩,
  div_eq_mul_inv := λ f g, by ext; exact div_eq_mul_inv _ _,
  .. smooth_map.monoid }

@[simp, to_additive]
lemma coe_inv {G : Type*} [group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] (f : C^∞⟮I, N; I', G⟯) :
  ⇑f⁻¹ = f⁻¹ := rfl

@[simp, to_additive]
lemma coe_div {G : Type*} [group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] (f g : C^∞⟮I, N; I', G⟯) :
  ⇑(f / g) = f / g :=
rfl

@[to_additive]
instance comm_group {G : Type*} [comm_group G] [topological_space G]
  [charted_space H' G] [lie_group I' G] :
  comm_group C^∞⟮I, N; I', G⟯ :=
{ ..smooth_map.group,
  ..smooth_map.comm_monoid }

end group_structure

section ring_structure

/-!
### Ring stucture

In this section we show that smooth functions valued in a smooth ring `R` inherit a ring structure
under pointwise multiplication.
-/

instance semiring {R : Type*} [semiring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] :
  semiring C^∞⟮I, N; I', R⟯ :=
{ left_distrib := λ a b c, by ext; exact left_distrib _ _ _,
  right_distrib := λ a b c, by ext; exact right_distrib _ _ _,
  zero_mul := λ a, by ext; exact zero_mul _,
  mul_zero := λ a, by ext; exact mul_zero _,
  ..smooth_map.add_comm_monoid,
  ..smooth_map.monoid }

instance ring {R : Type*} [ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] :
  ring C^∞⟮I, N; I', R⟯ :=
{ ..smooth_map.semiring,
  ..smooth_map.add_comm_group, }

instance comm_ring {R : Type*} [comm_ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] :
  comm_ring C^∞⟮I, N; I', R⟯ :=
{ ..smooth_map.semiring,
  ..smooth_map.add_comm_group,
  ..smooth_map.comm_monoid,}

/-- Coercion to a function as a `ring_hom`. -/
@[simps]
def coe_fn_ring_hom {R : Type*} [comm_ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] : C^∞⟮I, N; I', R⟯ →+* (N → R) :=
{ to_fun := coe_fn,
  ..(coe_fn_monoid_hom : C^∞⟮I, N; I', R⟯ →* _),
  ..(coe_fn_add_monoid_hom : C^∞⟮I, N; I', R⟯ →+ _) }

/-- `function.eval` as a `ring_hom` on the ring of smooth functions. -/
def eval_ring_hom {R : Type*} [comm_ring R] [topological_space R]
  [charted_space H' R] [smooth_ring I' R] (n : N) : C^∞⟮I, N; I', R⟯ →+* R :=
(pi.eval_ring_hom _ n : (N → R) →+* R).comp smooth_map.coe_fn_ring_hom

end ring_structure

section module_structure

/-!
### Semiodule stucture

In this section we show that smooth functions valued in a vector space `M` over a normed
field `𝕜` inherit a vector space structure.
-/

instance has_scalar {V : Type*} [normed_group V] [normed_space 𝕜 V] :
  has_scalar 𝕜 C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
⟨λ r f, ⟨r • f, smooth_const.smul f.smooth⟩⟩

@[simp]
lemma coe_smul {V : Type*} [normed_group V] [normed_space 𝕜 V]
  (r : 𝕜) (f : C^∞⟮I, N; 𝓘(𝕜, V), V⟯) :
  ⇑(r • f) = r • f := rfl

@[simp] lemma smul_comp {V : Type*} [normed_group V] [normed_space 𝕜 V]
  (r : 𝕜) (g : C^∞⟮I'', N'; 𝓘(𝕜, V), V⟯) (h : C^∞⟮I, N; I'', N'⟯) :
(r • g).comp h = r • (g.comp h) := rfl

instance module {V : Type*} [normed_group V] [normed_space 𝕜 V] :
  module 𝕜 C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
function.injective.module 𝕜 coe_fn_add_monoid_hom cont_mdiff_map.coe_inj coe_smul

/-- Coercion to a function as a `linear_map`. -/
@[simps]
def coe_fn_linear_map {V : Type*} [normed_group V] [normed_space 𝕜 V] :
C^∞⟮I, N; 𝓘(𝕜, V), V⟯ →ₗ[𝕜] (N → V) :=
{ to_fun := coe_fn,
  map_smul' := coe_smul,
  ..(coe_fn_add_monoid_hom : C^∞⟮I, N; 𝓘(𝕜, V), V⟯ →+ _) }

end module_structure

section algebra_structure

/-!
### Algebra structure

In this section we show that smooth functions valued in a normed algebra `A` over a normed field `𝕜`
inherit an algebra structure.
-/

variables {A : Type*} [normed_ring A] [normed_algebra 𝕜 A] [smooth_ring 𝓘(𝕜, A) A]

/-- Smooth constant functions as a `ring_hom`. -/
def C : 𝕜 →+* C^∞⟮I, N; 𝓘(𝕜, A), A⟯ :=
{ to_fun    := λ c : 𝕜, ⟨λ x, ((algebra_map 𝕜 A) c), smooth_const⟩,
  map_one'  := by ext x; exact (algebra_map 𝕜 A).map_one,
  map_mul'  := λ c₁ c₂, by ext x; exact (algebra_map 𝕜 A).map_mul _ _,
  map_zero' := by ext x; exact (algebra_map 𝕜 A).map_zero,
  map_add'  := λ c₁ c₂, by ext x; exact (algebra_map 𝕜 A).map_add _ _ }

instance algebra : algebra 𝕜 C^∞⟮I, N; 𝓘(𝕜, A), A⟯ :=
{ smul := λ r f,
  ⟨r • f, smooth_const.smul f.smooth⟩,
  to_ring_hom := smooth_map.C,
  commutes' := λ c f, by ext x; exact algebra.commutes' _ _,
  smul_def' := λ c f, by ext x; exact algebra.smul_def' _ _,
  ..smooth_map.semiring }

/-- A special case of `pi.algebra` for non-dependent types. Lean get stuck on the definition
below without this. -/
instance _root_.function.algebra (I : Type*) {R : Type*} (A : Type*) {r : comm_semiring R}
  [semiring A] [algebra R A] : algebra R (I → A) :=
pi.algebra _ _

/-- Coercion to a function as an `alg_hom`. -/
@[simps]
def coe_fn_alg_hom : C^∞⟮I, N; 𝓘(𝕜, A), A⟯ →ₐ[𝕜] (N → A) :=
{ to_fun := coe_fn,
  commutes' := λ r, rfl,
  -- `..(smooth_map.coe_fn_ring_hom : C^∞⟮I, N; 𝓘(𝕜, A), A⟯ →+* _)` times out for some reason
  map_zero' := smooth_map.coe_zero,
  map_one' := smooth_map.coe_one,
  map_add' := smooth_map.coe_add,
  map_mul' := smooth_map.coe_mul }

end algebra_structure

section module_over_continuous_functions

/-!
### Structure as module over scalar functions

If `V` is a module over `𝕜`, then we show that the space of smooth functions from `N` to `V`
is naturally a vector space over the ring of smooth functions from `N` to `𝕜`. -/

instance has_scalar' {V : Type*} [normed_group V] [normed_space 𝕜 V] :
  has_scalar C^∞⟮I, N; 𝕜⟯ C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
⟨λ f g, ⟨λ x, (f x) • (g x), (smooth.smul f.2 g.2)⟩⟩

@[simp] lemma smul_comp' {V : Type*} [normed_group V] [normed_space 𝕜 V]
  (f : C^∞⟮I'', N'; 𝕜⟯) (g : C^∞⟮I'', N'; 𝓘(𝕜, V), V⟯) (h : C^∞⟮I, N; I'', N'⟯) :
(f • g).comp h = (f.comp h) • (g.comp h) := rfl

instance module' {V : Type*} [normed_group V] [normed_space 𝕜 V] :
  module C^∞⟮I, N; 𝓘(𝕜), 𝕜⟯ C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
{ smul     := (•),
  smul_add := λ c f g, by ext x; exact smul_add (c x) (f x) (g x),
  add_smul := λ c₁ c₂ f, by ext x; exact add_smul (c₁ x) (c₂ x) (f x),
  mul_smul := λ c₁ c₂ f, by ext x; exact mul_smul (c₁ x) (c₂ x) (f x),
  one_smul := λ f, by ext x; exact one_smul 𝕜 (f x),
  zero_smul := λ f, by ext x; exact zero_smul _ _,
  smul_zero := λ r, by ext x; exact smul_zero _, }

end module_over_continuous_functions

end smooth_map


import set_theory.surreal
open pgame
namespace pgame

universe u

/-- An explicit description of the moves for Left in `x * y`. -/
def left_moves_mul {x y : pgame} : (x * y).left_moves
  ≃ x.left_moves × y.left_moves ⊕ x.right_moves × y.right_moves :=
by { cases x, cases y, refl, }

/-- An explicit description of the moves for Right in `x * y`. -/
def right_moves_mul {x y : pgame} : (x * y).right_moves
  ≃ x.left_moves × y.right_moves ⊕ x.right_moves × y.left_moves :=
by { cases x, cases y, refl, }

@[simp] lemma mk_mul_move_left_inl {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_left (sum.inl (i,j))
    = xL i * (mk yl yr yL yR) + (mk xl xr xL xR) * yL j - xL i * yL j
:= rfl

@[simp] lemma mul_move_left_inl {x y : pgame} {i j} :
   (x * y).move_left ((@left_moves_mul x y).symm (sum.inl (i,j)))
     = x.move_left i * y + x * y.move_left j - x.move_left i * y.move_left j
:= by {cases x, cases y, refl}

@[simp] lemma mk_mul_move_left_inr {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_left (sum.inr (i,j))
    = xR i * (mk yl yr yL yR) + (mk xl xr xL xR) * yR j - xR i * yR j
:= rfl

@[simp] lemma mul_move_left_inr {x y : pgame} {i j} :
   (x * y).move_left ((@left_moves_mul x y).symm (sum.inr (i,j)))
     = x.move_right i * y + x * y.move_right j - x.move_right i * y.move_right j
:= by {cases x, cases y, refl}

@[simp] lemma mk_mul_move_right_inl {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_right (sum.inl (i,j))
    = xL i * (mk yl yr yL yR) + (mk xl xr xL xR) * yR j - xL i * yR j
:= rfl

@[simp] lemma mul_move_right_inl {x y : pgame} {i j} :
   (x * y).move_right ((@right_moves_mul x y).symm (sum.inr (i, j)))
     = x.move_right i * y + x * y.move_left j - x.move_right i * y.move_left j
:= by {cases x, cases y, refl}

@[simp] lemma mk_mul_move_right_inr {xl xr yl yr} {xL xR yL yR} {i j} :
  (mk xl xr xL xR * mk yl yr yL yR).move_right (sum.inr (i,j))
    = xR i * (mk yl yr yL yR) + (mk xl xr xL xR) * yL j - xR i * yL j
:= rfl

@[simp] lemma mul_move_right_inr {x y : pgame} {i j} :
   (x * y).move_right ((@right_moves_mul x y).symm (sum.inr (i,j)))
     = x.move_right i * y + x * y.move_left j - x.move_right i * y.move_left j
:= by {cases x, cases y, refl}

local infix ` ~ ` := relabelling

/-- `x * 0` has exactly the same moves as `0`. -/
theorem mul_zero_relabelling : Π (x : pgame), relabelling (x * 0) 0
| (mk xl xr xL xR) :=
⟨by fsplit; rintro (⟨_, ⟨⟩⟩ | ⟨_, ⟨⟩⟩),
 by fsplit; rintro (⟨_, ⟨⟩⟩ | ⟨_, ⟨⟩⟩),
 by rintro (⟨_, ⟨⟩⟩ | ⟨_, ⟨⟩⟩),
 by rintro ⟨⟩⟩

/-- `x * 0` is equivalent to `0`. -/
lemma mul_zero_equiv (x : pgame) : (x * 0).equiv 0 :=
equiv_of_relabelling (mul_zero_relabelling x)

/-- `0 * x` has exactly the same moves as `0`. -/
theorem zero_mul_relabelling : Π (x : pgame), relabelling (0 * x) 0
| (mk xl xr xL xR) :=
⟨by fsplit; rintro (⟨⟨⟩, _⟩ | ⟨⟨⟩, _⟩),
 by fsplit; rintro (⟨⟨⟩, _⟩ | ⟨⟨⟩, _⟩),
 by rintro (⟨⟨⟩,_⟩ | ⟨⟨⟩,_⟩),
 by rintro ⟨⟩⟩

/-- `0 * x` is equivalent to `0`. -/
lemma zero_mul_equiv (x : pgame) : (0 * x).equiv 0 :=
equiv_of_relabelling (zero_mul_relabelling x)

theorem sub_congr_relabelling {w x y z : pgame}
  (h₁ : w.relabelling x) (h₂ : y.relabelling z) : (w - y).relabelling (x - z) :=
  sorry

#check equiv.refl

def mul_one_relabelling : Π {x : pgame.{u}}, relabelling (x * 1) x
| (mk xl xr xL xR) :=
begin
  refine ⟨_,_,_,_⟩,
  calc
     (mk xl xr xL xR * 1).left_moves
         ≃ xl × punit ⊕ xr × pempty : by refl
     ... ≃ xl × punit ⊕ pempty : equiv.sum_congr (equiv.refl _) (equiv.prod_pempty _)
     ... ≃ xl × punit : equiv.sum_pempty _
     ... ≃ xl : equiv.prod_punit _,

  calc
     (mk xl xr xL xR * 1).right_moves
         ≃ xl × pempty ⊕ xr × punit : by refl
     ... ≃ pempty ⊕ xr × punit : equiv.sum_congr (equiv.prod_pempty _) (equiv.refl _)
     ... ≃ xr × punit : equiv.pempty_sum _
     ... ≃ xr : equiv.prod_punit _,

  rintros (⟨i, ⟨⟩⟩|⟨i, ⟨⟩⟩),
  calc
    xL i * 1 + mk xl xr xL xR * 0 - xL i * 0
           ~ xL i * 1 + mk xl xr xL xR * 0 - 0 : sub_congr_relabelling (relabelling.refl _) (mul_zero_relabelling _)
       ... ~ xL i * 1 + mk xl xr xL xR * 0 + (-0) : by refl
       ... ~ xL i * 1 + (mk xl xr xL xR * 0 + 0) : sorry
       ... ~ xL i * 1 + mk xl xr xL xR * 0 : sorry
       ... ~ xL i * 1 + 0 : sorry
       ... ~ xL i * 1 : sorry
       ... ~ xL i : mul_one_relabelling,

  intro j,
  calc
    xR j * 1 + mk xl xr xL xR * 0 - xR j * 0
        ~ xR j * 1 + (mk xl xr xL xR * 0 - xR j * 0) : sorry
    ... ~ xR j * 1 + (mk xl xr xL xR * 0 - xR j * 0) : sorry
    ... ~ xR j * 1 + (mk xl xr xL xR - xR j) * 0 : sorry
    ... ~ xR j * 1 + 0 : sorry
    ... ~ xR j * 1 : by { refine add_zero_relabelling _ }
    ... ~ xR j : mul_one_relabelling,
end
using_well_founded { dec_tac := pgame_wf_tac }

example : ∀ (a b c : nat), a + b + c = a + ( b + c )
:=  add_assoc

end pgame

example (a b c : Type) : a × (b ⊕ c) ≃ (a × b) ⊕ (a × c) :=
equiv.prod_sum_distrib a b c


import topology.sheaves.sheaf
import algebraic_geometry.prime_spectrum.basic
import algebraic_geometry.structure_sheaf
import algebraic_geometry.Spec
import algebra.category.Module.basic
import module_localisation.basic
import algebra.category.Group.limits

namespace algebraic_geometry

open Top
open Top.presheaf
open topological_space
open category_theory
open opposite
open localized_module

universes u v

variables {R : CommRing.{u}} (M : Module.{u} R)

local notation `Spec.T` := Spec.Top_obj R

namespace MSpec

abbreviation localizations (p : Spec.T) : Type u :=
localized_module M (p.as_ideal.prime_compl)

def is_fraction {U : opens Spec.T} (f : Π x : U, localizations M x) : Prop :=
∃ (m : M) (s : R), ∀ x : U, ∃ nin: ¬ (s ∈ x.1.as_ideal), f x = localized_module.mk m ⟨s, nin⟩

def is_fraction_prelocal : @prelocal_predicate Spec.T (localizations M) :=
{ pred := λ U f, is_fraction M f,
  res := λ U V i f ⟨m, s, h⟩, ⟨m, s, λ x, begin
    rcases h (i x) with ⟨nin, h⟩,
    exact ⟨nin, h⟩,
  end⟩ }

def is_locally_fraction : local_predicate (localizations M) :=
(is_fraction_prelocal M).sheafify

lemma is_locally_fraction_pred {U : opens Spec.T}
  (f : Π x : U, localizations M x) :
  (is_locally_fraction M).pred f =
  ∀ x : U, ∃ (V : opens Spec.T) (m : x.1 ∈ V) (i : V ⟶ U) (m : M) (s : R),
    ∀ (y : V), ∃ (nin : ¬ (s ∈ y.1.as_ideal)),
      f (by exact i y) = localized_module.mk m ⟨s, nin⟩ := rfl

def section_add_group (U : (opens Spec.T)ᵒᵖ) : add_subgroup (Π (x : U.unop), localizations M x) :=
{ carrier := {f | (is_locally_fraction M).pred f},
  add_mem' := λ f g hf hg x, begin
    rcases hf x with ⟨Vf, mem1, i1, m1, s1, hf⟩,
    rcases hg x with ⟨Vg, mem2, i2, m2, s2, hg⟩,
    refine ⟨Vf ⊓ Vg, ⟨mem1, mem2⟩, hom_of_le inf_le_left ≫ i1, s2 • m1 + s1 • m2, s1 * s2, _⟩,
    intros y,
    rcases hf ((hom_of_le inf_le_left : Vf ⊓ Vg ⟶ Vf) y) with ⟨nin1, h1⟩,
    rcases hg ((hom_of_le inf_le_right : Vf ⊓ Vg ⟶ Vg) y) with ⟨nin2, h2⟩,
    refine ⟨λ r, (y.1.is_prime.mem_or_mem r).elim nin1 nin2, _⟩,
    dsimp only at h1 h2 ⊢,
    rw [pi.add_apply],
    erw [h1, h2],
    rw [localized_module.mk_add_mk],
    congr' 1,
  end,
  zero_mem' := λ x, begin
    refine ⟨U.unop, x.2, 𝟙 _, 0, 1, λ y, ⟨by simpa [←ideal.eq_top_iff_one] using y.1.is_prime.ne_top, _⟩⟩,
    dsimp only,
    rw [localized_module.mk_zero],
    refl,
  end,
  neg_mem' := λ f hf x, begin
    rcases hf x with ⟨Vf, mem1, i1, m1, s1, hf⟩,
    refine ⟨Vf, mem1, i1, -m1, s1, λ y, _⟩,
    rcases hf y with ⟨nin1, hf⟩,
    refine ⟨nin1, _⟩,
    simp only at hf ⊢,
    change - (f _) = _,
    rw [hf, localized_module.neg_mk],
  end }

def structure_sheaf_in_Type : sheaf Type* (Spec.T):=
subsheaf_to_Types (is_locally_fraction M)

instance ab_structure_sheaf_in_Type_obj (U : (opens Spec.T)ᵒᵖ) :
  add_comm_group ((structure_sheaf_in_Type M).1.obj U) := (section_add_group M U).to_add_comm_group

def structure_presheaf_in_Ab : presheaf Ab.{u} (Spec.T) :=
{ obj := λ U, AddCommGroup.of ((structure_sheaf_in_Type M).1.obj U),
  map := λ U V i,
  { to_fun := (structure_sheaf_in_Type M).1.map i,
    map_zero' := rfl,
    map_add' := λ _ _, rfl } }

def structure_presheaf_comp_forget :
  structure_presheaf_in_Ab M ⋙ (forget AddCommGroup) ≅ (structure_sheaf_in_Type M).1 :=
nat_iso.of_components (λ U, iso.refl _) (by tidy)

def structure_sheaf : sheaf Ab.{u} (Spec.T) :=
⟨structure_presheaf_in_Ab M,
  (@@is_sheaf_iff_is_sheaf_comp _ _ (forget Ab) _ _ _ (AddCommGroup.forget_preserves_limits.{u u}) (structure_presheaf_in_Ab M)).mpr
    (is_sheaf_of_iso (structure_presheaf_comp_forget M).symm (structure_sheaf_in_Type M).2)⟩

instance (U : (opens Spec.T)ᵒᵖ) (x : U.unop) :
  module (structure_sheaf.localizations R (x : Spec.T)) (localizations M x) :=
localized_module.is_module

instance (U : (opens Spec.T)ᵒᵖ) :
  has_scalar ((Spec.structure_sheaf R).1.obj U) ((MSpec.structure_sheaf M).1.obj U) :=
{ smul := λ r m, ⟨λ x, (r.1 x) • (m.1 x), λ x, begin
    rcases r.2 x with ⟨Vr, mem1, i1, ρ, s, hr⟩,
    rcases m.2 x with ⟨Vm, mem2, i2, m, t, ht⟩,
    refine ⟨Vr ⊓ Vm, ⟨mem1, mem2⟩, hom_of_le inf_le_left ≫ i1, ρ • m, s * t, λ y, _⟩,
    rcases hr ((hom_of_le (inf_le_left : Vr ⊓ Vm ≤ _)) y) with ⟨nin1, h1⟩,
    rcases ht ((hom_of_le (inf_le_right : Vr ⊓ Vm ≤ _)) y) with ⟨nin2, h2⟩,
    dsimp only at h1 h2 ⊢,
    refine ⟨λ r, (y.1.is_prime.mem_or_mem r).elim nin1 nin2, _⟩,
    have h3 : r.1 ((hom_of_le (inf_le_left : Vr ⊓ Vm ≤ _) ≫ i1) y) = localization.mk ρ ⟨s, nin1⟩,
    { rw [localization.mk_eq_mk'],
      erw is_localization.eq_mk'_iff_mul_eq,
      exact h1, },
    erw [h3, h2],
    rw localized_module.mk_smul_mk,
    refl,
  end⟩ }

protected lemma smul.val {U : (opens Spec.T)ᵒᵖ} (r : (Spec.structure_sheaf R).1.obj U) (m : (MSpec.structure_sheaf M).1.obj U) :
  (r • m).1 = r.1 • m.1 := rfl

protected lemma smul.apply {U : (opens Spec.T)ᵒᵖ} (r : (Spec.structure_sheaf R).1.obj U) (m : (MSpec.structure_sheaf M).1.obj U) (x : U.unop) :
  (r • m).1 x = r.1 x • m.1 x := rfl

protected lemma one_smul {U : (opens Spec.T)ᵒᵖ} (m : (MSpec.structure_sheaf M).1.obj U) :
  (1 : (Spec.structure_sheaf R).1.obj U) • m = m :=
begin
  rw [subtype.ext_iff_val],
  ext1 x,
  rw [MSpec.smul.apply],
  change (1 : Π x : U.unop, structure_sheaf.localizations R (x : Spec.T)) x • (m.1 x) = m.1 x,
  erw pi.one_apply,
  rw one_smul,
end

protected lemma mul_smul {U : (opens Spec.T)ᵒᵖ}
  (r1 r2 : (Spec.structure_sheaf R).1.obj U) (m : (MSpec.structure_sheaf M).1.obj U) :
  (r1 * r2) • m = r1 • r2 • m :=
begin
  rw [subtype.ext_iff_val],
  ext1 x,
  rw [MSpec.smul.apply, MSpec.smul.apply, MSpec.smul.apply],
  change (r1.1 * r2.1) x • _ = _,
  erw [pi.mul_apply],
  rw mul_smul,
end

protected lemma smul_add {U : (opens Spec.T)ᵒᵖ}
  (r : (Spec.structure_sheaf R).1.obj U) (m1 m2 : (MSpec.structure_sheaf M).1.obj U) :
  r • (m1 + m2) = r • m1 + r • m2 :=
begin
  rw [subtype.ext_iff_val],
  ext1 x,
  rw [MSpec.smul.apply],
  change r.1 x • (m1.1 + m2.1) x = (r.1 x • m1.1 x) + (r.1 x • m2.1 x),
  rw [pi.add_apply, smul_add],
end

protected lemma smul_zero {U : (opens Spec.T)ᵒᵖ}
  (r : (Spec.structure_sheaf R).1.obj U) :
  r • (0 : (MSpec.structure_sheaf M).1.obj U) = 0 :=
begin
  rw [subtype.ext_iff_val],
  ext1 x,
  rw [MSpec.smul.apply],
  change r.1 x • (0 : Π x, localizations M x) x = (0 : Π x, localizations M x) x,
  rw [pi.zero_apply, smul_zero],
end

protected lemma add_smul {U : (opens Spec.T)ᵒᵖ}
  (r1 r2 : (Spec.structure_sheaf R).1.obj U) (m : (MSpec.structure_sheaf M).1.obj U) :
  (r1 + r2) • m = r1 • m + r2 • m :=
begin
  rw [subtype.ext_iff_val],
  ext1 x,
  rw [MSpec.smul.apply],
  change (r1.1 + r2.1) x • _ = (r1.1 x • m.1 x + r2.1 x • m.1 x),
  rw [pi.add_apply, add_smul],
end

protected lemma zero_smul {U : (opens Spec.T)ᵒᵖ} (m : (MSpec.structure_sheaf M).1.obj U) :
  (0 : (Spec.structure_sheaf R).1.obj U) • m = 0 :=
begin
  rw [subtype.ext_iff_val],
  ext1 x,
  rw [MSpec.smul.apply],
  change (0 : Π x, structure_sheaf.localizations R (x : Spec.T)) x • m.1 x = (0 : Π x, localizations M x) x,
  rw [pi.zero_apply, zero_smul, pi.zero_apply],
end

instance (U : (opens Spec.T)ᵒᵖ) :
  module ((Spec.structure_sheaf R).1.obj U) ((MSpec.structure_sheaf M).1.obj U) :=
{ smul := (•),
  one_smul := MSpec.one_smul M,
  mul_smul := MSpec.mul_smul M,
  smul_add := MSpec.smul_add M,
  smul_zero := MSpec.smul_zero M,
  add_smul := MSpec.add_smul M,
  zero_smul := MSpec.zero_smul M }

end MSpec

end algebraic_geometry


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann

! This file was ported from Lean 3 source module algebra.continued_fractions.translations
! leanprover-community/mathlib commit a7e36e48519ab281320c4d192da6a7b348ce40ad
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.ContinuedFractions.Basic

/-!
# Basic Translation Lemmas Between Functions Defined for Continued Fractions

## Summary

Some simple translation lemmas between the different definitions of functions defined in
`algebra.continued_fractions.basic`.
-/

namespace GeneralizedContinuedFraction

/- ./././Mathport/Syntax/Translate/Command.lean:224:11: unsupported: unusual advanced open style -/
section General

/-!
### Translations Between General Access Functions

Here we give some basic translations that hold by definition between the various methods that allow
us to access the numerators and denominators of a continued fraction.
-/

variable {α : Type _} {g : GeneralizedContinuedFraction α} {n : ℕ}

theorem terminatedAt_iff_s_terminatedAt : g.TerminatedAt n ↔ g.s.TerminatedAt n := by rfl
#align generalized_continued_fraction.terminated_at_iff_s_terminated_at GeneralizedContinuedFraction.terminatedAt_iff_s_terminatedAt

theorem terminatedAt_iff_s_none : g.TerminatedAt n ↔ g.s.get? n = none := by rfl
#align generalized_continued_fraction.terminated_at_iff_s_none GeneralizedContinuedFraction.terminatedAt_iff_s_none

theorem part_num_none_iff_s_none : g.partialNumerators.get? n = none ↔ g.s.get? n = none := by
  cases s_nth_eq : g.s.nth n <;> simp [partial_numerators, s_nth_eq]
#align generalized_continued_fraction.part_num_none_iff_s_none GeneralizedContinuedFraction.part_num_none_iff_s_none

theorem terminatedAt_iff_part_num_none : g.TerminatedAt n ↔ g.partialNumerators.get? n = none := by
  rw [terminated_at_iff_s_none, part_num_none_iff_s_none]
#align generalized_continued_fraction.terminated_at_iff_part_num_none GeneralizedContinuedFraction.terminatedAt_iff_part_num_none

theorem part_denom_none_iff_s_none : g.partialDenominators.get? n = none ↔ g.s.get? n = none := by
  cases s_nth_eq : g.s.nth n <;> simp [partial_denominators, s_nth_eq]
#align generalized_continued_fraction.part_denom_none_iff_s_none GeneralizedContinuedFraction.part_denom_none_iff_s_none

theorem terminatedAt_iff_part_denom_none : g.TerminatedAt n ↔ g.partialDenominators.get? n = none :=
  by rw [terminated_at_iff_s_none, part_denom_none_iff_s_none]
#align generalized_continued_fraction.terminated_at_iff_part_denom_none GeneralizedContinuedFraction.terminatedAt_iff_part_denom_none

theorem part_num_eq_s_a {gp : Pair α} (s_nth_eq : g.s.get? n = some gp) :
    g.partialNumerators.get? n = some gp.a := by simp [partial_numerators, s_nth_eq]
#align generalized_continued_fraction.part_num_eq_s_a GeneralizedContinuedFraction.part_num_eq_s_a

theorem part_denom_eq_s_b {gp : Pair α} (s_nth_eq : g.s.get? n = some gp) :
    g.partialDenominators.get? n = some gp.b := by simp [partial_denominators, s_nth_eq]
#align generalized_continued_fraction.part_denom_eq_s_b GeneralizedContinuedFraction.part_denom_eq_s_b

theorem exists_s_a_of_part_num {a : α} (nth_part_num_eq : g.partialNumerators.get? n = some a) :
    ∃ gp, g.s.get? n = some gp ∧ gp.a = a := by
  simpa [partial_numerators, seq.map_nth] using nth_part_num_eq
#align generalized_continued_fraction.exists_s_a_of_part_num GeneralizedContinuedFraction.exists_s_a_of_part_num

theorem exists_s_b_of_part_denom {b : α}
    (nth_part_denom_eq : g.partialDenominators.get? n = some b) :
    ∃ gp, g.s.get? n = some gp ∧ gp.b = b := by
  simpa [partial_denominators, seq.map_nth] using nth_part_denom_eq
#align generalized_continued_fraction.exists_s_b_of_part_denom GeneralizedContinuedFraction.exists_s_b_of_part_denom

end General

section WithDivisionRing

/-!
### Translations Between Computational Functions

Here we  give some basic translations that hold by definition for the computational methods of a
continued fraction.
-/

variable {K : Type _} {g : GeneralizedContinuedFraction K} {n : ℕ} [DivisionRing K]

theorem nth_cont_eq_succ_nth_cont_aux : g.continuants n = g.continuantsAux (n + 1) :=
  rfl
#align generalized_continued_fraction.nth_cont_eq_succ_nth_cont_aux GeneralizedContinuedFraction.nth_cont_eq_succ_nth_cont_aux

theorem num_eq_conts_a : g.numerators n = (g.continuants n).a :=
  rfl
#align generalized_continued_fraction.num_eq_conts_a GeneralizedContinuedFraction.num_eq_conts_a

theorem denom_eq_conts_b : g.denominators n = (g.continuants n).b :=
  rfl
#align generalized_continued_fraction.denom_eq_conts_b GeneralizedContinuedFraction.denom_eq_conts_b

theorem convergent_eq_num_div_denom : g.convergents n = g.numerators n / g.denominators n :=
  rfl
#align generalized_continued_fraction.convergent_eq_num_div_denom GeneralizedContinuedFraction.convergent_eq_num_div_denom

theorem convergent_eq_conts_a_div_conts_b :
    g.convergents n = (g.continuants n).a / (g.continuants n).b :=
  rfl
#align generalized_continued_fraction.convergent_eq_conts_a_div_conts_b GeneralizedContinuedFraction.convergent_eq_conts_a_div_conts_b

theorem exists_conts_a_of_num {A : K} (nth_num_eq : g.numerators n = A) :
    ∃ conts, g.continuants n = conts ∧ conts.a = A := by simpa
#align generalized_continued_fraction.exists_conts_a_of_num GeneralizedContinuedFraction.exists_conts_a_of_num

theorem exists_conts_b_of_denom {B : K} (nth_denom_eq : g.denominators n = B) :
    ∃ conts, g.continuants n = conts ∧ conts.b = B := by simpa
#align generalized_continued_fraction.exists_conts_b_of_denom GeneralizedContinuedFraction.exists_conts_b_of_denom

@[simp]
theorem zeroth_continuant_aux_eq_one_zero : g.continuantsAux 0 = ⟨1, 0⟩ :=
  rfl
#align generalized_continued_fraction.zeroth_continuant_aux_eq_one_zero GeneralizedContinuedFraction.zeroth_continuant_aux_eq_one_zero

@[simp]
theorem first_continuant_aux_eq_h_one : g.continuantsAux 1 = ⟨g.h, 1⟩ :=
  rfl
#align generalized_continued_fraction.first_continuant_aux_eq_h_one GeneralizedContinuedFraction.first_continuant_aux_eq_h_one

@[simp]
theorem zeroth_continuant_eq_h_one : g.continuants 0 = ⟨g.h, 1⟩ :=
  rfl
#align generalized_continued_fraction.zeroth_continuant_eq_h_one GeneralizedContinuedFraction.zeroth_continuant_eq_h_one

@[simp]
theorem zeroth_numerator_eq_h : g.numerators 0 = g.h :=
  rfl
#align generalized_continued_fraction.zeroth_numerator_eq_h GeneralizedContinuedFraction.zeroth_numerator_eq_h

@[simp]
theorem zeroth_denominator_eq_one : g.denominators 0 = 1 :=
  rfl
#align generalized_continued_fraction.zeroth_denominator_eq_one GeneralizedContinuedFraction.zeroth_denominator_eq_one

@[simp]
theorem zeroth_convergent_eq_h : g.convergents 0 = g.h := by
  simp [convergent_eq_num_div_denom, num_eq_conts_a, denom_eq_conts_b, div_one]
#align generalized_continued_fraction.zeroth_convergent_eq_h GeneralizedContinuedFraction.zeroth_convergent_eq_h

theorem second_continuant_aux_eq {gp : Pair K} (zeroth_s_eq : g.s.get? 0 = some gp) :
    g.continuantsAux 2 = ⟨gp.b * g.h + gp.a, gp.b⟩ := by
  simp [zeroth_s_eq, continuants_aux, next_continuants, next_denominator, next_numerator]
#align generalized_continued_fraction.second_continuant_aux_eq GeneralizedContinuedFraction.second_continuant_aux_eq

theorem first_continuant_eq {gp : Pair K} (zeroth_s_eq : g.s.get? 0 = some gp) :
    g.continuants 1 = ⟨gp.b * g.h + gp.a, gp.b⟩ := by
  simp [nth_cont_eq_succ_nth_cont_aux, second_continuant_aux_eq zeroth_s_eq]
#align generalized_continued_fraction.first_continuant_eq GeneralizedContinuedFraction.first_continuant_eq

theorem first_numerator_eq {gp : Pair K} (zeroth_s_eq : g.s.get? 0 = some gp) :
    g.numerators 1 = gp.b * g.h + gp.a := by simp [num_eq_conts_a, first_continuant_eq zeroth_s_eq]
#align generalized_continued_fraction.first_numerator_eq GeneralizedContinuedFraction.first_numerator_eq

theorem first_denominator_eq {gp : Pair K} (zeroth_s_eq : g.s.get? 0 = some gp) :
    g.denominators 1 = gp.b := by simp [denom_eq_conts_b, first_continuant_eq zeroth_s_eq]
#align generalized_continued_fraction.first_denominator_eq GeneralizedContinuedFraction.first_denominator_eq

@[simp]
theorem zeroth_convergent'_aux_eq_zero {s : Seq <| Pair K} : convergents'Aux s 0 = 0 :=
  rfl
#align generalized_continued_fraction.zeroth_convergent'_aux_eq_zero GeneralizedContinuedFraction.zeroth_convergent'_aux_eq_zero

@[simp]
theorem zeroth_convergent'_eq_h : g.convergents' 0 = g.h := by simp [convergents']
#align generalized_continued_fraction.zeroth_convergent'_eq_h GeneralizedContinuedFraction.zeroth_convergent'_eq_h

theorem convergents'Aux_succ_none {s : Seq (Pair K)} (h : s.headI = none) (n : ℕ) :
    convergents'Aux s (n + 1) = 0 := by rw [convergents'_aux, h, convergents'_aux._match_1]
#align generalized_continued_fraction.convergents'_aux_succ_none GeneralizedContinuedFraction.convergents'Aux_succ_none

theorem convergents'Aux_succ_some {s : Seq (Pair K)} {p : Pair K} (h : s.headI = some p) (n : ℕ) :
    convergents'Aux s (n + 1) = p.a / (p.b + convergents'Aux s.tail n) := by
  rw [convergents'_aux, h, convergents'_aux._match_1]
#align generalized_continued_fraction.convergents'_aux_succ_some GeneralizedContinuedFraction.convergents'Aux_succ_some

end WithDivisionRing

end GeneralizedContinuedFraction


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.hom
import Mathlib.data.equiv.basic
import Mathlib.PostPort

universes u_1 u v

namespace Mathlib

/-!
# Type tags that turn additive structures into multiplicative, and vice versa

We define two type tags:

* `additive α`: turns any multiplicative structure on `α` into the corresponding
  additive structure on `additive α`;
* `multiplicative α`: turns any additive structure on `α` into the corresponding
  multiplicative structure on `multiplicative α`.

We also define instances `additive.*` and `multiplicative.*` that actually transfer the structures.
-/

/-- If `α` carries some multiplicative structure, then `additive α` carries the corresponding
additive structure. -/
/-- If `α` carries some additive structure, then `multiplicative α` carries the corresponding
def additive (α : Type u_1) := α

multiplicative structure. -/
def multiplicative (α : Type u_1) := α

namespace additive

/-- Reinterpret `x : α` as an element of `additive α`. -/
def of_mul {α : Type u} : α ≃ additive α :=
  equiv.mk (fun (x : α) => x) (fun (x : additive α) => x) sorry sorry

/-- Reinterpret `x : additive α` as an element of `α`. -/
def to_mul {α : Type u} : additive α ≃ α := equiv.symm of_mul

@[simp] theorem of_mul_symm_eq {α : Type u} : equiv.symm of_mul = to_mul := rfl

@[simp] theorem to_mul_symm_eq {α : Type u} : equiv.symm to_mul = of_mul := rfl

end additive

namespace multiplicative

/-- Reinterpret `x : α` as an element of `multiplicative α`. -/
def of_add {α : Type u} : α ≃ multiplicative α :=
  equiv.mk (fun (x : α) => x) (fun (x : multiplicative α) => x) sorry sorry

/-- Reinterpret `x : multiplicative α` as an element of `α`. -/
def to_add {α : Type u} : multiplicative α ≃ α := equiv.symm of_add

@[simp] theorem of_add_symm_eq {α : Type u} : equiv.symm of_add = to_add := rfl

@[simp] theorem to_add_symm_eq {α : Type u} : equiv.symm to_add = of_add := rfl

end multiplicative

@[simp] theorem to_add_of_add {α : Type u} (x : α) :
    coe_fn multiplicative.to_add (coe_fn multiplicative.of_add x) = x :=
  rfl

@[simp] theorem of_add_to_add {α : Type u} (x : multiplicative α) :
    coe_fn multiplicative.of_add (coe_fn multiplicative.to_add x) = x :=
  rfl

@[simp] theorem to_mul_of_mul {α : Type u} (x : α) :
    coe_fn additive.to_mul (coe_fn additive.of_mul x) = x :=
  rfl

@[simp] theorem of_mul_to_mul {α : Type u} (x : additive α) :
    coe_fn additive.of_mul (coe_fn additive.to_mul x) = x :=
  rfl

protected instance additive.inhabited {α : Type u} [Inhabited α] : Inhabited (additive α) :=
  { default := coe_fn additive.of_mul Inhabited.default }

protected instance multiplicative.inhabited {α : Type u} [Inhabited α] :
    Inhabited (multiplicative α) :=
  { default := coe_fn multiplicative.of_add Inhabited.default }

protected instance additive.has_add {α : Type u} [Mul α] : Add (additive α) :=
  { add :=
      fun (x y : additive α) =>
        coe_fn additive.of_mul (coe_fn additive.to_mul x * coe_fn additive.to_mul y) }

protected instance multiplicative.has_mul {α : Type u} [Add α] : Mul (multiplicative α) :=
  { mul :=
      fun (x y : multiplicative α) =>
        coe_fn multiplicative.of_add
          (coe_fn multiplicative.to_add x + coe_fn multiplicative.to_add y) }

@[simp] theorem of_add_add {α : Type u} [Add α] (x : α) (y : α) :
    coe_fn multiplicative.of_add (x + y) =
        coe_fn multiplicative.of_add x * coe_fn multiplicative.of_add y :=
  rfl

@[simp] theorem to_add_mul {α : Type u} [Add α] (x : multiplicative α) (y : multiplicative α) :
    coe_fn multiplicative.to_add (x * y) =
        coe_fn multiplicative.to_add x + coe_fn multiplicative.to_add y :=
  rfl

@[simp] theorem of_mul_mul {α : Type u} [Mul α] (x : α) (y : α) :
    coe_fn additive.of_mul (x * y) = coe_fn additive.of_mul x + coe_fn additive.of_mul y :=
  rfl

@[simp] theorem to_mul_add {α : Type u} [Mul α] (x : additive α) (y : additive α) :
    coe_fn additive.to_mul (x + y) = coe_fn additive.to_mul x * coe_fn additive.to_mul y :=
  rfl

protected instance additive.add_semigroup {α : Type u} [semigroup α] : add_semigroup (additive α) :=
  add_semigroup.mk Add.add mul_assoc

protected instance multiplicative.semigroup {α : Type u} [add_semigroup α] :
    semigroup (multiplicative α) :=
  semigroup.mk Mul.mul add_assoc

protected instance additive.add_comm_semigroup {α : Type u} [comm_semigroup α] :
    add_comm_semigroup (additive α) :=
  add_comm_semigroup.mk add_semigroup.add sorry sorry

protected instance multiplicative.comm_semigroup {α : Type u} [add_comm_semigroup α] :
    comm_semigroup (multiplicative α) :=
  comm_semigroup.mk semigroup.mul sorry sorry

protected instance additive.add_left_cancel_semigroup {α : Type u} [left_cancel_semigroup α] :
    add_left_cancel_semigroup (additive α) :=
  add_left_cancel_semigroup.mk add_semigroup.add sorry sorry

protected instance multiplicative.left_cancel_semigroup {α : Type u} [add_left_cancel_semigroup α] :
    left_cancel_semigroup (multiplicative α) :=
  left_cancel_semigroup.mk semigroup.mul sorry sorry

protected instance additive.add_right_cancel_semigroup {α : Type u} [right_cancel_semigroup α] :
    add_right_cancel_semigroup (additive α) :=
  add_right_cancel_semigroup.mk add_semigroup.add sorry sorry

protected instance multiplicative.right_cancel_semigroup {α : Type u}
    [add_right_cancel_semigroup α] : right_cancel_semigroup (multiplicative α) :=
  right_cancel_semigroup.mk semigroup.mul sorry sorry

protected instance additive.has_zero {α : Type u} [HasOne α] : HasZero (additive α) :=
  { zero := coe_fn additive.of_mul 1 }

@[simp] theorem of_mul_one {α : Type u} [HasOne α] : coe_fn additive.of_mul 1 = 0 := rfl

@[simp] theorem to_mul_zero {α : Type u} [HasOne α] : coe_fn additive.to_mul 0 = 1 := rfl

protected instance multiplicative.has_one {α : Type u} [HasZero α] : HasOne (multiplicative α) :=
  { one := coe_fn multiplicative.of_add 0 }

@[simp] theorem of_add_zero {α : Type u} [HasZero α] : coe_fn multiplicative.of_add 0 = 1 := rfl

@[simp] theorem to_add_one {α : Type u} [HasZero α] : coe_fn multiplicative.to_add 1 = 0 := rfl

protected instance additive.add_monoid {α : Type u} [monoid α] : add_monoid (additive α) :=
  add_monoid.mk add_semigroup.add sorry 0 sorry sorry

protected instance multiplicative.monoid {α : Type u} [add_monoid α] : monoid (multiplicative α) :=
  monoid.mk semigroup.mul sorry 1 sorry sorry

protected instance additive.add_comm_monoid {α : Type u} [comm_monoid α] :
    add_comm_monoid (additive α) :=
  add_comm_monoid.mk add_monoid.add sorry add_monoid.zero sorry sorry sorry

protected instance multiplicative.comm_monoid {α : Type u} [add_comm_monoid α] :
    comm_monoid (multiplicative α) :=
  comm_monoid.mk monoid.mul sorry monoid.one sorry sorry sorry

protected instance additive.has_neg {α : Type u} [has_inv α] : Neg (additive α) :=
  { neg := fun (x : additive α) => coe_fn multiplicative.of_add (coe_fn additive.to_mul x⁻¹) }

@[simp] theorem of_mul_inv {α : Type u} [has_inv α] (x : α) :
    coe_fn additive.of_mul (x⁻¹) = -coe_fn additive.of_mul x :=
  rfl

@[simp] theorem to_mul_neg {α : Type u} [has_inv α] (x : additive α) :
    coe_fn additive.to_mul (-x) = (coe_fn additive.to_mul x⁻¹) :=
  rfl

protected instance multiplicative.has_inv {α : Type u} [Neg α] : has_inv (multiplicative α) :=
  has_inv.mk fun (x : multiplicative α) => coe_fn additive.of_mul (-coe_fn multiplicative.to_add x)

@[simp] theorem of_add_neg {α : Type u} [Neg α] (x : α) :
    coe_fn multiplicative.of_add (-x) = (coe_fn multiplicative.of_add x⁻¹) :=
  rfl

@[simp] theorem to_add_inv {α : Type u} [Neg α] (x : multiplicative α) :
    coe_fn multiplicative.to_add (x⁻¹) = -coe_fn multiplicative.to_add x :=
  rfl

protected instance additive.has_sub {α : Type u} [Div α] : Sub (additive α) :=
  { sub :=
      fun (x y : additive α) =>
        coe_fn additive.of_mul (coe_fn additive.to_mul x / coe_fn additive.to_mul y) }

protected instance multiplicative.has_div {α : Type u} [Sub α] : Div (multiplicative α) :=
  { div :=
      fun (x y : multiplicative α) =>
        coe_fn multiplicative.of_add
          (coe_fn multiplicative.to_add x - coe_fn multiplicative.to_add y) }

@[simp] theorem of_add_sub {α : Type u} [Sub α] (x : α) (y : α) :
    coe_fn multiplicative.of_add (x - y) =
        coe_fn multiplicative.of_add x / coe_fn multiplicative.of_add y :=
  rfl

@[simp] theorem to_add_div {α : Type u} [Sub α] (x : multiplicative α) (y : multiplicative α) :
    coe_fn multiplicative.to_add (x / y) =
        coe_fn multiplicative.to_add x - coe_fn multiplicative.to_add y :=
  rfl

@[simp] theorem of_mul_div {α : Type u} [Div α] (x : α) (y : α) :
    coe_fn additive.of_mul (x / y) = coe_fn additive.of_mul x - coe_fn additive.of_mul y :=
  rfl

@[simp] theorem to_mul_sub {α : Type u} [Div α] (x : additive α) (y : additive α) :
    coe_fn additive.to_mul (x - y) = coe_fn additive.to_mul x / coe_fn additive.to_mul y :=
  rfl

protected instance additive.sub_neg_monoid {α : Type u} [div_inv_monoid α] :
    sub_neg_monoid (additive α) :=
  sub_neg_monoid.mk add_monoid.add sorry add_monoid.zero sorry sorry Neg.neg Sub.sub

protected instance multiplicative.div_inv_monoid {α : Type u} [sub_neg_monoid α] :
    div_inv_monoid (multiplicative α) :=
  div_inv_monoid.mk monoid.mul sorry monoid.one sorry sorry has_inv.inv Div.div

protected instance additive.add_group {α : Type u} [group α] : add_group (additive α) :=
  add_group.mk sub_neg_monoid.add sorry sub_neg_monoid.zero sorry sorry sub_neg_monoid.neg
    sub_neg_monoid.sub mul_left_inv

protected instance multiplicative.group {α : Type u} [add_group α] : group (multiplicative α) :=
  group.mk div_inv_monoid.mul sorry div_inv_monoid.one sorry sorry div_inv_monoid.inv
    div_inv_monoid.div add_left_neg

protected instance additive.add_comm_group {α : Type u} [comm_group α] :
    add_comm_group (additive α) :=
  add_comm_group.mk add_group.add sorry add_group.zero sorry sorry add_group.neg add_group.sub sorry
    sorry

protected instance multiplicative.comm_group {α : Type u} [add_comm_group α] :
    comm_group (multiplicative α) :=
  comm_group.mk group.mul sorry group.one sorry sorry group.inv group.div sorry sorry

/-- Reinterpret `α →+ β` as `multiplicative α →* multiplicative β`. -/
def add_monoid_hom.to_multiplicative {α : Type u} {β : Type v} [add_monoid α] [add_monoid β] :
    (α →+ β) ≃ (multiplicative α →* multiplicative β) :=
  equiv.mk
    (fun (f : α →+ β) =>
      monoid_hom.mk (add_monoid_hom.to_fun f) (add_monoid_hom.map_zero' f)
        (add_monoid_hom.map_add' f))
    (fun (f : multiplicative α →* multiplicative β) =>
      add_monoid_hom.mk (monoid_hom.to_fun f) sorry sorry)
    sorry sorry

/-- Reinterpret `α →* β` as `additive α →+ additive β`. -/
def monoid_hom.to_additive {α : Type u} {β : Type v} [monoid α] [monoid β] :
    (α →* β) ≃ (additive α →+ additive β) :=
  equiv.mk
    (fun (f : α →* β) =>
      add_monoid_hom.mk (monoid_hom.to_fun f) (monoid_hom.map_one' f) (monoid_hom.map_mul' f))
    (fun (f : additive α →+ additive β) => monoid_hom.mk (add_monoid_hom.to_fun f) sorry sorry)
    sorry sorry

/-- Reinterpret `additive α →+ β` as `α →* multiplicative β`. -/
def add_monoid_hom.to_multiplicative' {α : Type u} {β : Type v} [monoid α] [add_monoid β] :
    (additive α →+ β) ≃ (α →* multiplicative β) :=
  equiv.mk (fun (f : additive α →+ β) => monoid_hom.mk (add_monoid_hom.to_fun f) sorry sorry)
    (fun (f : α →* multiplicative β) => add_monoid_hom.mk (monoid_hom.to_fun f) sorry sorry) sorry
    sorry

/-- Reinterpret `α →* multiplicative β` as `additive α →+ β`. -/
def monoid_hom.to_additive' {α : Type u} {β : Type v} [monoid α] [add_monoid β] :
    (α →* multiplicative β) ≃ (additive α →+ β) :=
  equiv.symm add_monoid_hom.to_multiplicative'

/-- Reinterpret `α →+ additive β` as `multiplicative α →* β`. -/
def add_monoid_hom.to_multiplicative'' {α : Type u} {β : Type v} [add_monoid α] [monoid β] :
    (α →+ additive β) ≃ (multiplicative α →* β) :=
  equiv.mk (fun (f : α →+ additive β) => monoid_hom.mk (add_monoid_hom.to_fun f) sorry sorry)
    (fun (f : multiplicative α →* β) => add_monoid_hom.mk (monoid_hom.to_fun f) sorry sorry) sorry
    sorry

/-- Reinterpret `multiplicative α →* β` as `α →+ additive β`. -/
def monoid_hom.to_additive'' {α : Type u} {β : Type v} [add_monoid α] [monoid β] :
    (multiplicative α →* β) ≃ (α →+ additive β) :=
  equiv.symm add_monoid_hom.to_multiplicative''

end Mathlib


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Sébastien Gouëzel, Zhouhang Zhou, Reid Barton,
Anatole Dedecker
-/
import topology.homeomorph
import topology.uniform_space.uniform_embedding
import topology.uniform_space.pi

/-!
# Uniform isomorphisms

This file defines uniform isomorphisms between two uniform spaces. They are bijections with both
directions uniformly continuous. We denote uniform isomorphisms with the notation `≃ᵤ`.

# Main definitions

* `uniform_equiv α β`: The type of uniform isomorphisms from `α` to `β`.
  This type can be denoted using the following notation: `α ≃ᵤ β`.

-/

open set filter
open_locale

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

/-- Uniform isomorphism between `α` and `β` -/
@[nolint has_inhabited_instance] -- not all spaces are homeomorphic to each other
structure uniform_equiv (α : Type*) (β : Type*) [uniform_space α] [uniform_space β]
  extends α ≃ β :=
(uniform_continuous_to_fun  : uniform_continuous to_fun)
(uniform_continuous_inv_fun : uniform_continuous inv_fun)

infix ` ≃ᵤ `:25 := uniform_equiv

namespace uniform_equiv
variables [uniform_space α] [uniform_space β] [uniform_space γ] [uniform_space δ]

instance : has_coe_to_fun (α ≃ᵤ β) (λ _, α → β) := ⟨λe, e.to_equiv⟩

@[simp] lemma uniform_equiv_mk_coe (a : equiv α β) (b c) :
  ((uniform_equiv.mk a b c) : α → β) = a :=
rfl

/-- Inverse of a uniform isomorphism. -/
protected def symm (h : α ≃ᵤ β) : β ≃ᵤ α :=
{ uniform_continuous_to_fun  := h.uniform_continuous_inv_fun,
  uniform_continuous_inv_fun := h.uniform_continuous_to_fun,
  to_equiv := h.to_equiv.symm }

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : α ≃ᵤ β) : α → β := h
/-- See Note [custom simps projection] -/
def simps.symm_apply (h : α ≃ᵤ β) : β → α := h.symm

initialize_simps_projections uniform_equiv
  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, -to_equiv)

@[simp] lemma coe_to_equiv (h : α ≃ᵤ β) : ⇑h.to_equiv = h := rfl
@[simp] lemma coe_symm_to_equiv (h : α ≃ᵤ β) : ⇑h.to_equiv.symm = h.symm := rfl

lemma to_equiv_injective : function.injective (to_equiv : α ≃ᵤ β → α ≃ β)
| ⟨e, h₁, h₂⟩ ⟨e', h₁', h₂'⟩ rfl := rfl

@[ext] lemma ext {h h' : α ≃ᵤ β} (H : ∀ x, h x = h' x) : h = h' :=
to_equiv_injective $ equiv.ext H

/-- Identity map as a uniform isomorphism. -/
@[simps apply {fully_applied := ff}]
protected def refl (α : Type*) [uniform_space α] : α ≃ᵤ α :=
{ uniform_continuous_to_fun := uniform_continuous_id,
  uniform_continuous_inv_fun := uniform_continuous_id,
  to_equiv := equiv.refl α }

/-- Composition of two uniform isomorphisms. -/
protected def trans (h₁ : α ≃ᵤ β) (h₂ : β ≃ᵤ γ) : α ≃ᵤ γ :=
{ uniform_continuous_to_fun  := h₂.uniform_continuous_to_fun.comp h₁.uniform_continuous_to_fun,
  uniform_continuous_inv_fun := h₁.uniform_continuous_inv_fun.comp h₂.uniform_continuous_inv_fun,
  to_equiv := equiv.trans h₁.to_equiv h₂.to_equiv }

@[simp] lemma trans_apply (h₁ : α ≃ᵤ β) (h₂ : β ≃ᵤ γ) (a : α) : h₁.trans h₂ a = h₂ (h₁ a) := rfl

@[simp] lemma uniform_equiv_mk_coe_symm (a : equiv α β) (b c) :
  ((uniform_equiv.mk a b c).symm : β → α) = a.symm :=
rfl

@[simp] lemma refl_symm : (uniform_equiv.refl α).symm = uniform_equiv.refl α := rfl

protected lemma uniform_continuous (h : α ≃ᵤ β) : uniform_continuous h :=
h.uniform_continuous_to_fun

@[continuity]
protected lemma continuous (h : α ≃ᵤ β) : continuous h :=
h.uniform_continuous.continuous

protected lemma uniform_continuous_symm (h : α ≃ᵤ β) : uniform_continuous (h.symm) :=
h.uniform_continuous_inv_fun

@[continuity] -- otherwise `by continuity` can't prove continuity of `h.to_equiv.symm`
protected lemma continuous_symm (h : α ≃ᵤ β) : continuous (h.symm) :=
h.uniform_continuous_symm.continuous

/-- A uniform isomorphism as a homeomorphism. -/
@[simps]
protected def to_homeomorph (e : α ≃ᵤ β) : α ≃ₜ β :=
{ continuous_to_fun := e.continuous,
  continuous_inv_fun := e.continuous_symm,
  .. e.to_equiv }

@[simp] lemma apply_symm_apply (h : α ≃ᵤ β) (x : β) : h (h.symm x) = x :=
h.to_equiv.apply_symm_apply x

@[simp] lemma symm_apply_apply (h : α ≃ᵤ β) (x : α) : h.symm (h x) = x :=
h.to_equiv.symm_apply_apply x

protected lemma bijective (h : α ≃ᵤ β) : function.bijective h := h.to_equiv.bijective
protected lemma injective (h : α ≃ᵤ β) : function.injective h := h.to_equiv.injective
protected lemma surjective (h : α ≃ᵤ β) : function.surjective h := h.to_equiv.surjective

/-- Change the uniform equiv `f` to make the inverse function definitionally equal to `g`. -/
def change_inv (f : α ≃ᵤ β) (g : β → α) (hg : function.right_inverse g f) : α ≃ᵤ β :=
have g = f.symm, from funext (λ x, calc g x = f.symm (f (g x)) : (f.left_inv (g x)).symm
                                        ... = f.symm x : by rw hg x),
{ to_fun := f,
  inv_fun := g,
  left_inv := by convert f.left_inv,
  right_inv := by convert f.right_inv,
  uniform_continuous_to_fun := f.uniform_continuous,
  uniform_continuous_inv_fun := by convert f.symm.uniform_continuous }

@[simp] lemma symm_comp_self (h : α ≃ᵤ β) : ⇑h.symm ∘ ⇑h = id :=
funext h.symm_apply_apply

@[simp] lemma self_comp_symm (h : α ≃ᵤ β) : ⇑h ∘ ⇑h.symm = id :=
funext h.apply_symm_apply

@[simp] lemma range_coe (h : α ≃ᵤ β) : range h = univ :=
h.surjective.range_eq

lemma preimage_symm (h : α ≃ᵤ β) : preimage h.symm = image h :=
(funext h.to_equiv.image_eq_preimage).symm

@[simp] lemma image_preimage (h : α ≃ᵤ β) (s : set β) : h '' (h ⁻¹' s) = s :=
h.to_equiv.image_preimage s

@[simp] lemma preimage_image (h : α ≃ᵤ β) (s : set α) : h ⁻¹' (h '' s) = s :=
h.to_equiv.preimage_image s

protected lemma uniform_inducing (h : α ≃ᵤ β) : uniform_inducing h :=
uniform_inducing_of_compose h.uniform_continuous h.symm.uniform_continuous $
  by simp only [symm_comp_self, uniform_inducing_id]

lemma comap_eq (h : α ≃ᵤ β) : uniform_space.comap h ‹_› = ‹_› :=
by ext : 1; exact h.uniform_inducing.comap_uniformity

protected lemma uniform_embedding (h : α ≃ᵤ β) : uniform_embedding h :=
⟨h.uniform_inducing, h.injective⟩

/-- Uniform equiv given a uniform embedding. -/
noncomputable def of_uniform_embedding (f : α → β) (hf : uniform_embedding f) :
  α ≃ᵤ (set.range f) :=
{ uniform_continuous_to_fun := uniform_continuous_subtype_mk
    hf.to_uniform_inducing.uniform_continuous _,
  uniform_continuous_inv_fun :=
    by simp [hf.to_uniform_inducing.uniform_continuous_iff, uniform_continuous_subtype_coe],
  to_equiv := equiv.of_injective f hf.inj }

/-- If two sets are equal, then they are uniformly equivalent. -/
def set_congr {s t : set α} (h : s = t) : s ≃ᵤ t :=
{ uniform_continuous_to_fun := uniform_continuous_subtype_mk uniform_continuous_subtype_val _,
  uniform_continuous_inv_fun := uniform_continuous_subtype_mk uniform_continuous_subtype_val _,
  to_equiv := equiv.set_congr h }

/-- Product of two uniform isomorphisms. -/
def prod_congr (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) : α × γ ≃ᵤ β × δ :=
{ uniform_continuous_to_fun  := (h₁.uniform_continuous.comp uniform_continuous_fst).prod_mk
    (h₂.uniform_continuous.comp uniform_continuous_snd),
  uniform_continuous_inv_fun := (h₁.symm.uniform_continuous.comp uniform_continuous_fst).prod_mk
    (h₂.symm.uniform_continuous.comp uniform_continuous_snd),
  to_equiv := h₁.to_equiv.prod_congr h₂.to_equiv }

@[simp] lemma prod_congr_symm (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) :
  (h₁.prod_congr h₂).symm = h₁.symm.prod_congr h₂.symm := rfl

@[simp] lemma coe_prod_congr (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) :
  ⇑(h₁.prod_congr h₂) = prod.map h₁ h₂ := rfl

section
variables (α β γ)

/-- `α × β` is uniformly isomorphic to `β × α`. -/
def prod_comm : α × β ≃ᵤ β × α :=
{ uniform_continuous_to_fun  := uniform_continuous_snd.prod_mk uniform_continuous_fst,
  uniform_continuous_inv_fun := uniform_continuous_snd.prod_mk uniform_continuous_fst,
  to_equiv := equiv.prod_comm α β }

@[simp] lemma prod_comm_symm : (prod_comm α β).symm = prod_comm β α := rfl
@[simp] lemma coe_prod_comm : ⇑(prod_comm α β) = prod.swap := rfl

/-- `(α × β) × γ` is uniformly isomorphic to `α × (β × γ)`. -/
def prod_assoc : (α × β) × γ ≃ᵤ α × (β × γ) :=
{ uniform_continuous_to_fun  := (uniform_continuous_fst.comp uniform_continuous_fst).prod_mk
    ((uniform_continuous_snd.comp uniform_continuous_fst).prod_mk uniform_continuous_snd),
  uniform_continuous_inv_fun := (uniform_continuous_fst.prod_mk
    (uniform_continuous_fst.comp uniform_continuous_snd)).prod_mk
    (uniform_continuous_snd.comp uniform_continuous_snd),
  to_equiv := equiv.prod_assoc α β γ }

/-- `α × {*}` is uniformly isomorphic to `α`. -/
@[simps apply {fully_applied := ff}]
def prod_punit : α × punit ≃ᵤ α :=
{ to_equiv := equiv.prod_punit α,
  uniform_continuous_to_fun := uniform_continuous_fst,
  uniform_continuous_inv_fun := uniform_continuous_id.prod_mk uniform_continuous_const }

/-- `{*} × α` is uniformly isomorphic to `α`. -/
def punit_prod : punit × α ≃ᵤ α :=
(prod_comm _ _).trans (prod_punit _)

@[simp] lemma coe_punit_prod : ⇑(punit_prod α) = prod.snd := rfl

end

/-- If `ι` has a unique element, then `ι → α` is homeomorphic to `α`. -/
@[simps { fully_applied := ff }]
def fun_unique (ι α : Type*) [unique ι] [uniform_space α] : (ι → α) ≃ᵤ α :=
{ to_equiv := equiv.fun_unique ι α,
  uniform_continuous_to_fun := Pi.uniform_continuous_proj _ _,
  uniform_continuous_inv_fun := uniform_continuous_pi.mpr (λ _, uniform_continuous_id) }

/-- Uniform isomorphism between dependent functions `Π i : fin 2, α i` and `α 0 × α 1`. -/
@[simps { fully_applied := ff }]
def {u} pi_fin_two (α : fin 2 → Type u) [Π i, uniform_space (α i)] : (Π i, α i) ≃ᵤ α 0 × α 1 :=
{ to_equiv := pi_fin_two_equiv α,
  uniform_continuous_to_fun :=
    (Pi.uniform_continuous_proj _ 0).prod_mk (Pi.uniform_continuous_proj _ 1),
  uniform_continuous_inv_fun := uniform_continuous_pi.mpr $
    fin.forall_fin_two.2 ⟨uniform_continuous_fst, uniform_continuous_snd⟩ }

/-- Uniform isomorphism between `α² = fin 2 → α` and `α × α`. -/
@[simps { fully_applied := ff }] def fin_two_arrow : (fin 2 → α) ≃ᵤ α × α :=
{ to_equiv := fin_two_arrow_equiv α, .. pi_fin_two (λ _, α) }

/--
A subset of a uniform space is uniformly isomorphic to its image under a uniform isomorphism.
-/
def image (e : α ≃ᵤ β) (s : set α) : s ≃ᵤ e '' s :=
{ uniform_continuous_to_fun := uniform_continuous_subtype_mk
    (e.uniform_continuous.comp uniform_continuous_subtype_val) (λ x, mem_image_of_mem _ x.2),
  uniform_continuous_inv_fun := uniform_continuous_subtype_mk
    (e.symm.uniform_continuous.comp uniform_continuous_subtype_val)
    (λ x, by simpa using mem_image_of_mem e.symm x.2),
  to_equiv := e.to_equiv.image s }

end uniform_equiv

/-- A uniform inducing equiv between uniform spaces is a uniform isomorphism. -/
@[simps] def equiv.to_uniform_equiv_of_uniform_inducing [uniform_space α] [uniform_space β]
  (f : α ≃ β) (hf : uniform_inducing f) :
  α ≃ᵤ β :=
{ uniform_continuous_to_fun := hf.uniform_continuous,
  uniform_continuous_inv_fun := hf.uniform_continuous_iff.2 $ by simpa using uniform_continuous_id,
  .. f }


/-
Copyright (c) 2020 Yury Kudryashov All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.ring.prod
import Mathlib.group_theory.submonoid.default
import Mathlib.data.equiv.ring
import Mathlib.PostPort

universes u l u_1 u_2 v w

namespace Mathlib

/-!
# Bundled subsemirings

We define bundled subsemirings and some standard constructions: `complete_lattice` structure,
`subtype` and `inclusion` ring homomorphisms, subsemiring `map`, `comap` and range (`srange`) of
a `ring_hom` etc.
-/

/-- A subsemiring of a semiring `R` is a subset `s` that is both a multiplicative and an additive
submonoid. -/
structure subsemiring (R : Type u) [semiring R]
extends add_submonoid R, submonoid R
where

/-- Reinterpret a `subsemiring` as a `submonoid`. -/
/-- Reinterpret a `subsemiring` as an `add_submonoid`. -/
namespace subsemiring

protected instance set.has_coe {R : Type u} [semiring R] : has_coe (subsemiring R) (set R) :=
  has_coe.mk carrier

protected instance has_mem {R : Type u} [semiring R] : has_mem R (subsemiring R) :=
  has_mem.mk fun (m : R) (S : subsemiring R) => m ∈ ↑S

protected instance has_coe_to_sort {R : Type u} [semiring R] : has_coe_to_sort (subsemiring R) :=
  has_coe_to_sort.mk (Type u) fun (S : subsemiring R) => Subtype fun (x : R) => x ∈ S

/-- Construct a `subsemiring R` from a set `s`, a submonoid `sm`, and an additive
submonoid `sa` such that `x ∈ s ↔ x ∈ sm ↔ x ∈ sa`. -/
protected def mk' {R : Type u} [semiring R] (s : set R) (sm : submonoid R) (hm : ↑sm = s) (sa : add_submonoid R) (ha : ↑sa = s) : subsemiring R :=
  mk s sorry sorry sorry sorry

@[simp] theorem coe_mk' {R : Type u} [semiring R] {s : set R} {sm : submonoid R} (hm : ↑sm = s) {sa : add_submonoid R} (ha : ↑sa = s) : ↑(subsemiring.mk' s sm hm sa ha) = s :=
  rfl

@[simp] theorem mem_mk' {R : Type u} [semiring R] {s : set R} {sm : submonoid R} (hm : ↑sm = s) {sa : add_submonoid R} (ha : ↑sa = s) {x : R} : x ∈ subsemiring.mk' s sm hm sa ha ↔ x ∈ s :=
  iff.rfl

@[simp] theorem mk'_to_submonoid {R : Type u} [semiring R] {s : set R} {sm : submonoid R} (hm : ↑sm = s) {sa : add_submonoid R} (ha : ↑sa = s) : to_submonoid (subsemiring.mk' s sm hm sa ha) = sm :=
  submonoid.ext' (Eq.symm hm)

@[simp] theorem mk'_to_add_submonoid {R : Type u} [semiring R] {s : set R} {sm : submonoid R} (hm : ↑sm = s) {sa : add_submonoid R} (ha : ↑sa = s) : to_add_submonoid (subsemiring.mk' s sm hm sa ha) = sa :=
  add_submonoid.ext' (Eq.symm ha)

end subsemiring

protected theorem subsemiring.exists {R : Type u} [semiring R] {s : subsemiring R} {p : ↥s → Prop} : (∃ (x : ↥s), p x) ↔ ∃ (x : R), ∃ (H : x ∈ s), p { val := x, property := H } :=
  set_coe.exists

protected theorem subsemiring.forall {R : Type u} [semiring R] {s : subsemiring R} {p : ↥s → Prop} : (∀ (x : ↥s), p x) ↔ ∀ (x : R) (H : x ∈ s), p { val := x, property := H } :=
  set_coe.forall

namespace subsemiring

/-- Two subsemirings are equal if the underlying subsets are equal. -/
theorem ext' {R : Type u} [semiring R] {s : subsemiring R} {t : subsemiring R} (h : ↑s = ↑t) : s = t := sorry

/-- Two subsemirings are equal if and only if the underlying subsets are equal. -/
protected theorem ext'_iff {R : Type u} [semiring R] {s : subsemiring R} {t : subsemiring R} : s = t ↔ ↑s = ↑t :=
  { mp := fun (h : s = t) => h ▸ rfl, mpr := fun (h : ↑s = ↑t) => ext' h }

/-- Two subsemirings are equal if they have the same elements. -/
theorem ext {R : Type u} [semiring R] {S : subsemiring R} {T : subsemiring R} (h : ∀ (x : R), x ∈ S ↔ x ∈ T) : S = T :=
  ext' (set.ext h)

/-- A subsemiring contains the semiring's 1. -/
theorem one_mem {R : Type u} [semiring R] (s : subsemiring R) : 1 ∈ s :=
  one_mem' s

/-- A subsemiring contains the semiring's 0. -/
theorem zero_mem {R : Type u} [semiring R] (s : subsemiring R) : 0 ∈ s :=
  zero_mem' s

/-- A subsemiring is closed under multiplication. -/
theorem mul_mem {R : Type u} [semiring R] (s : subsemiring R) {x : R} {y : R} : x ∈ s → y ∈ s → x * y ∈ s :=
  mul_mem' s

/-- A subsemiring is closed under addition. -/
theorem add_mem {R : Type u} [semiring R] (s : subsemiring R) {x : R} {y : R} : x ∈ s → y ∈ s → x + y ∈ s :=
  add_mem' s

/-- Product of a list of elements in a `subsemiring` is in the `subsemiring`. -/
theorem list_prod_mem {R : Type u} [semiring R] (s : subsemiring R) {l : List R} : (∀ (x : R), x ∈ l → x ∈ s) → list.prod l ∈ s :=
  submonoid.list_prod_mem (to_submonoid s)

/-- Sum of a list of elements in a `subsemiring` is in the `subsemiring`. -/
theorem list_sum_mem {R : Type u} [semiring R] (s : subsemiring R) {l : List R} : (∀ (x : R), x ∈ l → x ∈ s) → list.sum l ∈ s :=
  add_submonoid.list_sum_mem (to_add_submonoid s)

/-- Product of a multiset of elements in a `subsemiring` of a `comm_semiring`
    is in the `subsemiring`. -/
theorem multiset_prod_mem {R : Type u_1} [comm_semiring R] (s : subsemiring R) (m : multiset R) : (∀ (a : R), a ∈ m → a ∈ s) → multiset.prod m ∈ s :=
  submonoid.multiset_prod_mem (to_submonoid s) m

/-- Sum of a multiset of elements in a `subsemiring` of a `semiring` is
in the `add_subsemiring`. -/
theorem multiset_sum_mem {R : Type u_1} [semiring R] (s : subsemiring R) (m : multiset R) : (∀ (a : R), a ∈ m → a ∈ s) → multiset.sum m ∈ s :=
  add_submonoid.multiset_sum_mem (to_add_submonoid s) m

/-- Product of elements of a subsemiring of a `comm_semiring` indexed by a `finset` is in the
    subsemiring. -/
theorem prod_mem {R : Type u_1} [comm_semiring R] (s : subsemiring R) {ι : Type u_2} {t : finset ι} {f : ι → R} (h : ∀ (c : ι), c ∈ t → f c ∈ s) : (finset.prod t fun (i : ι) => f i) ∈ s :=
  submonoid.prod_mem (to_submonoid s) h

/-- Sum of elements in an `subsemiring` of an `semiring` indexed by a `finset`
is in the `add_subsemiring`. -/
theorem sum_mem {R : Type u_1} [semiring R] (s : subsemiring R) {ι : Type u_2} {t : finset ι} {f : ι → R} (h : ∀ (c : ι), c ∈ t → f c ∈ s) : (finset.sum t fun (i : ι) => f i) ∈ s :=
  add_submonoid.sum_mem (to_add_submonoid s) h

theorem pow_mem {R : Type u} [semiring R] (s : subsemiring R) {x : R} (hx : x ∈ s) (n : ℕ) : x ^ n ∈ s :=
  submonoid.pow_mem (to_submonoid s) hx n

theorem nsmul_mem {R : Type u} [semiring R] (s : subsemiring R) {x : R} (hx : x ∈ s) (n : ℕ) : n •ℕ x ∈ s :=
  add_submonoid.nsmul_mem (to_add_submonoid s) hx n

theorem coe_nat_mem {R : Type u} [semiring R] (s : subsemiring R) (n : ℕ) : ↑n ∈ s := sorry

/-- A subsemiring of a semiring inherits a semiring structure -/
protected instance to_semiring {R : Type u} [semiring R] (s : subsemiring R) : semiring ↥s :=
  semiring.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry monoid.mul sorry monoid.one sorry sorry
    sorry sorry sorry sorry

protected instance nontrivial {R : Type u} [semiring R] (s : subsemiring R) [nontrivial R] : nontrivial ↥s :=
  nontrivial_of_ne 0 1 fun (H : 0 = 1) => zero_ne_one (congr_arg subtype.val H)

protected instance no_zero_divisors {R : Type u} [semiring R] (s : subsemiring R) [no_zero_divisors R] : no_zero_divisors ↥s :=
  no_zero_divisors.mk
    fun (x y : ↥s) (h : x * y = 0) =>
      or.cases_on (eq_zero_or_eq_zero_of_mul_eq_zero (iff.mp subtype.ext_iff h))
        (fun (h : subtype.val x = 0) => Or.inl (subtype.eq h)) fun (h : subtype.val y = 0) => Or.inr (subtype.eq h)

@[simp] theorem coe_mul {R : Type u} [semiring R] (s : subsemiring R) (x : ↥s) (y : ↥s) : ↑(x * y) = ↑x * ↑y :=
  rfl

@[simp] theorem coe_one {R : Type u} [semiring R] (s : subsemiring R) : ↑1 = 1 :=
  rfl

/-- A subsemiring of a `comm_semiring` is a `comm_semiring`. -/
protected instance to_comm_semiring {R : Type u_1} [comm_semiring R] (s : subsemiring R) : comm_semiring ↥s :=
  comm_semiring.mk semiring.add sorry semiring.zero sorry sorry sorry semiring.mul sorry semiring.one sorry sorry sorry
    sorry sorry sorry sorry

/-- The natural ring hom from a subsemiring of semiring `R` to `R`. -/
def subtype {R : Type u} [semiring R] (s : subsemiring R) : ↥s →+* R :=
  ring_hom.mk coe sorry sorry sorry sorry

@[simp] theorem coe_subtype {R : Type u} [semiring R] (s : subsemiring R) : ⇑(subtype s) = coe :=
  rfl

protected instance partial_order {R : Type u} [semiring R] : partial_order (subsemiring R) :=
  partial_order.mk (fun (s t : subsemiring R) => ∀ {x : R}, x ∈ s → x ∈ t) partial_order.lt sorry sorry sorry

theorem le_def {R : Type u} [semiring R] {s : subsemiring R} {t : subsemiring R} : s ≤ t ↔ ∀ {x : R}, x ∈ s → x ∈ t :=
  iff.rfl

@[simp] theorem coe_subset_coe {R : Type u} [semiring R] {s : subsemiring R} {t : subsemiring R} : ↑s ⊆ ↑t ↔ s ≤ t :=
  iff.rfl

@[simp] theorem coe_ssubset_coe {R : Type u} [semiring R] {s : subsemiring R} {t : subsemiring R} : ↑s ⊂ ↑t ↔ s < t :=
  iff.rfl

@[simp] theorem mem_coe {R : Type u} [semiring R] {S : subsemiring R} {m : R} : m ∈ ↑S ↔ m ∈ S :=
  iff.rfl

@[simp] theorem coe_coe {R : Type u} [semiring R] (s : subsemiring R) : ↥↑s = ↥s :=
  rfl

@[simp] theorem mem_to_submonoid {R : Type u} [semiring R] {s : subsemiring R} {x : R} : x ∈ to_submonoid s ↔ x ∈ s :=
  iff.rfl

@[simp] theorem coe_to_submonoid {R : Type u} [semiring R] (s : subsemiring R) : ↑(to_submonoid s) = ↑s :=
  rfl

@[simp] theorem mem_to_add_submonoid {R : Type u} [semiring R] {s : subsemiring R} {x : R} : x ∈ to_add_submonoid s ↔ x ∈ s :=
  iff.rfl

@[simp] theorem coe_to_add_submonoid {R : Type u} [semiring R] (s : subsemiring R) : ↑(to_add_submonoid s) = ↑s :=
  rfl

/-- The subsemiring `R` of the semiring `R`. -/
protected instance has_top {R : Type u} [semiring R] : has_top (subsemiring R) :=
  has_top.mk (mk (submonoid.carrier ⊤) sorry sorry sorry sorry)

@[simp] theorem mem_top {R : Type u} [semiring R] (x : R) : x ∈ ⊤ :=
  set.mem_univ x

@[simp] theorem coe_top {R : Type u} [semiring R] : ↑⊤ = set.univ :=
  rfl

/-- The preimage of a subsemiring along a ring homomorphism is a subsemiring. -/
def comap {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (s : subsemiring S) : subsemiring R :=
  mk (⇑f ⁻¹' ↑s) sorry sorry sorry sorry

@[simp] theorem coe_comap {R : Type u} {S : Type v} [semiring R] [semiring S] (s : subsemiring S) (f : R →+* S) : ↑(comap f s) = ⇑f ⁻¹' ↑s :=
  rfl

@[simp] theorem mem_comap {R : Type u} {S : Type v} [semiring R] [semiring S] {s : subsemiring S} {f : R →+* S} {x : R} : x ∈ comap f s ↔ coe_fn f x ∈ s :=
  iff.rfl

theorem comap_comap {R : Type u} {S : Type v} {T : Type w} [semiring R] [semiring S] [semiring T] (s : subsemiring T) (g : S →+* T) (f : R →+* S) : comap f (comap g s) = comap (ring_hom.comp g f) s :=
  rfl

/-- The image of a subsemiring along a ring homomorphism is a subsemiring. -/
def map {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (s : subsemiring R) : subsemiring S :=
  mk (⇑f '' ↑s) sorry sorry sorry sorry

@[simp] theorem coe_map {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (s : subsemiring R) : ↑(map f s) = ⇑f '' ↑s :=
  rfl

@[simp] theorem mem_map {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} {s : subsemiring R} {y : S} : y ∈ map f s ↔ ∃ (x : R), ∃ (H : x ∈ s), coe_fn f x = y :=
  set.mem_image_iff_bex

theorem map_map {R : Type u} {S : Type v} {T : Type w} [semiring R] [semiring S] [semiring T] (s : subsemiring R) (g : S →+* T) (f : R →+* S) : map g (map f s) = map (ring_hom.comp g f) s :=
  ext' (set.image_image (fun (a : S) => coe_fn g a) (fun (a : R) => coe_fn f a) ↑s)

theorem map_le_iff_le_comap {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} {s : subsemiring R} {t : subsemiring S} : map f s ≤ t ↔ s ≤ comap f t :=
  set.image_subset_iff

theorem gc_map_comap {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : galois_connection (map f) (comap f) :=
  fun (S_1 : subsemiring R) (T : subsemiring S) => map_le_iff_le_comap

end subsemiring

namespace ring_hom

/-- The range of a ring homomorphism is a subsemiring. -/
def srange {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : subsemiring S :=
  subsemiring.map f ⊤

@[simp] theorem coe_srange {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : ↑(srange f) = set.range ⇑f :=
  set.image_univ

@[simp] theorem mem_srange {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} {y : S} : y ∈ srange f ↔ ∃ (x : R), coe_fn f x = y := sorry

theorem map_srange {R : Type u} {S : Type v} {T : Type w} [semiring R] [semiring S] [semiring T] (g : S →+* T) (f : R →+* S) : subsemiring.map g (srange f) = srange (comp g f) :=
  subsemiring.map_map ⊤ g f

end ring_hom

namespace subsemiring

protected instance has_bot {R : Type u} [semiring R] : has_bot (subsemiring R) :=
  has_bot.mk (ring_hom.srange (nat.cast_ring_hom R))

protected instance inhabited {R : Type u} [semiring R] : Inhabited (subsemiring R) :=
  { default := ⊥ }

theorem coe_bot {R : Type u} [semiring R] : ↑⊥ = set.range coe :=
  ring_hom.coe_srange (nat.cast_ring_hom R)

theorem mem_bot {R : Type u} [semiring R] {x : R} : x ∈ ⊥ ↔ ∃ (n : ℕ), ↑n = x :=
  ring_hom.mem_srange

/-- The inf of two subsemirings is their intersection. -/
protected instance has_inf {R : Type u} [semiring R] : has_inf (subsemiring R) :=
  has_inf.mk fun (s t : subsemiring R) => mk (↑s ∩ ↑t) sorry sorry sorry sorry

@[simp] theorem coe_inf {R : Type u} [semiring R] (p : subsemiring R) (p' : subsemiring R) : ↑(p ⊓ p') = ↑p ∩ ↑p' :=
  rfl

@[simp] theorem mem_inf {R : Type u} [semiring R] {p : subsemiring R} {p' : subsemiring R} {x : R} : x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' :=
  iff.rfl

protected instance has_Inf {R : Type u} [semiring R] : has_Inf (subsemiring R) :=
  has_Inf.mk
    fun (s : set (subsemiring R)) =>
      subsemiring.mk' (set.Inter fun (t : subsemiring R) => set.Inter fun (H : t ∈ s) => ↑t)
        (infi fun (t : subsemiring R) => infi fun (H : t ∈ s) => to_submonoid t) sorry
        (infi fun (t : subsemiring R) => infi fun (H : t ∈ s) => to_add_submonoid t) sorry

@[simp] theorem coe_Inf {R : Type u} [semiring R] (S : set (subsemiring R)) : ↑(Inf S) = set.Inter fun (s : subsemiring R) => set.Inter fun (H : s ∈ S) => ↑s :=
  rfl

theorem mem_Inf {R : Type u} [semiring R] {S : set (subsemiring R)} {x : R} : x ∈ Inf S ↔ ∀ (p : subsemiring R), p ∈ S → x ∈ p :=
  set.mem_bInter_iff

@[simp] theorem Inf_to_submonoid {R : Type u} [semiring R] (s : set (subsemiring R)) : to_submonoid (Inf s) = infi fun (t : subsemiring R) => infi fun (H : t ∈ s) => to_submonoid t :=
  mk'_to_submonoid (has_Inf._proof_1 s) (has_Inf._proof_2 s)

@[simp] theorem Inf_to_add_submonoid {R : Type u} [semiring R] (s : set (subsemiring R)) : to_add_submonoid (Inf s) = infi fun (t : subsemiring R) => infi fun (H : t ∈ s) => to_add_submonoid t :=
  mk'_to_add_submonoid (has_Inf._proof_1 s) (has_Inf._proof_2 s)

/-- Subsemirings of a semiring form a complete lattice. -/
protected instance complete_lattice {R : Type u} [semiring R] : complete_lattice (subsemiring R) :=
  complete_lattice.mk complete_lattice.sup complete_lattice.le complete_lattice.lt sorry sorry sorry sorry sorry sorry
    has_inf.inf sorry sorry sorry ⊤ sorry ⊥ sorry complete_lattice.Sup complete_lattice.Inf sorry sorry sorry sorry

/-- The `subsemiring` generated by a set. -/
def closure {R : Type u} [semiring R] (s : set R) : subsemiring R :=
  Inf (set_of fun (S : subsemiring R) => s ⊆ ↑S)

theorem mem_closure {R : Type u} [semiring R] {x : R} {s : set R} : x ∈ closure s ↔ ∀ (S : subsemiring R), s ⊆ ↑S → x ∈ S :=
  mem_Inf

/-- The subsemiring generated by a set includes the set. -/
@[simp] theorem subset_closure {R : Type u} [semiring R] {s : set R} : s ⊆ ↑(closure s) :=
  fun (x : R) (hx : x ∈ s) => iff.mpr mem_closure fun (S : subsemiring R) (hS : s ⊆ ↑S) => hS hx

/-- A subsemiring `S` includes `closure s` if and only if it includes `s`. -/
@[simp] theorem closure_le {R : Type u} [semiring R] {s : set R} {t : subsemiring R} : closure s ≤ t ↔ s ⊆ ↑t :=
  { mp := set.subset.trans subset_closure, mpr := fun (h : s ⊆ ↑t) => Inf_le h }

/-- Subsemiring closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
theorem closure_mono {R : Type u} [semiring R] {s : set R} {t : set R} (h : s ⊆ t) : closure s ≤ closure t :=
  iff.mpr closure_le (set.subset.trans h subset_closure)

theorem closure_eq_of_le {R : Type u} [semiring R] {s : set R} {t : subsemiring R} (h₁ : s ⊆ ↑t) (h₂ : t ≤ closure s) : closure s = t :=
  le_antisymm (iff.mpr closure_le h₁) h₂

/-- An induction principle for closure membership. If `p` holds for `0`, `1`, and all elements
of `s`, and is preserved under addition and multiplication, then `p` holds for all elements
of the closure of `s`. -/
theorem closure_induction {R : Type u} [semiring R] {s : set R} {p : R → Prop} {x : R} (h : x ∈ closure s) (Hs : ∀ (x : R), x ∈ s → p x) (H0 : p 0) (H1 : p 1) (Hadd : ∀ (x y : R), p x → p y → p (x + y)) (Hmul : ∀ (x y : R), p x → p y → p (x * y)) : p x :=
  iff.mpr closure_le Hs x h

theorem mem_closure_iff {R : Type u} [semiring R] {s : set R} {x : R} : x ∈ closure s ↔ x ∈ add_submonoid.closure ↑(submonoid.closure s) := sorry

theorem mem_closure_iff_exists_list {R : Type u} [semiring R] {s : set R} {x : R} : x ∈ closure s ↔
  ∃ (L : List (List R)), (∀ (t : List R), t ∈ L → ∀ (y : R), y ∈ t → y ∈ s) ∧ list.sum (list.map list.prod L) = x := sorry

/-- `closure` forms a Galois insertion with the coercion to set. -/
protected def gi (R : Type u) [semiring R] : galois_insertion closure coe :=
  galois_insertion.mk (fun (s : set R) (_x : ↑(closure s) ≤ s) => closure s) sorry sorry sorry

/-- Closure of a subsemiring `S` equals `S`. -/
theorem closure_eq {R : Type u} [semiring R] (s : subsemiring R) : closure ↑s = s :=
  galois_insertion.l_u_eq (subsemiring.gi R) s

@[simp] theorem closure_empty {R : Type u} [semiring R] : closure ∅ = ⊥ :=
  galois_connection.l_bot (galois_insertion.gc (subsemiring.gi R))

@[simp] theorem closure_univ {R : Type u} [semiring R] : closure set.univ = ⊤ :=
  coe_top ▸ closure_eq ⊤

theorem closure_union {R : Type u} [semiring R] (s : set R) (t : set R) : closure (s ∪ t) = closure s ⊔ closure t :=
  galois_connection.l_sup (galois_insertion.gc (subsemiring.gi R))

theorem closure_Union {R : Type u} [semiring R] {ι : Sort u_1} (s : ι → set R) : closure (set.Union fun (i : ι) => s i) = supr fun (i : ι) => closure (s i) :=
  galois_connection.l_supr (galois_insertion.gc (subsemiring.gi R))

theorem closure_sUnion {R : Type u} [semiring R] (s : set (set R)) : closure (⋃₀s) = supr fun (t : set R) => supr fun (H : t ∈ s) => closure t :=
  galois_connection.l_Sup (galois_insertion.gc (subsemiring.gi R))

theorem map_sup {R : Type u} {S : Type v} [semiring R] [semiring S] (s : subsemiring R) (t : subsemiring R) (f : R →+* S) : map f (s ⊔ t) = map f s ⊔ map f t :=
  galois_connection.l_sup (gc_map_comap f)

theorem map_supr {R : Type u} {S : Type v} [semiring R] [semiring S] {ι : Sort u_1} (f : R →+* S) (s : ι → subsemiring R) : map f (supr s) = supr fun (i : ι) => map f (s i) :=
  galois_connection.l_supr (gc_map_comap f)

theorem comap_inf {R : Type u} {S : Type v} [semiring R] [semiring S] (s : subsemiring S) (t : subsemiring S) (f : R →+* S) : comap f (s ⊓ t) = comap f s ⊓ comap f t :=
  galois_connection.u_inf (gc_map_comap f)

theorem comap_infi {R : Type u} {S : Type v} [semiring R] [semiring S] {ι : Sort u_1} (f : R →+* S) (s : ι → subsemiring S) : comap f (infi s) = infi fun (i : ι) => comap f (s i) :=
  galois_connection.u_infi (gc_map_comap f)

@[simp] theorem map_bot {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : map f ⊥ = ⊥ :=
  galois_connection.l_bot (gc_map_comap f)

@[simp] theorem comap_top {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : comap f ⊤ = ⊤ :=
  galois_connection.u_top (gc_map_comap f)

/-- Given `subsemiring`s `s`, `t` of semirings `R`, `S` respectively, `s.prod t` is `s × t`
as a subsemiring of `R × S`. -/
def prod {R : Type u} {S : Type v} [semiring R] [semiring S] (s : subsemiring R) (t : subsemiring S) : subsemiring (R × S) :=
  mk (set.prod ↑s ↑t) sorry sorry sorry sorry

theorem coe_prod {R : Type u} {S : Type v} [semiring R] [semiring S] (s : subsemiring R) (t : subsemiring S) : ↑(prod s t) = set.prod ↑s ↑t :=
  rfl

theorem mem_prod {R : Type u} {S : Type v} [semiring R] [semiring S] {s : subsemiring R} {t : subsemiring S} {p : R × S} : p ∈ prod s t ↔ prod.fst p ∈ s ∧ prod.snd p ∈ t :=
  iff.rfl

theorem prod_mono {R : Type u} {S : Type v} [semiring R] [semiring S] {s₁ : subsemiring R} {s₂ : subsemiring R} (hs : s₁ ≤ s₂) {t₁ : subsemiring S} {t₂ : subsemiring S} (ht : t₁ ≤ t₂) : prod s₁ t₁ ≤ prod s₂ t₂ :=
  set.prod_mono hs ht

theorem prod_mono_right {R : Type u} {S : Type v} [semiring R] [semiring S] (s : subsemiring R) : monotone fun (t : subsemiring S) => prod s t :=
  prod_mono (le_refl s)

theorem prod_mono_left {R : Type u} {S : Type v} [semiring R] [semiring S] (t : subsemiring S) : monotone fun (s : subsemiring R) => prod s t :=
  fun (s₁ s₂ : subsemiring R) (hs : s₁ ≤ s₂) => prod_mono hs (le_refl t)

theorem prod_top {R : Type u} {S : Type v} [semiring R] [semiring S] (s : subsemiring R) : prod s ⊤ = comap (ring_hom.fst R S) s := sorry

theorem top_prod {R : Type u} {S : Type v} [semiring R] [semiring S] (s : subsemiring S) : prod ⊤ s = comap (ring_hom.snd R S) s := sorry

@[simp] theorem top_prod_top {R : Type u} {S : Type v} [semiring R] [semiring S] : prod ⊤ ⊤ = ⊤ :=
  Eq.trans (top_prod ⊤) (comap_top (ring_hom.snd R S))

/-- Product of subsemirings is isomorphic to their product as monoids. -/
def prod_equiv {R : Type u} {S : Type v} [semiring R] [semiring S] (s : subsemiring R) (t : subsemiring S) : ↥(prod s t) ≃+* ↥s × ↥t :=
  ring_equiv.mk (equiv.to_fun (equiv.set.prod ↑s ↑t)) (equiv.inv_fun (equiv.set.prod ↑s ↑t)) sorry sorry sorry sorry

theorem mem_supr_of_directed {R : Type u} [semiring R] {ι : Sort u_1} [hι : Nonempty ι] {S : ι → subsemiring R} (hS : directed LessEq S) {x : R} : (x ∈ supr fun (i : ι) => S i) ↔ ∃ (i : ι), x ∈ S i := sorry

theorem coe_supr_of_directed {R : Type u} [semiring R] {ι : Sort u_1} [hι : Nonempty ι] {S : ι → subsemiring R} (hS : directed LessEq S) : ↑(supr fun (i : ι) => S i) = set.Union fun (i : ι) => ↑(S i) := sorry

theorem mem_Sup_of_directed_on {R : Type u} [semiring R] {S : set (subsemiring R)} (Sne : set.nonempty S) (hS : directed_on LessEq S) {x : R} : x ∈ Sup S ↔ ∃ (s : subsemiring R), ∃ (H : s ∈ S), x ∈ s := sorry

theorem coe_Sup_of_directed_on {R : Type u} [semiring R] {S : set (subsemiring R)} (Sne : set.nonempty S) (hS : directed_on LessEq S) : ↑(Sup S) = set.Union fun (s : subsemiring R) => set.Union fun (H : s ∈ S) => ↑s := sorry

end subsemiring

namespace ring_hom

/-- Restriction of a ring homomorphism to a subsemiring of the domain. -/
def srestrict {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (s : subsemiring R) : ↥s →+* S :=
  comp f (subsemiring.subtype s)

@[simp] theorem srestrict_apply {R : Type u} {S : Type v} [semiring R] [semiring S] {s : subsemiring R} (f : R →+* S) (x : ↥s) : coe_fn (srestrict f s) x = coe_fn f ↑x :=
  rfl

/-- Restriction of a ring homomorphism to a subsemiring of the codomain. -/
def cod_srestrict {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (s : subsemiring S) (h : ∀ (x : R), coe_fn f x ∈ s) : R →+* ↥s :=
  mk (fun (n : R) => { val := coe_fn f n, property := h n }) sorry sorry sorry sorry

/-- Restriction of a ring homomorphism to its range iterpreted as a subsemiring. -/
def srange_restrict {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) : R →+* ↥(srange f) :=
  cod_srestrict f (srange f) sorry

@[simp] theorem coe_srange_restrict {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (x : R) : ↑(coe_fn (srange_restrict f) x) = coe_fn f x :=
  rfl

theorem srange_top_iff_surjective {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} : srange f = ⊤ ↔ function.surjective ⇑f := sorry

/-- The range of a surjective ring homomorphism is the whole of the codomain. -/
theorem srange_top_of_surjective {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (hf : function.surjective ⇑f) : srange f = ⊤ :=
  iff.mpr srange_top_iff_surjective hf

/-- The subsemiring of elements `x : R` such that `f x = g x` -/
def eq_slocus {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (g : R →+* S) : subsemiring R :=
  subsemiring.mk (set_of fun (x : R) => coe_fn f x = coe_fn g x) sorry sorry sorry sorry

/-- If two ring homomorphisms are equal on a set, then they are equal on its subsemiring closure. -/
theorem eq_on_sclosure {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} {g : R →+* S} {s : set R} (h : set.eq_on (⇑f) (⇑g) s) : set.eq_on ⇑f ⇑g ↑(subsemiring.closure s) :=
  (fun (this : subsemiring.closure s ≤ eq_slocus f g) => this) (iff.mpr subsemiring.closure_le h)

theorem eq_of_eq_on_stop {R : Type u} {S : Type v} [semiring R] [semiring S] {f : R →+* S} {g : R →+* S} (h : set.eq_on ⇑f ⇑g ↑⊤) : f = g :=
  ext fun (x : R) => h trivial

theorem eq_of_eq_on_sdense {R : Type u} {S : Type v} [semiring R] [semiring S] {s : set R} (hs : subsemiring.closure s = ⊤) {f : R →+* S} {g : R →+* S} (h : set.eq_on (⇑f) (⇑g) s) : f = g :=
  eq_of_eq_on_stop (hs ▸ eq_on_sclosure h)

theorem sclosure_preimage_le {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (s : set S) : subsemiring.closure (⇑f ⁻¹' s) ≤ subsemiring.comap f (subsemiring.closure s) :=
  iff.mpr subsemiring.closure_le
    fun (x : R) (hx : x ∈ ⇑f ⁻¹' s) =>
      iff.mpr subsemiring.mem_coe (iff.mpr subsemiring.mem_comap (subsemiring.subset_closure hx))

/-- The image under a ring homomorphism of the subsemiring generated by a set equals
the subsemiring generated by the image of the set. -/
theorem map_sclosure {R : Type u} {S : Type v} [semiring R] [semiring S] (f : R →+* S) (s : set R) : subsemiring.map f (subsemiring.closure s) = subsemiring.closure (⇑f '' s) := sorry

end ring_hom

namespace subsemiring

/-- The ring homomorphism associated to an inclusion of subsemirings. -/
def inclusion {R : Type u} [semiring R] {S : subsemiring R} {T : subsemiring R} (h : S ≤ T) : ↥S →* ↥T :=
  ↑(ring_hom.cod_srestrict (subtype S) T sorry)

@[simp] theorem srange_subtype {R : Type u} [semiring R] (s : subsemiring R) : ring_hom.srange (subtype s) = s :=
  ext' (Eq.trans (ring_hom.coe_srange (subtype s)) subtype.range_coe)

@[simp] theorem range_fst {R : Type u} {S : Type v} [semiring R] [semiring S] : ring_hom.srange (ring_hom.fst R S) = ⊤ :=
  ring_hom.srange_top_of_surjective (ring_hom.fst R S) prod.fst_surjective

@[simp] theorem range_snd {R : Type u} {S : Type v} [semiring R] [semiring S] : ring_hom.srange (ring_hom.snd R S) = ⊤ :=
  ring_hom.srange_top_of_surjective (ring_hom.snd R S) prod.snd_surjective

@[simp] theorem prod_bot_sup_bot_prod {R : Type u} {S : Type v} [semiring R] [semiring S] (s : subsemiring R) (t : subsemiring S) : prod s ⊥ ⊔ prod ⊥ t = prod s t := sorry

end subsemiring

namespace ring_equiv

/-- Makes the identity isomorphism from a proof two subsemirings of a multiplicative
    monoid are equal. -/
def subsemiring_congr {R : Type u} [semiring R] {s : subsemiring R} {t : subsemiring R} (h : s = t) : ↥s ≃+* ↥t :=
  mk (equiv.to_fun (equiv.set_congr sorry)) (equiv.inv_fun (equiv.set_congr sorry)) sorry sorry sorry sorry


import .fincard

open_locale big_operators classical

universes u v w

-- this file contains versions of the finsum lemma that require finiteness assumptions, where the finiteness
-- comes from [fintype α] instances. To disambiguate, they are all in the 'fin' namespace

namespace fin

variables {α : Type*} {β : Type*} [fintype α] {M: Type*} {f g : α → M} {s t : set α} {a b : α}

lemma finsum_le_finsum [ordered_add_comm_monoid M] (hfg : ∀ x, f x ≤ g x) :
  ∑ᶠ (i : α), f i ≤ ∑ᶠ (i : α), g i :=
by {apply finsum_le_finsum hfg; {apply set.finite.of_fintype}}

lemma finsum_in_le_finsum_in [ordered_add_comm_monoid M] (hfg : ∀ x ∈ s, f x ≤ g x) :
  ∑ᶠ i in s, f i ≤ ∑ᶠ i in s, g i  :=
by {apply finsum_in_le_finsum_in _ hfg, apply set.finite.of_fintype}

@[simp] lemma finsum_in_eq_zero_iff [canonically_ordered_add_monoid M]:
  ∑ᶠ x in s, f x = 0 ↔ ∀ x ∈ s, f x = 0 :=
by {apply finsum_in_eq_zero_iff, apply set.finite.of_fintype}

@[simp] lemma finsum_eq_zero_iff [canonically_ordered_add_monoid M]:
  ∑ᶠ x, f x = 0 ↔ ∀ x, f x = 0 :=
by {apply finsum_eq_zero_iff, apply set.finite.of_fintype}

lemma finsum_in_eq_zero_iff_of_nonneg [ordered_add_comm_monoid M] (hf : ∀ x ∈ s, 0 ≤ f x) :
  ∑ᶠ x in s, f x = 0 ↔ ∀ x ∈ s, f x = 0 :=
by {apply finsum_in_eq_zero_iff_of_nonneg _ hf, apply set.finite.of_fintype}

lemma finsum_eq_zero_iff_of_nonneg [ordered_add_comm_monoid M] (hf : ∀ x, 0 ≤ f x) :
  ∑ᶠ x, f x = 0 ↔ ∀ x, f x = 0 :=
by {apply finsum_eq_zero_iff_of_nonneg _ hf, apply set.finite.of_fintype}

@[simp] lemma fincard_eq_zero_iff_empty {s : set α} :
  fincard s = 0 ↔ s = ∅ :=
by {apply fincard_eq_zero_iff_empty, apply set.finite.of_fintype}

lemma finsum_in_insert [add_comm_monoid M] (f : α → M) (h : a ∉ s) :
  ∑ᶠ i in insert a s, f i = f a + ∑ᶠ i in s, f i :=
by {apply finsum_in_insert' _ h, apply set.finite.of_fintype}

lemma finsum_in_add_distrib [add_comm_monoid M] (f g : α → M) (s : set α) :
  ∑ᶠ i in s, (f + g) i = ∑ᶠ i in s, f i + ∑ᶠ i in s, g i :=
by {apply finsum_in_add_distrib, apply set.finite.of_fintype}

lemma finsum_add_distrib [add_comm_group M] (f g : α → M) :
  ∑ᶠ i, (f + g) i = ∑ᶠ i, f i + ∑ᶠ i, g i :=
by {apply finsum_add_distrib; apply set.finite.of_fintype}

lemma finsum_in_sub_distrib [add_comm_group M] (f g : α → M) (s : set α) :
  ∑ᶠ i in s, (f - g) i = ∑ᶠ i in s, f i - ∑ᶠ i in s, g i :=
by {apply finsum_in_sub_distrib, apply set.finite.of_fintype}

lemma finsum_sub_distrib [add_comm_group M] (f g : α → M) :
  ∑ᶠ i, (f - g) i = ∑ᶠ i, f i - ∑ᶠ i, g i :=
by {apply finsum_sub_distrib; apply set.finite.of_fintype}

lemma sum_fincard_fiber_eq_fincard (s : set α) (f : α → β) :
  ∑ᶠ (b : β), fincard {a ∈ s | f a = b} = fincard s :=
by {exact sum_fincard_fiber_eq_fincard _ (set.finite.of_fintype _),}

lemma finsum_in_exists_lt_of_finsum_lt [linear_ordered_cancel_add_comm_monoid M]
(hlt : ∑ᶠ x in s, f x < ∑ᶠ x in s, g x) :
  ∃ i ∈ s, f i < g i :=
by {apply finsum_in_exists_lt_of_finsum_lt _ hlt;
    apply set.finite.of_fintype, }

lemma finsum_exists_lt_of_finsum_lt [linear_ordered_cancel_add_comm_monoid M]
(hlt : ∑ᶠ x, f x < ∑ᶠ x, g x) :
  ∃ i, f i < g i :=
by {apply finsum_exists_lt_of_finsum_lt _ _ hlt;
    apply set.finite.of_fintype, }

lemma finsum_in_lt_finsum_in [ordered_cancel_add_comm_monoid M]
(hle : ∀ i ∈ s, f i ≤ g i) (hlt : ∃ i ∈ s, f i < g i) :
  ∑ᶠ i in s, f i < ∑ᶠ i in s, g i :=
by {apply finsum_in_lt_finsum_in _ hle hlt;
    apply (set.finite.of_fintype _); apply_instance, }

lemma finsum_lt_finsum [ordered_cancel_add_comm_monoid M]
(hle : ∀ i, f i ≤ g i) (hlt : ∃ i, f i < g i) :
  ∑ᶠ i, f i < ∑ᶠ i, g i :=
by {apply finsum_lt_finsum _ _ hle hlt;
    apply (set.finite.of_fintype _); apply_instance, }

lemma finsum_in_eq_finsum_in_iff_of_le [ordered_cancel_add_comm_monoid M]
(hfg : ∀ x ∈ s, f x ≤ g x) :
  ∑ᶠ i in s, f i = ∑ᶠ i in s, g i ↔ ∀ i ∈ s, f i = g i :=
by {apply finsum_in_eq_finsum_in_iff_of_le _ hfg;
    apply set.finite.of_fintype, }

lemma finsum_eq_finsum_iff_of_le [ordered_cancel_add_comm_monoid M]
(hfg : ∀ x, f x ≤ g x) :
  ∑ᶠ i, f i = ∑ᶠ i, g i ↔ ∀ i, f i = g i :=
by {apply finsum_eq_finsum_iff_of_le _ _ hfg;
    apply set.finite.of_fintype, }

lemma finsum_in_sUnion [add_comm_monoid M] {t : set (set α)}
(h : set.pairwise_disjoint t) :
  ∑ᶠ i in (⋃₀ t), f i = ∑ᶠ s in t, (∑ᶠ i in s, f i) :=
finsum_in_sUnion (set.finite.of_fintype _) (λ _, set.finite.of_fintype _) h

lemma finsum_in_Union [fintype β] [add_comm_monoid M] {t : β → set α}
  (h : ∀ x y, x ≠ y → disjoint (t x) (t y)) :
  ∑ᶠ i in (⋃ x : β, t x), f i = ∑ᶠ i, (∑ᶠ j in (t i), f j) :=
finsum_in_Union (λ _ ,set.finite.of_fintype _) h

lemma eq_zero_of_finsum_in_subset_eq_finsum_in_of_nonneg [ordered_cancel_add_comm_monoid M]
(hst : s ⊆ t) (hf : ∀ x ∈ t, 0 ≤ f x) (h : ∑ᶠ x in t, f x ≤ ∑ᶠ x in s, f x) :
  ∀ x ∈ t \ s, f x = 0 :=
begin
  apply eq_zero_of_finsum_in_subset_eq_finsum_in_of_nonneg _ hst hf h,
  apply set.finite.of_fintype,
end

end fin


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fintype.basic
import data.equiv.encodable.basic
import data.list.min_max

/-!
# Denumerable types

This file defines denumerable (countably infinite) types as a typeclass extending `encodable`. This
is used to provide explicit encode/decode functions from and to `ℕ`, with the information that those
functions are inverses of each other.

## Implementation notes

This property already has a name, namely `α ≃ ℕ`, but here we are interested in using it as a
typeclass.
-/

/-- A denumerable type is (constructively) bijective with `ℕ`. Typeclass equivalent of `α ≃ ℕ`. -/
class denumerable (α : Type*) extends encodable α :=
(decode_inv : ∀ n, ∃ a ∈ decode n, encode a = n)

open nat

namespace denumerable

section
variables {α : Type*} {β : Type*} [denumerable α] [denumerable β]
open encodable

theorem decode_is_some (α) [denumerable α] (n : ℕ) :
  (decode α n).is_some :=
option.is_some_iff_exists.2 $
(decode_inv n).imp $ λ a, Exists.fst

/-- Returns the `n`-th element of `α` indexed by the decoding. -/
def of_nat (α) [f : denumerable α] (n : ℕ) : α :=
option.get (decode_is_some α n)

@[simp, priority 900]
theorem decode_eq_of_nat (α) [denumerable α] (n : ℕ) :
  decode α n = some (of_nat α n) :=
option.eq_some_of_is_some _

@[simp] theorem of_nat_of_decode {n b}
  (h : decode α n = some b) : of_nat α n = b :=
option.some.inj $ (decode_eq_of_nat _ _).symm.trans h

@[simp] theorem encode_of_nat (n) : encode (of_nat α n) = n :=
let ⟨a, h, e⟩ := decode_inv n in
by rwa [of_nat_of_decode h]

@[simp] theorem of_nat_encode (a) : of_nat α (encode a) = a :=
of_nat_of_decode (encodek _)

/-- A denumerable type is equivalent to `ℕ`. -/
def eqv (α) [denumerable α] : α ≃ ℕ :=
⟨encode, of_nat α, of_nat_encode, encode_of_nat⟩

@[priority 100] -- See Note [lower instance priority]
instance : infinite α := infinite.of_surjective _ (eqv α).surjective

/-- A type equivalent to `ℕ` is denumerable. -/
def mk' {α} (e : α ≃ ℕ) : denumerable α :=
{ encode := e,
  decode := some ∘ e.symm,
  encodek := λ a, congr_arg some (e.symm_apply_apply _),
  decode_inv := λ n, ⟨_, rfl, e.apply_symm_apply _⟩ }

/-- Denumerability is conserved by equivalences. This is transitivity of equivalence the denumerable
way. -/
def of_equiv (α) {β} [denumerable α] (e : β ≃ α) : denumerable β :=
{ decode_inv := λ n, by simp,
  ..encodable.of_equiv _ e }

@[simp] theorem of_equiv_of_nat (α) {β} [denumerable α] (e : β ≃ α)
  (n) : @of_nat β (of_equiv _ e) n = e.symm (of_nat α n) :=
by apply of_nat_of_decode; show option.map _ _ = _; simp

/-- All denumerable types are equivalent. -/
def equiv₂ (α β) [denumerable α] [denumerable β] : α ≃ β := (eqv α).trans (eqv β).symm

instance nat : denumerable ℕ := ⟨λ n, ⟨_, rfl, rfl⟩⟩

@[simp] theorem of_nat_nat (n) : of_nat ℕ n = n := rfl

/-- If `α` is denumerable, then so is `option α`. -/
instance option : denumerable (option α) := ⟨λ n, begin
  cases n,
  { refine ⟨none, _, encode_none⟩,
    rw [decode_option_zero, option.mem_def] },
  refine ⟨some (of_nat α n), _, _⟩,
  { rw [decode_option_succ, decode_eq_of_nat, option.map_some', option.mem_def] },
  rw [encode_some, encode_of_nat],
end⟩

/-- If `α` and `β` are denumerable, then so is their sum. -/
instance sum : denumerable (α ⊕ β) :=
⟨λ n, begin
  suffices : ∃ a ∈ @decode_sum α β _ _ n,
    encode_sum a = bit (bodd n) (div2 n), {simpa [bit_decomp]},
  simp [decode_sum]; cases bodd n; simp [decode_sum, bit, encode_sum]
end⟩

section sigma
variables {γ : α → Type*} [∀ a, denumerable (γ a)]

/-- A denumerable collection of denumerable types is denumerable. -/
instance sigma : denumerable (sigma γ) :=
⟨λ n, by simp [decode_sigma]; exact ⟨_, _, ⟨rfl, heq.rfl⟩, by simp⟩⟩

@[simp] theorem sigma_of_nat_val (n : ℕ) :
  of_nat (sigma γ) n = ⟨of_nat α (unpair n).1, of_nat (γ _) (unpair n).2⟩ :=
option.some.inj $
by rw [← decode_eq_of_nat, decode_sigma_val]; simp; refl

end sigma

/-- If `α` and `β` are denumerable, then so is their product. -/
instance prod : denumerable (α × β) :=
of_equiv _ (equiv.sigma_equiv_prod α β).symm

@[simp] theorem prod_of_nat_val (n : ℕ) :
  of_nat (α × β) n = (of_nat α (unpair n).1, of_nat β (unpair n).2) :=
by simp; refl

@[simp] theorem prod_nat_of_nat : of_nat (ℕ × ℕ) = unpair :=
by funext; simp

instance int : denumerable ℤ := denumerable.mk' equiv.int_equiv_nat

instance pnat : denumerable ℕ+ := denumerable.mk' equiv.pnat_equiv_nat

/-- The lift of a denumerable type is denumerable. -/
instance ulift : denumerable (ulift α) := of_equiv _ equiv.ulift

/-- The lift of a denumerable type is denumerable. -/
instance plift : denumerable (plift α) := of_equiv _ equiv.plift

/-- If `α` is denumerable, then `α × α` and `α` are equivalent. -/
def pair : α × α ≃ α := equiv₂ _ _

end
end denumerable

namespace nat.subtype
open function encodable

/-! ### Subsets of `ℕ` -/

variables {s : set ℕ} [infinite s]

section classical
open_locale classical

lemma exists_succ (x : s) : ∃ n, ↑x + n + 1 ∈ s :=
classical.by_contradiction $ λ h,
have ∀ (a : ℕ) (ha : a ∈ s), a < succ x,
  from λ a ha, lt_of_not_ge (λ hax, h ⟨a - (x + 1),
    by rwa [add_right_comm, add_tsub_cancel_of_le hax]⟩),
fintype.false
  ⟨(((multiset.range (succ x)).filter (∈ s)).pmap
      (λ (y : ℕ) (hy : y ∈ s), subtype.mk y hy)
      (by simp [-multiset.range_succ])).to_finset,
    by simpa [subtype.ext_iff_val, multiset.mem_filter, -multiset.range_succ]⟩

end classical

variable [decidable_pred (∈ s)]

/-- Returns the next natural in a set, according to the usual ordering of `ℕ`. -/
def succ (x : s) : s :=
have h : ∃ m, ↑x + m + 1 ∈ s, from exists_succ x,
⟨↑x + nat.find h + 1, nat.find_spec h⟩

lemma succ_le_of_lt {x y : s} (h : y < x) : succ y ≤ x :=
have hx : ∃ m, ↑y + m + 1 ∈ s, from exists_succ _,
let ⟨k, hk⟩ := nat.exists_eq_add_of_lt h in
have nat.find hx ≤ k, from nat.find_min' _ (hk ▸ x.2),
show (y : ℕ) + nat.find hx + 1 ≤ x,
by rw hk; exact add_le_add_right (add_le_add_left this _) _

lemma le_succ_of_forall_lt_le {x y : s} (h : ∀ z < x, z ≤ y) : x ≤ succ y :=
have hx : ∃ m, ↑y + m + 1 ∈ s, from exists_succ _,
show ↑x ≤ ↑y + nat.find hx + 1,
from le_of_not_gt $ λ hxy,
(h ⟨_, nat.find_spec hx⟩ hxy).not_lt $
  calc ↑y ≤ ↑y + nat.find hx : le_add_of_nonneg_right (nat.zero_le _)
  ... < ↑y + nat.find hx + 1 : nat.lt_succ_self _

lemma lt_succ_self (x : s) : x < succ x :=
calc (x : ℕ) ≤ x + _ : le_self_add
... < succ x : nat.lt_succ_self (x + _)

lemma lt_succ_iff_le {x y : s} : x < succ y ↔ x ≤ y :=
⟨λ h, le_of_not_gt (λ h', not_le_of_gt h (succ_le_of_lt h')),
  λ h, lt_of_le_of_lt h (lt_succ_self _)⟩

/-- Returns the `n`-th element of a set, according to the usual ordering of `ℕ`. -/
def of_nat (s : set ℕ) [decidable_pred (∈ s)] [infinite s] : ℕ → s
| 0     := ⊥
| (n+1) := succ (of_nat n)

lemma of_nat_surjective_aux : ∀ {x : ℕ} (hx : x ∈ s), ∃ n, of_nat s n = ⟨x, hx⟩
| x := λ hx, let t : list s := ((list.range x).filter (λ y, y ∈ s)).pmap
  (λ (y : ℕ) (hy : y ∈ s), ⟨y, hy⟩) (by simp) in
have hmt : ∀ {y : s}, y ∈ t ↔ y < ⟨x, hx⟩,
  by simp [list.mem_filter, subtype.ext_iff_val, t]; intros; refl,
have wf : ∀ m : s, list.maximum t = m → ↑m < x,
  from λ m hmax, by simpa [hmt] using list.maximum_mem hmax,
begin
  cases hmax : list.maximum t with m,
  { exact ⟨0, le_antisymm bot_le
      (le_of_not_gt (λ h, list.not_mem_nil (⊥ : s) $
        by rw [← list.maximum_eq_none.1 hmax, hmt]; exact h))⟩ },
  cases of_nat_surjective_aux m.2 with a ha,
  exact ⟨a + 1, le_antisymm
    (by rw of_nat; exact succ_le_of_lt (by rw ha; exact wf _ hmax)) $
    by rw of_nat; exact le_succ_of_forall_lt_le
      (λ z hz, by rw ha; cases m; exact list.le_maximum_of_mem (hmt.2 hz) hmax)⟩
end
using_well_founded {dec_tac := `[tauto]}

lemma of_nat_surjective : surjective (of_nat s) :=
λ ⟨x, hx⟩, of_nat_surjective_aux hx

private def to_fun_aux (x : s) : ℕ :=
(list.range x).countp (∈ s)

private lemma to_fun_aux_eq (x : s) :
  to_fun_aux x = ((finset.range x).filter (∈ s)).card :=
by rw [to_fun_aux, list.countp_eq_length_filter]; refl

open finset

private lemma right_inverse_aux : ∀ n, to_fun_aux (of_nat s n) = n
| 0 := begin
  rw [to_fun_aux_eq, card_eq_zero, eq_empty_iff_forall_not_mem],
  rintro n hn,
  rw [mem_filter, of_nat, mem_range] at hn,
  exact bot_le.not_lt (show (⟨n, hn.2⟩ : s) < ⊥, from hn.1),
end
| (n+1) := have ih : to_fun_aux (of_nat s n) = n, from right_inverse_aux n,
have h₁ : (of_nat s n : ℕ) ∉ (range (of_nat s n)).filter (∈ s), by simp,
have h₂ : (range (succ (of_nat s n))).filter (∈ s) =
  insert (of_nat s n) ((range (of_nat s n)).filter (∈ s)),
  begin
    simp only [finset.ext_iff, mem_insert, mem_range, mem_filter],
    exact λ m, ⟨λ h, by simp only [h.2, and_true]; exact or.symm
        (lt_or_eq_of_le ((@lt_succ_iff_le _ _ _ ⟨m, h.2⟩ _).1 h.1)),
      λ h, h.elim (λ h, h.symm ▸ ⟨lt_succ_self _, (of_nat s n).prop⟩)
        (λ h, ⟨h.1.trans (lt_succ_self _), h.2⟩)⟩,
  end,
begin
  simp only [to_fun_aux_eq, of_nat, range_succ] at ⊢ ih,
  conv {to_rhs, rw [← ih, ← card_insert_of_not_mem h₁, ← h₂] },
end

/-- Any infinite set of naturals is denumerable. -/
def denumerable (s : set ℕ) [decidable_pred (∈ s)] [infinite s] : denumerable s :=
denumerable.of_equiv ℕ
{ to_fun := to_fun_aux,
  inv_fun := of_nat s,
  left_inv := left_inverse_of_surjective_of_right_inverse of_nat_surjective right_inverse_aux,
  right_inv := right_inverse_aux }

end nat.subtype

namespace denumerable
open encodable

/-- An infinite encodable type is denumerable. -/
def of_encodable_of_infinite (α : Type*) [encodable α] [infinite α] : denumerable α :=
begin
  letI := @decidable_range_encode α _;
  letI : infinite (set.range (@encode α _)) :=
    infinite.of_injective _ (equiv.of_injective _ encode_injective).injective,
  letI := nat.subtype.denumerable (set.range (@encode α _)),
  exact denumerable.of_equiv (set.range (@encode α _)) (equiv_range_encode α),
end

end denumerable