/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import data.real.basic

/-!
# IMO 2005 Q3
Let `x`, `y` and `z` be positive real numbers such that `xyz ≥ 1`. Prove that:
`(x^5 - x^2)/(x^5 + y^2 + z^2) + (y^5 - y^2)/(y^5 + z^2 + x^2) + (z^5 - z^2)/(z^5 + x^2 + y^2) ≥ 0`

# Solution
The solution by Iurie Boreico from Moldova is presented, which won a special prize during the exam.
The key insight is that `(x^5-x^2)/(x^5+y^2+z^2) ≥ (x^2-y*z)/(x^2+y^2+z^2)`, which is proven by
factoring `(x^5-x^2)/(x^5+y^2+z^2) - (x^5-x^2)/(x^3*(x^2+y^2+z^2))` into a non-negative expression
and then making use of `xyz ≥ 1` to show `(x^5-x^2)/(x^3*(x^2+y^2+z^2)) ≥ (x^2-y*z)/(x^2+y^2+z^2)`.
-/

lemma key_insight (x y z : ℝ) (hx : x > 0) (hy : y > 0) (hz : z > 0) (h : x*y*z ≥ 1) :
  (x^5-x^2)/(x^5+y^2+z^2) ≥ (x^2-y*z)/(x^2+y^2+z^2) :=
begin
  have h₁ : x^5+y^2+z^2 > 0, linarith [pow_pos hx 5, pow_pos hy 2, pow_pos hz 2],
  have h₂ : x^3 > 0, exact pow_pos hx 3,
  have h₃ : x^2+y^2+z^2 > 0, linarith [pow_pos hx 2, pow_pos hy 2, pow_pos hz 2],
  have h₄ : x^3*(x^2+y^2+z^2) > 0, exact mul_pos h₂ h₃,

  have key : (x^5-x^2)/(x^5+y^2+z^2) - (x^5-x^2)/(x^3*(x^2+y^2+z^2))
           = ((x^3 - 1)^2*x^2*(y^2 + z^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))),
  calc  (x^5-x^2)/(x^5+y^2+z^2) - (x^5-x^2)/(x^3*(x^2+y^2+z^2))
      = ((x^5-x^2)*(x^3*(x^2+y^2+z^2))-(x^5+y^2+z^2)*(x^5-x^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))):
        by exact div_sub_div _ _ (ne_of_gt h₁) (ne_of_gt h₄)    -- a/b - c/d = (a*d-b*c)/(b*d)
  ... = ((x^3 - 1)^2*x^2*(y^2 + z^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))) :
        by ring,

  have h₅ : ((x^3 - 1)^2*x^2*(y^2 + z^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))) ≥ 0,
  { refine div_nonneg _ _,
    refine mul_nonneg (mul_nonneg (sq_nonneg _) (sq_nonneg _)) _,
    exact add_nonneg (sq_nonneg _) (sq_nonneg _),
    exact le_of_lt (mul_pos h₁ h₄) },

  calc  (x^5-x^2)/(x^5+y^2+z^2)
      ≥ (x^5-x^2)/(x^3*(x^2+y^2+z^2)) : by linarith [key, h₅]
  ... ≥ (x^5-x^2*(x*y*z))/(x^3*(x^2+y^2+z^2)) :
        by { refine (div_le_div_right h₄).mpr _, simp,
             exact (le_mul_iff_one_le_right (pow_pos hx 2)).mpr h }
  ... = (x^2-y*z)/(x^2+y^2+z^2) :
        by { field_simp [ne_of_gt h₂, ne_of_gt h₃], ring },
end

theorem imo2005_q3 (x y z : ℝ) (hx : x > 0) (hy : y > 0) (hz : z > 0) (h : x*y*z ≥ 1) :
  (x^5-x^2)/(x^5+y^2+z^2) + (y^5-y^2)/(y^5+z^2+x^2) + (z^5-z^2)/(z^5+x^2+y^2) ≥ 0 :=
begin
  calc  (x^5-x^2)/(x^5+y^2+z^2) + (y^5-y^2)/(y^5+z^2+x^2) + (z^5-z^2)/(z^5+x^2+y^2)
      ≥ (x^2-y*z)/(x^2+y^2+z^2) + (y^2-z*x)/(y^2+z^2+x^2) + (z^2-x*y)/(z^2+x^2+y^2) :
        by { linarith [key_insight x y z hx hy hz h,
                       key_insight y z x hy hz hx (by linarith [h]),
                       key_insight z x y hz hx hy (by linarith [h])] }
  ... = (x^2 + y^2 + z^2 - y*z - z*x - x*y) / (x^2+y^2+z^2) :
        by { have h₁ : y^2+z^2+x^2 = x^2+y^2+z^2, linarith,
             have h₂ : z^2+x^2+y^2 = x^2+y^2+z^2, linarith,
             rw [h₁, h₂], ring }
  ... = 1/2*( (x-y)^2 + (y-z)^2 + (z-x)^2 ) / (x^2+y^2+z^2) : by ring
  ... ≥ 0 :
        by { exact div_nonneg
                (by linarith [sq_nonneg (x-y), sq_nonneg (y-z), sq_nonneg (z-x)])
                (by linarith [sq_nonneg x, sq_nonneg y, sq_nonneg z]) },
end


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

import group_theory.subgroup.basic
import ring_theory.subsemiring.basic

/-!
# Subrings

Let `R` be a ring. This file defines the "bundled" subring type `subring R`, a type
whose terms correspond to subrings of `R`. This is the preferred way to talk
about subrings in mathlib. Unbundled subrings (`s : set R` and `is_subring s`)
are not in this file, and they will ultimately be deprecated.

We prove that subrings are a complete lattice, and that you can `map` (pushforward) and
`comap` (pull back) them along ring homomorphisms.

We define the `closure` construction from `set R` to `subring R`, sending a subset of `R`
to the subring it generates, and prove that it is a Galois insertion.

## Main definitions

Notation used here:

`(R : Type u) [ring R] (S : Type u) [ring S] (f g : R →+* S)`
`(A : subring R) (B : subring S) (s : set R)`

* `subring R` : the type of subrings of a ring `R`.

* `instance : complete_lattice (subring R)` : the complete lattice structure on the subrings.

* `subring.center` : the center of a ring `R`.

* `subring.closure` : subring closure of a set, i.e., the smallest subring that includes the set.

* `subring.gi` : `closure : set M → subring M` and coercion `coe : subring M → set M`
  form a `galois_insertion`.

* `comap f B : subring A` : the preimage of a subring `B` along the ring homomorphism `f`

* `map f A : subring B` : the image of a subring `A` along the ring homomorphism `f`.

* `prod A B : subring (R × S)` : the product of subrings

* `f.range : subring B` : the range of the ring homomorphism `f`.

* `eq_locus f g : subring R` : given ring homomorphisms `f g : R →+* S`,
     the subring of `R` where `f x = g x`

## Implementation notes

A subring is implemented as a subsemiring which is also an additive subgroup.
The initial PR was as a submonoid which is also an additive subgroup.

Lattice inclusion (e.g. `≤` and `⊓`) is used rather than set notation (`⊆` and `∩`), although
`∈` is defined as membership of a subring's underlying set.

## Tags
subring, subrings
-/

open_locale big_operators
universes u v w

variables {R : Type u} {S : Type v} {T : Type w} [ring R] [ring S] [ring T]

set_option old_structure_cmd true

/-- `subring R` is the type of subrings of `R`. A subring of `R` is a subset `s` that is a
  multiplicative submonoid and an additive subgroup. Note in particular that it shares the
  same 0 and 1 as R. -/
structure subring (R : Type u) [ring R] extends subsemiring R, add_subgroup R

/-- Reinterpret a `subring` as a `subsemiring`. -/
add_decl_doc subring.to_subsemiring

/-- Reinterpret a `subring` as an `add_subgroup`. -/
add_decl_doc subring.to_add_subgroup

namespace subring

/-- The underlying submonoid of a subring. -/
def to_submonoid (s : subring R) : submonoid R :=
{ carrier := s.carrier,
  ..s.to_subsemiring.to_submonoid }

instance : set_like (subring R) R :=
⟨subring.carrier, λ p q h, by cases p; cases q; congr'⟩

@[simp]
lemma mem_carrier {s : subring R} {x : R} : x ∈ s.carrier ↔ x ∈ s := iff.rfl

@[simp]
lemma mem_mk {S : set R} {x : R} (h₁ h₂ h₃ h₄ h₅) :
  x ∈ (⟨S, h₁, h₂, h₃, h₄, h₅⟩ : subring R) ↔ x ∈ S := iff.rfl

@[simp] lemma coe_set_mk (S : set R) (h₁ h₂ h₃ h₄ h₅) :
  ((⟨S, h₁, h₂, h₃, h₄, h₅⟩ : subring R) : set R) = S := rfl

@[simp]
lemma mk_le_mk {S S' : set R} (h₁ h₂ h₃  h₄ h₅ h₁' h₂' h₃'  h₄' h₅') :
  (⟨S, h₁, h₂, h₃, h₄, h₅⟩ : subring R) ≤ (⟨S', h₁', h₂', h₃', h₄', h₅'⟩ : subring R) ↔ S ⊆ S' :=
iff.rfl

/-- Two subrings are equal if they have the same elements. -/
@[ext] theorem ext {S T : subring R} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T := set_like.ext h

/-- Copy of a subring with a new `carrier` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (S : subring R) (s : set R) (hs : s = ↑S) : subring R :=
{ carrier := s,
  neg_mem' := hs.symm ▸ S.neg_mem',
  ..S.to_subsemiring.copy s hs }

@[simp] lemma coe_copy (S : subring R) (s : set R) (hs : s = ↑S) :
  (S.copy s hs : set R) = s := rfl

lemma copy_eq (S : subring R) (s : set R) (hs : s = ↑S) : S.copy s hs = S :=
set_like.coe_injective hs

lemma to_subsemiring_injective : function.injective (to_subsemiring : subring R → subsemiring R)
| r s h := ext (set_like.ext_iff.mp h : _)

@[mono]
lemma to_subsemiring_strict_mono : strict_mono (to_subsemiring : subring R → subsemiring R) :=
λ _ _, id

@[mono]
lemma to_subsemiring_mono : monotone (to_subsemiring : subring R → subsemiring R) :=
to_subsemiring_strict_mono.monotone

lemma to_add_subgroup_injective : function.injective (to_add_subgroup : subring R → add_subgroup R)
| r s h := ext (set_like.ext_iff.mp h : _)

@[mono]
lemma to_add_subgroup_strict_mono : strict_mono (to_add_subgroup : subring R → add_subgroup R) :=
λ _ _, id

@[mono]
lemma to_add_subgroup_mono : monotone (to_add_subgroup : subring R → add_subgroup R) :=
to_add_subgroup_strict_mono.monotone

lemma to_submonoid_injective : function.injective (to_submonoid : subring R → submonoid R)
| r s h := ext (set_like.ext_iff.mp h : _)

@[mono]
lemma to_submonoid_strict_mono : strict_mono (to_submonoid : subring R → submonoid R) :=
λ _ _, id

@[mono]
lemma to_submonoid_mono : monotone (to_submonoid : subring R → submonoid R) :=
to_submonoid_strict_mono.monotone

/-- Construct a `subring R` from a set `s`, a submonoid `sm`, and an additive
subgroup `sa` such that `x ∈ s ↔ x ∈ sm ↔ x ∈ sa`. -/
protected def mk' (s : set R) (sm : submonoid R) (sa : add_subgroup R)
  (hm : ↑sm = s) (ha : ↑sa = s) :
  subring R :=
{ carrier := s,
  zero_mem' := ha ▸ sa.zero_mem,
  one_mem' := hm ▸ sm.one_mem,
  add_mem' := λ x y, by simpa only [← ha] using sa.add_mem,
  mul_mem' := λ x y, by simpa only [← hm] using sm.mul_mem,
  neg_mem' := λ x, by simpa only [← ha] using sa.neg_mem, }

@[simp] lemma coe_mk' {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_subgroup R} (ha : ↑sa = s) :
  (subring.mk' s sm sa hm ha : set R) = s := rfl

@[simp] lemma mem_mk' {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_subgroup R} (ha : ↑sa = s) {x : R} :
  x ∈ subring.mk' s sm sa hm ha ↔ x ∈ s :=
iff.rfl

@[simp] lemma mk'_to_submonoid {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_subgroup R} (ha : ↑sa = s) :
  (subring.mk' s sm sa hm ha).to_submonoid = sm :=
set_like.coe_injective hm.symm

@[simp] lemma mk'_to_add_subgroup {s : set R} {sm : submonoid R} (hm : ↑sm = s)
  {sa : add_subgroup R} (ha : ↑sa  =s) :
  (subring.mk' s sm sa hm ha).to_add_subgroup = sa :=
set_like.coe_injective ha.symm

end subring

/-- A `subsemiring` containing -1 is a `subring`. -/
def subsemiring.to_subring (s : subsemiring R) (hneg : (-1 : R) ∈ s) : subring R :=
{ neg_mem' := by { rintros x, rw <-neg_one_mul, apply subsemiring.mul_mem, exact hneg, }
..s.to_submonoid, ..s.to_add_submonoid }

namespace subring

variables (s : subring R)

/-- A subring contains the ring's 1. -/
theorem one_mem : (1 : R) ∈ s := s.one_mem'

/-- A subring contains the ring's 0. -/
theorem zero_mem : (0 : R) ∈ s := s.zero_mem'

/-- A subring is closed under multiplication. -/
theorem mul_mem : ∀ {x y : R}, x ∈ s → y ∈ s → x * y ∈ s := s.mul_mem'

/-- A subring is closed under addition. -/
theorem add_mem : ∀ {x y : R}, x ∈ s → y ∈ s → x + y ∈ s := s.add_mem'

/-- A subring is closed under negation. -/
theorem neg_mem : ∀ {x : R}, x ∈ s → -x ∈ s := s.neg_mem'

/-- A subring is closed under subtraction -/
theorem sub_mem {x y : R} (hx : x ∈ s) (hy : y ∈ s) : x - y ∈ s :=
by { rw sub_eq_add_neg, exact s.add_mem hx (s.neg_mem hy) }

/-- Product of a list of elements in a subring is in the subring. -/
lemma list_prod_mem {l : list R} : (∀x ∈ l, x ∈ s) → l.prod ∈ s :=
s.to_submonoid.list_prod_mem

/-- Sum of a list of elements in a subring is in the subring. -/
lemma list_sum_mem {l : list R} : (∀x ∈ l, x ∈ s) → l.sum ∈ s :=
s.to_add_subgroup.list_sum_mem

/-- Product of a multiset of elements in a subring of a `comm_ring` is in the subring. -/
lemma multiset_prod_mem {R} [comm_ring R] (s : subring R) (m : multiset R) :
  (∀a ∈ m, a ∈ s) → m.prod ∈ s :=
s.to_submonoid.multiset_prod_mem m

/-- Sum of a multiset of elements in an `subring` of a `ring` is
in the `subring`. -/
lemma multiset_sum_mem {R} [ring R] (s : subring R) (m : multiset R) :
  (∀a ∈ m, a ∈ s) → m.sum ∈ s :=
s.to_add_subgroup.multiset_sum_mem m

/-- Product of elements of a subring of a `comm_ring` indexed by a `finset` is in the
    subring. -/
lemma prod_mem {R : Type*} [comm_ring R] (s : subring R)
  {ι : Type*} {t : finset ι} {f : ι → R} (h : ∀c ∈ t, f c ∈ s) :
  ∏ i in t, f i ∈ s :=
s.to_submonoid.prod_mem h

/-- Sum of elements in a `subring` of a `ring` indexed by a `finset`
is in the `subring`. -/
lemma sum_mem {R : Type*} [ring R] (s : subring R)
  {ι : Type*} {t : finset ι} {f : ι → R} (h : ∀c ∈ t, f c ∈ s) :
  ∑ i in t, f i ∈ s :=
s.to_add_subgroup.sum_mem h

lemma pow_mem {x : R} (hx : x ∈ s) (n : ℕ) : x^n ∈ s := s.to_submonoid.pow_mem hx n

lemma zsmul_mem {x : R} (hx : x ∈ s) (n : ℤ) :
  n • x ∈ s := s.to_add_subgroup.zsmul_mem hx n

lemma coe_int_mem (n : ℤ) : (n : R) ∈ s :=
by simp only [← zsmul_one, zsmul_mem, one_mem]

/-- A subring of a ring inherits a ring structure -/
instance to_ring : ring s :=
{ right_distrib := λ x y z, subtype.eq $ right_distrib x y z,
  left_distrib := λ x y z, subtype.eq $ left_distrib x y z,
  .. s.to_submonoid.to_monoid, .. s.to_add_subgroup.to_add_comm_group }

@[simp, norm_cast] lemma coe_add (x y : s) : (↑(x + y) : R) = ↑x + ↑y := rfl
@[simp, norm_cast] lemma coe_neg (x : s) : (↑(-x) : R) = -↑x := rfl
@[simp, norm_cast] lemma coe_mul (x y : s) : (↑(x * y) : R) = ↑x * ↑y := rfl
@[simp, norm_cast] lemma coe_zero : ((0 : s) : R) = 0 := rfl
@[simp, norm_cast] lemma coe_one : ((1 : s) : R) = 1 := rfl
@[simp, norm_cast] lemma coe_pow (x : s) (n : ℕ) : (↑(x ^ n) : R) = x ^ n :=
s.to_submonoid.coe_pow x n

@[simp] lemma coe_eq_zero_iff {x : s} : (x : R) = 0 ↔ x = 0 :=
⟨λ h, subtype.ext (trans h s.coe_zero.symm),
 λ h, h.symm ▸ s.coe_zero⟩

/-- A subring of a `comm_ring` is a `comm_ring`. -/
instance to_comm_ring {R} [comm_ring R] (s : subring R) : comm_ring s :=
{ mul_comm := λ _ _, subtype.eq $ mul_comm _ _, ..subring.to_ring s}

/-- A subring of a non-trivial ring is non-trivial. -/
instance {R} [ring R] [nontrivial R] (s : subring R) : nontrivial s :=
s.to_subsemiring.nontrivial

/-- A subring of a ring with no zero divisors has no zero divisors. -/
instance {R} [ring R] [no_zero_divisors R] (s : subring R) : no_zero_divisors s :=
s.to_subsemiring.no_zero_divisors

/-- A subring of a domain is a domain. -/
instance {R} [ring R] [is_domain R] (s : subring R) : is_domain s :=
{ .. s.nontrivial, .. s.no_zero_divisors, .. s.to_ring }

/-- A subring of an `ordered_ring` is an `ordered_ring`. -/
instance to_ordered_ring {R} [ordered_ring R] (s : subring R) : ordered_ring s :=
subtype.coe_injective.ordered_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)

/-- A subring of an `ordered_comm_ring` is an `ordered_comm_ring`. -/
instance to_ordered_comm_ring {R} [ordered_comm_ring R] (s : subring R) : ordered_comm_ring s :=
subtype.coe_injective.ordered_comm_ring coe rfl rfl
  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)

/-- A subring of a `linear_ordered_ring` is a `linear_ordered_ring`. -/
instance to_linear_ordered_ring {R} [linear_ordered_ring R] (s : subring R) :
  linear_ordered_ring s :=
subtype.coe_injective.linear_ordered_ring coe rfl rfl
  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)

/-- A subring of a `linear_ordered_comm_ring` is a `linear_ordered_comm_ring`. -/
instance to_linear_ordered_comm_ring {R} [linear_ordered_comm_ring R] (s : subring R) :
  linear_ordered_comm_ring s :=
subtype.coe_injective.linear_ordered_comm_ring coe rfl rfl
  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)

/-- The natural ring hom from a subring of ring `R` to `R`. -/
def subtype (s : subring R) : s →+* R :=
{ to_fun := coe,
 .. s.to_submonoid.subtype, .. s.to_add_subgroup.subtype }

@[simp] theorem coe_subtype : ⇑s.subtype = coe := rfl
@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : ((n : s) : R) = n :=
s.subtype.map_nat_cast n
@[simp, norm_cast] lemma coe_int_cast (n : ℤ) : ((n : s) : R) = n :=
s.subtype.map_int_cast n

/-! ## Partial order -/

@[simp] lemma mem_to_submonoid {s : subring R} {x : R} : x ∈ s.to_submonoid ↔ x ∈ s := iff.rfl
@[simp] lemma coe_to_submonoid (s : subring R) : (s.to_submonoid : set R) = s := rfl
@[simp] lemma mem_to_add_subgroup {s : subring R} {x : R} :
  x ∈ s.to_add_subgroup ↔ x ∈ s := iff.rfl
@[simp] lemma coe_to_add_subgroup (s : subring R) : (s.to_add_subgroup : set R) = s := rfl

/-! ## top -/

/-- The subring `R` of the ring `R`. -/
instance : has_top (subring R) :=
⟨{ .. (⊤ : submonoid R), .. (⊤ : add_subgroup R) }⟩

@[simp] lemma mem_top (x : R) : x ∈ (⊤ : subring R) := set.mem_univ x

@[simp] lemma coe_top : ((⊤ : subring R) : set R) = set.univ := rfl

/-! ## comap -/

/-- The preimage of a subring along a ring homomorphism is a subring. -/
def comap {R : Type u} {S : Type v} [ring R] [ring S]
  (f : R →+* S) (s : subring S) : subring R :=
{ carrier := f ⁻¹' s.carrier,
 .. s.to_submonoid.comap (f : R →* S),
  .. s.to_add_subgroup.comap (f : R →+ S) }

@[simp] lemma coe_comap (s : subring S) (f : R →+* S) : (s.comap f : set R) = f ⁻¹' s := rfl

@[simp]
lemma mem_comap {s : subring S} {f : R →+* S} {x : R} : x ∈ s.comap f ↔ f x ∈ s := iff.rfl

lemma comap_comap (s : subring T) (g : S →+* T) (f : R →+* S) :
  (s.comap g).comap f = s.comap (g.comp f) :=
rfl

/-! ## map -/

/-- The image of a subring along a ring homomorphism is a subring. -/
def map {R : Type u} {S : Type v} [ring R] [ring S]
  (f : R →+* S) (s : subring R) : subring S :=
  { carrier := f '' s.carrier,
.. s.to_submonoid.map (f : R →* S),
.. s.to_add_subgroup.map (f : R →+ S) }

@[simp] lemma coe_map (f : R →+* S) (s : subring R) : (s.map f : set S) = f '' s := rfl

@[simp] lemma mem_map {f : R →+* S} {s : subring R} {y : S} :
  y ∈ s.map f ↔ ∃ x ∈ s, f x = y :=
set.mem_image_iff_bex

@[simp] lemma map_id : s.map (ring_hom.id R) = s :=
set_like.coe_injective $ set.image_id _

lemma map_map (g : S →+* T) (f : R →+* S) : (s.map f).map g = s.map (g.comp f) :=
set_like.coe_injective $ set.image_image _ _ _

lemma map_le_iff_le_comap {f : R →+* S} {s : subring R} {t : subring S} :
  s.map f ≤ t ↔ s ≤ t.comap f :=
set.image_subset_iff

lemma gc_map_comap (f : R →+* S) : galois_connection (map f) (comap f) :=
λ S T, map_le_iff_le_comap

/-- A subring is isomorphic to its image under an injective function -/
noncomputable def equiv_map_of_injective
  (f : R →+* S) (hf : function.injective f) : s ≃+* s.map f :=
{ map_mul' := λ _ _, subtype.ext (f.map_mul _ _),
  map_add' := λ _ _, subtype.ext (f.map_add _ _),
  ..equiv.set.image f s hf }

@[simp] lemma coe_equiv_map_of_injective_apply
  (f : R →+* S) (hf : function.injective f) (x : s) :
  (equiv_map_of_injective s f hf x : S) = f x := rfl

end subring

namespace ring_hom

variables (g : S →+* T) (f : R →+* S)

/-! ## range -/

/-- The range of a ring homomorphism, as a subring of the target. See Note [range copy pattern]. -/
def range {R : Type u} {S : Type v} [ring R] [ring S] (f : R →+* S) : subring S :=
((⊤ : subring R).map f).copy (set.range f) set.image_univ.symm

@[simp] lemma coe_range : (f.range : set S) = set.range f := rfl

@[simp] lemma mem_range {f : R →+* S} {y : S} : y ∈ f.range ↔ ∃ x, f x = y := iff.rfl

lemma range_eq_map (f : R →+* S) : f.range = subring.map f ⊤ :=
by { ext, simp }

lemma mem_range_self (f : R →+* S) (x : R) : f x ∈ f.range :=
mem_range.mpr ⟨x, rfl⟩

lemma map_range : f.range.map g = (g.comp f).range :=
by simpa only [range_eq_map] using (⊤ : subring R).map_map g f

-- TODO -- rename to `cod_restrict` when is_ring_hom is deprecated
/-- Restrict the codomain of a ring homomorphism to a subring that includes the range. -/
def cod_restrict' {R : Type u} {S : Type v} [ring R] [ring S] (f : R →+* S)
  (s : subring S) (h : ∀ x, f x ∈ s) : R →+* s :=
{ to_fun := λ x, ⟨f x, h x⟩,
  map_add' := λ x y, subtype.eq $ f.map_add x y,
  map_zero' := subtype.eq f.map_zero,
  map_mul' := λ x y, subtype.eq $ f.map_mul x y,
  map_one' := subtype.eq f.map_one }

/-- The range of a ring homomorphism is a fintype, if the domain is a fintype.
Note: this instance can form a diamond with `subtype.fintype` in the
  presence of `fintype S`. -/
instance fintype_range [fintype R] [decidable_eq S] (f : R →+* S) : fintype (range f) :=
set.fintype_range f

end ring_hom

namespace subring

/-! ## bot -/

instance : has_bot (subring R) := ⟨(int.cast_ring_hom R).range⟩

instance : inhabited (subring R) := ⟨⊥⟩

lemma coe_bot : ((⊥ : subring R) : set R) = set.range (coe : ℤ → R) :=
ring_hom.coe_range (int.cast_ring_hom R)

lemma mem_bot {x : R} : x ∈ (⊥ : subring R) ↔ ∃ (n : ℤ), ↑n = x :=
ring_hom.mem_range

/-! ## inf -/

/-- The inf of two subrings is their intersection. -/
instance : has_inf (subring R) :=
⟨λ s t,
  { carrier := s ∩ t,
    .. s.to_submonoid ⊓ t.to_submonoid,
    .. s.to_add_subgroup ⊓ t.to_add_subgroup }⟩

@[simp] lemma coe_inf (p p' : subring R) : ((p ⊓ p' : subring R) : set R) = p ∩ p' := rfl

@[simp] lemma mem_inf {p p' : subring R} {x : R} : x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' := iff.rfl

instance : has_Inf (subring R) :=
⟨λ s, subring.mk' (⋂ t ∈ s, ↑t) (⨅ t ∈ s, subring.to_submonoid t )
  (⨅ t ∈ s, subring.to_add_subgroup t) (by simp) (by simp)⟩

@[simp, norm_cast] lemma coe_Inf (S : set (subring R)) :
  ((Inf S : subring R) : set R) = ⋂ s ∈ S, ↑s := rfl

lemma mem_Inf {S : set (subring R)} {x : R} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p := set.mem_bInter_iff

@[simp] lemma Inf_to_submonoid (s : set (subring R)) :
  (Inf s).to_submonoid = ⨅ t ∈ s, subring.to_submonoid t := mk'_to_submonoid _ _

@[simp] lemma Inf_to_add_subgroup (s : set (subring R)) :
  (Inf s).to_add_subgroup = ⨅ t ∈ s, subring.to_add_subgroup t := mk'_to_add_subgroup _ _

/-- Subrings of a ring form a complete lattice. -/
instance : complete_lattice (subring R) :=
{ bot := (⊥),
  bot_le := λ s x hx, let ⟨n, hn⟩ := mem_bot.1 hx in hn ▸ s.coe_int_mem n,
  top := (⊤),
  le_top := λ s x hx, trivial,
  inf := (⊓),
  inf_le_left := λ s t x, and.left,
  inf_le_right := λ s t x, and.right,
  le_inf := λ s t₁ t₂ h₁ h₂ x hx, ⟨h₁ hx, h₂ hx⟩,
  .. complete_lattice_of_Inf (subring R)
    (λ s, is_glb.of_image (λ s t,
      show (s : set R) ≤ t ↔ s ≤ t, from set_like.coe_subset_coe) is_glb_binfi)}

lemma eq_top_iff' (A : subring R) : A = ⊤ ↔ ∀ x : R, x ∈ A :=
eq_top_iff.trans ⟨λ h m, h $ mem_top m, λ h m _, h m⟩

/-! ## Center of a ring -/

section

variables (R)

/-- The center of a ring `R` is the set of elements that commute with everything in `R` -/
def center : subring R :=
{ carrier := set.center R,
  neg_mem' := λ a, set.neg_mem_center,
  .. subsemiring.center R }

lemma coe_center : ↑(center R) = set.center R := rfl

@[simp] lemma center_to_subsemiring : (center R).to_subsemiring = subsemiring.center R := rfl

variables {R}

lemma mem_center_iff {z : R} : z ∈ center R ↔ ∀ g, g * z = z * g :=
iff.rfl

instance decidable_mem_center [decidable_eq R] [fintype R] : decidable_pred (∈ center R) :=
λ _, decidable_of_iff' _ mem_center_iff

@[simp] lemma center_eq_top (R) [comm_ring R] : center R = ⊤ :=
set_like.coe_injective (set.center_eq_univ R)

/-- The center is commutative. -/
instance : comm_ring (center R) :=
{ ..subsemiring.center.comm_semiring,
  ..(center R).to_ring}

end

section division_ring

variables {K : Type u} [division_ring K]

instance : field (center K) :=
{ inv := λ a, ⟨a⁻¹, set.inv_mem_center₀ a.prop⟩,
  mul_inv_cancel := λ ⟨a, ha⟩ h, subtype.ext $ mul_inv_cancel $ subtype.coe_injective.ne h,
  div := λ a b, ⟨a / b, set.div_mem_center₀ a.prop b.prop⟩,
  div_eq_mul_inv := λ a b, subtype.ext $ div_eq_mul_inv _ _,
  inv_zero := subtype.ext inv_zero,
  ..(center K).nontrivial,
  ..center.comm_ring }

@[simp]
lemma center.coe_inv (a : center K) : ((a⁻¹ : center K) : K) = (a : K)⁻¹ := rfl

@[simp]
lemma center.coe_div (a b : center K) : ((a / b : center K) : K) = (a : K) / (b : K) := rfl

end division_ring

/-! ## subring closure of a subset -/

/-- The `subring` generated by a set. -/
def closure (s : set R) : subring R := Inf {S | s ⊆ S}

lemma mem_closure {x : R} {s : set R} : x ∈ closure s ↔ ∀ S : subring R, s ⊆ S → x ∈ S :=
mem_Inf

/-- The subring generated by a set includes the set. -/
@[simp] lemma subset_closure {s : set R} : s ⊆ closure s := λ x hx, mem_closure.2 $ λ S hS, hS hx

lemma not_mem_of_not_mem_closure {s : set R} {P : R} (hP : P ∉ closure s) : P ∉ s :=
λ h, hP (subset_closure h)

/-- A subring `t` includes `closure s` if and only if it includes `s`. -/
@[simp]
lemma closure_le {s : set R} {t : subring R} : closure s ≤ t ↔ s ⊆ t :=
⟨set.subset.trans subset_closure, λ h, Inf_le h⟩

/-- Subring closure of a set is monotone in its argument: if `s ⊆ t`,
then `closure s ≤ closure t`. -/
lemma closure_mono ⦃s t : set R⦄ (h : s ⊆ t) : closure s ≤ closure t :=
closure_le.2 $ set.subset.trans h subset_closure

lemma closure_eq_of_le {s : set R} {t : subring R} (h₁ : s ⊆ t) (h₂ : t ≤ closure s) :
  closure s = t :=
le_antisymm (closure_le.2 h₁) h₂

/-- An induction principle for closure membership. If `p` holds for `0`, `1`, and all elements
of `s`, and is preserved under addition, negation, and multiplication, then `p` holds for all
elements of the closure of `s`. -/
@[elab_as_eliminator]
lemma closure_induction {s : set R} {p : R → Prop} {x} (h : x ∈ closure s)
  (Hs : ∀ x ∈ s, p x) (H0 : p 0) (H1 : p 1)
  (Hadd : ∀ x y, p x → p y → p (x + y))
  (Hneg : ∀ (x : R), p x → p (-x))
  (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
(@closure_le _ _ _ ⟨p, H1, Hmul, H0, Hadd, Hneg⟩).2 Hs h

lemma mem_closure_iff {s : set R} {x} :
  x ∈ closure s ↔ x ∈ add_subgroup.closure (submonoid.closure s : set R) :=
⟨ λ h, closure_induction h (λ x hx, add_subgroup.subset_closure $ submonoid.subset_closure hx )
 (add_subgroup.zero_mem _)
 (add_subgroup.subset_closure ( submonoid.one_mem (submonoid.closure s)) )
 (λ x y hx hy, add_subgroup.add_mem _ hx hy )
 (λ x hx, add_subgroup.neg_mem _ hx )
 ( λ x y hx hy, add_subgroup.closure_induction hy
  (λ q hq, add_subgroup.closure_induction hx
    ( λ p hp, add_subgroup.subset_closure ((submonoid.closure s).mul_mem hp hq) )
    ( begin rw zero_mul q, apply add_subgroup.zero_mem _, end )
    ( λ p₁ p₂ ihp₁ ihp₂, begin rw add_mul p₁ p₂ q, apply add_subgroup.add_mem _ ihp₁ ihp₂, end )
    ( λ x hx, begin have f : -x * q = -(x*q) :=
      by simp, rw f, apply add_subgroup.neg_mem _ hx, end ) )
  ( begin rw mul_zero x, apply add_subgroup.zero_mem _, end )
  ( λ q₁ q₂ ihq₁ ihq₂, begin rw mul_add x q₁ q₂, apply add_subgroup.add_mem _ ihq₁ ihq₂ end )
  ( λ z hz, begin have f : x * -z = -(x*z) := by simp,
            rw f, apply add_subgroup.neg_mem _ hz, end ) ),
 λ h, add_subgroup.closure_induction h
 ( λ x hx, submonoid.closure_induction hx
  ( λ x hx, subset_closure hx )
  ( one_mem _ )
  ( λ x y hx hy, mul_mem _ hx hy ) )
 ( zero_mem _ )
 (λ x y hx hy, add_mem _ hx hy)
 ( λ x hx, neg_mem _ hx ) ⟩

theorem exists_list_of_mem_closure {s : set R} {x : R} (h : x ∈ closure s) :
  (∃ L : list (list R), (∀ t ∈ L, ∀ y ∈ t, y ∈ s ∨ y = (-1:R)) ∧ (L.map list.prod).sum = x) :=
add_subgroup.closure_induction (mem_closure_iff.1 h)
  (λ x hx, let ⟨l, hl, h⟩ :=submonoid.exists_list_of_mem_closure hx in ⟨[l], by simp [h];
    clear_aux_decl; tauto!⟩)
  ⟨[], by simp⟩
  (λ x y ⟨l, hl1, hl2⟩ ⟨m, hm1, hm2⟩, ⟨l ++ m, λ t ht, (list.mem_append.1 ht).elim (hl1 t) (hm1 t),
    by simp [hl2, hm2]⟩)
  (λ x ⟨L, hL⟩, ⟨L.map (list.cons (-1)), list.forall_mem_map_iff.2 $ λ j hj, list.forall_mem_cons.2
    ⟨or.inr rfl, hL.1 j hj⟩, hL.2 ▸ list.rec_on L (by simp)
      (by simp [list.map_cons, add_comm] {contextual := tt})⟩)

variable (R)
/-- `closure` forms a Galois insertion with the coercion to set. -/
protected def gi : galois_insertion (@closure R _) coe :=
{ choice := λ s _, closure s,
  gc := λ s t, closure_le,
  le_l_u := λ s, subset_closure,
  choice_eq := λ s h, rfl }

variable {R}

/-- Closure of a subring `S` equals `S`. -/
lemma closure_eq (s : subring R) : closure (s : set R) = s := (subring.gi R).l_u_eq s

@[simp] lemma closure_empty : closure (∅ : set R) = ⊥ := (subring.gi R).gc.l_bot

@[simp] lemma closure_univ : closure (set.univ : set R) = ⊤ := @coe_top R _ ▸ closure_eq ⊤

lemma closure_union (s t : set R) : closure (s ∪ t) = closure s ⊔ closure t :=
(subring.gi R).gc.l_sup

lemma closure_Union {ι} (s : ι → set R) : closure (⋃ i, s i) = ⨆ i, closure (s i) :=
(subring.gi R).gc.l_supr

lemma closure_sUnion (s : set (set R)) : closure (⋃₀ s) = ⨆ t ∈ s, closure t :=
(subring.gi R).gc.l_Sup

lemma map_sup (s t : subring R) (f : R →+* S) : (s ⊔ t).map f = s.map f ⊔ t.map f :=
(gc_map_comap f).l_sup

lemma map_supr {ι : Sort*} (f : R →+* S) (s : ι → subring R) :
  (supr s).map f = ⨆ i, (s i).map f :=
(gc_map_comap f).l_supr

lemma comap_inf (s t : subring S) (f : R →+* S) : (s ⊓ t).comap f = s.comap f ⊓ t.comap f :=
(gc_map_comap f).u_inf

lemma comap_infi {ι : Sort*} (f : R →+* S) (s : ι → subring S) :
  (infi s).comap f = ⨅ i, (s i).comap f :=
(gc_map_comap f).u_infi

@[simp] lemma map_bot (f : R →+* S) : (⊥ : subring R).map f = ⊥ :=
(gc_map_comap f).l_bot

@[simp] lemma comap_top (f : R →+* S) : (⊤ : subring S).comap f = ⊤ :=
(gc_map_comap f).u_top

/-- Given `subring`s `s`, `t` of rings `R`, `S` respectively, `s.prod t` is `s × t`
as a subring of `R × S`. -/
def prod (s : subring R) (t : subring S) : subring (R × S) :=
{ carrier := (s : set R).prod t,
  .. s.to_submonoid.prod t.to_submonoid, .. s.to_add_subgroup.prod t.to_add_subgroup}

@[norm_cast]
lemma coe_prod (s : subring R) (t : subring S) :
  (s.prod t : set (R × S)) = (s : set R).prod (t : set S) :=
rfl

lemma mem_prod {s : subring R} {t : subring S} {p : R × S} :
  p ∈ s.prod t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl

@[mono] lemma prod_mono ⦃s₁ s₂ : subring R⦄ (hs : s₁ ≤ s₂) ⦃t₁ t₂ : subring S⦄
  (ht : t₁ ≤ t₂) : s₁.prod t₁ ≤ s₂.prod t₂ :=
set.prod_mono hs ht

lemma prod_mono_right (s : subring R) : monotone (λ t : subring S, s.prod t) :=
prod_mono (le_refl s)

lemma prod_mono_left (t : subring S) : monotone (λ s : subring R, s.prod t) :=
λ s₁ s₂ hs, prod_mono hs (le_refl t)

lemma prod_top (s : subring R) :
  s.prod (⊤ : subring S) = s.comap (ring_hom.fst R S) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_fst]

lemma top_prod (s : subring S) :
  (⊤ : subring R).prod s = s.comap (ring_hom.snd R S) :=
ext $ λ x, by simp [mem_prod, monoid_hom.coe_snd]

@[simp]
lemma top_prod_top : (⊤ : subring R).prod (⊤ : subring S) = ⊤ :=
(top_prod _).trans $ comap_top _

/-- Product of subrings is isomorphic to their product as rings. -/
def prod_equiv (s : subring R) (t : subring S) : s.prod t ≃+* s × t :=
{ map_mul' := λ x y, rfl, map_add' := λ x y, rfl, .. equiv.set.prod ↑s ↑t }

/-- The underlying set of a non-empty directed Sup of subrings is just a union of the subrings.
  Note that this fails without the directedness assumption (the union of two subrings is
  typically not a subring) -/
lemma mem_supr_of_directed {ι} [hι : nonempty ι] {S : ι → subring R} (hS : directed (≤) S)
  {x : R} :
  x ∈ (⨆ i, S i) ↔ ∃ i, x ∈ S i :=
begin
  refine ⟨_, λ ⟨i, hi⟩, (set_like.le_def.1 $ le_supr S i) hi⟩,
  let U : subring R := subring.mk' (⋃ i, (S i : set R))
    (⨆ i, (S i).to_submonoid) (⨆ i, (S i).to_add_subgroup)
    (submonoid.coe_supr_of_directed $ hS.mono_comp _ (λ _ _, id))
    (add_subgroup.coe_supr_of_directed $ hS.mono_comp _ (λ _ _, id)),
  suffices : (⨆ i, S i) ≤ U, by simpa using @this x,
  exact supr_le (λ i x hx, set.mem_Union.2 ⟨i, hx⟩),
end

lemma coe_supr_of_directed {ι} [hι : nonempty ι] {S : ι → subring R} (hS : directed (≤) S) :
  ((⨆ i, S i : subring R) : set R) = ⋃ i, ↑(S i) :=
set.ext $ λ x, by simp [mem_supr_of_directed hS]

lemma mem_Sup_of_directed_on {S : set (subring R)} (Sne : S.nonempty)
  (hS : directed_on (≤) S) {x : R} :
  x ∈ Sup S ↔ ∃ s ∈ S, x ∈ s :=
begin
  haveI : nonempty S := Sne.to_subtype,
  simp only [Sup_eq_supr', mem_supr_of_directed hS.directed_coe, set_coe.exists, subtype.coe_mk]
end

lemma coe_Sup_of_directed_on {S : set (subring R)} (Sne : S.nonempty) (hS : directed_on (≤) S) :
  (↑(Sup S) : set R) = ⋃ s ∈ S, ↑s :=
set.ext $ λ x, by simp [mem_Sup_of_directed_on Sne hS]

lemma mem_map_equiv {f : R ≃+* S} {K : subring R} {x : S} :
  x ∈ K.map (f : R →+* S) ↔ f.symm x ∈ K :=
@set.mem_image_equiv _ _ ↑K f.to_equiv x

lemma map_equiv_eq_comap_symm (f : R ≃+* S) (K : subring R) :
  K.map (f : R →+* S) = K.comap f.symm :=
set_like.coe_injective (f.to_equiv.image_eq_preimage K)

lemma comap_equiv_eq_map_symm (f : R ≃+* S) (K : subring S) :
  K.comap (f : R →+* S) = K.map f.symm :=
(map_equiv_eq_comap_symm f.symm K).symm

end subring

namespace ring_hom

variables [ring T] {s : subring R}

open subring

/-- Restriction of a ring homomorphism to a subring of the domain. -/
def restrict (f : R →+* S) (s : subring R) : s →+* S := f.comp s.subtype

@[simp] lemma restrict_apply (f : R →+* S) (x : s) : f.restrict s x = f x := rfl

/-- Restriction of a ring homomorphism to its range interpreted as a subsemiring.

This is the bundled version of `set.range_factorization`. -/
def range_restrict (f : R →+* S) : R →+* f.range :=
f.cod_restrict' f.range $ λ x, ⟨x, rfl⟩

@[simp] lemma coe_range_restrict (f : R →+* S) (x : R) : (f.range_restrict x : S) = f x := rfl

lemma range_restrict_surjective (f : R →+* S) : function.surjective f.range_restrict :=
λ ⟨y, hy⟩, let ⟨x, hx⟩ := mem_range.mp hy in ⟨x, subtype.ext hx⟩

lemma range_top_iff_surjective {f : R →+* S} :
  f.range = (⊤ : subring S) ↔ function.surjective f :=
set_like.ext'_iff.trans $ iff.trans (by rw [coe_range, coe_top]) set.range_iff_surjective

/-- The range of a surjective ring homomorphism is the whole of the codomain. -/
lemma range_top_of_surjective (f : R →+* S) (hf : function.surjective f) :
  f.range = (⊤ : subring S) :=
range_top_iff_surjective.2 hf

/-- The subring of elements `x : R` such that `f x = g x`, i.e.,
  the equalizer of f and g as a subring of R -/
def eq_locus (f g : R →+* S) : subring R :=
{ carrier := {x | f x = g x}, .. (f : R →* S).eq_mlocus g, .. (f : R →+ S).eq_locus g }

/-- If two ring homomorphisms are equal on a set, then they are equal on its subring closure. -/
lemma eq_on_set_closure {f g : R →+* S} {s : set R} (h : set.eq_on f g s) :
  set.eq_on f g (closure s) :=
show closure s ≤ f.eq_locus g, from closure_le.2 h

lemma eq_of_eq_on_set_top {f g : R →+* S} (h : set.eq_on f g (⊤ : subring R)) :
  f = g :=
ext $ λ x, h trivial

lemma eq_of_eq_on_set_dense {s : set R} (hs : closure s = ⊤) {f g : R →+* S} (h : s.eq_on f g) :
  f = g :=
eq_of_eq_on_set_top $ hs ▸ eq_on_set_closure h

lemma closure_preimage_le (f : R →+* S) (s : set S) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

/-- The image under a ring homomorphism of the subring generated by a set equals
the subring generated by the image of the set. -/
lemma map_closure (f : R →+* S) (s : set R) :
  (closure s).map f = closure (f '' s) :=
le_antisymm
  (map_le_iff_le_comap.2 $ le_trans (closure_mono $ set.subset_preimage_image _ _)
    (closure_preimage_le _ _))
  (closure_le.2 $ set.image_subset _ subset_closure)

end ring_hom

namespace subring

open ring_hom

/-- The ring homomorphism associated to an inclusion of subrings. -/
def inclusion {S T : subring R} (h : S ≤ T) : S →+* T :=
S.subtype.cod_restrict' _ (λ x, h x.2)

@[simp] lemma range_subtype (s : subring R) : s.subtype.range = s :=
set_like.coe_injective $ (coe_srange _).trans subtype.range_coe

@[simp]
lemma range_fst : (fst R S).srange = ⊤ :=
(fst R S).srange_top_of_surjective $ prod.fst_surjective

@[simp]
lemma range_snd : (snd R S).srange = ⊤ :=
(snd R S).srange_top_of_surjective $ prod.snd_surjective

@[simp]
lemma prod_bot_sup_bot_prod (s : subring R) (t : subring S) :
  (s.prod ⊥) ⊔ (prod ⊥ t) = s.prod t :=
le_antisymm (sup_le (prod_mono_right s bot_le) (prod_mono_left t bot_le)) $
assume p hp, prod.fst_mul_snd p ▸ mul_mem _
  ((le_sup_left : s.prod ⊥ ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨hp.1, set_like.mem_coe.2 $ one_mem ⊥⟩)
  ((le_sup_right : prod ⊥ t ≤ s.prod ⊥ ⊔ prod ⊥ t) ⟨set_like.mem_coe.2 $ one_mem ⊥, hp.2⟩)

end subring

namespace ring_equiv

variables {s t : subring R}

/-- Makes the identity isomorphism from a proof two subrings of a multiplicative
    monoid are equal. -/
def subring_congr (h : s = t) : s ≃+* t :=
{ map_mul' :=  λ _ _, rfl, map_add' := λ _ _, rfl, ..equiv.set_congr $ congr_arg _ h }

/-- Restrict a ring homomorphism with a left inverse to a ring isomorphism to its
`ring_hom.range`. -/
def of_left_inverse {g : S → R} {f : R →+* S} (h : function.left_inverse g f) :
  R ≃+* f.range :=
{ to_fun := λ x, f.range_restrict x,
  inv_fun := λ x, (g ∘ f.range.subtype) x,
  left_inv := h,
  right_inv := λ x, subtype.ext $
    let ⟨x', hx'⟩ := ring_hom.mem_range.mp x.prop in
    show f (g x) = x, by rw [←hx', h x'],
  ..f.range_restrict }

@[simp] lemma of_left_inverse_apply
  {g : S → R} {f : R →+* S} (h : function.left_inverse g f) (x : R) :
  ↑(of_left_inverse h x) = f x := rfl

@[simp] lemma of_left_inverse_symm_apply
  {g : S → R} {f : R →+* S} (h : function.left_inverse g f) (x : f.range) :
  (of_left_inverse h).symm x = g x := rfl

end ring_equiv

namespace subring

variables {s : set R}
local attribute [reducible] closure

@[elab_as_eliminator]
protected

lemma closure_preimage_le (f : R →+* S) (s : set S) :
  closure (f ⁻¹' s) ≤ (closure s).comap f :=
closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx

end subring

lemma add_subgroup.int_mul_mem {G : add_subgroup R} (k : ℤ) {g : R} (h : g ∈ G) :
  (k : R) * g ∈ G :=
by { convert add_subgroup.zsmul_mem G h k, simp }

/-! ## Actions by `subring`s

These are just copies of the definitions about `subsemiring` starting from
`subsemiring.mul_action`.

When `R` is commutative, `algebra.of_subring` provides a stronger result than those found in
this file, which uses the same scalar action.
-/
section actions

namespace subring

variables {α β : Type*}

/-- The action by a subring is the action by the underlying ring. -/
instance [mul_action R α] (S : subring R) : mul_action S α :=
S.to_subsemiring.mul_action

lemma smul_def [mul_action R α] {S : subring R} (g : S) (m : α) : g • m = (g : R) • m := rfl

instance smul_comm_class_left
  [mul_action R β] [has_scalar α β] [smul_comm_class R α β] (S : subring R) :
  smul_comm_class S α β :=
S.to_subsemiring.smul_comm_class_left

instance smul_comm_class_right
  [has_scalar α β] [mul_action R β] [smul_comm_class α R β] (S : subring R) :
  smul_comm_class α S β :=
S.to_subsemiring.smul_comm_class_right

/-- Note that this provides `is_scalar_tower S R R` which is needed by `smul_mul_assoc`. -/
instance
  [has_scalar α β] [mul_action R α] [mul_action R β] [is_scalar_tower R α β] (S : subring R) :
  is_scalar_tower S α β :=
S.to_subsemiring.is_scalar_tower

instance [mul_action R α] [has_faithful_scalar R α] (S : subring R) :
  has_faithful_scalar S α :=
S.to_subsemiring.has_faithful_scalar

/-- The action by a subring is the action by the underlying ring. -/
instance [add_monoid α] [distrib_mul_action R α] (S : subring R) : distrib_mul_action S α :=
S.to_subsemiring.distrib_mul_action

/-- The action by a subsemiring is the action by the underlying semiring. -/
instance [monoid α] [mul_distrib_mul_action R α] (S : subring R) : mul_distrib_mul_action S α :=
S.to_subsemiring.mul_distrib_mul_action

/-- The action by a subring is the action by the underlying ring. -/
instance [add_comm_monoid α] [module R α] (S : subring R) : module S α :=
S.to_subsemiring.module

end subring

end actions

-- while this definition is not about subrings, this is the earliest we have
-- both ordered ring structures and submonoids available

/-- The subgroup of positive units of a linear ordered semiring. -/
def units.pos_subgroup (R : Type*) [linear_ordered_semiring R] :
  subgroup (units R) :=
{ carrier := {x | (0 : R) < x},
  inv_mem' := λ x (hx : (0 : R) < x), (zero_lt_mul_left hx).mp $ x.mul_inv.symm ▸ zero_lt_one,
  ..(pos_submonoid R).comap (units.coe_hom R)}

@[simp] lemma units.mem_pos_subgroup {R : Type*} [linear_ordered_semiring R]
  (u : units R) : u ∈ units.pos_subgroup R ↔ (0 : R) < u := iff.rfl


import analysis.calculus.deriv
import data.polynomial.erase_lead
import asymptotics2
import analysis.asymptotic_equivalent
import topology.algebra.ordered
import algebra.group.pi

open_locale asymptotics
open filter

namespace asymptotics

section

variables {α β : Type*} {u v w : α → β} [normed_group β] {l : filter α}

lemma is_equivalent.add_is_o (huv : u ~[l] v) (hwv : is_o w v l) : (w + u) ~[l] v :=
begin
  rw is_equivalent at *,
  convert hwv.add huv,
  ext,
  simp [add_sub],
end

lemma is_o.is_equivalent (huv : is_o (u - v) v l) : u ~[l] v := huv

lemma is_equivalent.neg (huv : u ~[l] v) : (λ x, - u x) ~[l] (λ x, - v x) :=
begin
  rw is_equivalent,
  convert huv.is_o.neg_left.neg_right,
  ext,
  simp,
end

end

section normed_linear_ordered_field

variables {α β : Type*} [normed_linear_ordered_field β] {u v : α → β} {l : filter α}

#check tendsto_neg_at_top_at_bot

lemma is_equivalent.tendsto_at_bot [order_topology β] (huv : u ~[l] v) (hu : tendsto u l at_bot) :
  tendsto v l at_bot :=
begin
  convert tendsto_neg_at_top_at_bot.comp (huv.neg.tendsto_at_top $ tendsto_neg_at_bot_at_top.comp hu),
  ext,
  simp
end

lemma is_equivalent.tendsto_at_bot_iff [order_topology β] (huv : u ~[l] v) :
  tendsto u l at_bot ↔ tendsto v l at_bot := ⟨huv.tendsto_at_bot, huv.symm.tendsto_at_bot⟩

end normed_linear_ordered_field

end asymptotics


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

This file defines the monoid SL₂(ℕ) of 2 × 2 matrices over ℕ with
determinant one.  Various things about the Euclidean algorithm,
continued fractions and so on can be formulated nicely in terms
of this monoid.  It is also closely related to the group SL₂(ℤ),
which plays a key role in the theory of modular forms.

We have chosen to do this directly rather than embedding it in
a larger framework of matrices of general size over a general
semiring.  This might or might not be a good decision.

Some key facts are as follows:
* SL₂(ℕ) is freely generated as a monoid by the matrices
  S = [[1,1],[0,1]] and T = [[1,0],[1,1]]

* SL₂(ℕ) acts by multiplication on ℕ+ × ℕ+.  For any
  [a,b] in ℕ+ × ℕ+, there exists m in SL₂(ℕ) such that
  m • [d,d] = [a,b], where d = gcd a b.  This characterizes
  the gcd.  There is a version of the extended Euclidean
  algorithm that works solely in ℕ rather than ℤ, and
  calculates m and d as above.

* SL₂(ℕ) acts on ℚ+ by
   [[a,b],[c,d]] • q = (a * q + b) / (c * q + d)
  The map m ↦ m • 1 gives a bijection SL₂(ℕ) → ℚ+
  In combiation with the isomorphism SL₂(ℕ) = ⟨S,T⟩,
  this gives a verson of the theory of continued fractions.
-/

import data.pnat.basic data.rat group_theory.group_action
import tactic.ring

structure SL2N : Type :=
(a : nat) (b : nat) (c : nat) (d : nat)
(det_prop : a * d = c * b + 1)

namespace SL2N

@[ext]
theorem ext : ∀ (m₁ m₂ : SL2N),
 m₁.a = m₂.a → m₁.b = m₂.b → m₁.c = m₂.c → m₁.d = m₂.d → m₁ = m₂ :=
λ ⟨a₁,b₁,c₁,d₁,dp₁⟩ ⟨a₂,b₂,c₂,d₂,dp₂⟩ ha hb hc hd,
 by {cases ha, cases hb, cases hc,cases hd,rw[(rfl : dp₁ = dp₂)]}

theorem ext' {m₁ m₂ : SL2N} :
 m₁ = m₂ ↔ (m₁.a = m₂.a ∧ m₁.b = m₂.b ∧ m₁.c = m₂.c ∧ m₁.d = m₂.d) :=
by {split,{rintro rfl,simp only[eq_self_iff_true,true_and]},
    {intro h,ext,exact h.1,exact h.2.1,exact h.2.2.1,exact h.2.2.2}}

instance : has_sizeof SL2N := ⟨λ m,m.a + m.b + m.c + m.d⟩

instance : has_one SL2N := ⟨⟨1,0,0,1,rfl⟩⟩
@[simp] theorem one_a : (1 : SL2N).a = 1 := rfl
@[simp] theorem one_b : (1 : SL2N).b = 0 := rfl
@[simp] theorem one_c : (1 : SL2N).c = 0 := rfl
@[simp] theorem one_d : (1 : SL2N).d = 1 := rfl

instance : has_mul SL2N := ⟨λ m n,
  ⟨m.a * n.a + m.b * n.c, m.a * n.b + m.b * n.d,
   m.c * n.a + m.d * n.c, m.c * n.b + m.d * n.d,
   by {have h : forall (x y w z : ℕ),
        (w * x) * (y * z) = (w * y) * (x * z) :=
         by {intros,
             rw[mul_assoc w,mul_assoc w,← mul_assoc x,← mul_assoc y],
             rw[mul_comm x y]},
       rw[add_mul,add_mul,mul_add,mul_add,mul_add,mul_add],
       repeat {rw[h n.a]},repeat {rw[h n.c]},
       rw[mul_comm m.a m.c,mul_comm m.b m.c,mul_comm m.c m.a],
       rw[mul_comm m.d m.a,mul_comm m.d m.b],
       rw[m.det_prop,n.det_prop],
       rw[mul_add,mul_one,mul_add,mul_one,add_mul,one_mul],
       repeat {rw[add_assoc]},congr' 2,
       rw[add_comm,add_assoc],congr' 1,
       rw[add_assoc,add_comm,add_assoc,add_assoc],congr' 1,
       rw[← add_assoc,← add_assoc,add_comm (n.c * n.b)]}⟩⟩

@[simp] theorem mul_a (m n : SL2N) : (m * n).a = m.a * n.a + m.b * n.c := rfl
@[simp] theorem mul_b (m n : SL2N) : (m * n).b = m.a * n.b + m.b * n.d := rfl
@[simp] theorem mul_c (m n : SL2N) : (m * n).c = m.c * n.a + m.d * n.c := rfl
@[simp] theorem mul_d (m n : SL2N) : (m * n).d = m.c * n.b + m.d * n.d := rfl

instance : monoid SL2N := {
 one := has_one.one,
 mul := has_mul.mul,
 mul_assoc := λ m n p,
  by {have : ∀ w x y z : ℕ, w + (x + (y + z)) = w + (y + (x + z)) :=
      by {intros,congr' 1,rw[← add_assoc,← add_assoc,add_comm x]},
      ext;
      simp only [mul_a,mul_b,mul_c,mul_d,add_mul,mul_add,
                 mul_assoc,add_assoc,this],},
 one_mul := λ m, by {ext; simp only[mul_a,mul_b,mul_c,mul_d,
                     one_a,one_b,one_c,one_d,one_mul,zero_mul,
                    add_zero,zero_add],},
 mul_one := λ m, by {ext; simp only[mul_a,mul_b,mul_c,mul_d,
                     one_a,one_b,one_c,one_d,mul_one,mul_zero,
                    add_zero,zero_add],},
}

def S : SL2N := ⟨1,1,0,1,rfl⟩
def T : SL2N := ⟨1,0,1,1,rfl⟩

@[simp] theorem S_a : S.a = 1 := rfl
@[simp] theorem S_b : S.b = 1 := rfl
@[simp] theorem S_c : S.c = 0 := rfl
@[simp] theorem S_d : S.d = 1 := rfl

@[simp] theorem T_a : T.a = 1 := rfl
@[simp] theorem T_b : T.b = 0 := rfl
@[simp] theorem T_c : T.c = 1 := rfl
@[simp] theorem T_d : T.d = 1 := rfl

def S_pow (n : ℕ) : SL2N := ⟨1,n,0,1,by {rw[zero_mul,zero_add,one_mul]}⟩
def T_pow (n : ℕ) : SL2N := ⟨1,0,n,1,by {rw[mul_zero,zero_add,one_mul]}⟩

@[simp] theorem S_pow_a (n : ℕ) : (S_pow n).a = 1 := rfl
@[simp] theorem S_pow_b (n : ℕ) : (S_pow n).b = n := rfl
@[simp] theorem S_pow_c (n : ℕ) : (S_pow n).c = 0 := rfl
@[simp] theorem S_pow_d (n : ℕ) : (S_pow n).d = 1 := rfl

@[simp] theorem T_pow_a (n : ℕ) : (T_pow n).a = 1 := rfl
@[simp] theorem T_pow_b (n : ℕ) : (T_pow n).b = 0 := rfl
@[simp] theorem T_pow_c (n : ℕ) : (T_pow n).c = n := rfl
@[simp] theorem T_pow_d (n : ℕ) : (T_pow n).d = 1 := rfl

@[simp] theorem S_pow_one : S_pow 1 = S := by {ext; refl,}
@[simp] theorem T_pow_one : T_pow 1 = T := by {ext; refl,}

theorem S_pow_eq : ∀ (n : ℕ), S_pow n = S ^ n
| 0 := rfl
| (n + 1) := by {
    rw[pow_succ,← S_pow_eq n],ext;
    simp only[mul_a,mul_b,mul_c,mul_d,
              S_a,S_b,S_c,S_d,S_pow_a,S_pow_b,S_pow_c,S_pow_d,
              zero_mul,mul_zero,one_mul,mul_one],}

theorem T_pow_eq : ∀ (n : ℕ), T_pow n = T ^ n
| 0 := rfl
| (n + 1) := by {
    rw[pow_succ,← T_pow_eq n],ext;
    simp only[mul_a,mul_b,mul_c,mul_d,
              T_a,T_b,T_c,T_d,T_pow_a,T_pow_b,T_pow_c,T_pow_d,
              zero_mul,mul_zero,one_mul,mul_one,add_comm 1 n],}

def ab (m : SL2N) : ℕ := m.a + m.b
def cd (m : SL2N) : ℕ := m.c + m.d

lemma a_pos (m : SL2N) : m.a > 0 :=
begin
 rcases m with ⟨_ | a0,b,c,d,det_prop⟩;
 simp at det_prop ⊢, injection det_prop
end

lemma d_pos (m : SL2N) : m.d > 0 :=
begin
 rcases m with ⟨a,b,c,_ | d0,det_prop⟩;
 simp at det_prop ⊢, injection det_prop
end

def ab_pos (m : SL2N) : 0 < m.ab := nat.add_pos_left m.a_pos _
def cd_pos (m : SL2N) : 0 < m.cd := nat.add_pos_right _ m.d_pos

def aq  (m : SL2N) : ℚ := (m.a  : ℚ)
def bq  (m : SL2N) : ℚ := (m.b  : ℚ)
def cq  (m : SL2N) : ℚ := (m.c  : ℚ)
def dq  (m : SL2N) : ℚ := (m.d  : ℚ)
def abq (m : SL2N) : ℚ := (m.ab : ℚ)
def cdq (m : SL2N) : ℚ := (m.cd : ℚ)

def aq_pos  (m : SL2N) : 0 < m.aq  := int.cast_lt.mpr (int.coe_nat_lt.mpr m.a_pos)
def dq_pos  (m : SL2N) : 0 < m.dq  := int.cast_lt.mpr (int.coe_nat_lt.mpr m.d_pos)
def abq_pos (m : SL2N) : 0 < m.abq := int.cast_lt.mpr (int.coe_nat_lt.mpr m.ab_pos)
def cdq_pos (m : SL2N) : 0 < m.cdq := int.cast_lt.mpr (int.coe_nat_lt.mpr m.cd_pos)

def aq_nz  (m : SL2N) : m.aq  ≠ 0 := (ne_of_lt m.aq_pos ).symm
def dq_nz  (m : SL2N) : m.dq  ≠ 0 := (ne_of_lt m.dq_pos ).symm
def abq_nz (m : SL2N) : m.abq ≠ 0 := (ne_of_lt m.abq_pos).symm
def cdq_nz (m : SL2N) : m.cdq ≠ 0 := (ne_of_lt m.cdq_pos).symm

def au  (m : SL2N) : units ℚ := units.mk0 m.aq  m.aq_nz
def du  (m : SL2N) : units ℚ := units.mk0 m.dq  m.dq_nz
def abu (m : SL2N) : units ℚ := units.mk0 m.abq m.abq_nz
def cdu (m : SL2N) : units ℚ := units.mk0 m.cdq m.cdq_nz

def S_pow_mul (n : ℕ) (m : SL2N) : SL2N  :=
⟨ m.a + n * m.c , m.b + n * m.d,  m.c, m.d,
  by {rw[mul_add,add_mul,← mul_assoc,mul_comm m.c n,m.det_prop,
         add_assoc,add_assoc,add_comm 1],}⟩

@[simp] theorem S_pow_mul_a (n : ℕ) (m : SL2N) : (S_pow_mul n m).a = m.a + n * m.c := rfl
@[simp] theorem S_pow_mul_b (n : ℕ) (m : SL2N) : (S_pow_mul n m).b = m.b + n * m.d := rfl
@[simp] theorem S_pow_mul_c (n : ℕ) (m : SL2N) : (S_pow_mul n m).c = m.c := rfl
@[simp] theorem S_pow_mul_d (n : ℕ) (m : SL2N) : (S_pow_mul n m).d = m.d := rfl

theorem S_pow_mul_eq (n : ℕ) (m : SL2N) : S_pow_mul n m = (S_pow n) * m :=
by {ext;
    simp only[mul_a,mul_b,mul_c,mul_d,
              S_pow_a,S_pow_b,S_pow_c,S_pow_d,
              S_pow_mul_a,S_pow_mul_b,S_pow_mul_c,S_pow_mul_d,
              one_mul,zero_mul,zero_add],}

def T_pow_mul (n : ℕ) (m : SL2N) : SL2N :=
⟨ m.a , m.b, n * m.a + m.c, n * m.b + m.d,
  by {rw[mul_add,add_mul,← mul_assoc,mul_comm m.a n,m.det_prop,
         add_assoc],}⟩

@[simp] theorem T_pow_mul_a (n : ℕ) (m : SL2N) : (T_pow_mul n m).a = m.a := rfl
@[simp] theorem T_pow_mul_b (n : ℕ) (m : SL2N) : (T_pow_mul n m).b = m.b := rfl
@[simp] theorem T_pow_mul_c (n : ℕ) (m : SL2N) : (T_pow_mul n m).c = n * m.a + m.c := rfl
@[simp] theorem T_pow_mul_d (n : ℕ) (m : SL2N) : (T_pow_mul n m).d = n * m.b + m.d := rfl

theorem T_pow_mul_eq (n : ℕ) (m : SL2N) : T_pow_mul n m = (T_pow n) * m :=
by {ext;
    simp only[mul_a,mul_b,mul_c,mul_d,
              T_pow_a,T_pow_b,T_pow_c,T_pow_d,
              T_pow_mul_a,T_pow_mul_b,T_pow_mul_c,T_pow_mul_d,
              one_mul,zero_mul,add_zero],}

theorem S_pow_mul_zero : ∀ (m : SL2N), S_pow_mul 0 m = m :=
 λ ⟨a,b,c,d,dp⟩, by {dsimp[S_pow_mul],ext;simp only[zero_mul,add_zero],}

theorem T_pow_mul_zero : ∀ (m : SL2N), T_pow_mul 0 m = m :=
 λ ⟨a,b,c,d,dp⟩, by {dsimp[T_pow_mul],ext;simp only[zero_mul,zero_add],}

def S_mul : SL2N → SL2N := S_pow_mul  1
def T_mul : SL2N → SL2N := T_pow_mul 1

@[simp] theorem S_mul_a (m : SL2N) : (S_mul m).a = m.a + m.c :=
 by {dsimp[S_mul,S_pow_mul],rw[one_mul]}
@[simp] theorem S_mul_b (m : SL2N) : (S_mul m).b = m.b + m.d :=
 by {dsimp[S_mul,S_pow_mul],rw[one_mul]}
@[simp] theorem S_mul_c (m : SL2N) : (S_mul m).c = m.c := rfl
@[simp] theorem S_mul_d (m : SL2N) : (S_mul m).d = m.d := rfl

@[simp] theorem T_mul_a (m : SL2N) : (T_mul m).a = m.a := rfl
@[simp] theorem T_mul_b (m : SL2N) : (T_mul m).b = m.b := rfl
@[simp] theorem T_mul_c (m : SL2N) : (T_mul m).c = m.a + m.c :=
 by {dsimp[T_mul,S_pow_mul],rw[one_mul]}
@[simp] theorem T_mul_d (m : SL2N) : (T_mul m).d = m.b + m.d :=
 by {dsimp[T_mul,S_pow_mul],rw[one_mul]}

theorem S_mul_eq (m : SL2N) : S_mul m = S * m :=
 by {dsimp[S_mul],rw[S_pow_mul_eq,S_pow_one],}

theorem T_mul_eq (m : SL2N) : T_mul m = T * m :=
 by {dsimp[T_mul],rw[T_pow_mul_eq,T_pow_one],}

theorem db_ca_ineq (m : SL2N) (h : m.d ≤ m.b) : m.c < m.a :=
begin
  let u := m.a - m.c, let v := m.b - m.d,
  have : m.c * m.d < m.a * m.d :=
    m.det_prop.symm ▸ (lt_of_le_of_lt (nat.mul_le_mul_left m.c h)
                        (m.c * m.b).lt_succ_self),
  exact (mul_lt_mul_right m.d_pos).mp this,
end

theorem ac_bd_ineq (m : SL2N) (h : m.a ≤ m.c) : m.b < m.d :=
begin
  let u := m.c - m.a, let v := m.d - m.b,
  have : m.a * m.b < m.a * m.d :=
    m.det_prop.symm ▸ (lt_of_le_of_lt (nat.mul_le_mul_right m.b h)
                       (m.c * m.b).lt_succ_self),
  exact (mul_lt_mul_left m.a_pos).mp this,
end

theorem S_mul_ineq (m : SL2N) :
 (S_mul m).d ≤ (S_mul m).b ∧ (S_mul m).c < (S_mul m).a :=
begin
 suffices : (S_mul m).d ≤ (S_mul m).b,
 {exact ⟨this,db_ca_ineq _ this⟩},
 rw[S_mul_b,S_mul_d], exact nat.le_add_left m.d m.b
end

theorem T_mul_ineq (m : SL2N) :
 (T_mul m).a ≤ (T_mul m).c ∧ (T_mul m).b < (T_mul m).d :=
begin
 suffices : (T_mul m).a ≤ (T_mul m).c,
 {exact ⟨this,ac_bd_ineq _ this⟩},
 rw[T_mul_a,T_mul_c], exact nat.le_add_right m.a m.c
end

def S_div (m : SL2N) (h : m.b ≥ m.d) : SL2N :=
 ⟨m.a - m.c, m.b - m.d, m.c, m.d, by {
  let u := m.a - m.c, let v := m.b - m.d,
  change u * m.d = m.c * v + 1,
  let hm := m.det_prop,
  have h' := m.db_ca_ineq h,
  have : m.b = m.d + v := (nat.add_sub_of_le h).symm,
  rw[this] at hm,
  have : m.a = m.c + u := (nat.add_sub_of_le (le_of_lt h')).symm,
  rw[this,mul_add,add_mul,add_assoc] at hm,
  exact nat.add_left_cancel hm,
 }⟩

def T_div (m : SL2N) (h : m.c ≥ m.a) : SL2N :=
 ⟨m.a, m.b, m.c - m.a, m.d - m.b, by {
  let u := m.c - m.a, let v := m.d - m.b,
  change m.a * v = u * m.b + 1,
  let hm := m.det_prop,
  have h' := m.ac_bd_ineq h,
  have : m.c = m.a + u := (nat.add_sub_of_le h).symm,
  rw[this] at hm,
  have : m.d = m.b + v := (nat.add_sub_of_le (le_of_lt h')).symm,
  rw[this,mul_add,add_mul,add_assoc] at hm,
  exact nat.add_left_cancel hm,
 }⟩

@[simp] theorem S_div_a (m : SL2N) (h) : (S_div m h).a = m.a - m.c := rfl
@[simp] theorem S_div_b (m : SL2N) (h) : (S_div m h).b = m.b - m.d := rfl
@[simp] theorem S_div_c (m : SL2N) (h) : (S_div m h).c = m.c := rfl
@[simp] theorem S_div_d (m : SL2N) (h) : (S_div m h).d = m.d := rfl

@[simp] theorem T_div_a (m : SL2N) (h) : (T_div m h).a = m.a := rfl
@[simp] theorem T_div_b (m : SL2N) (h) : (T_div m h).b = m.b := rfl
@[simp] theorem T_div_c (m : SL2N) (h) : (T_div m h).c = m.c - m.a := rfl
@[simp] theorem T_div_d (m : SL2N) (h) : (T_div m h).d = m.d - m.b := rfl

theorem S_div_mul (m : SL2N) (h) : S_div (S_mul m) h = m :=
by {
 ext; simp only[S_mul_a,S_mul_b,S_mul_c,S_mul_d,
                S_div_a,S_div_b,S_div_c,S_div_d,nat.add_sub_cancel]}

theorem T_div_mul (m : SL2N) (h) : T_div (T_mul m) h = m :=
by {
 ext; simp only[T_mul_a,T_mul_b,T_mul_c,T_mul_d,
                T_div_a,T_div_b,T_div_c,T_div_d,
                add_comm m.a,add_comm m.b,nat.add_sub_cancel]}

theorem S_mul_div {m : SL2N} (h) : S_mul (S_div m h) = m :=
by {let h' := le_of_lt (db_ca_ineq m h),
    ext;
    simp only[S_mul_a,S_mul_b,S_mul_c,S_mul_d,
              S_div_a,S_div_b,S_div_c,S_div_d,
              add_comm,nat.add_sub_of_le h,nat.add_sub_of_le h']}

theorem T_mul_div {m : SL2N} (h) : T_mul (T_div m h) = m :=
by {let h' := le_of_lt (ac_bd_ineq m h),
    ext;
    simp only[T_mul_a,T_mul_b,T_mul_c,T_mul_d,
              T_div_a,T_div_b,T_div_c,T_div_d,
              add_comm,nat.add_sub_of_le h,nat.add_sub_of_le h']}

theorem S_mul_sizeof (m : SL2N) : sizeof (S_mul m) > sizeof m :=
by {dsimp[sizeof,has_sizeof.sizeof],rw[S_mul_a,S_mul_b],
    apply add_lt_add_right,apply add_lt_add_right,
    rw[add_assoc],apply add_lt_add_left,rw[add_comm,add_assoc],
    exact lt_add_of_pos_right m.b (nat.add_pos_left m.d_pos m.c),}

theorem T_mul_sizeof (m : SL2N) : sizeof (T_mul m) > sizeof m :=
by {dsimp[sizeof,has_sizeof.sizeof],rw[T_mul_c,T_mul_d],
    rw[add_assoc (m.a + m.b),add_assoc (m.a + m.b)],
    apply add_lt_add_left,
    rw[add_comm m.a,add_assoc],apply add_lt_add_left,
    rw[← add_assoc],
    exact lt_add_of_pos_left m.d (nat.add_pos_left m.a_pos m.b)}

theorem S_div_sizeof (m : SL2N) (h) : sizeof (S_div m h) < sizeof m :=
 by { rw[← congr_arg sizeof (S_mul_div h)], apply S_mul_sizeof}

theorem T_div_sizeof (m : SL2N) (h) : sizeof (T_div m h) < sizeof m :=
 by { rw[← congr_arg sizeof (T_mul_div h)], apply T_mul_sizeof}

theorem eq_one_iff (m : SL2N) : m = 1 ↔ (m.b < m.d ∧ m.c < m.a) :=
begin
 split; intro h,
 {rw[h,one_a,one_b,one_c,one_d],exact dec_trivial},
 {let u := m.d - (m.b).succ, let v := m.a - (m.c).succ,
  have hu : m.d = m.b + 1 + u :=
   (nat.add_sub_of_le h.left).symm,
  have hv : m.a = m.c + 1 + v :=
   (nat.add_sub_of_le h.right).symm,
  have hd := m.det_prop,
  rw[hu,hv] at hd,
  repeat {rw[mul_add] at hd},repeat {rw[add_mul] at hd},
  repeat {rw[mul_one] at hd},repeat {rw[one_mul] at hd},
  repeat {rw[← add_assoc] at hd},rw[add_comm _ 1,add_comm _ 1] at hd,
  repeat {rw[add_assoc] at hd},
  replace hd := add_left_cancel hd,
  replace hd := add_left_cancel (hd.trans (add_zero _).symm),
  rcases add_eq_zero_iff.mp hd with ⟨eb,hd⟩,
  rw[eb,mul_zero,zero_add] at hd,
  rcases add_eq_zero_iff.mp hd with ⟨ec,hd⟩,
  rw[ec,zero_mul,zero_add] at hd,
  rcases add_eq_zero_iff.mp hd with ⟨ev,hd⟩,
  rw[ev,zero_mul,add_zero] at hd,
  rw[eb,hd,zero_add,add_zero] at hu,
  rw[ec,ev,zero_add,add_zero] at hv,
  ext; simp only[one_a,one_b,one_c,one_d]; assumption,
 }
end

def flip : SL2N →* SL2N := {
  to_fun := λ m, ⟨ m.d,m.c,m.b,m.a, by rw[mul_comm,det_prop,mul_comm]⟩,
  map_one' := by { ext; refl },
  map_mul' := λ m n,
  by {ext; simp only [mul_a,mul_b,mul_c,mul_d,add_comm] }
}

@[simp] theorem flip_a (m : SL2N) : (flip m).a = m.d := rfl
@[simp] theorem flip_b (m : SL2N) : (flip m).b = m.c := rfl
@[simp] theorem flip_c (m : SL2N) : (flip m).c = m.b := rfl
@[simp] theorem flip_d (m : SL2N) : (flip m).d = m.a := rfl

lemma flip_flip : ∀ (m : SL2N), m.flip.flip = m :=
 λ ⟨a,b,c,d,dp⟩, by {constructor}

lemma flip_S : flip S = T := rfl
lemma flip_T : flip T = S := rfl
lemma flip_S_pow (n : ℕ) : flip (S_pow n) = T_pow n := rfl
lemma flip_T_pow (n : ℕ) : flip (T_pow n) = S_pow n := rfl

lemma flip_S_pow_mul  (n : ℕ) : ∀ (m : SL2N), (S_pow_mul  n m).flip = T_pow_mul n m.flip :=
 λ ⟨a,b,c,d,dp⟩,
  by {dsimp[S_pow_mul,T_pow_mul,flip],ext,
      refl,refl,
      exact add_comm b _,exact add_comm a _}

lemma flip_T_pow_mul (n : ℕ) : ∀ (m : SL2N), (T_pow_mul n m).flip = S_pow_mul n m.flip :=
 λ ⟨a,b,c,d,dp⟩,
  by {dsimp[S_pow_mul,T_pow_mul,flip],ext,
      exact (add_comm d _).symm,exact (add_comm c _).symm,
      refl,refl}

def word := list bool

instance word_monoid : monoid word := {
 one := list.nil,
 mul := list.append,
 mul_assoc := list.append_assoc,
 one_mul := list.nil_append,
 mul_one := list.append_nil
}

def word.to_string : word → string
| list.nil := ""
| (list.cons ff w) := string.append "S" (word.to_string w)
| (list.cons tt w) := string.append "T" (word.to_string w)

instance : has_repr word := ⟨word.to_string⟩

def of_word₀ : word → SL2N
| list.nil := 1
| (list.cons ff w) := S_mul (of_word₀ w)
| (list.cons tt w) := T_mul (of_word₀ w)

theorem of_word_append₀ : ∀ (u v : word),
  of_word₀ (list.append u v) = (of_word₀ u) * (of_word₀ v)
| list.nil v := by {
    have h₀ : (list.append list.nil v = v) := list.nil_append v,
    have h₁ : of_word₀ list.nil = 1 := rfl,
    rw[h₀,h₁,one_mul],}
| (list.cons ff u) v := by {
    rw[list.append,of_word₀,of_word₀,of_word_append₀],
    rw[S_mul_eq,S_mul_eq,mul_assoc],}
| (list.cons tt u) v := by {
    rw[list.append,of_word₀,of_word₀,of_word_append₀],
    rw[T_mul_eq,T_mul_eq,mul_assoc],}

def of_word : word →* SL2N := {
  to_fun := of_word₀,
  map_one' := rfl,
  map_mul' := λ u v, of_word_append₀ u v
}

theorem of_word_nil : of_word list.nil = 1 := rfl
theorem of_word_one : of_word 1 = 1 := rfl

theorem of_word_ff (w : word) : of_word (list.cons ff w) = S_mul (of_word w) := rfl
theorem of_word_tt (w : word) : of_word (list.cons tt w) = T_mul (of_word w) := rfl

def to_word₀ (m : SL2N) : word :=
begin
 let r : SL2N → SL2N → Prop := has_well_founded.r,
 let wf : well_founded r := has_well_founded.wf,
 let C : ∀ (m : SL2N), Type := λ m, word,
 let F : ∀ m, ∀ f : (∀ n (h : r n m), C n), C m :=
 λ m f, by {
  by_cases hb : m.b ≥ m.d,
  {exact ff :: (f (S_div m hb) (S_div_sizeof m hb))},
  by_cases hc : m.c ≥ m.a,
  {exact tt :: (f (T_div m hc) (T_div_sizeof m hc))},
  exact 1
 },
 exact @well_founded.fix SL2N C r wf F m
end

theorem to_word_one₀₀
 {m : SL2N} (hb : ¬ (m.d ≤ m.b)) (hc : ¬ (m.a ≤ m.c)) : to_word₀ m = 1 :=
by {dsimp[to_word₀],rw[well_founded.fix_eq,dif_neg hb,dif_neg hc]}

theorem to_word_one₀ : to_word₀ 1 = 1 :=
 by {apply to_word_one₀₀,exact dec_trivial,exact dec_trivial}

theorem to_word_S₀ {m : SL2N} (hb : m.d ≤ m.b) :
 to_word₀ m = ff :: (to_word₀ (S_div m hb)) :=
by {dsimp[to_word₀],rw[well_founded.fix_eq,dif_pos hb]}

theorem to_word_T₀ {m : SL2N} (hc : m.a ≤ m.c) :
 to_word₀ m = tt :: (to_word₀ (T_div m hc)) :=
by {have hb : ¬ (m.d ≤ m.b) :=
     not_le_of_gt (ac_bd_ineq m hc),
    dsimp[to_word₀],rw[well_founded.fix_eq,dif_neg hb,dif_pos hc]}

theorem to_of_word₀ (w : word) : to_word₀ (of_word w) = w :=
begin
 induction w with b w ih,
 {rw[of_word_nil], exact to_word_one₀},
 cases b,
 {rw[of_word_ff,to_word_S₀ (S_mul_ineq (of_word w)).left,S_div_mul,ih]},
 {rw[of_word_tt,to_word_T₀ (T_mul_ineq (of_word w)).left,T_div_mul,ih]},
end

theorem of_to_word₀ (m : SL2N) : of_word (to_word₀ m) = m :=
begin
 let r : SL2N → SL2N → Prop := has_well_founded.r,
 let wf : well_founded r := has_well_founded.wf,
 let C : ∀ (m : SL2N), Prop := λ m, of_word (to_word₀ m) = m,
 let F : ∀ m, ∀ f : (∀ n (h : r n m), C n), C m :=
 λ m f, by {
  by_cases hb : m.b ≥ m.d,
  {let ih : of_word (to_word₀ (S_div m hb)) = S_div m hb :=
    f (S_div m hb) (S_div_sizeof m hb),
   dsimp[C],rw[to_word_S₀ hb,of_word_ff,ih,S_mul_div hb],
  },
  by_cases hc : m.c ≥ m.a,
  {let n := T_div m hc,
   let ih : of_word (to_word₀ (T_div m hc)) = T_div m hc :=
    f (T_div m hc) (T_div_sizeof m hc),
   dsimp[C],rw[to_word_T₀ hc,of_word_tt,ih,T_mul_div hc],
   },
  {dsimp[C],rw[to_word_one₀₀ hb hc,of_word_one],
   exact ((eq_one_iff m).mpr ⟨(lt_of_not_ge hb),(lt_of_not_ge hc)⟩).symm,
  }
 },
 exact @well_founded.fix SL2N C r wf F m,
end

def to_word : SL2N →* word := {
  to_fun := to_word₀,
  map_one' := to_word_one₀,
  map_mul' := λ m n, by {
  let u := to_word₀ m,
  let v := to_word₀ n,
  change to_word₀ (m * n) = u * v,
  have hm : m = of_word u := (of_to_word₀ m).symm,
  have hn : n = of_word v := (of_to_word₀ n).symm,
  rw[hm,hn,← of_word.map_mul,to_of_word₀],
 }
}

theorem to_word_S {m : SL2N} (hb : m.d ≤ m.b) :
 to_word m = ff :: (to_word (S_div m hb)) := to_word_S₀ hb

theorem to_word_T {m : SL2N} (hc : m.a ≤ m.c) :
 to_word m = tt :: (to_word (T_div m hc)) := to_word_T₀ hc

def word_equiv : SL2N ≃* word := {
 to_fun := to_word, inv_fun := of_word,
 map_mul' := to_word.map_mul',
 left_inv := of_to_word₀,
 right_inv := to_of_word₀
}

structure P2 : Type :=
(x : nat) (y : nat) (x_pos : x > 0) (y_pos : y > 0)

namespace P2

@[ext]
theorem ext : ∀ (u₁ u₂ : P2), u₁.x = u₂.x → u₁.y = u₂.y → u₁ = u₂ :=
λ ⟨x₁,y₁,hx₁,hy₁⟩ ⟨x₂,y₂,hx₂,hy₂⟩ hx hy,
by {simp only [] at *,rcases hx,rcases hy,split; refl}

instance : has_sizeof P2 := ⟨λ u, u.x + u.y⟩

def xp : P2 → ℕ+ := λ u, ⟨u.x,u.x_pos⟩
def yp : P2 → ℕ+ := λ u, ⟨u.y,u.y_pos⟩

theorem xp_val (u : P2) : (u.xp).val = u.x := rfl
theorem yp_val (u : P2) : (u.yp).val = u.y := rfl

instance : has_scalar SL2N P2 := {
 smul := λ m u,
  ⟨m.a * u.x + m.b * u.y,
   m.c * u.x + m.d * u.y,
   nat.add_pos_left (mul_pos m.a_pos u.x_pos) _,
   nat.add_pos_right _ (mul_pos m.d_pos u.y_pos)⟩
}

theorem smul_x (m : SL2N) (u : P2) : (m • u).x = m.a * u.x + m.b * u.y := rfl
theorem smul_y (m : SL2N) (u : P2) : (m • u).y = m.c * u.x + m.d * u.y := rfl

theorem S_smul_x (u : P2) : (S • u).x = u.x + u.y :=
 by {change 1 * u.x + 1 * u.y = u.x + u.y,rw[one_mul,one_mul],}
theorem S_smul_y (u : P2) : (S • u).y = u.y :=
 by {change 0 * u.x + 1 * u.y = u.y,rw[zero_mul,one_mul,zero_add],}

theorem T_smul_x (u : P2) : (T • u).x = u.x :=
 by {change 1 * u.x + 0 * u.y = u.x,rw[zero_mul,one_mul,add_zero],}
theorem T_smul_y (u : P2) : (T • u).y = u.x + u.y :=
 by {change 1 * u.x + 1 * u.y = u.x + u.y,rw[one_mul,one_mul],}

instance : mul_action SL2N P2 := {
 smul := has_scalar.smul,
 one_smul := λ u,
  by {ext; simp only [smul_x,smul_y,one_a,one_b,one_c,one_d,
                      one_mul,zero_mul,zero_add,add_zero],},
 mul_smul := λ m n u,
  by {ext,
   {rw[smul_x,smul_x,smul_x,smul_y,
       mul_a,mul_b,add_mul,add_mul,mul_add,mul_add,
       mul_assoc,mul_assoc,mul_assoc,mul_assoc,
       add_assoc,add_assoc],
    congr' 1,rw[← add_assoc,← add_assoc],
    congr' 1,rw[add_comm]},
   {rw[smul_y,smul_y,smul_y,smul_x,
       mul_c,mul_d,add_mul,add_mul,mul_add,mul_add,
       mul_assoc,mul_assoc,mul_assoc,mul_assoc,
       add_assoc,add_assoc],
    congr' 1,rw[← add_assoc,← add_assoc],
    congr' 1,rw[add_comm]},
  }
}

def S_sdiv {u : P2} (h : u.y < u.x) : P2 :=
 {x := u.x - u.y, y := u.y, x_pos := nat.sub_pos_of_lt h, y_pos := u.y_pos}

def T_sdiv {u : P2} (h : u.x < u.y) : P2 :=
 {x := u.x, y := u.y - u.x, x_pos := u.x_pos, y_pos := nat.sub_pos_of_lt h}

@[simp] theorem S_sdiv_x {u : P2} (h) : (@S_sdiv u h).x = u.x - u.y := rfl
@[simp] theorem S_sdiv_y {u : P2} (h) : (@S_sdiv u h).y = u.y := rfl
@[simp] theorem T_sdiv_x {u : P2} (h) : (@T_sdiv u h).x = u.x := rfl
@[simp] theorem T_sdiv_y {u : P2} (h) : (@T_sdiv u h).y = u.y - u.x := rfl

theorem S_sdiv_smul (u : P2) (h) : @S_sdiv (S • u) h = u :=
 by {ext, rw[S_sdiv_x,S_smul_x,S_smul_y,nat.add_sub_cancel],rw[S_sdiv_y,S_smul_y],}

theorem T_sdiv_smul (u : P2) (h) : @T_sdiv (T • u) h = u :=
 by {ext, rw[T_sdiv_x,T_smul_x],rw[T_sdiv_y,T_smul_y,T_smul_x,add_comm,nat.add_sub_cancel],}

theorem S_smul_sdiv (u : P2) (h) : S • (@S_sdiv u h) = u :=
 by {ext,rw[S_smul_x,S_sdiv_x,S_sdiv_y,nat.sub_add_cancel (le_of_lt h)],
         rw[S_smul_y,S_sdiv_y]}

theorem T_smul_sdiv (u : P2) (h) : T • (@T_sdiv u h) = u :=
 by {ext,rw[T_smul_x,T_sdiv_x],
         rw[T_smul_y,T_sdiv_x,T_sdiv_y,add_comm,nat.sub_add_cancel (le_of_lt h)]}

theorem S_sdiv_sizeof {u : P2} (h) : sizeof (@S_sdiv u h) < sizeof u :=
 by { change (u.x - u.y) + u.y < u.x + u.y, rw[nat.sub_add_cancel (le_of_lt h)],
      exact lt_add_of_pos_right u.x u.y_pos}

theorem T_sdiv_sizeof {u : P2} (h) : sizeof (@T_sdiv u h) < sizeof u :=
 by { change u.x + (u.y - u.x) < u.x + u.y, rw[add_comm,nat.sub_add_cancel (le_of_lt h)],
      exact lt_add_of_pos_left u.y u.x_pos}

def xgcd_aux (mu : SL2N × P2) : SL2N × P2 :=
begin
 let r : (SL2N × P2) → (SL2N × P2) → Prop := measure (λ mu,sizeof mu.2),
 have r_iff : ∀ nv mu, r nv mu ↔ nv.2.x + nv.2.y < mu.2.x + mu.2.y :=
  by {intros, refl},
 let wf : well_founded r := measure_wf _,
 let C : ∀ (mu : SL2N × P2), Type := λ mu, SL2N × P2,
 let F : ∀ mu, ∀ f : (∀ nv (h : r nv mu), C nv), C mu :=
 λ mu f, by {
  by_cases hyx : mu.2.y < mu.2.x,
  {exact f ⟨mu.1 * S,S_sdiv hyx⟩ (S_sdiv_sizeof hyx)},
  by_cases hxy : mu.2.x < mu.2.y,
  {exact f ⟨mu.1 * T,T_sdiv hxy⟩ (T_sdiv_sizeof hxy)},
  exact mu
 },
 exact @well_founded.fix (SL2N × P2) C r wf F mu
end

theorem xgcd_aux_S {mu : SL2N × P2} (h : mu.2.y < mu.2.x) :
 xgcd_aux mu = xgcd_aux ⟨mu.1 * S,S_sdiv h⟩ :=
  by {dsimp[xgcd_aux],rw[well_founded.fix_eq,dif_pos h],}

theorem xgcd_aux_T {mu : SL2N × P2} (h : mu.2.x < mu.2.y) :
 xgcd_aux mu = xgcd_aux ⟨mu.1 * T,T_sdiv h⟩ :=
  by {dsimp[xgcd_aux],
      rw[well_founded.fix_eq,dif_neg (not_lt_of_gt h),dif_pos h],}

theorem xgcd_aux_end {mu : SL2N × P2} (h : mu.2.x = mu.2.y) :
 xgcd_aux mu = mu :=
  by {dsimp[xgcd_aux],rw[well_founded.fix_eq],
      have : ¬ (mu.2.y < mu.2.x) := by {rw[h],exact lt_irrefl _},
      rw[dif_neg this],
      have : ¬ (mu.2.x < mu.2.y) := by {rw[h],exact lt_irrefl _},
      rw[dif_neg this]}

def smul' (mu : SL2N × P2) : P2 := mu.1 • mu.2

theorem xgcd_aux_spec (mu : SL2N × P2) :
 smul' (xgcd_aux mu) = smul' mu ∧ ((xgcd_aux mu).2.x = (xgcd_aux mu).2.y) :=
begin
 let r : (SL2N × P2) → (SL2N × P2) → Prop := measure (λ mu,sizeof mu.2),
 have r_iff : ∀ nv mu, r nv mu ↔ nv.2.x + nv.2.y < mu.2.x + mu.2.y :=
  by {intros, refl},
 let wf : well_founded r := measure_wf _,
 let C : ∀ (mu : SL2N × P2), Prop := λ mu,
  smul' (xgcd_aux mu) = smul' mu ∧ ((xgcd_aux mu).2.x = (xgcd_aux mu).2.y),
 let F : ∀ mu, ∀ f : (∀ nv (h : r nv mu), C nv), C mu :=
 λ mu f, by {
  by_cases hyx : mu.2.y < mu.2.x,
  {rcases f ⟨mu.1 * S,S_sdiv hyx⟩ (S_sdiv_sizeof hyx) with ⟨h_smul,h_u⟩,
   split; rw[xgcd_aux_S hyx],
   {rw[h_smul,smul',smul',mul_smul,S_smul_sdiv]},{rw[h_u]}},
  by_cases hxy : mu.2.x < mu.2.y,
  {rcases f ⟨mu.1 * T,T_sdiv hxy⟩ (T_sdiv_sizeof hxy) with ⟨h_smul,h_u⟩,
   split; rw[xgcd_aux_T hxy],
   {rw[h_smul,smul',smul',mul_smul,T_smul_sdiv]},{rw[h_u]}},
  have := le_antisymm (le_of_not_gt hyx) (le_of_not_gt hxy),
  split; rw[xgcd_aux_end this], exact this,
 },
 exact @well_founded.fix (SL2N × P2) C r wf F mu,
end

def xgcd (u : P2) := xgcd_aux ⟨1,u⟩

def gcd (u : P2) := (xgcd u).2.x
def gcd_a (u : P2) := (xgcd u).1.a
def gcd_b (u : P2) := (xgcd u).1.b
def gcd_c (u : P2) := (xgcd u).1.c
def gcd_d (u : P2) := (xgcd u).1.d

theorem gcd_pos (u : P2) : (gcd u) > 0 := (xgcd u).2.x_pos
theorem gcd_a_pos (u : P2) : (gcd_a u) > 0 := (xgcd u).1.a_pos
theorem gcd_d_pos (u : P2) : (gcd_d u) > 0 := (xgcd u).1.d_pos

/- The next two theorems show that (gcd u) is a common divisor of
   u.x and u.y
-/

theorem gcd_x_eq (u : P2) : u.x = (gcd_a u + gcd_b u) * gcd u := by {
 rcases xgcd_aux_spec ⟨1,u⟩ with ⟨h_smul,h_xy⟩,
 rw[smul',smul',one_smul] at h_smul,
 have := congr_arg P2.x h_smul,
 rw[smul_x,h_xy.symm,← add_mul] at this,exact this.symm,
}

theorem gcd_y_eq (u : P2) : u.y = (gcd_c u + gcd_d u) * gcd u := by {
 rcases xgcd_aux_spec ⟨1,u⟩ with ⟨h_smul,h_xy⟩,
 rw[smul',smul',one_smul] at h_smul,
 have := congr_arg P2.y h_smul,
 rw[smul_y,h_xy.symm,← add_mul] at this,exact this.symm,
}

def gcd_det_prop (u : P2) : (gcd_a u) * (gcd_d u) = (gcd_c u) * (gcd_b u) + 1 :=
 (xgcd u).1.det_prop

/-
 Either of the next two theorems proves that (gcd u) is an integral
 linear combination of u.x and u.y, so it really is the gcd.
-/
theorem gcd_eq (u : P2) : gcd u + (gcd_b u) * u.y = (gcd_d u) * u.x :=
 by {symmetry,
     rw[← one_mul (gcd u),add_comm,gcd_x_eq,gcd_y_eq,
        ← mul_assoc,← mul_assoc,← add_mul],congr' 1,
      rw[mul_add,mul_add,mul_comm,gcd_det_prop u,mul_comm],
      rw[add_assoc,add_assoc,add_comm 1,mul_comm (gcd_d u)],}

theorem gcd_eq' (u : P2) : gcd u + (gcd_c u) * u.x = (gcd_a u) * u.y :=
 by {symmetry,
     rw[← one_mul (gcd u),add_comm,gcd_x_eq,gcd_y_eq,
        ← mul_assoc,← mul_assoc,← add_mul],congr' 1,
      rw[mul_add,mul_add,mul_comm,gcd_det_prop u,mul_comm,add_assoc]}

theorem is_gcd (u : P2) : ∀ n : ℕ, n ∣ gcd u ↔ (n ∣ u.x ∧ n ∣ u.y) :=
begin
 intro n,split,
 {intro h,split,
  {rw[gcd_x_eq u],exact dvd_mul_of_dvd_right h _},
  {rw[gcd_y_eq u],exact dvd_mul_of_dvd_right h _}},
 {rintro ⟨hx,hy⟩,
  have h₀ : n ∣ gcd u + (gcd_b u) * u.y :=
   by {rw[gcd_eq u],exact dvd_mul_of_dvd_right hx _},
  have h₁ : n ∣ (gcd_b u) * u.y := dvd_mul_of_dvd_right hy _,
  exact (nat.dvd_add_left h₁).mp h₀,
 }
end

end P2

end SL2N


/-
  If f : A → B has the localization property for a multiplicative S and g : B → C
  is a bijective ring homomorphism, then (g ∘ f) has the localization property for S too.
-/

import algebra.ring
import to_mathlib.localization.localization_alt

universes u v w

noncomputable theory

open localization_alt

variables {A : Type u} {B : Type v} {C : Type w} [comm_ring A] [comm_ring B] [comm_ring C]
variables (S : set A) [is_submonoid S] (f : A → B) [is_ring_hom f] (Hloc : is_localization_data S f)
variables (g : B → C) (Hg₁ : function.bijective g) (Hg₂ : is_ring_hom g)

include Hloc Hg₁ Hg₂

lemma is_localization_data.of_iso.inverts_data : inverts_data S (g ∘ f) :=
begin
  rintros s,
  rcases (Hloc.inverts s) with ⟨w, Hw⟩,
  use (g w),
  rw [←is_ring_hom.map_mul g, Hw, is_ring_hom.map_one g],
end

lemma is_localization_data.of_iso.has_denom : has_denom S (g ∘ f) :=
begin
  intros x,
  rw function.bijective_iff_has_inverse at Hg₁,
  rcases Hg₁ with ⟨h, Hhleft, Hhright⟩,
  rcases (Hloc.has_denom (h x)) with ⟨pq, Hpq⟩,
  replace Hpq := congr_arg g Hpq,
  rw is_ring_hom.map_mul g at Hpq,
  rw Hhright at Hpq,
  use [pq, Hpq],
end

lemma is_localization_data.of_iso.has_denom_data : has_denom_data S (g ∘ f) :=
has_denom_some S (g ∘ f) (is_localization_data.of_iso.has_denom S f Hloc g Hg₁ Hg₂)

lemma is_localization_data.of_iso.ker_le : ker (g ∘ f) ≤ submonoid_ann S :=
begin
  intros x Hx,
  rw function.bijective_iff_has_inverse at Hg₁,
  rcases Hg₁ with ⟨h, Hhleft, Hhright⟩,
  change g (f x) = 0 at Hx,
  replace Hx := congr_arg h Hx,
  rw ←is_ring_hom.map_zero g at Hx,
  iterate 2 { rw Hhleft at Hx, },
  exact Hloc.ker_le Hx,
end

lemma is_localization_data.of_iso : is_localization_data S (g ∘ f) :=
{ inverts := is_localization_data.of_iso.inverts_data S f Hloc g Hg₁ Hg₂,
  has_denom := is_localization_data.of_iso.has_denom_data S f Hloc g Hg₁ Hg₂,
  ker_le := is_localization_data.of_iso.ker_le S f Hloc g Hg₁ Hg₂, }


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import analysis.calculus.conformal.normed_space
import geometry.euclidean.angle.unoriented.basic

/-!
# Angles and conformal maps

This file proves that conformal maps preserve angles.

-/

namespace inner_product_geometry

variables {E F : Type*}
variables [normed_add_comm_group E] [normed_add_comm_group F]
variables [inner_product_space ℝ E] [inner_product_space ℝ F]

lemma is_conformal_map.preserves_angle {f' : E →L[ℝ] F} (h : is_conformal_map f') (u v : E) :
  angle (f' u) (f' v) = angle u v :=
begin
  obtain ⟨c, hc, li, rfl⟩ := h,
  exact (angle_smul_smul hc _ _).trans (li.angle_map _ _)
end

/-- If a real differentiable map `f` is conformal at a point `x`,
    then it preserves the angles at that point. -/
lemma conformal_at.preserves_angle {f : E → F} {x : E} {f' : E →L[ℝ] F}
  (h : has_fderiv_at f f' x) (H : conformal_at f x) (u v : E) :
  angle (f' u) (f' v) = angle u v :=
let ⟨f₁, h₁, c⟩ := H in h₁.unique h ▸ is_conformal_map.preserves_angle c u v

end inner_product_geometry


-- Copyright (C) 2020 by @ljt12138

import propositional.basics tactic.tauto

namespace prop_logic

lemma ax1_valid {α : Type} {φ ψ : sentence α} : tautology (Ax1 φ ψ) :=
begin
  unfold Ax1 tautology, simp, tauto
end

lemma ax1_conseq {α : Type} {φ ψ : sentence α} {Γ : _} : Γ ⊨ Ax1 φ ψ :=
begin
  unfold Ax1 logical_consequence contradiction_set, simp,
  intros a, existsi _, split,
  { left, refl },
  { unfold evaluate, intro contra, apply contra, tauto }
end

lemma ax2_valid {α : Type} {φ ψ γ : sentence α} : tautology (Ax2 φ ψ γ) :=
begin
  unfold Ax2 tautology, simp, intros, exact a a_2 (a_1 a_2)
end

lemma ax2_conseq {α : Type} {φ ψ γ : sentence α} {Γ : _} : Γ ⊨ Ax2 φ ψ γ :=
begin
  unfold Ax2 logical_consequence contradiction_set, simp,
  intros a, existsi _, split,
  { left, refl },
  { unfold evaluate, intro contra, apply contra, intros, exact a_1 a_3 (a_2 a_3) }
end

lemma ax3_valid {α : Type} {φ : sentence α} : tautology (Ax3 φ) :=
begin
  unfold Ax3 tautology, simp, classical, tauto
end

lemma ax3_conseq {α : Type} {φ : sentence α} {Γ : _} : Γ ⊨ Ax3 φ :=
begin
  unfold Ax3 logical_consequence contradiction_set, simp,
  intros a, existsi _, split,
  { left, refl },
  { unfold evaluate, intro contra, apply contra, classical, tauto }
end

lemma mp_valid {α : Type} {φ ψ : sentence α} :
               tautology (φ ↣ ψ) → tautology φ → tautology ψ :=
begin
  unfold tautology, simp at *, tauto
end

lemma mp_conseq {α : Type} {φ ψ : sentence α} {Γ : _} :
  Γ ⊨ φ ↣ ψ → Γ ⊨ φ → Γ ⊨ ψ :=
begin
  intros a a',
  unfold logical_consequence contradiction_set at *, simp at *,
  intros V, cases a' V, cases a V,
  cases h, cases h_1,
  cases h_left,
  case or.inl {
    rewrite h_left at *,
    cases h_1_left,
    case or.inl {
      existsi _, split, {left, refl},
      rewrite h_1_left at *,
      unfold evaluate at *, classical, tauto,
    },
    case or.inr {
      existsi _, split, {right, assumption},
      assumption
    }
  },
  case or.inr {
    existsi _, split, {right, assumption},
    assumption
  }
end

theorem weak_soundness {α : Type} {φ : sentence α} :
        ∅ ⊢ φ → tautology φ :=
begin
  intros a, cases a,
  induction a_h,
  { exact ax1_valid },
  { exact ax2_valid },
  { exact ax3_valid },
  { apply mp_valid, assumption, assumption },
  { cases a_h_a }
end

theorem strong_soundness {α : Type} {φ : sentence α} {Γ : _} :
        Γ ⊢ φ → Γ ⊨ φ :=
begin
  intros a, cases a,
  induction a_h,
  { exact ax1_conseq },
  { exact ax2_conseq },
  { exact ax3_conseq },
  { apply mp_conseq, assumption, assumption },
  {
    unfold logical_consequence contradiction_set, intros V,
    have ht := classical.em (evaluate V a_h_φ), cases ht,
    { existsi a_h_φ↣⊥, split, {left, refl}, {simp, assumption} },
    { existsi a_h_φ, split, {right, assumption}, {assumption} }
  }
end

end prop_logic


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

! This file was ported from Lean 3 source module order.filter.partial
! leanprover-community/mathlib commit b363547b3113d350d053abdf2884e9850a56b205
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Filter.Basic
import Mathlib.Data.PFun

/-!
# `Tendsto` for relations and partial functions

This file generalizes `Filter` definitions from functions to partial functions and relations.

## Considering functions and partial functions as relations

A function `f : α → β` can be considered as the relation `Rel α β` which relates `x` and `f x` for
all `x`, and nothing else. This relation is called `Function.Graph f`.

A partial function `f : α →. β` can be considered as the relation `Rel α β` which relates `x` and
`f x` for all `x` for which `f x` exists, and nothing else. This relation is called
`PFun.Graph' f`.

In this regard, a function is a relation for which every element in `α` is related to exactly one
element in `β` and a partial function is a relation for which every element in `α` is related to at
most one element in `β`.

This file leverages this analogy to generalize `Filter` definitions from functions to partial
functions and relations.

## Notes

`Set.preimage` can be generalized to relations in two ways:
* `Rel.preimage` returns the image of the set under the inverse relation.
* `Rel.core` returns the set of elements that are only related to those in the set.
Both generalizations are sensible in the context of filters, so `Filter.comap` and `Filter.Tendsto`
get two generalizations each.

We first take care of relations. Then the definitions for partial functions are taken as special
cases of the definitions for relations.
-/

universe u v w

namespace Filter

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

open Filter

/-! ### Relations -/

/-- The forward map of a filter under a relation. Generalization of `Filter.map` to relations. Note
that `Rel.core` generalizes `Set.preimage`. -/
def rmap (r : Rel α β) (l : Filter α) : Filter β where
  sets := { s | r.core s ∈ l }
  univ_sets := by simp
  sets_of_superset hs st := mem_of_superset hs (Rel.core_mono _ st)
  inter_sets hs ht := by
    simp only [Set.mem_setOf_eq]
    convert inter_mem hs ht
    rw [←Rel.core_inter]
#align filter.rmap Filter.rmap

theorem rmap_sets (r : Rel α β) (l : Filter α) : (l.rmap r).sets = r.core ⁻¹' l.sets :=
  rfl
#align filter.rmap_sets Filter.rmap_sets

@[simp]
theorem mem_rmap (r : Rel α β) (l : Filter α) (s : Set β) : s ∈ l.rmap r ↔ r.core s ∈ l :=
  Iff.rfl
#align filter.mem_rmap Filter.mem_rmap

@[simp]
theorem rmap_rmap (r : Rel α β) (s : Rel β γ) (l : Filter α) :
    rmap s (rmap r l) = rmap (r.comp s) l :=
  filter_eq <| by simp [rmap_sets, Set.preimage, Rel.core_comp]
#align filter.rmap_rmap Filter.rmap_rmap

@[simp]
theorem rmap_compose (r : Rel α β) (s : Rel β γ) : rmap s ∘ rmap r = rmap (r.comp s) :=
  funext <| rmap_rmap _ _
#align filter.rmap_compose Filter.rmap_compose

/-- Generic "limit of a relation" predicate. `Rtendsto r l₁ l₂` asserts that for every
`l₂`-neighborhood `a`, the `r`-core of `a` is an `l₁`-neighborhood. One generalization of
`Filter.Tendsto` to relations. -/
def Rtendsto (r : Rel α β) (l₁ : Filter α) (l₂ : Filter β) :=
  l₁.rmap r ≤ l₂
#align filter.rtendsto Filter.Rtendsto

theorem rtendsto_def (r : Rel α β) (l₁ : Filter α) (l₂ : Filter β) :
    Rtendsto r l₁ l₂ ↔ ∀ s ∈ l₂, r.core s ∈ l₁ :=
  Iff.rfl
#align filter.rtendsto_def Filter.rtendsto_def

/-- One way of taking the inverse map of a filter under a relation. One generalization of
`Filter.comap` to relations. Note that `Rel.core` generalizes `Set.preimage`. -/
def rcomap (r : Rel α β) (f : Filter β) : Filter α where
  sets := Rel.image (fun s t => r.core s ⊆ t) f.sets
  univ_sets := ⟨Set.univ, univ_mem, Set.subset_univ _⟩
  sets_of_superset := fun ⟨a', ha', ma'a⟩ ab => ⟨a', ha', ma'a.trans ab⟩
  inter_sets := fun ⟨a', ha₁, ha₂⟩ ⟨b', hb₁, hb₂⟩ =>
    ⟨a' ∩ b', inter_mem ha₁ hb₁, (r.core_inter a' b').subset.trans (Set.inter_subset_inter ha₂ hb₂)⟩
#align filter.rcomap Filter.rcomap

theorem rcomap_sets (r : Rel α β) (f : Filter β) :
    (rcomap r f).sets = Rel.image (fun s t => r.core s ⊆ t) f.sets :=
  rfl
#align filter.rcomap_sets Filter.rcomap_sets

theorem rcomap_rcomap (r : Rel α β) (s : Rel β γ) (l : Filter γ) :
    rcomap r (rcomap s l) = rcomap (r.comp s) l :=
  filter_eq <| by
    ext t; simp [rcomap_sets, Rel.image, Rel.core_comp]; constructor
    · rintro ⟨u, ⟨v, vsets, hv⟩, h⟩
      exact ⟨v, vsets, Set.Subset.trans (Rel.core_mono _ hv) h⟩
    rintro ⟨t, tsets, ht⟩
    exact ⟨Rel.core s t, ⟨t, tsets, Set.Subset.rfl⟩, ht⟩
#align filter.rcomap_rcomap Filter.rcomap_rcomap

@[simp]

theorem rtendsto_iff_le_rcomap (r : Rel α β) (l₁ : Filter α) (l₂ : Filter β) :
    Rtendsto r l₁ l₂ ↔ l₁ ≤ l₂.rcomap r := by
  rw [rtendsto_def]
  simp_rw [←l₂.mem_sets]
  simp [Filter.le_def, rcomap, Rel.mem_image]; constructor
  · exact fun h s t tl₂ => mem_of_superset (h t tl₂)
  · exact fun h t tl₂ => h _ t tl₂ Set.Subset.rfl
#align filter.rtendsto_iff_le_rcomap Filter.rtendsto_iff_le_rcomap

-- Interestingly, there does not seem to be a way to express this relation using a forward map.
-- Given a filter `f` on `α`, we want a filter `f'` on `β` such that `r.preimage s ∈ f` if
-- and only if `s ∈ f'`. But the intersection of two sets satisfying the lhs may be empty.
/-- One way of taking the inverse map of a filter under a relation. Generalization of `Filter.comap`
to relations. -/
def rcomap' (r : Rel α β) (f : Filter β) : Filter α where
  sets := Rel.image (fun s t => r.preimage s ⊆ t) f.sets
  univ_sets := ⟨Set.univ, univ_mem, Set.subset_univ _⟩
  sets_of_superset := fun ⟨a', ha', ma'a⟩ ab => ⟨a', ha', ma'a.trans ab⟩
  inter_sets := fun ⟨a', ha₁, ha₂⟩ ⟨b', hb₁, hb₂⟩ =>
    ⟨a' ∩ b', inter_mem ha₁ hb₁,
      (@Rel.preimage_inter _ _ r _ _).trans (Set.inter_subset_inter ha₂ hb₂)⟩
#align filter.rcomap' Filter.rcomap'

@[simp]
theorem mem_rcomap' (r : Rel α β) (l : Filter β) (s : Set α) :
    s ∈ l.rcomap' r ↔ ∃ t ∈ l, r.preimage t ⊆ s :=
  Iff.rfl
#align filter.mem_rcomap' Filter.mem_rcomap'

theorem rcomap'_sets (r : Rel α β) (f : Filter β) :
    (rcomap' r f).sets = Rel.image (fun s t => r.preimage s ⊆ t) f.sets :=
  rfl
#align filter.rcomap'_sets Filter.rcomap'_sets

@[simp]
theorem rcomap'_rcomap' (r : Rel α β) (s : Rel β γ) (l : Filter γ) :
    rcomap' r (rcomap' s l) = rcomap' (r.comp s) l :=
  Filter.ext fun t => by
    simp only [mem_rcomap', Rel.preimage_comp]
    constructor
    · rintro ⟨u, ⟨v, vsets, hv⟩, h⟩
      exact ⟨v, vsets, (Rel.preimage_mono _ hv).trans h⟩
    rintro ⟨t, tsets, ht⟩
    exact ⟨s.preimage t, ⟨t, tsets, Set.Subset.rfl⟩, ht⟩
#align filter.rcomap'_rcomap' Filter.rcomap'_rcomap'

@[simp]
theorem rcomap'_compose (r : Rel α β) (s : Rel β γ) : rcomap' r ∘ rcomap' s = rcomap' (r.comp s) :=
  funext <| rcomap'_rcomap' _ _
#align filter.rcomap'_compose Filter.rcomap'_compose

/-- Generic "limit of a relation" predicate. `Rtendsto' r l₁ l₂` asserts that for every
`l₂`-neighborhood `a`, the `r`-preimage of `a` is an `l₁`-neighborhood. One generalization of
`Filter.Tendsto` to relations. -/
def Rtendsto' (r : Rel α β) (l₁ : Filter α) (l₂ : Filter β) :=
  l₁ ≤ l₂.rcomap' r
#align filter.rtendsto' Filter.Rtendsto'

theorem rtendsto'_def (r : Rel α β) (l₁ : Filter α) (l₂ : Filter β) :
    Rtendsto' r l₁ l₂ ↔ ∀ s ∈ l₂, r.preimage s ∈ l₁ := by
  unfold Rtendsto' rcomap'; simp [le_def, Rel.mem_image]; constructor
  · exact fun h s hs => h _ _ hs Set.Subset.rfl
  · exact fun h s t ht => mem_of_superset (h t ht)
#align filter.rtendsto'_def Filter.rtendsto'_def

theorem tendsto_iff_rtendsto (l₁ : Filter α) (l₂ : Filter β) (f : α → β) :
    Tendsto f l₁ l₂ ↔ Rtendsto (Function.graph f) l₁ l₂ := by
  simp [tendsto_def, Function.graph, rtendsto_def, Rel.core, Set.preimage]
#align filter.tendsto_iff_rtendsto Filter.tendsto_iff_rtendsto

theorem tendsto_iff_rtendsto' (l₁ : Filter α) (l₂ : Filter β) (f : α → β) :
    Tendsto f l₁ l₂ ↔ Rtendsto' (Function.graph f) l₁ l₂ := by
  simp [tendsto_def, Function.graph, rtendsto'_def, Rel.preimage_def, Set.preimage]
#align filter.tendsto_iff_rtendsto' Filter.tendsto_iff_rtendsto'

/-! ### Partial functions -/

/-- The forward map of a filter under a partial function. Generalization of `Filter.map` to partial
functions. -/
def pmap (f : α →. β) (l : Filter α) : Filter β :=
  Filter.rmap f.graph' l
#align filter.pmap Filter.pmap

@[simp]
theorem mem_pmap (f : α →. β) (l : Filter α) (s : Set β) : s ∈ l.pmap f ↔ f.core s ∈ l :=
  Iff.rfl
#align filter.mem_pmap Filter.mem_pmap

/-- Generic "limit of a partial function" predicate. `Ptendsto r l₁ l₂` asserts that for every
`l₂`-neighborhood `a`, the `p`-core of `a` is an `l₁`-neighborhood. One generalization of
`Filter.Tendsto` to partial function. -/
def Ptendsto (f : α →. β) (l₁ : Filter α) (l₂ : Filter β) :=
  l₁.pmap f ≤ l₂
#align filter.ptendsto Filter.Ptendsto

theorem ptendsto_def (f : α →. β) (l₁ : Filter α) (l₂ : Filter β) :
    Ptendsto f l₁ l₂ ↔ ∀ s ∈ l₂, f.core s ∈ l₁ :=
  Iff.rfl
#align filter.ptendsto_def Filter.ptendsto_def

theorem ptendsto_iff_rtendsto (l₁ : Filter α) (l₂ : Filter β) (f : α →. β) :
    Ptendsto f l₁ l₂ ↔ Rtendsto f.graph' l₁ l₂ :=
  Iff.rfl
#align filter.ptendsto_iff_rtendsto Filter.ptendsto_iff_rtendsto

theorem pmap_res (l : Filter α) (s : Set α) (f : α → β) : pmap (PFun.res f s) l = map f (l ⊓ 𝓟 s) :=
  by
  ext t
  simp only [PFun.core_res, mem_pmap, mem_map, mem_inf_principal, imp_iff_not_or]
  rfl
#align filter.pmap_res Filter.pmap_res

theorem tendsto_iff_ptendsto (l₁ : Filter α) (l₂ : Filter β) (s : Set α) (f : α → β) :
    Tendsto f (l₁ ⊓ 𝓟 s) l₂ ↔ Ptendsto (PFun.res f s) l₁ l₂ := by
  simp only [Tendsto, Ptendsto, pmap_res]
#align filter.tendsto_iff_ptendsto Filter.tendsto_iff_ptendsto

theorem tendsto_iff_ptendsto_univ (l₁ : Filter α) (l₂ : Filter β) (f : α → β) :
    Tendsto f l₁ l₂ ↔ Ptendsto (PFun.res f Set.univ) l₁ l₂ := by
  rw [← tendsto_iff_ptendsto]
  simp [principal_univ]
#align filter.tendsto_iff_ptendsto_univ Filter.tendsto_iff_ptendsto_univ

/-- Inverse map of a filter under a partial function. One generalization of `Filter.comap` to
partial functions. -/
def pcomap' (f : α →. β) (l : Filter β) : Filter α :=
  Filter.rcomap' f.graph' l
#align filter.pcomap' Filter.pcomap'

/-- Generic "limit of a partial function" predicate. `Ptendsto' r l₁ l₂` asserts that for every
`l₂`-neighborhood `a`, the `p`-preimage of `a` is an `l₁`-neighborhood. One generalization of
`Filter.Tendsto` to partial functions. -/
def Ptendsto' (f : α →. β) (l₁ : Filter α) (l₂ : Filter β) :=
  l₁ ≤ l₂.rcomap' f.graph'
#align filter.ptendsto' Filter.Ptendsto'

theorem ptendsto'_def (f : α →. β) (l₁ : Filter α) (l₂ : Filter β) :
    Ptendsto' f l₁ l₂ ↔ ∀ s ∈ l₂, f.preimage s ∈ l₁ :=
  rtendsto'_def _ _ _
#align filter.ptendsto'_def Filter.ptendsto'_def

theorem ptendsto_of_ptendsto' {f : α →. β} {l₁ : Filter α} {l₂ : Filter β} :
    Ptendsto' f l₁ l₂ → Ptendsto f l₁ l₂ := by
  rw [ptendsto_def, ptendsto'_def]
  exact fun h s sl₂ => mem_of_superset (h s sl₂) (PFun.preimage_subset_core _ _)
#align filter.ptendsto_of_ptendsto' Filter.ptendsto_of_ptendsto'

theorem ptendsto'_of_ptendsto {f : α →. β} {l₁ : Filter α} {l₂ : Filter β} (h : f.Dom ∈ l₁) :
    Ptendsto f l₁ l₂ → Ptendsto' f l₁ l₂ := by
  rw [ptendsto_def, ptendsto'_def]
  intro h' s sl₂
  rw [PFun.preimage_eq]
  exact inter_mem (h' s sl₂) h
#align filter.ptendsto'_of_ptendsto Filter.ptendsto'_of_ptendsto

end Filter