/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Floris van Doorn.

A lecture on library-building.
-/
import algebra.group order.boolean_algebra tactic.library_search
data.vector

set_option old_structure_cmd true
universe variable u

/-
  Best practices:
-/

/-
  Use good names: https://github.com/leanprover-community/mathlib/blob/master/docs/contribute/naming.md
-/

#print nat.succ_ne_zero
#print mul_zero -- the name could be mul_zero_eq, but we shorten it
#print mul_one
#print le_iff_lt_or_eq
#print neg_neg
#print add_lt_add_of_lt_of_le
#print mul_assoc

example {p q : Prop} (h : p ∧ q) :
  p :=
h.left -- and.left h

open nat
example (n : ℕ) : succ n > 0 :=
by library_search
-- library_search is useful to find a lemma in the library. You need to know the exact conclusion of the lemma (and import tactic.library_search).

/-
  Use good style: https://github.com/leanprover-community/mathlib/blob/master/docs/contribute/style.md
-/

/-
  Good proving practice
    * Try to work in great generality (c.f. Fréchet derivative)
    * Use bi-implications whenever possible
    * Write equations and bi-implications so that the RHS is simpler than the LHS (if possible)
-/

/-
  IMPORTANT: Copy-paste from a similar development:
    - The existing library probably used the right explicit/implicit arguments
    - The existing library probably used the right style
    - The existing library probably made good design decisions
-/

/-
  Look through mathlib to see what parts already exists
-/

/-
  After you complete a lemma, clean up the proof afterwards:
    * replace `intro x, intro y` by `intros x y`
    * remove `simp` (or other automation) if it didn't close  goal
    * If the proof fits on one line, replace `begin ... end` with `by { ... }`
    * etc.
-/

/-
  As a demo, let's build a little library of quasigroups:
  https://en.wikipedia.org/wiki/Quasigroup
-/

/-
  From Wikipedia:
  A quasigroup (Q, ∗, \, /) is a type (2,2,2) algebra (i.e., equipped with three binary operations) satisfying the identities:
  y = x ∗ (x \ y),
  y = x \ (x ∗ y),
  y = (y / x) ∗ x,
  y = (y ∗ x) / x.
-/

#print semigroup -- we use a definition similar to semigroup
-- \ is left division, abbreviated as ldiv
-- / right division, abbreviated as rdiv
class quasigroup (α : Type u) extends has_mul α, has_div α, has_sdiff α :=
(mul_ldiv : ∀ x y : α, x * (x \ y) = y)
(ldiv_mul : ∀ x y : α, x \ (x * y) = y)
(rdiv_mul : ∀ x y : α, (x / y) * y = x)
(mul_rdiv : ∀ x y : α, (x * y) / y = x)

-- x \ y is the unique element z such that x * z = y

variables {α : Type u} [quasigroup α]

lemma mul_ldiv (x y : α) : x * (x \ y) = y :=
quasigroup.mul_ldiv x y
lemma ldiv_mul (x y : α) : x \ (x * y) = y :=
quasigroup.ldiv_mul x y
lemma mul_rdiv (x y : α) : (x * y) / y = x :=
quasigroup.mul_rdiv x y
lemma rdiv_mul (x y : α) : (x / y) * y = x :=
quasigroup.rdiv_mul x y

@[simp] lemma ldiv_eq_iff_mul_eq {x y z : α} :
  x \ y = z ↔ x * z = y :=
begin
  split,
  { intro h, rw [← h, mul_ldiv] },
  { intro h, rw [← h, ldiv_mul] }
end

@[simp] lemma rdiv_eq_iff_mul_eq {x y z : α} :
  x / y = z ↔ z * y = x :=
begin
  split,
  { intro h, rw [← h, rdiv_mul] },
  { intro h, rw [← h, mul_rdiv] }
end

/-
  Given an abelian group, (A, +), taking its subtraction operation as quasigroup multiplication yields a quasigroup (A, −)
-/

@[simp] lemma add_add_neg_cancel {α} [add_comm_group α] (x y : α) : x + (y + -x) = y :=
by { rw [add_comm], simp }

def sub_quasigroup (α : Type u) := α
instance {α} [add_comm_group α] : quasigroup (sub_quasigroup α) :=
{ mul := λ x y, (x - y : α),
  div := λ x y, (x + y : α),
  sdiff := λ x y, (x - y : α),
  ldiv_mul := by { intros, simp },
  mul_ldiv := by { intros, simp },
  mul_rdiv := by { intros, simp },
  rdiv_mul := by { intros, simp } }

/-
  A loop is a quasigroup with an identity element; that is, an element, e, such that
  x ∗ e = x and e ∗ x = x for all x in Q.
  It follows that the identity element, e, is unique, and that every element of Q has unique left and right inverses (which need not be the same).
-/
#print monoid -- we use a definition similar to monoid.

class loop (α : Type u) extends quasigroup α, has_one α :=
(one_mul : ∀ a : α, 1 * a = a) (mul_one : ∀ a : α, a * 1 = a)

/-
  Every group is a loop.
-/
#print group
instance group.to_loop {α : Type u}
  [h : group α] : loop α :=
{ mul := (*),
  div := λ x y, x * y⁻¹,
  sdiff := λ x y, x⁻¹ * y,
  mul_ldiv := by { intros, simp },
  ldiv_mul := by { intros, simp },
  rdiv_mul := by { intros, simp },
  mul_rdiv := by { intros, simp },
  ..h }

/-
  A loop that is associative is a group
-/

def loop.to_group {α} [h : loop α] (h_assoc : ∀ x y z : α, (x * y) * z = x * (y * z)) : group α :=
{ mul := (*),
  mul_assoc := h_assoc,
  inv := λ x, 1 / x,
  mul_left_inv := λ x, by apply rdiv_mul,
  ..h }

------------- Q&A -------------

/- It is better not to put `quasigroup α` as an argument.
  If we did that, we would have to specify two arguments to state that α has a loop structure -/
class loop' (α : Type u) [quasigroup α] extends has_one α :=
(one_mul : ∀ a : α, 1 * a = a) (mul_one : ∀ a : α, a * 1 = a)

def loop'.to_group {α} [quasigroup α] [h : loop' α] (h_assoc : ∀ x y z : α, (x * y) * z = x * (y * z)) : group α :=
sorry

instance group.to_quasigroup {α : Type u}
  [h : group α] : quasigroup α :=
  sorry

/- The following instance doesn't type-check if we remove the previous instance. -/
instance group.to_loop' {α : Type u}
  [h : group α] : loop' α :=
sorry

/- If you want to use the notation * for an operation of type
  α → α → α (for some α), you can should make an instance of has_mul. Example: -/

instance list.has_mul {α : Type u} : has_mul (list α) :=
{ mul := list.append }

/- If you want to make it a local notation (for only this file), use: -/
def list.has_mul' {α : Type u} : has_mul (list α) :=
{ mul := list.append }
local attribute [instance] list.has_mul'

/- if you have an operation with a different type, define (local) notation for it, and use a symbol other than *
  -/
constant inner_product {n : ℕ} : vector ℕ n → vector ℕ n → ℕ
local infix ⬝ := inner_product


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.nat.basic

universes u

namespace Mathlib

/-- `fin n` is the subtype of `ℕ` consisting of natural numbers strictly smaller than `n`. -/
def fin (n : ℕ) :=
  Subtype fun (i : ℕ) => i < n

namespace fin

/-- Backwards-compatible constructor for `fin n`. -/
def mk {n : ℕ} (i : ℕ) (h : i < n) : fin n :=
  { val := i, property := h }

protected def lt {n : ℕ} (a : fin n) (b : fin n) :=
  subtype.val a < subtype.val b

protected def le {n : ℕ} (a : fin n) (b : fin n) :=
  subtype.val a ≤ subtype.val b

protected instance has_lt {n : ℕ} : HasLess (fin n) :=
  { Less := fin.lt }

protected instance has_le {n : ℕ} : HasLessEq (fin n) :=
  { LessEq := fin.le }

protected instance decidable_lt {n : ℕ} (a : fin n) (b : fin n) : Decidable (a < b) :=
  nat.decidable_lt (subtype.val a) (subtype.val b)

protected instance decidable_le {n : ℕ} (a : fin n) (b : fin n) : Decidable (a ≤ b) :=
  nat.decidable_le (subtype.val a) (subtype.val b)

def elim0 {α : fin 0 → Sort u} (x : fin 0) : α x :=
  sorry

theorem eq_of_veq {n : ℕ} {i : fin n} {j : fin n} : subtype.val i = subtype.val j → i = j := sorry

theorem veq_of_eq {n : ℕ} {i : fin n} {j : fin n} : i = j → subtype.val i = subtype.val j := sorry

theorem ne_of_vne {n : ℕ} {i : fin n} {j : fin n} (h : subtype.val i ≠ subtype.val j) : i ≠ j :=
  fun (h' : i = j) => absurd (veq_of_eq h') h

theorem vne_of_ne {n : ℕ} {i : fin n} {j : fin n} (h : i ≠ j) : subtype.val i ≠ subtype.val j :=
  fun (h' : subtype.val i = subtype.val j) => absurd (eq_of_veq h') h

end fin

protected instance fin.decidable_eq (n : ℕ) : DecidableEq (fin n) :=
  fun (i j : fin n) => decidable_of_decidable_of_iff (nat.decidable_eq (subtype.val i) (subtype.val j)) sorry


import ring_theory.ideal_operations -- PRs mostly go there

-- PR directly to ring_theory.ideals
lemma ideal.one_mem_of_unit_mem {R : Type*} [comm_ring R] {I : ideal R} {u : units R} (h : (u : R) ∈ I) :
(1 : R) ∈ I :=
begin
  have : (u : R)*(u⁻¹ : units R) ∈ I, from I.mul_mem_right h,
  rwa u.mul_inv at this
end

lemma ideal.span_singleton_mul {R : Type*} [comm_ring R] (x y : R) :
(ideal.span ({x} : set R)) * (ideal.span {y}) = ideal.span {x*y} :=
by simp [ideal.span_mul_span]

lemma ideal.span_singleton_pow {R : Type*} [comm_ring R] (x : R) (n : ℕ) :
(ideal.span ({x} : set R))^n = ideal.span {x^n} :=
begin
  induction n with n ih,
  { simp },
  { rw [pow_succ, ih, ideal.span_singleton_mul, pow_succ] }
end

lemma ideal.eq_bot_iff_zero {R : Type*} [comm_ring R] {I : ideal R} : I = ⊥ ↔ (I : set R) = {0} :=
begin
  split ; intro h,
  { simp [h] },
  { ext,
    change x ∈ (I : set R) ↔ _,
    simp [h] },
end

@[simp] lemma ideal.span_empty {R : Type*} [comm_ring R] : ideal.span (∅ : set R) = ⊥ :=
ideal.span_eq_bot.mpr (λ x h, false.elim h)

@[simp] lemma ideal.span_zero {R : Type*} [comm_ring R] : ideal.span ({0} : set R) = ⊥ :=
ideal.span_eq_bot.mpr $ λ x, set.mem_singleton_iff.mp


import .to_permutation
import .to_sum
open equiv

universe u
/--
    For a group `G` and an element `g : G`,  `to equiv g` is the permutation (i.e `equiv G G`) define
    by : `s ↦ s * g⁻¹`
-/
def to_equiv {G : Type u}[group G](g : G) : perm G := { to_fun := λ s :G , s * g⁻¹ ,
  inv_fun := λ s : G , s * g,
  left_inv := begin
   intros x,dsimp,
   rw mul_assoc, rw inv_mul_self,rw mul_one, end,
  right_inv :=  begin  intros x,dsimp,rw  mul_assoc, rw mul_inv_self, rw mul_one, end}

lemma to_equiv_ext {G : Type u}[group G](g : G) (s : G) : to_equiv g s = s * g⁻¹  := rfl
universe v
/--
    Let `φ : G → X` with `fintype G` and `add_comm_monoid X`.
    For `σ : perm X` we have : `∑ φ = ∑ φ ∘ σ`.
-/
def Sum_equiv {G :Type u}{X : Type v}[fintype G](g : G)(φ :  G → X)[add_comm_monoid X] (σ : equiv.perm G) :
            finset.sum finset.univ φ = finset.sum finset.univ (λ s, φ (σ s))
:= Sum_permutation φ  σ

variables (G : Type)[group G](g : G)(X :Type) (φ : G → X)(hyp : fintype G)[add_comm_monoid X]
#check @Sum_equiv G X hyp g φ _ (to_equiv g)
/-
theorem Per (f : M→ₗ[R]M') (g : G) : Σ (mixte_conj ρ π f) = Σ (λ s, mixte_conj ρ π f (s * g⁻¹)) := begin
    sorry,
end
-/


import Mathbin.Data.Set.Basic
import Mathbin.Data.Complex.Exponential
import CvxLean.Lib.Missing.Mathlib
import Mathbin.Algebra.GroupWithZero.Basic

attribute [-simp] Set.inj_on_empty Set.inj_on_singleton Quot.lift_on₂_mk Quot.lift_on_mk Quot.lift₂_mk

namespace Real

def expCone (x y z : ℝ) : Prop :=
  (0 < y ∧ y * exp (x / y) ≤ z) ∨ (y = 0 ∧ 0 ≤ z ∧ x ≤ 0)

def Vec.expCone (x y z : Finₓ n → ℝ) : Prop :=
  ∀ i, Real.expCone (x i) (y i) (z i)

theorem exp_iff_expCone (t x : ℝ) : exp x ≤ t ↔ expCone x 1 t := by
  unfold expCone
  rw [iff_def]
  apply And.intro
  · intro hexp
    apply Or.intro_left
    apply And.intro
    apply zero_lt_one
    change One.one * exp (x / One.one) ≤ t
    rw [@div_one ℝ (@GroupWithZeroₓ.toDivisionMonoid Real
      (@DivisionSemiring.toGroupWithZero Real (@DivisionRing.toDivisionSemiring Real Real.divisionRing)))]
    rw [one_mulₓ]
    assumption
  · intro h
    cases h with
    | inl h =>
      have h : One.one * exp (x / One.one) ≤ t := h.2
      rwa [@div_one ℝ (@GroupWithZeroₓ.toDivisionMonoid Real
        (@DivisionSemiring.toGroupWithZero Real (@DivisionRing.toDivisionSemiring Real Real.divisionRing))),
        one_mulₓ] at h
    | inr h =>
      exfalso
      apply @one_ne_zero Real
      apply h.1

end Real


import algebra.parity
import data.nat.parity
import data.nat.prime
import data.rat

open nat

lemma rat_pow_denom_lemma :
      ∀ a b : ℚ, coprime a.num.nat_abs b.denom →
        coprime b.num.nat_abs a.denom →
        (a * b).denom = a.denom * b.denom :=
  begin
    introv,
    intros a_num_cop_b_denom b_num_cop_a_denom,
    cases a,
    cases b,
    rw rat.mul_num_denom,
    simp only [cast_mul] at *,
    norm_cast,
    have h₁ : (↑(a_denom * b_denom) : ℤ) > 0,
    {
      norm_cast,
      rw canonically_ordered_comm_semiring.mul_pos,
      exact ⟨a_pos, b_pos⟩,
    },
    have h₂ : coprime (a_num * b_num).nat_abs (↑(a_denom * b_denom) : ℤ).nat_abs,
    {
      norm_cast,
      have h₃ := nat.coprime.mul a_cop b_num_cop_a_denom,
      have h₄ := nat.coprime.mul b_cop a_num_cop_b_denom,
      rw ←int.nat_abs_mul at h₃,
      rw [←int.nat_abs_mul, int.mul_comm] at h₄,
      exact nat.coprime.mul_right h₃ h₄,
    },
    apply int.coe_nat_inj,
    cases ↑(a_denom * b_denom),
    {
      delta rat.mk,
      simp only [int.of_nat_eq_coe, nat.cast_inj],
      delta id_rhs,
      unfold rat.mk_nat,
      split_ifs,
      {
        exfalso,
        rw [h, int.of_nat_eq_coe, cast_zero, gt_iff_lt, lt_self_iff_false] at h₁,
        exact h₁,
      },
      {
        unfold rat.mk_pnat,
        simp only,
        unfold coprime at h₂,
        rw int.nat_abs_of_nat_core at h₂,
        rw h₂,
        exact nat.div_one _,
      },
    },
    {
      exfalso,
      rw [gt_iff_lt, int.neg_succ_not_pos] at h₁,
      exact h₁,
    },
  end

lemma rat_pow_num_lemma :
      ∀ a b : ℚ, coprime a.num.nat_abs b.denom →
        coprime b.num.nat_abs a.denom →
        (a * b).num = a.num * b.num :=
  begin
    introv,
    intros h h',
    cases a,
    cases b,
    rw rat.mul_num_denom,
    simp only [cast_mul] at *,
    norm_cast,
    have h₁ : (↑(a_denom * b_denom) : ℤ) > 0,
    {
      norm_cast,
      rw [canonically_ordered_comm_semiring.mul_pos],
      exact ⟨a_pos, b_pos⟩,
    },
    have h₂ : coprime (a_num * b_num).nat_abs (↑(a_denom * b_denom) : ℤ).nat_abs,
    {
      norm_cast,
      have h₃ := nat.coprime.mul a_cop h',
      have h₄ := nat.coprime.mul b_cop h,
      rw ←int.nat_abs_mul at h₃,
      rw [←int.nat_abs_mul, int.mul_comm] at h₄,
      exact nat.coprime.mul_right h₃ h₄,
    },
    cases ↑(a_denom * b_denom),
    {
      rw int.nat_abs_of_nat_core at h₂,
      delta rat.mk,
      simp only,
      delta id_rhs,
      unfold rat.mk_nat,
      split_ifs,
      {
        exfalso,
        rw [h_1, int.of_nat_eq_coe, cast_zero, gt_iff_lt, lt_self_iff_false] at h₁,
        exact h₁,
      },
      {
        unfold rat.mk_pnat,
        simp only,
        unfold coprime at h₂,
        rw [h₂, cast_one, int.div_one],
      },
    },
    {
      exfalso,
      rw [gt_iff_lt, int.neg_succ_not_pos] at h₁,
      exact h₁,
    },
  end

lemma rat_pow_lemma (q : ℚ) (e : ℕ) :
  (q ^ e).num = q.num ^ e ∧ (q ^ e).denom = q.denom ^ e :=
  begin
    induction e,
    {
      simp,
    },
    {
      repeat { rw pow_succ, },
      rw [←e_ih.1, ←e_ih.2, rat_pow_denom_lemma, rat_pow_num_lemma],
      split,
      repeat { refl, },
      repeat {
        rw e_ih.2,
        exact nat.coprime.pow_right _ q.cop,
      },
      repeat {
        rw [e_ih.1, int.nat_abs_pow],
        exact nat.coprime.pow_left _ q.cop,
      },
    },
  end

lemma abs_pow_eq_pow_of_even_exp :
  ∀ {i : ℤ} {e : ℕ}, even e → ↑i.nat_abs ^ e = i ^ e :=
  begin
    intros i _ h,
    rw ←int.abs_eq_nat_abs,
    exact even.pow_abs h i,
  end

lemma pow_ord_lemma : ∀ (e ≥ 1), ∀ {a b : ℕ}, a ^ e < b ^ e → a < b :=
  begin
    intros e e_ge_1 a b h',
    by_contra' h₁,
    cases eq_or_lt_of_le h₁ with h₁ h₁,
    {
      rw [← h₁, lt_self_iff_false (b ^ e)] at h',
      exact h',
    },
    {
      exact (lt_self_iff_false (a ^ e)).1 (lt_trans h' (nat.pow_lt_pow_of_lt_left h₁ e_ge_1)),
    },
  end

lemma ord_lemma : ∀ n : ℕ, ¬ ∃ m : ℕ, n < m ∧ m < n + 1 :=
  begin
    rintros n ⟨m, h⟩,
    exact (lt_self_iff_false (n + 1)).1 (lt_of_le_of_lt (by linarith : n + 1 ≤ m) h.2),
  end

  lemma sord_mul_lem : ∀ {a b c d : ℕ}, a < c → b < d → a * b < c * d :=
  begin
    intros a b c d,
    revert a b c,
    induction d,
    {
      introv,
      intros _ h,
      exfalso,
      exact not_lt_zero' h,
    },
    {
      introv,
      intros h₁ h₂,
      by_cases h₃ : b < d_n,
      {
        have i : c * d_n.succ = c * d_n + c,
        refl,
        rw i,
        apply lt_trans (d_ih h₁ h₃),
        rw lt_add_iff_pos_right (c * d_n),
        cases c,
        {
          exfalso,
          exact not_lt_zero' h₁,
        },
        {
          exact succ_pos',
        },
      },
      {
        cases eq_or_lt_of_le ((lt_succ_iff.mp h₂) : b ≤ d_n) with h h,
        {
          rw ←h,
          induction c,
          {
            exfalso,
            exact not_lt_zero' h₁,
          },
          {
            by_cases h₄ : a < c_n,
            {
              rw add_one_mul,
              exact lt_trans (c_ih h₄) (lt_add_of_pos_right _ succ_pos'),
            },
            {
              cases eq_or_lt_of_le ((lt_succ_iff.mp h₁) : a ≤ c_n) with h' h',
              {
                rw [←h', add_one_mul, (_ : a * b.succ = a * b + a), nat.add_assoc (a * b) a b.succ],
                apply lt_add_of_pos_right,
                simp only [add_pos_iff, succ_pos', or_true],
                refl,
              },
              {
                exfalso,
                exact h₄ h',
              }
            },
          }
        },
        {
          exfalso,
          exact h₃ h,
        },
      },
    },
  end

lemma ord_mul_lem : ∀ {a b c d : ℕ}, a ≥ b → c ≥ d → a * c ≥ b * d :=
  begin
    introv,
    intros h h',
    cases eq_or_lt_of_le h with h₁ h₁;
    cases eq_or_lt_of_le h' with h₂ h₂,
    repeat {
      rw h₁,
      exact nat.mul_le_mul_left _ h',
    },
    repeat {
      rw h₂,
      exact nat.mul_le_mul_right _ h,
    },
    have := sord_mul_lem h₁ h₂,
    linarith,
  end

lemma neg_odd_pow_lemma {q : ℚ} {e₁ : ℕ} : q < 0 → odd e₁ → q ^ e₁ < 0 :=
  begin
    intros q_le_0 e₁_odd,

    induction e₁ using nat.strong_induction_on with e₁ ih,
    {
      simp only [odd_iff_not_even] at ih,
      unfold odd at e₁_odd,
      rcases e₁_odd with ⟨k,h'⟩,
      rw h',
      cases k,
      {
        rw [mul_zero, pow_one],
        exact q_le_0,
      },
      {
        rw
          [
            ←nat.add_one, nat.left_distrib, mul_one,
            pow_succ, pow_succ, ←rat.mul_assoc, mul_neg_iff
          ],
        left,
        split,
        {
          rw mul_self_pos,
          linarith,
        },
        {
          apply ih (2 * k + 1),
          {
            rw [h', add_lt_add_iff_right, mul_lt_mul_left succ_pos'],
            exact lt_add_one k,
          },
          {
            rw ←nat.odd_iff_not_even,
            unfold odd,
            use k,
          },
        },
      },
    },
  end


import topology.constructions

/-
In this file, we define notation `X^n` to take powers of types.
By definition, `X^n` is modelled as functions from `fin n` to `X`.
-/

/-- A definition of powers of a type. -/
def type_pow : has_pow (Type*) ℕ := ⟨λ A n, fin n → A⟩

namespace type_pow_topology

local attribute [instance] type_pow

variables (z : ℤ) (A : Type) [add_comm_group A] (n : ℕ) (x : A^n)

instance topological_space {n : ℕ} {α : Type*} [topological_space α] : topological_space (α^n) :=
  Pi.topological_space

--instance {n : ℕ} {α : Type*} [topological_space α] [discrete_topology α] : discrete_topology (α^n) := admit

end type_pow_topology

namespace add_monoid_hom

universes u v

local attribute [instance] type_pow

/-- The group homomorphism `A^n →+ B^n` induced by a group homomorphism `A →+ B`. -/
def pow {A : Type u} [add_comm_group A] {B : Type u} [add_comm_group B]
  (φ : A →+ B) (n : ℕ) : A^n →+ B^n :=
{ to_fun := (∘) φ,
  map_zero' := funext (λ _, φ.map_zero),
  map_add' := λ _ _, funext (λ _, φ.map_add _ _) }

lemma pow_eval {A : Type u} [add_comm_group A] {B : Type u} [add_comm_group B]
  (φ : A →+ B) (n : ℕ) (as : A ^ n) (i : fin n) : φ.pow n as i = φ (as i) := rfl

open_locale big_operators

/-- The group homomorphism `A^n →+ B` induced by `n` group homs `A →+ B` -/
def pow_hom {A : Type u} [add_comm_group A] {B : Type u} [add_comm_group B]
  {n : ℕ} (φ : fin n → A →+ B) : (A^n →+ B) :=
{ to_fun := λ z, ∑ (i : fin n), φ i (z i),
  map_zero' := by simp only [pi.zero_apply, finset.sum_const_zero, map_zero],
  map_add' := λ x y, begin
    rw [← finset.sum_add_distrib],
    simp,
  end }

end add_monoid_hom

local attribute [instance] type_pow

/-- The natural bijection `(A^m)^n ≃ (A^n)^m`. -/
def pow_pow {A : Type*} {m n : ℕ} : (A^m)^n ≃ (A^n)^m :=
{ to_fun := λ f i j, f j i,
  inv_fun := λ f j i, f i j,
  left_inv := λ _, rfl,
  right_inv := λ _, rfl }

/-- The natural bijection `A^n ≃ B^n` induced by a bijection `A ≃ B`.-/
def pow_equiv {A B : Type*} (e : A ≃ B) {n : ℕ} : A^n ≃ B^n :=
{ to_fun := λ f i, e (f i),
  inv_fun := λ g i, e.symm (g i),
  left_inv := λ f, funext (λ i, equiv.symm_apply_apply _ _),
  right_inv := λ g, funext (λ i, equiv.apply_symm_apply _ _) }

#lint- only unused_arguments def_lemma doc_blame


-- This file is for undergraduate mathematicians who want to see the
-- proof that one of the axioms that Lean uses to define a group
-- actually follows from the others.

-- G comes with notation * (group law) 1 (identiy) and a⁻¹ (inverse)
-- mul : G → G → G := λ g h, g * h
-- one : G := 1
-- inv : G → G := λ a, a⁻¹

class has_group_notation (G : Type) extends has_mul G, has_one G, has_inv G

-- definition of the group' structure
class group' (G : Type) extends has_group_notation G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)
-- Lean 3.4.1 also uses mul_one : ∀ (a : G), a * 1 = a , but we'll see we can deduce it!
-- Note : this doesn't matter at all :-)

namespace group'
variables {G : Type} [group' G]

-- We prove left_mul_cancel for group'

lemma mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c :=
λ (a b c : G) (Habac : a * b = a * c), -- got to deduce b = c.
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : by rw mul_left_inv
    ... = a⁻¹ * (a * b) : by rw mul_assoc
    ... = a⁻¹ * (a * c) : by rw Habac
    ... = (a⁻¹ * a) * c : by rw mul_assoc
    ... = 1 * c         : by rw mul_left_inv
                ... = c : by rw one_mul

theorem mul_one : ∀ (a : G), a * 1 = a :=
begin
intro a, -- goal is a * 1 = a
 apply mul_left_cancel a⁻¹, -- goal now a⁻¹ * (a * 1) = a⁻¹ * a
 exact calc a⁻¹ * (a * 1) = (a⁻¹ * a) * 1 : by rw mul_assoc
 ...                      = 1 * 1         : by rw mul_left_inv
 ...                      = 1             : by rw one_mul
 ...                      = a⁻¹ * a       : by rw mul_left_inv
 end

-- when you're better at driving this thing you just write this:
theorem group'.mul_one' : ∀ (a : G), a * 1 = a :=
λ a, mul_left_cancel a⁻¹ _ _ (by rw [←mul_assoc,mul_left_inv,one_mul])

end group'


variables p q r : Prop

-- * commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p := iff.intro
(assume h₁: p ∧ q,
 show q ∧ p, from ⟨h₁.right, h₁.left⟩)
(assume h₂: q ∧ p,
show p ∧ q, from  ⟨h₂.right, h₂.left⟩)

example : p ∨ q ↔ q ∨ p := iff.intro
(assume h1: p ∨ q,
  or.elim h1
    (assume hp : p,
    show q ∨ p, from or.inr hp) -- I do think this is way more readable
    (assume hq : q,
    show q ∨ p, from or.inl hq))
(assume h2: q ∨ p,
  or.elim h2
    (assume hq : q, or.inr hq) -- Than this
    (assume hp : p, or.inl  hp))

-- * associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := iff.intro
(assume h1 :(p ∧ q) ∧ r,
⟨h1.left.left, h1.left.right, h1.right⟩)
(assume h2 : p ∧ (q ∧ r),
⟨⟨h2.left, h2.right.left⟩, h2.right.right⟩)

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := iff.intro
(assume h1,
or.elim h1
  (assume hpq,
     or.elim hpq
       (assume hp, or.inl hp)
       (assume hq, or.inr (or.inl hq))) -- that was tricky wtf
  (assume hr, or.inr (or.inr hr)))
(assume h2,
  h2.elim
  (assume hp, or.inl (or.inl hp) )
  (assume hqr, hqr.elim
    (assume hq, or.inl (or.inr hq))
    (assume hr, or.inr hr)))

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := iff.intro
(assume h1,
  have hp:p, from h1.left,
  h1.right.elim
    (assume hq, or.inl ⟨hp,hq⟩)
    (assume hr, or.inr ⟨hp, hr⟩))
(assume h2, h2.elim
  (assume hpq,
    ⟨hpq.left, or.inl hpq.right⟩)
  (assume hpr, ⟨hpr.left, or.inr hpr.right⟩))

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := iff.intro
(assume h1, h1.elim
  (assume hp, ⟨or.inl hp, or.inl hp⟩)
  (assume hqr,⟨or.inr hqr.left, or.inr hqr.right⟩)) --
(assume h2,
  h2.left.elim
    (assume hp, or.inl hp)
    (assume hq,
      h2.right.elim
        (assume hp,or.inl hp )
        (assume hr, or.inr ⟨hq,hr⟩)))
-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := iff.intro
  (assume h1,
    assume pq,
      h1 pq.left pq.right) -- (assume h1, λ pq, (h1 pq.1 pq.2 )) was my first try.
  (assume h2, assume ifp, assume ifq, h2 ⟨ifp, ifq⟩)

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  iff.intro
    (assume h1,
      and.intro   -- this one is very relevant, I had
          (assume hp, h1 (or.inl hp)) -- gotten stuck with the and in the goal!
          (assume hq, h1 (or.inr hq)))
    (assume h2,
      assume porq,
        porq.elim
          (assume hp, h2.left hp)
          (assume hq, h2.right hq))

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  iff.intro
    (assume h1,
      and.intro
        (assume hp, h1 (or.inl hp))
        (assume hq, h1 (or.inr hq)))
    (assume h2,
      assume porq,
             porq.elim
               (assume hp, h2.left hp)
               (assume hq, h2.right hq))

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
  assume h1,
  assume h2,
  h1.elim
    (assume notp, notp h2.left)
    (assume notq, notq h2.right)

example : ¬(p ∧ ¬p) :=
  assume h1, absurd h1.left h1.right

example : p ∧ ¬q → ¬(p → q) :=
  assume hp_and_nq,
  assume hp_then_q,
    hp_and_nq.right (hp_then_q hp_and_nq.left)

example : ¬p → (p → q) :=
  assume hnotp,
  assume hp,
    absurd hp hnotp

example : (¬p ∨ q) → (p → q) :=
  assume hnotp_or_q,
  assume hp,
    hnotp_or_q.elim
      (assume hnotp, absurd hp hnotp)
      (assume hq, hq)

example : p ∨ false ↔ p :=
  iff.intro
  (assume hp_or_false, hp_or_false.elim
    (assume hp,hp)
    (assume f, f.elim))
  (assume hp, or.inl hp)

example : p ∧ false ↔ false :=
  iff.intro
  (assume hp_and_false, hp_and_false.right)
  (assume f, f.elim)

example : (p → q) → (¬q → ¬p) :=
  assume hifp_then_q,
  assume hnot_q,
  assume hp,  absurd (hifp_then_q hp) hnot_q

-- couldnt do this one
 -- example : ¬(p ↔ ¬p) := assume h,

open classical

variables  s : Prop

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
  assume h, or.elim (em p)
    (assume hp, (h hp).elim
      (assume hr,
        have hpr : p → r, from λ _:p, hr,
        or.inl hpr)
      (assume hs,
        have hps : p → s, from λ _:p, hs,
        or.inr hps ))
    (assume hnotp,
    suffices hp_then_r : p → r,
    from or.inl hp_then_r, -- I still dont get this completely
      assume hp:p, absurd hp hnotp)

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
  assume h, or.elim (em p)
  (assume hp,
    or.elim (em q) -- that was tricky again
      (assume hq, (h ⟨hp, hq⟩).elim)
      (assume hnotq,or.inr hnotq))
  (assume hnotp, or.inl hnotp)

example : ¬(p → q) → p ∧ ¬q :=
assume h,
    or.elim (em q )
      (assume hq,
        have hpq : p → q, from λ _:p, hq,
        absurd hpq h)
      (assume hnotq,
        or.elim (em p)
          (assume hp, ⟨hp, hnotq⟩ )
          (assume hnotp,
            suffices hptoq : p → q, from  (h hptoq).elim,
              assume hpagain:p, absurd hpagain hnotp))
            -- not happy with this suffices dark magic

-- got bored
example : (p → q) → (¬p ∨ q) := sorry
example : (¬q → ¬p) → (p → q) := sorry

example : p ∨ ¬p :=
or.elim (em p)
(assume hp, or.inl hp) (assume hnotp, or.inr hnotp)

example : (((p → q) → p) → p) :=
  assume h, or.elim (em p )
    (assume hp, hp)
    (assume hnotp,
    have hpq : p → q, from (assume hp : p, absurd hp hnotp),
    absurd (h hpq) hnotp) -- this ↑↑ i got from the internet, it is ridiculous

-- All in all, I'm not happy with my understanding of have and suffices;
-- suffices is even worse gotta unerstand this fucker


import logic.basic
import algebra.order
import data.nat.basic

lemma ne_self_imp_false : ∀ (a : ℕ), a ≠ a → false :=
begin
    intro a,
    intro h,
    rw ne.def at h,
    rw ne_self_iff_false at h,
    exact h,
end

lemma gt_zero_of_ne_zero : ∀ (a : ℕ), a ≠ 0 → 0 < a :=
begin
    intro a,
    intro h,
    induction a with d hd,
    {
        exfalso,
        apply ne.irrefl,
        exact h,
    },
    {
        apply lt_of_le_not_le,
        {
            apply nat.le.intro,
            apply zero_add,
        },
        {
            intro h2,
            have h3 := nat.le.dest h2,
            cases h3 with n hn,
            have h4 := nat.eq_zero_of_add_eq_zero hn,
            have h5 := h4.left,
            have h6 := nat.succ_ne_zero d,
            rw ← h5 at h6,
            apply ne_self_imp_false,
            exact h6,
        },
    },
end

lemma ne_zero_iff_gt_zero : ∀ (a : ℕ), a ≠ 0 ↔ 0 < a :=
begin
    intro a,
    split,
    {
        apply gt_zero_of_ne_zero,
    },
    {
        intro h,
        apply ne_of_gt,
        exact h,
    },
end

lemma mul_left_cancel_0 (a b c : ℕ) (h: c ≠ 0) : a * c = b * c → a = b :=
begin
    have hc := gt_zero_of_ne_zero c h,
    intro h2,
    by_contradiction hab,
    rw ← ne.def at hab,
    rw ne_iff_lt_or_gt at hab,
    cases hab,
    repeat {
        have h3 := mul_lt_mul_of_pos_right hab hc,
        have h4 := ne_of_lt h3,
        rw h2 at h4,
        apply ne_self_imp_false,
        exact h4,
    },
end

lemma ge_zero (n : ℕ) : 0 ≤ n :=
begin
    apply @nat.le.intro 0 n n,
    rw zero_add,
end

lemma one_or_two (n : ℕ) (h: 0 < n ∧ n ≤ 2) : n = 1 ∨ n = 2 :=
begin
    have h2 := @classical.or_not (n ≥ 2),
    cases h2,
    {
        right,
        apply eq_iff_le_not_lt.2,
        split,
        {
            exact and.right h,
        },
        {
            apply not_lt_of_ge,
            exact h2,
        },
    },
    {
        left,
        apply eq_iff_le_not_lt.2,
        split,
        {
            apply nat.le_of_lt_succ,
            apply lt_of_not_ge,
            exact h2,
        },
        {
            apply not_lt_of_ge,
            apply nat.le_of_lt_succ,
            apply nat.succ_lt_succ,
            exact and.left h,
        },
    },
end

lemma zero_or_one (a : ℕ) : a = 0 ∨ a = 1 ↔ a < 2 :=
begin
    split,
    {
        intro h,
        cases h,
        {
            rw h,
            apply nat.lt_of_succ_le,
            apply le_of_lt,
            apply nat.lt_of_succ_le,
            refl,
        },
        {
            rw h,
            apply nat.lt_of_succ_le,
            refl,
        },
    },
    {
        intro h,
        cases (@classical.or_not (a ≥ 1)) with h2 h2n,
        {
            right,
            apply eq_iff_le_not_lt.2,
            split,
            {
                apply nat.le_of_lt_succ,
                exact h,
            },
            {
                apply not_lt_of_ge,
                exact h2
            },
        },
        {
            left,
            apply eq_iff_le_not_lt.2,
            split,
            {
                apply nat.le_of_lt_succ,
                apply lt_of_not_ge,
                exact h2n,
            },
            {
                apply not_lt_of_ge,
                apply ge_zero,
            },
        },
    },
end

lemma gt_zero_of_eq_one (n : ℕ) : n = 1 → 0 < n :=
begin
    intro h,
    rw h,
    apply lt_add_one,
end


/-
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 `nat.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, ←eq_nat_cast (algebra_map ℕ S),
    eval₂_at_nat_cast, nat.cast_id, 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, polynomial.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