/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module data.nat.factorial.cast
! leanprover-community/mathlib commit d50b12ae8e2bd910d08a94823976adae9825718b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.RingTheory.Polynomial.Pochhammer

/-!
# Cast of factorials

This file allows calculating factorials (including ascending and descending ones) as elements of a
semiring.

This is particularly crucial for `Nat.descFactorial` as subtraction on `ℕ` does **not** correspond
to subtraction on a general semiring. For example, we can't rely on existing cast lemmas to prove
`↑(a.descFactorial 2) = ↑a * (↑a - 1)`. We must use the fact that, whenever `↑(a - 1)` is not equal
to `↑a - 1`, the other factor is `0` anyway.
-/

open Nat

variable (S : Type _)

namespace Nat

section Semiring

variable [Semiring S] (a b : ℕ)

-- Porting note: added type ascription around a + 1
theorem cast_ascFactorial : (a.ascFactorial b : S) = (pochhammer S b).eval (a + 1 : S) := by
  rw [← pochhammer_nat_eq_ascFactorial, pochhammer_eval_cast, Nat.cast_add, Nat.cast_one]
#align nat.cast_asc_factorial Nat.cast_ascFactorial

-- Porting note: added type ascription around a - (b - 1)
theorem cast_descFactorial : (a.descFactorial b : S) = (pochhammer S b).eval (a - (b - 1) : S) := by
  rw [← pochhammer_eval_cast, pochhammer_nat_eq_descFactorial]
  induction' b with b
  · simp
  · simp_rw [add_succ, succ_sub_one]
    obtain h | h := le_total a b
    · rw [descFactorial_of_lt (lt_succ_of_le h), descFactorial_of_lt (lt_succ_of_le _)]
      rw [tsub_eq_zero_iff_le.mpr h, zero_add]
    · rw [tsub_add_cancel_of_le h]
#align nat.cast_desc_factorial Nat.cast_descFactorial

theorem cast_factorial : (a ! : S) = (pochhammer S a).eval 1 := by
  rw [← zero_ascFactorial, cast_ascFactorial, cast_zero, zero_add]
#align nat.cast_factorial Nat.cast_factorial

end Semiring

section Ring

variable [Ring S] (a b : ℕ)

/-- Convenience lemma. The `a - 1` is not using truncated subtraction, as opposed to the definition
of `Nat.descFactorial` as a natural. -/
theorem cast_descFactorial_two : (a.descFactorial 2 : S) = a * (a - 1) := by
  rw [cast_descFactorial]
  cases a
  · simp
  · rw [succ_sub_succ, tsub_zero, cast_succ, add_sub_cancel, pochhammer_succ_right, pochhammer_one,
      Polynomial.X_mul, Polynomial.eval_mul_X, Polynomial.eval_add, Polynomial.eval_X, cast_one,
      Polynomial.eval_one]
#align nat.cast_desc_factorial_two Nat.cast_descFactorial_two

end Ring

end Nat


/-
Quick&dirty port of some parts of `data.equiv.basic` from Lean 3.

Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/

import mathlib4_experiments.Data.Notation

set_option autoBoundImplicitLocal false

universes u₁ u₂ u₃ u₄ v

structure Equiv (α : Sort u₁) (β : Sort u₂) where
(toFun    : α → β)
(invFun   : β → α)
(leftInv  : ∀ x, invFun (toFun x) = x)
(rightInv : ∀ y, toFun (invFun y) = y)

namespace Equiv

instance : HasEquivalence (Sort u₁) (Sort u₂) := ⟨Equiv⟩
instance (α : Sort u₁) (β : Sort u₂) : CoeFun (α ≃ β) (λ _ => α → β) := ⟨Equiv.toFun⟩

def refl (α : Sort u₁) : α ≃ α := ⟨id, id, λ x => rfl, λ y => rfl⟩

def symm {α : Sort u₁} {β : Sort u₂} (e : α ≃ β) : β ≃ α := ⟨e.invFun, e.toFun, e.rightInv, e.leftInv⟩

theorem trans_leftInv {α : Sort u₁} {β : Sort u₂} {γ : Sort u₃} (e₁ : α ≃ β) (e₂ : β ≃ γ) (x : α) :
  e₁.invFun (e₂.invFun (e₂.toFun (e₁.toFun x))) = x :=
Eq.trans (congrArg e₁.invFun (e₂.leftInv (e₁.toFun x))) (e₁.leftInv x)

def trans {α : Sort u₁} {β : Sort u₂} {γ : Sort u₃} (e₁ : α ≃ β) (e₂ : β ≃ γ) : α ≃ γ :=
⟨e₂.toFun ∘ e₁.toFun, e₁.invFun ∘ e₂.invFun, trans_leftInv e₁ e₂, trans_leftInv (symm e₂) (symm e₁)⟩

variable {α : Sort u₁} {β : Sort u₂} {γ : Sort u₃} {δ : Sort u₄}

@[simp] theorem symm_symm (e : α ≃ β) : symm (symm e) = e := match e with
| ⟨toFun, invFun, leftInv, rightInv⟩ => rfl

@[simp] theorem trans_refl (e : α ≃ β) : trans e (refl β) = e := match e with
| ⟨toFun, invFun, leftInv, rightInv⟩ => rfl

@[simp] theorem refl_symm : symm (refl α) = refl α := rfl

@[simp] theorem refl_trans (e : α ≃ β) : trans (refl α) e = e := match e with
| ⟨toFun, invFun, leftInv, rightInv⟩ => rfl

@[simp] theorem symm_trans (e : α ≃ β) : trans (symm e) e = refl β :=
let h₁ : e.toFun ∘ e.invFun = id := funext e.rightInv;
-- Need to figure out how to recover injectivity of constructors in Lean 4.
sorry

@[simp] theorem trans_symm (e : α ≃ β) : trans e (symm e) = refl α := symm_trans (symm e)

@[simp] theorem symm_trans_symm (ab : α ≃ β) (bc : β ≃ γ) :
  symm (trans ab bc) = trans (symm bc) (symm ab) := rfl

theorem trans_assoc (ab : α ≃ β) (bc : β ≃ γ) (cd : γ ≃ δ) :
  trans (trans ab bc) cd = trans ab (trans bc cd) := rfl

end Equiv


/-
WR Scott's Group Theory in Lean

Permutation Groups
-/
import .definitions

namespace permutations
variables {A M U : Type}

 definition injective (f : A → A) : Prop :=
    ∀ x y, f x = f y → x = y

-- a permutation of a set M is a 1-1 function into M onto M
-- Sym(M) is a set of permutation of M, (f : M → M) ∈ Sym(M)
-- Sym is a group, fg is the binary operation (function product)
class Sym (A : Type) :=
  (perms : set (A → A))
  (mult : (A → A) → (A → A) → (A → A))
  (symm : ∀ (f : (A → A)), (f ∈ perms) → injective f)
infix ∘ := Sym.mult

-- to prove subgroup, start with a set S
-- show that multiplication membership holds
-- show that one membership holds
-- show that inverse membership holds
class subgroup [definitions.Group (U → U)] (S : set (U → U)) : Prop :=
  (mul_mem : ∀ {a b}, a ∈ S → b ∈ S → a * b ∈ S)
  (one_mem : definitions.Group.one ∈ S)
  (inv_mem: ∀ {a}, a ∈ S → (definitions.Group.inv a) ∈ S)

-- Exercise 1.3.1 if M is a set and Sym M is a set of permutations of M,
-- the Sym M is a group
theorem is_group [definitions.Group (A → A)] [S : Sym A] : subgroup (S.perms) :=
begin
  refine {..},
  intros p p q r,
  -- proof that f * g ∈ S
  -- f ∘ g is a function by theorem
  -- prove that f * g is onto S
  -- prove that f * g is one - to - one
  -- then f ∘ g is a permutation of M
  repeat {sorry},
end
end permutations


/- 10 Feb 2020 -/
-- srgs
-- box product
-- hamming graph
-- triangular graph
-- paley graph
import combinatorics.simple_graph.basic

universes u v
variables (V : Type u) {W : Type u}

namespace simple_graph

variables {V}

/-
The box product of `G : simple_graph V` and `H : simple_graph W` is a graph on `V × W` such that
`(x.1, w1)` is adjacent to `(y.1, y.2)` when `x.1 = y.1` and `H.adj w1 y.2` or `G.adj x.1 y.1` and `w1 = y.2`.
In other words, the vertices differ by one coordinate.
-/
def box_product (G : simple_graph V) (H : simple_graph W) : simple_graph (V × W) :=
{ adj := λ x y, (x.1 = y.1 ∧ H.adj x.2 y.2) ∨ (G.adj x.1 y.1 ∧ x.2 = y.2),
  sym := λ x y h,
    begin
      cases h with hv hw,
      { left,
        exact ⟨eq.symm hv.1, (H.edge_symm x.2 y.2).1 hv.2⟩ },
      { right,
        exact ⟨(G.edge_symm x.1 y.1).1 hw.1, eq.symm hw.2⟩ },
    end,
  loopless := λ ⟨v, w⟩ h,
    begin
      cases h with hw hv,
      { exact H.irrefl hw.2 },
      { exact G.irrefl hv.1 },
    end }

notation G ` □ ` := box_product G

variables (G : simple_graph V) [decidable_rel G.adj]

variables [decidable_eq V] [decidable_eq W]

instance decidable_rel_box_product (H : simple_graph W) [decidable_rel H.adj] : decidable_rel (G □ H).adj :=
λ _ _, or.decidable

variables [fintype V] [decidable_eq V]

/--
A graph is strongly regular with parameters `n k l m` if
 * its vertex set has cardinality `n`
 * it is regular with degree `k`
 * every pair of adjacent vertices has `l` common neighbors
 * every pair of nonadjacent vertices has `m` common neighbors
-/
structure is_SRG_of (n k l m : ℕ) : Prop :=
(card : fintype.card V = n)
(regular : G.is_regular_of_degree k)
(adj_common : ∀ (v w : V), G.adj v w → fintype.card (G.common_neighbors v w) = l)
(nadj_common : ∀ (v w : V), ¬ G.adj v w → fintype.card (G.common_neighbors v w) = m)

lemma hamming_srg : ((complete_graph V) □ (complete_graph V)).is_SRG_of ((fintype.card V)^2) (2*(fintype.card V - 1)) (fintype.card V - 2) 2 :=
begin
  sorry,
end

def incident (e f : sym2 V) : Prop := ∃ (v : V), v ∈ e ∧ v ∈ f

/-def line_graph (G : simple_graph V) : simple_graph G.edge_set :=
{ adj := λ e f, incident e f,
  sym := _,
  loopless := _ }-/

end simple_graph


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic
import data.real.basic
import analysis.calculus.parametric_integral

/-

# Basic calculus

-/

-- Thanks to Moritz Doll on the Zulip for writing this one!
/-- If `f : ℝ → ℝ` is differentiable at `x`, then the obvious induced function `ℝ → ℂ` is
also differentiable at `x`. -/
lemma complex.differentiable_at_coe {f : ℝ → ℝ} {x : ℝ } (hf : differentiable_at ℝ f x) :
  differentiable_at ℝ (λ y, (f y : ℂ)) x :=
begin
  apply complex.of_real_clm.differentiable_at.comp _ hf,
end

-- Here's a harder example
example (a : ℂ) (x : ℝ) : differentiable_at ℝ (λ (y : ℝ), complex.exp (-(a * ↑y ^ 2))) x :=
begin
  sorry,
end

noncomputable def φ₁ : ℝ → ℝ × ℝ :=
λ x, (real.cos x, real.sin x)

example : cont_diff_on ℝ ⊤ (λ x, (real.cos x, real.sin x)) (set.Icc 0 1) :=
begin
  sorry,
end


import tactic

lemma part_a : ¬ (∀ n k : ℕ, n > 0 → k > 0 → k ∣ n ^ k - n) :=
begin
  -- True for k prime
  intro h,
  specialize h 2 4,
  norm_num at h,
end

/-
  https://leanprover.zulipchat.com/#narrow/stream/116395-maths/topic/arithmetic.20timeout.20with.20a.5E2.2Bb.5E2.2Bc.5E2.3D7
  Thanks to Patrick Johnson
  Also a way via zmod by Alex J. Best
-/

lemma part_b : ¬ (∀ n : ℕ, n > 0 → ∃ a b c : ℕ, n = a^2 + b^2 + c^2) :=
begin
  -- True for n <= 6
  intro h,
  specialize h 7,
  have lt_three : ∀ {a b c : ℕ}, 7 = a ^ 2 + b ^ 2 + c ^ 2 → a < 3,
  { intros a b c h, nlinarith, },
  simp at h,
  rcases h with ⟨a, b, c, h⟩,
  have ha := lt_three h,
  have hb := lt_three (by linarith : 7 = b^2 + a^2 + c^2),
  have hc := lt_three (by linarith : 7 = c^2 + a^2 + b^2),
  interval_cases a; interval_cases b; interval_cases c; -- Generate 3 x 3 x 3 = 27 goals
  cases h,
end


/-
Copyright (c) 2018 . All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Thomas Browning
-/

import data.zmod.basic
import group_theory.index
import group_theory.group_action.conj_act
import group_theory.perm.cycle_type
import group_theory.quotient_group

/-!
# p-groups

This file contains a proof that if `G` is a `p`-group acting on a finite set `α`,
then the number of fixed points of the action is congruent mod `p` to the cardinality of `α`.
It also contains proofs of some corollaries of this lemma about existence of fixed points.
-/

open_locale big_operators

open fintype mul_action

variables (p : ℕ) (G : Type*) [group G]

/-- A p-group is a group in which every element has prime power order -/
def is_p_group : Prop := ∀ g : G, ∃ k : ℕ, g ^ (p ^ k) = 1

variables {p} {G}

namespace is_p_group

lemma iff_order_of [hp : fact p.prime] :
  is_p_group p G ↔ ∀ g : G, ∃ k : ℕ, order_of g = p ^ k :=
forall_congr (λ g, ⟨λ ⟨k, hk⟩, exists_imp_exists (by exact λ j, Exists.snd)
  ((nat.dvd_prime_pow hp.out).mp (order_of_dvd_of_pow_eq_one hk)),
  exists_imp_exists (λ k hk, by rw [←hk, pow_order_of_eq_one])⟩)

lemma of_card [fintype G] {n : ℕ} (hG : card G = p ^ n) : is_p_group p G :=
λ g, ⟨n, by rw [←hG, pow_card_eq_one]⟩

lemma of_bot : is_p_group p (⊥ : subgroup G) :=
of_card (subgroup.card_bot.trans (pow_zero p).symm)

lemma iff_card [fact p.prime] [fintype G] :
  is_p_group p G ↔ ∃ n : ℕ, card G = p ^ n :=
begin
  have hG : card G ≠ 0 := card_ne_zero,
  refine ⟨λ h, _, λ ⟨n, hn⟩, of_card hn⟩,
  suffices : ∀ q ∈ nat.factors (card G), q = p,
  { use (card G).factors.length,
    rw [←list.prod_repeat, ←list.eq_repeat_of_mem this, nat.prod_factors hG] },
  intros q hq,
  obtain ⟨hq1, hq2⟩ := (nat.mem_factors hG).mp hq,
  haveI : fact q.prime := ⟨hq1⟩,
  obtain ⟨g, hg⟩ := equiv.perm.exists_prime_order_of_dvd_card q hq2,
  obtain ⟨k, hk⟩ := (iff_order_of.mp h) g,
  exact (hq1.pow_eq_iff.mp (hg.symm.trans hk).symm).1.symm,
end

section G_is_p_group

variables (hG : is_p_group p G)

include hG

lemma of_injective {H : Type*} [group H] (ϕ : H →* G) (hϕ : function.injective ϕ) :
  is_p_group p H :=
begin
  simp_rw [is_p_group, ←hϕ.eq_iff, ϕ.map_pow, ϕ.map_one],
  exact λ h, hG (ϕ h),
end

lemma to_subgroup (H : subgroup G) : is_p_group p H :=
hG.of_injective H.subtype subtype.coe_injective

lemma of_surjective {H : Type*} [group H] (ϕ : G →* H) (hϕ : function.surjective ϕ) :
  is_p_group p H :=
begin
  refine λ h, exists.elim (hϕ h) (λ g hg, exists_imp_exists (λ k hk, _) (hG g)),
  rw [←hg, ←ϕ.map_pow, hk, ϕ.map_one],
end

lemma to_quotient (H : subgroup G) [H.normal] :
  is_p_group p (G ⧸ H) :=
hG.of_surjective (quotient_group.mk' H) quotient.surjective_quotient_mk'

lemma of_equiv {H : Type*} [group H] (ϕ : G ≃* H) : is_p_group p H :=
hG.of_surjective ϕ.to_monoid_hom ϕ.surjective

variables [hp : fact p.prime]

include hp

lemma index (H : subgroup G) [fintype (G ⧸ H)] :
  ∃ n : ℕ, H.index = p ^ n :=
begin
  obtain ⟨n, hn⟩ := iff_card.mp (hG.to_quotient H.normal_core),
  obtain ⟨k, hk1, hk2⟩ := (nat.dvd_prime_pow hp.out).mp ((congr_arg _
    (H.normal_core.index_eq_card.trans hn)).mp (subgroup.index_dvd_of_le H.normal_core_le)),
  exact ⟨k, hk2⟩,
end

variables {α : Type*} [mul_action G α]

lemma card_orbit (a : α) [fintype (orbit G a)] :
  ∃ n : ℕ, card (orbit G a) = p ^ n :=
begin
  let ϕ := orbit_equiv_quotient_stabilizer G a,
  haveI := fintype.of_equiv (orbit G a) ϕ,
  rw [card_congr ϕ, ←subgroup.index_eq_card],
  exact hG.index (stabilizer G a),
end

variables (α) [fintype α] [fintype (fixed_points G α)]

/-- If `G` is a `p`-group acting on a finite set `α`, then the number of fixed points
  of the action is congruent mod `p` to the cardinality of `α` -/
lemma card_modeq_card_fixed_points : card α ≡ card (fixed_points G α) [MOD p] :=
begin
  classical,
  calc card α = card (Σ y : quotient (orbit_rel G α), {x // quotient.mk' x = y}) :
    card_congr (equiv.sigma_preimage_equiv (@quotient.mk' _ (orbit_rel G α))).symm
  ... = ∑ a : quotient (orbit_rel G α), card {x // quotient.mk' x = a} : card_sigma _
  ... ≡ ∑ a : fixed_points G α, 1 [MOD p] : _
  ... = _ : by simp; refl,
  rw [←zmod.eq_iff_modeq_nat p, nat.cast_sum, nat.cast_sum],
  have key : ∀ x, card {y // (quotient.mk' y : quotient (orbit_rel G α)) = quotient.mk' x} =
    card (orbit G x) := λ x, by simp only [quotient.eq']; congr,
  refine eq.symm (finset.sum_bij_ne_zero (λ a _ _, quotient.mk' a.1) (λ _ _ _, finset.mem_univ _)
    (λ a₁ a₂ _ _ _ _ h, subtype.eq ((mem_fixed_points' α).mp a₂.2 a₁.1 (quotient.exact' h)))
      (λ b, quotient.induction_on' b (λ b _ hb, _)) (λ a ha _, by
      { rw [key, mem_fixed_points_iff_card_orbit_eq_one.mp a.2] })),
  obtain ⟨k, hk⟩ := hG.card_orbit b,
  have : k = 0 := nat.le_zero_iff.1 (nat.le_of_lt_succ (lt_of_not_ge (mt (pow_dvd_pow p)
    (by rwa [pow_one, ←hk, ←nat.modeq_zero_iff_dvd, ←zmod.eq_iff_modeq_nat, ←key])))),
  exact ⟨⟨b, mem_fixed_points_iff_card_orbit_eq_one.2 $ by rw [hk, this, pow_zero]⟩,
    finset.mem_univ _, (ne_of_eq_of_ne nat.cast_one one_ne_zero), rfl⟩,
end

/-- If a p-group acts on `α` and the cardinality of `α` is not a multiple
  of `p` then the action has a fixed point. -/
lemma nonempty_fixed_point_of_prime_not_dvd_card (hpα : ¬ p ∣ card α) :
  (fixed_points G α).nonempty :=
@set.nonempty_of_nonempty_subtype _ _ begin
rw [←card_pos_iff, pos_iff_ne_zero],
  contrapose! hpα,
  rw [←nat.modeq_zero_iff_dvd, ←hpα],
  exact hG.card_modeq_card_fixed_points α,
end

/-- If a p-group acts on `α` and the cardinality of `α` is a multiple
  of `p`, and the action has one fixed point, then it has another fixed point. -/
lemma exists_fixed_point_of_prime_dvd_card_of_fixed_point
  (hpα : p ∣ card α) {a : α} (ha : a ∈ fixed_points G α) :
  ∃ b, b ∈ fixed_points G α ∧ a ≠ b :=
have hpf : p ∣ card (fixed_points G α) :=
  nat.modeq_zero_iff_dvd.mp ((hG.card_modeq_card_fixed_points α).symm.trans hpα.modeq_zero_nat),
have hα : 1 < card (fixed_points G α) :=
  (fact.out p.prime).one_lt.trans_le (nat.le_of_dvd (card_pos_iff.2 ⟨⟨a, ha⟩⟩) hpf),
let ⟨⟨b, hb⟩, hba⟩ := exists_ne_of_one_lt_card hα ⟨a, ha⟩ in
⟨b, hb, λ hab, hba (by simp_rw [hab])⟩

lemma center_nontrivial [nontrivial G] [fintype G] : nontrivial (subgroup.center G) :=
begin
  classical,
  have := (hG.of_equiv conj_act.to_conj_act).exists_fixed_point_of_prime_dvd_card_of_fixed_point G,
  rw conj_act.fixed_points_eq_center at this,
  obtain ⟨g, hg⟩ := this _ (subgroup.center G).one_mem,
  { exact ⟨⟨1, ⟨g, hg.1⟩, mt subtype.ext_iff.mp hg.2⟩⟩ },
  { obtain ⟨n, hn⟩ := is_p_group.iff_card.mp hG,
    rw hn,
    apply dvd_pow_self,
    rintro rfl,
    exact (fintype.one_lt_card).ne' hn },
end

lemma bot_lt_center [nontrivial G] [fintype G] : ⊥ < subgroup.center G :=
begin
  haveI := center_nontrivial hG,
  classical,
  exact bot_lt_iff_ne_bot.mpr ((subgroup.center G).one_lt_card_iff_ne_bot.mp fintype.one_lt_card),
end

end G_is_p_group

lemma to_le {H K : subgroup G} (hK : is_p_group p K) (hHK : H ≤ K) : is_p_group p H :=
hK.of_injective (subgroup.inclusion hHK) (λ a b h, subtype.ext (show _, from subtype.ext_iff.mp h))

lemma to_inf_left {H K : subgroup G} (hH : is_p_group p H) : is_p_group p (H ⊓ K : subgroup G) :=
hH.to_le inf_le_left

lemma to_inf_right {H K : subgroup G} (hK : is_p_group p K) : is_p_group p (H ⊓ K : subgroup G) :=
hK.to_le inf_le_right

lemma map {H : subgroup G} (hH : is_p_group p H) {K : Type*} [group K]
  (ϕ : G →* K) : is_p_group p (H.map ϕ) :=
begin
  rw [←H.subtype_range, monoid_hom.map_range],
  exact hH.of_surjective (ϕ.restrict H).range_restrict (ϕ.restrict H).range_restrict_surjective,
end

lemma comap_of_ker_is_p_group {H : subgroup G} (hH : is_p_group p H) {K : Type*} [group K]
  (ϕ : K →* G) (hϕ : is_p_group p ϕ.ker) : is_p_group p (H.comap ϕ) :=
begin
  intro g,
  obtain ⟨j, hj⟩ := hH ⟨ϕ g.1, g.2⟩,
  rw [subtype.ext_iff, H.coe_pow, subtype.coe_mk, ←ϕ.map_pow] at hj,
  obtain ⟨k, hk⟩ := hϕ ⟨g.1 ^ p ^ j, hj⟩,
  rwa [subtype.ext_iff, ϕ.ker.coe_pow, subtype.coe_mk, ←pow_mul, ←pow_add] at hk,
  exact ⟨j + k, by rwa [subtype.ext_iff, (H.comap ϕ).coe_pow]⟩,
end

lemma ker_is_p_group_of_injective {K : Type*} [group K] {ϕ : K →* G} (hϕ : function.injective ϕ) :
  is_p_group p ϕ.ker :=
(congr_arg (λ Q : subgroup K, is_p_group p Q) (ϕ.ker_eq_bot_iff.mpr hϕ)).mpr is_p_group.of_bot

lemma comap_of_injective {H : subgroup G} (hH : is_p_group p H) {K : Type*} [group K]
  (ϕ : K →* G) (hϕ : function.injective ϕ) : is_p_group p (H.comap ϕ) :=
hH.comap_of_ker_is_p_group ϕ (ker_is_p_group_of_injective hϕ)

lemma comap_subtype {H : subgroup G} (hH : is_p_group p H) {K : subgroup G} :
  is_p_group p (H.comap K.subtype) :=
hH.comap_of_injective K.subtype subtype.coe_injective

lemma to_sup_of_normal_right {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  [K.normal] : is_p_group p (H ⊔ K : subgroup G) :=
begin
  rw [←quotient_group.ker_mk K, ←subgroup.comap_map_eq],
  apply (hH.map (quotient_group.mk' K)).comap_of_ker_is_p_group,
  rwa quotient_group.ker_mk,
end

lemma to_sup_of_normal_left {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  [H.normal] : is_p_group p (H ⊔ K : subgroup G) :=
(congr_arg (λ H : subgroup G, is_p_group p H) sup_comm).mp (to_sup_of_normal_right hK hH)

lemma to_sup_of_normal_right' {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  (hHK : H ≤ K.normalizer) : is_p_group p (H ⊔ K : subgroup G) :=
let hHK' := to_sup_of_normal_right (hH.of_equiv (subgroup.comap_subtype_equiv_of_le hHK).symm)
  (hK.of_equiv (subgroup.comap_subtype_equiv_of_le subgroup.le_normalizer).symm) in
((congr_arg (λ H : subgroup K.normalizer, is_p_group p H)
  (subgroup.sup_subgroup_of_eq hHK subgroup.le_normalizer)).mp hHK').of_equiv
  (subgroup.comap_subtype_equiv_of_le (sup_le hHK subgroup.le_normalizer))

lemma to_sup_of_normal_left' {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
  (hHK : K ≤ H.normalizer) : is_p_group p (H ⊔ K : subgroup G) :=
(congr_arg (λ H : subgroup G, is_p_group p H) sup_comm).mp (to_sup_of_normal_right' hK hH hHK)

/-- finite p-groups with different p have coprime orders -/
lemma coprime_card_of_ne {G₂ : Type*} [group G₂]
  (p₁ p₂ : ℕ) [hp₁ : fact p₁.prime] [hp₂ : fact p₂.prime] (hne : p₁ ≠ p₂)
  (H₁ : subgroup G) (H₂ : subgroup G₂) [fintype H₁] [fintype H₂]
  (hH₁ : is_p_group p₁ H₁) (hH₂ : is_p_group p₂ H₂) :
  nat.coprime (fintype.card H₁) (fintype.card H₂) :=
begin
  obtain ⟨n₁, heq₁⟩ := iff_card.mp hH₁, rw heq₁, clear heq₁,
  obtain ⟨n₂, heq₂⟩ := iff_card.mp hH₂, rw heq₂, clear heq₂,
  exact nat.coprime_pow_primes _ _ (hp₁.elim) (hp₂.elim) hne,
end

/-- p-groups with different p are disjoint -/
lemma disjoint_of_ne (p₁ p₂ : ℕ) [hp₁ : fact p₁.prime] [hp₂ : fact p₂.prime] (hne : p₁ ≠ p₂)
  (H₁ H₂ : subgroup G) (hH₁ : is_p_group p₁ H₁) (hH₂ : is_p_group p₂ H₂) :
  disjoint H₁ H₂ :=
begin
  rintro x ⟨hx₁, hx₂⟩,
  rw subgroup.mem_bot,
  obtain ⟨n₁, hn₁⟩ := iff_order_of.mp hH₁ ⟨x, hx₁⟩,
  obtain ⟨n₂, hn₂⟩ := iff_order_of.mp hH₂ ⟨x, hx₂⟩,
  rw [← order_of_subgroup, subgroup.coe_mk] at hn₁ hn₂,
  have : p₁ ^ n₁ = p₂ ^ n₂, by rw [← hn₁, ← hn₂],
  have : n₁ = 0,
  { contrapose! hne with h,
    rw ← associated_iff_eq at this ⊢,
    exact associated.of_pow_associated_of_prime
      (nat.prime_iff.mp hp₁.elim) (nat.prime_iff.mp hp₂.elim) (ne.bot_lt h) this },
  simpa [this] using hn₁,
end

end is_p_group


/-
The complex numbers.
A documented remix of part of mathlib

Our goal is to define the complex numbers, and then "extract some API".
Our first goal is to define addition and multiplication,
and prove that the complex numbers are a commutative ring.
We then do a slightly more computer-sciency worked development of the
natural inclusion from the reals to the complexes.

There are then a bunch of API-building exercises, which can be solved in term mode
or tactic mode. The first is `I`, the second is complex conjugation,
and the third is the "squared norm" function.

There is then a speculative last exercise on harder properties
of the complexes.
-/

-- We will assume that the real numbers are a field.
import data.real.basic

/-- A complex number is defined to be a structure consisting of two real numbers,
    the real part and the imaginary part of the complex number   . -/
structure complex : Type :=
(re : ℝ) (im : ℝ)

-- Let's use the usual notation for the complex numbers
notation `ℂ` := complex

-- You make the complex number with real part 3 and imaginary part 4 like this:
example : ℂ :=
{ re := 3,
  im := 4 }

-- Or like this:
example : ℂ := complex.mk 3 4

-- or like this:
example : ℂ := ⟨3, 4⟩

-- They all give the same complex number.

-- If you have a complex number, then you can get its real and
-- imaginary parts with the `complex.re` and `complex.im` functions.

example : ℝ := complex.re(complex.mk 3 4) -- this term is (3 : ℝ)

example : complex.re(complex.mk 3 4) = 3 := rfl -- true by definition.

-- We clearly don't want to be constantly saying `complex.blah` so let's
-- move into the `complex` namespace

namespace complex

-- All our theorems and definitions will now be called complex.something,
-- and we can in general just drop `complex.`

-- For example

example : re(mk 3 4) = 3 := rfl

-- Computer scientists prefer the style `z.re` to `re(z)` for some reason.

example : (mk 3 4).re = 3 := rfl

example (z : ℂ) : re(z) = z.re := rfl

-- We now prove the basic theorems and make the basic definitions for
-- complex numbers. For example, we will define addition and multiplication on
-- the complex numbers, and prove that it is a commutative ring.

/-! # Mathematical trivialities -/

/-! ## The first triviality -/

-- We start with some facts about complex numbers which are so obvious that we do not
-- often explicitly state them. The first is that if z is a complex number, then
-- the complex number with real part re(z) and imaginary part im(z) is equal to z.
-- This is called eta reduction in type theory. Let's work through the
-- simple tactic mode proof.

example : ∀ z : ℂ, complex.mk z.re z.im = z :=
begin
  intro z,
  cases z with x y,
  -- goal now looks complicated, and contains terms which look
  -- like {re := a, im := b}.re which obviously simplify to a.
  -- The `dsimp` tactic will do some tidying up for us, although
  -- it is not logically necessary. `dsimp` does definitional simplification.
  dsimp,
  -- Now we see the goal can be solved by reflexivity
  refl,
end

-- The proof was "unfold everything, and it's true by definition".
-- This proof does not teach a mathematician anything, so we may as well write
-- it in term mode, because each tactic has a term equivalent.
-- The equation compiler does the `intro` and `cases` steps,
-- and `dsimp` was unnecessary -- the two sides of the equation
-- were definitionally equal.

@[simp] theorem eta : ∀ z : ℂ, complex.mk z.re z.im = z
| ⟨x, y⟩ := rfl

/-! ### Digression on `simp` -/

-- It's important we give this theorem a name (and we called it `eta`
-- because that's what computer scientists call lemmas of this form).
-- The reason it's important is that we want `simp`
-- to be able to use it. In short, the `simp` tactic tries to solve
-- goals of the form A = B, when `refl` doesn't work (i.e. the goals are
-- not definitionally equal) but when any mathematician would be able
-- to simplify A and B via "obvious" steps such as `0 + x = x` or
-- `⟨z.re, z.im⟩ = z`. These things are sometimes not true by definition,
-- but they should be tagged as being well-known ways to simplify an equality.
-- When building our API for the complex numbers, if we prove a theorem of the
-- form `A = B` where `B` is a bit simpler than `A`, we should probably
-- tag it with the `@[simp]` attribute, so `simp` can use it.

-- Note: `simp` does *not* prove "all simple things". It proves *equalities*.
-- It proves `A = B` when, and only when, it can do it by applying
-- its "simplification rules", where a simplification rule is simply a proof
-- of a theorem of the form `A = B` and `B` is simpler than `A`.

/-! ## The second triviality -/

-- The second triviality is the assertion that two complex numbers
-- with the same and imaginary parts are equal. Again this is not
-- hard to prove, and mathematicians deem it not worth documenting.

example (z w : ℂ) : z.re = w.re → z.im = w.im → z = w :=
begin
  cases z with zr zi,
  cases w,
  intros, cc,
end

-- This lemma is called extensionality by type theorists.
-- Here is another tactic mode proof. Note that we have moved
-- the z and w to the other side of the colon; this does not
-- change the fully expanded proof term. It shows the power
-- of the `rintros` tactic.

example : ∀ z w : ℂ, z.re = w.re → z.im = w.im → z = w :=
begin
  rintros ⟨zr, zi⟩ ⟨_, _⟩ ⟨rfl⟩ ⟨rfl⟩,
  refl,
end

-- `rintros` does `cases` as many times as you like using this cool `⟨, ⟩` syntax
-- for the case splits. Note that if you do cases on `h : a = b` then, because
-- `=` is notation for `eq`, an inductive type with one constructor `a = a`,
-- it will just delete `b` and change all `b`s to `a`s. That is one of the
-- things going on in the above proof.

-- Here is the same proof in term mode. Even though it's obvious, we still
-- give it a name, namely `ext`. It's important to prove it, so we can
-- tag it with the `ext` attribute. If we do this, the `ext` tactic can use it.
-- The `ext` tactic applies all theorems of the form "two
-- objects are the same if they are made from the same pieces".

@[ext]
theorem ext : ∀ {z w : ℂ}, z.re = w.re → z.im = w.im → z = w
| ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl

-- The theorem `complex.ext` is trivially true to a mathematician.
-- But it is often used: for example it will be used all the time
-- in our proof that the complex numbers are a ring.

-- Note that `ext` is an implication -- if re(z)=re(w) and im(z)=im(w) then z=w.
-- The below variant `ext_iff` is the two-way implication: two complex
-- numbers are equal if and only if they have the same real and imaginary part.
-- Let's first see a tactic mode proof. See how the `ext` tactic is used?
-- After it is applied, we have two goals, both of which are hypotheses.
-- The semicolon means "apply the next tactic to all the goals produced by this one"

example (z w : ℂ) : z = w ↔ z.re = w.re ∧ z.im = w.im :=
begin
  split,
  { intro H,
    simp [H]},
  {
    rintro ⟨hre, him⟩,
    ext; assumption,
  }
end

-- Again this is easy to write in term mode, and no mathematician
-- wants to read the proof anyway.

theorem ext_iff {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
⟨λ H, by simp [H], and.rec ext⟩

/-! # Main course: the complex numbers are a ring. -/

-- Our goal is to prove that the complexes are a ring. Let's
-- define the structure first; the zero, one, addition and multiplication
-- on the complexes.

/-! ## 0 -/

-- Let's define the zero complex number. Once we have done this we will be
-- able to talk about (0 : ℂ).

/-- notation: `0`, or (0 : ℂ), will mean the complex number with
  real and imaginary part equal to (0 : ℝ). -/
instance : has_zero ℂ := ⟨⟨0, 0⟩⟩

-- Let's prove its basic properties, all of which are true by definition,
-- and then tag them with the appropriate attributes.
@[simp] lemma zero_re : (0 : ℂ).re = 0 := rfl
@[simp] lemma zero_im : (0 : ℂ).im = 0 := rfl

/-! ## 1 -/

-- Now let's do the same thing for 1.

/-- Notation `1` or `(1 : ℂ)`, means `⟨(1 : ℝ), (0 : ℝ)⟩`. -/
instance : has_one ℂ := ⟨⟨1, 0⟩⟩

-- name basic properties and tag them appropriately
@[simp] lemma one_re : (1 : ℂ).re = 1 := rfl
@[simp] lemma one_im : (1 : ℂ).im = 0 := rfl

/-! ## + -/

-- Now let's define addition

/-- Notation `+` for usual addition of complex numbers-/
instance : has_add ℂ := ⟨λ z w, ⟨z.re + w.re, z.im + w.im⟩⟩

-- and state and tag its basic properties. We want to prove
-- theorems like $$a(b+c)=ab+ac$$ by checking on real and
-- imaginary parts, so we need to teach the simplifier
-- these tricks.

@[simp] lemma add_re (z w : ℂ) : (z + w).re = z.re + w.re := rfl
@[simp] lemma add_im (z w : ℂ) : (z + w).im = z.im + w.im := rfl

instance : has_neg ℂ := ⟨λ z, ⟨-z.re, -z.im⟩⟩

@[simp] lemma neg_re (z : ℂ) : (-z).re = -z.re := rfl
@[simp] lemma neg_im (z : ℂ) : (-z).im = -z.im := rfl

instance : has_mul ℂ := ⟨λ z w, ⟨z.re * w.re - z.im * w.im, z.re * w.im + z.im * w.re⟩⟩

@[simp] lemma mul_re (z w : ℂ) : (z * w).re = z.re * w.re - z.im * w.im := rfl
@[simp] lemma mul_im (z w : ℂ) : (z * w).im = z.re * w.im + z.im * w.re := rfl

/-! ## Example of what `simp` can now do -/

example (a b c : ℂ) : re(a*(b+c)) = re(a) * (re(b) + re(c)) - im(a) * (im(b) + im(c)) :=
begin
  simp,
end

/-! # Theorem:  The complex numbers are a commutative ring -/

-- Proof: we've defined all the structure, and every axiom can be checked by reducing it
-- to checking real and imaginary parts with `ext`, expanding everything out with `simp`
-- and then using the fact that the real numbers are a ring.
instance : comm_ring ℂ :=
by refine { zero := 0, add := (+), neg := has_neg.neg, one := 1, mul := (*), ..};
   { intros, apply ext_iff.2; split; simp; ring }

-- That is the end of the proof that the complexes form a ring. We built
-- a basic API which was honed towards the general idea that to prove
-- certain statements about the complex numbers, for example distributivity,
-- we could just check on real and imaginary parts. We trained the `simp`
-- lemma to simplify every

/-! # Coercion

This is a worked example of how coercions work from the reals to the complexes.
It's convenient to do this early, and very straightforward.
 I have left in the term mode proofs, with explanations.

-/

-- Let's define a "canonical" map from ℝ to ℂ. Instead of making it a definition, we will
-- make it a coercion instance, which means that if `(r : ℝ)` is a real
-- number, then `(r : ℂ)` or `(↑r : ℂ)` will indicate the corresponding
-- complex number with no imaginary part

/-- The coercion from ℝ to ℂ sending `r` to the complex number `⟨r, 0⟩` -/
instance : has_coe ℝ ℂ := ⟨λ r, ⟨r, 0⟩⟩

-- The concept of the complex number associated
-- to a real number `r` is a new definition, so we had better formulate its basic
-- properties immediately, namely what its real and imaginary parts are,
-- and their basic behaviour. Here are two properties, both true by definition.
-- We name them because we want to tag them.
@[simp, norm_cast] lemma of_real_re (r : ℝ) : (r : ℂ).re = r := rfl
@[simp, norm_cast] lemma of_real_im (r : ℝ) : (r : ℂ).im = 0 := rfl

-- The `simp` tactic will now simplify `re(↑r)` to `r` and `im(↑r)` to `0`.
-- The `norm_cast` tactic might help you if you have proved a general
-- equality about complex numbers but you want it to be about real numbers,
-- or vice-versa.

-- The map from the reals to the complexes is injective, something we
-- write in iff form so `simp` can use it; `simp` also works on `iff` goals.
@[simp, norm_cast] theorem of_real_inj {z w : ℝ} : (z : ℂ) = w ↔ z = w :=
⟨congr_arg re, congr_arg _⟩

-- We now go through all our basic constants, namely 0, 1, + and *,
-- and tell the simplifier how they behave with respect to this new function.

/-! ## 0 -/
@[simp, norm_cast] lemma of_real_zero : ((0 : ℝ) : ℂ) = 0 := rfl

@[simp] theorem of_real_eq_zero {z : ℝ} : (z : ℂ) = 0 ↔ z = 0 := of_real_inj
theorem of_real_ne_zero {z : ℝ} : (z : ℂ) ≠ 0 ↔ z ≠ 0 := not_congr of_real_eq_zero

/-! ## 1 -/
@[simp, norm_cast] lemma of_real_one : ((1 : ℝ) : ℂ) = 1 := rfl

/-! ## + -/

-- TODO: some crazy bug? in Lean is sometimes stopping me from
-- uncommenting the following example and then putting
-- some code after it. Probably the commit before this one.

-- It is a theorem that the canonical map from ℝ to ℂ commutes with addition.
-- We should prove this and tag it appropriately.

example (r s : ℝ) : ((r + s : ℝ) : ℂ) = r + s :=
begin
  -- goal: to prove two complex numbers are equal.
  ext,
  -- goal: to prove that their real and imaginary
  -- parts are equal.
  { -- real part
    simp},
  { -- imaginary part
    simp},
end

-- Here's the term mode version. It's not true by definition, but `ext` and `simp` solve it.
@[simp, norm_cast] lemma of_real_add (r s : ℝ) : ((r + s : ℝ) : ℂ) = r + s := ext_iff.2 $ by simp

/-! ## - -/
@[simp, norm_cast] lemma of_real_neg (r : ℝ) : ((-r : ℝ) : ℂ) = -r := ext_iff.2 $ by simp

/-! ## * -/

@[simp, norm_cast] lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : ℂ) = r * s := ext_iff.2 $ by simp

/-! ## Example `simp` usage -/

-- examples of the power of `simp` now. Change to -- `by squeeze_simp` to see which
-- lemmas `simp` uses
lemma smul_re (r : ℝ) (z : ℂ) : (↑r * z).re = r * z.re := by simp -- or by squeeze_simp
lemma smul_im (r : ℝ) (z : ℂ) : (↑r * z).im = r * z.im := by simp -- or by squeeze_simp

/-! ## Appendix: numerals.

If you're not a computer scientist feel free to skip 15 lines down to `I`.

These last two are to do with the canonical map from numerals into the complexes, e.g. `(23 : ℂ)`.
Lean stores the numeral in binary. See for example

set_option pp.numerals false
#check (37 : ℂ)-- bit1 (bit0 (bit1 (bit0 (bit0 has_one.one)))) : ℂ
-/

@[simp, norm_cast] lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : ℂ) = bit0 r := ext_iff.2 $ by simp [bit0]
@[simp, norm_cast] lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : ℂ) = bit1 r := ext_iff.2 $ by simp [bit1]

/-!

# Exercise 1: I

I find it unbelievable that we have written 350+ lines of code about the complex numbers
and we've still never defined i, or j, or I, or $$\sqrt{-1}$$, or whatever it's called.
I will supply the definition, Why don't you try making its basic API?

All the proofs below are sorried. You can try them in tactic mode
by replacing `sorry` with `begin end` and then starting to write
tactics in the `begin end` block.
-/

/-- complex.I is the square root of -1 above the imaginary axis -/
def I : ℂ := ⟨0, 1⟩

@[simp] lemma I_re : I.re = 0 := sorry
@[simp] lemma I_im : I.im = 1 := sorry

@[simp] lemma I_mul_I : I * I = -1 := sorry

lemma mk_eq_add_mul_I (a b : ℝ) : complex.mk a b = a + b * I := sorry

@[simp] lemma re_add_im (z : ℂ) : (z.re : ℂ) + z.im * I = z := sorry

-- boss level
lemma I_ne_zero : (I : ℂ) ≠ 0 := sorry

/-!

# Exercise 2: Complex conjugation

Again I'll give you the definition, you supply the proofs.

-/

def conj (z : ℂ) : ℂ := ⟨z.re, -z.im⟩

@[simp] lemma conj_re (z : ℂ) : (conj z).re = z.re := sorry
@[simp] lemma conj_im (z : ℂ) : (conj z).im = -z.im := sorry

@[simp] lemma conj_of_real (r : ℝ) : conj r = r := sorry

@[simp] lemma conj_zero : conj 0 = 0 := sorry
@[simp] lemma conj_one : conj 1 = 1 := sorry
@[simp] lemma conj_I : conj I = -I := sorry

@[simp] lemma conj_add (z w : ℂ) : conj (z + w) = conj z + conj w :=
sorry

@[simp] lemma conj_neg (z : ℂ) : conj (-z) = -conj z := sorry

@[simp] lemma conj_neg_I : conj (-I) = I := sorry

@[simp] lemma conj_mul (z w : ℂ) : conj (z * w) = conj z * conj w :=
sorry

@[simp] lemma conj_conj (z : ℂ) : conj (conj z) = z :=
sorry

lemma conj_involutive : function.involutive conj := sorry

lemma conj_bijective : function.bijective conj := sorry

lemma conj_inj {z w : ℂ} : conj z = conj w ↔ z = w :=
sorry

@[simp] lemma conj_eq_zero {z : ℂ} : conj z = 0 ↔ z = 0 :=
sorry

lemma eq_conj_iff_real {z : ℂ} : conj z = z ↔ ∃ r : ℝ, z = r :=
sorry

lemma eq_conj_iff_re {z : ℂ} : conj z = z ↔ (z.re : ℂ) = z :=
sorry

theorem add_conj (z : ℂ) : z + conj z = (2 * z.re : ℝ) :=
sorry

/-- the ring homomorphism complex conjugation -/
def Conj : ℂ →+* ℂ :=
{ to_fun := conj,
  map_one' := sorry,
  map_mul' := sorry,
  map_zero' := sorry,
  map_add' := sorry}

/-!

# Exercise 3: Norms

-/

def norm_sq (z : ℂ) : ℝ := z.re * z.re + z.im * z.im

@[simp] lemma norm_sq_of_real (r : ℝ) : norm_sq r = r * r :=
sorry

@[simp] lemma norm_sq_zero : norm_sq 0 = 0 := sorry
@[simp] lemma norm_sq_one : norm_sq 1 = 1 := sorry
@[simp] lemma norm_sq_I : norm_sq I = 1 := sorry

lemma norm_sq_nonneg (z : ℂ) : 0 ≤ norm_sq z := sorry

@[simp] lemma norm_sq_eq_zero {z : ℂ} : norm_sq z = 0 ↔ z = 0 :=
sorry

@[simp] lemma norm_sq_pos {z : ℂ} : 0 < norm_sq z ↔ z ≠ 0 :=
sorry

@[simp] lemma norm_sq_neg (z : ℂ) : norm_sq (-z) = norm_sq z :=
sorry

@[simp] lemma norm_sq_conj (z : ℂ) : norm_sq (conj z) = norm_sq z :=
sorry

@[simp] lemma norm_sq_mul (z w : ℂ) : norm_sq (z * w) = norm_sq z * norm_sq w :=
sorry

lemma norm_sq_add (z w : ℂ) : norm_sq (z + w) =
  norm_sq z + norm_sq w + 2 * (z * conj w).re :=
sorry

lemma re_sq_le_norm_sq (z : ℂ) : z.re * z.re ≤ norm_sq z :=
sorry

lemma im_sq_le_norm_sq (z : ℂ) : z.im * z.im ≤ norm_sq z :=
sorry

theorem mul_conj (z : ℂ) : z * conj z = norm_sq z :=
sorry

end complex

/-! # Exercise 4 (advanced)

1) Prove the complex numbers are a field.

2) Prove the complex numbers are an algebraically closed field.

-/

instance : field ℂ := sorry

-- As for it being algebraically closed, [here](https://github.com/leanprover-community/mathlib/blob/3710744/src/analysis/complex/polynomial.lean#L34)
-- is where it is proved in mathlib. The mathlib proof was written by Chris Hughes, a mathematics
-- undergraduate at Imperial College London.


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import data.polynomial.derivative
import tactic.linear_combination
import tactic.ring_exp

/-!
# Theory of univariate polynomials

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

The main def is `binom_expansion`.
-/

noncomputable theory

namespace polynomial
open_locale polynomial
universes u v w x y z
variables {R : Type u} {S : Type v} {T : Type w} {ι : Type x} {k : Type y} {A : Type z}
  {a b : R} {m n : ℕ}

section identities

/- @TODO: pow_add_expansion and pow_sub_pow_factor are not specific to polynomials.
  These belong somewhere else. But not in group_power because they depend on tactic.ring_exp

Maybe use data.nat.choose to prove it.
 -/
/--
`(x + y)^n` can be expressed as `x^n + n*x^(n-1)*y + k * y^2` for some `k` in the ring.
-/
def pow_add_expansion {R : Type*} [comm_semiring R] (x y : R) : ∀ (n : ℕ),
  {k // (x + y)^n = x^n + n*x^(n-1)*y + k * y^2}
| 0 := ⟨0, by simp⟩
| 1 := ⟨0, by simp⟩
| (n+2) :=
  begin
    cases pow_add_expansion (n+1) with z hz,
    existsi x*z + (n+1)*x^n+z*y,
    calc (x + y) ^ (n + 2) = (x + y) * (x + y) ^ (n + 1) : by ring_exp
    ... = (x + y) * (x ^ (n + 1) + ↑(n + 1) * x ^ (n + 1 - 1) * y + z * y ^ 2) : by rw hz
    ... = x ^ (n + 2) + ↑(n + 2) * x ^ (n + 1) * y + (x*z + (n+1)*x^n+z*y) * y ^ 2 :
      by { push_cast, ring_exp! }
  end

variables [comm_ring R]

private def poly_binom_aux1 (x y : R) (e : ℕ) (a : R) :
  {k : R // a * (x + y)^e = a * (x^e + e*x^(e-1)*y + k*y^2)} :=
begin
  existsi (pow_add_expansion x y e).val,
  congr,
  apply (pow_add_expansion _ _ _).property
end

private lemma poly_binom_aux2 (f : R[X]) (x y : R) :
  f.eval (x + y) = f.sum (λ e a, a * (x^e + e*x^(e-1)*y + (poly_binom_aux1 x y e a).val*y^2)) :=
begin
  unfold eval eval₂, congr' with n z,
  apply (poly_binom_aux1 x y _ _).property
end

private lemma poly_binom_aux3 (f : R[X]) (x y : R) : f.eval (x + y) =
  f.sum (λ e a, a * x^e) +
  f.sum (λ e a, (a * e * x^(e-1)) * y) +
  f.sum (λ e a, (a *(poly_binom_aux1 x y e a).val)*y^2) :=
by { rw poly_binom_aux2, simp [left_distrib, sum_add, mul_assoc] }

/--
A polynomial `f` evaluated at `x + y` can be expressed as
the evaluation of `f` at `x`, plus `y` times the (polynomial) derivative of `f` at `x`,
plus some element `k : R` times `y^2`.
-/
def binom_expansion (f : R[X]) (x y : R) :
  {k : R // f.eval (x + y) = f.eval x + (f.derivative.eval x) * y + k * y^2} :=
begin
  existsi f.sum (λ e a, a *((poly_binom_aux1 x y e a).val)),
  rw poly_binom_aux3,
  congr,
  { rw [←eval_eq_sum], },
  { rw derivative_eval, exact finset.sum_mul.symm },
  { exact finset.sum_mul.symm }
end

/--
`x^n - y^n` can be expressed as `z * (x - y)` for some `z` in the ring.
-/
def pow_sub_pow_factor (x y : R) : Π (i : ℕ), {z : R // x^i - y^i = z * (x - y)}
| 0 := ⟨0, by simp⟩
| 1 := ⟨1, by simp⟩
| (k+2) :=
  begin
    cases @pow_sub_pow_factor (k+1) with z hz,
    existsi z*x + y^(k+1),
    linear_combination x * hz with { normalization_tactic := `[ring_exp] }
  end

/--
For any polynomial `f`, `f.eval x - f.eval y` can be expressed as `z * (x - y)`
for some `z` in the ring.
-/
def eval_sub_factor (f : R[X]) (x y : R) :
  {z : R // f.eval x - f.eval y = z * (x - y)} :=
begin
  refine ⟨f.sum (λ i r, r * (pow_sub_pow_factor x y i).val), _⟩,
  delta eval eval₂,
  simp only [sum, ← finset.sum_sub_distrib, finset.sum_mul],
  dsimp,
  congr' with i r,
  rw [mul_assoc, ←(pow_sub_pow_factor x y _).prop, mul_sub],
end

end identities

end polynomial


namespace hide

inductive nat : Type :=
| zero : nat
| succ : nat → nat

namespace nat

definition add (m n : nat) : nat :=
nat.rec_on n m (fun n add_m_n, succ add_m_n)

notation 0 := zero
infix `+` := add

theorem add_zero (m : nat) : m + 0 = m := rfl

theorem add_succ (m n : nat) : m + succ n = succ (m + n) := rfl

local abbreviation induction_on := @nat.induction_on

theorem zero_add (n : nat) : 0 + n = n :=
induction_on n
  (show 0 + 0 = 0, from rfl)
  (take n,
    assume IH : 0 + n = n,
    show 0 + succ n = succ n, from
      calc
        0 + succ n = succ (0 + n) : rfl
          ... = succ n : IH)

attribute add [reducible]
theorem add_assoc (m n k : nat) : m + n + k = m + (n + k) :=
induction_on k rfl (take k IH, eq.subst IH rfl)

theorem succ_add (m n : nat) : succ m + n = succ (m + n) :=
induction_on n
  (show succ m + 0 = succ (m + 0), from rfl)
  (take n,
    assume IH : succ m + n = succ (m + n),
    show succ m + succ n = succ (m + succ n), from
      calc
        succ m + succ n = succ (succ m + n) : rfl
          ... = succ (succ (m + n)) : IH
          ... = succ (m + succ n) : rfl)

theorem add_comm (m n : nat) : m + n = n + m :=
induction_on n
  (show m + 0 = 0 + m, from eq.symm (zero_add m))
  (take n,
    assume IH : m + n = n + m,
    calc
      m + succ n = succ (m + n) : rfl
        ... = succ (n + m) : IH
        ... = succ n + m : succ_add)

-- define mul by recursion on the second argument
definition mul (m n : nat) : nat :=
  nat.rec_on n 0 (fun n mul_m_n, mul_m_n + m)

infix `*` := mul

-- these should be proved by rfl
theorem mul_zero (m : nat) : m * 0 = 0 := rfl

theorem mul_succ (m n : nat) : m * (succ n) = m * n + m :=
  induction_on n
    (show m * (succ 0) = m * 0 + m, from rfl)
    (take n,
      assume IH : m * (succ n) = m * n + m,
      calc
        m * (succ (succ n)) = m * (succ n) + m : rfl)

theorem zero_mul (n : nat) : 0 * n = 0 :=
  induction_on n
    (show 0 * 0 = 0, from rfl)
    (take n,
      assume IH : 0 * n = 0,
      calc
        0 * (succ n) = (0 * n) + 0 : rfl
        ... = 0 + 0 : IH
        ... = 0 : rfl)

theorem mul_distrib (m n k : nat) : m * (n + k) = m * n + m * k :=
  induction_on k
    (show m * (n + 0) = m * n + m * 0, from rfl)
    (take k,
      assume IH : m * (n + k) = m * n + m * k,
      calc
        m * (n + (succ k)) = m * succ (n + k) : rfl
        ... = m * (n + k) + m : mul_succ
        ... = (m * n + m * k) + m : IH
        ... = m * n + (m * k + m) : add_assoc
        ... = m * n + m * (succ k) : mul_succ)

theorem mul_assoc (m n k : nat) : m * n * k = m * (n * k) :=
  induction_on k
    rfl
    (take k,
      assume IH : m * n * k = m * (n * k),
        calc
          m * n * succ k = m * n * k + m * n : mul_succ
          ... = m * (n * k) + m * n : IH
          ... = m * (n * k + n) : mul_distrib
          ... = m * (n * succ k) : mul_succ)

-- hint: you will need to prove an auxiliary statement
theorem succ_mul (m n : nat) : succ m * n = m * n + n :=
  induction_on n
    rfl
    (take n,
      assume IH : succ m * n = m * n + n,
        calc
          succ m * succ n = succ m * n + succ m : mul_succ
          ... = (m * n + n) + succ m : IH
          ... = m * n + (n + succ m) : add_assoc
          ... = m * n + succ (n + m) : add_succ
          ... = m * n + (succ n + m) : succ_add
          ... = m * n + (m + succ n) : add_comm
          ... = (m * n + m) + succ n : add_assoc
          ... = m * succ n + succ n : mul_succ)

theorem mul_comm (m n : nat) : m * n = n * m :=
  induction_on n
    (show m * 0 = 0 * m, from
      calc
        m * 0 = 0 : mul_zero
        ... = 0 * m : zero_mul)
    (take n,
      assume IH : m * n = n * m,
      calc
        m * succ n = m * n + m : mul_succ
        ... = n * m + m : IH
        ... = succ n * m : succ_mul)

definition pred (n : nat) : nat := nat.cases_on n zero (fun n, n)

theorem pred_succ (n : nat) : pred (succ n) = n := rfl

theorem succ_pred (n : nat) : n ≠ 0 → succ (pred n) = n :=
  nat.rec_on n
    (λ H : 0 ≠ 0,
      have H' : 0 = 0, from rfl,
      absurd H' H)
    (take n,
      assume IH : n ≠ 0 → succ (pred n) = n,
        (λ H : succ n ≠ 0,
          calc
            succ (pred (succ n)) = succ n : rfl))

end nat

end hide

namespace hide

inductive list (A : Type) : Type :=
| nil {} : list A
| cons : A → list A → list A

namespace list

notation `[` l:(foldr `,` (h t, cons h t) nil) `]` := l

variable {A : Type}

notation h :: t  := cons h t

definition append (s t : list A) : list A :=
list.rec_on s t (λ x l u, x::u)

notation s ++ t := append s t

theorem nil_append (t : list A) : nil ++ t = t := rfl

theorem cons_append (x : A) (s t : list A) : x::s ++ t = x::(s ++ t) := rfl

theorem append_nil (t : list A) : t ++ nil = t :=
  list.induction_on t
    rfl
    (λ x t,
      assume IH : t ++ nil = t,
        calc
          (x :: t) ++ nil = x :: (t ++ nil) : rfl
          ... = x :: t : IH)

theorem append_assoc (r s t : list A) : r ++ s ++ t = r ++ (s ++ t) :=
  list.induction_on r
    rfl
    (λ x r,
      assume IH : r ++ s ++ t = r ++ (s ++ t),
        calc
        (x :: r) ++ s ++ t = x :: (r ++ s) ++ t : rfl
        ... = x :: (r ++ s ++ t) : rfl
        ... = x :: (r ++ (s ++ t)) : IH
        ... = (x :: r) ++ (s ++ t) : rfl)

end list
end hide

namespace hide

inductive eq {A : Type} (a : A) : A → Prop :=
  refl : eq a a

theorem cast {A B : Type} (p : eq A B) (a : A) : B :=
  (eq.rec a) p

theorem subst {A : Type} {a b : A} {P : A → Prop}
  (H_1 : eq a b) (H_2 : P a) : P b :=
  (eq.rec H_2) H_1

theorem symm {A : Type} {a b : A} (H : eq a b) : eq b a :=
  (eq.rec (eq.refl a)) H

theorem trans {A : Type} {a b c : A} (H_1 : eq a b) (H_2 : eq b c) : eq a c :=
  eq.rec H_1 H_2

theorem congr {A B : Type} {a b : A} (f : A → B) (H : eq a b) : eq (f a) (f b) :=
  eq.rec (eq.refl (f a)) H

theorem hcongr {A : Type} {B : A → Type} {a b : A} (f : Π x : A, B x)
      (H : eq a b) : eq (eq.rec_on H (f a)) (f b) :=
  have h1 : ∀ h : eq a a, eq (eq.rec_on h (f a)) (f a), from
    (assume h : eq a a, eq.refl (eq.rec_on h (f a))),
  have h2 : ∀ h : eq a b, eq (eq.rec_on h (f a)) (f b), from
    eq.rec_on H h1,
  show eq (eq.rec_on H (f a)) (f b), from
    h2 H

end hide

namespace hide

inductive tree (A : Type) : Type :=
| leaf : A → tree A
| node : tree A → tree A → tree A

open tree

variable {A : Type}

theorem leaf_ne_node {a : A} {l r : tree A}
    (h : leaf a = node l r) : false :=
  tree.no_confusion h

theorem leaf_inj {a b : A} (h : leaf a = leaf b) : a = b :=
  tree.no_confusion h (fun e : a = b, e)

theorem node_inj_left {l1 r1 l2 r2 : tree A}
    (h : node l1 r1 = node l2 r2) : l1 = l2 :=
  tree.no_confusion h (fun (l : l1 = l2) (r : r1 = r2), l)

theorem node_inj_right {l1 r1 l2 r2 : tree A}
    (h : node l1 r1 = node l2 r2) : r1 = r2 :=
  tree.no_confusion h (fun (l : l1 = l2) (r : r1 = r2), r)

end hide


-- ---------------------------------------------------------------------
-- Ejercicio. Importar las teorías:
-- + algebra.group_power de potencias en grupos
-- + tactic de tácticas
-- ----------------------------------------------------------------------

import algebra.group_power
import tactic

-- ---------------------------------------------------------------------
-- Ejercicio. Declara R como una variable sobre dominios de integridad.
-- ----------------------------------------------------------------------

variables {R : Type*} [integral_domain R]

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar x e y como variables sobre R.
-- ----------------------------------------------------------------------

variables (x y : R)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar si
--    x^2 = 1
-- entonces
--    x = 1 ∨ x = -1
-- ----------------------------------------------------------------------

example
  (h : x^2 = 1)
  : x = 1 ∨ x = -1 :=
begin
  have h1 : (x - 1) * (x + 1) = 0,
    calc (x - 1) * (x + 1) = x^2 - 1 : by ring
                       ... = 1 - 1   : by rw h
                       ... = 0       : by ring,
  have h2 : x - 1 = 0 ∨ x + 1 = 0,
    { apply eq_zero_or_eq_zero_of_mul_eq_zero h1 },
  cases h2,
  { left,
    exact sub_eq_zero.mp h2 },
  { right,
    exact eq_neg_of_add_eq_zero h2 },
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar si
--    x^2 = y^2
-- entonces
--    x = y ∨ x = -y
-- ----------------------------------------------------------------------

example
  (h : x^2 = y^2)
  : x = y ∨ x = -y :=
begin
  have h1 : (x - y) * (x + y) = 0,
    calc (x - y) * (x + y) = x^2 - y^2 : by ring
                       ... = y^2 - y^2 : by rw h
                       ... = 0         : by ring,
  have h2 : x - y = 0 ∨ x + y = 0,
    { apply eq_zero_or_eq_zero_of_mul_eq_zero h1 },
  cases h2,
  { left,
    exact sub_eq_zero.mp h2 },
  { right,
    exact eq_neg_of_add_eq_zero h2 },
end


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

! This file was ported from Lean 3 source module data.polynomial.denoms_clearable
! leanprover-community/mathlib commit 85d9f2189d9489f9983c0d01536575b0233bd305
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Polynomial.EraseLead
import Mathlib.Data.Polynomial.Eval

/-!
# Denominators of evaluation of polynomials at ratios

Let `i : R → K` be a homomorphism of semirings.  Assume that `K` is commutative.  If `a` and
`b` are elements of `R` such that `i b ∈ K` is invertible, then for any polynomial
`f ∈ R[X]` the "mathematical" expression `b ^ f.natDegree * f (a / b) ∈ K` is in
the image of the homomorphism `i`.
-/

open Polynomial Finset

open Polynomial

section DenomsClearable

variable {R K : Type _} [Semiring R] [CommSemiring K] {i : R →+* K}

variable {a b : R} {bi : K}

-- TODO: use hypothesis (ub : IsUnit (i b)) to work with localizations.
/-- `denomsClearable` formalizes the property that `b ^ N * f (a / b)`
does not have denominators, if the inequality `f.natDegree ≤ N` holds.

The definition asserts the existence of an element `D` of `R` and an
element `bi = 1 / i b` of `K` such that clearing the denominators of
the fraction equals `i D`.
-/
def DenomsClearable (a b : R) (N : ℕ) (f : R[X]) (i : R →+* K) : Prop :=
  ∃ (D : R)(bi : K), bi * i b = 1 ∧ i D = i b ^ N * eval (i a * bi) (f.map i)
#align denoms_clearable DenomsClearable

theorem denomsClearable_zero (N : ℕ) (a : R) (bu : bi * i b = 1) : DenomsClearable a b N 0 i :=
  ⟨0, bi, bu, by
    simp only [eval_zero, RingHom.map_zero, MulZeroClass.mul_zero, Polynomial.map_zero]⟩
#align denoms_clearable_zero denomsClearable_zero

theorem denomsClearable_C_mul_X_pow {N : ℕ} (a : R) (bu : bi * i b = 1) {n : ℕ} (r : R)
    (nN : n ≤ N) : DenomsClearable a b N (C r * X ^ n) i := by
  refine' ⟨r * a ^ n * b ^ (N - n), bi, bu, _⟩
  rw [C_mul_X_pow_eq_monomial, map_monomial, ← C_mul_X_pow_eq_monomial, eval_mul, eval_pow, eval_C]
  rw [RingHom.map_mul, RingHom.map_mul, RingHom.map_pow, RingHom.map_pow, eval_X, mul_comm]
  rw [← tsub_add_cancel_of_le nN]
  conv_lhs => rw [← mul_one (i a), ← bu]
  simp [mul_assoc, mul_comm, mul_left_comm, pow_add, mul_pow]
set_option linter.uppercaseLean3 false in
#align denoms_clearable_C_mul_X_pow denomsClearable_C_mul_X_pow

theorem DenomsClearable.add {N : ℕ} {f g : R[X]} :
    DenomsClearable a b N f i → DenomsClearable a b N g i → DenomsClearable a b N (f + g) i :=
  fun ⟨Df, bf, bfu, Hf⟩ ⟨Dg, bg, bgu, Hg⟩ =>
  ⟨Df + Dg, bf, bfu,
    by
    rw [RingHom.map_add, Polynomial.map_add, eval_add, mul_add, Hf, Hg]
    congr
    refine' @inv_unique K _ (i b) bg bf _ _ <;> rwa [mul_comm]⟩
#align denoms_clearable.add DenomsClearable.add

theorem denomsClearable_of_natDegree_le (N : ℕ) (a : R) (bu : bi * i b = 1) :
    ∀ f : R[X], f.natDegree ≤ N → DenomsClearable a b N f i :=
  induction_with_natDegree_le _ N (denomsClearable_zero N a bu)
    (fun _ r _ => denomsClearable_C_mul_X_pow a bu r) fun _ _ _ _ df dg => df.add dg
#align denoms_clearable_of_nat_degree_le denomsClearable_of_natDegree_le

/-- If `i : R → K` is a ring homomorphism, `f` is a polynomial with coefficients in `R`,
`a, b` are elements of `R`, with `i b` invertible, then there is a `D ∈ R` such that
`b ^ f.natDegree * f (a / b)` equals `i D`. -/
theorem denomsClearable_natDegree (i : R →+* K) (f : R[X]) (a : R) (bu : bi * i b = 1) :
    DenomsClearable a b f.natDegree f i :=
  denomsClearable_of_natDegree_le f.natDegree a bu f le_rfl
#align denoms_clearable_nat_degree denomsClearable_natDegree

end DenomsClearable

open RingHom

--Porting note: `etaExperiment` is required to synthesize the `RingHomClass (ℤ →+* K) ℤ K` instance
set_option synthInstance.etaExperiment true in
/-- Evaluating a polynomial with integer coefficients at a rational number and clearing
denominators, yields a number greater than or equal to one.  The target can be any
`LinearOrderedField K`.
The assumption on `K` could be weakened to `LinearOrderedCommRing` assuming that the
image of the denominator is invertible in `K`. -/
theorem one_le_pow_mul_abs_eval_div {K : Type _} [LinearOrderedField K] {f : ℤ[X]} {a b : ℤ}
    (b0 : 0 < b) (fab : eval ((a : K) / b) (f.map (algebraMap ℤ K)) ≠ 0) :
    (1 : K) ≤ (b : K) ^ f.natDegree * |eval ((a : K) / b) (f.map (algebraMap ℤ K))| := by
  obtain ⟨ev, bi, bu, hF⟩ :=
    denomsClearable_natDegree (b := b) (algebraMap ℤ K) f a
      (by
        rw [eq_intCast, one_div_mul_cancel]
        rw [Int.cast_ne_zero]
        exact b0.ne.symm)
  obtain Fa := _root_.congr_arg abs hF
  rw [eq_one_div_of_mul_eq_one_left bu, eq_intCast, eq_intCast, abs_mul] at Fa
  rw [abs_of_pos (pow_pos (Int.cast_pos.mpr b0) _ : 0 < (b : K) ^ _), one_div, eq_intCast] at Fa
  rw [div_eq_mul_inv, ←Fa, ← Int.cast_abs, ← Int.cast_one, Int.cast_le]
  refine' Int.le_of_lt_add_one ((lt_add_iff_pos_left 1).mpr (abs_pos.mpr fun F0 => fab _))
  rw [eq_one_div_of_mul_eq_one_left bu, F0, one_div, eq_intCast, Int.cast_zero, zero_eq_mul] at hF
  cases' hF with hF hF
  · exact (not_le.mpr b0 (le_of_eq (Int.cast_eq_zero.mp (pow_eq_zero hF)))).elim
  · rwa [div_eq_mul_inv]
#align one_le_pow_mul_abs_eval_div one_le_pow_mul_abs_eval_div


import SciLean.Core.Functions
-- import SciLean.Tactic.AutoDiff.Main

namespace SciLean

variable {α β γ : Type}
variable {X Y Z : Type} [Vec X] [Vec Y] [Vec Z]

variable (f : Y → Z) [IsSmooth f]
variable (g : X → Y) [IsSmooth g]
variable (f1 : X → X) [IsSmooth f1]
variable (f2 : Y → Y) [IsSmooth f2]
variable (f3 : Z → Z) [IsSmooth f3]
variable (F : X → Y → Z) [IsSmooth F] [∀ x, IsSmooth (F x)]
variable (G : X × Y → Z) [IsSmooth G]

variable (x dx : X) (y dy : Y) (z dz : Z)

-- macro "diff_simp" : tactic => `(autodiff_core (config := {singlePass := true}))
macro "diff_simp" : tactic => `(simp) -- `(autodiff_core (config := {singlePass := true}))

example : ∂ (λ x => x) x dx = dx := by diff_simp done
example : ∂ (λ x => f (g x)) x dx = ∂ f (g x) (∂ g x dx) := by diff_simp done
example : ∂ (λ x => f (g (f1 x))) x dx = ∂ f (g (f1 x)) (∂ g (f1 x) (∂ f1 x dx)) := by diff_simp done
example (y x dx : X) : ∂ (λ x : X => y) x dx = 0 := by diff_simp done
example : ∂ (λ x => x + x) x dx = dx + dx := by diff_simp done
example : ∂ (λ (x : X) => F x (g x)) x dx = ∂ F x dx (g x) + ∂ (F x) (g x) (∂ g x dx) := by diff_simp  done
example : ∂ (λ (x : X) => f3 (F x (g x))) x dx = ∂ f3 (F x (g x)) (∂ F x dx (g x) + ∂ (F x) (g x) (∂ g x dx)) := by diff_simp done
example g dg x : ∂ (λ (g : X → Y) => f (g x)) g dg = ∂ f (g x) (dg x) := by diff_simp done
example g dg x : ∂ (λ (g : X → Y) (x : X) => F x (g x)) g dg x = ∂ (F x) (g x) (dg x) := by diff_simp done
example g dg x : ∂ (λ (g : X → X) (y : Y) => F (g x) y) g dg y = ∂ F (g x) (dg x) y := by diff_simp done
example (r dr : ℝ) : ∂ (λ x : ℝ => x*x + x) r dr = dr * r + r * dr + dr := by diff_simp; done
example (r dr : ℝ) : ∂ (λ x : ℝ => x*x*x + x) r dr = (dr * r + r * dr) * r + r * r * dr + dr := by diff_simp; done
example g dg y : ∂ (λ (g : X → X) (x : X) => F (g x) y) g dg x = ∂ F (g x) (dg x) y := by diff_simp done


-- Monotonia_de_la_suma_por_la_derecha.lean
-- Monotonía de la suma por la derecha
-- José A. Alonso Jiménez
-- Sevilla, 14 de agosto de 2020
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si a, b y c son números reles tales que
-- a ≤ b, entonces a + c ≤ b + c.
-- ----------------------------------------------------------------------

import data.real.basic
variables {a b c : ℝ}

-- 1ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  have h : (b + c) - (a + c) = b - a,
  { ring, },
  { rw h,
    rw sub_nonneg,
    exact hab, },
end

-- 2ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  calc 0   ≤ b - a           : by exact sub_nonneg.mpr hab
       ... = b + c - (a + c) : by exact (add_sub_add_right_eq_sub b a c).symm,
end

-- Comentario: Se usa el lema
-- + add_sub_add_right_eq_sub : a + c - (b + c) = a - b

-- 3ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  calc 0   ≤ b - a           : sub_nonneg.mpr hab
       ... = b + c - (a + c) : (add_sub_add_right_eq_sub b a c).symm,
end

-- 4ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  calc 0   ≤ b - a           : sub_nonneg.mpr hab
       ... = b + c - (a + c) : by ring,
end

-- 5ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  simp,
  exact hab,
end

-- 6ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  rw ← sub_nonneg,
  simp [hab],
end

-- 7ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
begin
  simp [hab],
end

-- 8ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
by simp [hab]

-- 9ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
add_le_add_right hab c

-- Comentario: Se ha usado el lema
-- + add_le_add_right : a ≤ b → ∀ (c : ℝ), a + c ≤ b + c

-- 10ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
by linarith

-- 11ª demostración
-- ===============

example
  (hab : a ≤ b)
  : a + c ≤ b + c :=
by finish