/-
Copyright (c) 2022 Bolton Bailey. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bolton Bailey, Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne

! This file was ported from Lean 3 source module analysis.special_functions.log.base
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Log.Basic
import Mathbin.Analysis.SpecialFunctions.Pow
import Mathbin.Data.Int.Log

/-!
# Real logarithm base `b`

In this file we define `real.logb` to be the logarithm of a real number in a given base `b`. We
define this as the division of the natural logarithms of the argument and the base, so that we have
a globally defined function with `logb b 0 = 0`, `logb b (-x) = logb b x` `logb 0 x = 0` and
`logb (-b) x = logb b x`.

We prove some basic properties of this function and its relation to `rpow`.

## Tags

logarithm, continuity
-/

open Set Filter Function

open Topology

noncomputable section

namespace Real

variable {b x y : ℝ}

/-- The real logarithm in a given base. As with the natural logarithm, we define `logb b x` to
be `logb b |x|` for `x < 0`, and `0` for `x = 0`.-/
@[pp_nodot]
noncomputable def logb (b x : ℝ) : ℝ :=
  log x / log b
#align real.logb Real.logb

theorem log_div_log : log x / log b = logb b x :=
  rfl
#align real.log_div_log Real.log_div_log

@[simp]
theorem logb_zero : logb b 0 = 0 := by simp [logb]
#align real.logb_zero Real.logb_zero

@[simp]
theorem logb_one : logb b 1 = 0 := by simp [logb]
#align real.logb_one Real.logb_one

@[simp]
theorem logb_abs (x : ℝ) : logb b (|x|) = logb b x := by rw [logb, logb, log_abs]
#align real.logb_abs Real.logb_abs

@[simp]
theorem logb_neg_eq_logb (x : ℝ) : logb b (-x) = logb b x := by
  rw [← logb_abs x, ← logb_abs (-x), abs_neg]
#align real.logb_neg_eq_logb Real.logb_neg_eq_logb

theorem logb_mul (hx : x ≠ 0) (hy : y ≠ 0) : logb b (x * y) = logb b x + logb b y := by
  simp_rw [logb, log_mul hx hy, add_div]
#align real.logb_mul Real.logb_mul

theorem logb_div (hx : x ≠ 0) (hy : y ≠ 0) : logb b (x / y) = logb b x - logb b y := by
  simp_rw [logb, log_div hx hy, sub_div]
#align real.logb_div Real.logb_div

@[simp]
theorem logb_inv (x : ℝ) : logb b x⁻¹ = -logb b x := by simp [logb, neg_div]
#align real.logb_inv Real.logb_inv

section BPosAndNeOne

variable (b_pos : 0 < b)

variable (b_ne_one : b ≠ 1)

include b_pos b_ne_one

private theorem log_b_ne_zero : log b ≠ 0 :=
  by
  have b_ne_zero : b ≠ 0; linarith
  have b_ne_minus_one : b ≠ -1; linarith
  simp [b_ne_one, b_ne_zero, b_ne_minus_one]
#align real.log_b_ne_zero real.log_b_ne_zero

@[simp]
theorem logb_rpow : logb b (b ^ x) = x :=
  by
  rw [logb, div_eq_iff, log_rpow b_pos]
  exact log_b_ne_zero b_pos b_ne_one
#align real.logb_rpow Real.logb_rpow

theorem rpow_logb_eq_abs (hx : x ≠ 0) : b ^ logb b x = |x| :=
  by
  apply log_inj_on_pos
  simp only [Set.mem_Ioi]
  apply rpow_pos_of_pos b_pos
  simp only [abs_pos, mem_Ioi, Ne.def, hx, not_false_iff]
  rw [log_rpow b_pos, logb, log_abs]
  field_simp [log_b_ne_zero b_pos b_ne_one]
#align real.rpow_logb_eq_abs Real.rpow_logb_eq_abs

@[simp]
theorem rpow_logb (hx : 0 < x) : b ^ logb b x = x :=
  by
  rw [rpow_logb_eq_abs b_pos b_ne_one hx.ne']
  exact abs_of_pos hx
#align real.rpow_logb Real.rpow_logb

theorem rpow_logb_of_neg (hx : x < 0) : b ^ logb b x = -x :=
  by
  rw [rpow_logb_eq_abs b_pos b_ne_one (ne_of_lt hx)]
  exact abs_of_neg hx
#align real.rpow_logb_of_neg Real.rpow_logb_of_neg

theorem surjOn_logb : SurjOn (logb b) (Ioi 0) univ := fun x _ =>
  ⟨rpow b x, rpow_pos_of_pos b_pos x, logb_rpow b_pos b_ne_one⟩
#align real.surj_on_logb Real.surjOn_logb

theorem logb_surjective : Surjective (logb b) := fun x => ⟨b ^ x, logb_rpow b_pos b_ne_one⟩
#align real.logb_surjective Real.logb_surjective

@[simp]
theorem range_logb : range (logb b) = univ :=
  (logb_surjective b_pos b_ne_one).range_eq
#align real.range_logb Real.range_logb

theorem surjOn_logb' : SurjOn (logb b) (Iio 0) univ :=
  by
  intro x x_in_univ
  use -b ^ x
  constructor
  · simp only [Right.neg_neg_iff, Set.mem_Iio]
    apply rpow_pos_of_pos b_pos
  · rw [logb_neg_eq_logb, logb_rpow b_pos b_ne_one]
#align real.surj_on_logb' Real.surjOn_logb'

end BPosAndNeOne

section OneLtB

variable (hb : 1 < b)

include hb

private theorem b_pos : 0 < b := by linarith
#align real.b_pos real.b_pos

private theorem b_ne_one : b ≠ 1 := by linarith
#align real.b_ne_one real.b_ne_one

@[simp]
theorem logb_le_logb (h : 0 < x) (h₁ : 0 < y) : logb b x ≤ logb b y ↔ x ≤ y := by
  rw [logb, logb, div_le_div_right (log_pos hb), log_le_log h h₁]
#align real.logb_le_logb Real.logb_le_logb

theorem logb_lt_logb (hx : 0 < x) (hxy : x < y) : logb b x < logb b y :=
  by
  rw [logb, logb, div_lt_div_right (log_pos hb)]
  exact log_lt_log hx hxy
#align real.logb_lt_logb Real.logb_lt_logb

@[simp]
theorem logb_lt_logb_iff (hx : 0 < x) (hy : 0 < y) : logb b x < logb b y ↔ x < y :=
  by
  rw [logb, logb, div_lt_div_right (log_pos hb)]
  exact log_lt_log_iff hx hy
#align real.logb_lt_logb_iff Real.logb_lt_logb_iff

theorem logb_le_iff_le_rpow (hx : 0 < x) : logb b x ≤ y ↔ x ≤ b ^ y := by
  rw [← rpow_le_rpow_left_iff hb, rpow_logb (b_pos hb) (b_ne_one hb) hx]
#align real.logb_le_iff_le_rpow Real.logb_le_iff_le_rpow

theorem logb_lt_iff_lt_rpow (hx : 0 < x) : logb b x < y ↔ x < b ^ y := by
  rw [← rpow_lt_rpow_left_iff hb, rpow_logb (b_pos hb) (b_ne_one hb) hx]
#align real.logb_lt_iff_lt_rpow Real.logb_lt_iff_lt_rpow

theorem le_logb_iff_rpow_le (hy : 0 < y) : x ≤ logb b y ↔ b ^ x ≤ y := by
  rw [← rpow_le_rpow_left_iff hb, rpow_logb (b_pos hb) (b_ne_one hb) hy]
#align real.le_logb_iff_rpow_le Real.le_logb_iff_rpow_le

theorem lt_logb_iff_rpow_lt (hy : 0 < y) : x < logb b y ↔ b ^ x < y := by
  rw [← rpow_lt_rpow_left_iff hb, rpow_logb (b_pos hb) (b_ne_one hb) hy]
#align real.lt_logb_iff_rpow_lt Real.lt_logb_iff_rpow_lt

theorem logb_pos_iff (hx : 0 < x) : 0 < logb b x ↔ 1 < x :=
  by
  rw [← @logb_one b]
  rw [logb_lt_logb_iff hb zero_lt_one hx]
#align real.logb_pos_iff Real.logb_pos_iff

theorem logb_pos (hx : 1 < x) : 0 < logb b x :=
  by
  rw [logb_pos_iff hb (lt_trans zero_lt_one hx)]
  exact hx
#align real.logb_pos Real.logb_pos

theorem logb_neg_iff (h : 0 < x) : logb b x < 0 ↔ x < 1 :=
  by
  rw [← logb_one]
  exact logb_lt_logb_iff hb h zero_lt_one
#align real.logb_neg_iff Real.logb_neg_iff

theorem logb_neg (h0 : 0 < x) (h1 : x < 1) : logb b x < 0 :=
  (logb_neg_iff hb h0).2 h1
#align real.logb_neg Real.logb_neg

theorem logb_nonneg_iff (hx : 0 < x) : 0 ≤ logb b x ↔ 1 ≤ x := by
  rw [← not_lt, logb_neg_iff hb hx, not_lt]
#align real.logb_nonneg_iff Real.logb_nonneg_iff

theorem logb_nonneg (hx : 1 ≤ x) : 0 ≤ logb b x :=
  (logb_nonneg_iff hb (zero_lt_one.trans_le hx)).2 hx
#align real.logb_nonneg Real.logb_nonneg

theorem logb_nonpos_iff (hx : 0 < x) : logb b x ≤ 0 ↔ x ≤ 1 := by
  rw [← not_lt, logb_pos_iff hb hx, not_lt]
#align real.logb_nonpos_iff Real.logb_nonpos_iff

theorem logb_nonpos_iff' (hx : 0 ≤ x) : logb b x ≤ 0 ↔ x ≤ 1 :=
  by
  rcases hx.eq_or_lt with (rfl | hx)
  · simp [le_refl, zero_le_one]
  exact logb_nonpos_iff hb hx
#align real.logb_nonpos_iff' Real.logb_nonpos_iff'

theorem logb_nonpos (hx : 0 ≤ x) (h'x : x ≤ 1) : logb b x ≤ 0 :=
  (logb_nonpos_iff' hb hx).2 h'x
#align real.logb_nonpos Real.logb_nonpos

theorem strictMonoOn_logb : StrictMonoOn (logb b) (Set.Ioi 0) := fun x hx y hy hxy =>
  logb_lt_logb hb hx hxy
#align real.strict_mono_on_logb Real.strictMonoOn_logb

theorem strictAntiOn_logb : StrictAntiOn (logb b) (Set.Iio 0) :=
  by
  rintro x (hx : x < 0) y (hy : y < 0) hxy
  rw [← logb_abs y, ← logb_abs x]
  refine' logb_lt_logb hb (abs_pos.2 hy.ne) _
  rwa [abs_of_neg hy, abs_of_neg hx, neg_lt_neg_iff]
#align real.strict_anti_on_logb Real.strictAntiOn_logb

theorem logb_injOn_pos : Set.InjOn (logb b) (Set.Ioi 0) :=
  (strictMonoOn_logb hb).InjOn
#align real.logb_inj_on_pos Real.logb_injOn_pos

theorem eq_one_of_pos_of_logb_eq_zero (h₁ : 0 < x) (h₂ : logb b x = 0) : x = 1 :=
  logb_injOn_pos hb (Set.mem_Ioi.2 h₁) (Set.mem_Ioi.2 zero_lt_one) (h₂.trans Real.logb_one.symm)
#align real.eq_one_of_pos_of_logb_eq_zero Real.eq_one_of_pos_of_logb_eq_zero

theorem logb_ne_zero_of_pos_of_ne_one (hx_pos : 0 < x) (hx : x ≠ 1) : logb b x ≠ 0 :=
  mt (eq_one_of_pos_of_logb_eq_zero hb hx_pos) hx
#align real.logb_ne_zero_of_pos_of_ne_one Real.logb_ne_zero_of_pos_of_ne_one

theorem tendsto_logb_atTop : Tendsto (logb b) atTop atTop :=
  Tendsto.atTop_div_const (log_pos hb) tendsto_log_atTop
#align real.tendsto_logb_at_top Real.tendsto_logb_atTop

end OneLtB

section BPosAndBLtOne

variable (b_pos : 0 < b)

variable (b_lt_one : b < 1)

include b_lt_one

private theorem b_ne_one : b ≠ 1 := by linarith
#align real.b_ne_one real.b_ne_one

include b_pos

@[simp]
theorem logb_le_logb_of_base_lt_one (h : 0 < x) (h₁ : 0 < y) : logb b x ≤ logb b y ↔ y ≤ x := by
  rw [logb, logb, div_le_div_right_of_neg (log_neg b_pos b_lt_one), log_le_log h₁ h]
#align real.logb_le_logb_of_base_lt_one Real.logb_le_logb_of_base_lt_one

theorem logb_lt_logb_of_base_lt_one (hx : 0 < x) (hxy : x < y) : logb b y < logb b x :=
  by
  rw [logb, logb, div_lt_div_right_of_neg (log_neg b_pos b_lt_one)]
  exact log_lt_log hx hxy
#align real.logb_lt_logb_of_base_lt_one Real.logb_lt_logb_of_base_lt_one

@[simp]
theorem logb_lt_logb_iff_of_base_lt_one (hx : 0 < x) (hy : 0 < y) : logb b x < logb b y ↔ y < x :=
  by
  rw [logb, logb, div_lt_div_right_of_neg (log_neg b_pos b_lt_one)]
  exact log_lt_log_iff hy hx
#align real.logb_lt_logb_iff_of_base_lt_one Real.logb_lt_logb_iff_of_base_lt_one

theorem logb_le_iff_le_rpow_of_base_lt_one (hx : 0 < x) : logb b x ≤ y ↔ b ^ y ≤ x := by
  rw [← rpow_le_rpow_left_iff_of_base_lt_one b_pos b_lt_one, rpow_logb b_pos (b_ne_one b_lt_one) hx]
#align real.logb_le_iff_le_rpow_of_base_lt_one Real.logb_le_iff_le_rpow_of_base_lt_one

theorem logb_lt_iff_lt_rpow_of_base_lt_one (hx : 0 < x) : logb b x < y ↔ b ^ y < x := by
  rw [← rpow_lt_rpow_left_iff_of_base_lt_one b_pos b_lt_one, rpow_logb b_pos (b_ne_one b_lt_one) hx]
#align real.logb_lt_iff_lt_rpow_of_base_lt_one Real.logb_lt_iff_lt_rpow_of_base_lt_one

theorem le_logb_iff_rpow_le_of_base_lt_one (hy : 0 < y) : x ≤ logb b y ↔ y ≤ b ^ x := by
  rw [← rpow_le_rpow_left_iff_of_base_lt_one b_pos b_lt_one, rpow_logb b_pos (b_ne_one b_lt_one) hy]
#align real.le_logb_iff_rpow_le_of_base_lt_one Real.le_logb_iff_rpow_le_of_base_lt_one

theorem lt_logb_iff_rpow_lt_of_base_lt_one (hy : 0 < y) : x < logb b y ↔ y < b ^ x := by
  rw [← rpow_lt_rpow_left_iff_of_base_lt_one b_pos b_lt_one, rpow_logb b_pos (b_ne_one b_lt_one) hy]
#align real.lt_logb_iff_rpow_lt_of_base_lt_one Real.lt_logb_iff_rpow_lt_of_base_lt_one

theorem logb_pos_iff_of_base_lt_one (hx : 0 < x) : 0 < logb b x ↔ x < 1 := by
  rw [← @logb_one b, logb_lt_logb_iff_of_base_lt_one b_pos b_lt_one zero_lt_one hx]
#align real.logb_pos_iff_of_base_lt_one Real.logb_pos_iff_of_base_lt_one

theorem logb_pos_of_base_lt_one (hx : 0 < x) (hx' : x < 1) : 0 < logb b x :=
  by
  rw [logb_pos_iff_of_base_lt_one b_pos b_lt_one hx]
  exact hx'
#align real.logb_pos_of_base_lt_one Real.logb_pos_of_base_lt_one

theorem logb_neg_iff_of_base_lt_one (h : 0 < x) : logb b x < 0 ↔ 1 < x := by
  rw [← @logb_one b, logb_lt_logb_iff_of_base_lt_one b_pos b_lt_one h zero_lt_one]
#align real.logb_neg_iff_of_base_lt_one Real.logb_neg_iff_of_base_lt_one

theorem logb_neg_of_base_lt_one (h1 : 1 < x) : logb b x < 0 :=
  (logb_neg_iff_of_base_lt_one b_pos b_lt_one (lt_trans zero_lt_one h1)).2 h1
#align real.logb_neg_of_base_lt_one Real.logb_neg_of_base_lt_one

theorem logb_nonneg_iff_of_base_lt_one (hx : 0 < x) : 0 ≤ logb b x ↔ x ≤ 1 := by
  rw [← not_lt, logb_neg_iff_of_base_lt_one b_pos b_lt_one hx, not_lt]
#align real.logb_nonneg_iff_of_base_lt_one Real.logb_nonneg_iff_of_base_lt_one

theorem logb_nonneg_of_base_lt_one (hx : 0 < x) (hx' : x ≤ 1) : 0 ≤ logb b x :=
  by
  rw [logb_nonneg_iff_of_base_lt_one b_pos b_lt_one hx]
  exact hx'
#align real.logb_nonneg_of_base_lt_one Real.logb_nonneg_of_base_lt_one

theorem logb_nonpos_iff_of_base_lt_one (hx : 0 < x) : logb b x ≤ 0 ↔ 1 ≤ x := by
  rw [← not_lt, logb_pos_iff_of_base_lt_one b_pos b_lt_one hx, not_lt]
#align real.logb_nonpos_iff_of_base_lt_one Real.logb_nonpos_iff_of_base_lt_one

theorem strictAntiOn_logb_of_base_lt_one : StrictAntiOn (logb b) (Set.Ioi 0) := fun x hx y hy hxy =>
  logb_lt_logb_of_base_lt_one b_pos b_lt_one hx hxy
#align real.strict_anti_on_logb_of_base_lt_one Real.strictAntiOn_logb_of_base_lt_one

theorem strictMonoOn_logb_of_base_lt_one : StrictMonoOn (logb b) (Set.Iio 0) :=
  by
  rintro x (hx : x < 0) y (hy : y < 0) hxy
  rw [← logb_abs y, ← logb_abs x]
  refine' logb_lt_logb_of_base_lt_one b_pos b_lt_one (abs_pos.2 hy.ne) _
  rwa [abs_of_neg hy, abs_of_neg hx, neg_lt_neg_iff]
#align real.strict_mono_on_logb_of_base_lt_one Real.strictMonoOn_logb_of_base_lt_one

theorem logb_injOn_pos_of_base_lt_one : Set.InjOn (logb b) (Set.Ioi 0) :=
  (strictAntiOn_logb_of_base_lt_one b_pos b_lt_one).InjOn
#align real.logb_inj_on_pos_of_base_lt_one Real.logb_injOn_pos_of_base_lt_one

theorem eq_one_of_pos_of_logb_eq_zero_of_base_lt_one (h₁ : 0 < x) (h₂ : logb b x = 0) : x = 1 :=
  logb_injOn_pos_of_base_lt_one b_pos b_lt_one (Set.mem_Ioi.2 h₁) (Set.mem_Ioi.2 zero_lt_one)
    (h₂.trans Real.logb_one.symm)
#align real.eq_one_of_pos_of_logb_eq_zero_of_base_lt_one Real.eq_one_of_pos_of_logb_eq_zero_of_base_lt_one

theorem logb_ne_zero_of_pos_of_ne_one_of_base_lt_one (hx_pos : 0 < x) (hx : x ≠ 1) : logb b x ≠ 0 :=
  mt (eq_one_of_pos_of_logb_eq_zero_of_base_lt_one b_pos b_lt_one hx_pos) hx
#align real.logb_ne_zero_of_pos_of_ne_one_of_base_lt_one Real.logb_ne_zero_of_pos_of_ne_one_of_base_lt_one

theorem tendsto_logb_atTop_of_base_lt_one : Tendsto (logb b) atTop atBot :=
  by
  rw [tendsto_at_top_at_bot]
  intro e
  use 1 ⊔ b ^ e
  intro a
  simp only [and_imp, sup_le_iff]
  intro ha
  rw [logb_le_iff_le_rpow_of_base_lt_one b_pos b_lt_one]
  tauto
  exact lt_of_lt_of_le zero_lt_one ha
#align real.tendsto_logb_at_top_of_base_lt_one Real.tendsto_logb_atTop_of_base_lt_one

end BPosAndBLtOne

theorem floor_logb_nat_cast {b : ℕ} {r : ℝ} (hb : 1 < b) (hr : 0 ≤ r) : ⌊logb b r⌋ = Int.log b r :=
  by
  obtain rfl | hr := hr.eq_or_lt
  · rw [logb_zero, Int.log_zero_right, Int.floor_zero]
  have hb1' : 1 < (b : ℝ) := nat.one_lt_cast.mpr hb
  apply le_antisymm
  · rw [← Int.zpow_le_iff_le_log hb hr, ← rpow_int_cast b]
    refine' le_of_le_of_eq _ (rpow_logb (zero_lt_one.trans hb1') hb1'.ne' hr)
    exact rpow_le_rpow_of_exponent_le hb1'.le (Int.floor_le _)
  · rw [Int.le_floor, le_logb_iff_rpow_le hb1' hr, rpow_int_cast]
    exact Int.zpow_log_le_self hb hr
#align real.floor_logb_nat_cast Real.floor_logb_nat_cast

theorem ceil_logb_nat_cast {b : ℕ} {r : ℝ} (hb : 1 < b) (hr : 0 ≤ r) : ⌈logb b r⌉ = Int.clog b r :=
  by
  obtain rfl | hr := hr.eq_or_lt
  · rw [logb_zero, Int.clog_zero_right, Int.ceil_zero]
  have hb1' : 1 < (b : ℝ) := nat.one_lt_cast.mpr hb
  apply le_antisymm
  · rw [Int.ceil_le, logb_le_iff_le_rpow hb1' hr, rpow_int_cast]
    refine' Int.self_le_zpow_clog hb r
  · rw [← Int.le_zpow_iff_clog_le hb hr, ← rpow_int_cast b]
    refine' (rpow_logb (zero_lt_one.trans hb1') hb1'.ne' hr).symm.trans_le _
    exact rpow_le_rpow_of_exponent_le hb1'.le (Int.le_ceil _)
#align real.ceil_logb_nat_cast Real.ceil_logb_nat_cast

@[simp]
theorem logb_eq_zero : logb b x = 0 ↔ b = 0 ∨ b = 1 ∨ b = -1 ∨ x = 0 ∨ x = 1 ∨ x = -1 :=
  by
  simp_rw [logb, div_eq_zero_iff, log_eq_zero]
  tauto
#align real.logb_eq_zero Real.logb_eq_zero

-- TODO add other limits and continuous API lemmas analogous to those in log.lean
open BigOperators

theorem logb_prod {α : Type _} (s : Finset α) (f : α → ℝ) (hf : ∀ x ∈ s, f x ≠ 0) :
    logb b (∏ i in s, f i) = ∑ i in s, logb b (f i) := by
  classical
    induction' s using Finset.induction_on with a s ha ih
    · simp
    simp only [Finset.mem_insert, forall_eq_or_imp] at hf
    simp [ha, ih hf.2, logb_mul hf.1 (Finset.prod_ne_zero_iff.2 hf.2)]
#align real.logb_prod Real.logb_prod

end Real


import data.fintype.basic
import data.real.basic

@[simp]
theorem floor_add_one_real
(x : ℝ)
(az : ℤ)
{ar : ℝ}
{h : coe az = ar}
: floor (x + (ar : ℝ)) = (floor x) + az
:= begin
  rw h.symm,
  exact floor_add_int x az,
end

theorem floor_eq_iff'
{T : Type*} [linear_ordered_ring T] [floor_ring T]
(r : T)
(ru : r < 1)
(rl : 0 ≤ r)
: floor r = 0
:= begin
  have h1 : ((0 : ℤ) : T) ≤ r ∧ r < (0 + 1), by {refine ⟨rl, _⟩, finish},
  exact (floor_eq_iff.mpr h1),
end

noncomputable def mod_two (x : ℝ) : ℝ := x - 2 * (floor (x / 2))

@[simp]
theorem mod_shift_even_eq_mod
(x : ℝ)
(k : ℤ)
: mod_two (x+2*k) = mod_two x
:= begin
  unfold mod_two,
  norm_cast,
  calc  x + ↑(2*k) -  ↑(2 * ⌊(x + ↑(2*k)) / 2⌋)
      = x + ↑(2*k) -  ↑(2 * ⌊x / 2 + (↑(2*k) / 2)⌋) : by rw add_div x ↑(2*k) 2
  ... = x + ↑(2*k) -  ↑(2 * ⌊x / 2 + ((2*↑k) / 2)⌋) : by norm_num
  ... = x + ↑(2*k) -  ↑(2 * ⌊x / 2 + ((↑k*2) / 2)⌋) : by rw mul_comm 2 (↑k : ℝ)
  ... = x + ↑(2*k) -  ↑(2 * ⌊x / 2 + (↑k : ℝ)⌋)     : by {
                                                        rw div_eq_mul_inv ((↑k*2) : ℝ) 2,
                                                        rw mul_assoc (↑k : ℝ) 2  2⁻¹,
                                                        have inverse_cancel : 2 * (2 : ℝ)⁻¹ = 1 := half_add_self 1,
                                                        rw inverse_cancel,
                                                        rw mul_one (↑k : ℝ),
                                                      }
  ... = x + ↑(2*k) -  ↑(2 * (⌊x / 2⌋ + k))          : by rw @floor_add_one_real (x/2) k _ rfl
  ... = x + ↑(2*k) -  ↑((2 * ⌊x / 2⌋) + (2*k : ℤ))  : by rw mul_add 2 ⌊(x / 2)⌋ k
  ... = x - ↑(2 * ⌊x / 2⌋)                          : by { rw int.cast_add (2 * ⌊x / 2⌋) (2 * k), ring, }
end

@[simp]
theorem mod_plus_two_eq_id
(x : ℝ)
: mod_two (x+2) = mod_two x
:= begin
  have hhh : mod_two (x+2) = mod_two (x + 2*(1 : ℤ)) := by { refine congr rfl _, finish, },
  rw hhh,
  exact mod_shift_even_eq_mod x (1 : ℤ),
end

@[simp]
theorem bounding_id
(a : ℝ)
(au : a < 2)
(al : 0 ≤ a)
: mod_two a = a
:= begin
  calc  a - 2 * ↑⌊a / 2⌋
        = a - 2 * ↑(0)     : by {
          have hu : (a / 2) < 1, by {refine (div_lt_one _).mpr au, exact zero_lt_two},
          have hl : 0 ≤ (a / 2), by {refine div_nonneg al _,       exact zero_le_two},
          rw floor_eq_iff' (a/2) hu hl,
          exact rfl,
        }
    ... = a - 2 * 0        : rfl
    ... = a                : by linarith,
end

theorem mod_two_le_2
(x : ℝ)
: mod_two x < 2
:= begin
  calc x - 2 * ↑⌊x / 2⌋
      < x - 2 * ((x / 2) - 1 ) : by { norm_num, exact sub_one_lt_floor (x / 2), }
  ... = 2                      : by linarith,
end

theorem mod_two_geq_0
(x : ℝ)
: mod_two x ≥ 0
:= begin
  calc x - 2 * ↑⌊x / 2⌋
      ≥ x - 2 * (x / 2) : by { norm_num, exact floor_le (x / 2), }
  ... = 0               : by linarith
end

theorem mod_two_idempotent
(x : ℝ)
: mod_two (mod_two x) = mod_two x
:= bounding_id (mod_two x) (mod_two_le_2 x) (mod_two_geq_0 x)

theorem mod_two_addition
(a b : ℝ)
: mod_two ((mod_two a) + b) = mod_two (a+b)
:= begin
  unfold mod_two,
  calc a - 2 * ↑⌊a / 2⌋ + b - 2 * ↑⌊(a - 2 * ↑⌊a / 2⌋ + b) / 2⌋
      = a - 2 * ↑⌊a / 2⌋ + b - 2 * ↑⌊(a + b - 2 * ↑⌊a / 2⌋) / 2⌋ : by rw sub_add_eq_add_sub a (2 * ↑⌊a / 2⌋) b
  ... = a - 2 * ↑⌊a / 2⌋ + b - 2 * ↑⌊(a + b)/2 - (2 * ↑⌊a / 2⌋) / 2⌋ : by rw sub_div (a + b) (2 * ↑⌊a / 2⌋) 2
  ... = a - 2 * ↑⌊a / 2⌋ + b - 2 * ↑⌊(a + b)/2 - ↑⌊a / 2⌋⌋ : by {
    rw mul_comm (2:ℝ) (↑⌊a / 2⌋),
    have hhh : (∀(x y : ℝ), y ≠ 0 → (x*y)/y = x) := mul_div_cancel,
    rw hhh (↑⌊a / 2⌋) 2 two_ne_zero,
  }
  ... = a - 2 * ↑⌊a / 2⌋ + b - 2 * ↑(⌊(a + b)/2⌋ - ⌊a / 2⌋) : by rw floor_sub_int ((a + b)/2) ⌊a / 2⌋
  ... = a - 2 * ↑⌊a / 2⌋ + b - 2 * (↑(⌊(a + b)/2⌋) - ↑⌊a / 2⌋) : by rw int.cast_sub ⌊(a + b)/2⌋ ⌊a / 2⌋

  ... = a + b - 2 * ↑⌊(a + b) / 2⌋ : by linarith
end

theorem mod_two_subtraction
(a b : ℝ)
: mod_two ((mod_two a) - b) = mod_two (a-b)
:= begin
  rw sub_eq_add_neg a b,
  rw ←mod_two_addition,
  rw ←sub_eq_add_neg (mod_two a) b,
end

theorem mod_two_xsub_one_eq_mod_two_x_plus_one
(x : ℝ)
(h : mod_two x < 1)
: mod_two (x - 1) = (mod_two x) + 1
:= begin
  calc mod_two (x - 1)
      = mod_two (mod_two x - 1)     : by rw ←mod_two_subtraction x 1
  ... = mod_two (mod_two x - 1 + 2) : by {rw mod_plus_two_eq_id (mod_two x - 1), }
  ... = mod_two (mod_two x + 1)     : by { ring, }
  ... = mod_two x + 1     : begin
    refine bounding_id (mod_two x + 1) _ _,
    linarith,
    linarith [mod_two_geq_0 x],
  end
end

theorem abs_of_mod_two_sub_mod_two_of_sub_one_eq_one
(x : ℝ)
: abs (mod_two x - mod_two (x - 1)) = 1
:= begin
  cases decidable.em (mod_two x ≥ 1) with mod_two_x_ge_1 ne_mod_two_x_ge_1, by {
    rw ←mod_two_subtraction x 1,
    have in_bounded_u : (mod_two x) - 1 < 2 := begin
      have := mod_two_le_2 x,
      linarith,
    end,

    have in_bounded_l : 0 ≤ (mod_two x) - 1, by linarith,
    rw bounding_id (mod_two x - 1) in_bounded_u in_bounded_l,
    calc abs (mod_two x - (mod_two x - 1))
        = abs 1 : by { refine congr rfl _, linarith, }
    ... = 1 : abs_one,
  },
  {
    have mod_x_le_1: mod_two x < 1 := not_le.mp ne_mod_two_x_ge_1,
    rw mod_two_xsub_one_eq_mod_two_x_plus_one x mod_x_le_1,

    calc abs (mod_two x - (mod_two x + 1))
        = abs (-1) : by { refine congr rfl _, linarith, }
    ... = abs 1 : abs_neg 1
    ... = 1 : abs_one,
  }
end

theorem bounding_mod_two
(a : ℝ)
(au : a < 2)
(al : 0 ≤ a)
(ha : mod_two a < 1)
: a < 1
:= begin
  rw (bounding_id a au al) at ha,
  exact ha,
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.big_operators.basic
import Mathlib.PostPort

universes u v w

namespace Mathlib

/-!
# Results about big operators with values in an ordered algebraic structure.

Mostly monotonicity results for the `∑` operation.

-/

namespace finset

theorem le_sum_of_subadditive {α : Type u} {β : Type v} {γ : Type w} [add_comm_monoid α] [ordered_add_comm_monoid β] (f : α → β) (h_zero : f 0 = 0) (h_add : ∀ (x y : α), f (x + y) ≤ f x + f y) (s : finset γ) (g : γ → α) : f (finset.sum s fun (x : γ) => g x) ≤ finset.sum s fun (x : γ) => f (g x) := sorry

theorem abs_sum_le_sum_abs {α : Type u} {β : Type v} [linear_ordered_field α] {f : β → α} {s : finset β} : abs (finset.sum s fun (x : β) => f x) ≤ finset.sum s fun (x : β) => abs (f x) :=
  le_sum_of_subadditive abs abs_zero abs_add s f

theorem abs_prod {α : Type u} {β : Type v} [linear_ordered_comm_ring α] {f : β → α} {s : finset β} : abs (finset.prod s fun (x : β) => f x) = finset.prod s fun (x : β) => abs (f x) :=
  monoid_hom.map_prod (monoid_with_zero_hom.to_monoid_hom abs_hom) (fun (x : β) => f x) s

theorem sum_le_sum {α : Type u} {β : Type v} {s : finset α} {f : α → β} {g : α → β} [ordered_add_comm_monoid β] : (∀ (x : α), x ∈ s → f x ≤ g x) → (finset.sum s fun (x : α) => f x) ≤ finset.sum s fun (x : α) => g x := sorry

theorem card_le_mul_card_image_of_maps_to {α : Type u} {γ : Type w} [DecidableEq γ] {f : α → γ} {s : finset α} {t : finset γ} (Hf : ∀ (a : α), a ∈ s → f a ∈ t) (n : ℕ) (hn : ∀ (a : γ), a ∈ t → card (filter (fun (x : α) => f x = a) s) ≤ n) : card s ≤ n * card t := sorry

theorem card_le_mul_card_image {α : Type u} {γ : Type w} [DecidableEq γ] {f : α → γ} (s : finset α) (n : ℕ) (hn : ∀ (a : γ), a ∈ image f s → card (filter (fun (x : α) => f x = a) s) ≤ n) : card s ≤ n * card (image f s) :=
  card_le_mul_card_image_of_maps_to (fun (x : α) => mem_image_of_mem f) n hn

theorem mul_card_image_le_card_of_maps_to {α : Type u} {γ : Type w} [DecidableEq γ] {f : α → γ} {s : finset α} {t : finset γ} (Hf : ∀ (a : α), a ∈ s → f a ∈ t) (n : ℕ) (hn : ∀ (a : γ), a ∈ t → n ≤ card (filter (fun (x : α) => f x = a) s)) : n * card t ≤ card s := sorry

theorem mul_card_image_le_card {α : Type u} {γ : Type w} [DecidableEq γ] {f : α → γ} (s : finset α) (n : ℕ) (hn : ∀ (a : γ), a ∈ image f s → n ≤ card (filter (fun (x : α) => f x = a) s)) : n * card (image f s) ≤ card s :=
  mul_card_image_le_card_of_maps_to (fun (x : α) => mem_image_of_mem f) n hn

theorem sum_nonneg {α : Type u} {β : Type v} {s : finset α} {f : α → β} [ordered_add_comm_monoid β] (h : ∀ (x : α), x ∈ s → 0 ≤ f x) : 0 ≤ finset.sum s fun (x : α) => f x :=
  le_trans (eq.mpr (id (Eq._oldrec (Eq.refl (0 ≤ finset.sum s fun (x : α) => 0)) sum_const_zero)) (le_refl 0))
    (sum_le_sum h)

theorem sum_nonpos {α : Type u} {β : Type v} {s : finset α} {f : α → β} [ordered_add_comm_monoid β] (h : ∀ (x : α), x ∈ s → f x ≤ 0) : (finset.sum s fun (x : α) => f x) ≤ 0 :=
  le_trans (sum_le_sum h)
    (eq.mpr (id (Eq._oldrec (Eq.refl ((finset.sum s fun (x : α) => 0) ≤ 0)) sum_const_zero)) (le_refl 0))

theorem sum_le_sum_of_subset_of_nonneg {α : Type u} {β : Type v} {s₁ : finset α} {s₂ : finset α} {f : α → β} [ordered_add_comm_monoid β] (h : s₁ ⊆ s₂) (hf : ∀ (x : α), x ∈ s₂ → ¬x ∈ s₁ → 0 ≤ f x) : (finset.sum s₁ fun (x : α) => f x) ≤ finset.sum s₂ fun (x : α) => f x := sorry

theorem sum_mono_set_of_nonneg {α : Type u} {β : Type v} {f : α → β} [ordered_add_comm_monoid β] (hf : ∀ (x : α), 0 ≤ f x) : monotone fun (s : finset α) => finset.sum s fun (x : α) => f x :=
  fun (s₁ s₂ : finset α) (hs : s₁ ≤ s₂) =>
    sum_le_sum_of_subset_of_nonneg hs fun (x : α) (_x : x ∈ s₂) (_x : ¬x ∈ s₁) => hf x

theorem sum_fiberwise_le_sum_of_sum_fiber_nonneg {α : Type u} {β : Type v} {γ : Type w} [ordered_add_comm_monoid β] [DecidableEq γ] {s : finset α} {t : finset γ} {g : α → γ} {f : α → β} (h : ∀ (y : γ), ¬y ∈ t → 0 ≤ finset.sum (filter (fun (x : α) => g x = y) s) fun (x : α) => f x) : (finset.sum t fun (y : γ) => finset.sum (filter (fun (x : α) => g x = y) s) fun (x : α) => f x) ≤
  finset.sum s fun (x : α) => f x := sorry

theorem sum_le_sum_fiberwise_of_sum_fiber_nonpos {α : Type u} {β : Type v} {γ : Type w} [ordered_add_comm_monoid β] [DecidableEq γ] {s : finset α} {t : finset γ} {g : α → γ} {f : α → β} (h : ∀ (y : γ), ¬y ∈ t → (finset.sum (filter (fun (x : α) => g x = y) s) fun (x : α) => f x) ≤ 0) : (finset.sum s fun (x : α) => f x) ≤
  finset.sum t fun (y : γ) => finset.sum (filter (fun (x : α) => g x = y) s) fun (x : α) => f x :=
  sum_fiberwise_le_sum_of_sum_fiber_nonneg h

theorem sum_eq_zero_iff_of_nonneg {α : Type u} {β : Type v} {s : finset α} {f : α → β} [ordered_add_comm_monoid β] : (∀ (x : α), x ∈ s → 0 ≤ f x) → ((finset.sum s fun (x : α) => f x) = 0 ↔ ∀ (x : α), x ∈ s → f x = 0) := sorry

theorem sum_eq_zero_iff_of_nonpos {α : Type u} {β : Type v} {s : finset α} {f : α → β} [ordered_add_comm_monoid β] : (∀ (x : α), x ∈ s → f x ≤ 0) → ((finset.sum s fun (x : α) => f x) = 0 ↔ ∀ (x : α), x ∈ s → f x = 0) :=
  sum_eq_zero_iff_of_nonneg

theorem single_le_sum {α : Type u} {β : Type v} {s : finset α} {f : α → β} [ordered_add_comm_monoid β] (hf : ∀ (x : α), x ∈ s → 0 ≤ f x) {a : α} (h : a ∈ s) : f a ≤ finset.sum s fun (x : α) => f x := sorry

@[simp] theorem sum_eq_zero_iff {α : Type u} {β : Type v} {s : finset α} {f : α → β} [canonically_ordered_add_monoid β] : (finset.sum s fun (x : α) => f x) = 0 ↔ ∀ (x : α), x ∈ s → f x = 0 :=
  sum_eq_zero_iff_of_nonneg fun (x : α) (hx : x ∈ s) => zero_le (f x)

theorem sum_le_sum_of_subset {α : Type u} {β : Type v} {s₁ : finset α} {s₂ : finset α} {f : α → β} [canonically_ordered_add_monoid β] (h : s₁ ⊆ s₂) : (finset.sum s₁ fun (x : α) => f x) ≤ finset.sum s₂ fun (x : α) => f x :=
  sum_le_sum_of_subset_of_nonneg h fun (x : α) (h₁ : x ∈ s₂) (h₂ : ¬x ∈ s₁) => zero_le (f x)

theorem sum_mono_set {α : Type u} {β : Type v} [canonically_ordered_add_monoid β] (f : α → β) : monotone fun (s : finset α) => finset.sum s fun (x : α) => f x :=
  fun (s₁ s₂ : finset α) (hs : s₁ ≤ s₂) => sum_le_sum_of_subset hs

theorem sum_le_sum_of_ne_zero {α : Type u} {β : Type v} {s₁ : finset α} {s₂ : finset α} {f : α → β} [canonically_ordered_add_monoid β] (h : ∀ (x : α), x ∈ s₁ → f x ≠ 0 → x ∈ s₂) : (finset.sum s₁ fun (x : α) => f x) ≤ finset.sum s₂ fun (x : α) => f x := sorry

theorem sum_lt_sum {α : Type u} {β : Type v} {s : finset α} {f : α → β} {g : α → β} [ordered_cancel_add_comm_monoid β] (Hle : ∀ (i : α), i ∈ s → f i ≤ g i) (Hlt : ∃ (i : α), ∃ (H : i ∈ s), f i < g i) : (finset.sum s fun (x : α) => f x) < finset.sum s fun (x : α) => g x := sorry

theorem sum_lt_sum_of_nonempty {α : Type u} {β : Type v} {s : finset α} {f : α → β} {g : α → β} [ordered_cancel_add_comm_monoid β] (hs : finset.nonempty s) (Hlt : ∀ (x : α), x ∈ s → f x < g x) : (finset.sum s fun (x : α) => f x) < finset.sum s fun (x : α) => g x :=
  sum_lt_sum (fun (i : α) (hi : i ∈ s) => le_of_lt (Hlt i hi))
    (Exists.dcases_on hs fun (i : α) (hi : i ∈ s) => Exists.intro i (Exists.intro hi (Hlt i hi)))

theorem sum_lt_sum_of_subset {α : Type u} {β : Type v} {s₁ : finset α} {s₂ : finset α} {f : α → β} [ordered_cancel_add_comm_monoid β] [DecidableEq α] (h : s₁ ⊆ s₂) {i : α} (hi : i ∈ s₂ \ s₁) (hpos : 0 < f i) (hnonneg : ∀ (j : α), j ∈ s₂ \ s₁ → 0 ≤ f j) : (finset.sum s₁ fun (x : α) => f x) < finset.sum s₂ fun (x : α) => f x := sorry

theorem exists_lt_of_sum_lt {α : Type u} {β : Type v} {s : finset α} {f : α → β} {g : α → β} [linear_ordered_cancel_add_comm_monoid β] (Hlt : (finset.sum s fun (x : α) => f x) < finset.sum s fun (x : α) => g x) : ∃ (i : α), ∃ (H : i ∈ s), f i < g i := sorry

theorem exists_le_of_sum_le {α : Type u} {β : Type v} {s : finset α} {f : α → β} {g : α → β} [linear_ordered_cancel_add_comm_monoid β] (hs : finset.nonempty s) (Hle : (finset.sum s fun (x : α) => f x) ≤ finset.sum s fun (x : α) => g x) : ∃ (i : α), ∃ (H : i ∈ s), f i ≤ g i := sorry

theorem exists_pos_of_sum_zero_of_exists_nonzero {α : Type u} {β : Type v} {s : finset α} [linear_ordered_cancel_add_comm_monoid β] (f : α → β) (h₁ : (finset.sum s fun (e : α) => f e) = 0) (h₂ : ∃ (x : α), ∃ (H : x ∈ s), f x ≠ 0) : ∃ (x : α), ∃ (H : x ∈ s), 0 < f x := sorry

/- this is also true for a ordered commutative multiplicative monoid -/

theorem prod_nonneg {α : Type u} {β : Type v} [linear_ordered_comm_ring β] {s : finset α} {f : α → β} (h0 : ∀ (x : α), x ∈ s → 0 ≤ f x) : 0 ≤ finset.prod s fun (x : α) => f x :=
  prod_induction f (fun (x : β) => 0 ≤ x) (fun (_x _x_1 : β) (ha : 0 ≤ _x) (hb : 0 ≤ _x_1) => mul_nonneg ha hb)
    zero_le_one h0

/- this is also true for a ordered commutative multiplicative monoid -/

theorem prod_pos {α : Type u} {β : Type v} [linear_ordered_comm_ring β] {s : finset α} {f : α → β} (h0 : ∀ (x : α), x ∈ s → 0 < f x) : 0 < finset.prod s fun (x : α) => f x :=
  prod_induction f (fun (x : β) => 0 < x) (fun (_x _x_1 : β) (ha : 0 < _x) (hb : 0 < _x_1) => mul_pos ha hb) zero_lt_one
    h0

/- this is also true for a ordered commutative multiplicative monoid -/

theorem prod_le_prod {α : Type u} {β : Type v} [linear_ordered_comm_ring β] {s : finset α} {f : α → β} {g : α → β} (h0 : ∀ (x : α), x ∈ s → 0 ≤ f x) (h1 : ∀ (x : α), x ∈ s → f x ≤ g x) : (finset.prod s fun (x : α) => f x) ≤ finset.prod s fun (x : α) => g x := sorry

theorem prod_le_one {α : Type u} {β : Type v} [linear_ordered_comm_ring β] {s : finset α} {f : α → β} (h0 : ∀ (x : α), x ∈ s → 0 ≤ f x) (h1 : ∀ (x : α), x ∈ s → f x ≤ 1) : (finset.prod s fun (x : α) => f x) ≤ 1 := sorry

/-- If `g, h ≤ f` and `g i + h i ≤ f i`, then the product of `f` over `s` is at least the
  sum of the products of `g` and `h`. This is the version for `linear_ordered_comm_ring`. -/
theorem prod_add_prod_le {α : Type u} {β : Type v} [linear_ordered_comm_ring β] {s : finset α} {i : α} {f : α → β} {g : α → β} {h : α → β} (hi : i ∈ s) (h2i : g i + h i ≤ f i) (hgf : ∀ (j : α), j ∈ s → j ≠ i → g j ≤ f j) (hhf : ∀ (j : α), j ∈ s → j ≠ i → h j ≤ f j) (hg : ∀ (i : α), i ∈ s → 0 ≤ g i) (hh : ∀ (i : α), i ∈ s → 0 ≤ h i) : ((finset.prod s fun (i : α) => g i) + finset.prod s fun (i : α) => h i) ≤ finset.prod s fun (i : α) => f i := sorry

theorem prod_le_prod' {α : Type u} {β : Type v} [canonically_ordered_comm_semiring β] {s : finset α} {f : α → β} {g : α → β} (h : ∀ (i : α), i ∈ s → f i ≤ g i) : (finset.prod s fun (x : α) => f x) ≤ finset.prod s fun (x : α) => g x := sorry

/-- If `g, h ≤ f` and `g i + h i ≤ f i`, then the product of `f` over `s` is at least the
  sum of the products of `g` and `h`. This is the version for `canonically_ordered_comm_semiring`.
-/
theorem prod_add_prod_le' {α : Type u} {β : Type v} [canonically_ordered_comm_semiring β] {s : finset α} {i : α} {f : α → β} {g : α → β} {h : α → β} (hi : i ∈ s) (h2i : g i + h i ≤ f i) (hgf : ∀ (j : α), j ∈ s → j ≠ i → g j ≤ f j) (hhf : ∀ (j : α), j ∈ s → j ≠ i → h j ≤ f j) : ((finset.prod s fun (i : α) => g i) + finset.prod s fun (i : α) => h i) ≤ finset.prod s fun (i : α) => f i := sorry

end finset

namespace with_top

/-- A product of finite numbers is still finite -/
theorem prod_lt_top {α : Type u} {β : Type v} [canonically_ordered_comm_semiring β] [nontrivial β] [DecidableEq β] {s : finset α} {f : α → with_top β} (h : ∀ (a : α), a ∈ s → f a < ⊤) : (finset.prod s fun (x : α) => f x) < ⊤ :=
  finset.prod_induction f (fun (a : with_top β) => a < ⊤) (fun (a b : with_top β) => mul_lt_top) (coe_lt_top 1) h

/-- A sum of finite numbers is still finite -/
theorem sum_lt_top {α : Type u} {β : Type v} [ordered_add_comm_monoid β] {s : finset α} {f : α → with_top β} : (∀ (a : α), a ∈ s → f a < ⊤) → (finset.sum s fun (x : α) => f x) < ⊤ := sorry

/-- A sum of finite numbers is still finite -/
theorem sum_lt_top_iff {α : Type u} {β : Type v} [canonically_ordered_add_monoid β] {s : finset α} {f : α → with_top β} : (finset.sum s fun (x : α) => f x) < ⊤ ↔ ∀ (a : α), a ∈ s → f a < ⊤ := sorry

/-- A sum of numbers is infinite iff one of them is infinite -/
theorem sum_eq_top_iff {α : Type u} {β : Type v} [canonically_ordered_add_monoid β] {s : finset α} {f : α → with_top β} : (finset.sum s fun (x : α) => f x) = ⊤ ↔ ∃ (a : α), ∃ (H : a ∈ s), f a = ⊤ := sorry


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

! This file was ported from Lean 3 source module geometry.euclidean.inversion
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.Basic

/-!
# Inversion in an affine space

In this file we define inversion in a sphere in an affine space. This map sends each point `x` to
the point `y` such that `y -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c)`, where `c` and `R` are the center
and the radius the sphere.

In many applications, it is convenient to assume that the inversions swaps the center and the point
at infinity. In order to stay in the original affine space, we define the map so that it sends
center to itself.

Currently, we prove only a few basic lemmas needed to prove Ptolemy's inequality, see
`euclidean_geometry.mul_dist_le_mul_dist_add_mul_dist`.
-/

noncomputable section

open Metric Real Function

namespace EuclideanGeometry

variable {V P : Type _} [NormedAddCommGroup V] [InnerProductSpace ℝ V] [MetricSpace P]
  [NormedAddTorsor V P] {a b c d x y z : P} {R : ℝ}

include V

/-- Inversion in a sphere in an affine space. This map sends each point `x` to the point `y` such
that `y -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c)`, where `c` and `R` are the center and the radius the
sphere. -/
def inversion (c : P) (R : ℝ) (x : P) : P :=
  (R / dist x c) ^ 2 • (x -ᵥ c) +ᵥ c
#align euclidean_geometry.inversion EuclideanGeometry.inversion

theorem inversion_vsub_center (c : P) (R : ℝ) (x : P) :
    inversion c R x -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c) :=
  vadd_vsub _ _
#align euclidean_geometry.inversion_vsub_center EuclideanGeometry.inversion_vsub_center

@[simp]
theorem inversion_self (c : P) (R : ℝ) : inversion c R c = c := by simp [inversion]
#align euclidean_geometry.inversion_self EuclideanGeometry.inversion_self

@[simp]
theorem inversion_dist_center (c x : P) : inversion c (dist x c) x = x :=
  by
  rcases eq_or_ne x c with (rfl | hne)
  · apply inversion_self
  · rw [inversion, div_self, one_pow, one_smul, vsub_vadd]
    rwa [dist_ne_zero]
#align euclidean_geometry.inversion_dist_center EuclideanGeometry.inversion_dist_center

theorem inversion_of_mem_sphere (h : x ∈ Metric.sphere c R) : inversion c R x = x :=
  h.out ▸ inversion_dist_center c x
#align euclidean_geometry.inversion_of_mem_sphere EuclideanGeometry.inversion_of_mem_sphere

/-- Distance from the image of a point under inversion to the center. This formula accidentally
works for `x = c`. -/
theorem dist_inversion_center (c x : P) (R : ℝ) : dist (inversion c R x) c = R ^ 2 / dist x c :=
  by
  rcases eq_or_ne x c with (rfl | hx)
  · simp
  have : dist x c ≠ 0 := dist_ne_zero.2 hx
  field_simp [inversion, norm_smul, abs_div, ← dist_eq_norm_vsub, sq, mul_assoc]
#align euclidean_geometry.dist_inversion_center EuclideanGeometry.dist_inversion_center

/-- Distance from the center of an inversion to the image of a point under the inversion. This
formula accidentally works for `x = c`. -/
theorem dist_center_inversion (c x : P) (R : ℝ) : dist c (inversion c R x) = R ^ 2 / dist c x := by
  rw [dist_comm c, dist_comm c, dist_inversion_center]
#align euclidean_geometry.dist_center_inversion EuclideanGeometry.dist_center_inversion

@[simp]
theorem inversion_inversion (c : P) {R : ℝ} (hR : R ≠ 0) (x : P) :
    inversion c R (inversion c R x) = x :=
  by
  rcases eq_or_ne x c with (rfl | hne)
  · rw [inversion_self, inversion_self]
  · rw [inversion, dist_inversion_center, inversion_vsub_center, smul_smul, ← mul_pow,
      div_mul_div_comm, div_mul_cancel _ (dist_ne_zero.2 hne), ← sq, div_self, one_pow, one_smul,
      vsub_vadd]
    exact pow_ne_zero _ hR
#align euclidean_geometry.inversion_inversion EuclideanGeometry.inversion_inversion

theorem inversion_involutive (c : P) {R : ℝ} (hR : R ≠ 0) : Involutive (inversion c R) :=
  inversion_inversion c hR
#align euclidean_geometry.inversion_involutive EuclideanGeometry.inversion_involutive

theorem inversion_surjective (c : P) {R : ℝ} (hR : R ≠ 0) : Surjective (inversion c R) :=
  (inversion_involutive c hR).Surjective
#align euclidean_geometry.inversion_surjective EuclideanGeometry.inversion_surjective

theorem inversion_injective (c : P) {R : ℝ} (hR : R ≠ 0) : Injective (inversion c R) :=
  (inversion_involutive c hR).Injective
#align euclidean_geometry.inversion_injective EuclideanGeometry.inversion_injective

theorem inversion_bijective (c : P) {R : ℝ} (hR : R ≠ 0) : Bijective (inversion c R) :=
  (inversion_involutive c hR).Bijective
#align euclidean_geometry.inversion_bijective EuclideanGeometry.inversion_bijective

/-- Distance between the images of two points under an inversion. -/
theorem dist_inversion_inversion (hx : x ≠ c) (hy : y ≠ c) (R : ℝ) :
    dist (inversion c R x) (inversion c R y) = R ^ 2 / (dist x c * dist y c) * dist x y :=
  by
  dsimp only [inversion]
  simp_rw [dist_vadd_cancel_right, dist_eq_norm_vsub V _ c]
  simpa only [dist_vsub_cancel_right] using
    dist_div_norm_sq_smul (vsub_ne_zero.2 hx) (vsub_ne_zero.2 hy) R
#align euclidean_geometry.dist_inversion_inversion EuclideanGeometry.dist_inversion_inversion

/-- **Ptolemy's inequality**: in a quadrangle `ABCD`, `|AC| * |BD| ≤ |AB| * |CD| + |BC| * |AD|`. If
`ABCD` is a convex cyclic polygon, then this inequality becomes an equality, see
`euclidean_geometry.mul_dist_add_mul_dist_eq_mul_dist_of_cospherical`.  -/
theorem mul_dist_le_mul_dist_add_mul_dist (a b c d : P) :
    dist a c * dist b d ≤ dist a b * dist c d + dist b c * dist a d :=
  by
  -- If one of the points `b`, `c`, `d` is equal to `a`, then the inequality is trivial.
  rcases eq_or_ne b a with (rfl | hb)
  · rw [dist_self, MulZeroClass.zero_mul, zero_add]
  rcases eq_or_ne c a with (rfl | hc)
  · rw [dist_self, MulZeroClass.zero_mul]
    apply_rules [add_nonneg, mul_nonneg, dist_nonneg]
  rcases eq_or_ne d a with (rfl | hd)
  · rw [dist_self, MulZeroClass.mul_zero, add_zero, dist_comm d, dist_comm d, mul_comm]
  /- Otherwise, we apply the triangle inequality to `euclidean_geometry.inversion a 1 b`,
    `euclidean_geometry.inversion a 1 c`, and `euclidean_geometry.inversion a 1 d`. -/
  have H := dist_triangle (inversion a 1 b) (inversion a 1 c) (inversion a 1 d)
  rw [dist_inversion_inversion hb hd, dist_inversion_inversion hb hc,
    dist_inversion_inversion hc hd, one_pow] at H
  rw [← dist_pos] at hb hc hd
  rw [← div_le_div_right (mul_pos hb (mul_pos hc hd))]
  convert H <;>
    · field_simp [hb.ne', hc.ne', hd.ne', dist_comm a]
      ring
#align euclidean_geometry.mul_dist_le_mul_dist_add_mul_dist EuclideanGeometry.mul_dist_le_mul_dist_add_mul_dist

end EuclideanGeometry


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

import algebra.polynomial.big_operators
import algebra.squarefree
import field_theory.minpoly
import field_theory.splitting_field

/-!

# Separable polynomials

We define a polynomial to be separable if it is coprime with its derivative. We prove basic
properties about separable polynomials here.

## Main definitions

* `polynomial.separable f`: a polynomial `f` is separable iff it is coprime with its derivative.
* `polynomial.expand R p f`: expand the polynomial `f` with coefficients in a
  commutative semiring `R` by a factor of p, so `expand R p (∑ aₙ xⁿ)` is `∑ aₙ xⁿᵖ`.
* `polynomial.contract p f`: the opposite of `expand`, so it sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`.

-/

universes u v w
open_locale classical big_operators
open finset

namespace polynomial

section comm_semiring

variables {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S]

/-- A polynomial is separable iff it is coprime with its derivative. -/
def separable (f : polynomial R) : Prop :=
is_coprime f f.derivative

lemma separable_def (f : polynomial R) :
  f.separable ↔ is_coprime f f.derivative :=
iff.rfl

lemma separable_def' (f : polynomial R) :
  f.separable ↔ ∃ a b : polynomial R, a * f + b * f.derivative = 1 :=
iff.rfl

lemma not_separable_zero [nontrivial R] : ¬ separable (0 : polynomial R) :=
begin
  rintro ⟨x, y, h⟩,
  simpa only [derivative_zero, mul_zero, add_zero, zero_ne_one] using h,
end

lemma separable_one : (1 : polynomial R).separable :=
is_coprime_one_left

@[nontriviality] lemma separable_of_subsingleton [subsingleton R] (f : polynomial R) :
  f.separable := by simp [separable]

lemma separable_X_add_C (a : R) : (X + C a).separable :=
by { rw [separable_def, derivative_add, derivative_X, derivative_C, add_zero],
  exact is_coprime_one_right }

lemma separable_X : (X : polynomial R).separable :=
by { rw [separable_def, derivative_X], exact is_coprime_one_right }

lemma separable_C (r : R) : (C r).separable ↔ is_unit r :=
by rw [separable_def, derivative_C, is_coprime_zero_right, is_unit_C]

lemma separable.of_mul_left {f g : polynomial R} (h : (f * g).separable) : f.separable :=
begin
  have := h.of_mul_left_left, rw derivative_mul at this,
  exact is_coprime.of_mul_right_left (is_coprime.of_add_mul_left_right this)
end

lemma separable.of_mul_right {f g : polynomial R} (h : (f * g).separable) : g.separable :=
by { rw mul_comm at h, exact h.of_mul_left }

lemma separable.of_dvd {f g : polynomial R} (hf : f.separable) (hfg : g ∣ f) : g.separable :=
by { rcases hfg with ⟨f', rfl⟩, exact separable.of_mul_left hf }

lemma separable_gcd_left {F : Type*} [field F] {f : polynomial F}
  (hf : f.separable) (g : polynomial F) : (euclidean_domain.gcd f g).separable :=
separable.of_dvd hf (euclidean_domain.gcd_dvd_left f g)

lemma separable_gcd_right {F : Type*} [field F] {g : polynomial F}
  (f : polynomial F) (hg : g.separable) : (euclidean_domain.gcd f g).separable :=
separable.of_dvd hg (euclidean_domain.gcd_dvd_right f g)

lemma separable.is_coprime {f g : polynomial R} (h : (f * g).separable) : is_coprime f g :=
begin
  have := h.of_mul_left_left, rw derivative_mul at this,
  exact is_coprime.of_mul_right_right (is_coprime.of_add_mul_left_right this)
end

theorem separable.of_pow' {f : polynomial R} :
  ∀ {n : ℕ} (h : (f ^ n).separable), is_unit f ∨ (f.separable ∧ n = 1) ∨ n = 0
| 0     := λ h, or.inr $ or.inr rfl
| 1     := λ h, or.inr $ or.inl ⟨pow_one f ▸ h, rfl⟩
| (n+2) := λ h, by { rw [pow_succ, pow_succ] at h,
    exact or.inl (is_coprime_self.1 h.is_coprime.of_mul_right_left) }

theorem separable.of_pow {f : polynomial R} (hf : ¬is_unit f) {n : ℕ} (hn : n ≠ 0)
  (hfs : (f ^ n).separable) : f.separable ∧ n = 1 :=
(hfs.of_pow'.resolve_left hf).resolve_right hn

theorem separable.map {p : polynomial R} (h : p.separable) {f : R →+* S} : (p.map f).separable :=
let ⟨a, b, H⟩ := h in ⟨a.map f, b.map f,
by rw [derivative_map, ← map_mul, ← map_mul, ← map_add, H, map_one]⟩

variables (R) (p q : ℕ)

/-- Expand the polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`. -/
noncomputable def expand : polynomial R →ₐ[R] polynomial R :=
{ commutes' := λ r, eval₂_C _ _,
  .. (eval₂_ring_hom C (X ^ p) : polynomial R →+* polynomial R) }

lemma coe_expand : (expand R p : polynomial R → polynomial R) = eval₂ C (X ^ p) := rfl

variables {R}

lemma expand_eq_sum {f : polynomial R} :
  expand R p f = f.sum (λ e a, C a * (X ^ p) ^ e) :=
by { dsimp [expand, eval₂], refl, }

@[simp] lemma expand_C (r : R) : expand R p (C r) = C r := eval₂_C _ _
@[simp] lemma expand_X : expand R p X = X ^ p := eval₂_X _ _
@[simp] lemma expand_monomial (r : R) : expand R p (monomial q r) = monomial (q * p) r :=
by simp_rw [monomial_eq_smul_X, alg_hom.map_smul, alg_hom.map_pow, expand_X, mul_comm, pow_mul]

theorem expand_expand (f : polynomial R) : expand R p (expand R q f) = expand R (p * q) f :=
polynomial.induction_on f (λ r, by simp_rw expand_C)
  (λ f g ihf ihg, by simp_rw [alg_hom.map_add, ihf, ihg])
  (λ n r ih, by simp_rw [alg_hom.map_mul, expand_C, alg_hom.map_pow, expand_X,
    alg_hom.map_pow, expand_X, pow_mul])

theorem expand_mul (f : polynomial R) : expand R (p * q) f = expand R p (expand R q f) :=
(expand_expand p q f).symm

@[simp] theorem expand_zero (f : polynomial R) : expand R 0 f = C (eval 1 f) :=
by simp [expand]

@[simp] theorem expand_one (f : polynomial R) : expand R 1 f = f :=
polynomial.induction_on f
  (λ r, by rw expand_C)
  (λ f g ihf ihg, by rw [alg_hom.map_add, ihf, ihg])
  (λ n r ih, by rw [alg_hom.map_mul, expand_C, alg_hom.map_pow, expand_X, pow_one])

theorem expand_pow (f : polynomial R) : expand R (p ^ q) f = (expand R p ^[q] f) :=
nat.rec_on q (by rw [pow_zero, expand_one, function.iterate_zero, id]) $ λ n ih,
by rw [function.iterate_succ_apply', pow_succ, expand_mul, ih]

theorem derivative_expand (f : polynomial R) :
  (expand R p f).derivative = expand R p f.derivative * (p * X ^ (p - 1)) :=
by rw [coe_expand, derivative_eval₂_C, derivative_pow, derivative_X, mul_one]

theorem coeff_expand {p : ℕ} (hp : 0 < p) (f : polynomial R) (n : ℕ) :
  (expand R p f).coeff n = if p ∣ n then f.coeff (n / p) else 0 :=
begin
  simp only [expand_eq_sum],
  simp_rw [coeff_sum, ← pow_mul, C_mul_X_pow_eq_monomial, coeff_monomial, sum],
  split_ifs with h,
  { rw [finset.sum_eq_single (n/p), nat.mul_div_cancel' h, if_pos rfl],
    { intros b hb1 hb2, rw if_neg, intro hb3, apply hb2, rw [← hb3, nat.mul_div_cancel_left b hp] },
    { intro hn, rw not_mem_support_iff.1 hn, split_ifs; refl } },
  { rw finset.sum_eq_zero, intros k hk, rw if_neg, exact λ hkn, h ⟨k, hkn.symm⟩, },
end

@[simp] theorem coeff_expand_mul {p : ℕ} (hp : 0 < p) (f : polynomial R) (n : ℕ) :
  (expand R p f).coeff (n * p) = f.coeff n :=
by rw [coeff_expand hp, if_pos (dvd_mul_left _ _), nat.mul_div_cancel _ hp]

@[simp] theorem coeff_expand_mul' {p : ℕ} (hp : 0 < p) (f : polynomial R) (n : ℕ) :
  (expand R p f).coeff (p * n) = f.coeff n :=
by rw [mul_comm, coeff_expand_mul hp]

theorem expand_inj {p : ℕ} (hp : 0 < p) {f g : polynomial R} :
  expand R p f = expand R p g ↔ f = g :=
⟨λ H, ext $ λ n, by rw [← coeff_expand_mul hp, H, coeff_expand_mul hp], congr_arg _⟩

theorem expand_eq_zero {p : ℕ} (hp : 0 < p) {f : polynomial R} : expand R p f = 0 ↔ f = 0 :=
by rw [← (expand R p).map_zero, expand_inj hp, alg_hom.map_zero]

theorem expand_eq_C {p : ℕ} (hp : 0 < p) {f : polynomial R} {r : R} :
  expand R p f = C r ↔ f = C r :=
by rw [← expand_C, expand_inj hp, expand_C]

theorem nat_degree_expand (p : ℕ) (f : polynomial R) :
  (expand R p f).nat_degree = f.nat_degree * p :=
begin
  cases p.eq_zero_or_pos with hp hp,
  { rw [hp, coe_expand, pow_zero, mul_zero, ← C_1, eval₂_hom, nat_degree_C] },
  by_cases hf : f = 0,
  { rw [hf, alg_hom.map_zero, nat_degree_zero, zero_mul] },
  have hf1 : expand R p f ≠ 0 := mt (expand_eq_zero hp).1 hf,
  rw [← with_bot.coe_eq_coe, ← degree_eq_nat_degree hf1],
  refine le_antisymm ((degree_le_iff_coeff_zero _ _).2 $ λ n hn, _) _,
  { rw coeff_expand hp, split_ifs with hpn,
    { rw coeff_eq_zero_of_nat_degree_lt, contrapose! hn,
      rw [with_bot.coe_le_coe, ← nat.div_mul_cancel hpn], exact nat.mul_le_mul_right p hn },
    { refl } },
  { refine le_degree_of_ne_zero _,
    rw [coeff_expand_mul hp, ← leading_coeff], exact mt leading_coeff_eq_zero.1 hf }
end

theorem map_expand {p : ℕ} (hp : 0 < p) {f : R →+* S} {q : polynomial R} :
  map f (expand R p q) = expand S p (map f q) :=
by { ext, rw [coeff_map, coeff_expand hp, coeff_expand hp], split_ifs; simp, }

/-- Expansion is injective. -/
lemma expand_injective {n : ℕ} (hn : 0 < n) :
  function.injective (expand R n) :=
λ g g' h, begin
  ext,
  have h' : (expand R n g).coeff (n * n_1) = (expand R n g').coeff (n * n_1) :=
  begin
    apply polynomial.ext_iff.1,
    exact h,
  end,

  rw [polynomial.coeff_expand hn g (n * n_1), polynomial.coeff_expand hn g' (n * n_1)] at h',
  simp only [if_true, dvd_mul_right] at h',
  rw (nat.mul_div_right n_1 hn) at h',
  exact h',
end

lemma is_unit_of_self_mul_dvd_separable {p q : polynomial R}
  (hp : p.separable) (hq : q * q ∣ p) : is_unit q :=
begin
  obtain ⟨p, rfl⟩ := hq,
  apply is_coprime_self.mp,
  have : is_coprime (q * (q * p)) (q * (q.derivative * p + q.derivative * p + q * p.derivative)),
  { simp only [← mul_assoc, mul_add],
    convert hp,
    rw [derivative_mul, derivative_mul],
    ring },
  exact is_coprime.of_mul_right_left (is_coprime.of_mul_left_left this)
end

/-- The opposite of `expand`: sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`. -/
noncomputable def contract (p : ℕ) (f : polynomial R) : polynomial R :=
∑ n in range (f.nat_degree + 1), monomial n (f.coeff (n * p))

theorem coeff_contract {p : ℕ} (hp : p ≠ 0) (f : polynomial R) (n : ℕ) :
  (contract p f).coeff n = f.coeff (n * p) :=
begin
  simp only [contract, coeff_monomial, sum_ite_eq', finset_sum_coeff, mem_range, not_lt,
    ite_eq_left_iff],
  assume hn,
  apply (coeff_eq_zero_of_nat_degree_lt _).symm,
  calc f.nat_degree < f.nat_degree + 1 : nat.lt_succ_self _
    ... ≤ n * 1 : by simpa only [mul_one] using hn
    ... ≤ n * p : mul_le_mul_of_nonneg_left (show 1 ≤ p, from hp.bot_lt) (zero_le n)
end

theorem contract_expand {f : polynomial R} (hp : p ≠ 0) : contract p (expand R p f) = f :=
begin
  ext,
  simp [coeff_contract hp, coeff_expand hp.bot_lt, nat.mul_div_cancel _ hp.bot_lt]
end

section char_p

variable [char_p R p]

theorem expand_contract [no_zero_divisors R] {f : polynomial R} (hf : f.derivative = 0)
  (hp : p ≠ 0) : expand R p (contract p f) = f :=
begin
  ext n,
  rw [coeff_expand hp.bot_lt, coeff_contract hp],
  split_ifs with h,
  { rw nat.div_mul_cancel h },
  { cases n,
    { exact absurd (dvd_zero p) h },
    have := coeff_derivative f n,
    rw [hf, coeff_zero, zero_eq_mul] at this,
    cases this,
    { rw this },
    rw [← nat.cast_succ, char_p.cast_eq_zero_iff R p] at this,
    exact absurd this h }
end

variable [hp : fact p.prime]
include hp

theorem expand_char (f : polynomial R) : map (frobenius R p) (expand R p f) = f ^ p :=
begin
  refine f.induction_on' (λ a b ha hb, _) (λ n a, _),
  { rw [alg_hom.map_add, map_add, ha, hb, add_pow_char], },
  { rw [expand_monomial, map_monomial, monomial_eq_C_mul_X, monomial_eq_C_mul_X,
        mul_pow, ← C.map_pow, frobenius_def],
    ring_exp }
end

theorem map_expand_pow_char (f : polynomial R) (n : ℕ) :
   map ((frobenius R p) ^ n) (expand R (p ^ n) f) = f ^ (p ^ n) :=
begin
  induction n,
  { simp [ring_hom.one_def] },
  symmetry,
  rw [pow_succ', pow_mul, ← n_ih, ← expand_char, pow_succ, ring_hom.mul_def,
      ← map_map, mul_comm, expand_mul, ← map_expand (nat.prime.pos hp.1)]
end

end char_p

lemma multiplicity_le_one_of_separable {p q : polynomial R} (hq : ¬ is_unit q)
  (hsep : separable p) : multiplicity q p ≤ 1 :=
begin
  contrapose! hq,
  apply is_unit_of_self_mul_dvd_separable hsep,
  rw ← sq,
  apply multiplicity.pow_dvd_of_le_multiplicity,
  simpa only [nat.cast_one, nat.cast_bit0] using enat.add_one_le_of_lt hq
end

lemma separable.squarefree {p : polynomial R} (hsep : separable p) : squarefree p :=
begin
  rw multiplicity.squarefree_iff_multiplicity_le_one p,
  intro f,
  by_cases hunit : is_unit f,
  { exact or.inr hunit },
  exact or.inl (multiplicity_le_one_of_separable hunit hsep)
end

end comm_semiring

section comm_ring

variables {R : Type u} [comm_ring R]

lemma separable_X_sub_C {x : R} : separable (X - C x) :=
by simpa only [sub_eq_add_neg, C_neg] using separable_X_add_C (-x)

lemma separable.mul {f g : polynomial R} (hf : f.separable) (hg : g.separable)
  (h : is_coprime f g) : (f * g).separable :=
by { rw [separable_def, derivative_mul], exact ((hf.mul_right h).add_mul_left_right _).mul_left
  ((h.symm.mul_right hg).mul_add_right_right _) }

lemma separable_prod' {ι : Sort*} {f : ι → polynomial R} {s : finset ι} :
  (∀x∈s, ∀y∈s, x ≠ y → is_coprime (f x) (f y)) → (∀x∈s, (f x).separable) →
  (∏ x in s, f x).separable :=
finset.induction_on s (λ _ _, separable_one) $ λ a s has ih h1 h2, begin
  simp_rw [finset.forall_mem_insert, forall_and_distrib] at h1 h2, rw prod_insert has,
  exact h2.1.mul (ih h1.2.2 h2.2) (is_coprime.prod_right $ λ i his, h1.1.2 i his $
    ne.symm $ ne_of_mem_of_not_mem his has)
end

lemma separable_prod {ι : Sort*} [fintype ι] {f : ι → polynomial R}
  (h1 : pairwise (is_coprime on f)) (h2 : ∀ x, (f x).separable) : (∏ x, f x).separable :=
separable_prod' (λ x hx y hy hxy, h1 x y hxy) (λ x hx, h2 x)

lemma separable.inj_of_prod_X_sub_C [nontrivial R] {ι : Sort*} {f : ι → R} {s : finset ι}
  (hfs : (∏ i in s, (X - C (f i))).separable)
  {x y : ι} (hx : x ∈ s) (hy : y ∈ s) (hfxy : f x = f y) : x = y :=
begin
  by_contra hxy,
  rw [← insert_erase hx, prod_insert (not_mem_erase _ _),
      ← insert_erase (mem_erase_of_ne_of_mem (ne.symm hxy) hy),
      prod_insert (not_mem_erase _ _), ← mul_assoc, hfxy, ← sq] at hfs,
  cases (hfs.of_mul_left.of_pow (by exact not_is_unit_X_sub_C _) two_ne_zero).2
end

lemma separable.injective_of_prod_X_sub_C [nontrivial R] {ι : Sort*} [fintype ι] {f : ι → R}
  (hfs : (∏ i, (X - C (f i))).separable) : function.injective f :=
λ x y hfxy, hfs.inj_of_prod_X_sub_C (mem_univ _) (mem_univ _) hfxy

lemma nodup_of_separable_prod [nontrivial R] {s : multiset R}
  (hs : separable (multiset.map (λ a, X - C a) s).prod) : s.nodup :=
begin
  rw multiset.nodup_iff_ne_cons_cons,
  rintros a t rfl,
  refine not_is_unit_X_sub_C a (is_unit_of_self_mul_dvd_separable hs _),
  simpa only [multiset.map_cons, multiset.prod_cons] using mul_dvd_mul_left _ (dvd_mul_right _ _)
end

/--If `is_unit n` in a `comm_ring R`, then `X ^ n - u` is separable for any unit `u`. -/
lemma separable_X_pow_sub_C_unit {n : ℕ} (u : units R) (hn : is_unit (n : R)) :
  separable (X ^ n - C (u : R)) :=
begin
  nontriviality R,
  rcases n.eq_zero_or_pos with rfl | hpos,
  { simpa using hn },
  apply (separable_def' (X ^ n - C (u : R))).2,
  obtain ⟨n', hn'⟩ := hn.exists_left_inv,
  refine ⟨-C ↑u⁻¹, C ↑u⁻¹ * C n' * X, _⟩,
  rw [derivative_sub, derivative_C, sub_zero, derivative_pow X n, derivative_X, mul_one],
  calc  - C ↑u⁻¹ * (X ^ n - C ↑u) + C ↑u⁻¹ * C n' * X * (↑n * X ^ (n - 1))
      = C (↑u⁻¹ * ↑ u) - C ↑u⁻¹ * X^n + C ↑ u ⁻¹ * C (n' * ↑n) * (X * X ^ (n - 1)) :
    by { simp only [C.map_mul, C_eq_nat_cast], ring }
  ... = 1 : by simp only [units.inv_mul, hn', C.map_one, mul_one, ← pow_succ,
              nat.sub_add_cancel (show 1 ≤ n, from hpos), sub_add_cancel]
end

lemma root_multiplicity_le_one_of_separable [nontrivial R] {p : polynomial R} (hp : p ≠ 0)
  (hsep : separable p) (x : R) : root_multiplicity x p ≤ 1 :=
begin
  rw [root_multiplicity_eq_multiplicity, dif_neg hp, ← enat.coe_le_coe, enat.coe_get, nat.cast_one],
  exact multiplicity_le_one_of_separable (not_is_unit_X_sub_C _) hsep
end

end comm_ring

section is_domain

variables (R : Type u) [comm_ring R] [is_domain R]

theorem is_local_ring_hom_expand {p : ℕ} (hp : 0 < p) :
  is_local_ring_hom (↑(expand R p) : polynomial R →+* polynomial R) :=
begin
  refine ⟨λ f hf1, _⟩, rw ← coe_fn_coe_base at hf1,
  have hf2 := eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit hf1),
  rw [coeff_expand hp, if_pos (dvd_zero _), p.zero_div] at hf2,
  rw [hf2, is_unit_C] at hf1, rw expand_eq_C hp at hf2, rwa [hf2, is_unit_C]
end

variable {R}

theorem of_irreducible_expand {p : ℕ} (hp : p ≠ 0) {f : polynomial R}
  (hf : irreducible (expand R p f)) : irreducible f :=
@@of_irreducible_map _ _ _ (is_local_ring_hom_expand R hp.bot_lt) hf

theorem of_irreducible_expand_pow {p : ℕ} (hp : p ≠ 0) {f : polynomial R} {n : ℕ} :
  irreducible (expand R (p ^ n) f) → irreducible f :=
nat.rec_on n (λ hf, by rwa [pow_zero, expand_one] at hf) $ λ n ih hf,
ih $ of_irreducible_expand hp $ by { rw pow_succ at hf, rwa [expand_expand] }

lemma count_roots_le_one {p : polynomial R} (hsep : separable p) (x : R) :
  p.roots.count x ≤ 1 :=
begin
  rcases eq_or_ne p 0 with rfl | hp,
  { simp },
  rw count_roots hp,
  exact root_multiplicity_le_one_of_separable hp hsep x
end

lemma nodup_roots {p : polynomial R} (hsep : separable p) : p.roots.nodup :=
multiset.nodup_iff_count_le_one.mpr (count_roots_le_one hsep)

end is_domain

section field

variables {F : Type u} [field F] {K : Type v} [field K]

theorem separable_iff_derivative_ne_zero {f : polynomial F} (hf : irreducible f) :
  f.separable ↔ f.derivative ≠ 0 :=
⟨λ h1 h2, hf.not_unit $ is_coprime_zero_right.1 $ h2 ▸ h1,
λ h, euclidean_domain.is_coprime_of_dvd (mt and.right h) $ λ g hg1 hg2 ⟨p, hg3⟩ hg4,
let ⟨u, hu⟩ := (hf.is_unit_or_is_unit hg3).resolve_left hg1 in
have f ∣ f.derivative, by { conv_lhs { rw [hg3, ← hu] }, rwa units.mul_right_dvd },
not_lt_of_le (nat_degree_le_of_dvd this h) $ nat_degree_derivative_lt h⟩

theorem separable_map (f : F →+* K) {p : polynomial F} : (p.map f).separable ↔ p.separable :=
by simp_rw [separable_def, derivative_map, is_coprime_map]

lemma separable_prod_X_sub_C_iff' {ι : Sort*} {f : ι → F} {s : finset ι} :
  (∏ i in s, (X - C (f i))).separable ↔ (∀ (x ∈ s) (y ∈ s), f x = f y → x = y) :=
⟨λ hfs x hx y hy hfxy, hfs.inj_of_prod_X_sub_C hx hy hfxy,
λ H, by { rw ← prod_attach, exact separable_prod' (λ x hx y hy hxy,
    @pairwise_coprime_X_sub _ _ { x // x ∈ s } (λ x, f x)
      (λ x y hxy, subtype.eq $ H x.1 x.2 y.1 y.2 hxy) _ _ hxy)
  (λ _ _, separable_X_sub_C) }⟩

lemma separable_prod_X_sub_C_iff {ι : Sort*} [fintype ι] {f : ι → F} :
  (∏ i, (X - C (f i))).separable ↔ function.injective f :=
separable_prod_X_sub_C_iff'.trans $ by simp_rw [mem_univ, true_implies_iff, function.injective]

section char_p

variables (p : ℕ) [HF : char_p F p]
include HF

theorem separable_or {f : polynomial F} (hf : irreducible f) : f.separable ∨
  ¬f.separable ∧ ∃ g : polynomial F, irreducible g ∧ expand F p g = f :=
if H : f.derivative = 0 then
begin
  unfreezingI { rcases p.eq_zero_or_pos with rfl | hp },
  { haveI := char_p.char_p_to_char_zero F,
    have := nat_degree_eq_zero_of_derivative_eq_zero H,
    have := (nat_degree_pos_iff_degree_pos.mpr $ degree_pos_of_irreducible hf).ne',
    contradiction },
  haveI := is_local_ring_hom_expand F hp,
  exact or.inr
        ⟨by rw [separable_iff_derivative_ne_zero hf, not_not, H],
        contract p f,
        of_irreducible_map ↑(expand F p) (by rwa ← expand_contract p H hp.ne' at hf),
        expand_contract p H hp.ne'⟩
end
else or.inl $ (separable_iff_derivative_ne_zero hf).2 H

theorem exists_separable_of_irreducible {f : polynomial F} (hf : irreducible f) (hp : p ≠ 0) :
  ∃ (n : ℕ) (g : polynomial F), g.separable ∧ expand F (p ^ n) g = f :=
begin
  replace hp : p.prime := (char_p.char_is_prime_or_zero F p).resolve_right hp,
  unfreezingI
  { induction hn : f.nat_degree using nat.strong_induction_on with N ih generalizing f },
  rcases separable_or p hf with h | ⟨h1, g, hg, hgf⟩,
  { refine ⟨0, f, h, _⟩, rw [pow_zero, expand_one] },
  { cases N with N,
    { rw [nat_degree_eq_zero_iff_degree_le_zero, degree_le_zero_iff] at hn,
      rw [hn, separable_C, is_unit_iff_ne_zero, not_not] at h1,
      have hf0 : f ≠ 0 := hf.ne_zero,
      rw [h1, C_0] at hn, exact absurd hn hf0 },
    have hg1 : g.nat_degree * p = N.succ,
    { rwa [← nat_degree_expand, hgf] },
    have hg2 : g.nat_degree ≠ 0,
    { intro this, rw [this, zero_mul] at hg1, cases hg1 },
    have hg3 : g.nat_degree < N.succ,
    { rw [← mul_one g.nat_degree, ← hg1],
      exact nat.mul_lt_mul_of_pos_left hp.one_lt hg2.bot_lt },
    rcases ih _ hg3 hg rfl with ⟨n, g, hg4, rfl⟩, refine ⟨n+1, g, hg4, _⟩,
    rw [← hgf, expand_expand, pow_succ] }
end

theorem is_unit_or_eq_zero_of_separable_expand {f : polynomial F} (n : ℕ) (hp : 0 < p)
  (hf : (expand F (p ^ n) f).separable) : is_unit f ∨ n = 0 :=
begin
  rw or_iff_not_imp_right,
  rintro hn : n ≠ 0,
  have hf2 : (expand F (p ^ n) f).derivative = 0,
  { by rw [derivative_expand, nat.cast_pow, char_p.cast_eq_zero,
      zero_pow hn.bot_lt, zero_mul, mul_zero] },
  rw [separable_def, hf2, is_coprime_zero_right, is_unit_iff] at hf,
  rcases hf with ⟨r, hr, hrf⟩,
  rw [eq_comm, expand_eq_C (pow_pos hp _)] at hrf,
  rwa [hrf, is_unit_C]
end

theorem unique_separable_of_irreducible {f : polynomial F} (hf : irreducible f) (hp : 0 < p)
  (n₁ : ℕ) (g₁ : polynomial F) (hg₁ : g₁.separable) (hgf₁ : expand F (p ^ n₁) g₁ = f)
  (n₂ : ℕ) (g₂ : polynomial F) (hg₂ : g₂.separable) (hgf₂ : expand F (p ^ n₂) g₂ = f) :
  n₁ = n₂ ∧ g₁ = g₂ :=
begin
  revert g₁ g₂,
  wlog hn : n₁ ≤ n₂ := le_total n₁ n₂ using [n₁ n₂, n₂ n₁],
  have hf0 : f ≠ 0 := hf.ne_zero,
  unfreezingI { intros, rw le_iff_exists_add at hn, rcases hn with ⟨k, rfl⟩,
    rw [← hgf₁, pow_add, expand_mul, expand_inj (pow_pos hp n₁)] at hgf₂, subst hgf₂,
    subst hgf₁,
    rcases is_unit_or_eq_zero_of_separable_expand p k hp hg₁ with h | rfl,
    { rw is_unit_iff at h, rcases h with ⟨r, hr, rfl⟩,
      simp_rw expand_C at hf, exact absurd (is_unit_C.2 hr) hf.1 },
    { rw [add_zero, pow_zero, expand_one], split; refl } },
  obtain ⟨hn, hg⟩ := this g₂ g₁ hg₂ hgf₂ hg₁ hgf₁,
  exact ⟨hn.symm, hg.symm⟩
end

end char_p

/--If `n ≠ 0` in `F`, then ` X ^ n - a` is separable for any `a ≠ 0`. -/
lemma separable_X_pow_sub_C {n : ℕ} (a : F) (hn : (n : F) ≠ 0) (ha : a ≠ 0) :
  separable (X ^ n - C a) :=
separable_X_pow_sub_C_unit (units.mk0 a ha) (is_unit.mk0 n hn)

-- this can possibly be strengthened to making `separable_X_pow_sub_C_unit` a
-- bi-implication, but it is nontrivial!
/-- In a field `F`, `X ^ n - 1` is separable iff `↑n ≠ 0`. -/
lemma X_pow_sub_one_separable_iff {n : ℕ} :
  (X ^ n - 1 : polynomial F).separable ↔ (n : F) ≠ 0 :=
begin
  refine ⟨_, λ h, separable_X_pow_sub_C_unit 1 (is_unit.mk0 ↑n h)⟩,
  rw [separable_def', derivative_sub, derivative_X_pow, derivative_one, sub_zero],
  -- Suppose `(n : F) = 0`, then the derivative is `0`, so `X ^ n - 1` is a unit, contradiction.
  rintro (h : is_coprime _ _) hn',
  rw [← C_eq_nat_cast, hn', C.map_zero, zero_mul, is_coprime_zero_right] at h,
  have := not_is_unit_X_pow_sub_one F n,
  contradiction
end

section splits

lemma card_root_set_eq_nat_degree [algebra F K] {p : polynomial F} (hsep : p.separable)
  (hsplit : splits (algebra_map F K) p) : fintype.card (p.root_set K) = p.nat_degree :=
begin
  simp_rw [root_set_def, finset.coe_sort_coe, fintype.card_coe],
  rw [multiset.to_finset_card_of_nodup, ←nat_degree_eq_card_roots hsplit],
  exact nodup_roots hsep.map,
end

variable {i : F →+* K}

lemma eq_X_sub_C_of_separable_of_root_eq {x : F} {h : polynomial F}
  (h_sep : h.separable) (h_root : h.eval x = 0) (h_splits : splits i h)
  (h_roots : ∀ y ∈ (h.map i).roots, y = i x) : h = (C (leading_coeff h)) * (X - C x) :=
begin
  have h_ne_zero : h ≠ 0 := by { rintro rfl, exact not_separable_zero h_sep },
  apply polynomial.eq_X_sub_C_of_splits_of_single_root i h_splits,
  apply finset.mk.inj,
  { change _ = {i x},
    rw finset.eq_singleton_iff_unique_mem,
    split,
    { apply finset.mem_mk.mpr,
      rw mem_roots (show h.map i ≠ 0, by exact map_ne_zero h_ne_zero),
      rw [is_root.def,←eval₂_eq_eval_map,eval₂_hom,h_root],
      exact ring_hom.map_zero i },
    { exact h_roots } },
  { exact nodup_roots (separable.map h_sep) },
end

lemma exists_finset_of_splits
  (i : F →+* K) {f : polynomial F} (sep : separable f) (sp : splits i f) :
  ∃ (s : finset K), f.map i =
    C (i f.leading_coeff) * (s.prod (λ a : K, (X : polynomial K) - C a)) :=
begin
  classical,
  obtain ⟨s, h⟩ := exists_multiset_of_splits i sp,
  use s.to_finset,
  rw [h, finset.prod_eq_multiset_prod, ←multiset.to_finset_eq],
  apply nodup_of_separable_prod,
  apply separable.of_mul_right,
  rw ←h,
  exact sep.map,
end

end splits

theorem _root_.irreducible.separable [char_zero F] {f : polynomial F}
  (hf : irreducible f) : f.separable :=
begin
  rw [separable_iff_derivative_ne_zero hf, ne, ← degree_eq_bot, degree_derivative_eq],
  { rintro ⟨⟩ },
  rw [pos_iff_ne_zero, ne, nat_degree_eq_zero_iff_degree_le_zero, degree_le_zero_iff],
  refine λ hf1, hf.not_unit _,
  rw [hf1, is_unit_C, is_unit_iff_ne_zero],
  intro hf2,
  rw [hf2, C_0] at hf1,
  exact absurd hf1 hf.ne_zero
end

end field

end polynomial

open polynomial

section comm_ring

variables (F K : Type*) [comm_ring F] [ring K] [algebra F K]

-- TODO: refactor to allow transcendental extensions?
-- See: https://en.wikipedia.org/wiki/Separable_extension#Separability_of_transcendental_extensions
-- Note that right now a Galois extension (class `is_galois`) is defined to be an extension which
-- is separable and normal, so if the definition of separable changes here at some point
-- to allow non-algebraic extensions, then the definition of `is_galois` must also be changed.

/-- Typeclass for separable field extension: `K` is a separable field extension of `F` iff
the minimal polynomial of every `x : K` is separable.

We define this for general (commutative) rings and only assume `F` and `K` are fields if this
is needed for a proof.
-/
class is_separable : Prop :=
(is_integral' (x : K) : is_integral F x)
(separable' (x : K) : (minpoly F x).separable)

variables (F) {K}

theorem is_separable.is_integral [is_separable F K] :
  ∀ x : K, is_integral F x := is_separable.is_integral'

theorem is_separable.separable [is_separable F K] :
  ∀ x : K, (minpoly F x).separable := is_separable.separable'

variables {F K}

theorem is_separable_iff : is_separable F K ↔ ∀ x : K, is_integral F x ∧ (minpoly F x).separable :=
⟨λ h x, ⟨@@is_separable.is_integral F _ _ _ h x, @@is_separable.separable F _ _ _ h x⟩,
 λ h, ⟨λ x, (h x).1, λ x, (h x).2⟩⟩

end comm_ring

instance is_separable_self (F : Type*) [field F] : is_separable F F :=
⟨λ x, is_integral_algebra_map, λ x, by { rw minpoly.eq_X_sub_C', exact separable_X_sub_C }⟩

/-- A finite field extension in characteristic 0 is separable. -/
@[priority 100] -- See note [lower instance priority]
instance is_separable.of_finite (F K : Type*) [field F] [field K] [algebra F K]
  [finite_dimensional F K] [char_zero F] : is_separable F K :=
have ∀ (x : K), is_integral F x,
from λ x, (is_algebraic_iff_is_integral _).mp (algebra.is_algebraic_of_finite _),
⟨this, λ x, (minpoly.irreducible (this x)).separable⟩

section is_separable_tower
variables (F K E : Type*) [field F] [field K] [field E] [algebra F K] [algebra F E]
  [algebra K E] [is_scalar_tower F K E]

lemma is_separable_tower_top_of_is_separable [is_separable F E] : is_separable K E :=
⟨λ x, is_integral_of_is_scalar_tower x (is_separable.is_integral F x),
 λ x, (is_separable.separable F x).map.of_dvd (minpoly.dvd_map_of_is_scalar_tower _ _ _)⟩

lemma is_separable_tower_bot_of_is_separable [h : is_separable F E] : is_separable F K :=
is_separable_iff.2 $ λ x, begin
  refine (is_separable_iff.1 h (algebra_map K E x)).imp
    is_integral_tower_bot_of_is_integral_field (λ hs, _),
  obtain ⟨q, hq⟩ := minpoly.dvd F x
    (is_scalar_tower.aeval_eq_zero_of_aeval_algebra_map_eq_zero_field
      (minpoly.aeval F ((algebra_map K E) x))),
  rw hq at hs,
  exact hs.of_mul_left
end

variables {E}

lemma is_separable.of_alg_hom (E' : Type*) [field E'] [algebra F E']
  (f : E →ₐ[F] E') [is_separable F E'] : is_separable F E :=
begin
  letI : algebra E E' := ring_hom.to_algebra f.to_ring_hom,
  haveI : is_scalar_tower F E E' := is_scalar_tower.of_algebra_map_eq (λ x, (f.commutes x).symm),
  exact is_separable_tower_bot_of_is_separable F E E',
end

end is_separable_tower

section card_alg_hom

variables {R S T : Type*} [comm_ring S]
variables {K L F : Type*} [field K] [field L] [field F]
variables [algebra K S] [algebra K L]

lemma alg_hom.card_of_power_basis (pb : power_basis K S) (h_sep : (minpoly K pb.gen).separable)
  (h_splits : (minpoly K pb.gen).splits (algebra_map K L)) :
  @fintype.card (S →ₐ[K] L) (power_basis.alg_hom.fintype pb) = pb.dim :=
begin
  let s := ((minpoly K pb.gen).map (algebra_map K L)).roots.to_finset,
  have H := λ x, multiset.mem_to_finset,
  rw [fintype.card_congr pb.lift_equiv', fintype.card_of_subtype s H,
      ← pb.nat_degree_minpoly, nat_degree_eq_card_roots h_splits, multiset.to_finset_card_of_nodup],
  exact nodup_roots ((separable_map (algebra_map K L)).mpr h_sep)
end

end card_alg_hom


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import tactic.basic

/-- `ℕ+` is the type of positive natural numbers. It is defined as a subtype,
  and the VM representation of `ℕ+` is the same as `ℕ` because the proof
  is not stored. -/
def pnat := {n : ℕ // n > 0}
notation `ℕ+` := pnat

instance coe_pnat_nat : has_coe ℕ+ ℕ := ⟨subtype.val⟩

namespace nat

/-- Convert a natural number to a positive natural number. The
  positivity assumption is inferred by `dec_trivial`. -/
def to_pnat (n : ℕ) (h : n > 0 . tactic.exact_dec_trivial) : ℕ+ := ⟨n, h⟩

/-- Write a successor as an element of `ℕ+`. -/
def succ_pnat (n : ℕ) : ℕ+ := ⟨succ n, succ_pos n⟩

@[simp] theorem succ_pnat_coe (n : ℕ) : (succ_pnat n : ℕ) = succ n := rfl

/-- Convert a natural number to a pnat. `n+1` is mapped to itself,
  and `0` becomes `1`. -/
def to_pnat' (n : ℕ) : ℕ+ := succ_pnat (pred n)

end nat

namespace pnat

open nat
@[simp] theorem pos (n : ℕ+) : (n : ℕ) > 0 := n.2

theorem eq {m n : ℕ+} : (m : ℕ) = n → m = n := subtype.eq

@[simp] theorem mk_coe (n h) : ((⟨n, h⟩ : ℕ+) : ℕ) = n := rfl

instance : has_add ℕ+ := ⟨λ m n, ⟨m + n, add_pos m.2 n.2⟩⟩

@[simp] theorem add_coe (m n : ℕ+) : ((m + n : ℕ+) : ℕ) = m + n := rfl

@[simp] theorem ne_zero (n : ℕ+) : (n : ℕ) ≠ 0 := ne_of_gt n.2

@[simp] theorem to_pnat'_coe {n : ℕ} : n > 0 → (n.to_pnat' : ℕ) = n := succ_pred_eq_of_pos

@[simp] theorem coe_to_pnat' (n : ℕ+) : (n : ℕ).to_pnat' = n := eq (to_pnat'_coe n.pos)

instance : comm_monoid ℕ+ :=
{ mul       := λ m n, ⟨m.1 * n.1, mul_pos m.2 n.2⟩,
  mul_assoc := λ a b c, subtype.eq (mul_assoc _ _ _),
  one       := succ_pnat 0,
  one_mul   := λ a, subtype.eq (one_mul _),
  mul_one   := λ a, subtype.eq (mul_one _),
  mul_comm  := λ a b, subtype.eq (mul_comm _ _) }

structure tricky2 (G : Type) extends has_mul G :=
(tricky_bit : 0 = 1)

#print comm_monoid
--  example : has_mul.mul ℕ+ := by apply_instance
set_option pp.implicit true
#check (by apply_instance : has_mul ℕ+)

@[simp] theorem one_coe : ((1 : ℕ+) : ℕ) = 1 := rfl

@[simp] theorem mul_coe (m n : ℕ+) : ((m * n : ℕ+) : ℕ) = m * n := rfl

/-- The power of a pnat and a nat is a pnat. -/
def pow (m : ℕ+) (n : ℕ) : ℕ+ :=
⟨m ^ n, nat.pos_pow_of_pos _ m.pos⟩

instance : has_pow ℕ+ ℕ := ⟨pow⟩

@[simp] theorem pow_coe (m : ℕ+) (n : ℕ) : (↑(m ^ n) : ℕ) = m ^ n := rfl

end pnat

section
parameters {a b c : nat}
parameters {ha : a > 0} {hb : b > 0} {hc : c > 0}
def A : pnat := ⟨a,ha⟩
def B : pnat := ⟨b,hb⟩
def C : pnat := ⟨c,hc⟩

example : (A * (A + B) * (C + (A + B)) : ℕ) = a * (a + b) * (c + (a + b)) := by simp [A,B,C]

#print prefix A

#check A
end section
#print prefix A
#check @A.equations._eqn_1

end
#print notation ^


/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/
import group_theory.order_of_element
import algebra.punit_instances
import algebra.gcd_monoid.finset
import ring_theory.int.basic

/-!
# Exponent of a group

This file defines the exponent of a group, or more generally a monoid. For a group `G` it is defined
to be the minimal `n≥1` such that `g ^ n = 1` for all `g ∈ G`. For a finite group `G` it is equal to
the lowest common multiple of the order of all elements of the group `G`.

## Main definitions

* `monoid.exponent_exists` is a predicate on a monoid `G` saying that there is some positive `n`
  such that `g ^ n = 1` for all `g ∈ G`.
* `monoid.exponent` defines the exponent of a monoid `G` as the minimal positive `n` such that
  `g ^ n = 1` for all `g ∈ G`, by convention it is `0` if no such `n` exists.
* `add_monoid.exponent_exists` the additive version of `monoid.exponent_exists`.
* `add_monoid.exponent` the additive version of `monoid.exponent`.

## Main results

* `lcm_order_eq_exponent`: For a finite group `G`, the exponent is equal to the `lcm` of the order
  of its elements.

## TODO
* Compute the exponent of cyclic groups.
* Refactor the characteristic of a ring to be the exponent of its underlying additive group.
-/

universe u

variables (G : Type u) [monoid G]

open_locale classical

namespace monoid

/--A predicate on a monoid saying that there is a positive integer `n` such that `g ^ n = 1`
  for all `g`.-/
@[to_additive "A predicate on an additive monoid saying that there is a positive integer `n` such
  that `n • g = 0` for all `g`."]
def exponent_exists  := ∃ n, 0 < n ∧ ∀ g : G, g ^ n = 1

/--The exponent of a group is the smallest positive integer `n` such that `g ^ n = 1` for all
  `g ∈ G` if it exists, otherwise it is zero by convention.-/
@[to_additive "The exponent of an additive group is the smallest positive integer `n` such that
  `n • g = 0` for all `g ∈ G` if it exists, otherwise it is zero by convention."]
noncomputable def exponent :=
if h : exponent_exists G then nat.find h else 0

@[to_additive exponent_nsmul_eq_zero]
lemma pow_exponent_eq_one (g : G) : g ^ exponent G = 1 :=
begin
  by_cases exponent_exists G,
  { simp_rw [exponent, dif_pos h],
    exact (nat.find_spec h).2 g},
  { simp_rw [exponent, dif_neg h, pow_zero] }
end

@[to_additive nsmul_eq_mod_exponent]
lemma pow_eq_mod_exponent {n : ℕ} (g : G): g ^ n = g ^ (n % exponent G) :=
calc g ^ n = g ^ (n % exponent G + exponent G * (n / exponent G)) : by rw [nat.mod_add_div]
  ... = g ^ (n % exponent G) : by simp [pow_add, pow_mul, pow_exponent_eq_one]

@[to_additive]
lemma exponent_pos_of_exists (n : ℕ) (hpos : 0 < n) (hG : ∀ g : G, g ^ n = 1) :
  0 < exponent G :=
begin
  have h : ∃ n, 0 < n ∧ ∀ g : G, g ^ n = 1 := ⟨n, hpos, hG⟩,
  rw [exponent, dif_pos],
  exact (nat.find_spec h).1,
end

@[to_additive]

@[to_additive]
lemma exponent_min (m : ℕ) (hpos : 0 < m) (hm : m < exponent G) : ∃ g : G, g ^ m ≠ 1 :=
begin
  by_contradiction,
  push_neg at h,
  have hcon : exponent G ≤ m := exponent_min' G m hpos h,
  linarith,
end

@[simp, to_additive]
lemma exp_eq_one_of_subsingleton [subsingleton G] : exponent G = 1 :=
begin
  apply le_antisymm,
  { apply exponent_min' _ _ nat.one_pos,
    simp },
  { apply nat.succ_le_of_lt,
    apply exponent_pos_of_exists _ 1 (nat.one_pos),
    simp },
end

@[to_additive add_order_dvd_exponent]
lemma order_dvd_exponent (g : G) : (order_of g) ∣ exponent G :=
order_of_dvd_of_pow_eq_one (pow_exponent_eq_one G g)

@[to_additive]
lemma exponent_dvd_of_forall_pow_eq_one (n : ℕ) (hpos : 0 < n) (hG : ∀ g : G, g ^ n = 1) :
  exponent G ∣ n :=
begin
  apply nat.dvd_of_mod_eq_zero,
  by_contradiction h,
  have h₁ := nat.pos_of_ne_zero h,
  have h₂ : n % exponent G < exponent G := nat.mod_lt _ (exponent_pos_of_exists _ n hpos hG),
  have h₃ : exponent G ≤ n % exponent G,
  { apply exponent_min' _ _ h₁,
    simp_rw ←pow_eq_mod_exponent,
    exact hG },
  linarith,
end

variable [fintype G]

@[to_additive lcm_add_order_of_dvd_exponent]
lemma lcm_order_of_dvd_exponent : (finset.univ : finset G).lcm order_of ∣ exponent G :=
begin
  apply finset.lcm_dvd,
  intros g hg,
  exact order_dvd_exponent G g
end

@[to_additive lcm_add_order_eq_exponent]
lemma lcm_order_eq_exponent {H : Type u} [fintype H] [left_cancel_monoid H] :
  (finset.univ : finset H).lcm order_of = exponent H :=
begin
  apply nat.dvd_antisymm (lcm_order_of_dvd_exponent H),
  apply exponent_dvd_of_forall_pow_eq_one,
  { apply nat.pos_of_ne_zero,
    by_contradiction,
    rw finset.lcm_eq_zero_iff at h,
    cases h with g hg,
    simp only [true_and, set.mem_univ, finset.coe_univ] at hg,
    exact ne_of_gt (order_of_pos g) hg },
  { intro g,
    have h : (order_of g) ∣ (finset.univ : finset H).lcm order_of,
    { apply finset.dvd_lcm,
      exact finset.mem_univ g },
    cases h with m hm,
    rw [hm, pow_mul, pow_order_of_eq_one, one_pow] },
end

end monoid


/-
Fill in the sorry.

section
  variable U : Type
  variables A B : U → Prop

  example : (∀ x, A x ∧ B x) → ∀ x, A x :=
  sorry
end
-/

section
  variable U : Type
  variables A B : U → Prop

  example : (∀ x, A x ∧ B x) → ∀ x, A x :=
  assume h: (∀ x, A(x) ∧ B(x)),
  assume x: U,
  have hAxBx: A(x) ∧ B(x), from h(x),
  show A(x), from and.elim_left(hAxBx)
end