/-
Copyright (c) 2019 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Scott Morrison
-/
import set_theory.pgame

/-!
# Surreal numbers

The basic theory of surreal numbers, built on top of the theory of combinatorial (pre-)games.

A pregame is `numeric` if all the Left options are strictly smaller than all the Right options, and
all those options are themselves numeric. In terms of combinatorial games, the numeric games have
"frozen"; you can only make your position worse by playing, and Left is some definite "number" of
moves ahead (or behind) Right.

A surreal number is an equivalence class of numeric pregames.

In fact, the surreals form a complete ordered field, containing a copy of the reals (and much else
besides!) but we do not yet have a complete development.

## Order properties
Surreal numbers inherit the relations `≤` and `<` from games, and these relations satisfy the axioms
of a partial order (recall that `x < y ↔ x ≤ y ∧ ¬ y ≤ x` did not hold for games).

## Algebraic operations
We show that the surreals form a linear ordered commutative group.

One can also map all the ordinals into the surreals!

### Multiplication of surreal numbers
The definition of multiplication for surreal numbers is surprisingly difficult and is currently
missing in the library. A sample proof can be found in Theorem 3.8 in the second reference below.
The difficulty lies in the length of the proof and the number of theorems that need to proven
simultaneously. This will make for a fun and challenging project.

## References
* [Conway, *On numbers and games*][conway2001]
* [Schleicher, Stoll, *An introduction to Conway's games and numbers*][schleicher_stoll]
-/

universes u

local infix ` ≈ ` := pgame.equiv

namespace pgame

/-- A pre-game is numeric if everything in the L set is less than everything in the R set,
and all the elements of L and R are also numeric. -/
def numeric : pgame → Prop
| ⟨l, r, L, R⟩ :=
  (∀ i j, L i < R j) ∧ (∀ i, numeric (L i)) ∧ (∀ i, numeric (R i))

lemma numeric.move_left {x : pgame} (o : numeric x) (i : x.left_moves) :
  numeric (x.move_left i) :=
begin
  cases x with xl xr xL xR,
  exact o.2.1 i,
end
lemma numeric.move_right {x : pgame} (o : numeric x) (j : x.right_moves) :
  numeric (x.move_right j) :=
begin
  cases x with xl xr xL xR,
  exact o.2.2 j,
end

@[elab_as_eliminator]
theorem numeric_rec {C : pgame → Prop}
  (H : ∀ l r (L : l → pgame) (R : r → pgame),
    (∀ i j, L i < R j) → (∀ i, numeric (L i)) → (∀ i, numeric (R i)) →
    (∀ i, C (L i)) → (∀ i, C (R i)) → C ⟨l, r, L, R⟩) :
  ∀ x, numeric x → C x
| ⟨l, r, L, R⟩ ⟨h, hl, hr⟩ :=
  H _ _ _ _ h hl hr (λ i, numeric_rec _ (hl i)) (λ i, numeric_rec _ (hr i))

theorem lt_asymm {x y : pgame} (ox : numeric x) (oy : numeric y) : x < y → ¬ y < x :=
begin
  refine numeric_rec (λ xl xr xL xR hx oxl oxr IHxl IHxr, _) x ox y oy,
  refine numeric_rec (λ yl yr yL yR hy oyl oyr IHyl IHyr, _),
  rw [mk_lt_mk, mk_lt_mk], rintro (⟨i, h₁⟩ | ⟨j, h₁⟩) (⟨i, h₂⟩ | ⟨j, h₂⟩),
  { exact IHxl _ _ (oyl _) (lt_of_le_mk h₁) (lt_of_le_mk h₂) },
  { exact not_lt.2 (le_trans h₂ h₁) (hy _ _) },
  { exact not_lt.2 (le_trans h₁ h₂) (hx _ _) },
  { exact IHxr _ _ (oyr _) (lt_of_mk_le h₁) (lt_of_mk_le h₂) },
end

theorem le_of_lt {x y : pgame} (ox : numeric x) (oy : numeric y) (h : x < y) : x ≤ y :=
not_lt.1 (lt_asymm ox oy h)

/-- On numeric pre-games, `<` and `≤` satisfy the axioms of a partial order (even though they
don't on all pre-games). -/
theorem lt_iff_le_not_le {x y : pgame} (ox : numeric x) (oy : numeric y) :
  x < y ↔ x ≤ y ∧ ¬ y ≤ x :=
⟨λ h, ⟨le_of_lt ox oy h, not_le.2 h⟩, λ h, not_le.1 h.2⟩

theorem numeric_zero : numeric 0 :=
⟨by rintros ⟨⟩ ⟨⟩, ⟨by rintros ⟨⟩, by rintros ⟨⟩⟩⟩
theorem numeric_one : numeric 1 :=
⟨by rintros ⟨⟩ ⟨⟩, ⟨λ x, numeric_zero, by rintros ⟨⟩⟩⟩

theorem numeric_neg : Π {x : pgame} (o : numeric x), numeric (-x)
| ⟨l, r, L, R⟩ o :=
⟨λ j i, lt_iff_neg_gt.1 (o.1 i j),
  ⟨λ j, numeric_neg (o.2.2 j), λ i, numeric_neg (o.2.1 i)⟩⟩

-- We provide this as an analogue for `numeric.move_left_le`,
-- even though it does not need the `numeric` hypothesis.
@[nolint unused_arguments]

theorem numeric.move_left_le {x : pgame} (o : numeric x) (i : x.left_moves) :
  x.move_left i ≤ x :=
le_of_lt (o.move_left i) o (o.move_left_lt i)

-- We provide this as an analogue for `numeric.le_move_right`,
-- even though it does not need the `numeric` hypothesis.
@[nolint unused_arguments]
theorem numeric.lt_move_right {x : pgame} (o : numeric x) (j : x.right_moves) :
  x < x.move_right j :=
begin
  rw lt_def_le,
  right,
  use j,
end

theorem numeric.le_move_right {x : pgame} (o : numeric x) (j : x.right_moves) :
  x ≤ x.move_right j :=
le_of_lt o (o.move_right j) (o.lt_move_right j)

theorem add_lt_add
  {w x y z : pgame.{u}} (oy : numeric y) (oz : numeric z)
  (hwx : w < x) (hyz : y < z) : w + y < x + z :=
begin
  rw lt_def_le at *,
  rcases hwx with ⟨ix, hix⟩|⟨jw, hjw⟩;
  rcases hyz with ⟨iz, hiz⟩|⟨jy, hjy⟩,
  { left,
    use (left_moves_add x z).symm (sum.inl ix),
    simp only [add_move_left_inl],
    calc w + y ≤ move_left x ix + y : add_le_add_right hix
            ... ≤ move_left x ix + move_left z iz : add_le_add_left hiz
            ... ≤ move_left x ix + z : add_le_add_left (oz.move_left_le iz) },
  { left,
    use (left_moves_add x z).symm (sum.inl ix),
    simp only [add_move_left_inl],
    calc w + y ≤ move_left x ix + y : add_le_add_right hix
            ... ≤ move_left x ix + move_right y jy : add_le_add_left (oy.le_move_right jy)
            ... ≤ move_left x ix + z : add_le_add_left hjy },
  { right,
    use (right_moves_add w y).symm (sum.inl jw),
    simp only [add_move_right_inl],
    calc move_right w jw + y ≤ x + y : add_le_add_right hjw
            ... ≤ x + move_left z iz : add_le_add_left hiz
            ... ≤ x + z : add_le_add_left (oz.move_left_le iz), },
  { right,
    use (right_moves_add w y).symm (sum.inl jw),
    simp only [add_move_right_inl],
    calc move_right w jw + y ≤ x + y : add_le_add_right hjw
            ... ≤ x + move_right y jy : add_le_add_left (oy.le_move_right jy)
            ... ≤ x + z : add_le_add_left hjy, },
end

theorem numeric_add : Π {x y : pgame} (ox : numeric x) (oy : numeric y), numeric (x + y)
| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ ox oy :=
⟨begin
   rintros (ix|iy) (jx|jy),
   { show xL ix + ⟨yl, yr, yL, yR⟩ < xR jx + ⟨yl, yr, yL, yR⟩,
     exact add_lt_add_right (ox.1 ix jx), },
   { show xL ix + ⟨yl, yr, yL, yR⟩ < ⟨xl, xr, xL, xR⟩ + yR jy,
     exact add_lt_add oy (oy.move_right jy) (ox.move_left_lt _) (oy.lt_move_right _), },
   { --  show ⟨xl, xr, xL, xR⟩ + yL iy < xR jx + ⟨yl, yr, yL, yR⟩, -- fails?
     exact add_lt_add (oy.move_left iy) oy (ox.lt_move_right _) (oy.move_left_lt _), },
   { --  show ⟨xl, xr, xL, xR⟩ + yL iy < ⟨xl, xr, xL, xR⟩ + yR jy, -- fails?
     exact @add_lt_add_left ⟨xl, xr, xL, xR⟩ _ _ (oy.1 iy jy), }
 end,
 begin
   split,
   { rintros (ix|iy),
     { apply numeric_add (ox.move_left ix) oy, },
     { apply numeric_add ox (oy.move_left iy), }, },
   { rintros (jx|jy),
     { apply numeric_add (ox.move_right jx) oy, },
     { apply numeric_add ox (oy.move_right jy), }, },
 end⟩
using_well_founded { dec_tac := pgame_wf_tac }

/-- Pre-games defined by natural numbers are numeric. -/
theorem numeric_nat : Π (n : ℕ), numeric n
| 0 := numeric_zero
| (n + 1) := numeric_add (numeric_nat n) numeric_one

/-- The pre-game omega is numeric. -/
theorem numeric_omega : numeric omega :=
⟨by rintros ⟨⟩ ⟨⟩, λ i, numeric_nat i.down, by rintros ⟨⟩⟩

/-- The pre-game `half` is numeric. -/
theorem numeric_half : numeric half :=
begin
  split,
  { rintros ⟨ ⟩ ⟨ ⟩,
    exact zero_lt_one },
  split; rintro ⟨ ⟩,
  { exact numeric_zero },
  { exact numeric_one }
end

theorem half_add_half_equiv_one : half + half ≈ 1 :=
begin
  split; rw le_def; split,
  { rintro (⟨⟨ ⟩⟩ | ⟨⟨ ⟩⟩),
    { right,
      use (sum.inr punit.star),
      calc ((half + half).move_left (sum.inl punit.star)).move_right (sum.inr punit.star)
          = (half.move_left punit.star + half).move_right (sum.inr punit.star) : by fsplit
      ... = (0 + half).move_right (sum.inr punit.star) : by fsplit
      ... ≈ 1 : zero_add_equiv 1
      ... ≤ 1 : pgame.le_refl 1 },
    { right,
      use (sum.inl punit.star),
      calc ((half + half).move_left (sum.inr punit.star)).move_right (sum.inl punit.star)
          = (half + half.move_left punit.star).move_right (sum.inl punit.star) : by fsplit
      ... = (half + 0).move_right (sum.inl punit.star) : by fsplit
      ... ≈ 1 : add_zero_equiv 1
      ... ≤ 1 : pgame.le_refl 1 } },
  { rintro ⟨ ⟩ },
  { rintro ⟨ ⟩,
    left,
    use (sum.inl punit.star),
    calc 0 ≤ half : le_of_lt numeric_zero numeric_half zero_lt_half
    ... ≈ 0 + half : (zero_add_equiv half).symm
    ... = (half + half).move_left (sum.inl punit.star) : by fsplit },
  { rintro (⟨⟨ ⟩⟩ | ⟨⟨ ⟩⟩); left,
    { exact ⟨sum.inr punit.star, le_of_le_of_equiv (pgame.le_refl _) (add_zero_equiv _).symm⟩ },
    { exact ⟨sum.inl punit.star, le_of_le_of_equiv (pgame.le_refl _) (zero_add_equiv _).symm⟩ } }
end

end pgame

/-- The equivalence on numeric pre-games. -/
def surreal.equiv (x y : {x // pgame.numeric x}) : Prop := x.1.equiv y.1

instance surreal.setoid : setoid {x // pgame.numeric x} :=
⟨λ x y, x.1.equiv y.1,
 λ x, pgame.equiv_refl _,
 λ x y, pgame.equiv_symm,
 λ x y z, pgame.equiv_trans⟩

/-- The type of surreal numbers. These are the numeric pre-games quotiented
by the equivalence relation `x ≈ y ↔ x ≤ y ∧ y ≤ x`. In the quotient,
the order becomes a total order. -/
def surreal := quotient surreal.setoid

namespace surreal
open pgame

/-- Construct a surreal number from a numeric pre-game. -/
def mk (x : pgame) (h : x.numeric) : surreal := quotient.mk ⟨x, h⟩

instance : has_zero surreal :=
{ zero := ⟦⟨0, numeric_zero⟩⟧ }
instance : has_one surreal :=
{ one := ⟦⟨1, numeric_one⟩⟧ }

instance : inhabited surreal := ⟨0⟩

/-- Lift an equivalence-respecting function on pre-games to surreals. -/
def lift {α} (f : ∀ x, numeric x → α)
  (H : ∀ {x y} (hx : numeric x) (hy : numeric y), x.equiv y → f x hx = f y hy) : surreal → α :=
quotient.lift (λ x : {x // numeric x}, f x.1 x.2) (λ x y, H x.2 y.2)

/-- Lift a binary equivalence-respecting function on pre-games to surreals. -/
def lift₂ {α} (f : ∀ x y, numeric x → numeric y → α)
  (H : ∀ {x₁ y₁ x₂ y₂} (ox₁ : numeric x₁) (oy₁ : numeric y₁) (ox₂ : numeric x₂) (oy₂ : numeric y₂),
    x₁.equiv x₂ → y₁.equiv y₂ → f x₁ y₁ ox₁ oy₁ = f x₂ y₂ ox₂ oy₂) : surreal → surreal → α :=
lift (λ x ox, lift (λ y oy, f x y ox oy) (λ y₁ y₂ oy₁ oy₂ h, H _ _ _ _ (equiv_refl _) h))
  (λ x₁ x₂ ox₁ ox₂ h, funext $ quotient.ind $ by exact λ ⟨y, oy⟩, H _ _ _ _ h (equiv_refl _))

/-- The relation `x ≤ y` on surreals. -/
def le : surreal → surreal → Prop :=
lift₂ (λ x y _ _, x ≤ y) (λ x₁ y₁ x₂ y₂ _ _ _ _ hx hy, propext (le_congr hx hy))

/-- The relation `x < y` on surreals. -/
def lt : surreal → surreal → Prop :=
lift₂ (λ x y _ _, x < y) (λ x₁ y₁ x₂ y₂ _ _ _ _ hx hy, propext (lt_congr hx hy))

theorem not_le : ∀ {x y : surreal}, ¬ le x y ↔ lt y x :=
by rintro ⟨⟨x, ox⟩⟩ ⟨⟨y, oy⟩⟩; exact not_le

/-- Addition on surreals is inherited from pre-game addition:
the sum of `x = {xL | xR}` and `y = {yL | yR}` is `{xL + y, x + yL | xR + y, x + yR}`. -/
def add : surreal → surreal → surreal :=
surreal.lift₂
  (λ (x y : pgame) (ox) (oy), ⟦⟨x + y, numeric_add ox oy⟩⟧)
  (λ x₁ y₁ x₂ y₂ _ _ _ _ hx hy, quotient.sound (pgame.add_congr hx hy))

/-- Negation for surreal numbers is inherited from pre-game negation:
the negation of `{L | R}` is `{-R | -L}`. -/
def neg : surreal → surreal :=
surreal.lift
  (λ x ox, ⟦⟨-x, pgame.numeric_neg ox⟩⟧)
  (λ _ _ _ _ a, quotient.sound (pgame.neg_congr a))

instance : has_le surreal   := ⟨le⟩
instance : has_lt surreal   := ⟨lt⟩
instance : has_add surreal  := ⟨add⟩
instance : has_neg surreal  := ⟨neg⟩

instance : ordered_add_comm_group surreal :=
{ add               := (+),
  add_assoc         := by { rintros ⟨_⟩ ⟨_⟩ ⟨_⟩, exact quotient.sound add_assoc_equiv },
  zero              := 0,
  zero_add          := by { rintros ⟨_⟩, exact quotient.sound (pgame.zero_add_equiv _) },
  add_zero          := by { rintros ⟨_⟩, exact quotient.sound (pgame.add_zero_equiv _) },
  neg               := has_neg.neg,
  add_left_neg      := by { rintros ⟨_⟩, exact quotient.sound pgame.add_left_neg_equiv },
  add_comm          := by { rintros ⟨_⟩ ⟨_⟩, exact quotient.sound pgame.add_comm_equiv },
  le                := (≤),
  lt                := (<),
  le_refl           := by { rintros ⟨_⟩, refl },
  le_trans          := by { rintros ⟨_⟩ ⟨_⟩ ⟨_⟩, exact pgame.le_trans },
  lt_iff_le_not_le  := by { rintros ⟨_, ox⟩ ⟨_, oy⟩, exact pgame.lt_iff_le_not_le ox oy },
  le_antisymm       := by { rintros ⟨_⟩ ⟨_⟩ h₁ h₂, exact quotient.sound ⟨h₁, h₂⟩ },
  add_le_add_left   := by { rintros ⟨_⟩ ⟨_⟩ hx ⟨_⟩, exact pgame.add_le_add_left hx } }

noncomputable instance : linear_ordered_add_comm_group surreal :=
{ le_total := by rintro ⟨⟨x, ox⟩⟩ ⟨⟨y, oy⟩⟩; classical; exact
    or_iff_not_imp_left.2 (λ h, le_of_lt oy ox (pgame.not_le.1 h)),
  decidable_le := classical.dec_rel _,
  ..surreal.ordered_add_comm_group }

-- We conclude with some ideas for further work on surreals; these would make fun projects.

-- TODO define the inclusion of groups `surreal → game`
-- TODO define the field structure on the surreals

end surreal


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.set.intervals.disjoint
import tactic.field_simp

/-!
# Monotonicity on intervals

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, +∞)`. We also provide an order
isomorphism `order_iso_Ioo_neg_one_one` between the open interval `(-1, 1)` in a linear ordered
field and the whole field.
-/

open set

section

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

/-- 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
  intros x y hxy,
  cases lt_or_le a x with hax hxa; [skip, cases le_or_lt y a with hya hay],
  exacts [h₂ hax.le (hax.trans hxy).le hxy, h₁ hxa hya hxy,
    (h₁.monotone_on hxa le_rfl hxa).trans_lt (h₂ le_rfl hay.le hay)]
end

/-- 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
protected lemma monotone_on.Iic_union_Ici (h₁ : monotone_on f (Iic a))
  (h₂ : monotone_on f (Ici a)) : monotone f :=
begin
  intros x y hxy,
  cases le_total x a with hxa hax; [cases le_total y a with hya hay, skip],
  exacts [h₁ hxa hya hxy, (h₁ hxa le_rfl hxa).trans (h₂ le_rfl hay hay), h₂ hax (hax.trans hxy) hxy]
end

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

end

section ordered_group

variables {G H : Type*} [linear_ordered_add_comm_group G] [ordered_add_comm_group H]

lemma strict_mono_of_odd_strict_mono_on_nonneg {f : G → H} (h₁ : ∀ x, f (-x) = -f x)
  (h₂ : strict_mono_on f (Ici 0)) :
  strict_mono f :=
begin
  refine strict_mono_on.Iic_union_Ici (λ x hx y hy hxy, neg_lt_neg_iff.1 _) h₂,
  rw [← h₁, ← h₁],
  exact h₂ (neg_nonneg.2 hy) (neg_nonneg.2 hx) (neg_lt_neg hxy)
end

lemma monotone_of_odd_of_monotone_on_nonneg {f : G → H} (h₁ : ∀ x, f (-x) = -f x)
  (h₂ : monotone_on f (Ici 0)) : monotone f :=
begin
  refine monotone_on.Iic_union_Ici (λ x hx y hy hxy, neg_le_neg_iff.1 _) h₂,
  rw [← h₁, ← h₁],
  exact h₂ (neg_nonneg.2 hy) (neg_nonneg.2 hx) (neg_le_neg hxy)
end

end ordered_group

/-- In a linear ordered field, the whole field is order isomorphic to the open interval `(-1, 1)`.
We consider the actual implementation to be a "black box", so it is irreducible.
-/
@[irreducible] def order_iso_Ioo_neg_one_one (k : Type*) [linear_ordered_field k] :
  k ≃o Ioo (-1 : k) 1 :=
begin
  refine strict_mono.order_iso_of_right_inverse _ _ (λ x, x / (1 - |x|)) _,
  { refine cod_restrict (λ x, x / (1 + |x|)) _ (λ x, abs_lt.1 _),
    have H : 0 < 1 + |x|, from (abs_nonneg x).trans_lt (lt_one_add _),
    calc |x / (1 + |x|)| = |x| / (1 + |x|) : by rw [abs_div, abs_of_pos H]
                     ... < 1               : (div_lt_one H).2 (lt_one_add _) },
  { refine (strict_mono_of_odd_strict_mono_on_nonneg _ _).cod_restrict _,
    { intro x, simp only [abs_neg, neg_div] },
    { rintros x (hx : 0 ≤ x) y (hy : 0 ≤ y) hxy,
      simp [abs_of_nonneg, mul_add, mul_comm x y, div_lt_div_iff,
        hx.trans_lt (lt_one_add _), hy.trans_lt (lt_one_add _), *] } },
  { refine λ x, subtype.ext _,
    have : 0 < 1 - |(x : k)|, from sub_pos.2 (abs_lt.2 x.2),
    field_simp [abs_div, this.ne', abs_of_pos this] }
end

section Ixx

variables {α β : Type*} [preorder α] [preorder β] {f g : α → β}

lemma antitone_Ici : antitone (Ici : α → set α) := λ _ _, Ici_subset_Ici.2

lemma monotone_Iic : monotone (Iic : α → set α) := λ _ _, Iic_subset_Iic.2

lemma antitone_Ioi : antitone (Ioi : α → set α) := λ _ _, Ioi_subset_Ioi

lemma monotone_Iio : monotone (Iio : α → set α) := λ _ _, Iio_subset_Iio

protected lemma monotone.Ici (hf : monotone f) : antitone (λ x, Ici (f x)) :=
antitone_Ici.comp_monotone hf

protected lemma antitone.Ici (hf : antitone f) : monotone (λ x, Ici (f x)) :=
antitone_Ici.comp hf

protected lemma monotone.Iic (hf : monotone f) : monotone (λ x, Iic (f x)) :=
monotone_Iic.comp hf

protected lemma antitone.Iic (hf : antitone f) : antitone (λ x, Iic (f x)) :=
monotone_Iic.comp_antitone hf

protected lemma monotone.Ioi (hf : monotone f) : antitone (λ x, Ioi (f x)) :=
antitone_Ioi.comp_monotone hf

protected lemma antitone.Ioi (hf : antitone f) : monotone (λ x, Ioi (f x)) :=
antitone_Ioi.comp hf

protected lemma monotone.Iio (hf : monotone f) : monotone (λ x, Iio (f x)) :=
monotone_Iio.comp hf

protected lemma antitone.Iio (hf : antitone f) : antitone (λ x, Iio (f x)) :=
monotone_Iio.comp_antitone hf

protected lemma monotone.Icc (hf : monotone f) (hg : antitone g) :
  antitone (λ x, Icc (f x) (g x)) :=
hf.Ici.inter hg.Iic

protected lemma antitone.Icc (hf : antitone f) (hg : monotone g) :
  monotone (λ x, Icc (f x) (g x)) :=
hf.Ici.inter hg.Iic

protected lemma monotone.Ico (hf : monotone f) (hg : antitone g) :
  antitone (λ x, Ico (f x) (g x)) :=
hf.Ici.inter hg.Iio

protected lemma antitone.Ico (hf : antitone f) (hg : monotone g) :
  monotone (λ x, Ico (f x) (g x)) :=
hf.Ici.inter hg.Iio

protected lemma monotone.Ioc (hf : monotone f) (hg : antitone g) :
  antitone (λ x, Ioc (f x) (g x)) :=
hf.Ioi.inter hg.Iic

protected lemma antitone.Ioc (hf : antitone f) (hg : monotone g) :
  monotone (λ x, Ioc (f x) (g x)) :=
hf.Ioi.inter hg.Iic

protected lemma monotone.Ioo (hf : monotone f) (hg : antitone g) :
  antitone (λ x, Ioo (f x) (g x)) :=
hf.Ioi.inter hg.Iio

protected lemma antitone.Ioo (hf : antitone f) (hg : monotone g) :
  monotone (λ x, Ioo (f x) (g x)) :=
hf.Ioi.inter hg.Iio

end Ixx

section Union

variables {α β : Type*} [semilattice_sup α] [linear_order β] {f g : α → β} {a b : β}

lemma Union_Ioo_of_mono_of_is_glb_of_is_lub (hf : antitone f) (hg : monotone g)
  (ha : is_glb (range f) a) (hb : is_lub (range g) b) :
  (⋃ x, Ioo (f x) (g x)) = Ioo a b :=
calc (⋃ x, Ioo (f x) (g x)) = (⋃ x, Ioi (f x)) ∩ ⋃ x, Iio (g x) :
  Union_inter_of_monotone hf.Ioi hg.Iio
... = Ioi a ∩ Iio b : congr_arg2 (∩) ha.Union_Ioi_eq hb.Union_Iio_eq

end Union


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

! This file was ported from Lean 3 source module data.zmod.basic
! leanprover-community/mathlib commit 297619ec79dedf23525458b6bf5bf35c736fd2b8
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.CharP.Basic
import Mathlib.Data.Nat.Parity
import Mathlib.Algebra.Group.ConjFinite
import Mathlib.Tactic.FinCases

/-!
# Integers mod `n`

Definition of the integers mod n, and the field structure on the integers mod p.

## Definitions

* `ZMod n`, which is for integers modulo a nat `n : ℕ`

* `val a` is defined as a natural number:
  - for `a : ZMod 0` it is the absolute value of `a`
  - for `a : ZMod n` with `0 < n` it is the least natural number in the equivalence class

* `valMinAbs` returns the integer closest to zero in the equivalence class.

* A coercion `cast` is defined from `ZMod n` into any ring.
This is a ring hom if the ring has characteristic dividing `n`

-/

namespace ZMod

instance : CharZero (ZMod 0) :=
  (by infer_instance : CharZero ℤ)

/-- `val a` is a natural number defined as:
  - for `a : ZMod 0` it is the absolute value of `a`
  - for `a : ZMod n` with `0 < n` it is the least natural number in the equivalence class

See `ZMod.valMinAbs` for a variant that takes values in the integers.
-/
def val : ∀ {n : ℕ}, ZMod n → ℕ
  | 0 => Int.natAbs
  | n + 1 => ((↑) : Fin (n + 1) → ℕ)
#align zmod.val ZMod.val

theorem val_lt {n : ℕ} [NeZero n] (a : ZMod n) : a.val < n := by
  cases n
  · cases NeZero.ne 0 rfl
  exact Fin.is_lt a
#align zmod.val_lt ZMod.val_lt

theorem val_le {n : ℕ} [NeZero n] (a : ZMod n) : a.val ≤ n :=
  a.val_lt.le
#align zmod.val_le ZMod.val_le

@[simp]
theorem val_zero : ∀ {n}, (0 : ZMod n).val = 0
  | 0 => rfl
  | _ + 1 => rfl
#align zmod.val_zero ZMod.val_zero

@[simp]
theorem val_one' : (1 : ZMod 0).val = 1 :=
  rfl
#align zmod.val_one' ZMod.val_one'

@[simp]
theorem val_neg' {n : ZMod 0} : (-n).val = n.val :=
  Int.natAbs_neg n
#align zmod.val_neg' ZMod.val_neg'

@[simp]
theorem val_mul' {m n : ZMod 0} : (m * n).val = m.val * n.val :=
  Int.natAbs_mul m n
#align zmod.val_mul' ZMod.val_mul'

theorem val_nat_cast {n : ℕ} (a : ℕ) : (a : ZMod n).val = a % n := by
  cases n
  · rw [Nat.mod_zero]
    exact Int.natAbs_ofNat a
  rw [← Fin.ofNat_eq_val]
  rfl
#align zmod.val_nat_cast ZMod.val_nat_cast

instance charP (n : ℕ) : CharP (ZMod n) n where
    cast_eq_zero_iff' := by
      intro k
      cases' n with n
      · simp [zero_dvd_iff, Int.coe_nat_eq_zero, Nat.zero_eq]
      rw [Fin.eq_iff_veq]
      show (k : ZMod (n + 1)).val = (0 : ZMod (n + 1)).val ↔ _
      rw [val_nat_cast, val_zero, Nat.dvd_iff_mod_eq_zero]

@[simp]
theorem addOrderOf_one (n : ℕ) : addOrderOf (1 : ZMod n) = n :=
  CharP.eq _ (CharP.addOrderOf_one _) (ZMod.charP n)
#align zmod.add_order_of_one ZMod.addOrderOf_one

/-- This lemma works in the case in which `ZMod n` is not infinite, i.e. `n ≠ 0`.  The version
where `a ≠ 0` is `addOrderOf_coe'`. -/
@[simp]
theorem addOrderOf_coe (a : ℕ) {n : ℕ} (n0 : n ≠ 0) : addOrderOf (a : ZMod n) = n / n.gcd a := by
  cases' a with a
  simp [Nat.pos_of_ne_zero n0]
  rw [← Nat.smul_one_eq_coe, addOrderOf_nsmul' _ a.succ_ne_zero, ZMod.addOrderOf_one]
#align zmod.add_order_of_coe ZMod.addOrderOf_coe

/-- This lemma works in the case in which `a ≠ 0`.  The version where
 `ZMod n` is not infinite, i.e. `n ≠ 0`, is `addOrderOf_coe`. -/
@[simp]
theorem addOrderOf_coe' {a : ℕ} (n : ℕ) (a0 : a ≠ 0) : addOrderOf (a : ZMod n) = n / n.gcd a := by
  rw [← Nat.smul_one_eq_coe, addOrderOf_nsmul' _ a0, ZMod.addOrderOf_one]
#align zmod.add_order_of_coe' ZMod.addOrderOf_coe'

/-- We have that `ringChar (ZMod n) = n`. -/
theorem ringChar_zmod_n (n : ℕ) : ringChar (ZMod n) = n := by
  rw [ringChar.eq_iff]
  exact ZMod.charP n
#align zmod.ring_char_zmod_n ZMod.ringChar_zmod_n

@[simp]
theorem nat_cast_self (n : ℕ) : (n : ZMod n) = 0 :=
  CharP.cast_eq_zero (ZMod n) n
#align zmod.nat_cast_self ZMod.nat_cast_self

@[simp]
theorem nat_cast_self' (n : ℕ) : (n + 1 : ZMod (n + 1)) = 0 := by
  rw [← Nat.cast_add_one, nat_cast_self (n + 1)]
#align zmod.nat_cast_self' ZMod.nat_cast_self'

section UniversalProperty

variable {n : ℕ} {R : Type _}

section

variable [AddGroupWithOne R]

/-- Cast an integer modulo `n` to another semiring.
This function is a morphism if the characteristic of `R` divides `n`.
See `ZMod.cast_hom` for a bundled version. -/
@[coe] def cast : ∀ {n : ℕ}, ZMod n → R
  | 0 => Int.cast
  | _ + 1 => fun i => i.val
#align zmod.cast ZMod.cast

-- see Note [coercion into rings]
instance (priority := 900) (n : ℕ) : CoeTC (ZMod n) R :=
  ⟨cast⟩

@[simp]
theorem cast_zero : ((0 : ZMod n) : R) = 0 := by
  delta ZMod.cast
  cases n
  . exact Int.cast_zero
  . simp
#align zmod.cast_zero ZMod.cast_zero

theorem cast_eq_val [NeZero n] (a : ZMod n) : (a : R) = a.val := by
  cases n
  · cases NeZero.ne 0 rfl
  rfl
#align zmod.cast_eq_val ZMod.cast_eq_val

variable {S : Type _} [AddGroupWithOne S]

@[simp]
theorem _root_.Prod.fst_zmod_cast (a : ZMod n) : (a : R × S).fst = a := by
  cases n
  . rfl
  . simp [ZMod.cast]
#align prod.fst_zmod_cast Prod.fst_zmod_cast

@[simp]
theorem _root_.Prod.snd_zmod_cast (a : ZMod n) : (a : R × S).snd = a := by
  cases n
  . rfl
  . simp [ZMod.cast]
#align prod.snd_zmod_cast Prod.snd_zmod_cast

end

/-- So-named because the coercion is `Nat.cast` into `ZMod`. For `Nat.cast` into an arbitrary ring,
see `ZMmod.nat_cast_val`. -/
theorem nat_cast_zmod_val {n : ℕ} [NeZero n] (a : ZMod n) : (a.val : ZMod n) = a := by
  cases n
  · cases NeZero.ne 0 rfl
  · apply Fin.cast_val_eq_self
#align zmod.nat_cast_zmod_val ZMod.nat_cast_zmod_val

theorem nat_cast_rightInverse [NeZero n] : Function.RightInverse val ((↑) : ℕ → ZMod n) :=
  nat_cast_zmod_val
#align zmod.nat_cast_right_inverse ZMod.nat_cast_rightInverse

theorem nat_cast_zmod_surjective [NeZero n] : Function.Surjective ((↑) : ℕ → ZMod n) :=
  nat_cast_rightInverse.surjective
#align zmod.nat_cast_zmod_surjective ZMod.nat_cast_zmod_surjective

/-- So-named because the outer coercion is `Int.cast` into `ZMod`. For `Int.cast` into an arbitrary
ring, see `ZMod.int_cast_cast`. -/
@[norm_cast]
theorem int_cast_zmod_cast (a : ZMod n) : ((a : ℤ) : ZMod n) = a := by
  cases n
  · simp [ZMod.cast, ZMod]
  · dsimp [ZMod.cast, ZMod]
    erw [Int.cast_ofNat, Fin.cast_val_eq_self]
#align zmod.int_cast_zmod_cast ZMod.int_cast_zmod_cast

theorem int_cast_rightInverse : Function.RightInverse ((↑) : ZMod n → ℤ) ((↑): ℤ → ZMod n) :=
  int_cast_zmod_cast
#align zmod.int_cast_right_inverse ZMod.int_cast_rightInverse

theorem int_cast_surjective : Function.Surjective ((↑) : ℤ → ZMod n) :=
  int_cast_rightInverse.surjective
#align zmod.int_cast_surjective ZMod.int_cast_surjective

@[norm_cast]
theorem cast_id : ∀ (n) (i : ZMod n), (ZMod.cast i : ZMod n) = i
  | 0, _ => Int.cast_id
  | _ + 1, i => nat_cast_zmod_val i
#align zmod.cast_id ZMod.cast_id

@[simp]
theorem cast_id' : (ZMod.cast : ZMod n → ZMod n) = id :=
  funext (cast_id n)
#align zmod.cast_id' ZMod.cast_id'

variable (R) [Ring R]

/-- The coercions are respectively `Nat.cast` and `ZMod.cast`. -/
@[simp]
theorem nat_cast_comp_val [NeZero n] : ((↑) : ℕ → R) ∘ (val : ZMod n → ℕ) = (↑) := by
  cases n
  · cases NeZero.ne 0 rfl
  rfl
#align zmod.nat_cast_comp_val ZMod.nat_cast_comp_val

/-- The coercions are respectively `Int.cast`, `ZMod.cast`, and `ZMod.cast`. -/
@[simp]
theorem int_cast_comp_cast : ((↑) : ℤ → R) ∘ ((↑) : ZMod n → ℤ) = (↑) := by
  cases n
  · exact congr_arg ((· ∘ ·) Int.cast) ZMod.cast_id'
  · ext
    simp [ZMod, ZMod.cast]
#align zmod.int_cast_comp_cast ZMod.int_cast_comp_cast

variable {R}

@[simp]
theorem nat_cast_val [NeZero n] (i : ZMod n) : (i.val : R) = i :=
  congr_fun (nat_cast_comp_val R) i
#align zmod.nat_cast_val ZMod.nat_cast_val

@[simp]
theorem int_cast_cast (i : ZMod n) : ((i : ℤ) : R) = i :=
  congr_fun (int_cast_comp_cast R) i
#align zmod.int_cast_cast ZMod.int_cast_cast

theorem coe_add_eq_ite {n : ℕ} (a b : ZMod n) :
    (↑(a + b) : ℤ) = if (n : ℤ) ≤ a + b then a + b - n else a + b := by
  cases n
  · simp
  simp only [Fin.val_add_eq_ite, ← Int.ofNat_add, ← Int.ofNat_succ, Int.ofNat_le]
  split_ifs with h
  · norm_cast
    congr
    simp
  · rfl
#align zmod.coe_add_eq_ite ZMod.coe_add_eq_ite

section CharDvd

/-! If the characteristic of `R` divides `n`, then `cast` is a homomorphism. -/

variable {m : ℕ} [CharP R m]

@[simp]
theorem cast_one (h : m ∣ n) : ((1 : ZMod n) : R) = 1 := by
  cases' n with n
  · exact Int.cast_one
  show ((1 % (n + 1) : ℕ) : R) = 1
  cases n;
  · rw [Nat.dvd_one] at h
    subst m
    apply Subsingleton.elim
  rw [Nat.mod_eq_of_lt]
  · exact Nat.cast_one
  exact Nat.lt_of_sub_eq_succ rfl
#align zmod.cast_one ZMod.cast_one

theorem cast_add (h : m ∣ n) (a b : ZMod n) : ((a + b : ZMod n) : R) = a + b := by
  cases n
  · apply Int.cast_add
  symm
  dsimp [ZMod, ZMod.cast]
  erw [← Nat.cast_add, ← sub_eq_zero, ← Nat.cast_sub (Nat.mod_le _ _),
    @CharP.cast_eq_zero_iff R _ m]
  exact h.trans (Nat.dvd_sub_mod _)
#align zmod.cast_add ZMod.cast_add

theorem cast_mul (h : m ∣ n) (a b : ZMod n) : ((a * b : ZMod n) : R) = a * b := by
  cases n
  · apply Int.cast_mul
  symm
  dsimp [ZMod, ZMod.cast]
  erw [← Nat.cast_mul, ← sub_eq_zero, ← Nat.cast_sub (Nat.mod_le _ _),
    @CharP.cast_eq_zero_iff R _ m]
  exact h.trans (Nat.dvd_sub_mod _)
#align zmod.cast_mul ZMod.cast_mul

/-- The canonical ring homomorphism from `ZMod n` to a ring of characteristic `n`.

See also `ZMod.lift` (in `Data.ZMod.Quotient`) for a generalized version working in `AddGroup`s.
-/
def castHom (h : m ∣ n) (R : Type _) [Ring R] [CharP R m] : ZMod n →+* R where
  toFun := (↑)
  map_zero' := cast_zero
  map_one' := cast_one h
  map_add' := cast_add h
  map_mul' := cast_mul h
#align zmod.cast_hom ZMod.castHom

@[simp]
theorem castHom_apply {h : m ∣ n} (i : ZMod n) : castHom h R i = i :=
  rfl
#align zmod.cast_hom_apply ZMod.castHom_apply

@[simp, norm_cast]
theorem cast_sub (h : m ∣ n) (a b : ZMod n) : ((a - b : ZMod n) : R) = (a : R) - b :=
  (castHom h R).map_sub a b
#align zmod.cast_sub ZMod.cast_sub

@[simp, norm_cast]
theorem cast_neg (h : m ∣ n) (a : ZMod n) : ((-a : ZMod n) : R) = -(a : R) :=
  (castHom h R).map_neg a
#align zmod.cast_neg ZMod.cast_neg

@[simp, norm_cast]
theorem cast_pow (h : m ∣ n) (a : ZMod n) (k : ℕ) : ((a ^ k : ZMod n) : R) = (a : R) ^ k :=
  (castHom h R).map_pow a k
#align zmod.cast_pow ZMod.cast_pow

@[simp, norm_cast]
theorem cast_nat_cast (h : m ∣ n) (k : ℕ) : ((k : ZMod n) : R) = k :=
  map_natCast (castHom h R) k
#align zmod.cast_nat_cast ZMod.cast_nat_cast

@[simp, norm_cast]
theorem cast_int_cast (h : m ∣ n) (k : ℤ) : ((k : ZMod n) : R) = k :=
  map_intCast (castHom h R) k
#align zmod.cast_int_cast ZMod.cast_int_cast

end CharDvd

section CharEq

/-! Some specialised simp lemmas which apply when `R` has characteristic `n`. -/

variable [CharP R n]

@[simp]
theorem cast_one' : ((1 : ZMod n) : R) = 1 :=
  cast_one dvd_rfl
#align zmod.cast_one' ZMod.cast_one'

@[simp]
theorem cast_add' (a b : ZMod n) : ((a + b : ZMod n) : R) = a + b :=
  cast_add dvd_rfl a b
#align zmod.cast_add' ZMod.cast_add'

@[simp]
theorem cast_mul' (a b : ZMod n) : ((a * b : ZMod n) : R) = a * b :=
  cast_mul dvd_rfl a b
#align zmod.cast_mul' ZMod.cast_mul'

@[simp]
theorem cast_sub' (a b : ZMod n) : ((a - b : ZMod n) : R) = a - b :=
  cast_sub dvd_rfl a b
#align zmod.cast_sub' ZMod.cast_sub'

@[simp]
theorem cast_pow' (a : ZMod n) (k : ℕ) : ((a ^ k : ZMod n) : R) = (a : R) ^ k :=
  cast_pow dvd_rfl a k
#align zmod.cast_pow' ZMod.cast_pow'

@[simp, norm_cast]
theorem cast_nat_cast' (k : ℕ) : ((k : ZMod n) : R) = k :=
  cast_nat_cast dvd_rfl k
#align zmod.cast_nat_cast' ZMod.cast_nat_cast'

@[simp, norm_cast]
theorem cast_int_cast' (k : ℤ) : ((k : ZMod n) : R) = k :=
  cast_int_cast dvd_rfl k
#align zmod.cast_int_cast' ZMod.cast_int_cast'

variable (R)

theorem castHom_injective : Function.Injective (ZMod.castHom (dvd_refl n) R) := by
  rw [injective_iff_map_eq_zero]
  intro x
  obtain ⟨k, rfl⟩ := ZMod.int_cast_surjective x
  rw [map_intCast, CharP.int_cast_eq_zero_iff R n, CharP.int_cast_eq_zero_iff (ZMod n) n]
  exact id
#align zmod.cast_hom_injective ZMod.castHom_injective

theorem castHom_bijective [Fintype R] (h : Fintype.card R = n) :
    Function.Bijective (ZMod.castHom (dvd_refl n) R) := by
  haveI : NeZero n :=
    ⟨by
      intro hn
      rw [hn] at h
      exact (Fintype.card_eq_zero_iff.mp h).elim' 0⟩
  rw [Fintype.bijective_iff_injective_and_card, ZMod.card, h, eq_self_iff_true, and_true_iff]
  apply ZMod.castHom_injective
#align zmod.cast_hom_bijective ZMod.castHom_bijective

/-- The unique ring isomorphism between `ZMod n` and a ring `R`
of characteristic `n` and cardinality `n`. -/
noncomputable def ringEquiv [Fintype R] (h : Fintype.card R = n) : ZMod n ≃+* R :=
  RingEquiv.ofBijective _ (ZMod.castHom_bijective R h)
#align zmod.ring_equiv ZMod.ringEquiv

/-- The identity between `ZMod m` and `ZMod n` when `m = n`, as a ring isomorphism. -/
def ringEquivCongr {m n : ℕ} (h : m = n) : ZMod m ≃+* ZMod n := by
  cases' m with m <;> cases' n with n
  · exact RingEquiv.refl _
  · exfalso
    exact n.succ_ne_zero h.symm
  · exfalso
    exact m.succ_ne_zero h
  · exact
      { Fin.cast h with
        map_mul' := fun a b => by
          dsimp [ZMod]
          ext
          rw [Fin.coe_cast, Fin.coe_mul, Fin.coe_mul, Fin.coe_cast, Fin.coe_cast, ← h]
        map_add' := fun a b => by
          dsimp [ZMod]
          ext
          rw [Fin.coe_cast, Fin.val_add, Fin.val_add, Fin.coe_cast, Fin.coe_cast, ← h] }
#align zmod.ring_equiv_congr ZMod.ringEquivCongr

end CharEq

end UniversalProperty

theorem int_cast_eq_int_cast_iff (a b : ℤ) (c : ℕ) : (a : ZMod c) = (b : ZMod c) ↔ a ≡ b [ZMOD c] :=
  CharP.int_cast_eq_int_cast_iff (ZMod c) c a b
#align zmod.int_coe_eq_int_coe_iff ZMod.int_cast_eq_int_cast_iff

theorem int_cast_eq_int_cast_iff' (a b : ℤ) (c : ℕ) : (a : ZMod c) = (b : ZMod c) ↔ a % c = b % c :=
  ZMod.int_cast_eq_int_cast_iff a b c
#align zmod.int_coe_eq_int_coe_iff' ZMod.int_cast_eq_int_cast_iff'

theorem nat_cast_eq_nat_cast_iff (a b c : ℕ) : (a : ZMod c) = (b : ZMod c) ↔ a ≡ b [MOD c] := by
  simpa [Int.coe_nat_modEq_iff] using ZMod.int_cast_eq_int_cast_iff a b c
#align zmod.nat_coe_eq_nat_coe_iff ZMod.nat_cast_eq_nat_cast_iff

theorem nat_cast_eq_nat_cast_iff' (a b c : ℕ) : (a : ZMod c) = (b : ZMod c) ↔ a % c = b % c :=
  ZMod.nat_cast_eq_nat_cast_iff a b c
#align zmod.nat_coe_eq_nat_coe_iff' ZMod.nat_cast_eq_nat_cast_iff'

theorem int_cast_zmod_eq_zero_iff_dvd (a : ℤ) (b : ℕ) : (a : ZMod b) = 0 ↔ (b : ℤ) ∣ a := by
  rw [← Int.cast_zero, ZMod.int_cast_eq_int_cast_iff, Int.modEq_zero_iff_dvd]
#align zmod.int_coe_zmod_eq_zero_iff_dvd ZMod.int_cast_zmod_eq_zero_iff_dvd

theorem int_cast_eq_int_cast_iff_dvd_sub (a b : ℤ) (c : ℕ) : (a : ZMod c) = ↑b ↔ ↑c ∣ b - a := by
  rw [ZMod.int_cast_eq_int_cast_iff, Int.modEq_iff_dvd]
#align zmod.int_coe_eq_int_coe_iff_dvd_sub ZMod.int_cast_eq_int_cast_iff_dvd_sub

theorem nat_cast_zmod_eq_zero_iff_dvd (a b : ℕ) : (a : ZMod b) = 0 ↔ b ∣ a := by
  rw [← Nat.cast_zero, ZMod.nat_cast_eq_nat_cast_iff, Nat.modEq_zero_iff_dvd]
#align zmod.nat_coe_zmod_eq_zero_iff_dvd ZMod.nat_cast_zmod_eq_zero_iff_dvd

theorem val_int_cast {n : ℕ} (a : ℤ) [NeZero n] : ↑(a : ZMod n).val = a % n := by
  have hle : (0 : ℤ) ≤ ↑(a : ZMod n).val := Int.coe_nat_nonneg _
  have hlt : ↑(a : ZMod n).val < (n : ℤ) := Int.ofNat_lt.mpr (ZMod.val_lt a)
  refine' (Int.emod_eq_of_lt hle hlt).symm.trans _
  rw [← ZMod.int_cast_eq_int_cast_iff', Int.cast_ofNat, ZMod.nat_cast_val, ZMod.cast_id]
#align zmod.val_int_cast ZMod.val_int_cast

theorem coe_int_cast {n : ℕ} (a : ℤ) : ↑(a : ZMod n) = a % n := by
  cases n
  · rw [Int.ofNat_zero, Int.emod_zero, Int.cast_id]; rfl
  · rw [← val_int_cast, val]; rfl
#align zmod.coe_int_cast ZMod.coe_int_cast

@[simp]
theorem val_neg_one (n : ℕ) : (-1 : ZMod n.succ).val = n := by
  dsimp [val, Fin.coe_neg]
  cases n
  · simp [Nat.mod_one]
  · dsimp [ZMod, ZMod.cast]
    rw [Fin.coe_neg_one]

#align zmod.val_neg_one ZMod.val_neg_one

/-- `-1 : ZMod n` lifts to `n - 1 : R`. This avoids the characteristic assumption in `cast_neg`. -/
theorem cast_neg_one {R : Type _} [Ring R] (n : ℕ) : ↑(-1 : ZMod n) = (n - 1 : R) := by
  cases' n with n
  · dsimp [ZMod, ZMod.cast]; simp
  · rw [← nat_cast_val, val_neg_one, Nat.cast_succ, add_sub_cancel]
#align zmod.cast_neg_one ZMod.cast_neg_one

theorem cast_sub_one {R : Type _} [Ring R] {n : ℕ} (k : ZMod n) :
    ((k - 1 : ZMod n) : R) = (if k = 0 then (n : R) else k) - 1 := by
  split_ifs with hk
  · rw [hk, zero_sub, ZMod.cast_neg_one]
  · cases n
    · dsimp [ZMod, ZMod.cast]
      rw [Int.cast_sub, Int.cast_one]
    · dsimp [ZMod, ZMod.cast, ZMod.val]
      rw [Fin.coe_sub_one, if_neg]
      · rw [Nat.cast_sub, Nat.cast_one]
        rwa [Fin.ext_iff, Fin.val_zero, ← Ne, ← Nat.one_le_iff_ne_zero] at hk
      · exact hk
#align zmod.cast_sub_one ZMod.cast_sub_one

theorem nat_coe_zmod_eq_iff (p : ℕ) (n : ℕ) (z : ZMod p) [NeZero p] :
    ↑n = z ↔ ∃ k, n = z.val + p * k := by
  constructor
  · rintro rfl
    refine' ⟨n / p, _⟩
    rw [val_nat_cast, Nat.mod_add_div]
  · rintro ⟨k, rfl⟩
    rw [Nat.cast_add, nat_cast_zmod_val, Nat.cast_mul, nat_cast_self, MulZeroClass.zero_mul,
      add_zero]
#align zmod.nat_coe_zmod_eq_iff ZMod.nat_coe_zmod_eq_iff

theorem int_coe_zmod_eq_iff (p : ℕ) (n : ℤ) (z : ZMod p) [NeZero p] :
    ↑n = z ↔ ∃ k, n = z.val + p * k := by
  constructor
  · rintro rfl
    refine' ⟨n / p, _⟩
    rw [val_int_cast, Int.emod_add_ediv]
  · rintro ⟨k, rfl⟩
    rw [Int.cast_add, Int.cast_mul, Int.cast_ofNat, Int.cast_ofNat, nat_cast_val,
      ZMod.nat_cast_self, MulZeroClass.zero_mul, add_zero, cast_id]
#align zmod.int_coe_zmod_eq_iff ZMod.int_coe_zmod_eq_iff

@[push_cast, simp]
theorem int_cast_mod (a : ℤ) (b : ℕ) : ((a % b : ℤ) : ZMod b) = (a : ZMod b) := by
  rw [ZMod.int_cast_eq_int_cast_iff]
  apply Int.mod_modEq
#align zmod.int_cast_mod ZMod.int_cast_mod

theorem ker_int_castAddHom (n : ℕ) :
    (Int.castAddHom (ZMod n)).ker = AddSubgroup.zmultiples (n : ℤ) := by
  ext
  rw [Int.mem_zmultiples_iff, AddMonoidHom.mem_ker, Int.coe_castAddHom,
    int_cast_zmod_eq_zero_iff_dvd]
#align zmod.ker_int_cast_add_hom ZMod.ker_int_castAddHom

theorem ker_int_castRingHom (n : ℕ) :
    RingHom.ker (Int.castRingHom (ZMod n)) = Ideal.span ({(n : ℤ)} : Set ℤ) := by
  ext
  rw [Ideal.mem_span_singleton, RingHom.mem_ker, Int.coe_castRingHom, int_cast_zmod_eq_zero_iff_dvd]
#align zmod.ker_int_cast_ring_hom ZMod.ker_int_castRingHom

--Porting note: commented
-- attribute [local semireducible] Int.NonNeg

@[simp]
theorem nat_cast_toNat (p : ℕ) : ∀ {z : ℤ} (_h : 0 ≤ z), (z.toNat : ZMod p) = z
  | (n : ℕ), _h => by simp only [Int.cast_ofNat, Int.toNat_coe_nat]
  | Int.negSucc n, h => by simp at h
#align zmod.nat_cast_to_nat ZMod.nat_cast_toNat

theorem val_injective (n : ℕ) [NeZero n] : Function.Injective (ZMod.val : ZMod n → ℕ) := by
  cases n
  · cases NeZero.ne 0 rfl
  intro a b h
  dsimp [ZMod]
  ext
  exact h
#align zmod.val_injective ZMod.val_injective

theorem val_one_eq_one_mod (n : ℕ) : (1 : ZMod n).val = 1 % n := by
  rw [← Nat.cast_one, val_nat_cast]
#align zmod.val_one_eq_one_mod ZMod.val_one_eq_one_mod

theorem val_one (n : ℕ) [Fact (1 < n)] : (1 : ZMod n).val = 1 := by
  rw [val_one_eq_one_mod]
  exact Nat.mod_eq_of_lt Fact.out
#align zmod.val_one ZMod.val_one

theorem val_add {n : ℕ} [NeZero n] (a b : ZMod n) : (a + b).val = (a.val + b.val) % n := by
  cases n
  · cases NeZero.ne 0 rfl
  · apply Fin.val_add
#align zmod.val_add ZMod.val_add

theorem val_mul {n : ℕ} (a b : ZMod n) : (a * b).val = a.val * b.val % n := by
  cases n
  · rw [Nat.mod_zero]
    apply Int.natAbs_mul
  · apply Fin.val_mul
#align zmod.val_mul ZMod.val_mul

instance nontrivial (n : ℕ) [Fact (1 < n)] : Nontrivial (ZMod n) :=
  ⟨⟨0, 1, fun h =>
      zero_ne_one <|
        calc
          0 = (0 : ZMod n).val := by rw [val_zero]
          _ = (1 : ZMod n).val := (congr_arg ZMod.val h)
          _ = 1 := val_one n
          ⟩⟩
#align zmod.nontrivial ZMod.nontrivial

instance nontrivial' : Nontrivial (ZMod 0) :=
  by delta ZMod; infer_instance
#align zmod.nontrivial' ZMod.nontrivial'

/-- The inversion on `ZMod n`.
It is setup in such a way that `a * a⁻¹` is equal to `gcd a.val n`.
In particular, if `a` is coprime to `n`, and hence a unit, `a * a⁻¹ = 1`. -/
def inv : ∀ n : ℕ, ZMod n → ZMod n
  | 0, i => Int.sign i
  | n + 1, i => Nat.gcdA i.val (n + 1)
#align zmod.inv ZMod.inv

instance (n : ℕ) : Inv (ZMod n) :=
  ⟨inv n⟩

@[nolint unusedHavesSuffices]
theorem inv_zero : ∀ n : ℕ, (0 : ZMod n)⁻¹ = 0
  | 0 => Int.sign_zero
  | n + 1 =>
    show (Nat.gcdA _ (n + 1) : ZMod (n + 1)) = 0
      by
      rw [val_zero]
      unfold Nat.gcdA Nat.xgcd Nat.xgcdAux
      rfl
#align zmod.inv_zero ZMod.inv_zero

theorem mul_inv_eq_gcd {n : ℕ} (a : ZMod n) : a * a⁻¹ = Nat.gcd a.val n := by
  cases' n with n
  · dsimp [ZMod] at a ⊢
    calc
      _ = a * Int.sign a := rfl
      _ = a.natAbs := by rw [Int.mul_sign]
      _ = a.natAbs.gcd 0 := by rw [Nat.gcd_zero_right]
  · calc
      a * a⁻¹ = a * a⁻¹ + n.succ * Nat.gcdB (val a) n.succ := by
        rw [nat_cast_self, MulZeroClass.zero_mul, add_zero]
      _ = ↑(↑a.val * Nat.gcdA (val a) n.succ + n.succ * Nat.gcdB (val a) n.succ) :=
        by
        push_cast
        rw [nat_cast_zmod_val]
        rfl
      _ = Nat.gcd a.val n.succ := by rw [← Nat.gcd_eq_gcd_ab a.val n.succ]; rfl

#align zmod.mul_inv_eq_gcd ZMod.mul_inv_eq_gcd

@[simp]
theorem nat_cast_mod (a : ℕ) (n : ℕ) : ((a % n : ℕ) : ZMod n) = a := by
  conv =>
      rhs
      rw [← Nat.mod_add_div a n]
  simp
#align zmod.nat_cast_mod ZMod.nat_cast_mod

theorem eq_iff_modEq_nat (n : ℕ) {a b : ℕ} : (a : ZMod n) = b ↔ a ≡ b [MOD n] := by
  cases n
  · simp [Nat.ModEq, Int.coe_nat_inj', Nat.mod_zero]
  · rw [Fin.ext_iff, Nat.ModEq, ← val_nat_cast, ← val_nat_cast]
    exact Iff.rfl
#align zmod.eq_iff_modeq_nat ZMod.eq_iff_modEq_nat

theorem coe_mul_inv_eq_one {n : ℕ} (x : ℕ) (h : Nat.coprime x n) :
    ((x : ZMod n) * (x : ZMod n)⁻¹) = 1 := by
  rw [Nat.coprime, Nat.gcd_comm, Nat.gcd_rec] at h
  rw [mul_inv_eq_gcd, val_nat_cast, h, Nat.cast_one]
#align zmod.coe_mul_inv_eq_one ZMod.coe_mul_inv_eq_one

/-- `unitOfCoprime` makes an element of `(ZMod n)ˣ` given
  a natural number `x` and a proof that `x` is coprime to `n`  -/
def unitOfCoprime {n : ℕ} (x : ℕ) (h : Nat.coprime x n) : (ZMod n)ˣ :=
  ⟨x, x⁻¹, coe_mul_inv_eq_one x h, by rw [mul_comm, coe_mul_inv_eq_one x h]⟩
#align zmod.unit_of_coprime ZMod.unitOfCoprime

@[simp]
theorem coe_unitOfCoprime {n : ℕ} (x : ℕ) (h : Nat.coprime x n) :
    (unitOfCoprime x h : ZMod n) = x :=
  rfl
#align zmod.coe_unit_of_coprime ZMod.coe_unitOfCoprime

theorem val_coe_unit_coprime {n : ℕ} (u : (ZMod n)ˣ) : Nat.coprime (u : ZMod n).val n := by
  cases' n with n
  · rcases Int.units_eq_one_or u with (rfl | rfl) <;> simp
  apply Nat.coprime_of_mul_modEq_one ((u⁻¹ : Units (ZMod (n + 1))) : ZMod (n + 1)).val
  have := Units.ext_iff.1 (mul_right_inv u)
  rw [Units.val_one] at this
  rw [← eq_iff_modEq_nat, Nat.cast_one, ← this]; clear this
  rw [← nat_cast_zmod_val ((u * u⁻¹ : Units (ZMod (n + 1))) : ZMod (n + 1))]
  rw [Units.val_mul, val_mul, nat_cast_mod]
#align zmod.val_coe_unit_coprime ZMod.val_coe_unit_coprime

@[simp]
theorem inv_coe_unit {n : ℕ} (u : (ZMod n)ˣ) : (u : ZMod n)⁻¹ = (u⁻¹ : (ZMod n)ˣ) := by
  have := congr_arg ((↑) : ℕ → ZMod n) (val_coe_unit_coprime u)
  rw [← mul_inv_eq_gcd, Nat.cast_one] at this
  let u' : (ZMod n)ˣ := ⟨u, (u : ZMod n)⁻¹, this, by rwa [mul_comm]⟩
  have h : u = u' := by
    apply Units.ext
    rfl
  rw [h]
  rfl
#align zmod.inv_coe_unit ZMod.inv_coe_unit

theorem mul_inv_of_unit {n : ℕ} (a : ZMod n) (h : IsUnit a) : a * a⁻¹ = 1 := by
  rcases h with ⟨u, rfl⟩
  rw [inv_coe_unit, u.mul_inv]
#align zmod.mul_inv_of_unit ZMod.mul_inv_of_unit

theorem inv_mul_of_unit {n : ℕ} (a : ZMod n) (h : IsUnit a) : a⁻¹ * a = 1 := by
  rw [mul_comm, mul_inv_of_unit a h]
#align zmod.inv_mul_of_unit ZMod.inv_mul_of_unit

-- TODO: this equivalence is true for `ZMod 0 = ℤ`, but needs to use different functions.
/-- Equivalence between the units of `ZMod n` and
the subtype of terms `x : ZMod n` for which `x.val` is comprime to `n` -/
def unitsEquivCoprime {n : ℕ} [NeZero n] : (ZMod n)ˣ ≃ { x : ZMod n // Nat.coprime x.val n }
    where
  toFun x := ⟨x, val_coe_unit_coprime x⟩
  invFun x := unitOfCoprime x.1.val x.2
  left_inv := fun ⟨_, _, _, _⟩ => Units.ext (nat_cast_zmod_val _)
  right_inv := fun ⟨_, _⟩ => by simp
#align zmod.units_equiv_coprime ZMod.unitsEquivCoprime

/-- The **Chinese remainder theorem**. For a pair of coprime natural numbers, `m` and `n`,
  the rings `ZMod (m * n)` and `ZMod m × ZMod n` are isomorphic.

See `Ideal.quotientInfRingEquivPiQuotient` for the Chinese remainder theorem for ideals in any
ring.
-/
def chineseRemainder {m n : ℕ} (h : m.coprime n) : ZMod (m * n) ≃+* ZMod m × ZMod n :=
  let to_fun : ZMod (m * n) → ZMod m × ZMod n :=
    ZMod.castHom (show m.lcm n ∣ m * n by simp [Nat.lcm_dvd_iff]) (ZMod m × ZMod n)
  let inv_fun : ZMod m × ZMod n → ZMod (m * n) := fun x =>
    if m * n = 0 then if m = 1 then RingHom.snd _ _ x else RingHom.fst _ _ x
    else Nat.chineseRemainder h x.1.val x.2.val
  have inv : Function.LeftInverse inv_fun to_fun ∧ Function.RightInverse inv_fun to_fun :=
    if hmn0 : m * n = 0 then by
      rcases h.eq_of_mul_eq_zero hmn0 with (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩)
      . constructor
        . intro x; rfl
        . rintro ⟨x, y⟩
          fin_cases y
          simp [castHom, Prod.ext_iff]
      . constructor
        . intro x; rfl
        . rintro ⟨x, y⟩
          fin_cases x
          simp [castHom, Prod.ext_iff]
    else by
      haveI : NeZero (m * n) := ⟨hmn0⟩
      haveI : NeZero m := ⟨left_ne_zero_of_mul hmn0⟩
      haveI : NeZero n := ⟨right_ne_zero_of_mul hmn0⟩
      have left_inv : Function.LeftInverse inv_fun to_fun :=
        by
        intro x
        dsimp only [dvd_mul_left, dvd_mul_right, ZMod.castHom_apply]
        conv_rhs => rw [← ZMod.nat_cast_zmod_val x]
        rw [if_neg hmn0, ZMod.eq_iff_modEq_nat, ← Nat.modEq_and_modEq_iff_modEq_mul h,
          Prod.fst_zmod_cast, Prod.snd_zmod_cast]
        refine'
          ⟨(Nat.chineseRemainder h (x : ZMod m).val (x : ZMod n).val).2.left.trans _,
            (Nat.chineseRemainder h (x : ZMod m).val (x : ZMod n).val).2.right.trans _⟩
        · rw [← ZMod.eq_iff_modEq_nat, ZMod.nat_cast_zmod_val, ZMod.nat_cast_val]
        · rw [← ZMod.eq_iff_modEq_nat, ZMod.nat_cast_zmod_val, ZMod.nat_cast_val]
      exact ⟨left_inv, left_inv.rightInverse_of_card_le (by simp)⟩
  { toFun := to_fun,
    invFun := inv_fun,
    map_mul' := RingHom.map_mul _
    map_add' := RingHom.map_add _
    left_inv := inv.1
    right_inv := inv.2 }
#align zmod.chinese_remainder ZMod.chineseRemainder

-- todo: this can be made a `Unique` instance.
instance subsingleton_units : Subsingleton (ZMod 2)ˣ :=
  ⟨by decide⟩
#align zmod.subsingleton_units ZMod.subsingleton_units

theorem le_div_two_iff_lt_neg (n : ℕ) [hn : Fact ((n : ℕ) % 2 = 1)] {x : ZMod n} (hx0 : x ≠ 0) :
    x.val ≤ (n / 2 : ℕ) ↔ (n / 2 : ℕ) < (-x).val := by
  haveI npos : NeZero n :=
    ⟨by
      rintro rfl
      simp [fact_iff] at hn⟩
  have _hn2 : (n : ℕ) / 2 < n :=
    Nat.div_lt_of_lt_mul ((lt_mul_iff_one_lt_left <| NeZero.pos n).2 (by decide))
  have hn2' : (n : ℕ) - n / 2 = n / 2 + 1 :=
    by
    conv =>
      lhs
      congr
      rw [← Nat.succ_sub_one n, Nat.succ_sub <| NeZero.pos n]
    rw [← Nat.two_mul_odd_div_two hn.1, two_mul, ← Nat.succ_add, add_tsub_cancel_right]
  have hxn : (n : ℕ) - x.val < n :=
    by
    rw [tsub_lt_iff_tsub_lt x.val_le le_rfl, tsub_self]
    rw [← ZMod.nat_cast_zmod_val x] at hx0
    exact Nat.pos_of_ne_zero fun h => by simp [h] at hx0
  · conv =>
      rhs
      rw [← Nat.succ_le_iff, Nat.succ_eq_add_one, ← hn2', ← zero_add (-x), ← ZMod.nat_cast_self, ←
        sub_eq_add_neg, ← ZMod.nat_cast_zmod_val x, ← Nat.cast_sub x.val_le, ZMod.val_nat_cast,
        Nat.mod_eq_of_lt hxn, tsub_le_tsub_iff_left x.val_le]
#align zmod.le_div_two_iff_lt_neg ZMod.le_div_two_iff_lt_neg

theorem ne_neg_self (n : ℕ) [hn : Fact ((n : ℕ) % 2 = 1)] {a : ZMod n} (ha : a ≠ 0) : a ≠ -a :=
  fun h => by
  have : a.val ≤ n / 2 ↔ (n : ℕ) / 2 < (-a).val := le_div_two_iff_lt_neg n ha
  rwa [← h, ← not_lt, ← not_iff, iff_self, not_true] at this
#align zmod.ne_neg_self ZMod.ne_neg_self

theorem neg_one_ne_one {n : ℕ} [Fact (2 < n)] : (-1 : ZMod n) ≠ 1 :=
  CharP.neg_one_ne_one (ZMod n) n
#align zmod.neg_one_ne_one ZMod.neg_one_ne_one

theorem neg_eq_self_mod_two (a : ZMod 2) : -a = a := by
  fin_cases a <;> apply Fin.ext <;> simp [Fin.coe_neg, Int.natMod]
#align zmod.neg_eq_self_mod_two ZMod.neg_eq_self_mod_two

@[simp]
theorem natAbs_mod_two (a : ℤ) : (a.natAbs : ZMod 2) = a := by
  cases a
  · simp only [Int.natAbs_ofNat, Int.cast_ofNat, Int.ofNat_eq_coe]
  · simp only [neg_eq_self_mod_two, Nat.cast_succ, Int.natAbs, Int.cast_negSucc]
#align zmod.nat_abs_mod_two ZMod.natAbs_mod_two

@[simp]
theorem val_eq_zero : ∀ {n : ℕ} (a : ZMod n), a.val = 0 ↔ a = 0
  | 0, a => Int.natAbs_eq_zero
  | n + 1, a => by
    rw [Fin.ext_iff]
    exact Iff.rfl
#align zmod.val_eq_zero ZMod.val_eq_zero

theorem neg_eq_self_iff {n : ℕ} (a : ZMod n) : -a = a ↔ a = 0 ∨ 2 * a.val = n := by
  rw [neg_eq_iff_add_eq_zero, ← two_mul]
  cases n
  · erw [@mul_eq_zero ℤ, @mul_eq_zero ℕ, val_eq_zero]
    exact
      ⟨fun h => h.elim (by simp) Or.inl, fun h =>
        Or.inr (h.elim id fun h => h.elim (by simp) id)⟩
  conv_lhs =>
    rw [← a.nat_cast_zmod_val, ← Nat.cast_two, ← Nat.cast_mul, nat_cast_zmod_eq_zero_iff_dvd]
  constructor
  · rintro ⟨m, he⟩
    cases' m with m
    · erw [MulZeroClass.mul_zero, mul_eq_zero] at he
      rcases he with (⟨⟨⟩⟩ | he)
      exact Or.inl (a.val_eq_zero.1 he)
    cases m
    · right
      rwa [show Nat.succ Nat.zero = 1 from rfl, mul_one] at he
    refine' (a.val_lt.not_le <| Nat.le_of_mul_le_mul_left _ zero_lt_two).elim
    rw [he, mul_comm]
    apply Nat.mul_le_mul_left
    erw [Nat.succ_le_succ_iff, Nat.succ_le_succ_iff]; simp
  · rintro (rfl | h)
    · rw [val_zero, MulZeroClass.mul_zero]
      apply dvd_zero
    · rw [h]
#align zmod.neg_eq_self_iff ZMod.neg_eq_self_iff

theorem val_cast_of_lt {n : ℕ} {a : ℕ} (h : a < n) : (a : ZMod n).val = a := by
  rw [val_nat_cast, Nat.mod_eq_of_lt h]
#align zmod.val_cast_of_lt ZMod.val_cast_of_lt

theorem neg_val' {n : ℕ} [NeZero n] (a : ZMod n) : (-a).val = (n - a.val) % n :=
  calc
    (-a).val = val (-a) % n := by rw [Nat.mod_eq_of_lt (-a).val_lt]
    _ = (n - val a) % n :=
      Nat.ModEq.add_right_cancel' _
        (by
          rw [Nat.ModEq, ← val_add, add_left_neg, tsub_add_cancel_of_le a.val_le, Nat.mod_self,
            val_zero])

#align zmod.neg_val' ZMod.neg_val'

theorem neg_val {n : ℕ} [NeZero n] (a : ZMod n) : (-a).val = if a = 0 then 0 else n - a.val := by
  rw [neg_val']
  by_cases h : a = 0; · rw [if_pos h, h, val_zero, tsub_zero, Nat.mod_self]
  rw [if_neg h]
  apply Nat.mod_eq_of_lt
  apply Nat.sub_lt (NeZero.pos n)
  contrapose! h
  rwa [le_zero_iff, val_eq_zero] at h
#align zmod.neg_val ZMod.neg_val

/-- `valMinAbs x` returns the integer in the same equivalence class as `x` that is closest to `0`,
  The result will be in the interval `(-n/2, n/2]`. -/
def valMinAbs : ∀ {n : ℕ}, ZMod n → ℤ
  | 0, x => x
  | n@(_ + 1), x => if x.val ≤ n / 2 then x.val else (x.val : ℤ) - n
#align zmod.val_min_abs ZMod.valMinAbs

@[simp]
theorem valMinAbs_def_zero (x : ZMod 0) : valMinAbs x = x :=
  rfl
#align zmod.val_min_abs_def_zero ZMod.valMinAbs_def_zero

theorem valMinAbs_def_pos {n : ℕ} [NeZero n] (x : ZMod n) :
    valMinAbs x = if x.val ≤ n / 2 then (x.val : ℤ) else x.val - n := by
  cases n
  · cases NeZero.ne 0 rfl
  · rfl
#align zmod.val_min_abs_def_pos ZMod.valMinAbs_def_pos

@[simp, norm_cast]
theorem coe_valMinAbs : ∀ {n : ℕ} (x : ZMod n), (x.valMinAbs : ZMod n) = x
  | 0, x => Int.cast_id
  | k@(n + 1), x => by
    rw [valMinAbs_def_pos]
    split_ifs
    · rw [Int.cast_ofNat, nat_cast_zmod_val]
    · rw [Int.cast_sub, Int.cast_ofNat, nat_cast_zmod_val, Int.cast_ofNat, nat_cast_self, sub_zero]
#align zmod.coe_val_min_abs ZMod.coe_valMinAbs

theorem injective_valMinAbs {n : ℕ} : (valMinAbs : ZMod n → ℤ).Injective :=
  Function.injective_iff_hasLeftInverse.2 ⟨_, coe_valMinAbs⟩
#align zmod.injective_val_min_abs ZMod.injective_valMinAbs

theorem _root_.Nat.le_div_two_iff_mul_two_le {n m : ℕ} : m ≤ n / 2 ↔ (m : ℤ) * 2 ≤ n := by
  rw [Nat.le_div_iff_mul_le zero_lt_two, ← Int.ofNat_le, Int.ofNat_mul, Nat.cast_two]
#align nat.le_div_two_iff_mul_two_le Nat.le_div_two_iff_mul_two_le

theorem valMinAbs_nonneg_iff {n : ℕ} [NeZero n] (x : ZMod n) : 0 ≤ x.valMinAbs ↔ x.val ≤ n / 2 := by
  rw [valMinAbs_def_pos]; split_ifs with h
  · exact iff_of_true (Nat.cast_nonneg _) h
  · exact iff_of_false (sub_lt_zero.2 <| Int.ofNat_lt.2 x.val_lt).not_le h
#align zmod.val_min_abs_nonneg_iff ZMod.valMinAbs_nonneg_iff

theorem valMinAbs_mul_two_eq_iff {n : ℕ} (a : ZMod n) : a.valMinAbs * 2 = n ↔ 2 * a.val = n := by
  cases' n with n
  · simp
  by_cases h : a.val ≤ n.succ / 2
  · dsimp [valMinAbs]
    rw [if_pos h, ← Int.coe_nat_inj', Nat.cast_mul, Nat.cast_two, mul_comm]
  apply iff_of_false _ (mt _ h)
  · intro he
    rw [← a.valMinAbs_nonneg_iff, ← mul_nonneg_iff_left_nonneg_of_pos, he] at h
    exacts[h (Nat.cast_nonneg _), zero_lt_two]
  · rw [mul_comm]
    exact fun h => (Nat.le_div_iff_mul_le zero_lt_two).2 h.le
#align zmod.val_min_abs_mul_two_eq_iff ZMod.valMinAbs_mul_two_eq_iff

theorem valMinAbs_mem_Ioc {n : ℕ} [NeZero n] (x : ZMod n) : x.valMinAbs * 2 ∈ Set.Ioc (-n : ℤ) n :=
  by
  simp_rw [valMinAbs_def_pos, Nat.le_div_two_iff_mul_two_le]; split_ifs with h
  · refine' ⟨(neg_lt_zero.2 <| by exact_mod_cast NeZero.pos n).trans_le (mul_nonneg _ _), h⟩
    exacts[Nat.cast_nonneg _, zero_le_two]
  · refine' ⟨_, le_trans (mul_nonpos_of_nonpos_of_nonneg _ zero_le_two) <| Nat.cast_nonneg _⟩
    · linarith only [h]
    · rw [sub_nonpos, Int.ofNat_le]
      exact x.val_lt.le
#align zmod.val_min_abs_mem_Ioc ZMod.valMinAbs_mem_Ioc

theorem valMinAbs_spec {n : ℕ} [NeZero n] (x : ZMod n) (y : ℤ) :
    x.valMinAbs = y ↔ x = y ∧ y * 2 ∈ Set.Ioc (-n : ℤ) n :=
  ⟨by
    rintro rfl
    exact ⟨x.coe_valMinAbs.symm, x.valMinAbs_mem_Ioc⟩, fun h =>
    by
    rw [← sub_eq_zero]
    apply @Int.eq_zero_of_abs_lt_dvd n
    · rw [← int_cast_zmod_eq_zero_iff_dvd, Int.cast_sub, coe_valMinAbs, h.1, sub_self]
    rw [← mul_lt_mul_right (@zero_lt_two ℤ _ _ _ _ _)]
    nth_rw 1 [← abs_eq_self.2 (@zero_le_two ℤ _ _ _ _)]
    rw [← abs_mul, sub_mul, abs_lt];
    constructor <;> linarith only [x.valMinAbs_mem_Ioc.1, x.valMinAbs_mem_Ioc.2, h.2.1, h.2.2]⟩
#align zmod.val_min_abs_spec ZMod.valMinAbs_spec

theorem natAbs_valMinAbs_le {n : ℕ} [NeZero n] (x : ZMod n) : x.valMinAbs.natAbs ≤ n / 2 := by
  rw [Nat.le_div_two_iff_mul_two_le]
  cases' x.valMinAbs.natAbs_eq with h h
  · rw [← h]
    exact x.valMinAbs_mem_Ioc.2
  · rw [← neg_le_neg_iff, ← neg_mul, ← h]
    exact x.valMinAbs_mem_Ioc.1.le
#align zmod.nat_abs_val_min_abs_le ZMod.natAbs_valMinAbs_le

@[simp]
theorem valMinAbs_zero : ∀ n, (0 : ZMod n).valMinAbs = 0
  | 0 => by simp only [valMinAbs_def_zero]
  | n + 1 => by simp only [valMinAbs_def_pos, if_true, Int.ofNat_zero, zero_le, val_zero]
#align zmod.val_min_abs_zero ZMod.valMinAbs_zero

@[simp]
theorem valMinAbs_eq_zero {n : ℕ} (x : ZMod n) : x.valMinAbs = 0 ↔ x = 0 := by
  cases' n with n
  · simp
  rw [← valMinAbs_zero n.succ]
  apply injective_valMinAbs.eq_iff
#align zmod.val_min_abs_eq_zero ZMod.valMinAbs_eq_zero

theorem nat_cast_natAbs_valMinAbs {n : ℕ} [NeZero n] (a : ZMod n) :
    (a.valMinAbs.natAbs : ZMod n) = if a.val ≤ (n : ℕ) / 2 then a else -a := by
  have : (a.val : ℤ) - n ≤ 0 := by
    erw [sub_nonpos, Int.ofNat_le]
    exact a.val_le
  rw [valMinAbs_def_pos]
  split_ifs
  · rw [Int.natAbs_ofNat, nat_cast_zmod_val]
  · rw [← Int.cast_ofNat, Int.ofNat_natAbs_of_nonpos this, Int.cast_neg, Int.cast_sub,
      Int.cast_ofNat, Int.cast_ofNat, nat_cast_self, sub_zero, nat_cast_zmod_val]
#align zmod.nat_cast_nat_abs_val_min_abs ZMod.nat_cast_natAbs_valMinAbs

theorem valMinAbs_neg_of_ne_half {n : ℕ} {a : ZMod n} (ha : 2 * a.val ≠ n) :
    (-a).valMinAbs = -a.valMinAbs := by
  cases' eq_zero_or_neZero n with h h
  · subst h
    rfl
  refine' (valMinAbs_spec _ _).2 ⟨_, _, _⟩
  · rw [Int.cast_neg, coe_valMinAbs]
  · rw [neg_mul, neg_lt_neg_iff]
    exact a.valMinAbs_mem_Ioc.2.lt_of_ne (mt a.valMinAbs_mul_two_eq_iff.1 ha)
  · linarith only [a.valMinAbs_mem_Ioc.1]
#align zmod.val_min_abs_neg_of_ne_half ZMod.valMinAbs_neg_of_ne_half

@[simp]
theorem natAbs_valMinAbs_neg {n : ℕ} (a : ZMod n) : (-a).valMinAbs.natAbs = a.valMinAbs.natAbs := by
  by_cases h2a : 2 * a.val = n
  · rw [a.neg_eq_self_iff.2 (Or.inr h2a)]
  · rw [valMinAbs_neg_of_ne_half h2a, Int.natAbs_neg]
#align zmod.nat_abs_val_min_abs_neg ZMod.natAbs_valMinAbs_neg

theorem val_eq_ite_valMinAbs {n : ℕ} [NeZero n] (a : ZMod n) :
    (a.val : ℤ) = a.valMinAbs + if a.val ≤ n / 2 then 0 else n := by
  rw [valMinAbs_def_pos]
  split_ifs <;> simp [add_zero, sub_add_cancel]
#align zmod.val_eq_ite_val_min_abs ZMod.val_eq_ite_valMinAbs

theorem prime_ne_zero (p q : ℕ) [hp : Fact p.Prime] [hq : Fact q.Prime] (hpq : p ≠ q) :
    (q : ZMod p) ≠ 0 := by
  rwa [← Nat.cast_zero, Ne.def, eq_iff_modEq_nat, Nat.modEq_zero_iff_dvd, ←
    hp.1.coprime_iff_not_dvd, Nat.coprime_primes hp.1 hq.1]
#align zmod.prime_ne_zero ZMod.prime_ne_zero

theorem valMinAbs_natAbs_eq_min {n : ℕ} [hpos : NeZero n] (a : ZMod n) :
    a.valMinAbs.natAbs = min a.val (n - a.val) := by
  rw [valMinAbs_def_pos]
  split_ifs with h
  · rw [Int.natAbs_ofNat]
    symm
    apply
      min_eq_left (le_trans h (le_trans (Nat.half_le_of_sub_le_half _) (Nat.sub_le_sub_left n h)))
    rw [Nat.sub_sub_self (Nat.div_le_self _ _)]
  · rw [← Int.natAbs_neg, neg_sub, ← Nat.cast_sub a.val_le]
    symm
    apply
      min_eq_right
        (le_trans (le_trans (Nat.sub_le_sub_left n (lt_of_not_ge h)) (Nat.le_half_of_half_lt_sub _))
          (le_of_not_ge h))
    rw [Nat.sub_sub_self (Nat.div_lt_self (lt_of_le_of_ne' (Nat.zero_le _) hpos.1) one_lt_two)]
    apply Nat.lt_succ_self
#align zmod.val_min_abs_nat_abs_eq_min ZMod.valMinAbs_natAbs_eq_min

theorem natAbs_min_of_le_div_two (n : ℕ) (x y : ℤ) (he : (x : ZMod n) = y) (hl : x.natAbs ≤ n / 2) :
    x.natAbs ≤ y.natAbs := by
  rw [int_cast_eq_int_cast_iff_dvd_sub] at he
  obtain ⟨m, he⟩ := he
  rw [sub_eq_iff_eq_add] at he
  subst he
  obtain rfl | hm := eq_or_ne m 0
  · rw [MulZeroClass.mul_zero, zero_add]
  apply hl.trans
  rw [← add_le_add_iff_right x.natAbs]
  refine' le_trans (le_trans ((add_le_add_iff_left _).2 hl) _) (Int.natAbs_sub_le _ _)
  rw [add_sub_cancel, Int.natAbs_mul, Int.natAbs_ofNat]
  refine' le_trans _ (Nat.le_mul_of_pos_right <| Int.natAbs_pos.2 hm)
  rw [← mul_two]; apply Nat.div_mul_le_self
#align zmod.nat_abs_min_of_le_div_two ZMod.natAbs_min_of_le_div_two

theorem natAbs_valMinAbs_add_le {n : ℕ} (a b : ZMod n) :
    (a + b).valMinAbs.natAbs ≤ (a.valMinAbs + b.valMinAbs).natAbs := by
  cases' n with n
  · rfl
  apply natAbs_min_of_le_div_two n.succ
  · simp_rw [Int.cast_add, coe_valMinAbs]
  · apply natAbs_valMinAbs_le
#align zmod.nat_abs_val_min_abs_add_le ZMod.natAbs_valMinAbs_add_le

variable (p : ℕ) [Fact p.Prime]

private theorem mul_inv_cancel_aux (a : ZMod p) (h : a ≠ 0) : a * a⁻¹ = 1 := by
  obtain ⟨k, rfl⟩ := nat_cast_zmod_surjective a
  apply coe_mul_inv_eq_one
  apply Nat.coprime.symm
  rwa [Nat.Prime.coprime_iff_not_dvd Fact.out, ← CharP.cast_eq_zero_iff (ZMod p)]

/-- Field structure on `ZMod p` if `p` is prime. -/
instance : Field (ZMod p) :=
  { inferInstanceAs (CommRing (ZMod p)), inferInstanceAs (Inv (ZMod p)),
    ZMod.nontrivial p with
    mul_inv_cancel := mul_inv_cancel_aux p
    inv_zero := inv_zero p }

/-- `ZMod p` is an integral domain when `p` is prime. -/
instance (p : ℕ) [hp : Fact p.Prime] : IsDomain (ZMod p) := by
  -- We need `cases p` here in order to resolve which `CommRing` instance is being used.
  cases p
  · exact (Nat.not_prime_zero hp.out).elim
  exact @Field.isDomain (ZMod _) (inferInstanceAs (Field (ZMod _)))

end ZMod

theorem RingHom.ext_zmod {n : ℕ} {R : Type _} [Semiring R] (f g : ZMod n →+* R) : f = g := by
  ext a
  obtain ⟨k, rfl⟩ := ZMod.int_cast_surjective a
  let φ : ℤ →+* R := f.comp (Int.castRingHom (ZMod n))
  let ψ : ℤ →+* R := g.comp (Int.castRingHom (ZMod n))
  show φ k = ψ k
  rw [φ.ext_int ψ]
#align ring_hom.ext_zmod RingHom.ext_zmod

namespace ZMod

variable {n : ℕ} {R : Type _}

instance subsingleton_ringHom [Semiring R] : Subsingleton (ZMod n →+* R) :=
  ⟨RingHom.ext_zmod⟩
#align zmod.subsingleton_ring_hom ZMod.subsingleton_ringHom

instance subsingleton_ringEquiv [Semiring R] : Subsingleton (ZMod n ≃+* R) :=
  ⟨fun f g => by
    rw [RingEquiv.coe_ringHom_inj_iff]
    apply RingHom.ext_zmod _ _⟩
#align zmod.subsingleton_ring_equiv ZMod.subsingleton_ringEquiv

@[simp]
theorem ringHom_map_cast [Ring R] (f : R →+* ZMod n) (k : ZMod n) : f k = k := by
  cases n
  . dsimp [ZMod, ZMod.cast] at f k ⊢; simp
  . dsimp [ZMod, ZMod.cast] at f k ⊢
    erw [map_natCast, Fin.cast_val_eq_self]
#align zmod.ring_hom_map_cast ZMod.ringHom_map_cast

theorem ringHom_rightInverse [Ring R] (f : R →+* ZMod n) :
    Function.RightInverse ((↑) : ZMod n → R) f :=
  ringHom_map_cast f
#align zmod.ring_hom_right_inverse ZMod.ringHom_rightInverse

theorem ringHom_surjective [Ring R] (f : R →+* ZMod n) : Function.Surjective f :=
  (ringHom_rightInverse f).surjective
#align zmod.ring_hom_surjective ZMod.ringHom_surjective

set_option synthInstance.etaExperiment true in
theorem ringHom_eq_of_ker_eq [CommRing R] (f g : R →+* ZMod n)
    (h : RingHom.ker f = RingHom.ker g) : f = g := by
  have := f.liftOfRightInverse_comp _ (ZMod.ringHom_rightInverse f) ⟨g, le_of_eq h⟩
  rw [Subtype.coe_mk] at this
  rw [← this, RingHom.ext_zmod (f.liftOfRightInverse _ _ ⟨g, _⟩) _, RingHom.id_comp]
#align zmod.ring_hom_eq_of_ker_eq ZMod.ringHom_eq_of_ker_eq

section lift

variable (n) {A : Type _} [AddGroup A]

/-- The map from `ZMod n` induced by `f : ℤ →+ A` that maps `n` to `0`. -/
--@[simps] --Porting note: removed, simplified LHS of `lift_coe` to something worse.
def lift : { f : ℤ →+ A // f n = 0 } ≃ (ZMod n →+ A) :=
  (Equiv.subtypeEquivRight <| by
        intro f
        rw [ker_int_castAddHom]
        constructor
        · rintro hf _ ⟨x, rfl⟩
          simp only [f.map_zsmul, zsmul_zero, f.mem_ker, hf]
        · intro h
          refine' h (AddSubgroup.mem_zmultiples _)).trans <|
    (Int.castAddHom (ZMod n)).liftOfRightInverse (↑) int_cast_zmod_cast
#align zmod.lift ZMod.lift

variable (f : { f : ℤ →+ A // f n = 0 })

@[simp]
theorem lift_coe (x : ℤ) : lift n f (x : ZMod n) = f.val x :=
  AddMonoidHom.liftOfRightInverse_comp_apply _ _ (fun _ => int_cast_zmod_cast _) _ _
#align zmod.lift_coe ZMod.lift_coe

theorem lift_castAddHom (x : ℤ) : lift n f (Int.castAddHom (ZMod n) x) = f.1 x :=
  AddMonoidHom.liftOfRightInverse_comp_apply _ _ (fun _ => int_cast_zmod_cast _) _ _
#align zmod.lift_cast_add_hom ZMod.lift_castAddHom

@[simp]

@[simp]
theorem lift_comp_castAddHom : (ZMod.lift n f).comp (Int.castAddHom (ZMod n)) = f :=
  AddMonoidHom.ext <| lift_castAddHom _ _
#align zmod.lift_comp_cast_add_hom ZMod.lift_comp_castAddHom

end lift

end ZMod


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

import linear_algebra.direct_sum.finsupp
import logic.small
import linear_algebra.std_basis

/-!

# Free modules

We introduce a class `module.free R M`, for `R` a `semiring` and `M` an `R`-module and we provide
several basic instances for this class.

Use `finsupp.total_id_surjective` to prove that any module is the quotient of a free module.

## Main definition

* `module.free R M` : the class of free `R`-modules.

-/

universes u v w z

variables (R : Type u) (M : Type v) (N : Type z)

open_locale tensor_product direct_sum big_operators

section basic

variables [semiring R] [add_comm_monoid M] [module R M]

/-- `module.free R M` is the statement that the `R`-module `M` is free.-/
class module.free : Prop :=
(exists_basis [] : nonempty (Σ (I : Type v), basis I R M))

/- If `M` fits in universe `w`, then freeness is equivalent to existence of a basis in that
universe.

Note that if `M` does not fit in `w`, the reverse direction of this implication is still true as
`module.free.of_basis`. -/
lemma module.free_def [small.{w} M] : module.free R M ↔ ∃ (I : Type w), nonempty (basis I R M) :=
⟨ λ h, ⟨shrink (set.range h.exists_basis.some.2),
    ⟨(basis.reindex_range h.exists_basis.some.2).reindex (equiv_shrink _)⟩⟩,
  λ h, ⟨(nonempty_sigma.2 h).map $ λ ⟨i, b⟩, ⟨set.range b, b.reindex_range⟩⟩⟩

lemma module.free_iff_set : module.free R M ↔ ∃ (S : set M), nonempty (basis S R M) :=
⟨λ h, ⟨set.range h.exists_basis.some.2, ⟨basis.reindex_range h.exists_basis.some.2⟩⟩,
    λ ⟨S, hS⟩, ⟨nonempty_sigma.2 ⟨S, hS⟩⟩⟩

variables {R M}

lemma module.free.of_basis {ι : Type w} (b : basis ι R M) : module.free R M :=
(module.free_def R M).2 ⟨set.range b, ⟨b.reindex_range⟩⟩

end basic

namespace module.free

section semiring

variables (R M) [semiring R] [add_comm_monoid M] [module R M] [module.free R M]
variables [add_comm_monoid N] [module R N]

/-- If `[finite_free R M]` then `choose_basis_index R M` is the `ι` which indexes the basis
  `ι → M`. -/
@[nolint has_inhabited_instance] def choose_basis_index := (exists_basis R M).some.1

/-- If `[finite_free R M]` then `choose_basis : ι → M` is the basis.
Here `ι = choose_basis_index R M`. -/
noncomputable def choose_basis : basis (choose_basis_index R M) R M := (exists_basis R M).some.2

/-- The isomorphism `M ≃ₗ[R] (choose_basis_index R M →₀ R)`. -/
noncomputable def repr : M ≃ₗ[R] (choose_basis_index R M →₀ R) := (choose_basis R M).repr

/-- The universal property of free modules: giving a functon `(choose_basis_index R M) → N`, for `N`
an `R`-module, is the same as giving an `R`-linear map `M →ₗ[R] N`.

This definition is parameterized over an extra `semiring S`,
such that `smul_comm_class R S M'` holds.
If `R` is commutative, you can set `S := R`; if `R` is not commutative,
you can recover an `add_equiv` by setting `S := ℕ`.
See library note [bundled maps over different rings]. -/
noncomputable def constr {S : Type z} [semiring S] [module S N] [smul_comm_class R S N] :
  ((choose_basis_index R M) → N) ≃ₗ[S] M →ₗ[R] N := basis.constr (choose_basis R M) S

@[priority 100]
instance no_zero_smul_divisors [no_zero_divisors R] : no_zero_smul_divisors R M :=
let ⟨⟨_, b⟩⟩ := exists_basis R M in b.no_zero_smul_divisors

/-- The product of finitely many free modules is free. -/
instance pi {ι : Type*} [fintype ι] {M : ι → Type*} [Π (i : ι), add_comm_group (M i)]
  [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] : module.free R (Π i, M i) :=
of_basis $ pi.basis $ λ i, choose_basis R (M i)

/-- The module of finite matrices is free. -/
instance matrix {n : Type*} [fintype n] {m : Type*} [fintype m] :
  module.free R (matrix n m R) :=
of_basis $ matrix.std_basis R n m

variables {R M N}

lemma of_equiv (e : M ≃ₗ[R] N) : module.free R N :=
of_basis $ (choose_basis R M).map e

/-- A variation of `of_equiv`: the assumption `module.free R P` here is explicit rather than an
instance. -/
lemma of_equiv' {P : Type v} [add_comm_monoid P] [module R P] (h : module.free R P)
  (e : P ≃ₗ[R] N) : module.free R N :=
of_equiv e

variables (R M N)

instance {ι : Type v} : module.free R (ι →₀ R) :=
of_basis (basis.of_repr (linear_equiv.refl _ _))

instance {ι : Type v} [fintype ι] : module.free R (ι → R) :=
of_equiv (basis.of_repr $ linear_equiv.refl _ _).equiv_fun

instance prod [module.free R N] : module.free R (M × N) :=
of_basis $ (choose_basis R M).prod (choose_basis R N)

instance self : module.free R R := of_basis $ basis.singleton unit R

@[priority 100]
instance of_subsingleton [subsingleton N] : module.free R N :=
of_basis (basis.empty N : basis pempty R N)

instance dfinsupp {ι : Type*} (M : ι → Type*) [Π (i : ι), add_comm_monoid (M i)]
  [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] : module.free R (Π₀ i, M i) :=
of_basis $ dfinsupp.basis $ λ i, choose_basis R (M i)

instance direct_sum {ι : Type*} (M : ι → Type*) [Π (i : ι), add_comm_monoid (M i)]
  [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] : module.free R (⨁ i, M i) :=
module.free.dfinsupp R M

end semiring

section comm_ring

variables [comm_ring R] [add_comm_group M] [module R M] [module.free R M]
variables [add_comm_group N] [module R N] [module.free R N]

instance tensor : module.free R (M ⊗[R] N) :=
of_equiv' (of_equiv' (finsupp.free R) (finsupp_tensor_finsupp' R _ _).symm)
  (tensor_product.congr (choose_basis R M).repr (choose_basis R N).repr).symm

end comm_ring

section division_ring

variables [division_ring R] [add_comm_group M] [module R M]

@[priority 100]
instance of_division_ring : module.free R M :=
of_basis (basis.of_vector_space R M)

end division_ring

end module.free


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import algebra.order.invertible
import algebra.order.module
import linear_algebra.affine_space.midpoint_zero
import linear_algebra.affine_space.slope
import tactic.field_simp

/-!
# Ordered modules as affine spaces

In this file we prove some theorems about `slope` and `line_map` in the case when the module `E`
acting on the codomain `PE` of a function is an ordered module over its domain `k`. We also prove
inequalities that can be used to link convexity of a function on an interval to monotonicity of the
slope, see section docstring below for details.

## Implementation notes

We do not introduce the notion of ordered affine spaces (yet?). Instead, we prove various theorems
for an ordered module interpreted as an affine space.

## Tags

affine space, ordered module, slope
-/

open affine_map

variables {k E PE : Type*}

/-!
### Monotonicity of `line_map`

In this section we prove that `line_map a b r` is monotone (strictly or not) in its arguments if
other arguments belong to specific domains.
-/

section ordered_ring

variables [ordered_ring k] [ordered_add_comm_group E] [module k E] [ordered_smul k E]

variables {a a' b b' : E} {r r' : k}

lemma line_map_mono_left (ha : a ≤ a') (hr : r ≤ 1) :
  line_map a b r ≤ line_map a' b r :=
begin
  simp only [line_map_apply_module],
  exact add_le_add_right (smul_le_smul_of_nonneg ha (sub_nonneg.2 hr)) _
end

lemma line_map_strict_mono_left (ha : a < a') (hr : r < 1) :
  line_map a b r < line_map a' b r :=
begin
  simp only [line_map_apply_module],
  exact add_lt_add_right (smul_lt_smul_of_pos ha (sub_pos.2 hr)) _
end

lemma line_map_mono_right (hb : b ≤ b') (hr : 0 ≤ r) :
  line_map a b r ≤ line_map a b' r :=
begin
  simp only [line_map_apply_module],
  exact add_le_add_left (smul_le_smul_of_nonneg hb hr) _
end

lemma line_map_strict_mono_right (hb : b < b') (hr : 0 < r) :
  line_map a b r < line_map a b' r :=
begin
  simp only [line_map_apply_module],
  exact add_lt_add_left (smul_lt_smul_of_pos hb hr) _
end

lemma line_map_mono_endpoints (ha : a ≤ a') (hb : b ≤ b') (h₀ : 0 ≤ r) (h₁ : r ≤ 1) :
  line_map a b r ≤ line_map a' b' r :=
(line_map_mono_left ha h₁).trans (line_map_mono_right hb h₀)

lemma line_map_strict_mono_endpoints (ha : a < a') (hb : b < b') (h₀ : 0 ≤ r) (h₁ : r ≤ 1) :
  line_map a b r < line_map a' b' r :=
begin
  rcases h₀.eq_or_lt with (rfl|h₀), { simpa },
  exact (line_map_mono_left ha.le h₁).trans_lt (line_map_strict_mono_right hb h₀)
end

lemma line_map_lt_line_map_iff_of_lt (h : r < r') :
  line_map a b r < line_map a b r' ↔ a < b :=
begin
  simp only [line_map_apply_module],
  rw [← lt_sub_iff_add_lt, add_sub_assoc, ← sub_lt_iff_lt_add', ← sub_smul, ← sub_smul,
    sub_sub_sub_cancel_left, smul_lt_smul_iff_of_pos (sub_pos.2 h)],
  apply_instance,
end

lemma left_lt_line_map_iff_lt (h : 0 < r) : a < line_map a b r ↔ a < b :=
iff.trans (by rw line_map_apply_zero) (line_map_lt_line_map_iff_of_lt h)

lemma line_map_lt_left_iff_lt (h : 0 < r) : line_map a b r < a ↔ b < a :=
@left_lt_line_map_iff_lt k Eᵒᵈ _ _ _ _ _ _ _ h

lemma line_map_lt_right_iff_lt (h : r < 1) : line_map a b r < b ↔ a < b :=
iff.trans (by rw line_map_apply_one) (line_map_lt_line_map_iff_of_lt h)

lemma right_lt_line_map_iff_lt (h : r < 1) : b < line_map a b r ↔ b < a :=
@line_map_lt_right_iff_lt k Eᵒᵈ _ _ _ _ _ _ _ h

end ordered_ring

section linear_ordered_ring

variables [linear_ordered_ring k] [ordered_add_comm_group E] [module k E]
  [ordered_smul k E] [invertible (2:k)] {a a' b b' : E} {r r' : k}

lemma midpoint_le_midpoint (ha : a ≤ a') (hb : b ≤ b') :
  midpoint k a b ≤ midpoint k a' b' :=
line_map_mono_endpoints ha hb (inv_of_nonneg.2 zero_le_two) $
  inv_of_le_one one_le_two

end linear_ordered_ring

section linear_ordered_field

variables [linear_ordered_field k] [ordered_add_comm_group E]
variables [module k E] [ordered_smul k E]

section

variables {a b : E} {r r' : k}

lemma line_map_le_line_map_iff_of_lt (h : r < r') :
  line_map a b r ≤ line_map a b r' ↔ a ≤ b :=
begin
  simp only [line_map_apply_module],
  rw [← le_sub_iff_add_le, add_sub_assoc, ← sub_le_iff_le_add', ← sub_smul, ← sub_smul,
    sub_sub_sub_cancel_left, smul_le_smul_iff_of_pos (sub_pos.2 h)],
  apply_instance,
end

lemma left_le_line_map_iff_le (h : 0 < r) : a ≤ line_map a b r ↔ a ≤ b :=
iff.trans (by rw line_map_apply_zero) (line_map_le_line_map_iff_of_lt h)

@[simp] lemma left_le_midpoint : a ≤ midpoint k a b ↔ a ≤ b :=
left_le_line_map_iff_le $ inv_pos.2 zero_lt_two

lemma line_map_le_left_iff_le (h : 0 < r) : line_map a b r ≤ a ↔ b ≤ a :=
@left_le_line_map_iff_le k Eᵒᵈ _ _ _ _ _ _ _ h

@[simp] lemma midpoint_le_left : midpoint k a b ≤ a ↔ b ≤ a :=
line_map_le_left_iff_le $ inv_pos.2 zero_lt_two

lemma line_map_le_right_iff_le (h : r < 1) : line_map a b r ≤ b ↔ a ≤ b :=
iff.trans (by rw line_map_apply_one) (line_map_le_line_map_iff_of_lt h)

@[simp] lemma midpoint_le_right : midpoint k a b ≤ b ↔ a ≤ b :=
line_map_le_right_iff_le $ inv_lt_one one_lt_two

lemma right_le_line_map_iff_le (h : r < 1) : b ≤ line_map a b r ↔ b ≤ a :=
@line_map_le_right_iff_le k Eᵒᵈ _ _ _ _ _ _ _ h

@[simp] lemma right_le_midpoint : b ≤ midpoint k a b ↔ b ≤ a :=
right_le_line_map_iff_le $ inv_lt_one one_lt_two

end

/-!
### Convexity and slope

Given an interval `[a, b]` and a point `c ∈ (a, b)`, `c = line_map a b r`, there are a few ways to
say that the point `(c, f c)` is above/below the segment `[(a, f a), (b, f b)]`:

* compare `f c` to `line_map (f a) (f b) r`;
* compare `slope f a c` to `slope `f a b`;
* compare `slope f c b` to `slope f a b`;
* compare `slope f a c` to `slope f c b`.

In this section we prove equivalence of these four approaches. In order to make the statements more
readable, we introduce local notation `c = line_map a b r`. Then we prove lemmas like

```
lemma map_le_line_map_iff_slope_le_slope_left (h : 0 < r * (b - a)) :
  f c ≤ line_map (f a) (f b) r ↔ slope f a c ≤ slope f a b :=
```

For each inequality between `f c` and `line_map (f a) (f b) r` we provide 3 lemmas:

* `*_left` relates it to an inequality on `slope f a c` and `slope f a b`;
* `*_right` relates it to an inequality on `slope f a b` and `slope f c b`;
* no-suffix version relates it to an inequality on `slope f a c` and `slope f c b`.

These inequalities can by used in to restate `convex_on` in terms of monotonicity of the slope.
-/

variables {f : k → E} {a b r : k}

local notation `c` := line_map a b r

/-- Given `c = line_map a b r`, `a < c`, the point `(c, f c)` is non-strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c ≤ slope f a b`. -/
lemma map_le_line_map_iff_slope_le_slope_left (h : 0 < r * (b - a)) :
  f c ≤ line_map (f a) (f b) r ↔ slope f a c ≤ slope f a b :=
begin
  rw [line_map_apply, line_map_apply, slope, slope,
  vsub_eq_sub, vsub_eq_sub, vsub_eq_sub, vadd_eq_add, vadd_eq_add,
  smul_eq_mul, add_sub_cancel, smul_sub, smul_sub, smul_sub,
  sub_le_iff_le_add, mul_inv_rev, mul_smul, mul_smul, ←smul_sub, ←smul_sub, ←smul_add, smul_smul,
  ← mul_inv_rev, inv_smul_le_iff h, smul_smul,
  mul_inv_cancel_right₀ (right_ne_zero_of_mul h.ne'), smul_add,
  smul_inv_smul₀ (left_ne_zero_of_mul h.ne')],
  apply_instance
end

/-- Given `c = line_map a b r`, `a < c`, the point `(c, f c)` is non-strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b ≤ slope f a c`. -/
lemma line_map_le_map_iff_slope_le_slope_left (h : 0 < r * (b - a)) :
  line_map (f a) (f b) r ≤ f c ↔ slope f a b ≤ slope f a c :=
@map_le_line_map_iff_slope_le_slope_left k Eᵒᵈ _ _ _ _ f a b r h

/-- Given `c = line_map a b r`, `a < c`, the point `(c, f c)` is strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c < slope f a b`. -/
lemma map_lt_line_map_iff_slope_lt_slope_left (h : 0 < r * (b - a)) :
  f c < line_map (f a) (f b) r ↔ slope f a c < slope f a b :=
lt_iff_lt_of_le_iff_le' (line_map_le_map_iff_slope_le_slope_left h)
  (map_le_line_map_iff_slope_le_slope_left h)

/-- Given `c = line_map a b r`, `a < c`, the point `(c, f c)` is strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b < slope f a c`. -/
lemma line_map_lt_map_iff_slope_lt_slope_left (h : 0 < r * (b - a)) :
  line_map (f a) (f b) r < f c ↔ slope f a b < slope f a c :=
@map_lt_line_map_iff_slope_lt_slope_left k Eᵒᵈ _ _ _ _ f a b r h

/-- Given `c = line_map a b r`, `c < b`, the point `(c, f c)` is non-strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b ≤ slope f c b`. -/
lemma map_le_line_map_iff_slope_le_slope_right (h : 0 < (1 - r) * (b - a)) :
  f c ≤ line_map (f a) (f b) r ↔ slope f a b ≤ slope f c b :=
begin
  rw [← line_map_apply_one_sub, ← line_map_apply_one_sub _ _ r],
  revert h, generalize : 1 - r = r', clear r, intro h,
  simp_rw [line_map_apply, slope, vsub_eq_sub, vadd_eq_add, smul_eq_mul],
  rw [sub_add_eq_sub_sub_swap, sub_self, zero_sub, neg_mul_eq_mul_neg, neg_sub, le_inv_smul_iff h,
    smul_smul, mul_inv_cancel_right₀, le_sub_comm, ← neg_sub (f b), smul_neg, neg_add_eq_sub],
  { exact right_ne_zero_of_mul h.ne' },
  { apply_instance }
end

/-- Given `c = line_map a b r`, `c < b`, the point `(c, f c)` is non-strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b ≤ slope f a b`. -/
lemma line_map_le_map_iff_slope_le_slope_right (h : 0 < (1 - r) * (b - a)) :
  line_map (f a) (f b) r ≤ f c ↔ slope f c b ≤ slope f a b :=
@map_le_line_map_iff_slope_le_slope_right k Eᵒᵈ _ _ _ _ f a b r h

/-- Given `c = line_map a b r`, `c < b`, the point `(c, f c)` is strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a b < slope f c b`. -/
lemma map_lt_line_map_iff_slope_lt_slope_right (h : 0 < (1 - r) * (b - a)) :
  f c < line_map (f a) (f b) r ↔ slope f a b < slope f c b :=
lt_iff_lt_of_le_iff_le' (line_map_le_map_iff_slope_le_slope_right h)
  (map_le_line_map_iff_slope_le_slope_right h)

/-- Given `c = line_map a b r`, `c < b`, the point `(c, f c)` is strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b < slope f a b`. -/
lemma line_map_lt_map_iff_slope_lt_slope_right (h : 0 < (1 - r) * (b - a)) :
  line_map (f a) (f b) r < f c ↔ slope f c b < slope f a b :=
@map_lt_line_map_iff_slope_lt_slope_right k Eᵒᵈ _ _ _ _ f a b r h

/-- Given `c = line_map a b r`, `a < c < b`, the point `(c, f c)` is non-strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c ≤ slope f c b`. -/
lemma map_le_line_map_iff_slope_le_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
  f c ≤ line_map (f a) (f b) r ↔ slope f a c ≤ slope f c b :=
begin
  rw [map_le_line_map_iff_slope_le_slope_left (mul_pos h₀ (sub_pos.2 hab)),
    ← line_map_slope_line_map_slope_line_map f a b r, right_le_line_map_iff_le h₁],
  apply_instance,
  apply_instance,
end

/-- Given `c = line_map a b r`, `a < c < b`, the point `(c, f c)` is non-strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b ≤ slope f a c`. -/
lemma line_map_le_map_iff_slope_le_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
  line_map (f a) (f b) r ≤ f c ↔ slope f c b ≤ slope f a c :=
@map_le_line_map_iff_slope_le_slope k Eᵒᵈ _ _ _ _ _ _ _ _ hab h₀ h₁

/-- Given `c = line_map a b r`, `a < c < b`, the point `(c, f c)` is strictly below the
segment `[(a, f a), (b, f b)]` if and only if `slope f a c < slope f c b`. -/
lemma map_lt_line_map_iff_slope_lt_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
  f c < line_map (f a) (f b) r ↔ slope f a c < slope f c b :=
lt_iff_lt_of_le_iff_le' (line_map_le_map_iff_slope_le_slope hab h₀ h₁)
  (map_le_line_map_iff_slope_le_slope hab h₀ h₁)

/-- Given `c = line_map a b r`, `a < c < b`, the point `(c, f c)` is strictly above the
segment `[(a, f a), (b, f b)]` if and only if `slope f c b < slope f a c`. -/
lemma line_map_lt_map_iff_slope_lt_slope (hab : a < b) (h₀ : 0 < r) (h₁ : r < 1) :
  line_map (f a) (f b) r < f c ↔ slope f c b < slope f a c :=
@map_lt_line_map_iff_slope_lt_slope k Eᵒᵈ _ _ _ _ _ _ _ _ hab h₀ h₁

end linear_ordered_field


import data.set data.equiv
import algebra.group

variables {G : Type*} [group G]

class is_subgroup (H : set G): Prop :=
(mul_ : ∀ g h, g ∈ H → h ∈ H → g*h ∈ H)
(inv_ : ∀ g, g ∈ H → g⁻¹ ∈ H)
(one_ : (1:G) ∈ H)

namespace is_subgroup
variables { H : set G } [is_subgroup H] { x y : G }

lemma mul : x ∈ H → y ∈ H → x*y ∈ H :=
mul_ _ _

instance : has_mul H :=
⟨λ h k, ⟨h*k, mul h.property k.property⟩⟩

lemma inv : x ∈ H → x⁻¹ ∈ H :=
inv_  _

instance : has_inv H :=
⟨λ h, ⟨h⁻¹, inv h.property⟩⟩

lemma one : (1:G) ∈ H := one_ _

instance : has_one H :=
⟨⟨(1:G), one⟩⟩

instance : group H :=
begin
refine { mul := (*), one := 1, inv := λ x, x⁻¹, ..},
{ intros a b c,
 cases a, cases b, cases c,
 simp[has_mul.mul],
 exact mul_assoc _ _ _ },
{ intro a, cases a, simp[has_mul.mul], exact group.one_mul _ },
{ intro a, cases a, simp[has_mul.mul], exact group.mul_one _ },
{ intro a, cases a,  simp[has_mul.mul, has_inv.inv], congr, exact group.mul_left_inv _ }
end
end is_subgroup

open equiv
universe u
variables {α : Type*} { β : Type* }
lemma equiv.ext (f g : equiv α β) (H : ∀ x, f x = g x) : f = g :=
eq_of_to_fun_eq (funext H)

/- The group of permutations (self-equivalences) of a type `α` -/
instance perm_group {α : Type u} : group (perm α) :=
begin
  refine { mul := λ f g, equiv.trans g f, one := equiv.refl α, inv:= equiv.symm, ..};
  intros; apply equiv.ext; try { apply trans_apply },
  apply inverse_apply_apply
end

variable {X : Type*}

def is_prop_preserving (prop : set X → Prop) (f : perm X) := ∀ L, prop L → prop (f '' L) ∧ prop (⇑f⁻¹ '' L)

lemma prop_group (prop : set X → Prop) : is_subgroup ({ f | is_prop_preserving prop f } : set (perm X)) :=
begin
split; simp,
{ intros g h gp hp L Lprop,
  split,
  { cases (hp L Lprop) with hpL _,
    cases (gp _ hpL) with gpL _,
    rw[←set.image_comp] at gpL,
    finish },
  { cases (gp L Lprop) with _ gpLinv,
    cases (hp _ gpLinv) with _ hpLinv,
    rw[←set.image_comp] at hpLinv,
    finish } },
{ intros g gp L Lprop, cases gp L Lprop with gp gpinv, finish },
{ intro L,
  rw[show (1:perm X)⁻¹ = 1, from rfl], simp,
  have : (1:perm X) '' L = L, simpa using set.image_id L,
  finish },
end

lemma stabilizer_group (x : X) : is_subgroup ({ f | f x = x } : set (perm X)) :=
begin
split; simp,
{ intros g h gx hx,
  simpa [hx, gx, show (g * h) x = g (h x), from rfl]},
{ intros g gx,
  simpa using (congr_arg g.symm gx).symm },
{ refl }
end


import categories.CatGroups
import categories.tactics
import categories.functor
import categories.natural_transformation
open categories
open categories.isomorphism
open categories.functor
open categories.CatGroup
open categories.natural_transformation

--delaration of universes and variables
universes u v u₀ v₀ u₁ v₁ u₂ v₂

lemma t {C : Type u} [𝒞 : CatGroup C] : ∀ X Y : C,((𝒞.obj ⟶ 𝒞.obj) = ((IdentityFunctor C) +> X ⟶ (IdentityFunctor C) +> Y)) :=
begin
intros,
exact calc
    (𝒞.obj ⟶ 𝒞.obj) = (((IdentityFunctor C) +> (𝒞.obj)) ⟶ 𝒞.obj) : by simp
    ... = ((IdentityFunctor C) +> 𝒞.obj ⟶ (IdentityFunctor C) +> 𝒞.obj) : by simp
    ... = ((IdentityFunctor C) +> X ⟶ (IdentityFunctor C) +> 𝒞.obj) : by rw CatGroup.uniqueobj_lemma X
    ... = ((IdentityFunctor C) +> X ⟶ (IdentityFunctor C) +> Y) : by rw CatGroup.uniqueobj_lemma Y
end

--2 Let G be a group viewed as a one-object category. Show that the natural transformations α : IdentityFunctor G ⟹ Identity Functor G correspond to elements in the centre of the group.
theorem Grp_id_nat_trans_center (C : Type u) [𝒞 : CatGroup C] (a : 𝒞.obj ⟶ 𝒞.obj) : (∀ x : 𝒞.obj ⟶ 𝒞.obj, a ≫ x = x ≫ a) ↔ (∃ α : IdentityFunctor C ⟹ IdentityFunctor C, α.components 𝒞.obj = a)  :=
begin
    apply iff.intro,
        intro hc,
        exact exists.intro
                (
                    ⟨
                        (λ X , cast(t X X) a),
                        begin
                            simp,
                            intros,
                            exact calc
                                f ≫ cast _ a = cast _ a ≫ f : sorry
                        end
                    ⟩   : IdentityFunctor C ⟹ IdentityFunctor C)
                (/-by simp-/ sorry),
        intro hn,
        cases (classical.indefinite_description _ hn) with α ha,
        intro,
        exact calc
            a ≫ x = (α.components 𝒞.obj) ≫ x : by rw ha
            ... = (α.components 𝒞.obj) ≫ ((IdentityFunctor C) &> x) : by simp
            ... = ((IdentityFunctor C) &> x) ≫ (α.components 𝒞.obj) : by rw NaturalTransformation.naturality_lemma
            ... = x ≫ (α.components 𝒞.obj) : by simp
            ... = x ≫ a : by rw ha
end