/-
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


-- import data.set
import tactic

-- dEAduction imports
import structures2
import user_notations
import utils

-- General principles :
-- Type should be defined as parameters, in order to be implicit everywhere
-- other parameters are implicit in definitions, i.e. defined using '{}' (e.g. {A : set X} )
-- but explicit everywhere else, i.e. defined using '()' (e.g. (A : set X) )
-- each definition must be an iff statement (since it will be called with 'rw' or 'symp_rw')

---------------------
-- Course metadata --
---------------------
-- logic names ['and', 'or', 'negate', 'implicate', 'iff', 'forall', 'exists']
-- proofs names ['use_proof_methods', 'new_object', 'apply', 'assumption']
-- magic names ['compute']
-- proof methods names ['cbr', 'contrapose', 'absurdum', 'todo']

/- dEAduction
Title
    Tests logic buttons
Author
    Frédéric Le Roux
Institution
    Université de France
-/

local attribute [instance] classical.prop_decidable

---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course
-- parameters {X Y Z: Type}

notation [parsing_only] P ` and ` Q := P ∧ Q
notation [parsing_only]  P ` or ` Q := P ∨ Q
notation [parsing_only]  ` not ` P := ¬ P
notation [parsing_only]  P ` implies ` Q := P → Q
notation [parsing_only]  P ` iff ` Q := P ↔ Q

notation [parsing_only]  x ` in ` A := x ∈ A
notation [parsing_only]  A ` cap ` B := A ∩ B
notation [parsing_only]  A ` cup ` B := A ∪ B
notation [parsing_only]  A ` subset ` B := A ⊆ B
notation [parsing_only]  `emptyset` := ∅
notation [parsing_only]  `vide` := ∅

notation [parsing_only] P ` et ` Q := P ∧ Q
notation [parsing_only]  P ` ou ` Q := P ∨ Q
notation [parsing_only]  ` non ` P := ¬ P
notation [parsing_only]  P ` implique ` Q := P → Q
notation [parsing_only]  P ` ssi ` Q := P ↔ Q

notation [parsing_only]  x ` dans ` A := x ∈ A
notation [parsing_only]  x ` appartient ` A := x ∈ A
notation [parsing_only]  A ` inter ` B := A ∩ B
notation [parsing_only]  A ` intersection ` B := A ∩ B
notation [parsing_only]  A ` union ` B := A ∪ B
notation [parsing_only]  A ` inclus ` B := A ⊆ B

notation f `⟮` A `⟯` := f '' A
notation f `⁻¹⟮` A `⟯` := f  ⁻¹' A
notation [parsing_only] f `inverse` A := f  ⁻¹' A
notation g `∘` f := set.composition g f
notation `∃!` P := exists_unique P

open set
parameters X Y Z: Type
------------------
-- COURSE TITLE --
------------------
namespace theorie_des_ensembles
/- dEAduction
PrettyName
    Théorie des ensembles
-/

namespace generalites
/- dEAduction
PrettyName
    Généralités
-/

------------------------
-- COURSE DEFINITIONS --
------------------------
lemma definition.inclusion {A B : set X} : A ⊆ B ↔ ∀ {x:X}, x ∈ A → x ∈ B :=
begin
    exact iff.rfl
end

lemma definition.egalite_deux_ensembles {A A' : set X} :
(A = A') ↔ ( ∀ x, x ∈ A ↔ x ∈ A' ) :=
/- dEAduction
PrettyName
    Egalité de deux ensembles
-/
begin
     exact set.ext_iff
end

lemma definition.ensemble_vide
(A: set X) :
(A = ∅) ↔ ∀ x : X, x ∉ A
:=
begin
    exact eq_empty_iff_forall_not_mem,
end

-- lemma definition.ensemble_non_vide
-- (A: set X) :
-- (A ≠ ∅) ↔ ∃ x : X, x ∈ A
-- :=
-- begin
--     todo
-- end

-- set_option pp.all true
lemma definition.ensemble_extension {X: Type}  {P : X → Prop} {x:X} :
 x ∈ {x | P x} ↔ P x
:=
/- dEAduction
PrettyName
    Ensemble en extension
-/
begin
    refl
end

lemma theorem.double_inclusion (A A' : set X) :
(A ⊆ A' ∧ A' ⊆ A) → A = A' :=
/- dEAduction
PrettyName
    Double inclusion
-/
begin
    exact set.subset.antisymm_iff.mpr
end

lemma exercise.inclusion_transitive
(A B C : set X) :
(A ⊆ B ∧ B ⊆ C) → A ⊆ C
:=
/- dEAduction
PrettyName
    Transitivité de l'inclusion
-/
begin
    intro H1,
    rw definition.inclusion,
    intros x H2,
    cases H1 with H3 H4,
    rw definition.inclusion at H3 H4,
    have H5 := H3 H2,
    have H6 := H4 H5,
    assumption,
end

example (x y:X) (H : x ≠ y) : y ≠ x :=
begin
    apply ne.symm, assumption,
end

end generalites

---------------------------
--- TESTS LOGIC BUTTONS ---
---------------------------
namespace tests_logic_buttons

-----------
--- AND ---
-----------
namespace tests_and
lemma exercise.test_construct_and_left
(P Q : Prop) (H1: P) (H2 : Q) : P ∧ Q :=
/- dEAduction
AutoTest
    ∧ 0, CQFD, CQFD
-/
begin
  todo
end

lemma exercise.test_construct_and_right
(P Q : Prop) (H1: P) (H2 : Q) :
P ∧ Q :=
/- dEAduction
AutoTest
    ∧ 1, CQFD, CQFD
-/
begin
  todo
end

lemma exercise.test_apply_and
(P Q : Prop) (H1: P ∧ Q):
P :=
/- dEAduction
AutoTest
    H1 ∧,
    CQFD
-/
begin
  todo
end

lemma exercise.test_construct_and_hyp
(P Q : Prop)  (H1: P) (H2 : Q):
P ∧ Q :=
/- dEAduction
AutoTest
    @P1 @P2 ∧, CQFD
-/
begin
  todo,
end
end tests_and

----------
--- OR ---
----------
namespace test_or

lemma exercise.test_construct_or_right
(P Q : Prop) (H1: P) : P ∨ Q :=
/- dEAduction
AutoTest
    ∨ 0,
    CQFD
-/
begin
  todo
end

lemma exercise.test_construct_or_left
(P Q : Prop) (H1: Q) : P ∨ Q :=
/- dEAduction
AutoTest
    ∨ 1,
    CQFD
-/
begin
  todo
end

lemma exercise.test_apply_or_left
(P Q : Prop) (H1: P ∨ Q):
P ∨ Q :=
/- dEAduction
AutoTest
    H1 ∨ 0,
    ∨ 0,
    CQFD,
    ∨ 1,
    CQFD
-/
begin
  todo
end

lemma exercise.test_apply_or_right
(P Q : Prop) (H1: P ∨ Q) : P ∨ Q :=
/- dEAduction
AutoTest
    H1 ∨ 1,
    ∨ 1,
    CQFD,
    ∨ 0,
    CQFD
-/
begin
  todo
end

lemma exercise.test_construct_or_on_hyp_left
(P Q : Prop) (H1: P):
P ∨ Q :=
/- dEAduction
AutoTest
    H1 ∨ Q 0,
    CQFD
-/
begin
  todo
end

lemma exercise.test_construct_or_on_hyp_right
(P Q : Prop) (H1: Q):
P ∨ Q :=
/- dEAduction
AutoTest
    H1 ∨ P 1,
    CQFD
-/
begin
  todo
end

end test_or

-----------
--- NOT ---
-----------
namespace test_not

lemma exercise.test_action_negate_hyp
(X: Type) (P Q : X × X → Prop)
(H1: ¬ (∀ x:X, ∃ y:X, P(x,y) ∨ Q(x,y)) ):
∃ x:X, ∀ y:X, ¬ P(x,y) ∧ ¬ Q(x,y) :=
/- dEAduction
AutoTest
    H1 ¬,
    CQFD
-/
begin
  todo
end

lemma exercise.test_action_negate_target
(X: Type) (P Q : X × X → Prop)
(H1: ∀ x:X, ∃ y:X, P(x,y) ∨ Q(x,y) ):
¬ (∃ x:X, ∀ y:X, ¬ P(x,y) ∧ ¬ Q(x,y))
 :=
/- dEAduction
AutoTest
    ¬,
    CQFD
-/
begin
  todo
end

end test_not

-----------------
--- IMPLICATE ---
-----------------
namespace test_implicate

lemma exercise.test_construct_implies
(P Q : Prop) (H1: Q) :
P → Q :=
/- dEAduction
AutoTest
    →,
    CQFD
-/
begin
  todo
end

lemma exercise.test_apply_implies
(P Q : Prop) (H1: P) (H2: P → Q) :
Q :=
/- dEAduction
AutoTest
    target H2 →,
    CQFD
-/
begin
  todo
end

lemma exercise.test_apply_implies_to_hyp
(P Q : Prop) (H1: P) (H2: P → Q) :
Q :=
/- dEAduction
AutoTest
    H1 H2 →,
    CQFD
-/
begin
  todo
end

lemma exercise.test_apply_implies_to_hyp_2
(X: Type) (P Q: X × X → Prop) (x y: X)
(H1: P(x,y)) (H2: ∀ x y:X, P(x,y) → Q(x,y)) :
Q(x,y) :=
/- dEAduction
AutoTest
    H1 H2 →,
    CQFD
-/
begin
  todo
end
end test_implicate

-----------
--- IFF ---
-----------
namespace test_iff

lemma exercise.test_construct_iff_left
(P Q : Prop) (H1: P → Q) (H2: Q → P):
P ↔ Q
:=
/- dEAduction
AutoTest
    ↔ 0, CQFD, CQFD
-/
begin
  todo
end

lemma exercise.test_construct_iff_right
(P Q : Prop) (H1: P → Q) (H2: Q → P):
P ↔ Q
:=
/- dEAduction
AutoTest
    ↔ 1, CQFD, CQFD
-/
begin
  todo
end

lemma exercise.test_construct_iff_with_and
(P Q : Prop) (H1: P → Q) (H2: Q → P):
P ↔ Q
:=
/- dEAduction
AutoTest
    ∧ 0, CQFD, CQFD
-/
begin
  todo
end

lemma exercise.test_destruct_iff
(P Q : Prop)  (H1: P ↔ Q):
(P → Q) ∧ (Q → P)
:=
/- dEAduction
AutoTest
    ↔, CQFD
-/
begin
  todo,
end

-- lemma exercise.test_destruct_iff_on_hyp
-- (P Q : Prop) (H1: P ↔ Q):
-- (P → Q) ∧ (Q → P)
-- :=
-- /- dEAduction
-- AutoTest
--     H1 ↔, CQFD
-- -/
-- begin
--   cases H1 with H1a H1b, split,
--   assumption, assumption,
-- end

lemma exercise.test_construct_iff_on_hyp
(P Q : Prop) (H1: P → Q) (H2: Q → P):
P ↔ Q
:=
/- dEAduction
AutoTest
    H1 H2 ↔, CQFD
-/
begin
  todo
end

lemma exercise.test_iff_as_implies_target
(X: Type) (P Q : X → Prop)
(H: ∀ x, (P x ↔ Q x))  (x:X) (H': P x) :
Q x
:=
/- dEAduction
AutoTest
    H ↔, CQFD
-/
begin
  todo
end

lemma exercise.test_iff_as_implies_hyp
(X: Type) (P Q : X → Prop)
(H: ∀ x, (P x ↔ Q x))  (x:X) (H': P x) :
Q x
:=
/- dEAduction
AutoTest
    H H' ↔, CQFD
-/
begin
  todo
end

end test_iff

--------------
--- FORALL ---
--------------
namespace test_forall

lemma exercise.test_construct_and_apply_forall
(X: Type) (P: X → Prop)
(H1: ∀ x:X, P(x)) :
∀ x:X, P(x) :=
/- dEAduction
AutoTest
    ∀,
    @O3 @P1 ∀,
    CQFD
-/
begin
  todo
end

lemma exercise.test_apply_forall_to_hyp
(X: Type) (P Q: X × X → Prop) (x y: X)
(H1: P(x,y)) (H2: ∀ x y:X, P(x,y) → Q(x,y)) :
Q(x,y) :=
/- dEAduction
AutoTest
    @O4 @O5 H1 H2 ∀,
    CQFD
-/
begin
  todo
end
end test_forall

--------------
--- EXISTS ---
--------------
namespace test_exists

lemma exercise.test_construct_exists
(X: Type) (P: X → Prop) (z: X)
(H1: P(z)) :
∃ x:X, P(x) :=
/- dEAduction
AutoTest
    @O3 ∃,
    CQFD
-/
begin
  todo
end

lemma exercise.test_construct_exists_2
(X: Type) (P: X → Prop) (z: X)
(H1: P(z)) :
∃ x:X, P(x) :=
/- dEAduction
AutoTest
    ∃ z,
    CQFD
-/
begin
  todo
end

lemma exercise.test_apply_exists_and_construct_exists_on_hyp
(X: Type) (P Q: X → Prop)
(H1: ∃ x:X, P(x))
(H2: ∀x:X, P(x) → Q(x)) :
(∃ x:X, Q(x))
:=
/- dEAduction
AutoTest
    H1 ∃,
    @P2 H2 →,
    @O4 @P3 ∃,
    CQFD
-/
begin
  todo
end
end test_exists

namespace test_equality
----------------
--- equality ---
----------------

lemma exercise.test_apply_equality1
(A B: set X) (x y : X) (f: X → Y) (H: x = y) (H': x ∈ A) (H'': A =B):
y ∈ B :=
/- dEAduction
AutoTest
    H' H =,
    H' H'' =,
    CQFD
-/
begin
  todo
end

lemma exercise.test_apply_equality_target1
(x y : X) (f: X → Y) (H: x = y):
f x= f y :=
/- dEAduction
AutoTest
    H = 0
-/
begin
  todo
end

lemma exercise.test_apply_equality_target2
(x y : X) (f: X → Y) (H: x = y):
f x= f y :=
/- dEAduction
AutoTest
    H = 1
-/
begin
  todo
end

lemma exercise.test_apply_equality_equality1
(x y z: X) (f: X → Y) (H: x = y) (H': y = z):
x = z :=
/- dEAduction
AutoTest
    H' H = 0,
    CQFD
-/
begin
  todo
end

lemma exercise.test_apply_equality_equality2
(x y z : X) (f: X → Y) (H: x = y) (H': y = z):
x = z :=
/- dEAduction
AutoTest
    H' H = 1,
    CQFD
-/
begin
  todo
end

lemma exercise.test_apply_equality_equality_and_direction1
(x y z : X) (f: X → Y) (H: x = y) (H': x = y):
x = z :=
/- dEAduction
AutoTest
    H' H = 0 0,
    proof_methods 3
-/
begin
  todo
end

lemma exercise.test_apply_equality_equality_and_direction2
(x y z : X) (f: X → Y) (H: x = y) (H': x = y):
x = z :=
/- dEAduction
AutoTest
    H' H = 0 1,
    proof_methods 3
-/
begin
  todo
end
lemma exercise.test_apply_equality_equality_and_direction3
(x y z : X) (f: X → Y) (H: x = y) (H': x = y):
x = z :=
/- dEAduction
AutoTest
    H' H = 1 0,
    proof_methods 3
-/
begin
  todo
end
lemma exercise.test_apply_equality_equality_and_direction4
(x y z : X) (f: X → Y) (H: x = y) (H': x = y):
x = z :=
/- dEAduction
AutoTest
    H' H = 1 1,
    proof_methods 3
-/
begin
  todo
end

end test_equality

namespace test_map
--------------
--- map ---
--------------

lemma exercise.test_map_equality1
(x y : X) (f: X → Y) (H: x = y):
f(x) = f(y) :=
/- dEAduction
AutoTest
    H f map,
    CQFD
-/
begin
  todo
end

lemma exercise.test_map_equality2
(x y z w : X) (f: X → Y) (H: x = y) (H': x = z) (H'': z = w):
f(x) = f(y) :=
/- dEAduction
AutoTest
    H f H' H'' map,
    CQFD
-/
begin
  todo
end

lemma exercise.test_map_element_1
(x x' : X) (f: X → Y) :
∃ y:Y, y= f(x') :=
/- dEAduction
AutoTest
    x' f map,
    y exists
-/
begin
  todo
end

lemma exercise.test_map_element_2
(x x' : X) (f: X → Y) :
∃ y:Y, y= f(x') :=
/- dEAduction
AutoTest
    f map x',
    y exists
-/
begin
  todo
end

lemma exercise.test_apply_error_1
(A B: set X) (x y : X) (f: X → Y) (H: x = y) (H': x ∈ A) (H'': A =B):
y ∈ B :=
/- dEAduction
AutoTest
    H' map WUI error=Sélectionner_une_application,
    proof_methods 3
-/
begin
  todo
end

end test_map
end tests_logic_buttons
end theorie_des_ensembles
end course


/-
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 ..lovelib

/-! # LoVe Homework 10: Metaprogramming

Homework must be done individually.

This homework is optional: it consists of one bonus problem!

You do not need to submit it unless you want to.
-/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (5 points): A `harmless` Tactic

We develop a tactic that applies all harmless introduction and elimination
rules for the connectives and quantifiers exhaustively. A rule is said to be
__harmless__ if, given a provable goal, it always gives rise to provable
subgoals. In addition, we will require that harmless rules do not introduce
metavariables (which can easily be instantiated accidentally with the wrong
terms).

We proceed in three steps.

1.1 (1 points). Develop a `harmless_intros` tactic that applies the introduction
rules for `true`, `∧`, and `↔` and that invokes `tactic.intro` (or
`tactic.intro1`) for `→`/`∀`. The tactic generalizes `intro_ands` from the
exercise.

Hint: You can use the `<|>` operator between the tactics used for different
logical symbols. -/

#check tactic.repeat
#check tactic.applyc
#check tactic.intro
#check tactic.intro1

meta def harmless_intros : tactic unit :=
sorry

lemma abcd (a b c d : Prop) :
  a → ¬ b ∧ (c ↔ d) :=
begin
  harmless_intros,
  /- The proof state should be roughly as follows:

  a b c d : Prop,
  a_1 : a,
  a_2 : b
  ⊢ false

  a b c d : Prop,
  a_1 : a,
  a_2 : c
  ⊢ d

  a b c d : Prop,
  a_1 : a,
  a_2 : d
  ⊢ c -/
  repeat { sorry }
end

/-! 1.2 (2 points). Develop a `harmless_destructs` tactic that eliminates
`false`, `∧`, `∨`, `↔`, and `∃`. The tactic generalizes `destruct_ands` from the
exercise. -/

meta def harmless_destructs : tactic unit :=
sorry

lemma abcdef (a b c d e f : Prop) (p : ℕ → Prop)
    (hneg: ¬ a) (hand : a ∧ b ∧ c) (hor : c ∨ d) (himp : b → e) (hiff : e ↔ f)
    (hex : ∃x, p x) :
  false :=
begin
  harmless_destructs,
  /- The proof state should be roughly as follows:

  2 goals
  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  hand_left : a,
  hor : c,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false

  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  hand_left : a,
  hor : d,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false -/
  repeat { sorry }
end

/-! 1.3 (2 points). Implement a `harmless` tactic that first performs
introduction, then elimination, and finally proves all the subgoals that can be
discharged directly by `tactic.assumption`. The tactic generalizes `destro_and`
from the exercise.

Hint: Depending on how you structure your code, the `tactic.try` combinator
might be useful. -/

meta def harmless : tactic unit :=
sorry

lemma abcdef₂ (a b c d e f : Prop) (p : ℕ → Prop)
    (hneg: ¬ a) (hand : a ∧ b ∧ c) (hor : c ∨ d) (himp : b → e) (hiff : e ↔ f)
    (hex : ∃x, p x) :
  a → ¬ b ∧ (c ↔ d) :=
begin
  harmless,
  /- The proof state should be roughly as follows:

  3 goals
  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  a_1 : a,
  a_2 : b,
  hand_left : a,
  hor : c,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false

  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  a_1 : a,
  a_2 : b,
  hand_left : a,
  hor : d,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ false

  a b c d e f : Prop,
  p : ℕ → Prop,
  hneg : ¬a,
  himp : b → e,
  a_1 : a,
  a_2 : c,
  hand_left : a,
  hor : c,
  hiff_mp : e → f,
  hiff_mpr : f → e,
  hex_w : ℕ,
  hex_h : p hex_w,
  hand_right_left : b,
  hand_right_right : c
  ⊢ d -/
  repeat { sorry }
end

end LoVe


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