-- https://leanprover.github.io/theorem_proving_in_lean/index.html
-- Section 5 (Tactics)

theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro,
  exact hp,
  apply and.intro,
  exact hq,
  exact hp
end
print test
-- This looks very Coq-like to me (perhaps intentionally, since Roesch
-- spoke very highly of Coq's tactics as something that Idris and Agda
-- were missing).

-- Helpful:
-- "You can write a tactic script incrementally. If you run Lean on an
-- incomplete tactic proof bracketed by begin and end, the system
-- reports all the unsolved goals that remain. If you are running Lean
-- with its Emacs interface, you can see this information by putting
-- your cursor on the end symbol, which should be underlined. In the
-- Emacs interface, there is another extremely useful trick: if you
-- put your cursor on a line of a tactic proof and press "C-c C-g",
-- Lean will show you the goal that remains at the end of the line."

-- Equivalent:
theorem test2 (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro hp,
  exact and.intro hq hp
end
print test2

-- Also equivalent:
theorem test3 (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
by exact and.intro hp (and.intro hq hp)
print test3

section example1
  variables {p q : Prop} (hp : p) (hq : q)

  include hp hq

  example : p ∧ q ∧ p :=
  begin
    apply and.intro hp,
    exact and.intro hq hp
  end
end example1

-- "We adopt the following convention regarding indentation: whenever
-- a tactic introduces one or more additional subgoals, we indent
-- another two spaces, until the additional subgoals are deleted."
example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h, -- 1st subgoal (iff.intro)
    apply or.elim (and.elim_right h),
      intro hq, -- 1st subsubgoal
      apply or.intro_left,
      apply and.intro, -- 2 subsubsubgoals:
        exact and.elim_left h,
      exact hq,
    intro hr, -- 2nd subsubgoal
    apply or.intro_right,
    apply and.intro, -- 2 subsubsubgoals:
      exact and.elim_left h,
      exact hr,
  intro h,  -- 2nd subgoal (iff.intro)
  apply or.elim h,
    intro hpq,
    apply and.intro,
      exact and.elim_left hpq,
    apply or.intro_left,
    exact and.elim_right hpq,
  intro hpr,
  apply and.intro,
    exact and.elim_left hpr,
  apply or.intro_right,
  exact and.elim_right hpr
end

section example_assumption
  variables {x y z w : Prop}
  example (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w :=
  begin
    apply eq.trans h₁,
    apply eq.trans h₂,
    assumption   -- applied h₃
  end

  example (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w :=
  begin
    apply eq.trans,
    assumption,     -- solves x = ?m_1 with h₁
    apply eq.trans,
    assumption,     -- solves y = ?m_1 with h₂
    assumption      -- solves z = w with h₃
  end
end example_assumption

example : ∀ a b c : ℕ, a = b → a = c → c = b :=
begin
  intros,
  apply eq.trans,
  apply eq.symm,
  assumption,
  assumption
end

-- Same as previous:
example : ∀ a b c : ℕ, a = b → a = c → c = b :=
begin
  intros,
  transitivity,
  symmetry,
  assumption,
  assumption
end

-- Or:
example : ∀ a b c : ℕ, a = b → a = c → c = b :=
begin
  intros,
  transitivity,
  symmetry,
  repeat { assumption }
end

example : ∃ a : ℕ, a = a :=
begin
  fapply exists.intro,
  exact 0,
  apply rfl
end

section example_generalize
  variables x y z : ℕ

  example : x = x :=
  begin
    generalize x z, -- goal is x : ℕ ⊢ ∀ (z : ℕ), z = z
    intro y,      -- goal is x y : ℕ ⊢ y = y
    reflexivity
  end

  -- I still don't totally get this...
  example : x + y + z = x + y + z :=
  begin
    generalize (x + y + z) w, -- goal is x y z : ℕ ⊢ ∀ (w : ℕ), w = w
    intro u,                  -- goal is x y z u : ℕ ⊢ u = u
    reflexivity
  end

  example : x + y + z = x + y + z :=
  begin
    generalize (x + y + z) w, -- goal is x y z : ℕ ⊢ ∀ (w : ℕ), w = w
    clear x y z,
    intro u,                  -- goal is u : ℕ ⊢ u = u
    reflexivity
  end
end example_generalize

example (x : ℕ) : x = x :=
begin
  revert x,     -- goal is ⊢ ∀ (x : ℕ), x = x
  intro y,      -- goal is y : ℕ ⊢ y = y
  reflexivity
end

-- "Moving a hypothesis into the goal yields an implication:" (Is it
-- sort of the opposite of 'intro' then?)
example (x y : ℕ) (h : x = y) : y = x :=
begin
  revert h,     -- goal is x y : ℕ ⊢ x = y → y = x
  intro h₁,     -- goal is x y : ℕ, h₁ : x = y ⊢ y = x
  symmetry,
  assumption
end

-- "reverting x in the example above brings h along with it:"
example (x y : ℕ) (h : x = y) : y = x :=
begin
  revert x,     -- goal is y : ℕ ⊢ ∀ (x : ℕ), x = y → y = x
  intros,
  symmetry,
  assumption
end

example (x y : ℕ) (h : x = y) : y = x :=
begin
  revert x y,     -- goal is ⊢ ∀ (x y : ℕ), x = y → y = x
  intros,
  symmetry,
  assumption
end

-- to create disjunction: left = apply or.inl, right = apply or.inr
-- to decompose disjunction: 'cases' tactic
example (p q : Prop) : p ∨ q → q ∨ p :=
begin
  intro h,
  cases h with hp hq,
  -- case hp : p
  right, exact hp,
  -- case hq : q
  left, exact hq
end

example (p q : Prop) : p ∧ q → q ∧ p :=
begin
  intro h,
  -- Also works for conjunction (or any inductively-defined type):
  cases h with hp hq,
  -- 'constructor' applies first constructor of inductive type (first?
  -- what?)
  constructor, exact hq, exact hp
end

section swap
  universe variables u v

  def swap_pair {α : Type u} {β : Type v} : α × β → β × α :=
  begin
    intro p,
    cases p with ha hb,
    constructor, exact hb, exact ha
  end

  def swap_sum {α : Type u} {β : Type v} : α ⊕ β → β ⊕ α :=
  begin
    intro p,
    cases p with ha hb,
      right, exact ha,
      left, exact hb
  end
end swap

section nats
  open nat

  example (P : ℕ → Prop) (h₀ : P 0) (h₁ : ∀ n, P (succ n)) (m : ℕ) : P m :=
  begin
    cases m with m', exact h₀, exact h₁ m'
  end
end nats

-- My term-style solution (from section 3):
example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  iff.intro
    (assume h : p ∧ (q ∨ r),
      (show (p ∧ q) ∨ (p ∧ r), from
        and.elim h
          (assume hp : p, assume hqr : q ∨ r,
            or.elim hqr
              (assume hq : q, or.inl (and.intro hp hq))
              (assume hr : r, or.inr (and.intro hp hr)))))
    (assume h : (p ∧ q) ∨ (p ∧ r),
      (show p ∧ (q ∨ r), from
        or.elim h
          (assume hpq : (p ∧ q),
            have hp : p, from and.left hpq,
            have hqr : q ∨ r, from or.inl (and.right hpq),
            and.intro hp hqr)
          (assume hpr : (p ∧ r),
            have hp : p, from and.left hpr,
            have hqr : q ∨ r, from or.inr (and.right hpr),
            and.intro hp hqr)))

-- Their tactic-style solution:
example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
  intro h,
   cases h with hp hqr,
   cases hqr with hq hr,
     left, constructor, repeat { assumption },
     right, constructor, repeat { assumption },
  intro h,
    cases h with hpq hpr,
      cases hpq with hp hq,
        constructor, exact hp, left, exact hq,
      cases hpr with hp hr,
        constructor, exact hp, right, exact hr
end

-- Their solution combining both styles:
example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    cases h^.right with hq hr,
      exact
        show (p ∧ q) ∨ (p ∧ r),
          from or.inl ⟨h^.left, hq⟩,
    exact
      show (p ∧ q) ∨ (p ∧ r),
        from or.inr ⟨h^.left, hr⟩,
  intro h,
  cases h with hpq hpr,
    exact
      show p ∧ (q ∨ r),
        from ⟨hpq^.left, or.inl hpq^.right⟩,
  exact show p ∧ (q ∨ r),
    from ⟨hpr^.left, or.inr hpr^.right⟩
end
-- "One thing that is nice about Lean's proof-writing syntax is that
-- it is possible to mix term-style and tactic-style proofs, and pass
-- between the two freely. For example, the tactics apply and exact
-- expect arbitrary terms, which you can write using have, show, and
-- so on. Conversely, when writing an arbitrary Lean term, you can
-- always invoke the tactic mode by inserting a begin...end block. "

-- Even further, using "show p, from t" for "exact (show p, from t)":
example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
    intro h,
    cases h^.right with hq hr,
      show (p ∧ q) ∨ (p ∧ r),
        from or.inl ⟨h^.left, hq⟩,
    show (p ∧ q) ∨ (p ∧ r),
      from or.inr ⟨h^.left, hr⟩,
  intro h,
  cases h with hpq hpr,
    show p ∧ (q ∨ r),
      from ⟨hpq^.left, or.inl hpq^.right⟩,
  show p ∧ (q ∨ r),
    from ⟨hpr^.left, or.inr hpr^.right⟩
end

-- Further still, using "have p, from t₁, t₂" for
-- "exact (have p, from t₁, t₂)":
example (p q r : Prop) : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) :=
begin
  intro h,
  have hp : p, from h^.left,
  have hqr : q ∨ r, from h^.right,
  show (p ∧ q) ∨ (p ∧ r),
  begin
    cases hqr with hq hr,
      exact or.inl ⟨hp, hq⟩,
    exact or.inr ⟨hp, hr⟩
  end
end

-- { & } act like nested begin/end:
example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
  apply iff.intro,
  { intro h,
    cases h^.right with hq hr,
    { show (p ∧ q) ∨ (p ∧ r),
        from or.inl ⟨h^.left, hq⟩ },
    show (p ∧ q) ∨ (p ∧ r),
      from or.inr ⟨h^.left, hr⟩ },
  intro h,
  cases h with hpq hpr,
  { show p ∧ (q ∨ r),
      from ⟨hpq^.left, or.inl hpq^.right⟩ },
  show p ∧ (q ∨ r),
    from ⟨hpr^.left, or.inr hpr^.right⟩
end
-- Note that an unsolved goal at "end" (or a closing bracket)
-- generates an error; use this to keep goals lined up.

-- Their convention: "every time a tactic leaves more than one
-- subgoal, we separate the remaining subgoals by enclosing them in
-- blocks and indenting, until we are back down to one subgoal" Note
-- that this differs a bit from what one might naturally expect,
-- e.g. indenting all subgoals including the last.

example (p q : Prop) : p ∧ q ↔ q ∧ p :=
begin
  apply iff.intro,
  { intro h,
    -- 'assert' creates subgoals, and the term hangs around in the
    -- context after that subgoal is proved:
    assert hp : p, exact h^.left,
    assert hq : q, exact h^.right,
    exact ⟨hq, hp⟩ },
  intro h,
  assert hp : p, exact h^.right,
  assert hq : q, exact h^.left,
  exact ⟨hp, hq⟩
end

-- Another way ('note' inserts a fact into the context):
example (p q : Prop) : p ∧ q ↔ q ∧ p :=
begin
  apply iff.intro,
  { intro h,
    note hp := h^.left,
    note hq := h^.right,
    exact ⟨hq, hp⟩ },
  intro h,
  note hp := h^.right,
  note hq := h^.left,
  exact ⟨hp, hq⟩
end
-- But with 'note' you can't get at the contents (not totally sure
-- what this means), whereas with 'pose' you can:
example : ∃ x : ℕ, x + 3 = 8 :=
begin
  pose x := 5,
  existsi x,
  reflexivity
end

example (p q : Prop) : p ∧ q → q ∧ p :=
begin
  intro h,
  split,
  { change q,
    -- I don't understand the point of 'change' here.  I can remove it
    -- and not change anything.
    exact h^.right },
  change p,
  exact h^.left
end

example (a b : ℕ) (h : a = b) : a + 0 = b + 0 :=
begin
  change a = b,
  assumption
end

example (a b c : ℕ) (h₁ : a = b) (h₂ : b = c) : a = c :=
begin
  transitivity,
    change _ = b, assumption,
  assumption
end
-- "In this example, after the transitivity tactic is applied, there
-- are two goals, a = ?m_1 and ?m_1 = c. After the change, the two
-- goals have been specialized to a = b and b = c."

section rewrite1
  variables (f : ℕ → ℕ) (k : ℕ)

  example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
  begin
    rw h₂, -- replace k with 0
    rw h₁  -- replace f 0 with 0
  end

  -- Identical:
  example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
  begin
    rw [h₂, h₁]
  end
end rewrite1

section rewrite2
  variables (f : ℕ → ℕ) (a b : ℕ)

  example (h₁ : a = b) (h₂ : f a = 0) : f b = 0 :=
  begin
    -- Rewriting in reverse direction of equality (see minus sign):
    rw [-h₁, h₂]
  end
end rewrite2

-- Clarifying a rewrite with an argument:
example (a b c : ℕ) : a + b + c = a + c + b :=
begin
  rw [add_assoc, add_comm b, -add_assoc]
end

example (a b c : ℕ) : a + b + c = a + c + b :=
begin
  rw [add_assoc, add_assoc, add_comm b]
end

example (a b c : ℕ) : a + b + c = a + c + b :=
begin
  rw [add_assoc, add_assoc, add_comm _ b]
end

-- Applying to specific hypothesis:
section rewrite3
  variables (f : ℕ → ℕ) (a : ℕ)

  example (h : a + 0 = 0) : f a = f 0 :=
  begin
    rw add_zero at h, rw h
  end
end rewrite3

section rewrite4
  universe variable u

  def tuple (α : Type u) (n : ℕ) := { l : list α // list.length l = n }

  variables {α : Type u} {n : ℕ}

  -- Note that propositions are just types, and 'rewrite' can work
  -- more generally on types other than Prop:
  example (h : n = 0) (t : tuple α n) : tuple α 0 :=
  begin
    rw h at t,
    exact t
  end
end rewrite4

-- Examples of 'simp' (much more automated than 'rewrite'):
section simplify1
  variables (x y z : ℕ) (p : ℕ → Prop)
  premise   (h : p (x * y))

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

  include h
  example : p ((x + 0) * (0 + y * 1 + z * 0)) :=
  begin simp, assumption end

  -- Simplify a hypothesis:
  example (h : p ((x + 0) * (0 + y * 1 + z * 0))) : p (x * y) :=
  begin simp at h, assumption end
end simplify1

-- Below, I redo some of the section 4 exercises in tactic style
-- rather than term style:
section exercises44a
  variables (α : Type) (p q : α → Prop)
  -- "Notice that the declaration variable a : α amounts to the
  -- assumption that there is at least one element of type α. This
  -- assumption is needed in the second example, as well as in the
  -- last two." (This sounds kinda... nonconstructive.)
  variable a : α
  variable r : Prop

  example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
  begin
    apply iff.intro,
    -- How do I start a begin/end block in Emacs, leave it empty, and
    -- still have C-c C-g tell me the current goal?  All I want to do
    -- is work incrementally.
    { intro h,
      cases h with x hpq,
      cases hpq with hp hq,
        left, existsi x, exact hp,
      right, existsi x, exact hq },
    intro h,
    cases h with hp hq,
      cases hp with x hpx,
      existsi x, left, exact hpx,
    cases hq with x hpq,
      existsi x, right, exact hpq,
  end

end exercises44a


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import analysis.special_functions.trigonometric.complex

/-!
# The `arctan` function.

Inequalities, derivatives,
and `real.tan` as a `local_homeomorph` between `(-(π / 2), π / 2)` and the whole line.
-/

noncomputable theory

namespace real

open set filter
open_locale topology real

lemma tan_add {x y : ℝ}
  (h : ((∀ k : ℤ, x ≠ (2 * k + 1) * π / 2) ∧ ∀ l : ℤ, y ≠ (2 * l + 1) * π / 2)
     ∨ ((∃ k : ℤ, x = (2 * k + 1) * π / 2) ∧ ∃ l : ℤ, y = (2 * l + 1) * π / 2)) :
  tan (x + y) = (tan x + tan y) / (1 - tan x * tan y) :=
by simpa only [← complex.of_real_inj, complex.of_real_sub, complex.of_real_add, complex.of_real_div,
              complex.of_real_mul, complex.of_real_tan]
    using @complex.tan_add (x:ℂ) (y:ℂ) (by convert h; norm_cast)

lemma tan_add' {x y : ℝ}
  (h : ((∀ k : ℤ, x ≠ (2 * k + 1) * π / 2) ∧ ∀ l : ℤ, y ≠ (2 * l + 1) * π / 2)) :
  tan (x + y) = (tan x + tan y) / (1 - tan x * tan y) :=
tan_add (or.inl h)

lemma tan_two_mul {x:ℝ} : tan (2 * x) = 2 * tan x / (1 - tan x ^ 2) :=
by simpa only [← complex.of_real_inj, complex.of_real_sub, complex.of_real_div, complex.of_real_pow,
              complex.of_real_mul, complex.of_real_tan, complex.of_real_bit0, complex.of_real_one]
    using complex.tan_two_mul

lemma tan_ne_zero_iff {θ : ℝ} : tan θ ≠ 0 ↔ ∀ k : ℤ, θ ≠ k * π / 2 :=
by rw [← complex.of_real_ne_zero, complex.of_real_tan, complex.tan_ne_zero_iff]; norm_cast

lemma tan_eq_zero_iff {θ : ℝ} : tan θ = 0 ↔ ∃ k : ℤ, θ = k * π / 2 :=
by rw [← not_iff_not, not_exists, ← ne, tan_ne_zero_iff]

lemma tan_int_mul_pi_div_two (n : ℤ) : tan (n * π/2) = 0 :=
tan_eq_zero_iff.mpr (by use n)

lemma continuous_on_tan : continuous_on tan {x | cos x ≠ 0} :=
begin
  suffices : continuous_on (λ x, sin x / cos x) {x | cos x ≠ 0},
  { have h_eq : (λ x, sin x / cos x) = tan, by {ext1 x, rw tan_eq_sin_div_cos, },
    rwa h_eq at this, },
  exact continuous_on_sin.div continuous_on_cos (λ x, id),
end

@[continuity]
lemma continuous_tan : continuous (λ x : {x | cos x ≠ 0}, tan x) :=
continuous_on_iff_continuous_restrict.1 continuous_on_tan

lemma continuous_on_tan_Ioo : continuous_on tan (Ioo (-(π/2)) (π/2)) :=
begin
  refine continuous_on.mono continuous_on_tan (λ x, _),
  simp only [and_imp, mem_Ioo, mem_set_of_eq, ne.def],
  rw cos_eq_zero_iff,
  rintros hx_gt hx_lt ⟨r, hxr_eq⟩,
  cases le_or_lt 0 r,
  { rw lt_iff_not_ge at hx_lt,
    refine hx_lt _,
    rw [hxr_eq, ← one_mul (π / 2), mul_div_assoc, ge_iff_le, mul_le_mul_right (half_pos pi_pos)],
    simp [h], },
  { rw lt_iff_not_ge at hx_gt,
    refine hx_gt _,
    rw [hxr_eq, ← one_mul (π / 2), mul_div_assoc, ge_iff_le, neg_mul_eq_neg_mul,
      mul_le_mul_right (half_pos pi_pos)],
    have hr_le : r ≤ -1, by rwa [int.lt_iff_add_one_le, ← le_neg_iff_add_nonpos_right] at h,
    rw [← le_sub_iff_add_le, mul_comm, ← le_div_iff],
    { norm_num, rw [← int.cast_one, ← int.cast_neg], norm_cast, exact hr_le, },
    { exact zero_lt_two, }, },
end

lemma surj_on_tan : surj_on tan (Ioo (-(π / 2)) (π / 2)) univ :=
have _ := neg_lt_self pi_div_two_pos,
continuous_on_tan_Ioo.surj_on_of_tendsto (nonempty_Ioo.2 this)
  (by simp [tendsto_tan_neg_pi_div_two, this]) (by simp [tendsto_tan_pi_div_two, this])

lemma tan_surjective : function.surjective tan :=
λ x, surj_on_tan.subset_range trivial

lemma image_tan_Ioo : tan '' (Ioo (-(π / 2)) (π / 2)) = univ :=
univ_subset_iff.1 surj_on_tan

/-- `real.tan` as an `order_iso` between `(-(π / 2), π / 2)` and `ℝ`. -/
def tan_order_iso : Ioo (-(π / 2)) (π / 2) ≃o ℝ :=
(strict_mono_on_tan.order_iso _ _).trans $ (order_iso.set_congr _ _ image_tan_Ioo).trans
  order_iso.set.univ

/-- Inverse of the `tan` function, returns values in the range `-π / 2 < arctan x` and
`arctan x < π / 2` -/
@[pp_nodot] noncomputable def arctan (x : ℝ) : ℝ :=
tan_order_iso.symm x

@[simp] lemma tan_arctan (x : ℝ) : tan (arctan x) = x :=
tan_order_iso.apply_symm_apply x

lemma arctan_mem_Ioo (x : ℝ) : arctan x ∈ Ioo (-(π / 2)) (π / 2) :=
subtype.coe_prop _

@[simp] lemma range_arctan : range arctan = Ioo (-(π / 2)) (π / 2) :=
((equiv_like.surjective _).range_comp _).trans subtype.range_coe

lemma arctan_tan {x : ℝ} (hx₁ : -(π / 2) < x) (hx₂ : x < π / 2) : arctan (tan x) = x :=
subtype.ext_iff.1 $ tan_order_iso.symm_apply_apply ⟨x, hx₁, hx₂⟩

lemma cos_arctan_pos (x : ℝ) : 0 < cos (arctan x) :=
cos_pos_of_mem_Ioo $ arctan_mem_Ioo x

lemma cos_sq_arctan (x : ℝ) : cos (arctan x) ^ 2 = 1 / (1 + x ^ 2) :=
by rw [one_div, ← inv_one_add_tan_sq (cos_arctan_pos x).ne', tan_arctan]

lemma sin_arctan (x : ℝ) : sin (arctan x) = x / sqrt (1 + x ^ 2) :=
by rw [← tan_div_sqrt_one_add_tan_sq (cos_arctan_pos x), tan_arctan]

lemma cos_arctan (x : ℝ) : cos (arctan x) = 1 / sqrt (1 + x ^ 2) :=
by rw [one_div, ← inv_sqrt_one_add_tan_sq (cos_arctan_pos x), tan_arctan]

lemma arctan_lt_pi_div_two (x : ℝ) : arctan x < π / 2 :=
(arctan_mem_Ioo x).2

lemma neg_pi_div_two_lt_arctan (x : ℝ) : -(π / 2) < arctan x :=
(arctan_mem_Ioo x).1

lemma arctan_eq_arcsin (x : ℝ) : arctan x = arcsin (x / sqrt (1 + x ^ 2)) :=
eq.symm $ arcsin_eq_of_sin_eq (sin_arctan x) (mem_Icc_of_Ioo $ arctan_mem_Ioo x)

lemma arcsin_eq_arctan {x : ℝ} (h : x ∈ Ioo (-(1:ℝ)) 1) :
  arcsin x = arctan (x / sqrt (1 - x ^ 2)) :=
begin
  rw [arctan_eq_arcsin, div_pow, sq_sqrt, one_add_div, div_div,
      ← sqrt_mul, mul_div_cancel', sub_add_cancel, sqrt_one, div_one];
  nlinarith [h.1, h.2],
end

@[simp] lemma arctan_zero : arctan 0 = 0 :=
by simp [arctan_eq_arcsin]

lemma arctan_eq_of_tan_eq {x y : ℝ} (h : tan x = y) (hx : x ∈ Ioo (-(π / 2)) (π / 2)) :
  arctan y = x :=
inj_on_tan (arctan_mem_Ioo _) hx (by rw [tan_arctan, h])

@[simp] lemma arctan_one : arctan 1 = π / 4 :=
arctan_eq_of_tan_eq tan_pi_div_four $ by split; linarith [pi_pos]

@[simp] lemma arctan_neg (x : ℝ) : arctan (-x) = - arctan x :=
by simp [arctan_eq_arcsin, neg_div]

lemma arctan_eq_arccos {x : ℝ} (h : 0 ≤ x) : arctan x = arccos ((sqrt (1 + x ^ 2))⁻¹) :=
begin
  rw [arctan_eq_arcsin, arccos_eq_arcsin], swap, { exact inv_nonneg.2 (sqrt_nonneg _) },
  congr' 1,
  rw [←sqrt_inv, sq_sqrt, ←one_div, one_sub_div, add_sub_cancel', sqrt_div, sqrt_sq h],
  all_goals { positivity }
end

-- The junk values for `arccos` and `sqrt` make this true even for `1 < x`.
lemma arccos_eq_arctan {x : ℝ} (h : 0 < x) :
  arccos x = arctan (sqrt (1 - x ^ 2) / x) :=
begin
  rw [arccos, eq_comm],
  refine arctan_eq_of_tan_eq _ ⟨_, _⟩,
  { rw [tan_pi_div_two_sub, tan_arcsin, inv_div] },
  { linarith only [arcsin_le_pi_div_two x, pi_pos] },
  { linarith only [arcsin_pos.2 h] }
end

@[continuity]
lemma continuous_arctan : continuous arctan :=
continuous_subtype_coe.comp tan_order_iso.to_homeomorph.continuous_inv_fun

lemma continuous_at_arctan {x : ℝ} : continuous_at arctan x := continuous_arctan.continuous_at

/-- `real.tan` as a `local_homeomorph` between `(-(π / 2), π / 2)` and the whole line. -/
def tan_local_homeomorph : local_homeomorph ℝ ℝ :=
{ to_fun := tan,
  inv_fun := arctan,
  source := Ioo (-(π / 2)) (π / 2),
  target := univ,
  map_source' := maps_to_univ _ _,
  map_target' := λ y hy, arctan_mem_Ioo y,
  left_inv' := λ x hx, arctan_tan hx.1 hx.2,
  right_inv' := λ y hy, tan_arctan y,
  open_source := is_open_Ioo,
  open_target := is_open_univ,
  continuous_to_fun := continuous_on_tan_Ioo,
  continuous_inv_fun := continuous_arctan.continuous_on }

@[simp] lemma coe_tan_local_homeomorph : ⇑tan_local_homeomorph = tan := rfl
@[simp] lemma coe_tan_local_homeomorph_symm : ⇑tan_local_homeomorph.symm = arctan := rfl

end real


import basic_defs_world.level1 -- hide

/- Axiom : A topological space is a T₀ space if, from any two points in the topology, there exist and open set that contains one point and not the other
t0 : ∀ (x y : X) (h : y ≠ x) , ∃ (U : set X) (hU : is_open U), ((x ∈ U) ∧ (y ∉ U)) ∨ ((x ∉ U) ∧ (y ∈ U))
-/

/- Axiom : A topological space is a T₁ space if, from any two points in the topology, there exist and open set that contains the first point and not the second
t1 : ∀ (x y : X) (h : y ≠ x), ∃ (U : set X) (hU : is_open U), (x ∈ U) ∧ (y ∉ U)
-/

/-

# Level 1: Every Frechet space is a T₀ space

-/
variables {X : Type} -- hide
variables [topological_space X] -- hide

namespace topological_space -- hide

/- Lemma
Let τ be a topological space. If τ is a frechet space is also a T₀.
-/
lemma T1_is_T0: T1_space X → T0_space X :=
begin
  introI t1,
  fconstructor,
  intros x y hxy,
  obtain ⟨U, hU, hh⟩:= T1_space.t1 x y hxy,
  exact ⟨U, hU, or.inl hh⟩,

end

end topological_space -- hide


import linear_algebra.basic
import linear_algebra.basis
import algebra.big_operators
universes u v w
variables (X : Type u)(R : Type v)[comm_ring R][decidable_eq X][fintype X]

def ε (x : X) : (X → R) := λ y, if x = y then 1 else 0
variables ( x y : X)
#check ε X R x

lemma  test1 (g : X → R)(s : finset X) : (λ (i : X), g i • ε X R i y)  = λ (i : X), if y = i then g y else 0 := begin
    funext,
    split_ifs, unfold ε, split_ifs,rw h, change g i * 1 = _, rw mul_one, have hypo : i = y, rw h, trivial,
    unfold ε,split_ifs, change (g i) * 1 = _, rw mul_one, have hyp : y= i, rw h_1, trivial, change (g i) * 0 = 0, rw mul_zero,
end
#check finset.sum_ite_eq
lemma  test  (g : X → R)(s : finset X)(y ∈  s) : finset.sum s ((λ (i : X), g i • ε X R i) ) y = g y :=
begin
    rw finset.sum_apply,
    erw test1,
    rw finset.sum_ite_eq,split_ifs, exact rfl,
    assumption,
end
lemma rtrt  (g : X → R)(s : finset X)(y ∈  s) : finset.sum s ((λ (i : X), g i • ε X R i) ) y =  finset.sum s ((λ (i : X), g i • ε X R i y) ) :=
begin
    rw finset.sum_apply, exact rfl,
end
lemma trr (M : Type w)[add_comm_group M][module R M] (p : submodule R M)(g : X → M) : set.range g ⊆ p  → finset.sum finset.univ g ∈ p :=
 begin
    sorry,
 end
lemma gen (g : X → R) : g = finset.sum (finset.univ) (λ (x : X), g x • ε X R x) :=
begin
    funext, rw finset.sum_apply,
    change g x = finset.sum finset.univ (λ (g_1 : X), (g g_1 • ε X R g_1 x) ),
    rw test1,rw finset.sum_ite_eq,split_ifs,exact rfl,
    have R : x ∈ finset.univ, exact finset.mem_univ x, trivial,
    use finset.univ,
end
theorem classical_basis : is_basis R (ε X R) :=
begin
    split,
    {
        rw linear_independent_iff', intros s, intros g,
        intros hyp,
        intros y, intro hyp_y,
        rw function.funext_iff at hyp,
        specialize hyp y,
        rw test at hyp, exact hyp, assumption,
        },
    { rw eq_top_iff, rw submodule.le_def',
    intros g, intros hyp, rw submodule.mem_span,
    intros p, intros hyp',
    let F := gen X R g, rw F,
    let G := trr X R (X → R) p (λ (x : X), g x • ε X R x),
    apply G,
    rw set.subset_def,
    intros g, intros hyp, rw set.mem_range at hyp,
    rcases hyp with ⟨y,hyp_rang ⟩,
    rw ← hyp_rang,
    apply submodule.smul,
    rw [set.subset_def] at hyp',
    specialize hyp' (ε  X R y),
     have GGGG : ε X R y ∈ set.range (ε X R),
        exact set.mem_range_self  y,
        exact hyp' GGGG,
    },
end


inductive Formula
| eqf  : Nat → Nat → Formula
| impf : Formula → Formula → Formula

def Formula.denote : Formula → Prop
| eqf n1 n2  => n1 = n2
| impf f1 f2 => denote f1 → denote f2

theorem Formula.denote_eqf (n1 n2 : Nat) : denote (eqf n1 n2) = (n1 = n2) :=
rfl

theorem Formula.denote_impf (f1 f2 : Formula) : denote (impf f1 f2) = (denote f1 → denote f2) :=
rfl


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Yaël Dillies
-/
import data.nat.pow

/-!
# Natural number logarithms

This file defines two `ℕ`-valued analogs of the logarithm of `n` with base `b`:
* `log b n`: Lower logarithm, or floor **log**. Greatest `k` such that `b^k ≤ n`.
* `clog b n`: Upper logarithm, or **c**eil **log**. Least `k` such that `n ≤ b^k`.

These are interesting because, for `1 < b`, `nat.log b` and `nat.clog b` are respectively right and
left adjoints of `nat.pow b`. See `pow_le_iff_le_log` and `le_pow_iff_clog_le`.
-/

namespace nat

/-! ### Floor logarithm -/

/-- `log b n`, is the logarithm of natural number `n` in base `b`. It returns the largest `k : ℕ`
such that `b^k ≤ n`, so if `b^k = n`, it returns exactly `k`. -/
@[pp_nodot] def log (b : ℕ) : ℕ → ℕ
| n :=
  if h : b ≤ n ∧ 1 < b then
    have n / b < n,
      from div_lt_self ((zero_lt_one.trans h.2).trans_le h.1) h.2,
    log (n / b) + 1
  else 0

lemma log_eq_zero {b n : ℕ} (hnb : n < b ∨ b ≤ 1) : log b n = 0 :=
begin
  rw [or_iff_not_and_not, not_lt, not_le] at hnb,
  rw [log, ←ite_not, if_pos hnb],
end

lemma log_of_one_lt_of_le {b n : ℕ} (h : 1 < b) (hn : b ≤ n) : log b n = log b (n / b) + 1 :=
begin
  rw log,
  exact if_pos ⟨hn, h⟩,
end

lemma log_of_lt {b n : ℕ} (hnb : n < b) : log b n = 0 :=
by rw [log, if_neg (λ h : b ≤ n ∧ 1 < b, h.1.not_lt hnb)]

lemma log_of_left_le_one {b n : ℕ} (hb : b ≤ 1) : log b n = 0 :=
by rw [log, if_neg (λ h : b ≤ n ∧ 1 < b, h.2.not_le hb)]

lemma log_eq_zero_iff {b n : ℕ} : log b n = 0 ↔ n < b ∨ b ≤ 1 :=
begin
  split,
  { intro h_log,
    by_contra h,
    push_neg at h,
    have := log_of_one_lt_of_le h.2 h.1,
    rw h_log at this,
    exact succ_ne_zero _ this.symm, },
  { exact log_eq_zero, },
end

lemma log_eq_one_iff {b n : ℕ} : log b n = 1 ↔ n < b * b ∧ 1 < b ∧ b ≤ n :=
-- This is best possible: if b = 2, n = 5, then 1 < b and b ≤ n but n > b * b.
begin
  split,
  { intro h_log,
    have bound : 1 < b ∧ b ≤ n,
    { contrapose h_log,
      rw [not_and_distrib, not_lt, not_le, or_comm, ←log_eq_zero_iff] at h_log,
      rw h_log,
      exact nat.zero_ne_one, },
    cases bound with one_lt_b b_le_n,
    refine ⟨_, one_lt_b, b_le_n⟩,
    rw [log_of_one_lt_of_le one_lt_b b_le_n, succ_inj',
        log_eq_zero_iff, nat.div_lt_iff_lt_mul _ _ (lt_trans zero_lt_one one_lt_b)] at h_log,
    exact h_log.resolve_right (λ b_small, lt_irrefl _ (lt_of_lt_of_le one_lt_b b_small)), },
  { rintros ⟨h, one_lt_b, b_le_n⟩,
    rw [log_of_one_lt_of_le one_lt_b b_le_n, succ_inj',
        log_eq_zero_iff, nat.div_lt_iff_lt_mul _ _ (lt_trans zero_lt_one one_lt_b)],
    exact or.inl h, },
end

@[simp] lemma log_zero_left (n : ℕ) : log 0 n = 0 :=
log_of_left_le_one zero_le_one

@[simp] lemma log_zero_right (b : ℕ) : log b 0 = 0 :=
by { rw log, cases b; refl }

@[simp] lemma log_one_left (n : ℕ) : log 1 n = 0 :=
log_of_left_le_one le_rfl

@[simp] lemma log_one_right (b : ℕ) : log b 1 = 0 :=
if h : b ≤ 1 then
  log_of_left_le_one h
else
  log_of_lt (not_le.mp h)

/-- `pow b` and `log b` (almost) form a Galois connection. -/
lemma pow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : 0 < y) :
  b^x ≤ y ↔ x ≤ log b y :=
begin
  induction y using nat.strong_induction_on with y ih generalizing x,
  cases x,
  { exact iff_of_true hy (zero_le _) },
  rw log, split_ifs,
  { have b_pos : 0 < b := zero_le_one.trans_lt hb,
    rw [succ_eq_add_one, add_le_add_iff_right, ←ih (y / b) (div_lt_self hy hb)
      (nat.div_pos h.1 b_pos), le_div_iff_mul_le _ _ b_pos, pow_succ'] },
  { refine iff_of_false (λ hby, h ⟨le_trans _ hby, hb⟩) (not_succ_le_zero _),
    convert pow_mono hb.le (zero_lt_succ x),
    exact (pow_one b).symm }
end

lemma log_pow {b : ℕ} (hb : 1 < b) (x : ℕ) : log b (b ^ x) = x :=
eq_of_forall_le_iff $ λ z,
by { rw ←pow_le_iff_le_log hb (pow_pos (zero_lt_one.trans hb) _),
    exact (pow_right_strict_mono hb).le_iff_le }

lemma log_pos {b n : ℕ} (hb : 1 < b) (hn : b ≤ n) : 0 < log b n :=
by { rwa [←succ_le_iff, ←pow_le_iff_le_log hb (hb.le.trans hn), pow_one] }

lemma lt_pow_succ_log_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 0 < x) :
  x < b ^ (log b x).succ :=
begin
  rw [←not_le, pow_le_iff_le_log hb hx, not_le],
  exact lt_succ_self _,
end

lemma pow_log_le_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 0 < x) : b ^ log b x ≤ x :=
(pow_le_iff_le_log hb hx).2 le_rfl

lemma log_le_log_of_le {b n m : ℕ} (h : n ≤ m) : log b n ≤ log b m :=
begin
  cases le_or_lt b 1 with hb hb,
  { rw log_of_left_le_one hb, exact zero_le _ },
  { cases nat.eq_zero_or_pos n with hn hn,
    { rw [hn, log_zero_right], exact zero_le _ },
    { rw ←pow_le_iff_le_log hb (hn.trans_le h),
      exact (pow_log_le_self hb hn).trans h } }
end

lemma log_le_log_of_left_ge {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : log b n ≤ log c n :=
begin
  cases n, { simp },
  rw ← pow_le_iff_le_log hc (zero_lt_succ n),
  calc
    c ^ log b n.succ ≤ b ^ log b n.succ : pow_le_pow_of_le_left
                                            (le_of_lt $ zero_lt_one.trans hc) hb _
                 ... ≤ n.succ           : pow_log_le_self (lt_of_lt_of_le hc hb)
                                            (zero_lt_succ n)
end

lemma log_monotone {b : ℕ} : monotone (λ n : ℕ, log b n) :=
λ x y, log_le_log_of_le

lemma log_antitone_left {n : ℕ} : antitone_on (λ b, log b n) (set.Ioi 1) :=
λ _ hc _ _ hb, log_le_log_of_left_ge (set.mem_Iio.1 hc) hb

private lemma add_pred_div_lt {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : (n + b - 1)/b < n :=
begin
  rw [div_lt_iff_lt_mul _ _ (zero_lt_one.trans hb), ←succ_le_iff, ←pred_eq_sub_one,
    succ_pred_eq_of_pos (add_pos (zero_lt_one.trans hn) (zero_lt_one.trans hb))],
  exact add_le_mul hn hb,
end

/-! ### Ceil logarithm -/

/-- `clog b n`, is the upper logarithm of natural number `n` in base `b`. It returns the smallest
`k : ℕ` such that `n ≤ b^k`, so if `b^k = n`, it returns exactly `k`. -/
@[pp_nodot] def clog (b : ℕ) : ℕ → ℕ
| n :=
  if h : 1 < b ∧ 1 < n then
    have (n + b - 1)/b < n := add_pred_div_lt h.1 h.2,
    clog ((n + b - 1)/b) + 1
  else 0

lemma clog_of_left_le_one {b : ℕ} (hb : b ≤ 1) (n : ℕ) : clog b n = 0 :=
by rw [clog, if_neg (λ h : 1 < b ∧ 1 < n, h.1.not_le hb)]

lemma clog_of_right_le_one {n : ℕ} (hn : n ≤ 1) (b : ℕ) : clog b n = 0 :=
by rw [clog, if_neg (λ h : 1 < b ∧ 1 < n, h.2.not_le hn)]

@[simp] lemma clog_zero_left (n : ℕ) : clog 0 n = 0 :=
clog_of_left_le_one zero_le_one _

@[simp] lemma clog_zero_right (b : ℕ) : clog b 0 = 0 :=
clog_of_right_le_one zero_le_one _

@[simp] lemma clog_one_left (n : ℕ) : clog 1 n = 0 :=
clog_of_left_le_one le_rfl _

@[simp] lemma clog_one_right (b : ℕ) : clog b 1 = 0 :=
clog_of_right_le_one le_rfl _

lemma clog_of_two_le {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) :
  clog b n = clog b ((n + b - 1)/b) + 1 :=
by rw [clog, if_pos (⟨hb, hn⟩ : 1 < b ∧ 1 < n)]

lemma clog_pos {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : 0 < clog b n :=
by { rw clog_of_two_le hb hn, exact zero_lt_succ _ }

lemma clog_eq_one {b n : ℕ} (hn : 2 ≤ n) (h : n ≤ b) : clog b n = 1 :=
begin
  rw [clog_of_two_le (hn.trans h) hn, clog_of_right_le_one],
  have n_pos : 0 < n := zero_lt_two.trans_le hn,
  rw [←lt_succ_iff, nat.div_lt_iff_lt_mul _ _ (n_pos.trans_le h), ←succ_le_iff,
    ←pred_eq_sub_one, succ_pred_eq_of_pos (add_pos n_pos (n_pos.trans_le h)), succ_mul, one_mul],
  exact add_le_add_right h _,
end

/--`clog b` and `pow b` form a Galois connection. -/
lemma le_pow_iff_clog_le {b : ℕ} (hb : 1 < b) {x y : ℕ} :
  x ≤ b^y ↔ clog b x ≤ y :=
begin
  induction x using nat.strong_induction_on with x ih generalizing y,
  cases y,
  { rw [pow_zero],
    refine ⟨λ h, (clog_of_right_le_one h b).le, _⟩,
    simp_rw ←not_lt,
    contrapose!,
    exact clog_pos hb },
  have b_pos : 0 < b := zero_lt_two.trans_le hb,
  rw clog, split_ifs,
  { rw [succ_eq_add_one, add_le_add_iff_right, ←ih ((x + b - 1)/b) (add_pred_div_lt hb h.2),
      nat.div_le_iff_le_mul_add_pred b_pos,
      ← pow_succ, add_tsub_assoc_of_le (nat.succ_le_of_lt b_pos), add_le_add_iff_right] },
  { exact iff_of_true ((not_lt.1 (not_and.1 h hb)).trans $ succ_le_of_lt $ pow_pos b_pos _)
    (zero_le _) }
end

lemma clog_pow (b x : ℕ) (hb : 1 < b) : clog b (b ^ x) = x :=
eq_of_forall_ge_iff $ λ z,
by { rw ←le_pow_iff_clog_le hb, exact (pow_right_strict_mono hb).le_iff_le }

lemma pow_pred_clog_lt_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 1 < x) :
  b ^ (clog b x).pred < x :=
begin
  rw [←not_le, le_pow_iff_clog_le hb, not_le],
  exact pred_lt (clog_pos hb hx).ne',
end

lemma le_pow_clog {b : ℕ} (hb : 1 < b) (x : ℕ) : x ≤ b ^ clog b x :=
(le_pow_iff_clog_le hb).2 le_rfl

lemma clog_le_clog_of_le (b : ℕ) {n m : ℕ} (h : n ≤ m) : clog b n ≤ clog b m :=
begin
  cases le_or_lt b 1 with hb hb,
  { rw clog_of_left_le_one hb, exact zero_le _ },
  { rw ←le_pow_iff_clog_le hb,
    exact h.trans (le_pow_clog hb _) }
end

lemma clog_le_clog_of_left_ge {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : clog b n ≤ clog c n :=
begin
  cases n, { simp },
  rw ← le_pow_iff_clog_le (lt_of_lt_of_le hc hb),
  calc
    n.succ ≤ c ^ clog c n.succ : le_pow_clog hc _
       ... ≤ b ^ clog c n.succ : pow_le_pow_of_le_left (le_of_lt $ zero_lt_one.trans hc) hb _
end

lemma clog_monotone (b : ℕ) : monotone (clog b) :=
λ x y, clog_le_clog_of_le _

lemma clog_antitone_left {n : ℕ} : antitone_on (λ b : ℕ, clog b n) (set.Ioi 1) :=
λ _ hc _ _ hb, clog_le_clog_of_left_ge (set.mem_Iio.1 hc) hb

lemma log_le_clog (b n : ℕ) : log b n ≤ clog b n :=
begin
  obtain hb | hb := le_or_lt b 1,
  { rw log_of_left_le_one hb,
    exact zero_le _},
  cases n,
  { rw log_zero_right,
    exact zero_le _},
  exact (pow_right_strict_mono hb).le_iff_le.1 ((pow_log_le_self hb $ succ_pos _).trans $
    le_pow_clog hb _),
end

end nat


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

! This file was ported from Lean 3 source module algebra.geom_sum
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Order
import Mathlib.Algebra.BigOperators.Ring
import Mathlib.Algebra.BigOperators.Intervals
import Mathlib.Tactic.Abel
import Mathlib.Data.Nat.Parity

/-!
# Partial sums of geometric series

This file determines the values of the geometric series $\sum_{i=0}^{n-1} x^i$ and
$\sum_{i=0}^{n-1} x^i y^{n-1-i}$ and variants thereof. We also provide some bounds on the
"geometric" sum of `a/b^i` where `a b : ℕ`.

## Main statements

* `geom_sum_Ico` proves that $\sum_{i=m}^{n-1} x^i=\frac{x^n-x^m}{x-1}$ in a division ring.
* `geom_sum₂_Ico` proves that $\sum_{i=m}^{n-1} x^iy^{n - 1 - i}=\frac{x^n-y^{n-m}x^m}{x-y}$
  in a field.

Several variants are recorded, generalising in particular to the case of a noncommutative ring in
which `x` and `y` commute. Even versions not using division or subtraction, valid in each semiring,
are recorded.
-/

--porting note: corrected type in the description of `geom_sum₂_Ico` (in the doc string only).

universe u

variable {α : Type u}

open Finset MulOpposite

open BigOperators

section Semiring

variable [Semiring α]

theorem geom_sum_succ {x : α} {n : ℕ} :
    (∑ i in range (n + 1), x ^ i) = (x * ∑ i in range n, x ^ i) + 1 := by
  simp only [mul_sum, ← pow_succ, sum_range_succ', pow_zero]
#align geom_sum_succ geom_sum_succ

theorem geom_sum_succ' {x : α} {n : ℕ} :
    (∑ i in range (n + 1), x ^ i) = x ^ n + ∑ i in range n, x ^ i :=
  (sum_range_succ _ _).trans (add_comm _ _)
#align geom_sum_succ' geom_sum_succ'

theorem geom_sum_zero (x : α) : (∑ i in range 0, x ^ i) = 0 :=
  rfl
#align geom_sum_zero geom_sum_zero

theorem geom_sum_one (x : α) : (∑ i in range 1, x ^ i) = 1 := by simp [geom_sum_succ']
#align geom_sum_one geom_sum_one

@[simp]
theorem geom_sum_two {x : α} : (∑ i in range 2, x ^ i) = x + 1 := by simp [geom_sum_succ']
#align geom_sum_two geom_sum_two

@[simp]
theorem zero_geom_sum : ∀ {n}, (∑ i in range n, (0 : α) ^ i) = if n = 0 then 0 else 1
  | 0 => by simp
  | 1 => by simp
  | n + 2 => by
    rw [geom_sum_succ']
    simp [zero_geom_sum]
#align zero_geom_sum zero_geom_sum

theorem one_geom_sum (n : ℕ) : (∑ i in range n, (1 : α) ^ i) = n := by simp
#align one_geom_sum one_geom_sum

-- porting note: simp can prove this
-- @[simp]
theorem op_geom_sum (x : α) (n : ℕ) : op (∑ i in range n, x ^ i) = ∑ i in range n, op x ^ i := by
  simp
#align op_geom_sum op_geom_sum

--porting note: linter suggested to change left hand side
@[simp]
theorem op_geom_sum₂ (x y : α) (n : ℕ) :
    ∑ i in range n, op y ^ (n - 1 - i) * op x ^ i = ∑ i in range n, op y ^ i * op x ^ (n - 1 - i):=
  by
  simp only [op_sum, op_mul, op_pow]
  rw [← sum_range_reflect]
  refine' sum_congr rfl fun j j_in => _
  rw [mem_range, Nat.lt_iff_add_one_le] at j_in
  congr
  apply tsub_tsub_cancel_of_le
  exact le_tsub_of_add_le_right j_in
#align op_geom_sum₂ op_geom_sum₂

theorem geom_sum₂_with_one (x : α) (n : ℕ) :
    (∑ i in range n, x ^ i * 1 ^ (n - 1 - i)) = ∑ i in range n, x ^ i :=
  sum_congr rfl fun i _ => by rw [one_pow, mul_one]
#align geom_sum₂_with_one geom_sum₂_with_one

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
protected theorem Commute.geom_sum₂_mul_add {x y : α} (h : Commute x y) (n : ℕ) :
    (∑ i in range n, (x + y) ^ i * y ^ (n - 1 - i)) * x + y ^ n = (x + y) ^ n := by
  let f :  ℕ → ℕ → α := fun m i : ℕ => (x + y) ^ i * y ^ (m - 1 - i)
  -- porting note: adding `hf` here, because below in two places `dsimp [f]` didn't work
  have hf : ∀ m i : ℕ, f m i = (x + y) ^ i * y ^ (m - 1 - i) := by
    simp only [ge_iff_le, tsub_le_iff_right, forall_const]
  change (∑ i in range n, (f n) i) * x + y ^ n = (x + y) ^ n
  induction' n with n ih
  · rw [range_zero, sum_empty, zero_mul, zero_add, pow_zero, pow_zero]
  · have f_last : f (n + 1) n = (x + y) ^ n := by
      rw [hf, ← tsub_add_eq_tsub_tsub, Nat.add_comm, tsub_self, pow_zero, mul_one]
    have f_succ : ∀ i, i ∈ range n → f (n + 1) i = y * f n i := fun i hi => by
      rw [hf]
      have : Commute y ((x + y) ^ i) := (h.symm.add_right (Commute.refl y)).pow_right i
      rw [← mul_assoc, this.eq, mul_assoc, ← pow_succ y (n - 1 - i)]
      congr 2
      rw [add_tsub_cancel_right, ← tsub_add_eq_tsub_tsub, add_comm 1 i]
      have : i + 1 + (n - (i + 1)) = n := add_tsub_cancel_of_le (mem_range.mp hi)
      rw [add_comm (i + 1)] at this
      rw [← this, add_tsub_cancel_right, add_comm i 1, ← add_assoc, add_tsub_cancel_right]
    rw [pow_succ (x + y), add_mul, sum_range_succ_comm, add_mul, f_last, add_assoc]
    rw [(((Commute.refl x).add_right h).pow_right n).eq]
    congr 1
    rw [sum_congr rfl f_succ, ← mul_sum, pow_succ y, mul_assoc, ← mul_add y, ih]
#align commute.geom_sum₂_mul_add Commute.geom_sum₂_mul_add

end Semiring

@[simp]
theorem neg_one_geom_sum [Ring α] {n : ℕ} :
    (∑ i in range n, (-1 : α) ^ i) = if Even n then 0 else 1 := by
  induction' n with k hk
  · simp
  · simp only [geom_sum_succ', Nat.even_add_one, hk]
    split_ifs with h
    · rw [h.neg_one_pow, add_zero]
    · rw [(Nat.odd_iff_not_even.2 h).neg_one_pow, neg_add_self]
#align neg_one_geom_sum neg_one_geom_sum

theorem geom_sum₂_self {α : Type _} [CommRing α] (x : α) (n : ℕ) :
    (∑ i in range n, x ^ i * x ^ (n - 1 - i)) = n * x ^ (n - 1) :=
  calc
    (∑ i in Finset.range n, x ^ i * x ^ (n - 1 - i)) =
        ∑ i in Finset.range n, x ^ (i + (n - 1 - i)) :=
      by simp_rw [← pow_add]
    _ = ∑ i in Finset.range n, x ^ (n - 1) :=
      Finset.sum_congr rfl fun i hi =>
        congr_arg _ <| add_tsub_cancel_of_le <| Nat.le_pred_of_lt <| Finset.mem_range.1 hi
    _ = (Finset.range n).card • x ^ (n - 1) := Finset.sum_const _
    _ = n * x ^ (n - 1) := by rw [Finset.card_range, nsmul_eq_mul]

#align geom_sum₂_self geom_sum₂_self

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
theorem geom_sum₂_mul_add [CommSemiring α] (x y : α) (n : ℕ) :
    (∑ i in range n, (x + y) ^ i * y ^ (n - 1 - i)) * x + y ^ n = (x + y) ^ n :=
  (Commute.all x y).geom_sum₂_mul_add n
#align geom_sum₂_mul_add geom_sum₂_mul_add

theorem geom_sum_mul_add [Semiring α] (x : α) (n : ℕ) :
    (∑ i in range n, (x + 1) ^ i) * x + 1 = (x + 1) ^ n := by
  have := (Commute.one_right x).geom_sum₂_mul_add n
  rw [one_pow, geom_sum₂_with_one] at this
  exact this
#align geom_sum_mul_add geom_sum_mul_add

protected theorem Commute.geom_sum₂_mul [Ring α] {x y : α} (h : Commute x y) (n : ℕ) :
    (∑ i in range n, x ^ i * y ^ (n - 1 - i)) * (x - y) = x ^ n - y ^ n := by
  have := (h.sub_left (Commute.refl y)).geom_sum₂_mul_add n
  rw [sub_add_cancel] at this
  rw [← this, add_sub_cancel]
#align commute.geom_sum₂_mul Commute.geom_sum₂_mul

theorem Commute.mul_neg_geom_sum₂ [Ring α] {x y : α} (h : Commute x y) (n : ℕ) :
    ((y - x) * ∑ i in range n, x ^ i * y ^ (n - 1 - i)) = y ^ n - x ^ n := by
  apply op_injective
  simp only [op_mul, op_sub, op_geom_sum₂, op_pow]
  simp [(Commute.op h.symm).geom_sum₂_mul n]
#align commute.mul_neg_geom_sum₂ Commute.mul_neg_geom_sum₂

theorem Commute.mul_geom_sum₂ [Ring α] {x y : α} (h : Commute x y) (n : ℕ) :
    ((x - y) * ∑ i in range n, x ^ i * y ^ (n - 1 - i)) = x ^ n - y ^ n := by
  rw [← neg_sub (y ^ n), ← h.mul_neg_geom_sum₂, ← neg_mul, neg_sub]
#align commute.mul_geom_sum₂ Commute.mul_geom_sum₂

theorem geom_sum₂_mul [CommRing α] (x y : α) (n : ℕ) :
    (∑ i in range n, x ^ i * y ^ (n - 1 - i)) * (x - y) = x ^ n - y ^ n :=
  (Commute.all x y).geom_sum₂_mul n
#align geom_sum₂_mul geom_sum₂_mul

theorem sub_dvd_pow_sub_pow [CommRing α] (x y : α) (n : ℕ) : x - y ∣ x ^ n - y ^ n :=
  Dvd.intro_left _ (geom_sum₂_mul x y n)
#align sub_dvd_pow_sub_pow sub_dvd_pow_sub_pow

theorem nat_sub_dvd_pow_sub_pow (x y n : ℕ) : x - y ∣ x ^ n - y ^ n := by
  cases' le_or_lt y x with h h
  · have : y ^ n ≤ x ^ n := Nat.pow_le_pow_of_le_left h _
    exact_mod_cast sub_dvd_pow_sub_pow (x : ℤ) (↑y) n
  · have : x ^ n ≤ y ^ n := Nat.pow_le_pow_of_le_left h.le _
    exact (Nat.sub_eq_zero_of_le this).symm ▸ dvd_zero (x - y)
#align nat_sub_dvd_pow_sub_pow nat_sub_dvd_pow_sub_pow

theorem Odd.add_dvd_pow_add_pow [CommRing α] (x y : α) {n : ℕ} (h : Odd n) :
    x + y ∣ x ^ n + y ^ n := by
  have h₁ := geom_sum₂_mul x (-y) n
  rw [Odd.neg_pow h y, sub_neg_eq_add, sub_neg_eq_add] at h₁
  exact Dvd.intro_left _ h₁
#align odd.add_dvd_pow_add_pow Odd.add_dvd_pow_add_pow

theorem Odd.nat_add_dvd_pow_add_pow (x y : ℕ) {n : ℕ} (h : Odd n) : x + y ∣ x ^ n + y ^ n := by
  exact_mod_cast Odd.add_dvd_pow_add_pow (x : ℤ) (↑y) h
#align odd.nat_add_dvd_pow_add_pow Odd.nat_add_dvd_pow_add_pow

theorem geom_sum_mul [Ring α] (x : α) (n : ℕ) : (∑ i in range n, x ^ i) * (x - 1) = x ^ n - 1 := by
  have := (Commute.one_right x).geom_sum₂_mul n
  rw [one_pow, geom_sum₂_with_one] at this
  exact this
#align geom_sum_mul geom_sum_mul

theorem mul_geom_sum [Ring α] (x : α) (n : ℕ) : ((x - 1) * ∑ i in range n, x ^ i) = x ^ n - 1 :=
  op_injective <| by simpa using geom_sum_mul (op x) n
#align mul_geom_sum mul_geom_sum

theorem geom_sum_mul_neg [Ring α] (x : α) (n : ℕ) : (∑ i in range n, x ^ i) * (1 - x) = 1 - x ^ n :=
  by
  have := congr_arg Neg.neg (geom_sum_mul x n)
  rw [neg_sub, ← mul_neg, neg_sub] at this
  exact this
#align geom_sum_mul_neg geom_sum_mul_neg

theorem mul_neg_geom_sum [Ring α] (x : α) (n : ℕ) : ((1 - x) * ∑ i in range n, x ^ i) = 1 - x ^ n :=
  op_injective <| by simpa using geom_sum_mul_neg (op x) n
#align mul_neg_geom_sum mul_neg_geom_sum

protected theorem Commute.geom_sum₂_comm {α : Type u} [Semiring α] {x y : α} (n : ℕ)
    (h : Commute x y) :
    (∑ i in range n, x ^ i * y ^ (n - 1 - i)) = ∑ i in range n, y ^ i * x ^ (n - 1 - i) := by
  cases n; · simp
  simp only [Nat.succ_eq_add_one, Nat.add_sub_cancel]
  rw [← Finset.sum_flip]
  refine' Finset.sum_congr rfl fun i hi => _
  simpa [Nat.sub_sub_self (Nat.succ_le_succ_iff.mp (Finset.mem_range.mp hi))] using h.pow_pow _ _
#align commute.geom_sum₂_comm Commute.geom_sum₂_comm

theorem geom_sum₂_comm {α : Type u} [CommSemiring α] (x y : α) (n : ℕ) :
    (∑ i in range n, x ^ i * y ^ (n - 1 - i)) = ∑ i in range n, y ^ i * x ^ (n - 1 - i) :=
  (Commute.all x y).geom_sum₂_comm n
#align geom_sum₂_comm geom_sum₂_comm

protected theorem Commute.geom_sum₂ [DivisionRing α] {x y : α} (h' : Commute x y) (h : x ≠ y)
    (n : ℕ) : (∑ i in range n, x ^ i * y ^ (n - 1 - i)) = (x ^ n - y ^ n) / (x - y) := by
  have : x - y ≠ 0 := by simp_all [sub_eq_iff_eq_add]
  rw [← h'.geom_sum₂_mul, mul_div_cancel _ this]
#align commute.geom_sum₂ Commute.geom_sum₂

theorem geom₂_sum [Field α] {x y : α} (h : x ≠ y) (n : ℕ) :
    (∑ i in range n, x ^ i * y ^ (n - 1 - i)) = (x ^ n - y ^ n) / (x - y) :=
  (Commute.all x y).geom_sum₂ h n
#align geom₂_sum geom₂_sum

theorem geom_sum_eq [DivisionRing α] {x : α} (h : x ≠ 1) (n : ℕ) :
    (∑ i in range n, x ^ i) = (x ^ n - 1) / (x - 1) := by
  have : x - 1 ≠ 0 := by simp_all [sub_eq_iff_eq_add]
  rw [← geom_sum_mul, mul_div_cancel _ this]
#align geom_sum_eq geom_sum_eq

protected theorem Commute.mul_geom_sum₂_Ico [Ring α] {x y : α} (h : Commute x y) {m n : ℕ}
    (hmn : m ≤ n) :
    ((x - y) * ∑ i in Finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) := by
  rw [sum_Ico_eq_sub _ hmn]
  have :
    (∑ k in range m, x ^ k * y ^ (n - 1 - k)) =
      ∑ k in range m, x ^ k * (y ^ (n - m) * y ^ (m - 1 - k)) :=
    by
    refine' sum_congr rfl fun j j_in => _
    rw [← pow_add]
    congr
    rw [mem_range, Nat.lt_iff_add_one_le, add_comm] at j_in
    have h' : n - m + (m - (1 + j)) = n - (1 + j) := tsub_add_tsub_cancel hmn j_in
    rw [← tsub_add_eq_tsub_tsub m, h', ← tsub_add_eq_tsub_tsub]
  rw [this]
  simp_rw [pow_mul_comm y (n - m) _]
  simp_rw [← mul_assoc]
  rw [← sum_mul, mul_sub, h.mul_geom_sum₂, ← mul_assoc, h.mul_geom_sum₂, sub_mul, ← pow_add,
    add_tsub_cancel_of_le hmn, sub_sub_sub_cancel_right (x ^ n) (x ^ m * y ^ (n - m)) (y ^ n)]
#align commute.mul_geom_sum₂_Ico Commute.mul_geom_sum₂_Ico

protected theorem Commute.geom_sum₂_succ_eq {α : Type u} [Ring α] {x y : α} (h : Commute x y)
    {n : ℕ} :
    (∑ i in range (n + 1), x ^ i * y ^ (n - i)) =
      x ^ n + y * ∑ i in range n, x ^ i * y ^ (n - 1 - i) := by
  simp_rw [mul_sum, sum_range_succ_comm, tsub_self, pow_zero, mul_one, add_right_inj, ← mul_assoc,
    (h.symm.pow_right _).eq, mul_assoc, ← pow_succ]
  refine' sum_congr rfl fun i hi => _
  suffices n - 1 - i + 1 = n - i by rw [this]
  cases' n with n
  · exact absurd (List.mem_range.mp hi) i.not_lt_zero
  · rw [tsub_add_eq_add_tsub (Nat.le_pred_of_lt (List.mem_range.mp hi)),
      tsub_add_cancel_of_le (Nat.succ_le_iff.mpr n.succ_pos)]
#align commute.geom_sum₂_succ_eq Commute.geom_sum₂_succ_eq

theorem mul_geom_sum₂_Ico [CommRing α] (x y : α) {m n : ℕ} (hmn : m ≤ n) :
    ((x - y) * ∑ i in Finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) :=
  (Commute.all x y).mul_geom_sum₂_Ico hmn
#align mul_geom_sum₂_Ico mul_geom_sum₂_Ico

protected theorem Commute.geom_sum₂_Ico_mul [Ring α] {x y : α} (h : Commute x y) {m n : ℕ}
    (hmn : m ≤ n) :
    (∑ i in Finset.Ico m n, x ^ i * y ^ (n - 1 - i)) * (x - y) = x ^ n - y ^ (n - m) * x ^ m := by
  apply op_injective
  simp only [op_sub, op_mul, op_pow, op_sum]
  have : (∑ k in Ico m n, MulOpposite.op y ^ (n - 1 - k) * MulOpposite.op x ^ k) =
      ∑ k in Ico m n, MulOpposite.op x ^ k * MulOpposite.op y ^ (n - 1 - k) := by
    refine' sum_congr rfl fun k _ => _
    simp only [ge_iff_le, tsub_le_iff_right]
    have hp := Commute.pow_pow (Commute.op h.symm) (n - 1 - k) k
    simpa [Commute, SemiconjBy] using hp
  simp only [this]
  -- porting note: gives deterministic timeout without this intermediate `have`
  convert (Commute.op h).mul_geom_sum₂_Ico hmn
#align commute.geom_sum₂_Ico_mul Commute.geom_sum₂_Ico_mul

theorem geom_sum_Ico_mul [Ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) :
    (∑ i in Finset.Ico m n, x ^ i) * (x - 1) = x ^ n - x ^ m := by
  rw [sum_Ico_eq_sub _ hmn, sub_mul, geom_sum_mul, geom_sum_mul, sub_sub_sub_cancel_right]
#align geom_sum_Ico_mul geom_sum_Ico_mul

theorem geom_sum_Ico_mul_neg [Ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) :
    (∑ i in Finset.Ico m n, x ^ i) * (1 - x) = x ^ m - x ^ n := by
  rw [sum_Ico_eq_sub _ hmn, sub_mul, geom_sum_mul_neg, geom_sum_mul_neg, sub_sub_sub_cancel_left]
#align geom_sum_Ico_mul_neg geom_sum_Ico_mul_neg

protected theorem Commute.geom_sum₂_Ico [DivisionRing α] {x y : α} (h : Commute x y) (hxy : x ≠ y)
    {m n : ℕ} (hmn : m ≤ n) :
    (∑ i in Finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = (x ^ n - y ^ (n - m) * x ^ m) / (x - y) := by
  have : x - y ≠ 0 := by simp_all [sub_eq_iff_eq_add]
  rw [← h.geom_sum₂_Ico_mul hmn, mul_div_cancel _ this]
#align commute.geom_sum₂_Ico Commute.geom_sum₂_Ico

theorem geom_sum₂_Ico [Field α] {x y : α} (hxy : x ≠ y) {m n : ℕ} (hmn : m ≤ n) :
    (∑ i in Finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = (x ^ n - y ^ (n - m) * x ^ m) / (x - y) :=
  (Commute.all x y).geom_sum₂_Ico hxy hmn
#align geom_sum₂_Ico geom_sum₂_Ico

theorem geom_sum_Ico [DivisionRing α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) :
    (∑ i in Finset.Ico m n, x ^ i) = (x ^ n - x ^ m) / (x - 1) := by
  simp only [sum_Ico_eq_sub _ hmn, geom_sum_eq hx, div_sub_div_same, sub_sub_sub_cancel_right]
#align geom_sum_Ico geom_sum_Ico

theorem geom_sum_Ico' [DivisionRing α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) :
    (∑ i in Finset.Ico m n, x ^ i) = (x ^ m - x ^ n) / (1 - x) := by
  simp only [geom_sum_Ico hx hmn]
  convert neg_div_neg_eq (x ^ m - x ^ n) (1 - x) using 2 <;> abel
#align geom_sum_Ico' geom_sum_Ico'

theorem geom_sum_Ico_le_of_lt_one [LinearOrderedField α] {x : α} (hx : 0 ≤ x) (h'x : x < 1)
    {m n : ℕ} : (∑ i in Ico m n, x ^ i) ≤ x ^ m / (1 - x) := by
  rcases le_or_lt m n with (hmn | hmn)
  · rw [geom_sum_Ico' h'x.ne hmn]
    apply div_le_div (pow_nonneg hx _) _ (sub_pos.2 h'x) le_rfl
    simpa using pow_nonneg hx _
  · rw [Ico_eq_empty, sum_empty]
    · apply div_nonneg (pow_nonneg hx _)
      simpa using h'x.le
    · simpa using hmn.le
#align geom_sum_Ico_le_of_lt_one geom_sum_Ico_le_of_lt_one

theorem geom_sum_inv [DivisionRing α] {x : α} (hx1 : x ≠ 1) (hx0 : x ≠ 0) (n : ℕ) :
    (∑ i in range n, x⁻¹ ^ i) = (x - 1)⁻¹ * (x - x⁻¹ ^ n * x) := by
  have h₁ : x⁻¹ ≠ 1 := by rwa [inv_eq_one_div, Ne.def, div_eq_iff_mul_eq hx0, one_mul]
  have h₂ : x⁻¹ - 1 ≠ 0 := mt sub_eq_zero.1 h₁
  have h₃ : x - 1 ≠ 0 := mt sub_eq_zero.1 hx1
  have h₄ : x * (x ^ n)⁻¹ = (x ^ n)⁻¹ * x :=
    Nat.recOn n (by simp) fun n h => by
      rw [pow_succ, mul_inv_rev, ← mul_assoc, h, mul_assoc, mul_inv_cancel hx0, mul_assoc,
        inv_mul_cancel hx0]
  rw [geom_sum_eq h₁, div_eq_iff_mul_eq h₂, ← mul_right_inj' h₃, ← mul_assoc, ← mul_assoc,
    mul_inv_cancel h₃]
  simp [mul_add, add_mul, mul_inv_cancel hx0, mul_assoc, h₄, sub_eq_add_neg, add_comm,
    add_left_comm]
  rw [add_comm _ (-x), add_assoc, add_assoc _ _ 1]
#align geom_sum_inv geom_sum_inv

variable {β : Type _}

theorem RingHom.map_geom_sum [Semiring α] [Semiring β] (x : α) (n : ℕ) (f : α →+* β) :
    f (∑ i in range n, x ^ i) = ∑ i in range n, f x ^ i := by simp [f.map_sum]
#align ring_hom.map_geom_sum RingHom.map_geom_sum

theorem RingHom.map_geom_sum₂ [Semiring α] [Semiring β] (x y : α) (n : ℕ) (f : α →+* β) :
    f (∑ i in range n, x ^ i * y ^ (n - 1 - i)) = ∑ i in range n, f x ^ i * f y ^ (n - 1 - i) := by
  simp [f.map_sum]
#align ring_hom.map_geom_sum₂ RingHom.map_geom_sum₂

/-! ### Geometric sum with `ℕ`-division -/

theorem Nat.pred_mul_geom_sum_le (a b n : ℕ) :
    ((b - 1) * ∑ i in range n.succ, a / b ^ i) ≤ a * b - a / b ^ n :=
  calc
    ((b - 1) * ∑ i in range n.succ, a / b ^ i) =
        (∑ i in range n, a / b ^ (i + 1) * b) + a * b - ((∑ i in range n, a / b ^ i) + a / b ^ n) :=
      by rw [tsub_mul, mul_comm, sum_mul, one_mul, sum_range_succ', sum_range_succ, pow_zero,
        Nat.div_one]
    _ ≤ (∑ i in range n, a / b ^ i) + a * b - ((∑ i in range n, a / b ^ i) + a / b ^ n) :=
    by
      refine' tsub_le_tsub_right (add_le_add_right (sum_le_sum fun i _ => _) _) _
      rw [pow_succ', mul_comm b]
      rw [← Nat.div_div_eq_div_mul]
      exact Nat.div_mul_le_self _ _
    _ = a * b - a / b ^ n := add_tsub_add_eq_tsub_left _ _ _

#align nat.pred_mul_geom_sum_le Nat.pred_mul_geom_sum_le

theorem Nat.geom_sum_le {b : ℕ} (hb : 2 ≤ b) (a n : ℕ) :
    (∑ i in range n, a / b ^ i) ≤ a * b / (b - 1) := by
  refine' (Nat.le_div_iff_mul_le <| tsub_pos_of_lt hb).2 _
  cases' n with n
  · rw [sum_range_zero, zero_mul]
    exact Nat.zero_le _
  rw [mul_comm]
  exact (Nat.pred_mul_geom_sum_le a b n).trans tsub_le_self
#align nat.geom_sum_le Nat.geom_sum_le

theorem Nat.geom_sum_Ico_le {b : ℕ} (hb : 2 ≤ b) (a n : ℕ) :
    (∑ i in Ico 1 n, a / b ^ i) ≤ a / (b - 1) := by
  cases' n with n
  · rw [zero_eq, Ico_eq_empty_of_le (zero_le_one' ℕ), sum_empty]
    exact Nat.zero_le _
  rw [← add_le_add_iff_left a]
  calc
    (a + ∑ i : ℕ in Ico 1 n.succ, a / b ^ i) = a / b ^ 0 + ∑ i : ℕ in Ico 1 n.succ, a / b ^ i :=
    by
      rw [pow_zero, Nat.div_one]
    _ = ∑ i in range n.succ, a / b ^ i :=
    by
      rw [range_eq_Ico, ← Nat.Ico_insert_succ_left (Nat.succ_pos _), sum_insert]
      exact fun h => zero_lt_one.not_le (mem_Ico.1 h).1
    _ ≤ a * b / (b - 1) := Nat.geom_sum_le hb a _
    _ = (a * 1 + a * (b - 1)) / (b - 1) :=
    by
      rw [← mul_add, add_tsub_cancel_of_le (one_le_two.trans hb)]
    _ = a + a / (b - 1) := by rw [mul_one, Nat.add_mul_div_right _ _ (tsub_pos_of_lt hb), add_comm]

#align nat.geom_sum_Ico_le Nat.geom_sum_Ico_le

section Order

variable {n : ℕ} {x : α}

theorem geom_sum_pos [StrictOrderedSemiring α] (hx : 0 ≤ x) (hn : n ≠ 0) :
    0 < ∑ i in range n, x ^ i :=
  sum_pos' (fun k _ => pow_nonneg hx _) ⟨0, mem_range.2 hn.bot_lt, by simp⟩
#align geom_sum_pos geom_sum_pos

theorem geom_sum_pos_and_lt_one [StrictOrderedRing α] (hx : x < 0) (hx' : 0 < x + 1) (hn : 1 < n) :
    (0 < ∑ i in range n, x ^ i) ∧ (∑ i in range n, x ^ i) < 1 := by
  refine' Nat.le_induction _ _ n (show 2 ≤ n from hn)
  · rw [geom_sum_two]
    exact ⟨hx', (add_lt_iff_neg_right _).2 hx⟩
  clear hn
  intro n _ ihn
  rw [geom_sum_succ, add_lt_iff_neg_right, ← neg_lt_iff_pos_add', neg_mul_eq_neg_mul]
  exact
    ⟨mul_lt_one_of_nonneg_of_lt_one_left (neg_nonneg.2 hx.le) (neg_lt_iff_pos_add'.2 hx') ihn.2.le,
      mul_neg_of_neg_of_pos hx ihn.1⟩
#align geom_sum_pos_and_lt_one geom_sum_pos_and_lt_one

theorem geom_sum_alternating_of_le_neg_one [StrictOrderedRing α] (hx : x + 1 ≤ 0) (n : ℕ) :
    if Even n then (∑ i in range n, x ^ i) ≤ 0 else 1 ≤ ∑ i in range n, x ^ i := by
  have hx0 : x ≤ 0 := (le_add_of_nonneg_right zero_le_one).trans hx
  induction' n with n ih
  · simp only [Nat.zero_eq, range_zero, sum_empty, le_refl, ite_true]
  simp only [Nat.even_add_one, geom_sum_succ]
  split_ifs at ih with h
  · rw [if_neg (not_not_intro h), le_add_iff_nonneg_left]
    exact mul_nonneg_of_nonpos_of_nonpos hx0 ih
  · rw [if_pos h]
    refine' (add_le_add_right _ _).trans hx
    simpa only [mul_one] using mul_le_mul_of_nonpos_left ih hx0
#align geom_sum_alternating_of_le_neg_one geom_sum_alternating_of_le_neg_one

theorem geom_sum_alternating_of_lt_neg_one [StrictOrderedRing α] (hx : x + 1 < 0) (hn : 1 < n) :
    if Even n then (∑ i in range n, x ^ i) < 0 else 1 < ∑ i in range n, x ^ i := by
  have hx0 : x < 0 := ((le_add_iff_nonneg_right _).2 zero_le_one).trans_lt hx
  refine' Nat.le_induction _ _ n (show 2 ≤ n from hn)
  · simp only [geom_sum_two, lt_add_iff_pos_left, ite_true, gt_iff_lt, hx]
  clear hn
  intro n _ ihn
  simp only [Nat.even_add_one, geom_sum_succ]
  by_cases hn' : Even n
  · rw [if_pos hn'] at ihn
    rw [if_neg, lt_add_iff_pos_left]
    exact mul_pos_of_neg_of_neg hx0 ihn
    exact not_not_intro hn'
  · rw [if_neg hn'] at ihn
    rw [if_pos]
    swap
    · exact hn'
    have := add_lt_add_right (mul_lt_mul_of_neg_left ihn hx0) 1
    rw [mul_one] at this
    exact this.trans hx
#align geom_sum_alternating_of_lt_neg_one geom_sum_alternating_of_lt_neg_one

theorem geom_sum_pos' [LinearOrderedRing α] (hx : 0 < x + 1) (hn : n ≠ 0) :
    0 < ∑ i in range n, x ^ i := by
  obtain _ | _ | n := n
  · cases hn rfl
  · simp only [Nat.zero_eq, ← Nat.one_eq_succ_zero, range_one, sum_singleton, pow_zero, zero_lt_one]
  obtain hx' | hx' := lt_or_le x 0
  · exact (geom_sum_pos_and_lt_one hx' hx n.one_lt_succ_succ).1
  · exact geom_sum_pos hx' (by simp only [Nat.succ_ne_zero, Ne.def, not_false_iff])
#align geom_sum_pos' geom_sum_pos'

theorem Odd.geom_sum_pos [LinearOrderedRing α] (h : Odd n) : 0 < ∑ i in range n, x ^ i := by
  rcases n with (_ | _ | k)
  · exact ((show ¬Odd 0 by decide) h).elim
  · simp only [Nat.zero_eq, ← Nat.one_eq_succ_zero, geom_sum_one, zero_lt_one]
  rw [Nat.odd_iff_not_even] at h
  rcases lt_trichotomy (x + 1) 0 with (hx | hx | hx)
  · have := geom_sum_alternating_of_lt_neg_one hx k.one_lt_succ_succ
    simp only [h, if_false] at this
    exact zero_lt_one.trans this
  · simp only [eq_neg_of_add_eq_zero_left hx, h, neg_one_geom_sum, if_false, zero_lt_one]
  · exact geom_sum_pos' hx k.succ.succ_ne_zero
#align odd.geom_sum_pos Odd.geom_sum_pos

theorem geom_sum_pos_iff [LinearOrderedRing α] (hn : n ≠ 0) :
    (0 < ∑ i in range n, x ^ i) ↔ Odd n ∨ 0 < x + 1 := by
  refine' ⟨fun h => _, _⟩
  · rw [or_iff_not_imp_left, ← not_le, ← Nat.even_iff_not_odd]
    refine' fun hn hx => h.not_le _
    simpa [if_pos hn] using geom_sum_alternating_of_le_neg_one hx n
  · rintro (hn | hx')
    · exact hn.geom_sum_pos
    · exact geom_sum_pos' hx' hn
#align geom_sum_pos_iff geom_sum_pos_iff

theorem geom_sum_ne_zero [LinearOrderedRing α] (hx : x ≠ -1) (hn : n ≠ 0) :
    (∑ i in range n, x ^ i) ≠ 0 := by
  obtain _ | _ | n := n
  · cases hn rfl
  · simp only [Nat.zero_eq, ← Nat.one_eq_succ_zero, range_one, sum_singleton, pow_zero, ne_eq,
      one_ne_zero, not_false_iff]
  rw [Ne.def, eq_neg_iff_add_eq_zero, ← Ne.def] at hx
  obtain h | h := hx.lt_or_lt
  · have := geom_sum_alternating_of_lt_neg_one h n.one_lt_succ_succ
    split_ifs  at this
    · exact this.ne
    · exact (zero_lt_one.trans this).ne'
  · exact (geom_sum_pos' h n.succ.succ_ne_zero).ne'
#align geom_sum_ne_zero geom_sum_ne_zero

theorem geom_sum_eq_zero_iff_neg_one [LinearOrderedRing α] (hn : n ≠ 0) :
    (∑ i in range n, x ^ i) = 0 ↔ x = -1 ∧ Even n := by
  refine' ⟨fun h => _, @fun ⟨h, hn⟩ => by simp only [h, hn, neg_one_geom_sum, if_true]⟩
  contrapose! h
  have hx := eq_or_ne x (-1)
  cases' hx with hx hx
  · rw [hx, neg_one_geom_sum]
    simp only [h hx, ne_eq, ite_eq_left_iff, one_ne_zero, not_forall, exists_prop, and_true]
  · exact geom_sum_ne_zero hx hn
#align geom_sum_eq_zero_iff_neg_one geom_sum_eq_zero_iff_neg_one

theorem geom_sum_neg_iff [LinearOrderedRing α] (hn : n ≠ 0) :
    (∑ i in range n, x ^ i) < 0 ↔ Even n ∧ x + 1 < 0 := by
  rw [← not_iff_not, not_lt, le_iff_lt_or_eq, eq_comm,
    or_congr (geom_sum_pos_iff hn) (geom_sum_eq_zero_iff_neg_one hn), Nat.odd_iff_not_even, ←
    add_eq_zero_iff_eq_neg, not_and, not_lt, le_iff_lt_or_eq, eq_comm, ← imp_iff_not_or, or_comm,
    and_comm, Decidable.and_or_imp, or_comm]
#align geom_sum_neg_iff geom_sum_neg_iff

end Order


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module algebra.char_zero.lemmas
! leanprover-community/mathlib commit acee671f47b8e7972a1eb6f4eed74b4b3abce829
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Cast.Field
import Mathlib.Algebra.GroupPower.Lemmas

/-!
# Characteristic zero (additional theorems)

A ring `R` is called of characteristic zero if every natural number `n` is non-zero when considered
as an element of `R`. Since this definition doesn't mention the multiplicative structure of `R`
except for the existence of `1` in this file characteristic zero is defined for additive monoids
with `1`.

## Main statements

* Characteristic zero implies that the additive monoid is infinite.
-/

namespace Nat

variable {R : Type _} [AddMonoidWithOne R] [CharZero R]

/-- `Nat.cast` as an embedding into monoids of characteristic `0`. -/
@[simps]
def castEmbedding : ℕ ↪ R :=
  ⟨Nat.cast, cast_injective⟩
#align nat.cast_embedding Nat.castEmbedding
#align nat.cast_embedding_apply Nat.castEmbedding_apply

@[simp]
theorem cast_pow_eq_one {R : Type _} [Semiring R] [CharZero R] (q : ℕ) (n : ℕ) (hn : n ≠ 0) :
    (q : R) ^ n = 1 ↔ q = 1 := by
  rw [← cast_pow, cast_eq_one]
  exact pow_eq_one_iff hn
#align nat.cast_pow_eq_one Nat.cast_pow_eq_one

@[simp, norm_cast]
theorem cast_div_charZero {k : Type _} [DivisionSemiring k] [CharZero k] {m n : ℕ} (n_dvd : n ∣ m) :
    ((m / n : ℕ) : k) = m / n := by
  rcases eq_or_ne n 0 with (rfl | hn)
  · simp
  · exact cast_div n_dvd (cast_ne_zero.2 hn)
#align nat.cast_div_char_zero Nat.cast_div_charZero

end Nat

section

variable (M : Type _) [AddMonoidWithOne M] [CharZero M]

instance CharZero.NeZero.two : NeZero (2 : M) :=
  ⟨by
    have : ((2 : ℕ) : M) ≠ 0 := Nat.cast_ne_zero.2 (by decide)
    rwa [Nat.cast_two] at this⟩
#align char_zero.ne_zero.two CharZero.NeZero.two

end

section

variable {R : Type _} [NonAssocSemiring R] [NoZeroDivisors R] [CharZero R] {a : R}

@[simp]
theorem add_self_eq_zero {a : R} : a + a = 0 ↔ a = 0 := by
  simp only [(two_mul a).symm, mul_eq_zero, two_ne_zero, false_or_iff]
#align add_self_eq_zero add_self_eq_zero

set_option linter.deprecated false

@[simp]
theorem bit0_eq_zero {a : R} : bit0 a = 0 ↔ a = 0 :=
  add_self_eq_zero
#align bit0_eq_zero bit0_eq_zero

@[simp]
theorem zero_eq_bit0 {a : R} : 0 = bit0 a ↔ a = 0 := by
  rw [eq_comm]
  exact bit0_eq_zero
#align zero_eq_bit0 zero_eq_bit0

theorem bit0_ne_zero : bit0 a ≠ 0 ↔ a ≠ 0 :=
  bit0_eq_zero.not
#align bit0_ne_zero bit0_ne_zero

theorem zero_ne_bit0 : 0 ≠ bit0 a ↔ a ≠ 0 :=
  zero_eq_bit0.not
#align zero_ne_bit0 zero_ne_bit0

end

section

variable {R : Type _} [NonAssocRing R] [NoZeroDivisors R] [CharZero R]

theorem neg_eq_self_iff {a : R} : -a = a ↔ a = 0 :=
  neg_eq_iff_add_eq_zero.trans add_self_eq_zero
#align neg_eq_self_iff neg_eq_self_iff

theorem eq_neg_self_iff {a : R} : a = -a ↔ a = 0 :=
  eq_neg_iff_add_eq_zero.trans add_self_eq_zero
#align eq_neg_self_iff eq_neg_self_iff

theorem nat_mul_inj {n : ℕ} {a b : R} (h : (n : R) * a = (n : R) * b) : n = 0 ∨ a = b := by
  rw [← sub_eq_zero, ← mul_sub, mul_eq_zero, sub_eq_zero] at h
  exact_mod_cast h
#align nat_mul_inj nat_mul_inj

theorem nat_mul_inj' {n : ℕ} {a b : R} (h : (n : R) * a = (n : R) * b) (w : n ≠ 0) : a = b := by
  simpa [w] using nat_mul_inj h
#align nat_mul_inj' nat_mul_inj'

set_option linter.deprecated false

theorem bit0_injective : Function.Injective (bit0 : R → R) := fun a b h => by
  dsimp [bit0] at h
  simp only [(two_mul a).symm, (two_mul b).symm] at h
  refine' nat_mul_inj' _ two_ne_zero
  exact_mod_cast h
#align bit0_injective bit0_injective

theorem bit1_injective : Function.Injective (bit1 : R → R) := fun a b h => by
  simp only [bit1, add_left_inj] at h
  exact bit0_injective h
#align bit1_injective bit1_injective

@[simp]
theorem bit0_eq_bit0 {a b : R} : bit0 a = bit0 b ↔ a = b :=
  bit0_injective.eq_iff
#align bit0_eq_bit0 bit0_eq_bit0

@[simp]
theorem bit1_eq_bit1 {a b : R} : bit1 a = bit1 b ↔ a = b :=
  bit1_injective.eq_iff
#align bit1_eq_bit1 bit1_eq_bit1

@[simp]
theorem bit1_eq_one {a : R} : bit1 a = 1 ↔ a = 0 := by
  rw [show (1 : R) = bit1 0 by simp, bit1_eq_bit1]
#align bit1_eq_one bit1_eq_one

@[simp]
theorem one_eq_bit1 {a : R} : 1 = bit1 a ↔ a = 0 := by
  rw [eq_comm]
  exact bit1_eq_one
#align one_eq_bit1 one_eq_bit1

end

section

variable {R : Type _} [DivisionRing R] [CharZero R]

@[simp]
theorem half_add_self (a : R) : (a + a) / 2 = a := by rw [← mul_two, mul_div_cancel a two_ne_zero]
#align half_add_self half_add_self

@[simp]
theorem add_halves' (a : R) : a / 2 + a / 2 = a := by rw [← add_div, half_add_self]
#align add_halves' add_halves'

theorem sub_half (a : R) : a - a / 2 = a / 2 := by rw [sub_eq_iff_eq_add, add_halves']
#align sub_half sub_half

theorem half_sub (a : R) : a / 2 - a = -(a / 2) := by rw [← neg_sub, sub_half]
#align half_sub half_sub

end

namespace WithTop

instance {R : Type _} [AddMonoidWithOne R] [CharZero R] :
    CharZero (WithTop R) where
  cast_injective m n h := by
    rwa [← coe_nat, ← coe_nat n, coe_eq_coe, Nat.cast_inj] at h

end WithTop

section RingHom

variable {R S : Type _} [NonAssocSemiring R] [NonAssocSemiring S]

theorem RingHom.charZero (ϕ : R →+* S) [hS : CharZero S] : CharZero R :=
  ⟨fun a b h => CharZero.cast_injective (by rw [← map_natCast ϕ, ← map_natCast ϕ, h])⟩
#align ring_hom.char_zero RingHom.charZero

theorem RingHom.charZero_iff {ϕ : R →+* S} (hϕ : Function.Injective ϕ) : CharZero R ↔ CharZero S :=
  ⟨fun hR =>
    ⟨by intro a b h; rwa [← @Nat.cast_inj R, ← hϕ.eq_iff, map_natCast ϕ, map_natCast ϕ]⟩,
    fun hS => ϕ.charZero⟩
#align ring_hom.char_zero_iff RingHom.charZero_iff

theorem RingHom.injective_nat (f : ℕ →+* R) [CharZero R] : Function.Injective f :=
  Subsingleton.elim (Nat.castRingHom _) f ▸ Nat.cast_injective
#align ring_hom.injective_nat RingHom.injective_nat

end RingHom


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.abel
import data.polynomial.eval

/-!
# The Pochhammer polynomials

We define and prove some basic relations about
`pochhammer S n : polynomial S := X * (X + 1) * ... * (X + n - 1)`
which is also known as the rising factorial. A version of this definition
that is focused on `nat` can be found in `data.nat.factorial` as `asc_factorial`.

## Implementation

As with many other families of polynomials, even though the coefficients are always in `ℕ`,
we define the polynomial with coefficients in any `[semiring S]`.

## TODO

There is lots more in this direction:
* q-factorials, q-binomials, q-Pochhammer.
-/

universes u v

open polynomial

section semiring
variables (S : Type u) [semiring S]

/--
`pochhammer S n` is the polynomial `X * (X+1) * ... * (X + n - 1)`,
with coefficients in the semiring `S`.
-/
noncomputable def pochhammer : ℕ → polynomial S
| 0 := 1
| (n+1) := X * (pochhammer n).comp (X + 1)

@[simp] lemma pochhammer_zero : pochhammer S 0 = 1 := rfl
@[simp] lemma pochhammer_one : pochhammer S 1 = X := by simp [pochhammer]

lemma pochhammer_succ_left (n : ℕ) : pochhammer S (n+1) = X * (pochhammer S n).comp (X+1) :=
by rw pochhammer

section
variables {S} {T : Type v} [semiring T]
@[simp] lemma pochhammer_map (f : S →+* T) (n : ℕ) : (pochhammer S n).map f = pochhammer T n :=
begin
  induction n with n ih,
  { simp, },
  { simp [ih, pochhammer_succ_left, map_comp], },
end

end

@[simp, norm_cast] lemma pochhammer_eval_cast (n k : ℕ) :
  ((pochhammer ℕ n).eval k : S) = (pochhammer S n).eval k :=
begin
  rw [←pochhammer_map (algebra_map ℕ S), eval_map, ←(algebra_map ℕ S).eq_nat_cast,
    eval₂_at_nat_cast, nat.cast_id, ring_hom.eq_nat_cast],
end

lemma pochhammer_eval_zero {n : ℕ} : (pochhammer S n).eval 0 = if n = 0 then 1 else 0 :=
begin
  cases n,
  { simp, },
  { simp [X_mul, nat.succ_ne_zero, pochhammer_succ_left], }
end

lemma pochhammer_zero_eval_zero : (pochhammer S 0).eval 0 = 1 :=
by simp

@[simp] lemma pochhammer_ne_zero_eval_zero {n : ℕ} (h : n ≠ 0) : (pochhammer S n).eval 0 = 0 :=
by simp [pochhammer_eval_zero, h]

lemma pochhammer_succ_right (n : ℕ) : pochhammer S (n+1) = pochhammer S n * (X + n) :=
begin
  suffices h : pochhammer ℕ (n+1) = pochhammer ℕ n * (X + n),
  { apply_fun polynomial.map (algebra_map ℕ S) at h,
    simpa only [pochhammer_map, polynomial.map_mul, polynomial.map_add, map_X, map_nat_cast]
      using h },
  induction n with n ih,
  { simp, },
  { conv_lhs
  { rw [pochhammer_succ_left, ih, mul_comp, ←mul_assoc, ←pochhammer_succ_left, add_comp, X_comp,
      nat_cast_comp, add_assoc, add_comm (1 : polynomial ℕ)], },
    refl, },
end

lemma polynomial.mul_X_add_nat_cast_comp {p q : polynomial S} {n : ℕ} :
  (p * (X + n)).comp q = (p.comp q) * (q + n) :=
by rw [mul_add, add_comp, mul_X_comp, ←nat.cast_comm, nat_cast_mul_comp, nat.cast_comm, mul_add]

lemma pochhammer_mul (n m : ℕ) :
  pochhammer S n * (pochhammer S m).comp (X + n) = pochhammer S (n + m) :=
begin
  induction m with m ih,
  { simp, },
  { rw [pochhammer_succ_right, polynomial.mul_X_add_nat_cast_comp, ←mul_assoc, ih,
      nat.succ_eq_add_one, ←add_assoc, pochhammer_succ_right, nat.cast_add, add_assoc], }
end

lemma pochhammer_nat_eq_asc_factorial (n : ℕ) :
  ∀ k, (pochhammer ℕ k).eval (n + 1) = n.asc_factorial k
| 0 := by erw [eval_one]; refl
| (t + 1) := begin
  rw [pochhammer_succ_right, eval_mul, pochhammer_nat_eq_asc_factorial t],
  suffices : n.asc_factorial t * (n + 1 + t) = n.asc_factorial (t + 1), by simpa,
  rw [nat.asc_factorial_succ, add_right_comm, mul_comm]
end

lemma pochhammer_nat_eq_desc_factorial (a b : ℕ) :
  (pochhammer ℕ b).eval a = (a + b - 1).desc_factorial b :=
begin
  cases b,
  { rw [nat.desc_factorial_zero, pochhammer_zero, polynomial.eval_one] },
  rw [nat.add_succ, nat.succ_sub_succ, tsub_zero],
  cases a,
  { rw [pochhammer_ne_zero_eval_zero _ b.succ_ne_zero, zero_add,
    nat.desc_factorial_of_lt b.lt_succ_self] },
  { rw [nat.succ_add, ←nat.add_succ, nat.add_desc_factorial_eq_asc_factorial,
      pochhammer_nat_eq_asc_factorial] }
end

end semiring

section comm_semiring
variables {S : Type*} [comm_semiring S]

lemma pochhammer_succ_eval (n : ℕ) (k : S) :
  (pochhammer S n.succ).eval k = (pochhammer S n).eval k * (k + ↑n) :=
by rw [pochhammer_succ_right, polynomial.eval_mul, polynomial.eval_add, polynomial.eval_X,
    polynomial.eval_nat_cast]

end comm_semiring

section ordered_semiring
variables {S : Type*} [ordered_semiring S] [nontrivial S]

lemma pochhammer_pos (n : ℕ) (s : S) (h : 0 < s) : 0 < (pochhammer S n).eval s :=
begin
  induction n with n ih,
  { simp only [nat.nat_zero_eq_zero, pochhammer_zero, eval_one], exact zero_lt_one, },
  { rw [pochhammer_succ_right, mul_add, eval_add, ←nat.cast_comm, eval_nat_cast_mul, eval_mul_X,
      nat.cast_comm, ←mul_add],
    exact mul_pos ih
      (lt_of_lt_of_le h ((le_add_iff_nonneg_right _).mpr (nat.cast_nonneg n))), }
end

end ordered_semiring

section factorial

open_locale nat

variables (S : Type*) [semiring S] (r n : ℕ)

@[simp]
lemma pochhammer_eval_one (S : Type*) [semiring S] (n : ℕ) :
  (pochhammer S n).eval (1 : S) = (n! : S) :=
by rw_mod_cast [pochhammer_nat_eq_asc_factorial, nat.zero_asc_factorial]

lemma factorial_mul_pochhammer (S : Type*) [semiring S] (r n : ℕ) :
  (r! : S) * (pochhammer S n).eval (r + 1) = (r + n)! :=
by rw_mod_cast [pochhammer_nat_eq_asc_factorial, nat.factorial_mul_asc_factorial]

lemma pochhammer_nat_eval_succ (r : ℕ) :
  ∀ n : ℕ, n * (pochhammer ℕ r).eval (n + 1) = (n + r) * (pochhammer ℕ r).eval n
| 0 := begin
  by_cases h : r = 0,
  { simp only [h, zero_mul, zero_add], },
  { simp only [pochhammer_eval_zero, zero_mul, if_neg h, mul_zero], }
end
| (k + 1) := by simp only [pochhammer_nat_eq_asc_factorial, nat.succ_asc_factorial, add_right_comm]

lemma pochhammer_eval_succ (r n : ℕ) :
  (n : S) * (pochhammer S r).eval (n + 1 : S) = (n + r) * (pochhammer S r).eval n :=
by exact_mod_cast congr_arg nat.cast (pochhammer_nat_eval_succ r n)

end factorial


import plane_separation_world.level03 --hide
open IncidencePlane --hide

noncomputable theory --hide
open_locale classical --hide

/-
# Plane Separation World

## Level 4: on the way to the final level (I).

Welcome to the last trip of The Euclid Game! This is the first of five lemmas that we need to prove before jumping into the final level of the game! You will be provided with
their mathematical proof in paper so as to solve them with ease. Remember to read the lemma and do a drawing of the situation. Let's get started!

## Mathematical proof in paper...

**Claim:** Given three non-collinear points A, B and C, then A ≠ C.

**Proof:**

Let us assume that `A ≠ C`. That is, `(A = C) → false`. Then, let us assume that `A = C`. Now, we want to prove that this is false.
We know that A, B, C are non-collinear. That is, `collinear {A, C, B} → false`. Then, it suffices to prove that A, B, C are collinear points.
Because `A = C`, then `collinear {A, C, B} = collinear {C, C, B}`. For this reason, there has to exist a line ℓ and a point P, such that `P ∈ {C, C, B} → P ∈ ℓ`.
Let the line ℓ be the line through B and C. Then, `P ∈ line_through B C`. Because `P ∈ {C, C, B}`, then either P = C or P = B. If P = C, then
`(P ∈ line_through B C) = (C ∈ line_through B C)`. By the first axiom of incidence (`line_through_right`), we prove that `C ∈ line_through B C`.
If P = B, then `(P ∈ line_through B C) = (B ∈ line_through B C)`. By the first axiom of incidence (`line_through_left`), we prove that `B ∈ line_through B C`.
-/

/- Hint : Click here for a hint, in case you get stuck.
To solve this level, remember that you can type `unfold collinear,` in order to make progress. In case you feel bewildered, do not hesitate
to click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B C P Q R : Ω} --hide
variables {ℓ r s t : Line Ω} --hide

/- Lemma :
Given three non-collinear points A, B and C, then A ≠ C.
-/
lemma noncollinear_ne_points (hCol : ¬ collinear ({A, C, B} : set Ω)) : A ≠ C :=
begin
  intro h,
  apply hCol,
  rw h,
  unfold collinear,
  use line_through B C,
  intros P H,
  cases H,
  rw H,
  exact line_through_right B C,
  cases H,
  rw H,
  exact line_through_right B C,
  cases H,
  exact line_through_left B C,
end


/-
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
-/
import data.nat.basic
import tactic.monotonicity.basic
import group_theory.group_action.defs

/-!
# Power operations on monoids and groups

The power operation on monoids and groups.
We separate this from group, because it depends on `ℕ`,
which in turn depends on other parts of algebra.

This module contains lemmas about `a ^ n` and `n • a`, where `n : ℕ` or `n : ℤ`.
Further lemmas can be found in `algebra.group_power.lemmas`.

The analogous results for groups with zero can be found in `algebra.group_with_zero.power`.

## Notation

- `a ^ n` is used as notation for `has_pow.pow a n`; in this file `n : ℕ` or `n : ℤ`.
- `n • a` is used as notation for `has_scalar.smul n a`; in this file `n : ℕ` or `n : ℤ`.

## Implementation details

We adopt the convention that `0^0 = 1`.
-/

universes u v w x y z u₁ u₂

variables {M : Type u} {N : Type v} {G : Type w} {H : Type x} {A : Type y} {B : Type z}
  {R : Type u₁} {S : Type u₂}

/-!
### Commutativity

First we prove some facts about `semiconj_by` and `commute`. They do not require any theory about
`pow` and/or `nsmul` and will be useful later in this file.
-/

section monoid
variables [monoid M] [monoid N] [add_monoid A] [add_monoid B]

@[simp, to_additive one_nsmul]
theorem pow_one (a : M) : a^1 = a :=
by rw [pow_succ, pow_zero, mul_one]

/-- Note that most of the lemmas about powers of two refer to it as `sq`. -/
@[to_additive two_nsmul]
theorem pow_two (a : M) : a^2 = a * a :=
by rw [pow_succ, pow_one]

alias pow_two ← sq

@[to_additive nsmul_add_comm']
theorem pow_mul_comm' (a : M) (n : ℕ) : a^n * a = a * a^n := commute.pow_self a n

@[to_additive add_nsmul]
theorem pow_add (a : M) (m n : ℕ) : a^(m + n) = a^m * a^n :=
by induction n with n ih; [rw [nat.add_zero, pow_zero, mul_one],
  rw [pow_succ', ← mul_assoc, ← ih, ← pow_succ', nat.add_assoc]]

@[simp] lemma pow_ite (P : Prop) [decidable P] (a : M) (b c : ℕ) :
  a ^ (if P then b else c) = if P then a ^ b else a ^ c :=
by split_ifs; refl

@[simp] lemma ite_pow (P : Prop) [decidable P] (a b : M) (c : ℕ) :
  (if P then a else b) ^ c = if P then a ^ c else b ^ c :=
by split_ifs; refl

@[simp] lemma pow_boole (P : Prop) [decidable P] (a : M) :
  a ^ (if P then 1 else 0) = if P then a else 1 :=
by simp

-- the attributes are intentionally out of order. `smul_zero` proves `nsmul_zero`.
@[to_additive nsmul_zero, simp] theorem one_pow (n : ℕ) : (1 : M)^n = 1 :=
by induction n with n ih; [exact pow_zero _, rw [pow_succ, ih, one_mul]]

@[to_additive mul_nsmul']
theorem pow_mul (a : M) (m n : ℕ) : a^(m * n) = (a^m)^n :=
begin
  induction n with n ih,
  { rw [nat.mul_zero, pow_zero, pow_zero] },
  { rw [nat.mul_succ, pow_add, pow_succ', ih] }
end

@[to_additive nsmul_left_comm]
lemma pow_right_comm (a : M) (m n : ℕ) : (a^m)^n = (a^n)^m :=
by rw [←pow_mul, nat.mul_comm, pow_mul]

@[to_additive mul_nsmul]
theorem pow_mul' (a : M) (m n : ℕ) : a^(m * n) = (a^n)^m :=
by rw [nat.mul_comm, pow_mul]

@[to_additive nsmul_add_sub_nsmul]
theorem pow_mul_pow_sub (a : M) {m n : ℕ} (h : m ≤ n) : a ^ m * a ^ (n - m) = a ^ n :=
by rw [←pow_add, nat.add_comm, tsub_add_cancel_of_le h]

@[to_additive sub_nsmul_nsmul_add]
theorem pow_sub_mul_pow (a : M) {m n : ℕ} (h : m ≤ n) : a ^ (n - m) * a ^ m = a ^ n :=
by rw [←pow_add, tsub_add_cancel_of_le h]

@[to_additive bit0_nsmul]
theorem pow_bit0 (a : M) (n : ℕ) : a ^ bit0 n = a^n * a^n := pow_add _ _ _

@[to_additive bit1_nsmul]
theorem pow_bit1 (a : M) (n : ℕ) : a ^ bit1 n = a^n * a^n * a :=
by rw [bit1, pow_succ', pow_bit0]

@[to_additive nsmul_add_comm]
theorem pow_mul_comm (a : M) (m n : ℕ) : a^m * a^n = a^n * a^m :=
commute.pow_pow_self a m n

@[to_additive]
lemma commute.mul_pow {a b : M} (h : commute a b) (n : ℕ) : (a * b) ^ n = a ^ n * b ^ n :=
nat.rec_on n (by simp only [pow_zero, one_mul]) $ λ n ihn,
by simp only [pow_succ, ihn, ← mul_assoc, (h.pow_left n).right_comm]

@[to_additive bit0_nsmul']
theorem pow_bit0' (a : M) (n : ℕ) : a ^ bit0 n = (a * a) ^ n :=
by rw [pow_bit0, (commute.refl a).mul_pow]

@[to_additive bit1_nsmul']
theorem pow_bit1' (a : M) (n : ℕ) : a ^ bit1 n = (a * a) ^ n * a :=
by rw [bit1, pow_succ', pow_bit0']

end monoid

/-!
### Commutative (additive) monoid
-/

section comm_monoid
variables [comm_monoid M] [add_comm_monoid A]

@[to_additive nsmul_add]
theorem mul_pow (a b : M) (n : ℕ) : (a * b)^n = a^n * b^n :=
(commute.all a b).mul_pow n

/-- The `n`th power map on a commutative monoid for a natural `n`, considered as a morphism of
monoids. -/
@[to_additive nsmul_add_monoid_hom "Multiplication by a natural `n` on a commutative additive
monoid, considered as a morphism of additive monoids.", simps]
def pow_monoid_hom (n : ℕ) : M →* M :=
{ to_fun := (^ n),
  map_one' := one_pow _,
  map_mul' := λ a b, mul_pow a b n }

-- the below line causes the linter to complain :-/
-- attribute [simps] pow_monoid_hom nsmul_add_monoid_hom

lemma dvd_pow {x y : M} (hxy : x ∣ y) :
  ∀ {n : ℕ} (hn : n ≠ 0), x ∣ y^n
| 0       hn := (hn rfl).elim
| (n + 1) hn := by { rw pow_succ, exact hxy.mul_right _ }

alias dvd_pow ← has_dvd.dvd.pow

lemma dvd_pow_self (a : M) {n : ℕ} (hn : n ≠ 0) : a ∣ a^n :=
dvd_rfl.pow hn

end comm_monoid

section div_inv_monoid
variable [div_inv_monoid G]

open int

@[simp, to_additive one_zsmul]
theorem zpow_one (a : G) : a ^ (1:ℤ) = a :=
by { convert pow_one a using 1, exact zpow_coe_nat a 1 }

theorem zpow_two (a : G) : a ^ (2 : ℤ) = a * a :=
by { convert pow_two a using 1, exact zpow_coe_nat a 2 }

@[to_additive neg_one_zsmul]
theorem zpow_neg_one (x : G) : x ^ (-1:ℤ) = x⁻¹ :=
(zpow_neg_succ_of_nat x 0).trans $ congr_arg has_inv.inv (pow_one x)

@[to_additive]
theorem zpow_neg_coe_of_pos (a : G) : ∀ {n : ℕ}, 0 < n → a ^ -(n:ℤ) = (a ^ n)⁻¹
| (n+1) _ := zpow_neg_succ_of_nat _ _

end div_inv_monoid

section group
variables [group G] [group H] [add_group A] [add_group B]

open int

section nat

@[simp, to_additive neg_nsmul] theorem inv_pow (a : G) (n : ℕ) : (a⁻¹)^n = (a^n)⁻¹ :=
begin
  induction n with n ih,
  { rw [pow_zero, pow_zero, one_inv] },
  { rw [pow_succ', pow_succ, ih, mul_inv_rev] }
end

@[to_additive nsmul_sub] -- rename to sub_nsmul?
theorem pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a^(m - n) = a^m * (a^n)⁻¹ :=
have h1 : m - n + n = m, from tsub_add_cancel_of_le h,
have h2 : a^(m - n) * a^n = a^m, by rw [←pow_add, h1],
eq_mul_inv_of_mul_eq h2

@[to_additive nsmul_neg_comm]
theorem pow_inv_comm (a : G) (m n : ℕ) : (a⁻¹)^m * a^n = a^n * (a⁻¹)^m :=
(commute.refl a).inv_left.pow_pow m n

@[to_additive sub_nsmul_neg]
theorem inv_pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a⁻¹^(m - n) = (a^m)⁻¹ * a^n :=
by rw [pow_sub a⁻¹ h, inv_pow, inv_pow, inv_inv]

end nat

@[simp, to_additive zsmul_zero]
theorem one_zpow : ∀ (n : ℤ), (1 : G) ^ n = 1
| (n : ℕ) := by rw [zpow_coe_nat, one_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, one_pow, one_inv]

@[simp, to_additive neg_zsmul]
theorem zpow_neg (a : G) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹
| (n+1:ℕ) := div_inv_monoid.zpow_neg' _ _
| 0       := by { change a ^ (0 : ℤ) = (a ^ (0 : ℤ))⁻¹, simp }
| -[1+ n] := by { rw [zpow_neg_succ_of_nat, inv_inv, ← zpow_coe_nat], refl }

@[to_additive neg_one_zsmul_add] lemma mul_zpow_neg_one (a b : G) :
  (a*b)^(-(1:ℤ)) = b^(-(1:ℤ))*a^(-(1:ℤ)) :=
by simp only [mul_inv_rev, zpow_one, zpow_neg]

@[to_additive zsmul_neg]
theorem inv_zpow (a : G) : ∀n:ℤ, a⁻¹ ^ n = (a ^ n)⁻¹
| (n : ℕ) := by rw [zpow_coe_nat, zpow_coe_nat, inv_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, inv_pow]

@[to_additive add_commute.zsmul_add]
theorem commute.mul_zpow {a b : G} (h : commute a b) : ∀ n : ℤ, (a * b) ^ n = a ^ n * b ^ n
| (n : ℕ) := by simp [zpow_coe_nat, h.mul_pow n]
| -[1+n]  := by simp [h.mul_pow, (h.pow_pow n.succ n.succ).inv_inv.symm.eq]

end group

section comm_group
variables [comm_group G] [add_comm_group A]

@[to_additive zsmul_add]
theorem mul_zpow (a b : G) (n : ℤ) : (a * b)^n = a^n * b^n := (commute.all a b).mul_zpow n

@[to_additive zsmul_sub]
theorem div_zpow (a b : G) (n : ℤ) : (a / b) ^ n = a ^ n / b ^ n :=
by rw [div_eq_mul_inv, div_eq_mul_inv, mul_zpow, inv_zpow]

/-- The `n`th power map (`n` an integer) on a commutative group, considered as a group
homomorphism. -/
@[to_additive "Multiplication by an integer `n` on a commutative additive group, considered as an
additive group homomorphism.", simps]
def zpow_group_hom (n : ℤ) : G →* G :=
{ to_fun := (^ n),
  map_one' := one_zpow n,
  map_mul' := λ a b, mul_zpow a b n }

end comm_group

lemma zero_pow [monoid_with_zero R] : ∀ {n : ℕ}, 0 < n → (0 : R) ^ n = 0
| (n+1) _ := by rw [pow_succ, zero_mul]

lemma zero_pow_eq [monoid_with_zero R] (n : ℕ) : (0 : R)^n = if n = 0 then 1 else 0 :=
begin
  split_ifs with h,
  { rw [h, pow_zero], },
  { rw [zero_pow (nat.pos_of_ne_zero h)] },
end

lemma pow_eq_zero_of_le [monoid_with_zero M] {x : M} {n m : ℕ}
  (hn : n ≤ m) (hx : x^n = 0) : x^m = 0 :=
by rw [← tsub_add_cancel_of_le hn, pow_add, hx, mul_zero]

namespace ring_hom

variables [semiring R] [semiring S]

protected lemma map_pow (f : R →+* S) (a) :
  ∀ n : ℕ, f (a ^ n) = (f a) ^ n :=
map_pow f a

end ring_hom

lemma pow_dvd_pow [monoid R] (a : R) {m n : ℕ} (h : m ≤ n) :
  a ^ m ∣ a ^ n := ⟨a ^ (n - m), by rw [← pow_add, nat.add_comm, tsub_add_cancel_of_le h]⟩

theorem pow_dvd_pow_of_dvd [comm_monoid R] {a b : R} (h : a ∣ b) : ∀ n : ℕ, a ^ n ∣ b ^ n
| 0     := by rw [pow_zero, pow_zero]
| (n+1) := by { rw [pow_succ, pow_succ], exact mul_dvd_mul h (pow_dvd_pow_of_dvd n) }

theorem pow_eq_zero [monoid_with_zero R] [no_zero_divisors R] {x : R} {n : ℕ} (H : x^n = 0) :
  x = 0 :=
begin
  induction n with n ih,
  { rw pow_zero at H,
    rw [← mul_one x, H, mul_zero] },
  { rw pow_succ at H,
    exact or.cases_on (mul_eq_zero.1 H) id ih }
end

@[simp] lemma pow_eq_zero_iff [monoid_with_zero R] [no_zero_divisors R]
  {a : R} {n : ℕ} (hn : 0 < n) :
  a ^ n = 0 ↔ a = 0 :=
begin
  refine ⟨pow_eq_zero, _⟩,
  rintros rfl,
  exact zero_pow hn,
end

lemma pow_ne_zero_iff [monoid_with_zero R] [no_zero_divisors R] {a : R} {n : ℕ} (hn : 0 < n) :
  a ^ n ≠ 0 ↔ a ≠ 0 :=
by rwa [not_iff_not, pow_eq_zero_iff]

@[field_simps] theorem pow_ne_zero [monoid_with_zero R] [no_zero_divisors R]
  {a : R} (n : ℕ) (h : a ≠ 0) : a ^ n ≠ 0 :=
mt pow_eq_zero h

section semiring
variables [semiring R]

lemma min_pow_dvd_add {n m : ℕ} {a b c : R} (ha : c ^ n ∣ a) (hb : c ^ m ∣ b) :
  c ^ (min n m) ∣ a + b :=
begin
  replace ha := (pow_dvd_pow c (min_le_left n m)).trans ha,
  replace hb := (pow_dvd_pow c (min_le_right n m)).trans hb,
  exact dvd_add ha hb
end

end semiring

section comm_semiring
variables [comm_semiring R]

lemma add_sq (a b : R) : (a + b) ^ 2 = a ^ 2 + 2 * a * b + b ^ 2 :=
by simp only [sq, add_mul_self_eq]

alias add_sq ← add_pow_two

end comm_semiring

section ring
variable [ring R]

section
variables (R)
theorem neg_one_pow_eq_or : ∀ n : ℕ, (-1 : R)^n = 1 ∨ (-1 : R)^n = -1
| 0     := or.inl (pow_zero _)
| (n+1) := (neg_one_pow_eq_or n).swap.imp
  (λ h, by rw [pow_succ, h, neg_one_mul, neg_neg])
  (λ h, by rw [pow_succ, h, mul_one])

end

@[simp]
lemma neg_one_pow_mul_eq_zero_iff {n : ℕ} {r : R} : (-1)^n * r = 0 ↔ r = 0 :=
by rcases neg_one_pow_eq_or R n; simp [h]

@[simp]
lemma mul_neg_one_pow_eq_zero_iff {n : ℕ} {r : R} : r * (-1)^n = 0 ↔ r = 0 :=
by rcases neg_one_pow_eq_or R n; simp [h]

theorem neg_pow (a : R) (n : ℕ) : (- a) ^ n = (-1) ^ n * a ^ n :=
(neg_one_mul a) ▸ (commute.neg_one_left a).mul_pow n

@[simp] theorem neg_pow_bit0 (a : R) (n : ℕ) : (- a) ^ (bit0 n) = a ^ (bit0 n) :=
by rw [pow_bit0', neg_mul_neg, pow_bit0']

@[simp] theorem neg_pow_bit1 (a : R) (n : ℕ) : (- a) ^ (bit1 n) = - a ^ (bit1 n) :=
by simp only [bit1, pow_succ, neg_pow_bit0, neg_mul_eq_neg_mul]

@[simp] lemma neg_sq (a : R) : (-a)^2 = a^2 :=
by simp [sq]

alias neg_sq ← neg_pow_two

end ring

section comm_ring
variables [comm_ring R]

lemma sq_sub_sq (a b : R) : a ^ 2 - b ^ 2 = (a + b) * (a - b) :=
by rw [sq, sq, mul_self_sub_mul_self]

alias sq_sub_sq ← pow_two_sub_pow_two

lemma eq_or_eq_neg_of_sq_eq_sq [is_domain R] (a b : R) (h : a ^ 2 = b ^ 2) : a = b ∨ a = -b :=
by rwa [← add_eq_zero_iff_eq_neg, ← sub_eq_zero, or_comm, ← mul_eq_zero,
        ← sq_sub_sq a b, sub_eq_zero]

lemma sub_sq (a b : R) : (a - b) ^ 2 = a ^ 2 - 2 * a * b + b ^ 2 :=
by rw [sub_eq_add_neg, add_sq, neg_sq, mul_neg_eq_neg_mul_symm, ← sub_eq_add_neg]

alias sub_sq ← sub_pow_two

end comm_ring

lemma of_add_nsmul [add_monoid A] (x : A) (n : ℕ) :
  multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl

lemma of_add_zsmul [add_group A] (x : A) (n : ℤ) :
  multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl

lemma of_mul_pow [monoid A] (x : A) (n : ℕ) :
  additive.of_mul (x ^ n) = n • (additive.of_mul x) := rfl

lemma of_mul_zpow [group G] (x : G) (n : ℤ) : additive.of_mul (x ^ n) = n • additive.of_mul x :=
rfl

@[simp] lemma semiconj_by.zpow_right [group G] {a x y : G} (h : semiconj_by a x y) :
  ∀ m : ℤ, semiconj_by a (x^m) (y^m)
| (n : ℕ) := by simp [zpow_coe_nat, h.pow_right n]
| -[1+n] := by simp [(h.pow_right n.succ).inv_right]

namespace commute

variables [group G] {a b : G}

@[simp] lemma zpow_right (h : commute a b) (m : ℤ) : commute a (b^m) :=
h.zpow_right m

@[simp] lemma zpow_left (h : commute a b) (m : ℤ) : commute (a^m) b :=
(h.symm.zpow_right m).symm

lemma zpow_zpow (h : commute a b) (m n : ℤ) : commute (a^m) (b^n) := (h.zpow_left m).zpow_right n

variables (a) (m n : ℤ)

@[simp] theorem self_zpow : commute a (a ^ n) := (commute.refl a).zpow_right n
@[simp] theorem zpow_self : commute (a ^ n) a := (commute.refl a).zpow_left n
@[simp] theorem zpow_zpow_self : commute (a ^ m) (a ^ n) := (commute.refl a).zpow_zpow m n

end commute