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

! This file was ported from Lean 3 source module ring_theory.is_adjoin_root
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.AlgebraMap
import Mathbin.FieldTheory.Minpoly.IsIntegrallyClosed
import Mathbin.RingTheory.PowerBasis

/-!
# A predicate on adjoining roots of polynomial

This file defines a predicate `is_adjoin_root S f`, which states that the ring `S` can be
constructed by adjoining a specified root of the polynomial `f : R[X]` to `R`.
This predicate is useful when the same ring can be generated by adjoining the root of different
polynomials, and you want to vary which polynomial you're considering.

The results in this file are intended to mirror those in `ring_theory.adjoin_root`,
in order to provide an easier way to translate results from one to the other.

## Motivation

`adjoin_root` presents one construction of a ring `R[α]`. However, it is possible to obtain
rings of this form in many ways, such as `number_field.ring_of_integers ℚ(√-5)`,
or `algebra.adjoin R {α, α^2}`, or `intermediate_field.adjoin R {α, 2 - α}`,
or even if we want to view `ℂ` as adjoining a root of `X^2 + 1` to `ℝ`.

## Main definitions

The two main predicates in this file are:

 * `is_adjoin_root S f`: `S` is generated by adjoining a specified root of `f : R[X]` to `R`
 * `is_adjoin_root_monic S f`: `S` is generated by adjoining a root of the monic polynomial
   `f : R[X]` to `R`

Using `is_adjoin_root` to map into `S`:

 * `is_adjoin_root.map`: inclusion from `R[X]` to `S`
 * `is_adjoin_root.root`: the specific root adjoined to `R` to give `S`

Using `is_adjoin_root` to map out of `S`:

 * `is_adjoin_root.repr`: choose a non-unique representative in `R[X]`
 * `is_adjoin_root.lift`, `is_adjoin_root.lift_hom`: lift a morphism `R →+* T` to `S →+* T`
 * `is_adjoin_root_monic.mod_by_monic_hom`: a unique representative in `R[X]` if `f` is monic

## Main results

 * `adjoin_root.is_adjoin_root` and `adjoin_root.is_adjoin_root_monic`:
   `adjoin_root` satisfies the conditions on `is_adjoin_root`(`_monic`)
 * `is_adjoin_root_monic.power_basis`: the `root` generates a power basis on `S` over `R`
 * `is_adjoin_root.aequiv`: algebra isomorphism showing adjoining a root gives a unique ring
   up to isomorphism
 * `is_adjoin_root.of_equiv`: transfer `is_adjoin_root` across an algebra isomorphism
 * `is_adjoin_root_eq.minpoly_eq`: the minimal polynomial of the adjoined root of `f` is equal to
   `f`, if `f` is irreducible and monic, and `R` is a GCD domain
-/

open Polynomial

open Polynomial

noncomputable section

universe u v

section MoveMe

end MoveMe

-- This class doesn't really make sense on a predicate
/-- `is_adjoin_root S f` states that the ring `S` can be constructed by adjoining a specified root
of the polynomial `f : R[X]` to `R`.

Compare `power_basis R S`, which does not explicitly specify which polynomial we adjoin a root of
(in particular `f` does not need to be the minimal polynomial of the root we adjoin),
and `adjoin_root` which constructs a new type.

This is not a typeclass because the choice of root given `S` and `f` is not unique.
-/
@[nolint has_nonempty_instance]
structure IsAdjoinRoot {R : Type u} (S : Type v) [CommSemiring R] [Semiring S] [Algebra R S]
  (f : R[X]) : Type max u v where
  map : R[X] →+* S
  map_surjective : Function.Surjective map
  ker_map : RingHom.ker map = Ideal.span {f}
  algebraMap_eq : algebraMap R S = map.comp Polynomial.C
#align is_adjoin_root IsAdjoinRoot

-- This class doesn't really make sense on a predicate
/-- `is_adjoin_root_monic S f` states that the ring `S` can be constructed by adjoining a specified
root of the monic polynomial `f : R[X]` to `R`.

As long as `f` is monic, there is a well-defined representation of elements of `S` as polynomials
in `R[X]` of degree lower than `deg f` (see `mod_by_monic_hom` and `coeff`). In particular,
we have `is_adjoin_root_monic.power_basis`.

Bundling `monic` into this structure is very useful when working with explicit `f`s such as
`X^2 - C a * X - C b` since it saves you carrying around the proofs of monicity.
-/
@[nolint has_nonempty_instance]
structure IsAdjoinRootMonic {R : Type u} (S : Type v) [CommSemiring R] [Semiring S] [Algebra R S]
  (f : R[X]) extends IsAdjoinRoot S f where
  Monic : Monic f
#align is_adjoin_root_monic IsAdjoinRootMonic

section Ring

variable {R : Type u} {S : Type v} [CommRing R] [Ring S] {f : R[X]} [Algebra R S]

namespace IsAdjoinRoot

/-- `(h : is_adjoin_root S f).root` is the root of `f` that can be adjoined to generate `S`. -/
def root (h : IsAdjoinRoot S f) : S :=
  h.map X
#align is_adjoin_root.root IsAdjoinRoot.root

theorem subsingleton (h : IsAdjoinRoot S f) [Subsingleton R] : Subsingleton S :=
  h.map_surjective.Subsingleton
#align is_adjoin_root.subsingleton IsAdjoinRoot.subsingleton

theorem algebraMap_apply (h : IsAdjoinRoot S f) (x : R) :
    algebraMap R S x = h.map (Polynomial.C x) := by rw [h.algebra_map_eq, RingHom.comp_apply]
#align is_adjoin_root.algebra_map_apply IsAdjoinRoot.algebraMap_apply

@[simp]
theorem mem_ker_map (h : IsAdjoinRoot S f) {p} : p ∈ RingHom.ker h.map ↔ f ∣ p := by
  rw [h.ker_map, Ideal.mem_span_singleton]
#align is_adjoin_root.mem_ker_map IsAdjoinRoot.mem_ker_map

theorem map_eq_zero_iff (h : IsAdjoinRoot S f) {p} : h.map p = 0 ↔ f ∣ p := by
  rw [← h.mem_ker_map, RingHom.mem_ker]
#align is_adjoin_root.map_eq_zero_iff IsAdjoinRoot.map_eq_zero_iff

@[simp]
theorem map_x (h : IsAdjoinRoot S f) : h.map X = h.root :=
  rfl
#align is_adjoin_root.map_X IsAdjoinRoot.map_x

@[simp]
theorem map_self (h : IsAdjoinRoot S f) : h.map f = 0 :=
  h.map_eq_zero_iff.mpr dvd_rfl
#align is_adjoin_root.map_self IsAdjoinRoot.map_self

@[simp]
theorem aeval_eq (h : IsAdjoinRoot S f) (p : R[X]) : aeval h.root p = h.map p :=
  Polynomial.induction_on p (fun x => by rw [aeval_C, h.algebra_map_apply])
    (fun p q ihp ihq => by rw [AlgHom.map_add, RingHom.map_add, ihp, ihq]) fun n x ih => by
    rw [AlgHom.map_mul, aeval_C, AlgHom.map_pow, aeval_X, RingHom.map_mul, ← h.algebra_map_apply,
      RingHom.map_pow, map_X]
#align is_adjoin_root.aeval_eq IsAdjoinRoot.aeval_eq

@[simp]
theorem aeval_root (h : IsAdjoinRoot S f) : aeval h.root f = 0 := by rw [aeval_eq, map_self]
#align is_adjoin_root.aeval_root IsAdjoinRoot.aeval_root

/-- Choose an arbitrary representative so that `h.map (h.repr x) = x`.

If `f` is monic, use `is_adjoin_root_monic.mod_by_monic_hom` for a unique choice of representative.
-/
def repr (h : IsAdjoinRoot S f) (x : S) : R[X] :=
  (h.map_surjective x).some
#align is_adjoin_root.repr IsAdjoinRoot.repr

theorem map_repr (h : IsAdjoinRoot S f) (x : S) : h.map (h.repr x) = x :=
  (h.map_surjective x).choose_spec
#align is_adjoin_root.map_repr IsAdjoinRoot.map_repr

/-- `repr` preserves zero, up to multiples of `f` -/
theorem repr_zero_mem_span (h : IsAdjoinRoot S f) : h.repr 0 ∈ Ideal.span ({f} : Set R[X]) := by
  rw [← h.ker_map, RingHom.mem_ker, h.map_repr]
#align is_adjoin_root.repr_zero_mem_span IsAdjoinRoot.repr_zero_mem_span

/-- `repr` preserves addition, up to multiples of `f` -/
theorem repr_add_sub_repr_add_repr_mem_span (h : IsAdjoinRoot S f) (x y : S) :
    h.repr (x + y) - (h.repr x + h.repr y) ∈ Ideal.span ({f} : Set R[X]) := by
  rw [← h.ker_map, RingHom.mem_ker, map_sub, h.map_repr, map_add, h.map_repr, h.map_repr, sub_self]
#align is_adjoin_root.repr_add_sub_repr_add_repr_mem_span IsAdjoinRoot.repr_add_sub_repr_add_repr_mem_span

/-- Extensionality of the `is_adjoin_root` structure itself. See `is_adjoin_root_monic.ext_elem`
for extensionality of the ring elements. -/
theorem ext_map (h h' : IsAdjoinRoot S f) (eq : ∀ x, h.map x = h'.map x) : h = h' :=
  by
  cases h; cases h'; congr
  exact RingHom.ext Eq
#align is_adjoin_root.ext_map IsAdjoinRoot.ext_map

/-- Extensionality of the `is_adjoin_root` structure itself. See `is_adjoin_root_monic.ext_elem`
for extensionality of the ring elements. -/
@[ext]
theorem ext (h h' : IsAdjoinRoot S f) (eq : h.root = h'.root) : h = h' :=
  h.ext_map h' fun x => by rw [← h.aeval_eq, ← h'.aeval_eq, Eq]
#align is_adjoin_root.ext IsAdjoinRoot.ext

section lift

variable {T : Type _} [CommRing T] {i : R →+* T} {x : T} (hx : f.eval₂ i x = 0)

include hx

/-- Auxiliary lemma for `is_adjoin_root.lift` -/
theorem eval₂_repr_eq_eval₂_of_map_eq (h : IsAdjoinRoot S f) (z : S) (w : R[X])
    (hzw : h.map w = z) : (h.repr z).eval₂ i x = w.eval₂ i x :=
  by
  rw [eq_comm, ← sub_eq_zero, ← h.map_repr z, ← map_sub, h.map_eq_zero_iff] at hzw
  obtain ⟨y, hy⟩ := hzw
  rw [← sub_eq_zero, ← eval₂_sub, hy, eval₂_mul, hx, MulZeroClass.zero_mul]
#align is_adjoin_root.eval₂_repr_eq_eval₂_of_map_eq IsAdjoinRoot.eval₂_repr_eq_eval₂_of_map_eq

variable (i x)

-- To match `adjoin_root.lift`
/-- Lift a ring homomorphism `R →+* T` to `S →+* T` by specifying a root `x` of `f` in `T`,
where `S` is given by adjoining a root of `f` to `R`. -/
def lift (h : IsAdjoinRoot S f) : S →+* T
    where
  toFun z := (h.repr z).eval₂ i x
  map_zero' := by rw [h.eval₂_repr_eq_eval₂_of_map_eq hx _ _ (map_zero _), eval₂_zero]
  map_add' z w :=
    by
    rw [h.eval₂_repr_eq_eval₂_of_map_eq hx _ (h.repr z + h.repr w), eval₂_add]
    · rw [map_add, map_repr, map_repr]
  map_one' := by rw [h.eval₂_repr_eq_eval₂_of_map_eq hx _ _ (map_one _), eval₂_one]
  map_mul' z w :=
    by
    rw [h.eval₂_repr_eq_eval₂_of_map_eq hx _ (h.repr z * h.repr w), eval₂_mul]
    · rw [map_mul, map_repr, map_repr]
#align is_adjoin_root.lift IsAdjoinRoot.lift

variable {i x}

@[simp]
theorem lift_map (h : IsAdjoinRoot S f) (z : R[X]) : h.lift i x hx (h.map z) = z.eval₂ i x := by
  rw [lift, RingHom.coe_mk, h.eval₂_repr_eq_eval₂_of_map_eq hx _ _ rfl]
#align is_adjoin_root.lift_map IsAdjoinRoot.lift_map

@[simp]
theorem lift_root (h : IsAdjoinRoot S f) : h.lift i x hx h.root = x := by
  rw [← h.map_X, lift_map, eval₂_X]
#align is_adjoin_root.lift_root IsAdjoinRoot.lift_root

@[simp]
theorem lift_algebraMap (h : IsAdjoinRoot S f) (a : R) : h.lift i x hx (algebraMap R S a) = i a :=
  by rw [h.algebra_map_apply, lift_map, eval₂_C]
#align is_adjoin_root.lift_algebra_map IsAdjoinRoot.lift_algebraMap

/-- Auxiliary lemma for `apply_eq_lift` -/
theorem apply_eq_lift (h : IsAdjoinRoot S f) (g : S →+* T) (hmap : ∀ a, g (algebraMap R S a) = i a)
    (hroot : g h.root = x) (a : S) : g a = h.lift i x hx a :=
  by
  rw [← h.map_repr a, Polynomial.as_sum_range_C_mul_X_pow (h.repr a)]
  simp only [map_sum, map_mul, map_pow, h.map_X, hroot, ← h.algebra_map_apply, hmap, lift_root,
    lift_algebra_map]
#align is_adjoin_root.apply_eq_lift IsAdjoinRoot.apply_eq_lift

/-- Unicity of `lift`: a map that agrees on `R` and `h.root` agrees with `lift` everywhere. -/
theorem eq_lift (h : IsAdjoinRoot S f) (g : S →+* T) (hmap : ∀ a, g (algebraMap R S a) = i a)
    (hroot : g h.root = x) : g = h.lift i x hx :=
  RingHom.ext (h.apply_eq_lift hx g hmap hroot)
#align is_adjoin_root.eq_lift IsAdjoinRoot.eq_lift

variable [Algebra R T] (hx' : aeval x f = 0)

omit hx

variable (x)

-- To match `adjoin_root.lift_hom`
/-- Lift the algebra map `R → T` to `S →ₐ[R] T` by specifying a root `x` of `f` in `T`,
where `S` is given by adjoining a root of `f` to `R`. -/
def liftHom (h : IsAdjoinRoot S f) : S →ₐ[R] T :=
  { h.lift (algebraMap R T) x hx' with commutes' := fun a => h.lift_algebraMap hx' a }
#align is_adjoin_root.lift_hom IsAdjoinRoot.liftHom

variable {x}

@[simp]
theorem coe_liftHom (h : IsAdjoinRoot S f) :
    (h.liftHom x hx' : S →+* T) = h.lift (algebraMap R T) x hx' :=
  rfl
#align is_adjoin_root.coe_lift_hom IsAdjoinRoot.coe_liftHom

theorem lift_algebraMap_apply (h : IsAdjoinRoot S f) (z : S) :
    h.lift (algebraMap R T) x hx' z = h.liftHom x hx' z :=
  rfl
#align is_adjoin_root.lift_algebra_map_apply IsAdjoinRoot.lift_algebraMap_apply

@[simp]
theorem liftHom_map (h : IsAdjoinRoot S f) (z : R[X]) : h.liftHom x hx' (h.map z) = aeval x z := by
  rw [← lift_algebra_map_apply, lift_map, aeval_def]
#align is_adjoin_root.lift_hom_map IsAdjoinRoot.liftHom_map

@[simp]
theorem liftHom_root (h : IsAdjoinRoot S f) : h.liftHom x hx' h.root = x := by
  rw [← lift_algebra_map_apply, lift_root]
#align is_adjoin_root.lift_hom_root IsAdjoinRoot.liftHom_root

/-- Unicity of `lift_hom`: a map that agrees on `h.root` agrees with `lift_hom` everywhere. -/
theorem eq_liftHom (h : IsAdjoinRoot S f) (g : S →ₐ[R] T) (hroot : g h.root = x) :
    g = h.liftHom x hx' :=
  AlgHom.ext (h.apply_eq_lift hx' g g.commutes hroot)
#align is_adjoin_root.eq_lift_hom IsAdjoinRoot.eq_liftHom

end lift

end IsAdjoinRoot

namespace AdjoinRoot

variable (f)

/-- `adjoin_root f` is indeed given by adjoining a root of `f`. -/
protected def isAdjoinRoot : IsAdjoinRoot (AdjoinRoot f) f
    where
  map := AdjoinRoot.mk f
  map_surjective := Ideal.Quotient.mk_surjective
  ker_map := by
    ext
    rw [RingHom.mem_ker, ← @AdjoinRoot.mk_self _ _ f, AdjoinRoot.mk_eq_mk, Ideal.mem_span_singleton,
      ← dvd_add_left (dvd_refl f), sub_add_cancel]
  algebraMap_eq := AdjoinRoot.algebraMap_eq f
#align adjoin_root.is_adjoin_root AdjoinRoot.isAdjoinRoot

/-- `adjoin_root f` is indeed given by adjoining a root of `f`. If `f` is monic this is more
powerful than `adjoin_root.is_adjoin_root`. -/
protected def isAdjoinRootMonic (hf : Monic f) : IsAdjoinRootMonic (AdjoinRoot f) f :=
  { AdjoinRoot.isAdjoinRoot f with Monic := hf }
#align adjoin_root.is_adjoin_root_monic AdjoinRoot.isAdjoinRootMonic

@[simp]
theorem isAdjoinRoot_map_eq_mk : (AdjoinRoot.isAdjoinRoot f).map = AdjoinRoot.mk f :=
  rfl
#align adjoin_root.is_adjoin_root_map_eq_mk AdjoinRoot.isAdjoinRoot_map_eq_mk

@[simp]
theorem isAdjoinRootMonic_map_eq_mk (hf : f.Monic) :
    (AdjoinRoot.isAdjoinRootMonic f hf).map = AdjoinRoot.mk f :=
  rfl
#align adjoin_root.is_adjoin_root_monic_map_eq_mk AdjoinRoot.isAdjoinRootMonic_map_eq_mk

@[simp]
theorem isAdjoinRoot_root_eq_root : (AdjoinRoot.isAdjoinRoot f).root = AdjoinRoot.root f := by
  simp only [IsAdjoinRoot.root, AdjoinRoot.root, AdjoinRoot.isAdjoinRoot_map_eq_mk]
#align adjoin_root.is_adjoin_root_root_eq_root AdjoinRoot.isAdjoinRoot_root_eq_root

@[simp]
theorem isAdjoinRootMonic_root_eq_root (hf : Monic f) :
    (AdjoinRoot.isAdjoinRootMonic f hf).root = AdjoinRoot.root f := by
  simp only [IsAdjoinRoot.root, AdjoinRoot.root, AdjoinRoot.isAdjoinRootMonic_map_eq_mk]
#align adjoin_root.is_adjoin_root_monic_root_eq_root AdjoinRoot.isAdjoinRootMonic_root_eq_root

end AdjoinRoot

namespace IsAdjoinRootMonic

open IsAdjoinRoot

theorem map_modByMonic (h : IsAdjoinRootMonic S f) (g : R[X]) : h.map (g %ₘ f) = h.map g :=
  by
  rw [← RingHom.sub_mem_ker_iff, mem_ker_map, mod_by_monic_eq_sub_mul_div _ h.monic, sub_right_comm,
    sub_self, zero_sub, dvd_neg]
  exact ⟨_, rfl⟩
#align is_adjoin_root_monic.map_mod_by_monic IsAdjoinRootMonic.map_modByMonic

theorem modByMonic_repr_map (h : IsAdjoinRootMonic S f) (g : R[X]) :
    h.repr (h.map g) %ₘ f = g %ₘ f :=
  modByMonic_eq_of_dvd_sub h.Monic <| by rw [← h.mem_ker_map, RingHom.sub_mem_ker_iff, map_repr]
#align is_adjoin_root_monic.mod_by_monic_repr_map IsAdjoinRootMonic.modByMonic_repr_map

/-- `is_adjoin_root.mod_by_monic_hom` sends the equivalence class of `f` mod `g` to `f %ₘ g`. -/
def modByMonicHom (h : IsAdjoinRootMonic S f) : S →ₗ[R] R[X]
    where
  toFun x := h.repr x %ₘ f
  map_add' x y := by
    conv_lhs =>
      rw [← h.map_repr x, ← h.map_repr y, ← map_add, h.mod_by_monic_repr_map, add_mod_by_monic]
  map_smul' c x := by
    rw [RingHom.id_apply, ← h.map_repr x, Algebra.smul_def, h.algebra_map_apply, ← map_mul,
      h.mod_by_monic_repr_map, ← smul_eq_C_mul, smul_mod_by_monic, h.map_repr]
#align is_adjoin_root_monic.mod_by_monic_hom IsAdjoinRootMonic.modByMonicHom

@[simp]
theorem modByMonicHom_map (h : IsAdjoinRootMonic S f) (g : R[X]) :
    h.modByMonicHom (h.map g) = g %ₘ f :=
  h.modByMonic_repr_map g
#align is_adjoin_root_monic.mod_by_monic_hom_map IsAdjoinRootMonic.modByMonicHom_map

@[simp]
theorem map_modByMonicHom (h : IsAdjoinRootMonic S f) (x : S) : h.map (h.modByMonicHom x) = x := by
  rw [mod_by_monic_hom, LinearMap.coe_mk, map_mod_by_monic, map_repr]
#align is_adjoin_root_monic.map_mod_by_monic_hom IsAdjoinRootMonic.map_modByMonicHom

@[simp]
theorem modByMonicHom_root_pow (h : IsAdjoinRootMonic S f) {n : ℕ} (hdeg : n < natDegree f) :
    h.modByMonicHom (h.root ^ n) = X ^ n :=
  by
  nontriviality R
  rwa [← h.map_X, ← map_pow, mod_by_monic_hom_map, mod_by_monic_eq_self_iff h.monic, degree_X_pow]
  contrapose! hdeg
  simpa [nat_degree_le_iff_degree_le] using hdeg
#align is_adjoin_root_monic.mod_by_monic_hom_root_pow IsAdjoinRootMonic.modByMonicHom_root_pow

@[simp]
theorem modByMonicHom_root (h : IsAdjoinRootMonic S f) (hdeg : 1 < natDegree f) :
    h.modByMonicHom h.root = X := by simpa using mod_by_monic_hom_root_pow h hdeg
#align is_adjoin_root_monic.mod_by_monic_hom_root IsAdjoinRootMonic.modByMonicHom_root

/-- The basis on `S` generated by powers of `h.root`.

Auxiliary definition for `is_adjoin_root_monic.power_basis`. -/
def basis (h : IsAdjoinRootMonic S f) : Basis (Fin (natDegree f)) R S :=
  Basis.ofRepr
    { toFun := fun x => (h.modByMonicHom x).toFinsupp.comapDomain coe (Fin.val_injective.InjOn _)
      invFun := fun g => h.map (ofFinsupp (g.mapDomain coe))
      left_inv := fun x => by
        cases subsingleton_or_nontrivial R
        · haveI := h.subsingleton
          exact Subsingleton.elim _ _
        simp only
        rw [Finsupp.mapDomain_comapDomain, Polynomial.eta, h.map_mod_by_monic_hom x]
        intro i hi
        refine' set.mem_range.mpr ⟨⟨i, _⟩, rfl⟩
        contrapose! hi
        simp only [Polynomial.toFinsupp_apply, Classical.not_not, Finsupp.mem_support_iff, Ne.def,
          mod_by_monic_hom, LinearMap.coe_mk, Finset.mem_coe]
        by_cases hx : h.to_is_adjoin_root.repr x %ₘ f = 0
        · simp [hx]
        refine' coeff_eq_zero_of_nat_degree_lt (lt_of_lt_of_le _ hi)
        rw [nat_degree_lt_nat_degree_iff hx]
        · exact degree_mod_by_monic_lt _ h.monic
      right_inv := fun g => by
        nontriviality R
        ext i
        simp only [h.mod_by_monic_hom_map, Finsupp.comapDomain_apply, Polynomial.toFinsupp_apply]
        rw [(Polynomial.modByMonic_eq_self_iff h.monic).mpr, Polynomial.coeff,
          Finsupp.mapDomain_apply Fin.val_injective]
        rw [degree_eq_nat_degree h.monic.ne_zero, degree_lt_iff_coeff_zero]
        intro m hm
        rw [Polynomial.coeff, Finsupp.mapDomain_notin_range]
        rw [Set.mem_range, not_exists]
        rintro i rfl
        exact i.prop.not_le hm
      map_add' := fun x y => by
        simp only [map_add, Finsupp.comapDomain_add_of_injective Fin.val_injective, to_finsupp_add]
      map_smul' := fun c x => by
        simp only [map_smul, Finsupp.comapDomain_smul_of_injective Fin.val_injective,
          RingHom.id_apply, to_finsupp_smul] }
#align is_adjoin_root_monic.basis IsAdjoinRootMonic.basis

@[simp]
theorem basis_apply (h : IsAdjoinRootMonic S f) (i) : h.Basis i = h.root ^ (i : ℕ) :=
  Basis.apply_eq_iff.mpr <|
    show
      (h.modByMonicHom (h.toIsAdjoinRoot.root ^ (i : ℕ))).toFinsupp.comapDomain coe
          (Fin.val_injective.InjOn _) =
        Finsupp.single _ _
      by
      ext j
      rw [Finsupp.comapDomain_apply, mod_by_monic_hom_root_pow]
      · rw [X_pow_eq_monomial, to_finsupp_monomial, Finsupp.single_apply_left Fin.val_injective]
      · exact i.is_lt
#align is_adjoin_root_monic.basis_apply IsAdjoinRootMonic.basis_apply

theorem deg_pos [Nontrivial S] (h : IsAdjoinRootMonic S f) : 0 < natDegree f :=
  by
  rcases h.basis.index_nonempty with ⟨⟨i, hi⟩⟩
  exact (Nat.zero_le _).trans_lt hi
#align is_adjoin_root_monic.deg_pos IsAdjoinRootMonic.deg_pos

theorem deg_ne_zero [Nontrivial S] (h : IsAdjoinRootMonic S f) : natDegree f ≠ 0 :=
  h.deg_pos.ne'
#align is_adjoin_root_monic.deg_ne_zero IsAdjoinRootMonic.deg_ne_zero

/-- If `f` is monic, the powers of `h.root` form a basis. -/
@[simps gen dim Basis]
def powerBasis (h : IsAdjoinRootMonic S f) : PowerBasis R S
    where
  gen := h.root
  dim := natDegree f
  Basis := h.Basis
  basis_eq_pow := h.basis_apply
#align is_adjoin_root_monic.power_basis IsAdjoinRootMonic.powerBasis

@[simp]
theorem basis_repr (h : IsAdjoinRootMonic S f) (x : S) (i : Fin (natDegree f)) :
    h.Basis.repr x i = (h.modByMonicHom x).coeff (i : ℕ) :=
  by
  change (h.mod_by_monic_hom x).toFinsupp.comapDomain coe (fin.coe_injective.inj_on _) i = _
  rw [Finsupp.comapDomain_apply, Polynomial.toFinsupp_apply]
#align is_adjoin_root_monic.basis_repr IsAdjoinRootMonic.basis_repr

theorem basis_one (h : IsAdjoinRootMonic S f) (hdeg : 1 < natDegree f) :
    h.Basis ⟨1, hdeg⟩ = h.root := by rw [h.basis_apply, Fin.val_mk, pow_one]
#align is_adjoin_root_monic.basis_one IsAdjoinRootMonic.basis_one

/-- `is_adjoin_root_monic.lift_polyₗ` lifts a linear map on polynomials to a linear map on `S`. -/
@[simps]
def liftPolyₗ {T : Type _} [AddCommGroup T] [Module R T] (h : IsAdjoinRootMonic S f)
    (g : R[X] →ₗ[R] T) : S →ₗ[R] T :=
  g.comp h.modByMonicHom
#align is_adjoin_root_monic.lift_polyₗ IsAdjoinRootMonic.liftPolyₗ

/-- `is_adjoin_root_monic.coeff h x i` is the `i`th coefficient of the representative of `x : S`.
-/
def coeff (h : IsAdjoinRootMonic S f) : S →ₗ[R] ℕ → R :=
  h.liftPolyₗ
    { toFun := Polynomial.coeff
      map_add' := fun p q => funext (Polynomial.coeff_add p q)
      map_smul' := fun c p => funext (Polynomial.coeff_smul c p) }
#align is_adjoin_root_monic.coeff IsAdjoinRootMonic.coeff

theorem coeff_apply_lt (h : IsAdjoinRootMonic S f) (z : S) (i : ℕ) (hi : i < natDegree f) :
    h.coeff z i = h.Basis.repr z ⟨i, hi⟩ :=
  by
  simp only [coeff, LinearMap.comp_apply, Finsupp.lcoeFun_apply, Finsupp.lmapDomain_apply,
    LinearEquiv.coe_coe, lift_polyₗ_apply, LinearMap.coe_mk, h.basis_repr]
  rfl
#align is_adjoin_root_monic.coeff_apply_lt IsAdjoinRootMonic.coeff_apply_lt

theorem coeff_apply_coe (h : IsAdjoinRootMonic S f) (z : S) (i : Fin (natDegree f)) :
    h.coeff z i = h.Basis.repr z i :=
  h.coeff_apply_lt z i i.Prop
#align is_adjoin_root_monic.coeff_apply_coe IsAdjoinRootMonic.coeff_apply_coe

theorem coeff_apply_le (h : IsAdjoinRootMonic S f) (z : S) (i : ℕ) (hi : natDegree f ≤ i) :
    h.coeff z i = 0 :=
  by
  simp only [coeff, LinearMap.comp_apply, Finsupp.lcoeFun_apply, Finsupp.lmapDomain_apply,
    LinearEquiv.coe_coe, lift_polyₗ_apply, LinearMap.coe_mk, h.basis_repr]
  nontriviality R
  exact
    Polynomial.coeff_eq_zero_of_degree_lt
      ((degree_mod_by_monic_lt _ h.monic).trans_le (Polynomial.degree_le_of_natDegree_le hi))
#align is_adjoin_root_monic.coeff_apply_le IsAdjoinRootMonic.coeff_apply_le

theorem coeff_apply (h : IsAdjoinRootMonic S f) (z : S) (i : ℕ) :
    h.coeff z i = if hi : i < natDegree f then h.Basis.repr z ⟨i, hi⟩ else 0 :=
  by
  split_ifs with hi
  · exact h.coeff_apply_lt z i hi
  · exact h.coeff_apply_le z i (le_of_not_lt hi)
#align is_adjoin_root_monic.coeff_apply IsAdjoinRootMonic.coeff_apply

theorem coeff_root_pow (h : IsAdjoinRootMonic S f) {n} (hn : n < natDegree f) :
    h.coeff (h.root ^ n) = Pi.single n 1 := by
  ext i
  rw [coeff_apply]
  split_ifs with hi
  ·
    calc
      h.basis.repr (h.root ^ n) ⟨i, _⟩ = h.basis.repr (h.basis ⟨n, hn⟩) ⟨i, hi⟩ := by
        rw [h.basis_apply, Fin.val_mk]
      _ = Pi.single ((⟨n, hn⟩ : Fin _) : ℕ) (1 : (fun _ => R) _) ↑(⟨i, _⟩ : Fin _) := by
        rw [h.basis.repr_self, ← Finsupp.single_eq_pi_single,
          Finsupp.single_apply_left Fin.val_injective]
      _ = Pi.single n 1 i := by rw [Fin.val_mk, Fin.val_mk]

  · refine' (Pi.single_eq_of_ne _ (1 : (fun _ => R) _)).symm
    rintro rfl
    simpa [hi] using hn
#align is_adjoin_root_monic.coeff_root_pow IsAdjoinRootMonic.coeff_root_pow

theorem coeff_one [Nontrivial S] (h : IsAdjoinRootMonic S f) : h.coeff 1 = Pi.single 0 1 := by
  rw [← h.coeff_root_pow h.deg_pos, pow_zero]
#align is_adjoin_root_monic.coeff_one IsAdjoinRootMonic.coeff_one

theorem coeff_root (h : IsAdjoinRootMonic S f) (hdeg : 1 < natDegree f) :
    h.coeff h.root = Pi.single 1 1 := by rw [← h.coeff_root_pow hdeg, pow_one]
#align is_adjoin_root_monic.coeff_root IsAdjoinRootMonic.coeff_root

theorem coeff_algebraMap [Nontrivial S] (h : IsAdjoinRootMonic S f) (x : R) :
    h.coeff (algebraMap R S x) = Pi.single 0 x :=
  by
  ext i
  rw [Algebra.algebraMap_eq_smul_one, map_smul, coeff_one, Pi.smul_apply, smul_eq_mul]
  refine' (Pi.apply_single (fun _ y => x * y) _ 0 1 i).trans (by simp)
  intros
  simp
#align is_adjoin_root_monic.coeff_algebra_map IsAdjoinRootMonic.coeff_algebraMap

theorem ext_elem (h : IsAdjoinRootMonic S f) ⦃x y : S⦄
    (hxy : ∀ i < natDegree f, h.coeff x i = h.coeff y i) : x = y :=
  EquivLike.injective h.Basis.equivFun <|
    funext fun i =>
      show h.Basis.equivFun x i = h.Basis.equivFun y i by
        rw [Basis.equivFun_apply, ← h.coeff_apply_coe, Basis.equivFun_apply, ← h.coeff_apply_coe,
          hxy i i.prop]
#align is_adjoin_root_monic.ext_elem IsAdjoinRootMonic.ext_elem

theorem ext_elem_iff (h : IsAdjoinRootMonic S f) {x y : S} :
    x = y ↔ ∀ i < natDegree f, h.coeff x i = h.coeff y i :=
  ⟨fun hxy i hi => hxy ▸ rfl, fun hxy => h.ext_elem hxy⟩
#align is_adjoin_root_monic.ext_elem_iff IsAdjoinRootMonic.ext_elem_iff

theorem coeff_injective (h : IsAdjoinRootMonic S f) : Function.Injective h.coeff := fun x y hxy =>
  h.ext_elem fun i hi => hxy ▸ rfl
#align is_adjoin_root_monic.coeff_injective IsAdjoinRootMonic.coeff_injective

theorem isIntegral_root (h : IsAdjoinRootMonic S f) : IsIntegral R h.root :=
  ⟨f, h.Monic, h.aeval_root⟩
#align is_adjoin_root_monic.is_integral_root IsAdjoinRootMonic.isIntegral_root

end IsAdjoinRootMonic

end Ring

section CommRing

variable {R : Type u} {S : Type v} [CommRing R] [CommRing S] [Algebra R S] {f : R[X]}

namespace IsAdjoinRoot

section lift

@[simp]
theorem lift_self_apply (h : IsAdjoinRoot S f) (x : S) :
    h.lift (algebraMap R S) h.root h.aeval_root x = x := by
  rw [← h.map_repr x, lift_map, ← aeval_def, h.aeval_eq]
#align is_adjoin_root.lift_self_apply IsAdjoinRoot.lift_self_apply

theorem lift_self (h : IsAdjoinRoot S f) :
    h.lift (algebraMap R S) h.root h.aeval_root = RingHom.id S :=
  RingHom.ext h.lift_self_apply
#align is_adjoin_root.lift_self IsAdjoinRoot.lift_self

end lift

section Equiv

variable {T : Type _} [CommRing T] [Algebra R T]

/-- Adjoining a root gives a unique ring up to algebra isomorphism.

This is the converse of `is_adjoin_root.of_equiv`: this turns an `is_adjoin_root` into an
`alg_equiv`, and `is_adjoin_root.of_equiv` turns an `alg_equiv` into an `is_adjoin_root`.
-/
def aequiv (h : IsAdjoinRoot S f) (h' : IsAdjoinRoot T f) : S ≃ₐ[R] T :=
  {
    h.liftHom h'.root
      h'.aeval_root with
    toFun := h.liftHom h'.root h'.aeval_root
    invFun := h'.liftHom h.root h.aeval_root
    left_inv := fun x => by rw [← h.map_repr x, lift_hom_map, aeval_eq, lift_hom_map, aeval_eq]
    right_inv := fun x => by rw [← h'.map_repr x, lift_hom_map, aeval_eq, lift_hom_map, aeval_eq] }
#align is_adjoin_root.aequiv IsAdjoinRoot.aequiv

@[simp]
theorem aequiv_map (h : IsAdjoinRoot S f) (h' : IsAdjoinRoot T f) (z : R[X]) :
    h.aequiv h' (h.map z) = h'.map z := by rw [aequiv, AlgEquiv.coe_mk, lift_hom_map, aeval_eq]
#align is_adjoin_root.aequiv_map IsAdjoinRoot.aequiv_map

@[simp]
theorem aequiv_root (h : IsAdjoinRoot S f) (h' : IsAdjoinRoot T f) : h.aequiv h' h.root = h'.root :=
  by rw [aequiv, AlgEquiv.coe_mk, lift_hom_root]
#align is_adjoin_root.aequiv_root IsAdjoinRoot.aequiv_root

@[simp]
theorem aequiv_self (h : IsAdjoinRoot S f) : h.aequiv h = AlgEquiv.refl :=
  by
  ext a
  exact h.lift_self_apply a
#align is_adjoin_root.aequiv_self IsAdjoinRoot.aequiv_self

@[simp]
theorem aequiv_symm (h : IsAdjoinRoot S f) (h' : IsAdjoinRoot T f) :
    (h.aequiv h').symm = h'.aequiv h := by
  ext
  rfl
#align is_adjoin_root.aequiv_symm IsAdjoinRoot.aequiv_symm

@[simp]
theorem lift_aequiv {U : Type _} [CommRing U] (h : IsAdjoinRoot S f) (h' : IsAdjoinRoot T f)
    (i : R →+* U) (x hx z) : h'.lift i x hx (h.aequiv h' z) = h.lift i x hx z := by
  rw [← h.map_repr z, aequiv_map, lift_map, lift_map]
#align is_adjoin_root.lift_aequiv IsAdjoinRoot.lift_aequiv

@[simp]
theorem liftHom_aequiv {U : Type _} [CommRing U] [Algebra R U] (h : IsAdjoinRoot S f)
    (h' : IsAdjoinRoot T f) (x : U) (hx z) : h'.liftHom x hx (h.aequiv h' z) = h.liftHom x hx z :=
  h.lift_aequiv h' _ _ hx _
#align is_adjoin_root.lift_hom_aequiv IsAdjoinRoot.liftHom_aequiv

@[simp]
theorem aequiv_aequiv {U : Type _} [CommRing U] [Algebra R U] (h : IsAdjoinRoot S f)
    (h' : IsAdjoinRoot T f) (h'' : IsAdjoinRoot U f) (x) :
    (h'.aequiv h'') (h.aequiv h' x) = h.aequiv h'' x :=
  h.liftHom_aequiv _ _ h''.aeval_root _
#align is_adjoin_root.aequiv_aequiv IsAdjoinRoot.aequiv_aequiv

@[simp]
theorem aequiv_trans {U : Type _} [CommRing U] [Algebra R U] (h : IsAdjoinRoot S f)
    (h' : IsAdjoinRoot T f) (h'' : IsAdjoinRoot U f) :
    (h.aequiv h').trans (h'.aequiv h'') = h.aequiv h'' :=
  by
  ext z
  exact h.aequiv_aequiv h' h'' z
#align is_adjoin_root.aequiv_trans IsAdjoinRoot.aequiv_trans

/-- Transfer `is_adjoin_root` across an algebra isomorphism.

This is the converse of `is_adjoin_root.aequiv`: this turns an `alg_equiv` into an `is_adjoin_root`,
and `is_adjoin_root.aequiv` turns an `is_adjoin_root` into an `alg_equiv`.
-/
@[simps map_apply]
def ofEquiv (h : IsAdjoinRoot S f) (e : S ≃ₐ[R] T) : IsAdjoinRoot T f
    where
  map := ((e : S ≃+* T) : S →+* T).comp h.map
  map_surjective := e.Surjective.comp h.map_surjective
  ker_map := by
    rw [← RingHom.comap_ker, RingHom.ker_coe_equiv, ← RingHom.ker_eq_comap_bot, h.ker_map]
  algebraMap_eq := by
    ext <;>
      simp only [AlgEquiv.commutes, RingHom.comp_apply, AlgEquiv.coe_ringEquiv,
        RingEquiv.coe_toRingHom, ← h.algebra_map_apply]
#align is_adjoin_root.of_equiv IsAdjoinRoot.ofEquiv

@[simp]
theorem ofEquiv_root (h : IsAdjoinRoot S f) (e : S ≃ₐ[R] T) : (h.of_equiv e).root = e h.root :=
  rfl
#align is_adjoin_root.of_equiv_root IsAdjoinRoot.ofEquiv_root

@[simp]
theorem aequiv_ofEquiv {U : Type _} [CommRing U] [Algebra R U] (h : IsAdjoinRoot S f)
    (h' : IsAdjoinRoot T f) (e : T ≃ₐ[R] U) : h.aequiv (h'.of_equiv e) = (h.aequiv h').trans e := by
  ext a <;> rw [← h.map_repr a, aequiv_map, AlgEquiv.trans_apply, aequiv_map, of_equiv_map_apply]
#align is_adjoin_root.aequiv_of_equiv IsAdjoinRoot.aequiv_ofEquiv

@[simp]
theorem ofEquiv_aequiv {U : Type _} [CommRing U] [Algebra R U] (h : IsAdjoinRoot S f)
    (h' : IsAdjoinRoot U f) (e : S ≃ₐ[R] T) :
    (h.of_equiv e).aequiv h' = e.symm.trans (h.aequiv h') := by
  ext a <;>
    rw [← (h.of_equiv e).map_repr a, aequiv_map, AlgEquiv.trans_apply, of_equiv_map_apply,
      e.symm_apply_apply, aequiv_map]
#align is_adjoin_root.of_equiv_aequiv IsAdjoinRoot.ofEquiv_aequiv

end Equiv

end IsAdjoinRoot

namespace IsAdjoinRootMonic

theorem minpoly_eq [IsDomain R] [IsDomain S] [NoZeroSMulDivisors R S] [IsIntegrallyClosed R]
    (h : IsAdjoinRootMonic S f) (hirr : Irreducible f) : minpoly R h.root = f :=
  let ⟨q, hq⟩ := minpoly.isIntegrallyClosed_dvd h.isIntegral_root h.aeval_root
  symm <|
    eq_of_monic_of_associated h.Monic (minpoly.monic h.isIntegral_root) <| by
      convert Associated.mul_left (minpoly R h.root) <|
            associated_one_iff_isUnit.2 <|
              (hirr.is_unit_or_is_unit hq).resolve_left <| minpoly.not_isUnit R h.root <;>
        rw [mul_one]
#align is_adjoin_root_monic.minpoly_eq IsAdjoinRootMonic.minpoly_eq

end IsAdjoinRootMonic

section Algebra

open AdjoinRoot IsAdjoinRoot minpoly PowerBasis IsAdjoinRootMonic Algebra

theorem Algebra.adjoin.powerBasis'_minpoly_gen [IsDomain R] [IsDomain S] [NoZeroSMulDivisors R S]
    [IsIntegrallyClosed R] {x : S} (hx' : IsIntegral R x) :
    minpoly R x = minpoly R (Algebra.adjoin.powerBasis' hx').gen :=
  by
  haveI := is_domain_of_prime (prime_of_is_integrally_closed hx')
  haveI :=
    no_zero_smul_divisors_of_prime_of_degree_ne_zero (prime_of_is_integrally_closed hx')
      (ne_of_lt (degree_pos hx')).symm
  rw [← minpoly_gen_eq, adjoin.power_basis', minpoly_gen_map, minpoly_gen_eq, power_basis'_gen, ←
    is_adjoin_root_monic_root_eq_root _ (monic hx'), minpoly_eq]
  exact Irreducible hx'
#align algebra.adjoin.power_basis'_minpoly_gen Algebra.adjoin.powerBasis'_minpoly_gen

end Algebra

end CommRing


/-
Copyright (c) 2022 Alex Kontorovich. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex Kontorovich
-/

import group_theory.subgroup.actions

/-!
# Mul-opposite subgroups

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

## Tags
subgroup, subgroups

-/

variables {G : Type*} [group G]

namespace subgroup

/-- A subgroup `H` of `G` determines a subgroup `H.opposite` of the opposite group `Gᵐᵒᵖ`. -/
@[to_additive "An additive subgroup `H` of `G` determines an additive subgroup `H.opposite` of the
  opposite additive group `Gᵃᵒᵖ`."]
def opposite : subgroup G ≃ subgroup Gᵐᵒᵖ :=
{ to_fun := λ H, { carrier := mul_opposite.unop ⁻¹' (H : set G),
                   one_mem' := H.one_mem,
                   mul_mem' := λ a b ha hb, H.mul_mem hb ha,
                   inv_mem' := λ a, H.inv_mem },
  inv_fun := λ H, { carrier := mul_opposite.op ⁻¹' (H : set Gᵐᵒᵖ),
                   one_mem' := H.one_mem,
                   mul_mem' := λ a b ha hb, H.mul_mem hb ha,
                   inv_mem' := λ a, H.inv_mem },
  left_inv := λ H, set_like.coe_injective rfl,
  right_inv := λ H, set_like.coe_injective rfl }

/-- Bijection between a subgroup `H` and its opposite. -/
@[to_additive "Bijection between an additive subgroup `H` and its opposite.", simps]
def opposite_equiv (H : subgroup G) : H ≃ H.opposite :=
mul_opposite.op_equiv.subtype_equiv $ λ _, iff.rfl

@[to_additive] instance (H : subgroup G) [encodable H] : encodable H.opposite :=
encodable.of_equiv H H.opposite_equiv.symm

@[to_additive] instance (H : subgroup G) [countable H] : countable H.opposite :=
countable.of_equiv H H.opposite_equiv

@[to_additive] lemma smul_opposite_mul {H : subgroup G} (x g : G) (h : H.opposite) :
  h • (g * x) = g * (h • x) :=
begin
  cases h,
  simp [(•), mul_assoc],
end

end subgroup


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

! This file was ported from Lean 3 source module number_theory.padics.ring_homs
! leanprover-community/mathlib commit 565eb991e264d0db702722b4bde52ee5173c9950
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Zmod.Basic
import Mathbin.NumberTheory.Padics.PadicIntegers

/-!

# Relating `ℤ_[p]` to `zmod (p ^ n)`

In this file we establish connections between the `p`-adic integers $\mathbb{Z}_p$
and the integers modulo powers of `p`, $\mathbb{Z}/p^n\mathbb{Z}$.

## Main declarations

We show that $\mathbb{Z}_p$ has a ring hom to $\mathbb{Z}/p^n\mathbb{Z}$ for each `n`.
The case for `n = 1` is handled separately, since it is used in the general construction
and we may want to use it without the `^1` getting in the way.
* `padic_int.to_zmod`: ring hom to `zmod p`
* `padic_int.to_zmod_pow`: ring hom to `zmod (p^n)`
* `padic_int.ker_to_zmod` / `padic_int.ker_to_zmod_pow`: the kernels of these maps are the ideals
  generated by `p^n`

We also establish the universal property of $\mathbb{Z}_p$ as a projective limit.
Given a family of compatible ring homs $f_k : R \to \mathbb{Z}/p^n\mathbb{Z}$,
there is a unique limit $R \to \mathbb{Z}_p$.
* `padic_int.lift`: the limit function
* `padic_int.lift_spec` / `padic_int.lift_unique`: the universal property

## Implementation notes

The ring hom constructions go through an auxiliary constructor `padic_int.to_zmod_hom`,
which removes some boilerplate code.

-/

noncomputable section

open Classical

open Nat LocalRing Padic

namespace PadicInt

variable {p : ℕ} [hp_prime : Fact p.Prime]

include hp_prime

section RingHoms

/-! ### Ring homomorphisms to `zmod p` and `zmod (p ^ n)` -/

variable (p) (r : ℚ)

omit hp_prime

/-- `mod_part p r` is an integer that satisfies
`‖(r - mod_part p r : ℚ_[p])‖ < 1` when `‖(r : ℚ_[p])‖ ≤ 1`,
see `padic_int.norm_sub_mod_part`.
It is the unique non-negative integer that is `< p` with this property.

(Note that this definition assumes `r : ℚ`.
See `padic_int.zmod_repr` for a version that takes values in `ℕ`
and works for arbitrary `x : ℤ_[p]`.) -/
def modPart : ℤ :=
  r.num * gcdA r.den p % p
#align padic_int.mod_part PadicInt.modPart

include hp_prime

variable {p}

theorem modPart_lt_p : modPart p r < p :=
  by
  convert Int.emod_lt _ _
  · simp
  · exact_mod_cast hp_prime.1.NeZero
#align padic_int.mod_part_lt_p PadicInt.modPart_lt_p

theorem modPart_nonneg : 0 ≤ modPart p r :=
  Int.emod_nonneg _ <| by exact_mod_cast hp_prime.1.NeZero
#align padic_int.mod_part_nonneg PadicInt.modPart_nonneg

theorem isUnit_den (r : ℚ) (h : ‖(r : ℚ_[p])‖ ≤ 1) : IsUnit (r.den : ℤ_[p]) :=
  by
  rw [is_unit_iff]
  apply le_antisymm (r.denom : ℤ_[p]).2
  rw [← not_lt, val_eq_coe, coe_nat_cast]
  intro norm_denom_lt
  have hr : ‖(r * r.denom : ℚ_[p])‖ = ‖(r.num : ℚ_[p])‖ :=
    by
    rw_mod_cast [@Rat.mul_den_eq_num r]
    rfl
  rw [padicNormE.mul] at hr
  have key : ‖(r.num : ℚ_[p])‖ < 1 := by
    calc
      _ = _ := hr.symm
      _ < 1 * 1 := (mul_lt_mul' h norm_denom_lt (norm_nonneg _) zero_lt_one)
      _ = 1 := mul_one 1

  have : ↑p ∣ r.num ∧ (p : ℤ) ∣ r.denom :=
    by
    simp only [← norm_int_lt_one_iff_dvd, ← padic_norm_e_of_padic_int]
    norm_cast
    exact ⟨key, norm_denom_lt⟩
  apply hp_prime.1.not_dvd_one
  rwa [← r.cop.gcd_eq_one, Nat.dvd_gcd_iff, ← Int.coe_nat_dvd_left, ← Int.coe_nat_dvd]
#align padic_int.is_unit_denom PadicInt.isUnit_den

theorem norm_sub_mod_part_aux (r : ℚ) (h : ‖(r : ℚ_[p])‖ ≤ 1) :
    ↑p ∣ r.num - r.num * r.den.gcdA p % p * ↑r.den :=
  by
  rw [← ZMod.int_cast_zmod_eq_zero_iff_dvd]
  simp only [Int.cast_ofNat, ZMod.nat_cast_mod, Int.cast_mul, Int.cast_sub]
  have := congr_arg (coe : ℤ → ZMod p) (gcd_eq_gcd_ab r.denom p)
  simp only [Int.cast_ofNat, add_zero, Int.cast_add, ZMod.nat_cast_self, Int.cast_mul,
    MulZeroClass.zero_mul] at this
  push_cast
  rw [mul_right_comm, mul_assoc, ← this]
  suffices rdcp : r.denom.coprime p
  · rw [rdcp.gcd_eq_one]
    simp only [mul_one, cast_one, sub_self]
  apply coprime.symm
  apply (coprime_or_dvd_of_prime hp_prime.1 _).resolve_right
  rw [← Int.coe_nat_dvd, ← norm_int_lt_one_iff_dvd, not_lt]
  apply ge_of_eq
  rw [← is_unit_iff]
  exact is_unit_denom r h
#align padic_int.norm_sub_mod_part_aux PadicInt.norm_sub_mod_part_aux

theorem norm_sub_modPart (h : ‖(r : ℚ_[p])‖ ≤ 1) : ‖(⟨r, h⟩ - modPart p r : ℤ_[p])‖ < 1 :=
  by
  let n := mod_part p r
  rw [norm_lt_one_iff_dvd, ← (is_unit_denom r h).dvd_mul_right]
  suffices ↑p ∣ r.num - n * r.denom
    by
    convert(Int.castRingHom ℤ_[p]).map_dvd this
    simp only [sub_mul, Int.cast_ofNat, eq_intCast, Int.cast_mul, sub_left_inj, Int.cast_sub]
    apply Subtype.coe_injective
    simp only [coe_mul, Subtype.coe_mk, coe_nat_cast]
    rw_mod_cast [@Rat.mul_den_eq_num r]
    rfl
  exact norm_sub_mod_part_aux r h
#align padic_int.norm_sub_mod_part PadicInt.norm_sub_modPart

theorem exists_mem_range_of_norm_rat_le_one (h : ‖(r : ℚ_[p])‖ ≤ 1) :
    ∃ n : ℤ, 0 ≤ n ∧ n < p ∧ ‖(⟨r, h⟩ - n : ℤ_[p])‖ < 1 :=
  ⟨modPart p r, modPart_nonneg _, modPart_lt_p _, norm_sub_modPart _ h⟩
#align padic_int.exists_mem_range_of_norm_rat_le_one PadicInt.exists_mem_range_of_norm_rat_le_one

theorem zMod_congr_of_sub_mem_span_aux (n : ℕ) (x : ℤ_[p]) (a b : ℤ)
    (ha : x - a ∈ (Ideal.span {p ^ n} : Ideal ℤ_[p]))
    (hb : x - b ∈ (Ideal.span {p ^ n} : Ideal ℤ_[p])) : (a : ZMod (p ^ n)) = b :=
  by
  rw [Ideal.mem_span_singleton] at ha hb
  rw [← sub_eq_zero, ← Int.cast_sub, ZMod.int_cast_zmod_eq_zero_iff_dvd, Int.coe_nat_pow]
  rw [← dvd_neg, neg_sub] at ha
  have := dvd_add ha hb
  rwa [sub_eq_add_neg, sub_eq_add_neg, add_assoc, neg_add_cancel_left, ← sub_eq_add_neg, ←
    Int.cast_sub, pow_p_dvd_int_iff] at this
#align padic_int.zmod_congr_of_sub_mem_span_aux PadicInt.zMod_congr_of_sub_mem_span_aux

theorem zMod_congr_of_sub_mem_span (n : ℕ) (x : ℤ_[p]) (a b : ℕ)
    (ha : x - a ∈ (Ideal.span {p ^ n} : Ideal ℤ_[p]))
    (hb : x - b ∈ (Ideal.span {p ^ n} : Ideal ℤ_[p])) : (a : ZMod (p ^ n)) = b := by
  simpa using zmod_congr_of_sub_mem_span_aux n x a b ha hb
#align padic_int.zmod_congr_of_sub_mem_span PadicInt.zMod_congr_of_sub_mem_span

theorem zMod_congr_of_sub_mem_max_ideal (x : ℤ_[p]) (m n : ℕ) (hm : x - m ∈ maximalIdeal ℤ_[p])
    (hn : x - n ∈ maximalIdeal ℤ_[p]) : (m : ZMod p) = n :=
  by
  rw [maximal_ideal_eq_span_p] at hm hn
  have := zmod_congr_of_sub_mem_span_aux 1 x m n
  simp only [pow_one] at this
  specialize this hm hn
  apply_fun ZMod.castHom (show p ∣ p ^ 1 by rw [pow_one]) (ZMod p)  at this
  simp only [map_intCast] at this
  simpa only [Int.cast_ofNat] using this
#align padic_int.zmod_congr_of_sub_mem_max_ideal PadicInt.zMod_congr_of_sub_mem_max_ideal

variable (x : ℤ_[p])

theorem exists_mem_range : ∃ n : ℕ, n < p ∧ x - n ∈ maximalIdeal ℤ_[p] :=
  by
  simp only [maximal_ideal_eq_span_p, Ideal.mem_span_singleton, ← norm_lt_one_iff_dvd]
  obtain ⟨r, hr⟩ := rat_dense p (x : ℚ_[p]) zero_lt_one
  have H : ‖(r : ℚ_[p])‖ ≤ 1 := by
    rw [norm_sub_rev] at hr
    calc
      _ = ‖(r : ℚ_[p]) - x + x‖ := by ring_nf
      _ ≤ _ := (padicNormE.nonarchimedean _ _)
      _ ≤ _ := max_le (le_of_lt hr) x.2

  obtain ⟨n, hzn, hnp, hn⟩ := exists_mem_range_of_norm_rat_le_one r H
  lift n to ℕ using hzn
  use n
  constructor
  · exact_mod_cast hnp
  simp only [norm_def, coe_sub, Subtype.coe_mk, coe_nat_cast] at hn⊢
  rw [show (x - n : ℚ_[p]) = x - r + (r - n) by ring]
  apply lt_of_le_of_lt (padicNormE.nonarchimedean _ _)
  apply max_lt hr
  simpa using hn
#align padic_int.exists_mem_range PadicInt.exists_mem_range

/-- `zmod_repr x` is the unique natural number smaller than `p`
satisfying `‖(x - zmod_repr x : ℤ_[p])‖ < 1`.
-/
def zmodRepr : ℕ :=
  Classical.choose (exists_mem_range x)
#align padic_int.zmod_repr PadicInt.zmodRepr

theorem zmodRepr_spec : zmodRepr x < p ∧ x - zmodRepr x ∈ maximalIdeal ℤ_[p] :=
  Classical.choose_spec (exists_mem_range x)
#align padic_int.zmod_repr_spec PadicInt.zmodRepr_spec

theorem zmodRepr_lt_p : zmodRepr x < p :=
  (zmodRepr_spec _).1
#align padic_int.zmod_repr_lt_p PadicInt.zmodRepr_lt_p

theorem sub_zmodRepr_mem : x - zmodRepr x ∈ maximalIdeal ℤ_[p] :=
  (zmodRepr_spec _).2
#align padic_int.sub_zmod_repr_mem PadicInt.sub_zmodRepr_mem

/-- `to_zmod_hom` is an auxiliary constructor for creating ring homs from `ℤ_[p]` to `zmod v`.
-/
def toZmodHom (v : ℕ) (f : ℤ_[p] → ℕ) (f_spec : ∀ x, x - f x ∈ (Ideal.span {v} : Ideal ℤ_[p]))
    (f_congr :
      ∀ (x : ℤ_[p]) (a b : ℕ),
        x - a ∈ (Ideal.span {v} : Ideal ℤ_[p]) →
          x - b ∈ (Ideal.span {v} : Ideal ℤ_[p]) → (a : ZMod v) = b) :
    ℤ_[p] →+* ZMod v where
  toFun x := f x
  map_zero' := by
    rw [f_congr (0 : ℤ_[p]) _ 0, cast_zero]
    · exact f_spec _
    · simp only [sub_zero, cast_zero, Submodule.zero_mem]
  map_one' := by
    rw [f_congr (1 : ℤ_[p]) _ 1, cast_one]
    · exact f_spec _
    · simp only [sub_self, cast_one, Submodule.zero_mem]
  map_add' := by
    intro x y
    rw [f_congr (x + y) _ (f x + f y), cast_add]
    · exact f_spec _
    · convert Ideal.add_mem _ (f_spec x) (f_spec y)
      rw [cast_add]
      ring
  map_mul' := by
    intro x y
    rw [f_congr (x * y) _ (f x * f y), cast_mul]
    · exact f_spec _
    · let I : Ideal ℤ_[p] := Ideal.span {v}
      convert I.add_mem (I.mul_mem_left x (f_spec y)) (I.mul_mem_right (f y) (f_spec x))
      rw [cast_mul]
      ring
#align padic_int.to_zmod_hom PadicInt.toZmodHom

/-- `to_zmod` is a ring hom from `ℤ_[p]` to `zmod p`,
with the equality `to_zmod x = (zmod_repr x : zmod p)`.
-/
def toZmod : ℤ_[p] →+* ZMod p :=
  toZmodHom p zmodRepr
    (by
      rw [← maximal_ideal_eq_span_p]
      exact sub_zmod_repr_mem)
    (by
      rw [← maximal_ideal_eq_span_p]
      exact zmod_congr_of_sub_mem_max_ideal)
#align padic_int.to_zmod PadicInt.toZmod

/-- `z - (to_zmod z : ℤ_[p])` is contained in the maximal ideal of `ℤ_[p]`, for every `z : ℤ_[p]`.

The coercion from `zmod p` to `ℤ_[p]` is `zmod.has_coe_t`,
which coerces `zmod p` into artibrary rings.
This is unfortunate, but a consequence of the fact that we allow `zmod p`
to coerce to rings of arbitrary characteristic, instead of only rings of characteristic `p`.
This coercion is only a ring homomorphism if it coerces into a ring whose characteristic divides
`p`. While this is not the case here we can still make use of the coercion.
-/
theorem toZmod_spec (z : ℤ_[p]) : z - (toZmod z : ℤ_[p]) ∈ maximalIdeal ℤ_[p] :=
  by
  convert sub_zmod_repr_mem z using 2
  dsimp [to_zmod, to_zmod_hom]
  rcases exists_eq_add_of_lt hp_prime.1.Pos with ⟨p', rfl⟩
  change ↑(ZMod.val _) = _
  simp only [ZMod.val_nat_cast, add_zero, add_def, Nat.cast_inj, zero_add]
  apply mod_eq_of_lt
  simpa only [zero_add] using zmod_repr_lt_p z
#align padic_int.to_zmod_spec PadicInt.toZmod_spec

theorem ker_toZmod : (toZmod : ℤ_[p] →+* ZMod p).ker = maximalIdeal ℤ_[p] :=
  by
  ext x
  rw [RingHom.mem_ker]
  constructor
  · intro h
    simpa only [h, ZMod.cast_zero, sub_zero] using to_zmod_spec x
  · intro h
    rw [← sub_zero x] at h
    dsimp [to_zmod, to_zmod_hom]
    convert zmod_congr_of_sub_mem_max_ideal x _ 0 _ h
    norm_cast
    apply sub_zmod_repr_mem
#align padic_int.ker_to_zmod PadicInt.ker_toZmod

/-- `appr n x` gives a value `v : ℕ` such that `x` and `↑v : ℤ_p` are congruent mod `p^n`.
See `appr_spec`. -/
noncomputable irreducible_def appr : ℤ_[p] → ℕ → ℕ
  | x, 0 => 0
  | x, n + 1 =>
    let y := x - appr x n
    if hy : y = 0 then appr x n
    else
      let u := unitCoeff hy
      appr x n + p ^ n * (toZmod ((u : ℤ_[p]) * p ^ (y.Valuation - n).natAbs)).val
#align padic_int.appr PadicInt.appr

theorem appr_lt (x : ℤ_[p]) (n : ℕ) : x.appr n < p ^ n :=
  by
  induction' n with n ih generalizing x
  · simp only [appr, succ_pos', pow_zero]
  simp only [appr, map_natCast, ZMod.nat_cast_self, RingHom.map_pow, Int.natAbs, RingHom.map_mul]
  have hp : p ^ n < p ^ (n + 1) := by apply pow_lt_pow hp_prime.1.one_lt (lt_add_one n)
  split_ifs with h
  · apply lt_trans (ih _) hp
  · calc
      _ < p ^ n + p ^ n * (p - 1) := _
      _ = p ^ (n + 1) := _

    · apply add_lt_add_of_lt_of_le (ih _)
      apply Nat.mul_le_mul_left
      apply le_pred_of_lt
      apply ZMod.val_lt
    · rw [mul_tsub, mul_one, ← pow_succ']
      apply add_tsub_cancel_of_le (le_of_lt hp)
#align padic_int.appr_lt PadicInt.appr_lt

theorem appr_mono (x : ℤ_[p]) : Monotone x.appr :=
  by
  apply monotone_nat_of_le_succ
  intro n
  dsimp [appr]
  split_ifs; · rfl
  apply Nat.le_add_right
#align padic_int.appr_mono PadicInt.appr_mono

theorem dvd_appr_sub_appr (x : ℤ_[p]) (m n : ℕ) (h : m ≤ n) : p ^ m ∣ x.appr n - x.appr m :=
  by
  obtain ⟨k, rfl⟩ := Nat.exists_eq_add_of_le h; clear h
  induction' k with k ih
  · simp only [add_zero, tsub_self, dvd_zero]
  rw [Nat.succ_eq_add_one, ← add_assoc]
  dsimp [appr]
  split_ifs with h
  · exact ih
  rw [add_comm, add_tsub_assoc_of_le (appr_mono _ (Nat.le_add_right m k))]
  apply dvd_add _ ih
  apply dvd_mul_of_dvd_left
  apply pow_dvd_pow _ (Nat.le_add_right m k)
#align padic_int.dvd_appr_sub_appr PadicInt.dvd_appr_sub_appr

theorem appr_spec (n : ℕ) : ∀ x : ℤ_[p], x - appr x n ∈ (Ideal.span {p ^ n} : Ideal ℤ_[p]) :=
  by
  simp only [Ideal.mem_span_singleton]
  induction' n with n ih
  · simp only [isUnit_one, IsUnit.dvd, pow_zero, forall_true_iff]
  intro x
  dsimp only [appr]
  split_ifs with h
  · rw [h]
    apply dvd_zero
  push_cast
  rw [sub_add_eq_sub_sub]
  obtain ⟨c, hc⟩ := ih x
  simp only [map_natCast, ZMod.nat_cast_self, RingHom.map_pow, RingHom.map_mul, ZMod.nat_cast_val]
  have hc' : c ≠ 0 := by
    rintro rfl
    simp only [MulZeroClass.mul_zero] at hc
    contradiction
  conv_rhs =>
    congr
    simp only [hc]
  rw [show (x - ↑(appr x n)).Valuation = (↑p ^ n * c).Valuation by rw [hc]]
  rw [valuation_p_pow_mul _ _ hc', add_sub_cancel', pow_succ', ← mul_sub]
  apply mul_dvd_mul_left
  obtain hc0 | hc0 := c.valuation.nat_abs.eq_zero_or_pos
  · simp only [hc0, mul_one, pow_zero]
    rw [mul_comm, unit_coeff_spec h] at hc
    suffices c = unit_coeff h
      by
      rw [← this, ← Ideal.mem_span_singleton, ← maximal_ideal_eq_span_p]
      apply to_zmod_spec
    obtain ⟨c, rfl⟩ : IsUnit c :=
      by
      -- TODO: write a can_lift instance for units
      rw [Int.natAbs_eq_zero] at hc0
      rw [is_unit_iff, norm_eq_pow_val hc', hc0, neg_zero, zpow_zero]
    rw [DiscreteValuationRing.unit_mul_pow_congr_unit _ _ _ _ _ hc]
    exact irreducible_p
  · rw [zero_pow hc0]
    simp only [sub_zero, ZMod.cast_zero, MulZeroClass.mul_zero]
    rw [unit_coeff_spec hc']
    exact (dvd_pow_self (p : ℤ_[p]) hc0.ne').mul_left _
#align padic_int.appr_spec PadicInt.appr_spec

/-- A ring hom from `ℤ_[p]` to `zmod (p^n)`, with underlying function `padic_int.appr n`. -/
def toZmodPow (n : ℕ) : ℤ_[p] →+* ZMod (p ^ n) :=
  toZmodHom (p ^ n) (fun x => appr x n)
    (by
      intros
      convert appr_spec n _ using 1
      simp)
    (by
      intro x a b ha hb
      apply zmod_congr_of_sub_mem_span n x a b
      · simpa using ha
      · simpa using hb)
#align padic_int.to_zmod_pow PadicInt.toZmodPow

theorem ker_toZmodPow (n : ℕ) : (toZmodPow n : ℤ_[p] →+* ZMod (p ^ n)).ker = Ideal.span {p ^ n} :=
  by
  ext x
  rw [RingHom.mem_ker]
  constructor
  · intro h
    suffices x.appr n = 0 by
      convert appr_spec n x
      simp only [this, sub_zero, cast_zero]
    dsimp [to_zmod_pow, to_zmod_hom] at h
    rw [ZMod.nat_cast_zmod_eq_zero_iff_dvd] at h
    apply eq_zero_of_dvd_of_lt h (appr_lt _ _)
  · intro h
    rw [← sub_zero x] at h
    dsimp [to_zmod_pow, to_zmod_hom]
    rw [zmod_congr_of_sub_mem_span n x _ 0 _ h, cast_zero]
    apply appr_spec
#align padic_int.ker_to_zmod_pow PadicInt.ker_toZmodPow

@[simp]
theorem zMod_cast_comp_toZmodPow (m n : ℕ) (h : m ≤ n) :
    (ZMod.castHom (pow_dvd_pow p h) (ZMod (p ^ m))).comp (toZmodPow n) = toZmodPow m :=
  by
  apply ZMod.ringHom_eq_of_ker_eq
  ext x
  rw [RingHom.mem_ker, RingHom.mem_ker]
  simp only [Function.comp_apply, ZMod.castHom_apply, RingHom.coe_comp]
  simp only [to_zmod_pow, to_zmod_hom, RingHom.coe_mk]
  rw [ZMod.cast_nat_cast (pow_dvd_pow p h),
    zmod_congr_of_sub_mem_span m (x.appr n) (x.appr n) (x.appr m)]
  · rw [sub_self]
    apply Ideal.zero_mem _
  · rw [Ideal.mem_span_singleton]
    rcases dvd_appr_sub_appr x m n h with ⟨c, hc⟩
    use c
    rw [← Nat.cast_sub (appr_mono _ h), hc, Nat.cast_mul, Nat.cast_pow]
  · infer_instance
#align padic_int.zmod_cast_comp_to_zmod_pow PadicInt.zMod_cast_comp_toZmodPow

@[simp]
theorem cast_toZmodPow (m n : ℕ) (h : m ≤ n) (x : ℤ_[p]) : ↑(toZmodPow n x) = toZmodPow m x :=
  by
  rw [← zmod_cast_comp_to_zmod_pow _ _ h]
  rfl
#align padic_int.cast_to_zmod_pow PadicInt.cast_toZmodPow

theorem denseRange_nat_cast : DenseRange (Nat.cast : ℕ → ℤ_[p]) :=
  by
  intro x
  rw [Metric.mem_closure_range_iff]
  intro ε hε
  obtain ⟨n, hn⟩ := exists_pow_neg_lt p hε
  use x.appr n
  rw [dist_eq_norm]
  apply lt_of_le_of_lt _ hn
  rw [norm_le_pow_iff_mem_span_pow]
  apply appr_spec
#align padic_int.dense_range_nat_cast PadicInt.denseRange_nat_cast

theorem denseRange_int_cast : DenseRange (Int.cast : ℤ → ℤ_[p]) :=
  by
  intro x
  apply dense_range_nat_cast.induction_on x
  · exact isClosed_closure
  · intro a
    change (a.cast : ℤ_[p]) with (a : ℤ).cast
    apply subset_closure
    exact Set.mem_range_self _
#align padic_int.dense_range_int_cast PadicInt.denseRange_int_cast

end RingHoms

section lift

/-! ### Universal property as projective limit -/

open CauSeq PadicSeq

variable {R : Type _} [NonAssocSemiring R] (f : ∀ k : ℕ, R →+* ZMod (p ^ k))
  (f_compat : ∀ (k1 k2) (hk : k1 ≤ k2), (ZMod.castHom (pow_dvd_pow p hk) _).comp (f k2) = f k1)

omit hp_prime

/-- Given a family of ring homs `f : Π n : ℕ, R →+* zmod (p ^ n)`,
`nth_hom f r` is an integer-valued sequence
whose `n`th value is the unique integer `k` such that `0 ≤ k < p ^ n`
and `f n r = (k : zmod (p ^ n))`.
-/
def nthHom (r : R) : ℕ → ℤ := fun n => (f n r : ZMod (p ^ n)).val
#align padic_int.nth_hom PadicInt.nthHom

@[simp]
theorem nthHom_zero : nthHom f 0 = 0 := by simp [nth_hom] <;> rfl
#align padic_int.nth_hom_zero PadicInt.nthHom_zero

variable {f}

include hp_prime

include f_compat

theorem pow_dvd_nthHom_sub (r : R) (i j : ℕ) (h : i ≤ j) : ↑p ^ i ∣ nthHom f r j - nthHom f r i :=
  by
  specialize f_compat i j h
  rw [← Int.coe_nat_pow, ← ZMod.int_cast_zmod_eq_zero_iff_dvd, Int.cast_sub]
  dsimp [nth_hom]
  rw [← f_compat, RingHom.comp_apply]
  simp only [ZMod.cast_id, ZMod.castHom_apply, sub_self, ZMod.nat_cast_val, ZMod.int_cast_cast]
#align padic_int.pow_dvd_nth_hom_sub PadicInt.pow_dvd_nthHom_sub

theorem isCauSeq_nthHom (r : R) : IsCauSeq (padicNorm p) fun n => nthHom f r n :=
  by
  intro ε hε
  obtain ⟨k, hk⟩ : ∃ k : ℕ, (p ^ (-(↑(k : ℕ) : ℤ)) : ℚ) < ε := exists_pow_neg_lt_rat p hε
  use k
  intro j hj
  refine' lt_of_le_of_lt _ hk
  norm_cast
  rw [← padicNorm.dvd_iff_norm_le]
  exact_mod_cast pow_dvd_nth_hom_sub f_compat r k j hj
#align padic_int.is_cau_seq_nth_hom PadicInt.isCauSeq_nthHom

/-- `nth_hom_seq f_compat r` bundles `padic_int.nth_hom f r`
as a Cauchy sequence of rationals with respect to the `p`-adic norm.
The `n`th value of the sequence is `((f n r).val : ℚ)`.
-/
def nthHomSeq (r : R) : PadicSeq p :=
  ⟨fun n => nthHom f r n, isCauSeq_nthHom f_compat r⟩
#align padic_int.nth_hom_seq PadicInt.nthHomSeq

-- this lemma ran into issues after changing to `ne_zero` and I'm not sure why.
theorem nthHomSeq_one : nthHomSeq f_compat 1 ≈ 1 :=
  by
  intro ε hε
  change _ < _ at hε
  use 1
  intro j hj
  haveI : Fact (1 < p ^ j) := ⟨Nat.one_lt_pow _ _ (by linarith) hp_prime.1.one_lt⟩
  suffices ((1 : ZMod (p ^ j)) : ℚ) = 1 by simp [nth_hom_seq, nth_hom, this, hε]
  rw [ZMod.cast_eq_val, ZMod.val_one, Nat.cast_one]
#align padic_int.nth_hom_seq_one PadicInt.nthHomSeq_one

theorem nthHomSeq_add (r s : R) :
    nthHomSeq f_compat (r + s) ≈ nthHomSeq f_compat r + nthHomSeq f_compat s :=
  by
  intro ε hε
  obtain ⟨n, hn⟩ := exists_pow_neg_lt_rat p hε
  use n
  intro j hj
  dsimp [nth_hom_seq]
  apply lt_of_le_of_lt _ hn
  rw [← Int.cast_add, ← Int.cast_sub, ← padicNorm.dvd_iff_norm_le, ←
    ZMod.int_cast_zmod_eq_zero_iff_dvd]
  dsimp [nth_hom]
  simp only [ZMod.nat_cast_val, RingHom.map_add, Int.cast_sub, ZMod.int_cast_cast, Int.cast_add]
  rw [ZMod.cast_add (show p ^ n ∣ p ^ j from pow_dvd_pow _ hj), sub_self]
  · infer_instance
#align padic_int.nth_hom_seq_add PadicInt.nthHomSeq_add

theorem nthHomSeq_mul (r s : R) :
    nthHomSeq f_compat (r * s) ≈ nthHomSeq f_compat r * nthHomSeq f_compat s :=
  by
  intro ε hε
  obtain ⟨n, hn⟩ := exists_pow_neg_lt_rat p hε
  use n
  intro j hj
  dsimp [nth_hom_seq]
  apply lt_of_le_of_lt _ hn
  rw [← Int.cast_mul, ← Int.cast_sub, ← padicNorm.dvd_iff_norm_le, ←
    ZMod.int_cast_zmod_eq_zero_iff_dvd]
  dsimp [nth_hom]
  simp only [ZMod.nat_cast_val, RingHom.map_mul, Int.cast_sub, ZMod.int_cast_cast, Int.cast_mul]
  rw [ZMod.cast_mul (show p ^ n ∣ p ^ j from pow_dvd_pow _ hj), sub_self]
  · infer_instance
#align padic_int.nth_hom_seq_mul PadicInt.nthHomSeq_mul

/--
`lim_nth_hom f_compat r` is the limit of a sequence `f` of compatible ring homs `R →+* zmod (p^k)`.
This is itself a ring hom: see `padic_int.lift`.
-/
def limNthHom (r : R) : ℤ_[p] :=
  ofIntSeq (nthHom f r) (isCauSeq_nthHom f_compat r)
#align padic_int.lim_nth_hom PadicInt.limNthHom

theorem limNthHom_spec (r : R) :
    ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n ≥ N, ‖limNthHom f_compat r - nthHom f r n‖ < ε :=
  by
  intro ε hε
  obtain ⟨ε', hε'0, hε'⟩ : ∃ v : ℚ, (0 : ℝ) < v ∧ ↑v < ε := exists_rat_btwn hε
  norm_cast  at hε'0
  obtain ⟨N, hN⟩ := padicNormE.defn (nth_hom_seq f_compat r) hε'0
  use N
  intro n hn
  apply lt_trans _ hε'
  change ↑(padicNormE _) < _
  norm_cast
  exact hN _ hn
#align padic_int.lim_nth_hom_spec PadicInt.limNthHom_spec

theorem limNthHom_zero : limNthHom f_compat 0 = 0 := by simp [lim_nth_hom] <;> rfl
#align padic_int.lim_nth_hom_zero PadicInt.limNthHom_zero

theorem limNthHom_one : limNthHom f_compat 1 = 1 :=
  Subtype.ext <| Quot.sound <| nthHomSeq_one _
#align padic_int.lim_nth_hom_one PadicInt.limNthHom_one

theorem limNthHom_add (r s : R) :
    limNthHom f_compat (r + s) = limNthHom f_compat r + limNthHom f_compat s :=
  Subtype.ext <| Quot.sound <| nthHomSeq_add _ _ _
#align padic_int.lim_nth_hom_add PadicInt.limNthHom_add

theorem limNthHom_mul (r s : R) :
    limNthHom f_compat (r * s) = limNthHom f_compat r * limNthHom f_compat s :=
  Subtype.ext <| Quot.sound <| nthHomSeq_mul _ _ _
#align padic_int.lim_nth_hom_mul PadicInt.limNthHom_mul

-- TODO: generalize this to arbitrary complete discrete valuation rings
/-- `lift f_compat` is the limit of a sequence `f` of compatible ring homs `R →+* zmod (p^k)`,
with the equality `lift f_compat r = padic_int.lim_nth_hom f_compat r`.
-/
def lift : R →+* ℤ_[p] where
  toFun := limNthHom f_compat
  map_one' := limNthHom_one f_compat
  map_mul' := limNthHom_mul f_compat
  map_zero' := limNthHom_zero f_compat
  map_add' := limNthHom_add f_compat
#align padic_int.lift PadicInt.lift

omit f_compat

theorem lift_sub_val_mem_span (r : R) (n : ℕ) :
    lift f_compat r - (f n r).val ∈ (Ideal.span {↑p ^ n} : Ideal ℤ_[p]) :=
  by
  obtain ⟨k, hk⟩ :=
    lim_nth_hom_spec f_compat r _
      (show (0 : ℝ) < p ^ (-n : ℤ) from Nat.zpow_pos_of_pos hp_prime.1.Pos _)
  have := le_of_lt (hk (max n k) (le_max_right _ _))
  rw [norm_le_pow_iff_mem_span_pow] at this
  dsimp [lift]
  rw [sub_eq_sub_add_sub (lim_nth_hom f_compat r) _ ↑(nth_hom f r (max n k))]
  apply Ideal.add_mem _ _ this
  rw [Ideal.mem_span_singleton]
  simpa only [eq_intCast, RingHom.map_pow, Int.cast_sub] using
    (Int.castRingHom ℤ_[p]).map_dvd (pow_dvd_nth_hom_sub f_compat r n (max n k) (le_max_left _ _))
#align padic_int.lift_sub_val_mem_span PadicInt.lift_sub_val_mem_span

/-- One part of the universal property of `ℤ_[p]` as a projective limit.
See also `padic_int.lift_unique`.
-/
theorem lift_spec (n : ℕ) : (toZmodPow n).comp (lift f_compat) = f n :=
  by
  ext r
  rw [RingHom.comp_apply, ← ZMod.nat_cast_zmod_val (f n r), ← map_natCast <| to_zmod_pow n, ←
    sub_eq_zero, ← RingHom.map_sub, ← RingHom.mem_ker, ker_to_zmod_pow]
  apply lift_sub_val_mem_span
#align padic_int.lift_spec PadicInt.lift_spec

/-- One part of the universal property of `ℤ_[p]` as a projective limit.
See also `padic_int.lift_spec`.
-/
theorem lift_unique (g : R →+* ℤ_[p]) (hg : ∀ n, (toZmodPow n).comp g = f n) : lift f_compat = g :=
  by
  ext1 r
  apply eq_of_forall_dist_le
  intro ε hε
  obtain ⟨n, hn⟩ := exists_pow_neg_lt p hε
  apply le_trans _ (le_of_lt hn)
  rw [dist_eq_norm, norm_le_pow_iff_mem_span_pow, ← ker_to_zmod_pow, RingHom.mem_ker,
    RingHom.map_sub, ← RingHom.comp_apply, ← RingHom.comp_apply, lift_spec, hg, sub_self]
#align padic_int.lift_unique PadicInt.lift_unique

@[simp]
theorem lift_self (z : ℤ_[p]) : @lift p _ ℤ_[p] _ toZmodPow zMod_cast_comp_toZmodPow z = z :=
  by
  show _ = RingHom.id _ z
  rw [@lift_unique p _ ℤ_[p] _ _ zmod_cast_comp_to_zmod_pow (RingHom.id ℤ_[p])]
  intro ; rw [RingHom.comp_id]
#align padic_int.lift_self PadicInt.lift_self

end lift

theorem ext_of_toZmodPow {x y : ℤ_[p]} : (∀ n, toZmodPow n x = toZmodPow n y) ↔ x = y :=
  by
  constructor
  · intro h
    rw [← lift_self x, ← lift_self y]
    simp [lift, lim_nth_hom, nth_hom, h]
  · rintro rfl _
    rfl
#align padic_int.ext_of_to_zmod_pow PadicInt.ext_of_toZmodPow

theorem toZmodPow_eq_iff_ext {R : Type _} [NonAssocSemiring R] {g g' : R →+* ℤ_[p]} :
    (∀ n, (toZmodPow n).comp g = (toZmodPow n).comp g') ↔ g = g' :=
  by
  constructor
  · intro hg
    ext x : 1
    apply ext_of_to_zmod_pow.mp
    intro n
    show (to_zmod_pow n).comp g x = (to_zmod_pow n).comp g' x
    rw [hg n]
  · rintro rfl _
    rfl
#align padic_int.to_zmod_pow_eq_iff_ext PadicInt.toZmodPow_eq_iff_ext

end PadicInt


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.ring.basic
import Mathlib.algebra.group_with_zero.default
import Mathlib.PostPort

universes u l u_1 u_2

namespace Mathlib

/-- A `division_ring` is a `ring` with multiplicative inverses for nonzero elements -/
class division_ring (K : Type u) extends div_inv_monoid K, ring K, nontrivial K where
  mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * (a⁻¹) = 1
  inv_zero : 0⁻¹ = 0

/-- Every division ring is a `group_with_zero`. -/
protected instance division_ring.to_group_with_zero {K : Type u} [division_ring K] :
    group_with_zero K :=
  group_with_zero.mk division_ring.mul division_ring.mul_assoc division_ring.one
    division_ring.one_mul division_ring.mul_one division_ring.zero sorry sorry division_ring.inv
    division_ring.div division_ring.exists_pair_ne division_ring.inv_zero
    division_ring.mul_inv_cancel

theorem inverse_eq_has_inv {K : Type u} [division_ring K] : ring.inverse = has_inv.inv := sorry

theorem one_div_neg_one_eq_neg_one {K : Type u} [division_ring K] : 1 / -1 = -1 :=
  (fun (this : -1 * -1 = 1) => Eq.symm (eq_one_div_of_mul_eq_one this))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-1 * -1 = 1)) (neg_mul_neg 1 1)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 * 1 = 1)) (one_mul 1))) (Eq.refl 1)))

theorem one_div_neg_eq_neg_one_div {K : Type u} [division_ring K] (a : K) : 1 / -a = -(1 / a) :=
  sorry

theorem div_neg_eq_neg_div {K : Type u} [division_ring K] (a : K) (b : K) : b / -a = -(b / a) :=
  sorry

theorem neg_div {K : Type u} [division_ring K] (a : K) (b : K) : -b / a = -(b / a) := sorry

theorem neg_div' {K : Type u_1} [division_ring K] (a : K) (b : K) : -(b / a) = -b / a := sorry

theorem neg_div_neg_eq {K : Type u} [division_ring K] (a : K) (b : K) : -a / -b = a / b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-a / -b = a / b)) (div_neg_eq_neg_div b (-a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-(-a / b) = a / b)) (neg_div b a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl ( --(a / b) = a / b)) (neg_neg (a / b)))) (Eq.refl (a / b))))

theorem div_add_div_same {K : Type u} [division_ring K] (a : K) (b : K) (c : K) :
    a / c + b / c = (a + b) / c :=
  sorry

theorem same_add_div {K : Type u} [division_ring K] {a : K} {b : K} (h : b ≠ 0) :
    (b + a) / b = 1 + a / b :=
  sorry

theorem one_add_div {K : Type u} [division_ring K] {a : K} {b : K} (h : b ≠ 0) :
    1 + a / b = (b + a) / b :=
  Eq.symm (same_add_div h)

theorem div_add_same {K : Type u} [division_ring K] {a : K} {b : K} (h : b ≠ 0) :
    (a + b) / b = a / b + 1 :=
  sorry

theorem div_add_one {K : Type u} [division_ring K] {a : K} {b : K} (h : b ≠ 0) :
    a / b + 1 = (a + b) / b :=
  Eq.symm (div_add_same h)

theorem div_sub_div_same {K : Type u} [division_ring K] (a : K) (b : K) (c : K) :
    a / c - b / c = (a - b) / c :=
  sorry

theorem same_sub_div {K : Type u} [division_ring K] {a : K} {b : K} (h : b ≠ 0) :
    (b - a) / b = 1 - a / b :=
  sorry

theorem one_sub_div {K : Type u} [division_ring K] {a : K} {b : K} (h : b ≠ 0) :
    1 - a / b = (b - a) / b :=
  Eq.symm (same_sub_div h)

theorem div_sub_same {K : Type u} [division_ring K] {a : K} {b : K} (h : b ≠ 0) :
    (a - b) / b = a / b - 1 :=
  sorry

theorem div_sub_one {K : Type u} [division_ring K] {a : K} {b : K} (h : b ≠ 0) :
    a / b - 1 = (a - b) / b :=
  Eq.symm (div_sub_same h)

theorem neg_inv {K : Type u} [division_ring K] {a : K} : -(a⁻¹) = (-a⁻¹) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-(a⁻¹) = (-a⁻¹))) (inv_eq_one_div a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-(1 / a) = (-a⁻¹))) (inv_eq_one_div (-a))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (-(1 / a) = 1 / -a)) (div_neg_eq_neg_div a 1)))
        (Eq.refl (-(1 / a)))))

theorem add_div {K : Type u} [division_ring K] (a : K) (b : K) (c : K) :
    (a + b) / c = a / c + b / c :=
  Eq.symm (div_add_div_same a b c)

theorem sub_div {K : Type u} [division_ring K] (a : K) (b : K) (c : K) :
    (a - b) / c = a / c - b / c :=
  Eq.symm (div_sub_div_same a b c)

theorem div_neg {K : Type u} [division_ring K] {b : K} (a : K) : a / -b = -(a / b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / -b = -(a / b))) (Eq.symm (div_neg_eq_neg_div b a))))
    (Eq.refl (a / -b))

theorem inv_neg {K : Type u} [division_ring K] {a : K} : -a⁻¹ = -(a⁻¹) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-a⁻¹ = -(a⁻¹))) neg_inv)) (Eq.refl (-a⁻¹))

theorem one_div_mul_add_mul_one_div_eq_one_div_add_one_div {K : Type u} [division_ring K] {a : K}
    {b : K} (ha : a ≠ 0) (hb : b ≠ 0) : 1 / a * (a + b) * (1 / b) = 1 / a + 1 / b :=
  sorry

theorem one_div_mul_sub_mul_one_div_eq_one_div_add_one_div {K : Type u} [division_ring K] {a : K}
    {b : K} (ha : a ≠ 0) (hb : b ≠ 0) : 1 / a * (b - a) * (1 / b) = 1 / a - 1 / b :=
  sorry

theorem add_div_eq_mul_add_div {K : Type u} [division_ring K] (a : K) (b : K) {c : K} (hc : c ≠ 0) :
    a + b / c = (a * c + b) / c :=
  iff.mpr (eq_div_iff_mul_eq hc)
    (eq.mpr (id (Eq._oldrec (Eq.refl ((a + b / c) * c = a * c + b)) (right_distrib a (b / c) c)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * c + b / c * c = a * c + b)) (div_mul_cancel b hc)))
        (Eq.refl (a * c + b))))

protected instance division_ring.to_domain {K : Type u} [division_ring K] : domain K :=
  domain.mk division_ring.add division_ring.add_assoc division_ring.zero division_ring.zero_add
    division_ring.add_zero division_ring.neg division_ring.sub division_ring.add_left_neg
    division_ring.add_comm division_ring.mul division_ring.mul_assoc division_ring.one
    division_ring.one_mul division_ring.mul_one division_ring.left_distrib
    division_ring.right_distrib division_ring.exists_pair_ne sorry

/-- A `field` is a `comm_ring` with multiplicative inverses for nonzero elements -/
class field (K : Type u) extends has_inv K, comm_ring K, nontrivial K where
  mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * (a⁻¹) = 1
  inv_zero : 0⁻¹ = 0

protected instance field.to_division_ring {K : Type u} [field K] : division_ring K :=
  division_ring.mk field.add sorry field.zero sorry sorry field.neg field.sub sorry sorry field.mul
    sorry field.one sorry sorry sorry sorry field.inv
    (div_inv_monoid.div._default field.mul sorry field.one sorry sorry field.inv) sorry sorry sorry

/-- Every field is a `comm_group_with_zero`. -/
protected instance field.to_comm_group_with_zero {K : Type u} [field K] : comm_group_with_zero K :=
  comm_group_with_zero.mk group_with_zero.mul sorry group_with_zero.one sorry sorry field.mul_comm
    group_with_zero.zero sorry sorry group_with_zero.inv group_with_zero.div sorry sorry sorry

theorem one_div_add_one_div {K : Type u} [field K] {a : K} {b : K} (ha : a ≠ 0) (hb : b ≠ 0) :
    1 / a + 1 / b = (a + b) / (a * b) :=
  sorry

theorem div_add_div {K : Type u} [field K] (a : K) {b : K} (c : K) {d : K} (hb : b ≠ 0)
    (hd : d ≠ 0) : a / b + c / d = (a * d + b * c) / (b * d) :=
  sorry

theorem div_sub_div {K : Type u} [field K] (a : K) {b : K} (c : K) {d : K} (hb : b ≠ 0)
    (hd : d ≠ 0) : a / b - c / d = (a * d - b * c) / (b * d) :=
  sorry

theorem inv_add_inv {K : Type u} [field K] {a : K} {b : K} (ha : a ≠ 0) (hb : b ≠ 0) :
    a⁻¹ + (b⁻¹) = (a + b) / (a * b) :=
  sorry

theorem inv_sub_inv {K : Type u} [field K] {a : K} {b : K} (ha : a ≠ 0) (hb : b ≠ 0) :
    a⁻¹ - (b⁻¹) = (b - a) / (a * b) :=
  sorry

theorem add_div' {K : Type u} [field K] (a : K) (b : K) (c : K) (hc : c ≠ 0) :
    b + a / c = (b * c + a) / c :=
  sorry

theorem sub_div' {K : Type u} [field K] (a : K) (b : K) (c : K) (hc : c ≠ 0) :
    b - a / c = (b * c - a) / c :=
  sorry

theorem div_add' {K : Type u} [field K] (a : K) (b : K) (c : K) (hc : c ≠ 0) :
    a / c + b = (a + b * c) / c :=
  sorry

theorem div_sub' {K : Type u} [field K] (a : K) (b : K) (c : K) (hc : c ≠ 0) :
    a / c - b = (a - c * b) / c :=
  sorry

protected instance field.to_integral_domain {K : Type u} [field K] : integral_domain K :=
  integral_domain.mk field.add field.add_assoc field.zero field.zero_add field.add_zero field.neg
    field.sub field.add_left_neg field.add_comm field.mul field.mul_assoc field.one field.one_mul
    field.mul_one field.left_distrib field.right_distrib field.mul_comm field.exists_pair_ne sorry

/-- A predicate to express that a ring is a field.

This is mainly useful because such a predicate does not contain data,
and can therefore be easily transported along ring isomorphisms.
Additionaly, this is useful when trying to prove that
a particular ring structure extends to a field. -/
structure is_field (R : Type u) [ring R] where
  exists_pair_ne : ∃ (x : R), ∃ (y : R), x ≠ y
  mul_comm : ∀ (x y : R), x * y = y * x
  mul_inv_cancel : ∀ {a : R}, a ≠ 0 → ∃ (b : R), a * b = 1

/-- Transferring from field to is_field -/
theorem field.to_is_field (R : Type u) [field R] : is_field R :=
  is_field.mk field.exists_pair_ne field.mul_comm
    fun (a : R) (ha : a ≠ 0) => Exists.intro (a⁻¹) (field.mul_inv_cancel ha)

/-- Transferring from is_field to field -/
def is_field.to_field (R : Type u) [ring R] (h : is_field R) : field R :=
  field.mk ring.add ring.add_assoc ring.zero ring.zero_add ring.add_zero ring.neg ring.sub
    ring.add_left_neg ring.add_comm ring.mul ring.mul_assoc ring.one ring.one_mul ring.mul_one
    ring.left_distrib ring.right_distrib (is_field.mul_comm h)
    (fun (a : R) =>
      dite (a = 0) (fun (ha : a = 0) => 0)
        fun (ha : ¬a = 0) => classical.some (is_field.mul_inv_cancel h ha))
    (is_field.exists_pair_ne h) sorry sorry

/-- For each field, and for each nonzero element of said field, there is a unique inverse.
Since `is_field` doesn't remember the data of an `inv` function and as such,
a lemma that there is a unique inverse could be useful.
-/
theorem uniq_inv_of_is_field (R : Type u) [ring R] (hf : is_field R) (x : R) :
    x ≠ 0 → exists_unique fun (y : R) => x * y = 1 :=
  sorry

namespace ring_hom

@[simp] theorem map_units_inv {K : Type u} {R : Type u_1} [semiring R] [division_ring K]
    (f : R →+* K) (u : units R) : coe_fn f ↑(u⁻¹) = (coe_fn f ↑u⁻¹) :=
  monoid_hom.map_units_inv (↑f) u

theorem map_ne_zero {K : Type u} {R : Type u_1} [division_ring K] [semiring R] [nontrivial R]
    (f : K →+* R) {x : K} : coe_fn f x ≠ 0 ↔ x ≠ 0 :=
  monoid_with_zero_hom.map_ne_zero (to_monoid_with_zero_hom f)

@[simp] theorem map_eq_zero {K : Type u} {R : Type u_1} [division_ring K] [semiring R]
    [nontrivial R] (f : K →+* R) {x : K} : coe_fn f x = 0 ↔ x = 0 :=
  monoid_with_zero_hom.map_eq_zero (to_monoid_with_zero_hom f)

theorem map_inv {K : Type u} {K' : Type u_2} [division_ring K] [division_ring K'] (g : K →+* K')
    (x : K) : coe_fn g (x⁻¹) = (coe_fn g x⁻¹) :=
  monoid_with_zero_hom.map_inv' (to_monoid_with_zero_hom g) x

theorem map_div {K : Type u} {K' : Type u_2} [division_ring K] [division_ring K'] (g : K →+* K')
    (x : K) (y : K) : coe_fn g (x / y) = coe_fn g x / coe_fn g y :=
  monoid_with_zero_hom.map_div (to_monoid_with_zero_hom g) x y

protected theorem injective {K : Type u} {R : Type u_1} [division_ring K] [semiring R]
    [nontrivial R] (f : K →+* R) : function.injective ⇑f :=
  iff.mpr (injective_iff f) fun (x : K) => iff.mp (map_eq_zero f)

end ring_hom

/-- Constructs a `division_ring` structure on a `ring` consisting only of units and 0. -/
def division_ring_of_is_unit_or_eq_zero {R : Type u_1} [nontrivial R] [hR : ring R]
    (h : ∀ (a : R), is_unit a ∨ a = 0) : division_ring R :=
  division_ring.mk ring.add ring.add_assoc group_with_zero.zero ring.zero_add ring.add_zero ring.neg
    ring.sub ring.add_left_neg ring.add_comm group_with_zero.mul sorry group_with_zero.one sorry
    sorry ring.left_distrib ring.right_distrib group_with_zero.inv group_with_zero.div sorry sorry
    sorry

/-- Constructs a `field` structure on a `comm_ring` consisting only of units and 0. -/
def field_of_is_unit_or_eq_zero {R : Type u_1} [nontrivial R] [hR : comm_ring R]
    (h : ∀ (a : R), is_unit a ∨ a = 0) : field R :=
  field.mk comm_ring.add comm_ring.add_assoc group_with_zero.zero comm_ring.zero_add
    comm_ring.add_zero comm_ring.neg comm_ring.sub comm_ring.add_left_neg comm_ring.add_comm
    group_with_zero.mul sorry group_with_zero.one sorry sorry comm_ring.left_distrib
    comm_ring.right_distrib comm_ring.mul_comm group_with_zero.inv sorry sorry sorry

end Mathlib


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel
-/
import order.bounds.basic

/-!
# Monotonicity on intervals

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

In this file we prove that a function is (strictly) monotone (or antitone) on a linear order `α`
provided that it is (strictly) monotone on `(-∞, a]` and on `[a, +∞)`. This is a special case
of a more general statement where one deduces monotonicity on a union from monotonicity on each
set.
-/

open set
variables {α β : Type*} [linear_order α] [preorder β] {a : α} {f : α → β}

/-- If `f` is strictly monotone both on `s` and `t`, with `s` to the left of `t` and the center
point belonging to both `s` and `t`, then `f` is strictly monotone on `s ∪ t` -/
protected lemma strict_mono_on.union {s t : set α} {c : α} (h₁ : strict_mono_on f s)
  (h₂ : strict_mono_on f t) (hs : is_greatest s c) (ht : is_least t c) :
  strict_mono_on f (s ∪ t) :=
begin
  have A : ∀ x, x ∈ s ∪ t → x ≤ c → x ∈ s,
  { assume x hx hxc,
    cases hx, { exact hx },
    rcases eq_or_lt_of_le hxc with rfl|h'x, { exact hs.1 },
    exact (lt_irrefl _ (h'x.trans_le (ht.2 hx))).elim },
  have B : ∀ x, x ∈ s ∪ t → c ≤ x → x ∈ t,
  { assume x hx hxc,
    cases hx, swap, { exact hx },
    rcases eq_or_lt_of_le hxc with rfl|h'x, { exact ht.1 },
    exact (lt_irrefl _ (h'x.trans_le (hs.2 hx))).elim },
  assume x hx y hy hxy,
  rcases lt_or_le x c with hxc|hcx,
  { have xs : x ∈ s, from A _ hx hxc.le,
    rcases lt_or_le y c with hyc|hcy,
    { exact h₁ xs (A _ hy hyc.le) hxy },
    { exact (h₁ xs hs.1 hxc).trans_le (h₂.monotone_on ht.1 (B _ hy hcy) hcy) } },
  { have xt : x ∈ t, from B _ hx hcx,
    have yt : y ∈ t, from B _ hy (hcx.trans hxy.le),
    exact h₂ xt yt hxy }
end

/-- If `f` is strictly monotone both on `(-∞, a]` and `[a, ∞)`, then it is strictly monotone on the
whole line. -/
protected lemma strict_mono_on.Iic_union_Ici (h₁ : strict_mono_on f (Iic a))
  (h₂ : strict_mono_on f (Ici a)) : strict_mono f :=
begin
  rw [← strict_mono_on_univ, ← @Iic_union_Ici _ _ a],
  exact strict_mono_on.union h₁ h₂ is_greatest_Iic is_least_Ici,
end

/-- If `f` is strictly antitone both on `s` and `t`, with `s` to the left of `t` and the center
point belonging to both `s` and `t`, then `f` is strictly antitone on `s ∪ t` -/
protected lemma strict_anti_on.union {s t : set α} {c : α} (h₁ : strict_anti_on f s)
  (h₂ : strict_anti_on f t) (hs : is_greatest s c) (ht : is_least t c) :
  strict_anti_on f (s ∪ t) :=
(h₁.dual_right.union h₂.dual_right hs ht).dual_right

/-- If `f` is strictly antitone both on `(-∞, a]` and `[a, ∞)`, then it is strictly antitone on the
whole line. -/
protected lemma strict_anti_on.Iic_union_Ici (h₁ : strict_anti_on f (Iic a))
  (h₂ : strict_anti_on f (Ici a)) : strict_anti f :=
(h₁.dual_right.Iic_union_Ici h₂.dual_right).dual_right

/-- If `f` is monotone both on `s` and `t`, with `s` to the left of `t` and the center
point belonging to both `s` and `t`, then `f` is monotone on `s ∪ t` -/
protected lemma monotone_on.union_right {s t : set α} {c : α} (h₁ : monotone_on f s)
  (h₂ : monotone_on f t) (hs : is_greatest s c) (ht : is_least t c) :
  monotone_on f (s ∪ t) :=
begin
  have A : ∀ x, x ∈ s ∪ t → x ≤ c → x ∈ s,
  { assume x hx hxc,
    cases hx, { exact hx },
    rcases eq_or_lt_of_le hxc with rfl|h'x, { exact hs.1 },
    exact (lt_irrefl _ (h'x.trans_le (ht.2 hx))).elim },
  have B : ∀ x, x ∈ s ∪ t → c ≤ x → x ∈ t,
  { assume x hx hxc,
    cases hx, swap, { exact hx },
    rcases eq_or_lt_of_le hxc with rfl|h'x, { exact ht.1 },
    exact (lt_irrefl _ (h'x.trans_le (hs.2 hx))).elim },
  assume x hx y hy hxy,
  rcases lt_or_le x c with hxc|hcx,
  { have xs : x ∈ s, from A _ hx hxc.le,
    rcases lt_or_le y c with hyc|hcy,
    { exact h₁ xs (A _ hy hyc.le) hxy },
    { exact (h₁ xs hs.1 hxc.le).trans (h₂ ht.1 (B _ hy hcy) hcy) } },
  { have xt : x ∈ t, from B _ hx hcx,
    have yt : y ∈ t, from B _ hy (hcx.trans hxy),
    exact h₂ xt yt hxy }
end

/-- If `f` is monotone both on `(-∞, a]` and `[a, ∞)`, then it is monotone on the whole line. -/
protected lemma monotone_on.Iic_union_Ici (h₁ : monotone_on f (Iic a))
  (h₂ : monotone_on f (Ici a)) : monotone f :=
begin
  rw [← monotone_on_univ, ← @Iic_union_Ici _ _ a],
  exact monotone_on.union_right h₁ h₂ is_greatest_Iic is_least_Ici
end

/-- If `f` is antitone both on `s` and `t`, with `s` to the left of `t` and the center
point belonging to both `s` and `t`, then `f` is antitone on `s ∪ t` -/
protected lemma antitone_on.union_right {s t : set α} {c : α} (h₁ : antitone_on f s)
  (h₂ : antitone_on f t) (hs : is_greatest s c) (ht : is_least t c) :
  antitone_on f (s ∪ t) :=
(h₁.dual_right.union_right h₂.dual_right hs ht).dual_right

/-- If `f` is antitone both on `(-∞, a]` and `[a, ∞)`, then it is antitone on the whole line. -/
protected lemma antitone_on.Iic_union_Ici (h₁ : antitone_on f (Iic a))
  (h₂ : antitone_on f (Ici a)) : antitone f :=
(h₁.dual_right.Iic_union_Ici h₂.dual_right).dual_right


import data.list.basic

section
variables (x y z : nat) (p : nat → Prop)
variable (h : p (x * y))

example : (x + 0) * (0 + y * 1 + z * 0) = x * y :=
by simp

include h

example : p ((x + 0) * (0 + y * 1 + z * 0)) :=
by { simp, assumption }

end

section

universe u
variable {α : Type}
open list
example (xs : list nat) :

reverse (xs ++ [1, 2, 3]) = [3, 2, 1] ++ reverse xs :=
by simp

example (xs ys : list α) :
length (reverse (xs ++ ys)) = length xs + length ys :=
by simp

variables (x y z : nat) (p : nat → Prop)

example (h : p ((x + 0) * (0 + y * 1 + z * 0))) :
p (x * y) :=
by { simp at h, assumption }

end

section
variables (w x y z : nat) (p : nat → Prop)

local attribute [simp] mul_comm mul_assoc mul_left_comm

example (h : p (x * y + z * w * x)) :
  p (x * w * z + y * x) :=
by { simp at *, assumption }

example (h1 : p (1 * x + y)) (h2 : p (x * z * 1)) :
  p (y + 0 + x) ∧ p (z * x) :=
by { simp at *, split; assumption }

def f (m n : nat) : nat := m + n + m
example {m n : nat} (h : n = 1) (h' : 0 = m) : (f m n) * m = m :=
by simp [h, h'.symm, f]

end

section

variables (p q r : Prop)
example (hp : p) : p ∧ q ↔ q :=
by simp *
example (hp : p) : p ∨ q :=
by simp *
example (hp : p) (hq : q) : p ∧ (q ∨ r) :=
by simp *

end

namespace test
open list

universe u

variables {α : Type} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs

theorem reverse_mk_symm (xs : list α) :
reverse (mk_symm xs) = mk_symm xs :=
by { unfold mk_symm, simp }

example (xs ys : list nat) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
by simp [reverse_mk_symm]

example (xs ys : list nat) (p : list nat → Prop)
(h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
by simp [reverse_mk_symm] at h; assumption

end test

section

open list

variables {α : Type}

def mk_symm (xs : list α) := xs ++ reverse xs

@[simp] theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
by simp [mk_symm]

example (xs ys : list nat) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
by simp

example (xs ys : list nat) (p : list nat → Prop)
(h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
by simp at h; assumption

end