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

! This file was ported from Lean 3 source module algebra.group_power.order
! leanprover-community/mathlib commit dd4c2044a9dee231309637e7fd4e61aea1506e33
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Ring.Abs
import Mathlib.Algebra.Order.WithZero
import Mathlib.Algebra.GroupPower.Ring
import Mathlib.Data.Set.Intervals.Basic
import Mathlib.Data.Nat.Basic
import Mathlib.Init.Data.Nat.Basic

/-!
# Lemmas about the interaction of power operations with order

Note that some lemmas are in `Algebra/GroupPower/Lemmas.lean` as they import files which
depend on this file.
-/

open Function

variable {β A G M R : Type _}

section Monoid

variable [Monoid M]

section Preorder

variable [Preorder M]

section Left

variable [CovariantClass M M (· * ·) (· ≤ ·)] {x : M}

@[to_additive (attr := mono) nsmul_le_nsmul_of_le_right]
theorem pow_le_pow_of_le_left' [CovariantClass M M (swap (· * ·)) (· ≤ ·)] {a b : M} (hab : a ≤ b) :
    ∀ i : ℕ, a ^ i ≤ b ^ i
  | 0 => by simp
  | k + 1 => by
    rw [pow_succ, pow_succ]
    exact mul_le_mul' hab (pow_le_pow_of_le_left' hab k)
#align pow_le_pow_of_le_left' pow_le_pow_of_le_left'
#align nsmul_le_nsmul_of_le_right nsmul_le_nsmul_of_le_right

@[to_additive nsmul_nonneg]
theorem one_le_pow_of_one_le' {a : M} (H : 1 ≤ a) : ∀ n : ℕ, 1 ≤ a ^ n
  | 0 => by simp
  | k + 1 => by
    rw [pow_succ]
    exact one_le_mul H (one_le_pow_of_one_le' H k)
#align one_le_pow_of_one_le' one_le_pow_of_one_le'
#align nsmul_nonneg nsmul_nonneg

@[to_additive nsmul_nonpos]
theorem pow_le_one' {a : M} (H : a ≤ 1) (n : ℕ) : a ^ n ≤ 1 :=
  @one_le_pow_of_one_le' Mᵒᵈ _ _ _ _ H n
#align pow_le_one' pow_le_one'
#align nsmul_nonpos nsmul_nonpos

@[to_additive nsmul_le_nsmul]
theorem pow_le_pow' {a : M} {n m : ℕ} (ha : 1 ≤ a) (h : n ≤ m) : a ^ n ≤ a ^ m :=
  let ⟨k, hk⟩ := Nat.le.dest h
  calc
    a ^ n ≤ a ^ n * a ^ k := le_mul_of_one_le_right' (one_le_pow_of_one_le' ha _)
    _ = a ^ m := by rw [← hk, pow_add]

#align pow_le_pow' pow_le_pow'
#align nsmul_le_nsmul nsmul_le_nsmul

@[to_additive nsmul_le_nsmul_of_nonpos]
theorem pow_le_pow_of_le_one' {a : M} {n m : ℕ} (ha : a ≤ 1) (h : n ≤ m) : a ^ m ≤ a ^ n :=
  @pow_le_pow' Mᵒᵈ _ _ _ _ _ _ ha h
#align pow_le_pow_of_le_one' pow_le_pow_of_le_one'
#align nsmul_le_nsmul_of_nonpos nsmul_le_nsmul_of_nonpos

@[to_additive nsmul_pos]
theorem one_lt_pow' {a : M} (ha : 1 < a) {k : ℕ} (hk : k ≠ 0) : 1 < a ^ k := by
  rcases Nat.exists_eq_succ_of_ne_zero hk with ⟨l, rfl⟩
  clear hk
  induction' l with l IH
  · rw [pow_succ]; simpa using ha
  · rw [pow_succ]
    exact one_lt_mul'' ha IH
#align one_lt_pow' one_lt_pow'
#align nsmul_pos nsmul_pos

@[to_additive nsmul_neg]
theorem pow_lt_one' {a : M} (ha : a < 1) {k : ℕ} (hk : k ≠ 0) : a ^ k < 1 :=
  @one_lt_pow' Mᵒᵈ _ _ _ _ ha k hk
#align pow_lt_one' pow_lt_one'
#align nsmul_neg nsmul_neg

@[to_additive nsmul_lt_nsmul]
theorem pow_lt_pow' [CovariantClass M M (· * ·) (· < ·)] {a : M} {n m : ℕ} (ha : 1 < a)
    (h : n < m) : a ^ n < a ^ m := by
  rcases Nat.le.dest h with ⟨k, rfl⟩; clear h
  rw [pow_add, pow_succ', mul_assoc, ← pow_succ]
  exact lt_mul_of_one_lt_right' _ (one_lt_pow' ha k.succ_ne_zero)
#align pow_lt_pow' pow_lt_pow'
#align nsmul_lt_nsmul nsmul_lt_nsmul

@[to_additive nsmul_strictMono_right]
theorem pow_strictMono_left [CovariantClass M M (· * ·) (· < ·)] {a : M} (ha : 1 < a) :
    StrictMono ((· ^ ·) a : ℕ → M) := fun _ _ => pow_lt_pow' ha
#align pow_strict_mono_left pow_strictMono_left
#align nsmul_strict_mono_right nsmul_strictMono_right

@[to_additive Left.pow_nonneg]
theorem Left.one_le_pow_of_le (hx : 1 ≤ x) : ∀ {n : ℕ}, 1 ≤ x ^ n
  | 0 => (pow_zero x).ge
  | n + 1 => by
    rw [pow_succ]
    exact Left.one_le_mul hx <| Left.one_le_pow_of_le hx
#align left.one_le_pow_of_le Left.one_le_pow_of_le
#align left.pow_nonneg Left.pow_nonneg

@[to_additive Left.pow_nonpos]
theorem Left.pow_le_one_of_le (hx : x ≤ 1) : ∀ {n : ℕ}, x ^ n ≤ 1
  | 0 => (pow_zero _).le
  | n + 1 => by
    rw [pow_succ]
    exact Left.mul_le_one hx <| Left.pow_le_one_of_le hx
#align left.pow_le_one_of_le Left.pow_le_one_of_le
#align left.pow_nonpos Left.pow_nonpos

end Left

section Right

variable [CovariantClass M M (swap (· * ·)) (· ≤ ·)] {x : M}

@[to_additive Right.pow_nonneg]
theorem Right.one_le_pow_of_le (hx : 1 ≤ x) : ∀ {n : ℕ}, 1 ≤ x ^ n
  | 0 => (pow_zero _).ge
  | n + 1 => by
    rw [pow_succ]
    exact Right.one_le_mul hx <| Right.one_le_pow_of_le hx
#align right.one_le_pow_of_le Right.one_le_pow_of_le
#align right.pow_nonneg Right.pow_nonneg

@[to_additive Right.pow_nonpos]
theorem Right.pow_le_one_of_le (hx : x ≤ 1) : ∀ {n : ℕ}, x ^ n ≤ 1
  | 0 => (pow_zero _).le
  | n + 1 => by
    rw [pow_succ]
    exact Right.mul_le_one hx <| Right.pow_le_one_of_le hx
#align right.pow_le_one_of_le Right.pow_le_one_of_le
#align right.pow_nonpos Right.pow_nonpos

end Right

section CovariantLtSwap

variable [Preorder β] [CovariantClass M M (· * ·) (· < ·)]
  [CovariantClass M M (swap (· * ·)) (· < ·)] {f : β → M}

@[to_additive StrictMono.nsmul_left]
theorem StrictMono.pow_right' (hf : StrictMono f) : ∀ {n : ℕ}, n ≠ 0 → StrictMono fun a => f a ^ n
  | 0, hn => (hn rfl).elim
  | 1, _ => by simpa
  | Nat.succ <| Nat.succ n, _ => by
    simp_rw [pow_succ _ (n + 1)]
    exact hf.mul' (StrictMono.pow_right' hf n.succ_ne_zero)
#align strict_mono.pow_right' StrictMono.pow_right'
#align strict_mono.nsmul_left StrictMono.nsmul_left

/-- See also `pow_strictMono_right` -/
@[to_additive nsmul_strictMono_left]  -- Porting note: nolint to_additive_doc
theorem pow_strictMono_right' {n : ℕ} (hn : n ≠ 0) : StrictMono fun a : M => a ^ n :=
  strictMono_id.pow_right' hn
#align pow_strict_mono_right' pow_strictMono_right'
#align nsmul_strict_mono_left nsmul_strictMono_left

end CovariantLtSwap

section CovariantLeSwap

variable [Preorder β] [CovariantClass M M (· * ·) (· ≤ ·)]
  [CovariantClass M M (swap (· * ·)) (· ≤ ·)]

@[to_additive Monotone.nsmul_left]
theorem Monotone.pow_right {f : β → M} (hf : Monotone f) : ∀ n : ℕ, Monotone fun a => f a ^ n
  | 0 => by simpa using monotone_const
  | n + 1 => by
    simp_rw [pow_succ]
    exact hf.mul' (Monotone.pow_right hf _)
#align monotone.pow_right Monotone.pow_right
#align monotone.nsmul_left Monotone.nsmul_left

@[to_additive nsmul_mono_left]
theorem pow_mono_right (n : ℕ) : Monotone fun a : M => a ^ n :=
  monotone_id.pow_right _
#align pow_mono_right pow_mono_right
#align nsmul_mono_left nsmul_mono_left

end CovariantLeSwap

@[to_additive Left.pow_neg]
theorem Left.pow_lt_one_of_lt [CovariantClass M M (· * ·) (· < ·)] {n : ℕ} {x : M} (hn : 0 < n)
    (h : x < 1) : x ^ n < 1 :=
  Nat.le_induction ((pow_one _).trans_lt h)
    (fun n _ ih => by
      rw [pow_succ]
      exact mul_lt_one h ih)
    _ (Nat.succ_le_iff.2 hn)
#align left.pow_lt_one_of_lt Left.pow_lt_one_of_lt
#align left.pow_neg Left.pow_neg

@[to_additive Right.pow_neg]
theorem Right.pow_lt_one_of_lt [CovariantClass M M (swap (· * ·)) (· < ·)] {n : ℕ} {x : M}
    (hn : 0 < n) (h : x < 1) : x ^ n < 1 :=
  Nat.le_induction ((pow_one _).trans_lt h)
    (fun n _ ih => by
      rw [pow_succ]
      exact Right.mul_lt_one h ih)
    _ (Nat.succ_le_iff.2 hn)
#align right.pow_lt_one_of_lt Right.pow_lt_one_of_lt
#align right.pow_neg Right.pow_neg

end Preorder

section LinearOrder

variable [LinearOrder M]

section CovariantLe

variable [CovariantClass M M (· * ·) (· ≤ ·)]

@[to_additive nsmul_nonneg_iff]
theorem one_le_pow_iff {x : M} {n : ℕ} (hn : n ≠ 0) : 1 ≤ x ^ n ↔ 1 ≤ x :=
  ⟨le_imp_le_of_lt_imp_lt fun h => pow_lt_one' h hn, fun h => one_le_pow_of_one_le' h n⟩
#align one_le_pow_iff one_le_pow_iff
#align nsmul_nonneg_iff nsmul_nonneg_iff

@[to_additive]
theorem pow_le_one_iff {x : M} {n : ℕ} (hn : n ≠ 0) : x ^ n ≤ 1 ↔ x ≤ 1 :=
  @one_le_pow_iff Mᵒᵈ _ _ _ _ _ hn
#align pow_le_one_iff pow_le_one_iff
#align nsmul_nonpos_iff nsmul_nonpos_iff

@[to_additive nsmul_pos_iff]
theorem one_lt_pow_iff {x : M} {n : ℕ} (hn : n ≠ 0) : 1 < x ^ n ↔ 1 < x :=
  lt_iff_lt_of_le_iff_le (pow_le_one_iff hn)
#align one_lt_pow_iff one_lt_pow_iff
#align nsmul_pos_iff nsmul_pos_iff

@[to_additive]
theorem pow_lt_one_iff {x : M} {n : ℕ} (hn : n ≠ 0) : x ^ n < 1 ↔ x < 1 :=
  lt_iff_lt_of_le_iff_le (one_le_pow_iff hn)
#align pow_lt_one_iff pow_lt_one_iff
#align nsmul_neg_iff nsmul_neg_iff

@[to_additive]
theorem pow_eq_one_iff {x : M} {n : ℕ} (hn : n ≠ 0) : x ^ n = 1 ↔ x = 1 := by
  simp only [le_antisymm_iff]
  rw [pow_le_one_iff hn, one_le_pow_iff hn]

#align pow_eq_one_iff pow_eq_one_iff
#align nsmul_eq_zero_iff nsmul_eq_zero_iff

variable [CovariantClass M M (· * ·) (· < ·)] {a : M} {m n : ℕ}

@[to_additive nsmul_le_nsmul_iff]
theorem pow_le_pow_iff' (ha : 1 < a) : a ^ m ≤ a ^ n ↔ m ≤ n :=
  (pow_strictMono_left ha).le_iff_le
#align pow_le_pow_iff' pow_le_pow_iff'
#align nsmul_le_nsmul_iff nsmul_le_nsmul_iff

@[to_additive nsmul_lt_nsmul_iff]
theorem pow_lt_pow_iff' (ha : 1 < a) : a ^ m < a ^ n ↔ m < n :=
  (pow_strictMono_left ha).lt_iff_lt
#align pow_lt_pow_iff' pow_lt_pow_iff'
#align nsmul_lt_nsmul_iff nsmul_lt_nsmul_iff

end CovariantLe

section CovariantLeSwap

variable [CovariantClass M M (· * ·) (· ≤ ·)] [CovariantClass M M (swap (· * ·)) (· ≤ ·)]

@[to_additive lt_of_nsmul_lt_nsmul]
theorem lt_of_pow_lt_pow' {a b : M} (n : ℕ) : a ^ n < b ^ n → a < b :=
  (pow_mono_right _).reflect_lt
#align lt_of_pow_lt_pow' lt_of_pow_lt_pow'
#align lt_of_nsmul_lt_nsmul lt_of_nsmul_lt_nsmul

@[to_additive]
theorem min_lt_max_of_mul_lt_mul {a b c d : M} (h : a * b < c * d) : min a b < max c d :=
  lt_of_pow_lt_pow' 2 <| by
    simp_rw [pow_two]
    exact
      (mul_le_mul' inf_le_left inf_le_right).trans_lt
        (h.trans_le <| mul_le_mul' le_sup_left le_sup_right)
#align min_lt_max_of_mul_lt_mul min_lt_max_of_mul_lt_mul
#align min_lt_max_of_add_lt_add min_lt_max_of_add_lt_add

@[to_additive min_lt_of_add_lt_two_nsmul]
theorem min_lt_of_mul_lt_sq {a b c : M} (h : a * b < c ^ 2) : min a b < c := by
  simpa using min_lt_max_of_mul_lt_mul (h.trans_eq <| pow_two _)
#align min_lt_of_mul_lt_sq min_lt_of_mul_lt_sq
#align min_lt_of_add_lt_two_nsmul min_lt_of_add_lt_two_nsmul

@[to_additive lt_max_of_two_nsmul_lt_add]
theorem lt_max_of_sq_lt_mul {a b c : M} (h : a ^ 2 < b * c) : a < max b c := by
  simpa using min_lt_max_of_mul_lt_mul ((pow_two _).symm.trans_lt h)
#align lt_max_of_sq_lt_mul lt_max_of_sq_lt_mul
#align lt_max_of_two_nsmul_lt_add lt_max_of_two_nsmul_lt_add

end CovariantLeSwap

section CovariantLtSwap

variable [CovariantClass M M (· * ·) (· < ·)] [CovariantClass M M (swap (· * ·)) (· < ·)]

@[to_additive le_of_nsmul_le_nsmul]
theorem le_of_pow_le_pow' {a b : M} {n : ℕ} (hn : n ≠ 0) : a ^ n ≤ b ^ n → a ≤ b :=
  (pow_strictMono_right' hn).le_iff_le.1
#align le_of_pow_le_pow' le_of_pow_le_pow'
#align le_of_nsmul_le_nsmul le_of_nsmul_le_nsmul

@[to_additive min_le_of_add_le_two_nsmul]
theorem min_le_of_mul_le_sq {a b c : M} (h : a * b ≤ c ^ 2) : min a b ≤ c := by
  simpa using min_le_max_of_mul_le_mul (h.trans_eq <| pow_two _)
#align min_le_of_mul_le_sq min_le_of_mul_le_sq
#align min_le_of_add_le_two_nsmul min_le_of_add_le_two_nsmul

@[to_additive le_max_of_two_nsmul_le_add]
theorem le_max_of_sq_le_mul {a b c : M} (h : a ^ 2 ≤ b * c) : a ≤ max b c := by
  simpa using min_le_max_of_mul_le_mul ((pow_two _).symm.trans_le h)
#align le_max_of_sq_le_mul le_max_of_sq_le_mul
#align le_max_of_two_nsmul_le_add le_max_of_two_nsmul_le_add

end CovariantLtSwap

@[to_additive Left.nsmul_neg_iff]
theorem Left.pow_lt_one_iff' [CovariantClass M M (· * ·) (· < ·)] {n : ℕ} {x : M} (hn : 0 < n) :
    x ^ n < 1 ↔ x < 1 :=
  haveI := Mul.to_covariantClass_left M
  pow_lt_one_iff hn.ne'
#align left.nsmul_neg_iff Left.nsmul_neg_iff

theorem Left.pow_lt_one_iff [CovariantClass M M (· * ·) (· < ·)] {n : ℕ} {x : M} (hn : 0 < n) :
    x ^ n < 1 ↔ x < 1 := Left.pow_lt_one_iff' hn
#align left.pow_lt_one_iff Left.pow_lt_one_iff

@[to_additive]
theorem Right.pow_lt_one_iff [CovariantClass M M (swap (· * ·)) (· < ·)] {n : ℕ} {x : M}
    (hn : 0 < n) : x ^ n < 1 ↔ x < 1 :=
  ⟨fun H =>
    not_le.mp fun k =>
      H.not_le <|
        haveI := Mul.to_covariantClass_right M
        Right.one_le_pow_of_le k,
    Right.pow_lt_one_of_lt hn⟩
#align right.pow_lt_one_iff Right.pow_lt_one_iff
#align right.nsmul_neg_iff Right.nsmul_neg_iff

end LinearOrder

end Monoid

section DivInvMonoid

variable [DivInvMonoid G] [Preorder G] [CovariantClass G G (· * ·) (· ≤ ·)]

@[to_additive zsmul_nonneg]
theorem one_le_zpow {x : G} (H : 1 ≤ x) {n : ℤ} (hn : 0 ≤ n) : 1 ≤ x ^ n := by
  lift n to ℕ using hn
  rw [zpow_ofNat]
  apply one_le_pow_of_one_le' H
#align one_le_zpow one_le_zpow
#align zsmul_nonneg zsmul_nonneg

end DivInvMonoid

namespace CanonicallyOrderedCommSemiring

variable [CanonicallyOrderedCommSemiring R]

theorem pow_pos {a : R} (H : 0 < a) (n : ℕ) : 0 < a ^ n :=
  pos_iff_ne_zero.2 <| pow_ne_zero _ H.ne'
#align canonically_ordered_comm_semiring.pow_pos CanonicallyOrderedCommSemiring.pow_pos

end CanonicallyOrderedCommSemiring

section OrderedSemiring

variable [OrderedSemiring R] {a x y : R} {n m : ℕ}

theorem zero_pow_le_one : ∀ n : ℕ, (0 : R) ^ n ≤ 1
  | 0 => (pow_zero _).le
  | n + 1 => by
    rw [zero_pow n.succ_pos]
    exact zero_le_one
#align zero_pow_le_one zero_pow_le_one

theorem pow_add_pow_le (hx : 0 ≤ x) (hy : 0 ≤ y) (hn : n ≠ 0) : x ^ n + y ^ n ≤ (x + y) ^ n := by
  rcases Nat.exists_eq_succ_of_ne_zero hn with ⟨k, rfl⟩
  induction' k with k ih;
  . have eqn : Nat.succ Nat.zero = 1 := rfl
    rw [eqn]
    simp only [pow_one, le_refl]
  . let n := k.succ
    have h1 := add_nonneg (mul_nonneg hx (pow_nonneg hy n)) (mul_nonneg hy (pow_nonneg hx n))
    have h2 := add_nonneg hx hy
    calc
      x ^ n.succ + y ^ n.succ ≤ x * x ^ n + y * y ^ n + (x * y ^ n + y * x ^ n) :=
      by
        rw [pow_succ _ n, pow_succ _ n]
        exact le_add_of_nonneg_right h1
      _ = (x + y) * (x ^ n + y ^ n) :=
      by
        rw [add_mul, mul_add, mul_add, add_comm (y * x ^ n), ← add_assoc, ← add_assoc,
          add_assoc (x * x ^ n) (x * y ^ n), add_comm (x * y ^ n) (y * y ^ n), ← add_assoc]
      _ ≤ (x + y) ^ n.succ :=
      by
        rw [pow_succ _ n]
        exact mul_le_mul_of_nonneg_left (ih (Nat.succ_ne_zero k)) h2

#align pow_add_pow_le pow_add_pow_le

theorem pow_le_one : ∀ (n : ℕ) (_ : 0 ≤ a) (_ : a ≤ 1), a ^ n ≤ 1
  | 0, _, _ => (pow_zero a).le
  | n + 1, h₀, h₁ => (pow_succ' a n).le.trans (mul_le_one (pow_le_one n h₀ h₁) h₀ h₁)
#align pow_le_one pow_le_one

theorem pow_lt_one (h₀ : 0 ≤ a) (h₁ : a < 1) : ∀ {n : ℕ} (_ : n ≠ 0), a ^ n < 1
  | 0, h => (h rfl).elim
  | n + 1, _ => by
    rw [pow_succ]
    exact mul_lt_one_of_nonneg_of_lt_one_left h₀ h₁ (pow_le_one _ h₀ h₁.le)
#align pow_lt_one pow_lt_one

theorem one_le_pow_of_one_le (H : 1 ≤ a) : ∀ n : ℕ, 1 ≤ a ^ n
  | 0 => by rw [pow_zero]
  | n + 1 => by
    rw [pow_succ]
    simpa only [mul_one] using
      mul_le_mul H (one_le_pow_of_one_le H n) zero_le_one (le_trans zero_le_one H)
#align one_le_pow_of_one_le one_le_pow_of_one_le

theorem pow_mono (h : 1 ≤ a) : Monotone fun n : ℕ => a ^ n :=
  monotone_nat_of_le_succ fun n => by
    rw [pow_succ]
    exact le_mul_of_one_le_left (pow_nonneg (zero_le_one.trans h) _) h
#align pow_mono pow_mono

theorem pow_le_pow (ha : 1 ≤ a) (h : n ≤ m) : a ^ n ≤ a ^ m :=
  pow_mono ha h
#align pow_le_pow pow_le_pow

theorem le_self_pow (ha : 1 ≤ a) (h : m ≠ 0) : a ≤ a ^ m :=
  (pow_one a).symm.trans_le (pow_le_pow ha <| pos_iff_ne_zero.mpr h)
#align le_self_pow le_self_pow

@[mono]
theorem pow_le_pow_of_le_left {a b : R} (ha : 0 ≤ a) (hab : a ≤ b) : ∀ i : ℕ, a ^ i ≤ b ^ i := by
  intro i
  induction i with
  | zero =>  simp
  | succ k ih =>
    rw [pow_succ, pow_succ]
    apply mul_le_mul hab
    apply ih
    apply pow_nonneg ha
    apply le_trans ha hab
#align pow_le_pow_of_le_left pow_le_pow_of_le_left

theorem one_lt_pow (ha : 1 < a) : ∀ {n : ℕ} (_ : n ≠ 0), 1 < a ^ n
  | 0, h => (h rfl).elim
  | n + 1, _ => by
    rw [pow_succ]
    exact one_lt_mul_of_lt_of_le ha (one_le_pow_of_one_le ha.le _)
#align one_lt_pow one_lt_pow

end OrderedSemiring

section StrictOrderedSemiring

variable [StrictOrderedSemiring R] {a x y : R} {n m : ℕ}

theorem pow_lt_pow_of_lt_left (h : x < y) (hx : 0 ≤ x) : ∀ {n : ℕ}, 0 < n → x ^ n < y ^ n
  | 0, hn => by contradiction
  | n + 1, _ => by
    simpa only [pow_succ'] using
      mul_lt_mul_of_le_of_le' (pow_le_pow_of_le_left hx h.le _) h (pow_pos (hx.trans_lt h) _) hx
#align pow_lt_pow_of_lt_left pow_lt_pow_of_lt_left

theorem strictMonoOn_pow (hn : 0 < n) : StrictMonoOn (fun x : R => x ^ n) (Set.Ici 0) :=
  fun _ hx _ _ h => pow_lt_pow_of_lt_left h hx hn
#align strict_mono_on_pow strictMonoOn_pow

theorem pow_strictMono_right (h : 1 < a) : StrictMono fun n : ℕ => a ^ n :=
  have : 0 < a := zero_le_one.trans_lt h
  strictMono_nat_of_lt_succ fun n => by
    simpa only [one_mul, pow_succ] using mul_lt_mul h (le_refl (a ^ n)) (pow_pos this _) this.le
#align pow_strict_mono_right pow_strictMono_right

theorem pow_lt_pow (h : 1 < a) (h2 : n < m) : a ^ n < a ^ m :=
  pow_strictMono_right h h2
#align pow_lt_pow pow_lt_pow

theorem pow_lt_pow_iff (h : 1 < a) : a ^ n < a ^ m ↔ n < m :=
  (pow_strictMono_right h).lt_iff_lt
#align pow_lt_pow_iff pow_lt_pow_iff

theorem pow_le_pow_iff (h : 1 < a) : a ^ n ≤ a ^ m ↔ n ≤ m :=
  (pow_strictMono_right h).le_iff_le
#align pow_le_pow_iff pow_le_pow_iff

theorem strictAnti_pow (h₀ : 0 < a) (h₁ : a < 1) : StrictAnti fun n : ℕ => a ^ n :=
  strictAnti_nat_of_succ_lt fun n => by
    simpa only [pow_succ, one_mul] using mul_lt_mul h₁ le_rfl (pow_pos h₀ n) zero_le_one
#align strict_anti_pow strictAnti_pow

theorem pow_lt_pow_iff_of_lt_one (h₀ : 0 < a) (h₁ : a < 1) : a ^ m < a ^ n ↔ n < m :=
  (strictAnti_pow h₀ h₁).lt_iff_lt
#align pow_lt_pow_iff_of_lt_one pow_lt_pow_iff_of_lt_one

theorem pow_lt_pow_of_lt_one (h : 0 < a) (ha : a < 1) {i j : ℕ} (hij : i < j) : a ^ j < a ^ i :=
  (pow_lt_pow_iff_of_lt_one h ha).2 hij
#align pow_lt_pow_of_lt_one pow_lt_pow_of_lt_one

theorem pow_lt_self_of_lt_one (h₀ : 0 < a) (h₁ : a < 1) (hn : 1 < n) : a ^ n < a :=
  calc
    a ^ n < a ^ 1 := pow_lt_pow_of_lt_one h₀ h₁ hn
    _ = a := pow_one _

#align pow_lt_self_of_lt_one pow_lt_self_of_lt_one

theorem sq_pos_of_pos (ha : 0 < a) : 0 < a ^ 2 := by
  rw [sq]
  exact mul_pos ha ha
#align sq_pos_of_pos sq_pos_of_pos

end StrictOrderedSemiring

section StrictOrderedRing
set_option linter.deprecated false

variable [StrictOrderedRing R] {a : R}

theorem pow_bit0_pos_of_neg (ha : a < 0) (n : ℕ) : 0 < a ^ bit0 n := by
  rw [pow_bit0']
  exact pow_pos (mul_pos_of_neg_of_neg ha ha) _
#align pow_bit0_pos_of_neg pow_bit0_pos_of_neg

theorem pow_bit1_neg (ha : a < 0) (n : ℕ) : a ^ bit1 n < 0 := by
  rw [bit1, pow_succ]
  exact mul_neg_of_neg_of_pos ha (pow_bit0_pos_of_neg ha n)
#align pow_bit1_neg pow_bit1_neg

theorem sq_pos_of_neg (ha : a < 0) : 0 < a ^ 2 :=
  pow_bit0_pos_of_neg ha 1
#align sq_pos_of_neg sq_pos_of_neg

end StrictOrderedRing

section LinearOrderedSemiring

variable [LinearOrderedSemiring R] {a b : R}

theorem pow_le_one_iff_of_nonneg {a : R} (ha : 0 ≤ a) {n : ℕ} (hn : n ≠ 0) : a ^ n ≤ 1 ↔ a ≤ 1 := by
  refine' ⟨_, pow_le_one n ha⟩
  rw [← not_lt, ← not_lt]
  exact mt fun h => one_lt_pow h hn
#align pow_le_one_iff_of_nonneg pow_le_one_iff_of_nonneg

theorem one_le_pow_iff_of_nonneg {a : R} (ha : 0 ≤ a) {n : ℕ} (hn : n ≠ 0) : 1 ≤ a ^ n ↔ 1 ≤ a := by
  refine' ⟨_, fun h => one_le_pow_of_one_le h n⟩
  rw [← not_lt, ← not_lt]
  exact mt fun h => pow_lt_one ha h hn
#align one_le_pow_iff_of_nonneg one_le_pow_iff_of_nonneg

theorem one_lt_pow_iff_of_nonneg {a : R} (ha : 0 ≤ a) {n : ℕ} (hn : n ≠ 0) : 1 < a ^ n ↔ 1 < a :=
  lt_iff_lt_of_le_iff_le (pow_le_one_iff_of_nonneg ha hn)
#align one_lt_pow_iff_of_nonneg one_lt_pow_iff_of_nonneg

theorem pow_lt_one_iff_of_nonneg {a : R} (ha : 0 ≤ a) {n : ℕ} (hn : n ≠ 0) : a ^ n < 1 ↔ a < 1 :=
  lt_iff_lt_of_le_iff_le (one_le_pow_iff_of_nonneg ha hn)
#align pow_lt_one_iff_of_nonneg pow_lt_one_iff_of_nonneg

theorem sq_le_one_iff {a : R} (ha : 0 ≤ a) : a ^ 2 ≤ 1 ↔ a ≤ 1 :=
  pow_le_one_iff_of_nonneg ha (Nat.succ_ne_zero _)
#align sq_le_one_iff sq_le_one_iff

theorem sq_lt_one_iff {a : R} (ha : 0 ≤ a) : a ^ 2 < 1 ↔ a < 1 :=
  pow_lt_one_iff_of_nonneg ha (Nat.succ_ne_zero _)
#align sq_lt_one_iff sq_lt_one_iff

theorem one_le_sq_iff {a : R} (ha : 0 ≤ a) : 1 ≤ a ^ 2 ↔ 1 ≤ a :=
  one_le_pow_iff_of_nonneg ha (Nat.succ_ne_zero _)
#align one_le_sq_iff one_le_sq_iff

theorem one_lt_sq_iff {a : R} (ha : 0 ≤ a) : 1 < a ^ 2 ↔ 1 < a :=
  one_lt_pow_iff_of_nonneg ha (Nat.succ_ne_zero _)
#align one_lt_sq_iff one_lt_sq_iff

@[simp]
theorem pow_left_inj {x y : R} {n : ℕ} (Hxpos : 0 ≤ x) (Hypos : 0 ≤ y) (Hnpos : 0 < n) :
    x ^ n = y ^ n ↔ x = y :=
  (@strictMonoOn_pow R _ _ Hnpos).eq_iff_eq Hxpos Hypos
#align pow_left_inj pow_left_inj

theorem lt_of_pow_lt_pow {a b : R} (n : ℕ) (hb : 0 ≤ b) (h : a ^ n < b ^ n) : a < b :=
  lt_of_not_ge fun hn => not_lt_of_ge (pow_le_pow_of_le_left hb hn _) h
#align lt_of_pow_lt_pow lt_of_pow_lt_pow

theorem le_of_pow_le_pow {a b : R} (n : ℕ) (hb : 0 ≤ b) (hn : 0 < n) (h : a ^ n ≤ b ^ n) : a ≤ b :=
  le_of_not_lt fun h1 => not_le_of_lt (pow_lt_pow_of_lt_left h1 hb hn) h
#align le_of_pow_le_pow le_of_pow_le_pow

@[simp]
theorem sq_eq_sq {a b : R} (ha : 0 ≤ a) (hb : 0 ≤ b) : a ^ 2 = b ^ 2 ↔ a = b :=
  pow_left_inj ha hb (by decide)
#align sq_eq_sq sq_eq_sq

theorem lt_of_mul_self_lt_mul_self (hb : 0 ≤ b) : a * a < b * b → a < b := by
  simp_rw [← sq]
  exact lt_of_pow_lt_pow _ hb
#align lt_of_mul_self_lt_mul_self lt_of_mul_self_lt_mul_self

end LinearOrderedSemiring

section LinearOrderedRing

variable [LinearOrderedRing R]

theorem pow_abs (a : R) (n : ℕ) : |a| ^ n = |a ^ n| :=
  ((absHom.toMonoidHom : R →* R).map_pow a n).symm
#align pow_abs pow_abs

theorem abs_neg_one_pow (n : ℕ) : |(-1 : R) ^ n| = 1 := by rw [← pow_abs, abs_neg, abs_one, one_pow]
#align abs_neg_one_pow abs_neg_one_pow

section
set_option linter.deprecated false

theorem pow_bit0_nonneg (a : R) (n : ℕ) : 0 ≤ a ^ bit0 n := by
  rw [pow_bit0]
  exact mul_self_nonneg _
#align pow_bit0_nonneg pow_bit0_nonneg

theorem sq_nonneg (a : R) : 0 ≤ a ^ 2 :=
  pow_bit0_nonneg a 1
#align sq_nonneg sq_nonneg

alias sq_nonneg ← pow_two_nonneg
#align pow_two_nonneg pow_two_nonneg

theorem pow_bit0_pos {a : R} (h : a ≠ 0) (n : ℕ) : 0 < a ^ bit0 n :=
  (pow_bit0_nonneg a n).lt_of_ne (pow_ne_zero _ h).symm
#align pow_bit0_pos pow_bit0_pos

theorem sq_pos_of_ne_zero (a : R) (h : a ≠ 0) : 0 < a ^ 2 :=
  pow_bit0_pos h 1
#align sq_pos_of_ne_zero sq_pos_of_ne_zero

alias sq_pos_of_ne_zero ← pow_two_pos_of_ne_zero
#align pow_two_pos_of_ne_zero pow_two_pos_of_ne_zero

theorem pow_bit0_pos_iff (a : R) {n : ℕ} (hn : n ≠ 0) : 0 < a ^ bit0 n ↔ a ≠ 0 := by
  refine' ⟨fun h => _, fun h => pow_bit0_pos h n⟩
  rintro rfl
  rw [zero_pow (Nat.zero_lt_bit0 hn)] at h
  exact lt_irrefl _ h
#align pow_bit0_pos_iff pow_bit0_pos_iff

end

theorem sq_pos_iff (a : R) : 0 < a ^ 2 ↔ a ≠ 0 :=
  pow_bit0_pos_iff a one_ne_zero
#align sq_pos_iff sq_pos_iff

variable {x y : R}

theorem sq_abs (x : R) : |x| ^ 2 = x ^ 2 := by simpa only [sq] using abs_mul_abs_self x
#align sq_abs sq_abs

theorem abs_sq (x : R) : |x ^ 2| = x ^ 2 := by simpa only [sq] using abs_mul_self x
#align abs_sq abs_sq

theorem sq_lt_sq : x ^ 2 < y ^ 2 ↔ |x| < |y| := by
  simpa only [sq_abs] using
    (@strictMonoOn_pow R _ _ two_pos).lt_iff_lt (abs_nonneg x) (abs_nonneg y)
#align sq_lt_sq sq_lt_sq

theorem sq_lt_sq' (h1 : -y < x) (h2 : x < y) : x ^ 2 < y ^ 2 :=
  sq_lt_sq.2 (lt_of_lt_of_le (abs_lt.2 ⟨h1, h2⟩) (le_abs_self _))
#align sq_lt_sq' sq_lt_sq'

theorem sq_le_sq : x ^ 2 ≤ y ^ 2 ↔ |x| ≤ |y| := by
  simpa only [sq_abs] using
    (@strictMonoOn_pow R _ _ two_pos).le_iff_le (abs_nonneg x) (abs_nonneg y)
#align sq_le_sq sq_le_sq

theorem sq_le_sq' (h1 : -y ≤ x) (h2 : x ≤ y) : x ^ 2 ≤ y ^ 2 :=
  sq_le_sq.2 (le_trans (abs_le.mpr ⟨h1, h2⟩) (le_abs_self _))
#align sq_le_sq' sq_le_sq'

theorem abs_lt_of_sq_lt_sq (h : x ^ 2 < y ^ 2) (hy : 0 ≤ y) : |x| < y := by
  rwa [← abs_of_nonneg hy, ← sq_lt_sq]
#align abs_lt_of_sq_lt_sq abs_lt_of_sq_lt_sq

theorem abs_lt_of_sq_lt_sq' (h : x ^ 2 < y ^ 2) (hy : 0 ≤ y) : -y < x ∧ x < y :=
  abs_lt.mp <| abs_lt_of_sq_lt_sq h hy
#align abs_lt_of_sq_lt_sq' abs_lt_of_sq_lt_sq'

theorem abs_le_of_sq_le_sq (h : x ^ 2 ≤ y ^ 2) (hy : 0 ≤ y) : |x| ≤ y := by
  rwa [← abs_of_nonneg hy, ← sq_le_sq]
#align abs_le_of_sq_le_sq abs_le_of_sq_le_sq

theorem abs_le_of_sq_le_sq' (h : x ^ 2 ≤ y ^ 2) (hy : 0 ≤ y) : -y ≤ x ∧ x ≤ y :=
  abs_le.mp <| abs_le_of_sq_le_sq h hy
#align abs_le_of_sq_le_sq' abs_le_of_sq_le_sq'

theorem sq_eq_sq_iff_abs_eq_abs (x y : R) : x ^ 2 = y ^ 2 ↔ |x| = |y| := by
  simp only [le_antisymm_iff, sq_le_sq]
#align sq_eq_sq_iff_abs_eq_abs sq_eq_sq_iff_abs_eq_abs

@[simp]
theorem sq_le_one_iff_abs_le_one (x : R) : x ^ 2 ≤ 1 ↔ |x| ≤ 1 := by
  simpa only [one_pow, abs_one] using @sq_le_sq _ _ x 1
#align sq_le_one_iff_abs_le_one sq_le_one_iff_abs_le_one

@[simp]
theorem sq_lt_one_iff_abs_lt_one (x : R) : x ^ 2 < 1 ↔ |x| < 1 := by
  simpa only [one_pow, abs_one] using @sq_lt_sq _ _ x 1
#align sq_lt_one_iff_abs_lt_one sq_lt_one_iff_abs_lt_one

@[simp]
theorem one_le_sq_iff_one_le_abs (x : R) : 1 ≤ x ^ 2 ↔ 1 ≤ |x| := by
  simpa only [one_pow, abs_one] using @sq_le_sq _ _ 1 x
#align one_le_sq_iff_one_le_abs one_le_sq_iff_one_le_abs

@[simp]
theorem one_lt_sq_iff_one_lt_abs (x : R) : 1 < x ^ 2 ↔ 1 < |x| := by
  simpa only [one_pow, abs_one] using @sq_lt_sq _ _ 1 x
#align one_lt_sq_iff_one_lt_abs one_lt_sq_iff_one_lt_abs

theorem pow_four_le_pow_two_of_pow_two_le {x y : R} (h : x ^ 2 ≤ y) : x ^ 4 ≤ y ^ 2 :=
  (pow_mul x 2 2).symm ▸ pow_le_pow_of_le_left (sq_nonneg x) h 2
#align pow_four_le_pow_two_of_pow_two_le pow_four_le_pow_two_of_pow_two_le

end LinearOrderedRing

section LinearOrderedCommRing

variable [LinearOrderedCommRing R]

/-- Arithmetic mean-geometric mean (AM-GM) inequality for linearly ordered commutative rings. -/
theorem two_mul_le_add_sq (a b : R) : 2 * a * b ≤ a ^ 2 + b ^ 2 :=
  sub_nonneg.mp ((sub_add_eq_add_sub _ _ _).subst ((sub_sq a b).subst (sq_nonneg _)))
#align two_mul_le_add_sq two_mul_le_add_sq

alias two_mul_le_add_sq ← two_mul_le_add_pow_two
#align two_mul_le_add_pow_two two_mul_le_add_pow_two

end LinearOrderedCommRing

section LinearOrderedCommMonoidWithZero

variable [LinearOrderedCommMonoidWithZero M] [NoZeroDivisors M] {a : M} {n : ℕ}

theorem pow_pos_iff (hn : 0 < n) : 0 < a ^ n ↔ 0 < a := by
  simp_rw [zero_lt_iff, pow_ne_zero_iff hn]
  rw [pow_ne_zero_iff]
  assumption
#align pow_pos_iff pow_pos_iff

end LinearOrderedCommMonoidWithZero

section LinearOrderedCommGroupWithZero

variable [LinearOrderedCommGroupWithZero M] {a : M} {m n : ℕ}

theorem pow_lt_pow_succ (ha : 1 < a) : a ^ n < a ^ n.succ := by
  rw [← one_mul (a ^ n), pow_succ]
  exact mul_lt_right₀ _ ha (pow_ne_zero _ (zero_lt_one.trans ha).ne')
#align pow_lt_pow_succ pow_lt_pow_succ

theorem pow_lt_pow₀ (ha : 1 < a) (hmn : m < n) : a ^ m < a ^ n := by
  induction' hmn with n _ ih
  exacts[pow_lt_pow_succ ha, lt_trans ih (pow_lt_pow_succ ha)]
#align pow_lt_pow₀ pow_lt_pow₀

end LinearOrderedCommGroupWithZero

namespace MonoidHom

variable [Ring R] [Monoid M] [LinearOrder M] [CovariantClass M M (· * ·) (· ≤ ·)] (f : R →* M)

theorem map_neg_one : f (-1) = 1 :=
  (pow_eq_one_iff (Nat.succ_ne_zero 1)).1 <| by rw [← map_pow, neg_one_sq, map_one]
#align monoid_hom.map_neg_one MonoidHom.map_neg_one

@[simp]
theorem map_neg (x : R) : f (-x) = f x := by rw [← neg_one_mul, map_mul, map_neg_one, one_mul]
#align monoid_hom.map_neg MonoidHom.map_neg

theorem map_sub_swap (x y : R) : f (x - y) = f (y - x) := by rw [← map_neg, neg_sub]
#align monoid_hom.map_sub_swap MonoidHom.map_sub_swap

end MonoidHom


/-
Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro

! This file was ported from Lean 3 source module data.nat.units
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Basic
import Mathbin.Algebra.Group.Units

/-! # The units of the natural numbers as a `monoid` and `add_monoid`

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

namespace Nat

/- warning: nat.units_eq_one -> Nat.units_eq_one is a dubious translation:
lean 3 declaration is
  forall (u : Units.{0} Nat Nat.monoid), Eq.{1} (Units.{0} Nat Nat.monoid) u (OfNat.ofNat.{0} (Units.{0} Nat Nat.monoid) 1 (OfNat.mk.{0} (Units.{0} Nat Nat.monoid) 1 (One.one.{0} (Units.{0} Nat Nat.monoid) (MulOneClass.toHasOne.{0} (Units.{0} Nat Nat.monoid) (Units.mulOneClass.{0} Nat Nat.monoid)))))
but is expected to have type
  forall (u : Units.{0} Nat Nat.monoid), Eq.{1} (Units.{0} Nat Nat.monoid) u (OfNat.ofNat.{0} (Units.{0} Nat Nat.monoid) 1 (One.toOfNat1.{0} (Units.{0} Nat Nat.monoid) (InvOneClass.toOne.{0} (Units.{0} Nat Nat.monoid) (DivInvOneMonoid.toInvOneClass.{0} (Units.{0} Nat Nat.monoid) (DivisionMonoid.toDivInvOneMonoid.{0} (Units.{0} Nat Nat.monoid) (DivisionCommMonoid.toDivisionMonoid.{0} (Units.{0} Nat Nat.monoid) (CommGroup.toDivisionCommMonoid.{0} (Units.{0} Nat Nat.monoid) (Units.instCommGroupUnitsToMonoid.{0} Nat Nat.commMonoid))))))))
Case conversion may be inaccurate. Consider using '#align nat.units_eq_one Nat.units_eq_oneₓ'. -/
theorem units_eq_one (u : ℕˣ) : u = 1 :=
  Units.ext <| Nat.eq_one_of_dvd_one ⟨u.inv, u.val_inv.symm⟩
#align nat.units_eq_one Nat.units_eq_one

/- warning: nat.add_units_eq_zero -> Nat.addUnits_eq_zero is a dubious translation:
lean 3 declaration is
  forall (u : AddUnits.{0} Nat Nat.addMonoid), Eq.{1} (AddUnits.{0} Nat Nat.addMonoid) u (OfNat.ofNat.{0} (AddUnits.{0} Nat Nat.addMonoid) 0 (OfNat.mk.{0} (AddUnits.{0} Nat Nat.addMonoid) 0 (Zero.zero.{0} (AddUnits.{0} Nat Nat.addMonoid) (AddZeroClass.toHasZero.{0} (AddUnits.{0} Nat Nat.addMonoid) (AddUnits.addZeroClass.{0} Nat Nat.addMonoid)))))
but is expected to have type
  forall (u : AddUnits.{0} Nat Nat.addMonoid), Eq.{1} (AddUnits.{0} Nat Nat.addMonoid) u (OfNat.ofNat.{0} (AddUnits.{0} Nat Nat.addMonoid) 0 (Zero.toOfNat0.{0} (AddUnits.{0} Nat Nat.addMonoid) (NegZeroClass.toZero.{0} (AddUnits.{0} Nat Nat.addMonoid) (SubNegZeroMonoid.toNegZeroClass.{0} (AddUnits.{0} Nat Nat.addMonoid) (SubtractionMonoid.toSubNegZeroMonoid.{0} (AddUnits.{0} Nat Nat.addMonoid) (SubtractionCommMonoid.toSubtractionMonoid.{0} (AddUnits.{0} Nat Nat.addMonoid) (AddCommGroup.toDivisionAddCommMonoid.{0} (AddUnits.{0} Nat Nat.addMonoid) (AddUnits.instAddCommGroupAddUnitsToAddMonoid.{0} Nat Nat.addCommMonoid))))))))
Case conversion may be inaccurate. Consider using '#align nat.add_units_eq_zero Nat.addUnits_eq_zeroₓ'. -/
theorem addUnits_eq_zero (u : AddUnits ℕ) : u = 0 :=
  AddUnits.ext <| (Nat.eq_zero_of_add_eq_zero u.val_neg).1
#align nat.add_units_eq_zero Nat.addUnits_eq_zero

#print Nat.isUnit_iff /-
@[simp]
protected theorem isUnit_iff {n : ℕ} : IsUnit n ↔ n = 1 :=
  Iff.intro
    (fun ⟨u, hu⟩ =>
      match n, u, hu, Nat.units_eq_one u with
      | _, _, rfl, rfl => rfl)
    fun h => h.symm ▸ ⟨1, rfl⟩
#align nat.is_unit_iff Nat.isUnit_iff
-/

#print Nat.unique_units /-
instance unique_units : Unique ℕˣ where
  default := 1
  uniq := Nat.units_eq_one
#align nat.unique_units Nat.unique_units
-/

#print Nat.unique_addUnits /-
instance unique_addUnits : Unique (AddUnits ℕ)
    where
  default := 0
  uniq := Nat.addUnits_eq_zero
#align nat.unique_add_units Nat.unique_addUnits
-/

end Nat


import main
import split_cycle

open_locale classical

variables {V X : Type}

def condorcet_winner [fintype V] (P : Prof V X) (x : X) : Prop := ∀ y, x ≠ y → margin_pos P x y

--def condorcet_winner [fintype V] (P : Prof V X) (x : X) : Prop := ∀ y ≠ x, margin_pos P x y

def condorcet_loser [fintype V] (P : Prof V X) (x : X) : Prop := (∀ y, x ≠ y → margin_pos P y x) ∧ ∃ y, x ≠ y

def condorcet_criterion [fintype V] (F : VSCC) (P : Prof V X) : Prop := ∀ x, condorcet_winner P x → F V X P = {x}

def condorcet_loser_criterion [fintype V] (F : VSCC) (P : Prof V X) : Prop := ∀ x, condorcet_loser P x → x ∉ F V X P

lemma ineq {n : ℕ} (e : n > 1) : (n - 2).succ < n := by omega
lemma ineq2 {n : ℕ} (e : n > 1) : (n - 2).succ = (n - 1) := by omega

lemma gt_zero_of_ne_zero (i : ℕ) : i ≠ 0 → i > 0 := by omega

def condorcet_SCC [fintype V] : SCC V X := λ P, if c : (∃x, condorcet_winner P x) then {c.some} else set.univ

def condorcet_VSCC : VSCC := λ V X P, if f : (∃ [fintype V], true) then @condorcet_SCC V X f.some P else ∅

def split_cycle_condorcet_criterion [fintype V] (P : Prof V X) : condorcet_criterion split_cycle P :=
begin
    intro w,
    intro x_winner,
    unfold split_cycle,
    unfold split_cycle_VCCR,
    unfold split_cycle_CCR,
    unfold max_el_VSCC,
    simp,

    have no_cycles : ¬ ∃ l (e : cycle (margin_pos P) l), w ∈ l,
    by_contradiction a,
    cases a with l a,
    cases a with e a,
    have defeated := dominate_of_cycle l (margin_pos P) e w a,
    cases defeated with bad defeated,
    cases defeated with _ defeated,
    specialize x_winner bad,
    have ne : w ≠ bad,
    simp,
    by_contradiction a_1,
    rw a_1 at defeated,
    unfold margin_pos at defeated,
    rw self_margin_zero bad P at defeated,
    linarith,
    specialize x_winner ne,
    unfold margin_pos at *,
    have as := margin_antisymmetric P,
    unfold antisymmetric at as,
    specialize as bad w,
    rw as at defeated,
    linarith,

    ext1,
    split,
    intro a,
    specialize a w,
    apply of_not_not,
    by_contradiction a_1,
    specialize x_winner x,
    have x_winner := x_winner (ne.symm a_1),
    cases a with f a,
    unfold margin_pos at a,
    rw margin_eq_margin f _inst_1 P w x at a,
    have a := a x_winner,
    cases a with c a,
    cases a with w_mem a,
    cases a with x_mem cy,
    have contr : ∃ (l : list X) (e : cycle (margin_pos P) l), w ∈ l,
    use c,
    refine and.intro _ w_mem,
    have imp : ∀ e1 e2, (λ (a b : X), margin P w x ≤ margin P a b) e1 e2 → (margin_pos P) e1 e2,
        {intros e1 e2,
        simp,
        intro z,
        have o : ∀ (a b : ℤ), a > 0 → a ≤ b → b > 0 := by omega,
        exact o (margin P w x) (margin P e1 e2) x_winner z,},
    simp_rw margin_eq_margin f _inst_1 at cy,
    exact cycle_of_cycle_imp imp cy,

    exact no_cycles contr,

    intro eq,
    intro x_1,
    by_contradiction a,
    push_neg at a,
    specialize a _inst_1,
    cases a with a b,
    simp at eq,
    rw eq at a,
    specialize x_winner x_1,
    by_cases eq : x_1 = w,
    rw eq at a,
    unfold margin_pos at a,
    rw self_margin_zero w P at a,
    linarith,

    specialize x_winner (ne.symm eq),
    unfold margin_pos at *,
    have as := margin_antisymmetric P,
    unfold antisymmetric at as,
    specialize as x_1 w,
    rw as at a,
    linarith,
end

lemma margin_pos_irrefl [fintype V] (P : Prof V X) : ∀ x, ¬ margin_pos P x x :=
begin
    intro x, -- for any candidate x
    unfold margin_pos,
    unfold margin,
    linarith,
end

-- we should probably get the axioms out of the way for this. Is it a strict total order?
lemma margin_pos_asymm [fintype V] (P : Prof V X) : ∀ x y, margin_pos P x y → ¬ margin_pos P y x :=
begin
    intro x, intro y,
    unfold margin_pos,
    unfold margin,
    intro dominates,
    push_neg,
    linarith,
end

lemma condorcet_loser_ineq (a : ℤ) : (0 < a) → (-a ≤ 0) := by omega

def split_cycle_condorcet_loser_criterion [fintype V] (P : Prof V X) : condorcet_loser_criterion split_cycle P :=
begin
    intro x,
    intro x_loser,
    unfold split_cycle,
    unfold max_el_VSCC,
    simp,
    unfold condorcet_loser at x_loser,
    cases x_loser with a b,
    cases b with y b, -- consider the element y ≠ x guaranteed by condorcet_loser.
    use y, -- we will prove this element defeats x.
    unfold split_cycle_VCCR,
    introI _inst_2,
    split,
    unfold margin_pos,
    rw margin_eq_margin _inst_2 _inst_1,
    exact a y b,
    by_contradiction, -- we show there is no clemency cycle by contradiction
    cases h with l h,
    cases h with y_mem h,
    cases h with x_mem c,
    have dominates := dominates_of_cycle l (λ (a b : X), margin P y x ≤ margin P a b) c x x_mem,
    cases dominates with z dominates, -- let z be the element dominated by x
    cases dominates with z_mem dominates,
    have contr : margin P x z ≤ 0,
    specialize a z,
    by_cases x = z,
    rw h,
    rw self_margin_zero,
    specialize a h,
    unfold margin_pos at a,
    rw margin_antisymmetric,
    rw margin_eq_margin _inst_2 _inst_1,
    exact condorcet_loser_ineq (@margin V X _inst_1 P z x) a,
    have f := int.le_trans dominates contr,
    specialize a y, specialize a b,
    unfold margin_pos at a,
    rw margin_eq_margin _inst_2 _inst_1 at f,
    exact (not_lt.mpr f) a,
end


import data.nat.parity field_theory.finite.basic algebra.is_prime_pow

/-! # IMO 2020 N4, Generalized Version (Properties of `F` and `S_p`) -/

namespace IMOSL
namespace IMO2020N4

open finset function

section extra_lemmas

/-- Note: This lemma should really be put into mathlib, if it does not exist.
  I cannot find a similar version in mathlib. -/
lemma not_dvd_of_coprime {p : ℕ} (h : p ≠ 1) {x : ℕ} (h0 : x.coprime p) : ¬p ∣ x :=
begin
  rintros ⟨d, rfl⟩,
  replace h0 := h0.coprime_mul_right,
  rw nat.coprime_self at h0,
  exact h h0
end

lemma two_pow_lt_Mersenne {k m : ℕ} (h : 1 < k) (h0 : m < k) : 2 ^ m < 2 ^ k - 1 :=
begin
  rw lt_iff_exists_add at h; rcases h with ⟨n, h, rfl⟩,
  rw [← nat.succ_eq_one_add, nat.lt_succ_iff] at h0,
  rw [lt_tsub_iff_right, pow_add, pow_one, two_mul],
  exact add_lt_add_of_le_of_lt (pow_mono one_le_two h0) (nat.one_lt_two_pow n h)
end

end extra_lemmas

section order_two

variables {p : ℕ} (h : odd p)
include h

lemma two_coprime_p : nat.coprime 2 p :=
  by rwa [nat.prime_two.coprime_iff_not_dvd, nat.two_dvd_ne_zero, ← nat.odd_iff]

lemma exists_two_mod_eq_one : ∃ k : ℕ, 0 < k ∧ 2 ^ k ≡ 1 [MOD p] :=
  ⟨p.totient, nat.totient_pos (odd.pos h), nat.modeq.pow_totient (two_coprime_p h)⟩

def order_two_mod_p := nat.find (exists_two_mod_eq_one h)

lemma order_two_mod_p_pos : 0 < order_two_mod_p h :=
  (nat.find_spec (exists_two_mod_eq_one h)).1

lemma two_pow_order_two_mod_p_eq_one : 2 ^ order_two_mod_p h ≡ 1 [MOD p] :=
  (nat.find_spec (exists_two_mod_eq_one h)).2

lemma two_pow_mod_p_eq_one_iff (k : ℕ) : 2 ^ k ≡ 1 [MOD p] ↔ order_two_mod_p h ∣ k :=
begin
  let T := order_two_mod_p h,
  have h0 : 0 < T := order_two_mod_p_pos h,
  have h1 : 2 ^ T ≡ 1 [MOD p] := two_pow_order_two_mod_p_eq_one h,
  obtain ⟨q, r, h0, rfl⟩ : ∃ q r : ℕ, r < T ∧ r + q * T = k :=
    ⟨k / T, k % T, k.mod_lt h0, nat.mod_add_div' k T⟩,
  rw nat.modeq at h1 ⊢,
  rw [← nat.dvd_add_iff_left ⟨q, mul_comm q T⟩, pow_add, mul_comm q T, pow_mul,
      nat.mul_mod, nat.pow_mod (2 ^ T), h1, ← nat.pow_mod, one_pow, ← nat.mul_mod,
      mul_one, ← nat.modeq, nat.dvd_iff_mod_eq_zero, nat.mod_eq_of_lt h0, iff.comm],
  refine ⟨λ h2, _, λ h2, _⟩,
  rw [h2, pow_zero],
  contrapose! h0; exact nat.find_min' _ ⟨zero_lt_iff.mpr h0, h2⟩
end

lemma p_dvd_two_pow_sub_one_iff (k : ℕ) : p ∣ 2 ^ k - 1 ↔ order_two_mod_p h ∣ k :=
  by rw [← two_pow_mod_p_eq_one_iff, nat.modeq.comm,
         nat.modeq_iff_dvd' (nat.one_le_pow k 2 two_pos)]

lemma p_dvd_two_pow_order_two_mod_p : p ∣ 2 ^ order_two_mod_p h - 1 :=
  (p_dvd_two_pow_sub_one_iff h (order_two_mod_p h)).mpr (dvd_refl _)

lemma order_two_mod_p_dvd_totient : order_two_mod_p h ∣ p.totient :=
  (two_pow_mod_p_eq_one_iff h _).mp (nat.modeq.pow_totient (two_coprime_p h))

lemma order_two_even_of_neg_one_eq_two_pow (h0 : 1 < p) (h1 : ∃ c : ℕ, p ∣ 2 ^ c + 1) :
  even (order_two_mod_p h) :=
begin
  cases h1 with c h1,
  by_contra h2,
  replace h2 := (two_coprime_p (nat.odd_iff_not_even.mpr h2)).symm,
  have h3 : p ∣ (2 ^ c) ^ 2 - 1 ^ 2 :=
    by rw nat.sq_sub_sq; exact dvd_mul_of_dvd_left h1 (2 ^ c - 1),
  rw [one_pow, ← pow_mul, p_dvd_two_pow_sub_one_iff h,
      h2.dvd_mul_right, ← p_dvd_two_pow_sub_one_iff h] at h3,
  rw [← nat.sub_add_cancel (nat.one_le_pow c 2 two_pos),
      add_assoc, ← nat.dvd_add_iff_right h3, ← bit0] at h1,
  exact not_dvd_of_coprime (ne_of_gt h0) (two_coprime_p h) h1
end

theorem order_two_even_iff_prime_pow (h0 : is_prime_pow p) :
  even (order_two_mod_p h) ↔ ∃ c : ℕ, p ∣ 2 ^ c + 1 :=
begin
  ---- Right-to-left direction has been proved above
  rw is_prime_pow_nat_iff at h0,
  rcases h0 with ⟨q, k, hq, hk, rfl⟩,
  refine ⟨λ h0, _, order_two_even_of_neg_one_eq_two_pow h (nat.one_lt_pow k q hk hq.one_lt)⟩,
  cases h0 with c h0; rw ← mul_two at h0,
  have h1 : q ^ k ∣ (2 ^ c + 1) * (2 ^ c - 1) :=
    by rw [← nat.sq_sub_sq, one_pow, ← pow_mul, ← h0]; exact p_dvd_two_pow_order_two_mod_p h,
  refine ⟨c, (nat.coprime.dvd_mul_right (nat.coprime.pow_left _ _)).mp h1⟩,
  rw hq.coprime_iff_not_dvd,

  ---- Reduce to showing `q ∣ 2 ^ c + 1`
  suffices : q ∣ 2 ^ c + 1,
  { intros h2,
    rw [← nat.sub_add_cancel (nat.one_le_pow c 2 two_pos),
        add_assoc, ← nat.dvd_add_iff_right h2, ← bit0] at this,
    refine not_dvd_of_coprime hq.ne_one (two_coprime_p _) this,
    clear h0; contrapose h,
    rw [nat.odd_iff_not_even, not_not] at h ⊢,
    rw nat.even_pow; exact ⟨h, ne_of_gt hk⟩ },

  ---- Now show that `q ∣ 2 ^ c + 1`
  contrapose h1,
  rw ← hq.coprime_iff_not_dvd at h1,
  rw [(h1.pow_left k).dvd_mul_left, p_dvd_two_pow_sub_one_iff h, ← mul_one c, h0],
  replace h0 : 0 < c * 2 := by rw ← h0; exact order_two_mod_p_pos h,
  rw zero_lt_mul_right (nat.zero_lt_succ 1) at h0,
  rw [nat.mul_dvd_mul_iff_left h0, nat.dvd_one],
  norm_num
end

theorem order_two_even_iff_prime (hp : p.prime) :
  even (order_two_mod_p h) ↔ ∃ c : ℕ, p ∣ 2 ^ c + 1 :=
  order_two_even_iff_prime_pow h hp.is_prime_pow

end order_two

section properties

def F (p n : ℕ) := n + n % p
def S (p k n : ℕ) := (range k).sum (λ i, (2 ^ i * n) % p)

lemma F_mod_p (p n : ℕ) : F p n % p = (2 * n) % p :=
  by rw [F, nat.add_mod_mod, two_mul]

lemma F_iterate_mod_p (p k n : ℕ) : (F p^[k]) n % p = (2 ^ k * n) % p :=
begin
  induction k with k k_ih,
  rw [iterate_zero, id.def, pow_zero, one_mul],
  rw [iterate_succ', comp_app, F_mod_p, pow_succ, mul_assoc, nat.mul_mod, nat.mul_mod 2, k_ih]
end

lemma self_le_F (p n : ℕ) : n ≤ F p n :=
  le_self_add

lemma F_iterate_monotone (p n : ℕ) : monotone (λ i, (F p)^[i] n) :=
begin
  intros i j h,
  rw le_iff_exists_add at h,
  rcases h with ⟨c, rfl⟩,
  induction c with c c_ih,
  rw add_zero,
  rw nat.add_succ,
  simp_rw iterate_succ',
  exact le_trans c_ih (self_le_F p _)
end

lemma S_zero (p n : ℕ) : S p 0 n = 0 :=
  by rw [S, sum_range_zero]

lemma S_one (p n : ℕ) : S p 1 n = n % p :=
  by rw [S, sum_range_one, pow_zero, one_mul]

lemma S_succ (p k n : ℕ) : S p k.succ n = S p k n + (2 ^ k * n % p) :=
  sum_range_succ _ _

lemma S_succ' (p k n : ℕ) : S p k.succ n = S p k (2 * n) + n % p :=
begin
  rw [S, sum_range_succ', pow_zero, one_mul, add_left_inj, S],
  refine sum_congr rfl (λ x _, _),
  rw [pow_succ', mul_assoc]
end

lemma S_mod_p (p k n : ℕ) : S p k n = S p k (n % p) :=
begin
  induction k with k k_ih,
  rw [S_zero, S_zero],
  rw [S_succ, S_succ, ← k_ih, add_right_inj, eq_comm, nat.mul_mod, nat.mod_mod, ← nat.mul_mod]
end

lemma self_add_S_mod_p (p k n : ℕ) : (n + S p k n) % p = (2 ^ k * n) % p :=
begin
  induction k with k k_ih,
  rw [S_zero, add_zero, pow_zero, one_mul],
  rw [S_succ, ← add_assoc, ← nat.mod_add_mod, k_ih, ← nat.add_mod, ← two_mul, pow_succ, mul_assoc]
end

lemma F_iterate_S (p k n : ℕ) : (F p^[k]) n = n + S p k n :=
begin
  induction k with k k_ih,
  rw [iterate_zero, id.def, S_zero, add_zero],
  rw [iterate_succ', comp_app, k_ih, F, S_succ, ← add_assoc, self_add_S_mod_p]
end

lemma S_add_SS (p k k0 n : ℕ) : S p (k + k0) n = S p k n + S p k0 (2 ^ k * n) :=
begin
  rw [S, sum_range_add, S, add_right_inj, S],
  refine sum_congr rfl (λ x _, _),
  rw [add_comm, pow_add, mul_assoc]
end

lemma F_switch_sign {p a b : ℕ} (h0 : b < a) (h1 : F p a < F p b) :
  ∃ k x y : ℕ, p / 2 + x < y ∧ y < p ∧ a = x + (k + 1) * p ∧ b = y + k * p :=
begin
  ---- Throw out the case `p = 0`
  rw [F, F] at h1,
  rcases p.eq_zero_or_pos with rfl | h,
  rw [nat.mod_zero, ← two_mul, nat.mod_zero, ← two_mul] at h1,
  exfalso; exact lt_asymm h1 ((mul_lt_mul_left two_pos).mpr h0),

  ---- Rexpand `a = kp + x` and `b = mp + y`
  obtain ⟨m, x, h2, rfl⟩ : ∃ m x : ℕ, x < p ∧ x + m * p = a :=
    ⟨a / p, a % p, a.mod_lt h, a.mod_add_div' p⟩,
  obtain ⟨k, y, h3, rfl⟩ : ∃ k y : ℕ, y < p ∧ y + k * p = b :=
    ⟨b / p, b % p, b.mod_lt h, b.mod_add_div' p⟩,
  rw [nat.add_mul_mod_self_right, nat.mod_eq_of_lt h2, add_right_comm, ← two_mul,
      nat.add_mul_mod_self_right, nat.mod_eq_of_lt h3, add_right_comm, ← two_mul] at h1,

  ---- Reduce to showing that `m = k + 1`
  suffices h5 : m = k + 1,
  { subst h5; refine ⟨k, x, y, _, h3, rfl, rfl⟩,
    rw [add_comm k 1, one_add_mul, ← add_assoc, add_lt_add_iff_right] at h1,
    rwa [← nat.add_mul_div_right _ _ two_pos, add_comm,
         nat.div_lt_iff_lt_mul two_pos, mul_comm, mul_comm y] },

  ---- Finishing
  replace h2 : x < y :=
  begin
    rw [← add_lt_add_iff_left x, ← add_assoc, ← add_assoc, ← two_mul] at h0,
    replace h1 := lt_trans h0 h1,
    rwa [add_lt_add_iff_right, two_mul, add_lt_add_iff_right] at h1
  end,
  replace h0 := lt_trans (add_lt_add_right h2 _) h0,
  rw [add_lt_add_iff_left, mul_lt_mul_right h, lt_iff_exists_add] at h0,
  rcases h0 with ⟨c, h0, rfl⟩,
  rw [add_comm k, add_mul, ← add_assoc, add_lt_add_iff_right, two_mul y] at h1,
  replace h1 := lt_trans (lt_of_le_of_lt le_add_self h1) (add_lt_add h3 h3),
  rw [← two_mul, mul_lt_mul_right h, nat.lt_succ_iff] at h1,
  rw [gt_iff_lt, ← nat.succ_le_iff] at h0,
  rw le_antisymm h1 h0
end

variables {p : ℕ} (h : odd p)
include h

lemma F_injective : injective (F p) :=
begin
  intros x y h0,
  obtain ⟨q, q0, r, h1, rfl, rfl⟩ : ∃ q q0 r : ℕ, r < p ∧ q * p + r = x ∧ q0 * p + r = y :=
  begin
    refine ⟨x / p, y / p, x % p, x.mod_lt h.pos, nat.div_add_mod' x p, _⟩,
    convert nat.div_add_mod' y p using 2,
    replace h0 : (F p x) % p = (F p y) % p := congr_arg (λ c, c % p) h0,
    rw [F_mod_p, F_mod_p, ← nat.modeq] at h0,
    refine nat.modeq.modeq_cancel_left_of_coprime _ h0,
    rw [nat.odd_iff, ← nat.two_dvd_ne_zero] at h,
    rwa [← nat.coprime, nat.coprime_comm, nat.prime_two.coprime_iff_not_dvd]
  end,
  rw [F, F, nat.mul_add_mod, nat.mul_add_mod, add_left_inj, add_left_inj] at h0,
  rw h0
end

lemma F_coprime {n : ℕ} (h0 : n.coprime p) : (F p n).coprime p :=
begin
  rw [F, ← nat.coprime_add_mul_left_left _ _ (n / p), add_assoc, nat.mod_add_div, ← two_mul],
  exact (two_coprime_p h).mul h0
end

/-- Wrapper for `S_p(n)`, only up to length `T = ord_p(2)` -/
def S0 (n : ℕ) := S p (order_two_mod_p h) n

lemma F_iterate_coprime {n : ℕ} (h0 : n.coprime p) (N : ℕ) : (F p^[N] n).coprime p :=
begin
  induction N with N N_ih,
  rwa [iterate_zero, id.def],
  rw [iterate_succ', comp_app],
  exact F_coprime h N_ih
end

lemma S0_mod_p (n : ℕ) : S0 h n = S0 h (n % p) :=
  S_mod_p p _ n

lemma S0_two_mul (n : ℕ) : S0 h (2 * n) = S0 h n :=
begin
  have h0 := S_succ p (order_two_mod_p h) n,
  have h1 : 2 ^ order_two_mod_p h % p = 1 % p := two_pow_order_two_mod_p_eq_one h,
  rwa [S_succ', nat.mul_mod, h1, ← nat.mul_mod, one_mul, add_left_inj] at h0
end

lemma S0_two_pow_mul (n c : ℕ) : S0 h (2 ^ c * n) = S0 h n :=
begin
  induction c with c c_ih,
  rw [pow_zero, one_mul],
  rw [pow_succ, mul_assoc, S0_two_mul h, c_ih]
end

lemma S0_two_pow (c : ℕ) : S0 h (2 ^ c) = S0 h 1 :=
  by rw [← mul_one (2 ^ c), S0_two_pow_mul]

lemma S_mul_order (k n : ℕ) : S p (k * order_two_mod_p h) n = k * S0 h n :=
begin
  induction k with k k_ih,
  rw [zero_mul, S_zero, zero_mul],
  rw [nat.succ_mul, S_add_SS, k_ih, ← S0, S0_two_pow_mul h, nat.succ_mul]
end

lemma F_iterate_mul_ord (k n : ℕ) : (F p^[k * order_two_mod_p h]) n = n + k * S0 h n :=
  by rw [F_iterate_S, S_mul_order]

lemma S_mul_order_add (k n r : ℕ) :
  S p (k * order_two_mod_p h + r) n = k * S0 h n + S p r n :=
  by rw [add_comm, S_add_SS, S_mul_order h, S0_two_pow_mul h, add_comm]

lemma F_iterate_mul_ord_add (k n r : ℕ) :
  (F p^[k * order_two_mod_p h + r]) n = n + k * S0 h n + S p r n :=
  by rw [F_iterate_S, S_mul_order_add, add_assoc]

lemma S0_F_iterate (k n : ℕ) : S0 h (F p^[k] n) = S0 h n :=
  by rw [S0_mod_p h, F_iterate_mod_p, ← S0_mod_p h, S0_two_pow_mul]

lemma S_p_dvd_add {m n : ℕ} (h0 : ¬p ∣ m) (h1 : p ∣ m + n) (k : ℕ) :
  S p k m + S p k n = k * p :=
begin
  revert h0 h1 m n,
  induction k with k k_ih; intros m n h0 h1,
  rw [S_zero, S_zero, add_zero, zero_mul],
  rw [S_succ', S_succ', add_add_add_comm, k_ih, nat.succ_mul, add_right_inj],
  have X := nat.le_mod_add_mod_of_dvd_add_of_not_dvd h1 h0,
  replace X := nat.add_mod_add_of_le_add_mod X,
  rwa [nat.mod_eq_zero_of_dvd h1, zero_add, eq_comm] at X,
  rwa (two_coprime_p h).symm.dvd_mul_left,
  rw ← mul_add; exact dvd_mul_of_dvd_right h1 2
end

lemma S0_p_dvd_add {m n : ℕ} (h0 : ¬p ∣ m) (h1 : p ∣ m + n) :
  S0 h m + S0 h n = order_two_mod_p h * p :=
  S_p_dvd_add h h0 h1 (order_two_mod_p h)

lemma eventually_F_lt_of_S0_lt {a b : ℕ} (h0 : S0 h a < S0 h b) :
  ∃ N : ℕ, ∀ n : ℕ, N ≤ n → (F p^[n]) a < (F p^[n]) b :=
begin
  ---- Find `K` large enough
  obtain ⟨K, h1⟩ : ∃ K : ℕ, a + (K + 1) * S0 h a < b + K * S0 h b :=
  begin
    generalize_hyp : S0 h a = c at h0 ⊢,
    generalize_hyp : S0 h b = d at h0 ⊢,
    use a + c + 1,
    rw [add_one_mul, add_left_comm, ← nat.add_one_le_iff, add_assoc, ← mul_add_one],
    rw ← nat.add_one_le_iff at h0,
    exact le_trans (mul_le_mul_left' h0 (a + c + 1)) le_add_self
  end,

  ---- Pick `N = kT`, and if `n = kT + r`, reduce to `a + (k + 1) S_p(a) < b + k S_p(b)`
  let T := order_two_mod_p h,
  have hT : 0 < T := order_two_mod_p_pos h,
  refine ⟨K * T, λ n hn, _⟩,
  obtain ⟨k, r, h2, rfl⟩ : ∃ k r : ℕ, r < T ∧ k * T + r = n :=
    ⟨n / T, n % T, n.mod_lt hT, nat.div_add_mod' n T⟩,
  refine lt_of_lt_of_le _ (F_iterate_monotone p b le_self_add),
  refine lt_of_le_of_lt (F_iterate_monotone p a (add_le_add_left (le_of_lt h2) _)) _,
  simp only []; rw [← add_one_mul, F_iterate_S, S_mul_order h, F_iterate_S, S_mul_order h],

  ---- Prove that `a + (k + 1) S_p(a) < b + k S_p(b)`
  replace hn : (K * T) / T ≤ (k * T + r) / T := nat.div_le_div_right hn,
  rw [nat.mul_div_cancel _ hT, add_comm, nat.add_mul_div_right _ _ hT,
      nat.div_eq_zero h2, zero_add, le_iff_exists_add] at hn,
  rcases hn with ⟨c, rfl⟩,
  rw [add_right_comm, add_mul, add_mul K c, ← add_assoc, ← add_assoc],
  exact add_lt_add_of_lt_of_le h1 (mul_le_mul_left' (le_of_lt h0) c)
end

end properties

section Mersenne

/-- This lemma proves that the Mersenne numbers `2^k - 1` are odd for `k > 0`.
  For the rest of the lemmas, we use the oddness of `2^k - 1` as the hypothesis itself. -/
lemma Mersenne_odd {k : ℕ} (h : 0 < k) : odd (2 ^ k - 1) :=
begin
  rw [nat.odd_iff_not_even, ← nat.even_add_one,
      nat.sub_add_cancel (nat.one_le_pow k 2 two_pos), nat.even_pow' (ne_of_gt h)],
  exact even_two
end

variables {k : ℕ} (h : odd (2 ^ k - 1))
include h

lemma order_two_mod_Mersenne : order_two_mod_p h = k :=
begin
  have X : ∀ m : ℕ, 1 ≤ 2 ^ m := λ m, nat.one_le_pow m 2 two_pos,
  unfold order_two_mod_p; apply le_antisymm,
  rw nat.find_le_iff; refine ⟨k, le_refl k, _, nat.modeq_sub (X k)⟩,
  rw zero_lt_iff; rintros rfl,
  rw [pow_zero, nat.sub_self, nat.odd_iff_not_even] at h,
  exact h even_zero,
  rw nat.le_find_iff; rintros m h0 ⟨h1, h2⟩,
  rw [nat.modeq.comm, nat.modeq_iff_dvd' (X m)] at h2,
  revert h2; refine nat.not_dvd_of_pos_of_lt _ _,
  rw tsub_pos_iff_lt; exact nat.one_lt_pow m 2 h1 one_lt_two,
  rw tsub_lt_tsub_iff_right (X m); exact pow_lt_pow one_lt_two h0
end

lemma S0_Mersenne_one (h0 : 1 < k) : S0 h 1 = 2 ^ k - 1 :=
begin
  conv_rhs { rw ← geom_sum_mul_add 1 k },
  rw [S0, order_two_mod_Mersenne, S, nat.add_sub_cancel, mul_one],
  refine sum_congr rfl (λ i h1, _),
  rw [mul_one, nat.mod_eq_of_lt],
  obtain ⟨m, rfl⟩ := nat.exists_eq_succ_of_ne_zero (ne_of_gt (lt_trans one_pos h0)),
  rw [mem_range, nat.lt_succ_iff] at h1,
  rw [lt_tsub_iff_right, pow_succ, two_mul],
  refine add_lt_add_of_le_of_lt (nat.pow_le_pow_of_le_right two_pos h1) _,
  rw nat.succ_lt_succ_iff at h0; exact nat.one_lt_two_pow m h0
end

lemma S0_Mersenne_neg_two_pow (h0 : 1 < k) {m : ℕ} (h1 : m < k) :
  S0 h (2 ^ k - 1 - 2 ^ m) = (k - 1) * (2 ^ k - 1) :=
begin
  have h2 := two_pow_lt_Mersenne h0 h1,
  rw [← add_right_inj (S0 h (2 ^ m)), S0_p_dvd_add, order_two_mod_Mersenne, add_comm,
      S0_two_pow h, S0_Mersenne_one h h0, ← add_one_mul, nat.sub_add_cancel (le_of_lt h0)],
  exact nat.not_dvd_of_pos_of_lt (pow_pos two_pos m) h2,
  rw [add_comm, nat.sub_add_cancel (le_of_lt h2)]
end

lemma S0_Mersenne_neg_one (h0 : 1 < k) : S0 h (2 ^ k - 1 - 1) = (k - 1) * (2 ^ k - 1) :=
  S0_Mersenne_neg_two_pow h h0 (lt_trans one_pos h0)

end Mersenne

end IMO2020N4
end IMOSL


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

! This file was ported from Lean 3 source module field_theory.finite.basic
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.FieldTheory.Separable
import Mathbin.FieldTheory.SplittingField
import Mathbin.RingTheory.IntegralDomain
import Mathbin.Tactic.ApplyFun

/-!
# Finite fields

This file contains basic results about finite fields.
Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

See `ring_theory.integral_domain` for the fact that the unit group of a finite field is a
cyclic group, as well as the fact that every finite integral domain is a field
(`fintype.field_of_domain`).

## Main results

1. `fintype.card_units`: The unit group of a finite field is has cardinality `q - 1`.
2. `sum_pow_units`: The sum of `x^i`, where `x` ranges over the units of `K`, is
   - `q-1` if `q-1 ∣ i`
   - `0`   otherwise
3. `finite_field.card`: The cardinality `q` is a power of the characteristic of `K`.
   See `card'` for a variant.

## Notation

Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

## Implementation notes

While `fintype Kˣ` can be inferred from `fintype K` in the presence of `decidable_eq K`,
in this file we take the `fintype Kˣ` argument directly to reduce the chance of typeclass
diamonds, as `fintype` carries data.

-/

variable {K : Type _} {R : Type _}

-- mathport name: exprq
local notation "q" => Fintype.card K

open Finset Function

open BigOperators Polynomial

namespace FiniteField

section Polynomial

variable [CommRing R] [IsDomain R]

open Polynomial

/-- The cardinality of a field is at most `n` times the cardinality of the image of a degree `n`
  polynomial -/
theorem card_image_polynomial_eval [DecidableEq R] [Fintype R] {p : R[X]} (hp : 0 < p.degree) :
    Fintype.card R ≤ natDegree p * (univ.image fun x => eval x p).card :=
  Finset.card_le_mul_card_image _ _ fun a _ =>
    calc
      _ = (p - C a).roots.toFinset.card :=
        congr_arg card (by simp [Finset.ext_iff, mem_roots_sub_C hp])
      _ ≤ (p - C a).roots.card := (Multiset.toFinset_card_le _)
      _ ≤ _ := card_roots_sub_C' hp

#align finite_field.card_image_polynomial_eval FiniteField.card_image_polynomial_eval

/-- If `f` and `g` are quadratic polynomials, then the `f.eval a + g.eval b = 0` has a solution. -/
theorem exists_root_sum_quadratic [Fintype R] {f g : R[X]} (hf2 : degree f = 2) (hg2 : degree g = 2)
    (hR : Fintype.card R % 2 = 1) : ∃ a b, f.eval a + g.eval b = 0 :=
  letI := Classical.decEq R
  suffices ¬Disjoint (univ.image fun x : R => eval x f) (univ.image fun x : R => eval x (-g))
    by
    simp only [disjoint_left, mem_image] at this
    push_neg  at this
    rcases this with ⟨x, ⟨a, _, ha⟩, ⟨b, _, hb⟩⟩
    exact ⟨a, b, by rw [ha, ← hb, eval_neg, neg_add_self]⟩
  fun hd : Disjoint _ _ =>
  lt_irrefl (2 * ((univ.image fun x : R => eval x f) ∪ univ.image fun x : R => eval x (-g)).card) <|
    calc
      2 * ((univ.image fun x : R => eval x f) ∪ univ.image fun x : R => eval x (-g)).card ≤
          2 * Fintype.card R :=
        Nat.mul_le_mul_left _ (Finset.card_le_univ _)
      _ = Fintype.card R + Fintype.card R := (two_mul _)
      _ <
          nat_degree f * (univ.image fun x : R => eval x f).card +
            nat_degree (-g) * (univ.image fun x : R => eval x (-g)).card :=
        (add_lt_add_of_lt_of_le
          (lt_of_le_of_ne (card_image_polynomial_eval (by rw [hf2] <;> exact by decide))
            (mt (congr_arg (· % 2)) (by simp [nat_degree_eq_of_degree_eq_some hf2, hR])))
          (card_image_polynomial_eval (by rw [degree_neg, hg2] <;> exact by decide)))
      _ = 2 * ((univ.image fun x : R => eval x f) ∪ univ.image fun x : R => eval x (-g)).card := by
        rw [card_disjoint_union hd] <;>
          simp [nat_degree_eq_of_degree_eq_some hf2, nat_degree_eq_of_degree_eq_some hg2, bit0,
            mul_add]

#align finite_field.exists_root_sum_quadratic FiniteField.exists_root_sum_quadratic

end Polynomial

theorem prod_univ_units_id_eq_neg_one [CommRing K] [IsDomain K] [Fintype Kˣ] :
    (∏ x : Kˣ, x) = (-1 : Kˣ) := by
  classical
    have : (∏ x in (@univ Kˣ _).eraseₓ (-1), x) = 1 :=
      prod_involution (fun x _ => x⁻¹) (by simp)
        (fun a => by simp (config := { contextual := true }) [Units.inv_eq_self_iff])
        (fun a => by simp [@inv_eq_iff_eq_inv _ _ a]) (by simp)
    rw [← insert_erase (mem_univ (-1 : Kˣ)), prod_insert (not_mem_erase _ _), this, mul_one]
#align finite_field.prod_univ_units_id_eq_neg_one FiniteField.prod_univ_units_id_eq_neg_one

section

variable [GroupWithZero K] [Fintype K]

theorem pow_card_sub_one_eq_one (a : K) (ha : a ≠ 0) : a ^ (q - 1) = 1 :=
  calc
    a ^ (Fintype.card K - 1) = (Units.mk0 a ha ^ (Fintype.card K - 1) : Kˣ) := by
      rw [Units.val_pow_eq_pow_val, Units.val_mk0]
    _ = 1 := by
      classical
        rw [← Fintype.card_units, pow_card_eq_one]
        rfl

#align finite_field.pow_card_sub_one_eq_one FiniteField.pow_card_sub_one_eq_one

theorem pow_card (a : K) : a ^ q = a :=
  by
  have hp : 0 < Fintype.card K := lt_trans zero_lt_one Fintype.one_lt_card
  by_cases h : a = 0;
  · rw [h]
    apply zero_pow hp
  rw [← Nat.succ_pred_eq_of_pos hp, pow_succ, Nat.pred_eq_sub_one, pow_card_sub_one_eq_one a h,
    mul_one]
#align finite_field.pow_card FiniteField.pow_card

theorem pow_card_pow (n : ℕ) (a : K) : a ^ q ^ n = a :=
  by
  induction' n with n ih
  · simp
  · simp [pow_succ, pow_mul, ih, pow_card]
#align finite_field.pow_card_pow FiniteField.pow_card_pow

end

variable (K) [Field K] [Fintype K]

theorem card (p : ℕ) [CharP K p] : ∃ n : ℕ+, Nat.Prime p ∧ q = p ^ (n : ℕ) :=
  by
  haveI hp : Fact p.prime := ⟨CharP.char_is_prime K p⟩
  letI : Module (ZMod p) K := { (ZMod.castHom dvd_rfl K : ZMod p →+* _).toModule with }
  obtain ⟨n, h⟩ := VectorSpace.card_fintype (ZMod p) K
  rw [ZMod.card] at h
  refine' ⟨⟨n, _⟩, hp.1, h⟩
  apply Or.resolve_left (Nat.eq_zero_or_pos n)
  rintro rfl
  rw [pow_zero] at h
  have : (0 : K) = 1 := by apply fintype.card_le_one_iff.mp (le_of_eq h)
  exact absurd this zero_ne_one
#align finite_field.card FiniteField.card

-- this statement doesn't use `q` because we want `K` to be an explicit parameter
theorem card' : ∃ (p : ℕ)(n : ℕ+), Nat.Prime p ∧ Fintype.card K = p ^ (n : ℕ) :=
  let ⟨p, hc⟩ := CharP.exists K
  ⟨p, @FiniteField.card K _ _ p hc⟩
#align finite_field.card' FiniteField.card'

@[simp]
theorem cast_card_eq_zero : (q : K) = 0 :=
  by
  rcases CharP.exists K with ⟨p, _char_p⟩; skip
  rcases card K p with ⟨n, hp, hn⟩
  simp only [CharP.cast_eq_zero_iff K p, hn]
  conv =>
    congr
    rw [← pow_one p]
  exact pow_dvd_pow _ n.2
#align finite_field.cast_card_eq_zero FiniteField.cast_card_eq_zero

theorem forall_pow_eq_one_iff (i : ℕ) : (∀ x : Kˣ, x ^ i = 1) ↔ q - 1 ∣ i := by
  classical
    obtain ⟨x, hx⟩ := IsCyclic.exists_generator Kˣ
    rw [← Fintype.card_units, ← orderOf_eq_card_of_forall_mem_zpowers hx,
      orderOf_dvd_iff_pow_eq_one]
    constructor
    · intro h
      apply h
    · intro h y
      simp_rw [← mem_powers_iff_mem_zpowers] at hx
      rcases hx y with ⟨j, rfl⟩
      rw [← pow_mul, mul_comm, pow_mul, h, one_pow]
#align finite_field.forall_pow_eq_one_iff FiniteField.forall_pow_eq_one_iff

/-- The sum of `x ^ i` as `x` ranges over the units of a finite field of cardinality `q`
is equal to `0` unless `(q - 1) ∣ i`, in which case the sum is `q - 1`. -/
theorem sum_pow_units [Fintype Kˣ] (i : ℕ) :
    (∑ x : Kˣ, (x ^ i : K)) = if q - 1 ∣ i then -1 else 0 :=
  by
  let φ : Kˣ →* K :=
    { toFun := fun x => x ^ i
      map_one' := by rw [Units.val_one, one_pow]
      map_mul' := by
        intros
        rw [Units.val_mul, mul_pow] }
  have : Decidable (φ = 1) := by classical infer_instance
  calc
    (∑ x : Kˣ, φ x) = if φ = 1 then Fintype.card Kˣ else 0 := sum_hom_units φ
    _ = if q - 1 ∣ i then -1 else 0 := _

  suffices q - 1 ∣ i ↔ φ = 1 by
    simp only [this]
    split_ifs with h h
    swap
    rfl
    rw [Fintype.card_units, Nat.cast_sub, cast_card_eq_zero, Nat.cast_one, zero_sub]
    show 1 ≤ q
    exact fintype.card_pos_iff.mpr ⟨0⟩
  rw [← forall_pow_eq_one_iff, MonoidHom.ext_iff]
  apply forall_congr'
  intro x
  rw [Units.ext_iff, Units.val_pow_eq_pow_val, Units.val_one, MonoidHom.one_apply]
  rfl
#align finite_field.sum_pow_units FiniteField.sum_pow_units

/-- The sum of `x ^ i` as `x` ranges over a finite field of cardinality `q`
is equal to `0` if `i < q - 1`. -/
theorem sum_pow_lt_card_sub_one (i : ℕ) (h : i < q - 1) : (∑ x : K, x ^ i) = 0 :=
  by
  by_cases hi : i = 0
  · simp only [hi, nsmul_one, sum_const, pow_zero, card_univ, cast_card_eq_zero]
  classical
    have hiq : ¬q - 1 ∣ i := by
      contrapose! h
      exact Nat.le_of_dvd (Nat.pos_of_ne_zero hi) h
    let φ : Kˣ ↪ K := ⟨coe, Units.ext⟩
    have : univ.map φ = univ \ {0} := by
      ext x
      simp only [true_and_iff, embedding.coe_fn_mk, mem_sdiff, Units.exists_iff_ne_zero, mem_univ,
        mem_map, exists_prop_of_true, mem_singleton]
    calc
      (∑ x : K, x ^ i) = ∑ x in univ \ {(0 : K)}, x ^ i := by
        rw [← sum_sdiff ({0} : Finset K).subset_univ, sum_singleton,
          zero_pow (Nat.pos_of_ne_zero hi), add_zero]
      _ = ∑ x : Kˣ, x ^ i := by
        rw [← this, univ.sum_map φ]
        rfl
      _ = 0 := by
        rw [sum_pow_units K i, if_neg]
        exact hiq

#align finite_field.sum_pow_lt_card_sub_one FiniteField.sum_pow_lt_card_sub_one

section IsSplittingField

open Polynomial

section

variable (K' : Type _) [Field K'] {p n : ℕ}

theorem x_pow_card_sub_x_natDegree_eq (hp : 1 < p) : (X ^ p - X : K'[X]).natDegree = p :=
  by
  have h1 : (X : K'[X]).degree < (X ^ p : K'[X]).degree :=
    by
    rw [degree_X_pow, degree_X]
    exact_mod_cast hp
  rw [nat_degree_eq_of_degree_eq (degree_sub_eq_left_of_degree_lt h1), nat_degree_X_pow]
#align finite_field.X_pow_card_sub_X_nat_degree_eq FiniteField.x_pow_card_sub_x_natDegree_eq

theorem x_pow_card_pow_sub_x_natDegree_eq (hn : n ≠ 0) (hp : 1 < p) :
    (X ^ p ^ n - X : K'[X]).natDegree = p ^ n :=
  x_pow_card_sub_x_natDegree_eq K' <| Nat.one_lt_pow _ _ (Nat.pos_of_ne_zero hn) hp
#align finite_field.X_pow_card_pow_sub_X_nat_degree_eq FiniteField.x_pow_card_pow_sub_x_natDegree_eq

theorem x_pow_card_sub_x_ne_zero (hp : 1 < p) : (X ^ p - X : K'[X]) ≠ 0 :=
  ne_zero_of_natDegree_gt <|
    calc
      1 < _ := hp
      _ = _ := (x_pow_card_sub_x_natDegree_eq K' hp).symm

#align finite_field.X_pow_card_sub_X_ne_zero FiniteField.x_pow_card_sub_x_ne_zero

theorem x_pow_card_pow_sub_x_ne_zero (hn : n ≠ 0) (hp : 1 < p) : (X ^ p ^ n - X : K'[X]) ≠ 0 :=
  x_pow_card_sub_x_ne_zero K' <| Nat.one_lt_pow _ _ (Nat.pos_of_ne_zero hn) hp
#align finite_field.X_pow_card_pow_sub_X_ne_zero FiniteField.x_pow_card_pow_sub_x_ne_zero

end

variable (p : ℕ) [Fact p.Prime] [Algebra (ZMod p) K]

theorem roots_x_pow_card_sub_x : roots (X ^ q - X : K[X]) = Finset.univ.val := by
  classical
    have aux : (X ^ q - X : K[X]) ≠ 0 := X_pow_card_sub_X_ne_zero K Fintype.one_lt_card
    have : (roots (X ^ q - X : K[X])).toFinset = Finset.univ :=
      by
      rw [eq_univ_iff_forall]
      intro x
      rw [Multiset.mem_toFinset, mem_roots aux, is_root.def, eval_sub, eval_pow, eval_X,
        sub_eq_zero, pow_card]
    rw [← this, Multiset.toFinset_val, eq_comm, Multiset.dedup_eq_self]
    apply nodup_roots
    rw [separable_def]
    convert is_coprime_one_right.neg_right using 1
    ·
      rw [derivative_sub, derivative_X, derivative_X_pow, CharP.cast_card_eq_zero K, C_0,
        MulZeroClass.zero_mul, zero_sub]
#align finite_field.roots_X_pow_card_sub_X FiniteField.roots_x_pow_card_sub_x

instance (F : Type _) [Field F] [Algebra F K] : IsSplittingField F K (X ^ q - X)
    where
  Splits :=
    by
    have h : (X ^ q - X : K[X]).natDegree = q :=
      X_pow_card_sub_X_nat_degree_eq K Fintype.one_lt_card
    rw [← splits_id_iff_splits, splits_iff_card_roots, Polynomial.map_sub, Polynomial.map_pow,
      map_X, h, roots_X_pow_card_sub_X K, ← Finset.card_def, Finset.card_univ]
  adjoin_roots := by
    classical
      trans Algebra.adjoin F ((roots (X ^ q - X : K[X])).toFinset : Set K)
      · simp only [Polynomial.map_pow, map_X, Polynomial.map_sub]
      · rw [roots_X_pow_card_sub_X, val_to_finset, coe_univ, Algebra.adjoin_univ]

end IsSplittingField

variable {K}

theorem frobenius_pow {p : ℕ} [Fact p.Prime] [CharP K p] {n : ℕ} (hcard : q = p ^ n) :
    frobenius K p ^ n = 1 := by
  ext; conv_rhs => rw [RingHom.one_def, RingHom.id_apply, ← pow_card x, hcard]; clear hcard
  induction n; · simp
  rw [pow_succ, pow_succ', pow_mul, RingHom.mul_def, RingHom.comp_apply, frobenius_def, n_ih]
#align finite_field.frobenius_pow FiniteField.frobenius_pow

open Polynomial

theorem expand_card (f : K[X]) : expand K q f = f ^ q :=
  by
  cases' CharP.exists K with p hp
  letI := hp
  rcases FiniteField.card K p with ⟨⟨n, npos⟩, ⟨hp, hn⟩⟩
  haveI : Fact p.prime := ⟨hp⟩
  dsimp at hn
  rw [hn, ← map_expand_pow_char, frobenius_pow hn, RingHom.one_def, map_id]
#align finite_field.expand_card FiniteField.expand_card

end FiniteField

namespace ZMod

open FiniteField Polynomial

theorem sq_add_sq (p : ℕ) [hp : Fact p.Prime] (x : ZMod p) : ∃ a b : ZMod p, a ^ 2 + b ^ 2 = x :=
  by
  cases' hp.1.eq_two_or_odd with hp2 hp_odd
  · subst p
    change Fin 2 at x
    fin_cases x
    · use 0
      simp
    · use 0, 1
      simp
  let f : (ZMod p)[X] := X ^ 2
  let g : (ZMod p)[X] := X ^ 2 - C x
  obtain ⟨a, b, hab⟩ : ∃ a b, f.eval a + g.eval b = 0 :=
    @exists_root_sum_quadratic _ _ _ _ f g (degree_X_pow 2) (degree_X_pow_sub_C (by decide) _)
      (by rw [ZMod.card, hp_odd])
  refine' ⟨a, b, _⟩
  rw [← sub_eq_zero]
  simpa only [eval_C, eval_X, eval_pow, eval_sub, ← add_sub_assoc] using hab
#align zmod.sq_add_sq ZMod.sq_add_sq

end ZMod

namespace CharP

theorem sq_add_sq (R : Type _) [CommRing R] [IsDomain R] (p : ℕ) [NeZero p] [CharP R p] (x : ℤ) :
    ∃ a b : ℕ, (a ^ 2 + b ^ 2 : R) = x :=
  by
  haveI := char_is_prime_of_pos R p
  obtain ⟨a, b, hab⟩ := ZMod.sq_add_sq p x
  refine' ⟨a.val, b.val, _⟩
  simpa using congr_arg (ZMod.castHom dvd_rfl R) hab
#align char_p.sq_add_sq CharP.sq_add_sq

end CharP

open Nat

open ZMod

/-- The **Fermat-Euler totient theorem**. `nat.modeq.pow_totient` is an alternative statement
  of the same theorem. -/
@[simp]
theorem ZMod.pow_totient {n : ℕ} (x : (ZMod n)ˣ) : x ^ φ n = 1 :=
  by
  cases n
  · rw [Nat.totient_zero, pow_zero]
  · rw [← card_units_eq_totient, pow_card_eq_one]
#align zmod.pow_totient ZMod.pow_totient

/-- The **Fermat-Euler totient theorem**. `zmod.pow_totient` is an alternative statement
  of the same theorem. -/
theorem Nat.ModEq.pow_totient {x n : ℕ} (h : Nat.coprime x n) : x ^ φ n ≡ 1 [MOD n] :=
  by
  rw [← ZMod.eq_iff_modEq_nat]
  let x' : Units (ZMod n) := ZMod.unitOfCoprime _ h
  have := ZMod.pow_totient x'
  apply_fun (coe : Units (ZMod n) → ZMod n)  at this
  simpa only [-ZMod.pow_totient, Nat.succ_eq_add_one, Nat.cast_pow, Units.val_one, Nat.cast_one,
    coe_unit_of_coprime, Units.val_pow_eq_pow_val]
#align nat.modeq.pow_totient Nat.ModEq.pow_totient

section

variable {V : Type _} [Fintype K] [DivisionRing K] [AddCommGroup V] [Module K V]

-- should this go in a namespace?
-- finite_dimensional would be natural,
-- but we don't assume it...
theorem card_eq_pow_finrank [Fintype V] : Fintype.card V = q ^ FiniteDimensional.finrank K V :=
  by
  let b := IsNoetherian.finsetBasis K V
  rw [Module.card_fintype b, ← FiniteDimensional.finrank_eq_card_basis b]
#align card_eq_pow_finrank card_eq_pow_finrank

end

open FiniteField

namespace ZMod

/-- A variation on Fermat's little theorem. See `zmod.pow_card_sub_one_eq_one` -/
@[simp]
theorem pow_card {p : ℕ} [Fact p.Prime] (x : ZMod p) : x ^ p = x :=
  by
  have h := FiniteField.pow_card x
  rwa [ZMod.card p] at h
#align zmod.pow_card ZMod.pow_card

@[simp]
theorem pow_card_pow {n p : ℕ} [Fact p.Prime] (x : ZMod p) : x ^ p ^ n = x :=
  by
  induction' n with n ih
  · simp
  · simp [pow_succ, pow_mul, ih, pow_card]
#align zmod.pow_card_pow ZMod.pow_card_pow

@[simp]
theorem frobenius_zMod (p : ℕ) [Fact p.Prime] : frobenius (ZMod p) p = RingHom.id _ :=
  by
  ext a
  rw [frobenius_def, ZMod.pow_card, RingHom.id_apply]
#align zmod.frobenius_zmod ZMod.frobenius_zMod

@[simp]
theorem card_units (p : ℕ) [Fact p.Prime] : Fintype.card (ZMod p)ˣ = p - 1 := by
  rw [Fintype.card_units, card]
#align zmod.card_units ZMod.card_units

/-- **Fermat's Little Theorem**: for every unit `a` of `zmod p`, we have `a ^ (p - 1) = 1`. -/
theorem units_pow_card_sub_one_eq_one (p : ℕ) [Fact p.Prime] (a : (ZMod p)ˣ) : a ^ (p - 1) = 1 := by
  rw [← card_units p, pow_card_eq_one]
#align zmod.units_pow_card_sub_one_eq_one ZMod.units_pow_card_sub_one_eq_one

/-- **Fermat's Little Theorem**: for all nonzero `a : zmod p`, we have `a ^ (p - 1) = 1`. -/
theorem pow_card_sub_one_eq_one {p : ℕ} [Fact p.Prime] {a : ZMod p} (ha : a ≠ 0) :
    a ^ (p - 1) = 1 := by
  have h := pow_card_sub_one_eq_one a ha
  rwa [ZMod.card p] at h
#align zmod.pow_card_sub_one_eq_one ZMod.pow_card_sub_one_eq_one

theorem orderOf_units_dvd_card_sub_one {p : ℕ} [Fact p.Prime] (u : (ZMod p)ˣ) : orderOf u ∣ p - 1 :=
  orderOf_dvd_of_pow_eq_one <| units_pow_card_sub_one_eq_one _ _
#align zmod.order_of_units_dvd_card_sub_one ZMod.orderOf_units_dvd_card_sub_one

theorem orderOf_dvd_card_sub_one {p : ℕ} [Fact p.Prime] {a : ZMod p} (ha : a ≠ 0) :
    orderOf a ∣ p - 1 :=
  orderOf_dvd_of_pow_eq_one <| pow_card_sub_one_eq_one ha
#align zmod.order_of_dvd_card_sub_one ZMod.orderOf_dvd_card_sub_one

open Polynomial

theorem expand_card {p : ℕ} [Fact p.Prime] (f : Polynomial (ZMod p)) :
    expand (ZMod p) p f = f ^ p :=
  by
  have h := FiniteField.expand_card f
  rwa [ZMod.card p] at h
#align zmod.expand_card ZMod.expand_card

end ZMod

/-- **Fermat's Little Theorem**: for all `a : ℤ` coprime to `p`, we have
`a ^ (p - 1) ≡ 1 [ZMOD p]`. -/
theorem Int.ModEq.pow_card_sub_one_eq_one {p : ℕ} (hp : Nat.Prime p) {n : ℤ} (hpn : IsCoprime n p) :
    n ^ (p - 1) ≡ 1 [ZMOD p] := by
  haveI : Fact p.prime := ⟨hp⟩
  have : ¬(n : ZMod p) = 0 :=
    by
    rw [CharP.int_cast_eq_zero_iff _ p, ← (nat.prime_iff_prime_int.mp hp).coprime_iff_not_dvd]
    · exact hpn.symm
    exact ZMod.charP p
  simpa [← ZMod.int_cast_eq_int_cast_iff] using ZMod.pow_card_sub_one_eq_one this
#align int.modeq.pow_card_sub_one_eq_one Int.ModEq.pow_card_sub_one_eq_one

section

namespace FiniteField

variable {F : Type _} [Field F]

section Finite

variable [Finite F]

/-- In a finite field of characteristic `2`, all elements are squares. -/
theorem isSquare_of_char_two (hF : ringChar F = 2) (a : F) : IsSquare a :=
  haveI hF' : CharP F 2 := ringChar.of_eq hF
  isSquare_of_charTwo' a
#align finite_field.is_square_of_char_two FiniteField.isSquare_of_char_two

/-- In a finite field of odd characteristic, not every element is a square. -/
theorem exists_nonsquare (hF : ringChar F ≠ 2) : ∃ a : F, ¬IsSquare a :=
  by
  -- Idea: the squaring map on `F` is not injective, hence not surjective
  let sq : F → F := fun x => x ^ 2
  have h : ¬injective sq :=
    by
    simp only [injective, not_forall, exists_prop]
    refine' ⟨-1, 1, _, Ring.neg_one_ne_one_of_char_ne_two hF⟩
    simp only [sq, one_pow, neg_one_sq]
  rw [Finite.injective_iff_surjective] at h
  -- sq not surjective
  simp_rw [IsSquare, ← pow_two, @eq_comm _ _ (_ ^ 2)]
  push_neg  at h⊢
  exact h
#align finite_field.exists_nonsquare FiniteField.exists_nonsquare

end Finite

variable [Fintype F]

/-- The finite field `F` has even cardinality iff it has characteristic `2`. -/
theorem even_card_iff_char_two : ringChar F = 2 ↔ Fintype.card F % 2 = 0 :=
  by
  rcases FiniteField.card F (ringChar F) with ⟨n, hp, h⟩
  rw [h, Nat.pow_mod]
  constructor
  · intro hF
    rw [hF]
    simp only [Nat.bit0_mod_two, zero_pow', Ne.def, PNat.ne_zero, not_false_iff, Nat.zero_mod]
  · rw [← Nat.even_iff, Nat.even_pow]
    rintro ⟨hev, hnz⟩
    rw [Nat.even_iff, Nat.mod_mod] at hev
    exact (Nat.Prime.eq_two_or_odd hp).resolve_right (ne_of_eq_of_ne hev zero_ne_one)
#align finite_field.even_card_iff_char_two FiniteField.even_card_iff_char_two

theorem even_card_of_char_two (hF : ringChar F = 2) : Fintype.card F % 2 = 0 :=
  even_card_iff_char_two.mp hF
#align finite_field.even_card_of_char_two FiniteField.even_card_of_char_two

theorem odd_card_of_char_ne_two (hF : ringChar F ≠ 2) : Fintype.card F % 2 = 1 :=
  Nat.mod_two_ne_zero.mp (mt even_card_iff_char_two.mpr hF)
#align finite_field.odd_card_of_char_ne_two FiniteField.odd_card_of_char_ne_two

/-- If `F` has odd characteristic, then for nonzero `a : F`, we have that `a ^ (#F / 2) = ±1`. -/
theorem pow_dichotomy (hF : ringChar F ≠ 2) {a : F} (ha : a ≠ 0) :
    a ^ (Fintype.card F / 2) = 1 ∨ a ^ (Fintype.card F / 2) = -1 :=
  by
  have h₁ := FiniteField.pow_card_sub_one_eq_one a ha
  rw [← Nat.two_mul_odd_div_two (FiniteField.odd_card_of_char_ne_two hF), mul_comm, pow_mul,
    pow_two] at h₁
  exact mul_self_eq_one_iff.mp h₁
#align finite_field.pow_dichotomy FiniteField.pow_dichotomy

/-- A unit `a` of a finite field `F` of odd characteristic is a square
if and only if `a ^ (#F / 2) = 1`. -/
theorem unit_isSquare_iff (hF : ringChar F ≠ 2) (a : Fˣ) :
    IsSquare a ↔ a ^ (Fintype.card F / 2) = 1 := by
  classical
    obtain ⟨g, hg⟩ := IsCyclic.exists_generator Fˣ
    obtain ⟨n, hn⟩ : a ∈ Submonoid.powers g :=
      by
      rw [mem_powers_iff_mem_zpowers]
      apply hg
    have hodd := Nat.two_mul_odd_div_two (FiniteField.odd_card_of_char_ne_two hF)
    constructor
    · rintro ⟨y, rfl⟩
      rw [← pow_two, ← pow_mul, hodd]
      apply_fun @coe Fˣ F _ using Units.ext
      · push_cast
        exact FiniteField.pow_card_sub_one_eq_one (y : F) (Units.ne_zero y)
    · subst a
      intro h
      have key : 2 * (Fintype.card F / 2) ∣ n * (Fintype.card F / 2) :=
        by
        rw [← pow_mul] at h
        rw [hodd, ← Fintype.card_units, ← orderOf_eq_card_of_forall_mem_zpowers hg]
        apply orderOf_dvd_of_pow_eq_one h
      have : 0 < Fintype.card F / 2 := Nat.div_pos Fintype.one_lt_card (by norm_num)
      obtain ⟨m, rfl⟩ := Nat.dvd_of_mul_dvd_mul_right this key
      refine' ⟨g ^ m, _⟩
      rw [mul_comm, pow_mul, pow_two]
#align finite_field.unit_is_square_iff FiniteField.unit_isSquare_iff

/-- A non-zero `a : F` is a square if and only if `a ^ (#F / 2) = 1`. -/
theorem isSquare_iff (hF : ringChar F ≠ 2) {a : F} (ha : a ≠ 0) :
    IsSquare a ↔ a ^ (Fintype.card F / 2) = 1 :=
  by
  apply
    (iff_congr _ (by simp [Units.ext_iff])).mp (FiniteField.unit_isSquare_iff hF (Units.mk0 a ha))
  simp only [IsSquare, Units.ext_iff, Units.val_mk0, Units.val_mul]
  constructor
  · rintro ⟨y, hy⟩
    exact ⟨y, hy⟩
  · rintro ⟨y, rfl⟩
    have hy : y ≠ 0 := by
      rintro rfl
      simpa [zero_pow] using ha
    refine' ⟨Units.mk0 y hy, _⟩
    simp
#align finite_field.is_square_iff FiniteField.isSquare_iff

end FiniteField

end


import Spa.localization_Huber
import Spa.presheaf
import sheaves.stalk_of_rings

/-!
# The valuation on the stalk

We define the valuations on the stalks of the structure presheaf of the adic spectrum.

The strategy is as follows:

1. Recall that a point in the adic spectrum is an equivalence class of valuations.
We pick a representative v. This valuation has a valuation field
that does not depend on the choice of representative (up to isomorphism).

2. Define a map from the stalk above [v] to K_v-hat, the completion of the valuation field of v.

3. Extend v to the completion of its valuation field.

4. Pullback v along the map constructed in 2.

The hard parts of this outline are #2 and #3,
however #3 has been dealt with in valuation/valuation_field_completion.lean.
That leaves us with #2.

The stalk of a presheaf F at a point x consists of “germs”:
pairs (U,s) of an open neighbourhood U of x and a section s in F(U),
modulo an equivalence relation.

To define a map out of the stalk, we can use a recursor,
and define the map on the sections s in F(U) for open neigbourhoods U of x.
But we have to check a compatibility condition, and this takes some effort.

Let us translate this to the context of the structure presheaf of the adic spectrum.
The sections above a rational open subset R(T/s) are:

  rat_open_data_completion r := A<T/s>

* We define a map A<T/s> → K_v-hat.
* We show that this map satisfies the property that if v in D(T1,s1) ⊂ D(T2,s2) then
  the maps A<Ti/si> → K_v-hat commute with the restriction map.
* We then show that we can get compatible maps O_X(U) → K_v-hat for an arbitrary open with v ∈ U.

Once this is in place, we can apply the recursor, to get the desired map from #2.
-/

open_locale classical
open topological_space valuation Spv spa uniform_space

namespace spa

variable {A : Huber_pair}

local attribute [instance] valued.uniform_space

namespace rational_open_data

/-- The natural map from A<T/s> to the completion of the valuation field of a valuation v
contained in R(T/s). -/
noncomputable def to_complete_valuation_field (r : rational_open_data A) {v : spa A}
  (hv : v ∈ r.open_set) :
  rat_open_data_completion r → completion (valuation_field (Spv.out v.1)) :=
completion.map (Huber_pair.rational_open_data.to_valuation_field hv)

variables {r r1 r2 : rational_open_data A} {v : spa A} (hv : v ∈ r.open_set)

/-- The natural map from A<T/s> to the completion of the valuation field of a valuation v
contained in R(T/s) is a ring homomorphism. -/
instance to_complete_valuation_field_is_ring_hom :
  is_ring_hom (r.to_complete_valuation_field hv) :=
completion.is_ring_hom_map (Huber_pair.rational_open_data.to_valuation_field_cts hv)

-- Next we need to show that the completed maps to K_v-hat
-- all commute with the restriction maps.

/-- The maps from rationals opens to completions commute with allowable restriction maps. -/
theorem to_valuation_field_commutes (hv1 : v ∈ r1.open_set) (hv2 : v ∈ r2.open_set) (h : r1 ≤ r2) :
  (r2.to_complete_valuation_field hv2) ∘ (rat_open_data_completion.restriction h) =
  (r1.to_complete_valuation_field hv1) :=
begin
  delta to_complete_valuation_field,
  delta rat_open_data_completion.restriction,
  have uc1 : uniform_continuous (rational_open_data.localization_map h),
    from rational_open_data.localization_map_is_uniform_continuous h,
  have uc2 : uniform_continuous (Huber_pair.rational_open_data.to_valuation_field hv2),
    from uniform_continuous_of_continuous (Huber_pair.rational_open_data.to_valuation_field_cts hv2),
  rw [Huber_pair.rational_open_data.to_valuation_field_commutes hv1 hv2 h, completion.map_comp uc2 uc1]
end

end rational_open_data

-- Now we need to show that for any 𝒪_X(U) with v in U we have a map to K_v-hat.
-- First let's write a noncomputable function which gets a basis element.
section
variables {v : spa A} {U : opens (spa A)}

lemma exists_rational_open_subset (hv : v ∈ U) :
  ∃ r : rational_open_data_subsets U, v ∈ r.1.open_set :=
begin
  suffices : U.1 ∈ nhds v,
  { rw mem_nhds_of_is_topological_basis (rational_basis.is_basis) at this,
    rcases this with ⟨_, ⟨r, rfl⟩, hv, hr⟩,
    use ⟨r, hr⟩,
    exact hv, },
  apply mem_nhds_sets U.2 hv,
end

/-- Given an open set U and a valuation v, this function chooses a random rational open subset
containing v and contained in U. -/
noncomputable def rational_open_subset_nhd (hv : v ∈ U) :
  rational_open_data_subsets U :=
classical.some $ spa.exists_rational_open_subset hv

lemma mem_rational_open_subset_nhd (hv : v ∈ U) :
  v ∈ (spa.rational_open_subset_nhd hv).1.open_set :=
classical.some_spec $ spa.exists_rational_open_subset hv

end

namespace presheaf
open rational_open_data
variables {v : spa A} {U : opens (spa A)} (hv : v ∈ U) (f : spa.presheaf_value U)

/-- The map from F(U) to K_v for v ∈ U, that restricts a section of the structure presheaf
to the completion of the valuation field of v. -/
noncomputable def to_valuation_field_completion :
  completion (valuation_field (Spv.out v.1)) :=
to_complete_valuation_field _ (spa.mem_rational_open_subset_nhd hv) $
  f.1 $ spa.rational_open_subset_nhd hv

/-- Restricting a section of the structure presheaf to a smaller open set is a ring homomorphism.-/
instance restriction_is_ring_hom (U : opens (spa A)) (r : rational_open_data_subsets U) :
  is_ring_hom (λ (f : presheaf_value U), f.val r) :=
{ map_one := rfl,
  map_mul := λ _ _, rfl,
  map_add := λ _ _, rfl }

/-- The map that restricts a section of the structure presheaf above U to the completion of
the valuation field of v ∈ U is a ring homomorphism. -/
instance : is_ring_hom (to_valuation_field_completion hv) :=
begin
  show is_ring_hom
    ((to_complete_valuation_field _ (spa.mem_rational_open_subset_nhd hv)) ∘
      (λ (f : presheaf_value U), (f.val (spa.rational_open_subset_nhd hv)))),
  exact is_ring_hom.comp _ _,
end

-- We need to prove that if V ⊆ U then to_valuation_field_completion commutes with restriction.

-- Before we even start with this terrifying noncomputable spa.rational_open_subset_nhd
-- let's check that spa.rat_open_data_completion.to_complete_valuation_field commutes with ≤.

-- We will place these helper lemmas in a separate namespace

namespace to_valuation_field_completion_well_defined
variables {r1 r2 : rational_open_data_subsets U}
variables (h1 : v ∈ r1.1.open_set) (h2 : v ∈ r2.1.open_set)
include h1 h2

lemma aux₁ :
  to_complete_valuation_field _ h1 (f.1 r1) = to_complete_valuation_field _
    (show v ∈ (r1.1.inter r2.1).open_set, by { rw inter_open_set, exact ⟨h1, h2⟩ })
  (f.1 (rational_open_data_subsets_inter r1 r2)) :=
begin
  rw ← to_valuation_field_commutes h1 _ (rational_open_data.le_inter_left r1.1 r2.1),
  swap, { rw rational_open_data.inter_open_set, exact ⟨h1, h2⟩ },
  delta function.comp,
  congr' 1,
  -- exact times out here; convert closes the goal really quickly
  convert f.2 r1 (rational_open_data_subsets_inter r1 r2) _,
end

-- now the other way
lemma aux₂ :
  to_complete_valuation_field _ h2 (f.1 r2) = to_complete_valuation_field _
    (show v ∈ (r1.1.inter r2.1).open_set, by { rw inter_open_set, exact ⟨h1, h2⟩ })
  (f.1 (rational_open_data_subsets_inter r1 r2)) :=
begin
  rw ← to_valuation_field_commutes h2 _ (rational_open_data.le_inter_right r1.1 r2.1),
  swap, { rw rational_open_data.inter_open_set, exact ⟨h1, h2⟩ },
  delta function.comp,
  congr' 1,
  -- exact times out here; convert closes the goal really quickly
  convert f.2 r2 (rational_open_data_subsets_inter r1 r2) _,
end

-- now let's check it agrees on any rational_open_data_subsets
lemma aux₃ :
  to_complete_valuation_field _ h1 (f.1 r1) = to_complete_valuation_field _ h2 (f.1 r2) :=
by rw [aux₁ f h1 h2, aux₂ f h1 h2]

end to_valuation_field_completion_well_defined

-- next I will prove that for every r : rational_open_data_subsets U with v ∈ r.1.rational_open,
-- f gets sent to the same thing.
lemma to_valuation_field_completion_well_defined
  (r : rational_open_data_subsets U) (hr : v ∈ r.1.open_set) :
  to_valuation_field_completion hv f = to_complete_valuation_field _ hr (f.1 r) :=
to_valuation_field_completion_well_defined.aux₃ f _ hr

-- now the main goal

/-- If v ∈ U then the map from 𝒪_X(U) to `completion (valuation_field v)`
    commutes with restriction (so we can get a map from the stalk at v) -/
theorem to_valuation_field_completion_commutes {U V : opens (spa A)} (hv : v ∈ U)
  (hUV : U ⊆ V) (f : spa.presheaf_value V) :
  to_valuation_field_completion (hUV hv) f =
  to_valuation_field_completion hv (spa.presheaf_map hUV f) :=
begin
  -- to_valuation_field_completion involves choosing a random basis element.
  let rU := rational_open_subset_nhd hv,
  let rV := rational_open_subset_nhd (hUV hv),
  -- we now need to intersect these two things.
  let rUV1 := rU.1.inter rV.1,
  rw [to_valuation_field_completion_well_defined hv (spa.presheaf_map hUV f) ⟨rUV1, _⟩,
      to_valuation_field_completion_well_defined (hUV hv) f ⟨rUV1, _⟩],
  { refl },
  { rw rational_open_data.inter_open_set,
    exact ⟨mem_rational_open_subset_nhd hv, mem_rational_open_subset_nhd _⟩, },
  { rw rational_open_data.inter_open_set,
    exact set.subset.trans (set.inter_subset_left _ _) rU.2 },
end

set_option class.instance_max_depth 49

/--An auxiliary function in the definition of the valuations on the stalks
of the structure presheaf of the adic spectrum of a Huber pair:
the valuation is obtained by pulling back a valuation along this function.

It is the natural map from the stalk above a point in spa(A),
which is an equivalence class of valuations,
to the completion of the valuation field of a valuation
that is a representative of this equivalence class. -/
noncomputable def stalk_to_valuation_field (x : spa A) :
  stalk_of_rings (spa.presheaf_of_topological_rings A).to_presheaf_of_rings x →
  completion (valuation_field (Spv.out x.1)) :=
to_stalk.rec (spa.presheaf_of_topological_rings A).to_presheaf_of_rings x
  (completion (valuation_field (Spv.out x.1))) (λ U hxU, to_valuation_field_completion hxU)
  (λ U V HUV r hxU, (to_valuation_field_completion_commutes hxU HUV r).symm)

/-- The natural map from the stalk above a point v in spa(A) to the
completion of the valuation field of v is a ring homomorphism. -/
instance stalk_to_valuation_field.is_ring_hom (x : spa A) :
  is_ring_hom (stalk_to_valuation_field x) := to_stalk.rec_is_ring_hom _ _ _ _ _

/--The valuation on the stalk of the structure presheaf of the adic spectrum.-/
noncomputable def stalk_valuation (x : spa A) :
  valuation (stalk_of_rings (spa.presheaf_of_topological_rings A).to_presheaf_of_rings x)
    (value_monoid (out x.1)) :=
(valuation_on_completion (out x.1)).comap (stalk_to_valuation_field x)

end presheaf

end spa