import combinatorics.simple_graph.connectivity

#check simple_graph.walk.take_until

/-!
# Trees!

A graph is a tree if for every pair of vertices there is a unique
path between them

Things to try:

1) tree ↔ ∃! trails
2) tree ↔ connected + no cycles

-/

universe u₀

namespace simple_graph

def is_tree {V : Type u₀} (G : simple_graph V) : Prop :=
∀ u v : V, ∃! p : G.walk u v, p.is_path

def is_connected {V : Type u₀} (G : simple_graph V) : Prop :=
∀ u v : V, ∃ p : G.walk u v, p.is_path

namespace is_tree
variables {V: Type u₀} { G : simple_graph V}

lemma is_tree.is_connceted {V : Type u₀} (G : simple_graph V)
  (h: G.is_tree) : G.is_connected :=
begin
  intros u v,
  exact exists_unique.exists (h u v),
end

open simple_graph.walk

example (X : Type) (P: X → Prop) (hP : ∃! a : X, P a) (x y : X)
  (hx : P x) (hy : P y) : x = y := exists_unique.unique hP hx hy

lemma no_cycles [decidable_eq V] (hG: G.is_tree) (u : V) (p: G.walk u u) (hp : p.is_cycle)
 : false :=
begin
  cases p with _ _ v _ huv q,
  -- Nil walk is not a cycle
  {
    exact hp.ne_nil rfl,
  }, {
    set w1 := walk.cons huv nil with hw1,
    set w2 := q.reverse with hw2,
    have hw1path : w1.is_path,
    {
      simp,
      intro h,
      rewrite h at huv,
      exact G.loopless v huv,
    },
    have hw2path : w2.is_path,
    { sorry },

    have hw := exists_unique.unique (hG u v) hw1path hw2path,
    sorry,
    -- stopping because no time
  },
end

variables {u v w : V} (p : G.walk u v)

end is_tree
end simple_graph


-- Welcome to Lean! As you can tell I'm working with Lean through VS Code. Unfortunately there aren't a ton of options available for Lean-compatible editors (the other option is emacs)

-- I'll be using ``tactics'' to prove the results below, so I need to import the tactics module just as I would import a module in any other language.
import tactic
import data.nat.basic

-- A little trick so Lean doesn't get confused between my definition of even and odd and the one already implemented in Lean.
namespace hidden

-- The syntax of Lean is very human readable. It features UTF-8 encoding, and has all of our favorite characters like ←, →, ↔, ⟨⟩, ℕ, ℤ, ℝ, ℂ

def even (n : ℕ) := ∃(k : ℕ), 2*k = n
def odd  (n : ℕ) := ∃(k : ℕ), 2*k + 1 = n

theorem even_plus_even {n m : ℕ} (h₁ : even n) (h₂ : even m) : even (n + m) :=
-- Begin and end are used to denote the beginning and end of a proof given in tactic mode. Sorry is a tactic that automatically proves any theorem! (unfortunately, it's cheating so Lean scolds us for using it)
begin
  sorry
end

-- Lets prove an even harder theorem. This time we should think a little bit about how we would go about showing this result on pen and paper before we jump into its formalization.
theorem even_or_odd {n : ℕ} : even n ∨ odd n :=
begin
  sorry
end

end hidden


import data.set
open set

namespace logic

    def reflexivity (R : set Prop → Prop → Prop) :=
        ∀ α : Prop, R {α} α

    def monotonicity (R : set Prop → Prop → Prop) : Prop :=
        ∀ Γ Δ : set Prop, ∀ α : Prop, Γ ⊆ Δ ∧ R Γ α → R Δ α

    def transitivity (R : set Prop → Prop → Prop) : Prop :=
        ∀ Γ Δ : set Prop, ∀ α : Prop, R (Γ ∪ Δ) α ∧ (∀ β ∈ Δ, R Γ β) → R Γ α

    theorem transitivity_single (R : set Prop → Prop → Prop) : Prop :=
        ∀ Γ : set Prop, ∀ α β : Prop, R (Γ ∪ {α}) β ∧ R Γ α → R Γ β

    variables {α β : Prop}
    variables {Γ Δ : set Prop}
    variable R : set Prop → Prop → Prop
    variable {reflCr : reflexivity R}
    variable {monCr : monotonicity R}
    variable {cutCr : transitivity R}

    example (x : Prop) : R {x} x := reflCr x

end logic


import homotopy.basic
import topology.path_connected
import path.defs
import intervals

/-!
# Homotopy of Paths

In this file, we define what it means for two paths to be homotopic. Furthermore, we show that this
is an equivalence relation.
-/

noncomputable theory

variables {X Y : Type _} [topological_space X] [topological_space Y] {x₀ x₁ x₂ x₃ : X}

open_locale unit_interval

/--
A `path_homotopy` between paths `f₀` and `f₁` is a homotopy between `f₀` and `f₁` which keep the end
points fixed.
-/
abbreviation path_homotopy (f₀ f₁ : path' x₀ x₁) :=
  homotopy_with (f₀ : C(ℝ, X)) f₁ (λ r, r 0 = x₀ ∧ r 1 = x₁)

namespace path_homotopy

section lemmas

variables {f₀ f₁ : path' x₀ x₁}

@[simp] lemma to_fun_zero (h : path_homotopy f₀ f₁) {t : ℝ} :
  h (0, t) = x₀ :=
by simpa using (h.prop t).1

@[simp] lemma to_fun_one (h : path_homotopy f₀ f₁) {t : ℝ} :
  h (1, t) = x₁ :=
by simpa using (h.prop t).2

/--
A path is homotopic to itself.
-/
def refl (f₀ : path' x₀ x₁) : path_homotopy f₀ f₀ := homotopy_with.refl (by simp)

/--
Given two paths `f₀` and `f₁` which agree for all inputs, we have a homotopy between them.
-/
def of_refl {f₀ f₁ : path' x₀ x₁} (h : f₀ = f₁) : path_homotopy f₀ f₁ :=
{ to_fun :=
  { to_fun := λ p : ℝ × ℝ, f₀ (prod.fst p) },
  to_fun_zero' := by simp [h],
  to_fun_one' := by simp [h],
  prop := by simp [h] }

/--
If `f₀` and `f₁` are homotopic paths, and `F` is a continuous function, then the images of the paths
are homotopic.
-/
def map (h : path_homotopy f₀ f₁) (F : C(X, Y)) : path_homotopy (f₀.map F) (f₁.map F) :=
{ to_fun := F.comp h,
  to_fun_zero' := by simp,
  to_fun_one' := by simp,
  prop := λ t, by simp } .

/--
A path `f₀` is homotopic to `f₀` joined to the constant path.
-/
def trans_const (f₀ : path' x₀ x₁)  : path_homotopy f₀ (f₀.trans (path'.const x₁)) :=
{ to_fun :=
  { to_fun := λ p, f₀ (if p.1 ≤ 1/2 then (1 + p.2) * p.1 else (1 - p.2) * p.1 + p.2),
    continuous_to_fun := begin
      apply continuous.comp,
      { continuity },
      apply continuous.if; [skip, continuity, continuity],
      { intros a ha,
        rw mem_frontier_fst_le at ha,
        rw ha,
        linarith },
    end },
  to_fun_zero' := by norm_num,
  to_fun_one' := λ t, begin
    simp only [path'.trans, one_div, path'.coe_apply, add_zero, mul_one, one_mul, path'.mk_apply,
               path'.const_to_fun, continuous_map.coe_mk, zero_mul, zero_add, mul_zero, sub_self,
               neg_zero],
    split_ifs; norm_num,
  end,
  prop := λ t, by norm_num } .

/--
A path `f₀` is homotopic to `f₀` joined to the constant path.
-/
def const_trans (f₀ : path' x₀ x₁)  : path_homotopy f₀ ((path'.const x₀).trans f₀) :=
{ to_fun :=
  { to_fun := λ p, f₀ (if p.1 ≤ 1/2 then (1 - p.2) * p.1 else (1 + p.2) * p.1 - p.2),
    continuous_to_fun := begin
      apply continuous.comp,
      { continuity },
      apply continuous.if; [skip, continuity, continuity],
      { intros a ha,
        rw mem_frontier_fst_le at ha,
        rw ha,
        linarith }
    end },
  to_fun_zero' := by norm_num,
  to_fun_one' := λ t, begin
    simp only [path'.trans, one_div, path'.coe_apply, add_zero, mul_one, one_mul, path'.mk_apply,
               path'.const_to_fun, continuous_map.coe_mk, zero_mul, zero_add, neg_neg, mul_zero,
               sub_self, neg_zero],
    split_ifs; norm_num,
  end,
  prop := λ t, by norm_num } .

/--
If `f₀` and `g₀` are homotopic, and `f₁` and `g₁` are homotopic, then `f₀` joined with `f₁` is
homotopic to `g₀` joined to `g₁`.
-/
def trans₂ {f₀ g₀ : path' x₀ x₁} {f₁ g₁ : path' x₁ x₂} (h₀ : path_homotopy f₀ g₀) (h₁ : path_homotopy f₁ g₁) :
  path_homotopy (f₀.trans f₁) (g₀.trans g₁) :=
{ to_fun :=
  { to_fun := λ p, if p.1 ≤ 1/2 then h₀ (2 * p.1, p.2) else h₁ (2 * p.1 - 1, p.2),
    continuous_to_fun := begin
      apply continuous.if; [skip, continuity, continuity],
      intros a ha,
      rw mem_frontier_fst_le at ha,
      norm_num [ha],
    end },
  to_fun_zero' := by simp [path'.trans],
  to_fun_one' := by simp [path'.trans],
  prop := λ t, by norm_num } .

/--
If `f` and `g` are homotopic paths, then their inverses are also homotopic.
-/
def inv {f g : path' x₀ x₁} (h : path_homotopy f g) : path_homotopy f.inv g.inv :=
{ to_fun :=
  { to_fun := λ p, h (1 - p.1, p.2) },
  to_fun_zero' := by norm_num [path'.inv],
  to_fun_one' := by norm_num [path'.inv],
  prop := by norm_num [path'.inv] }

end lemmas

section assoc

private def δ (γ₀ : path' x₀ x₁) (γ₁ : path' x₁ x₂) (γ₂ : path' x₂ x₃) : C(ℝ, X) :=
{ to_fun := λ t,
  if t ≤ 1/3 then
    γ₀ (3 * t)
  else if t ≤ 2/3 then
    γ₁ (3 * t - 1)
  else
    γ₂ (3 * t - 2),
  continuous_to_fun := begin
    apply continuous.if; [rintros a (ha : a ∈ frontier (set.Iic (1/3 : ℝ))), continuity, skip],
    { rw [frontier_Iic, set.mem_singleton_iff] at ha,
      norm_num [ha] },
    { apply continuous.if; [rintros b (hb : b ∈ frontier (set.Iic (2/3 : ℝ))), continuity, continuity],
      { rw [frontier_Iic, set.mem_singleton_iff] at hb,
        norm_num [hb] } }
  end } .

private def f₀ : path' (0 : ℝ) 1 :=
{ to_fun :=
  { to_fun := λ t, if t ≤ 1/2 then 4/3 * t else 1/3 + 2/3 * t,
    continuous_to_fun := begin
      apply continuous.if; [rintros a (ha : a ∈ frontier (set.Iic (1/2 : ℝ))), continuity, continuity],
      rw [frontier_Iic, set.mem_singleton_iff] at ha,
      norm_num [ha]
    end },
  to_fun_zero' := by norm_num,
  to_fun_one' := by norm_num }

private def f₁ : path' (0 : ℝ) 1 :=
{ to_fun :=
  { to_fun := λ t, if t ≤ 1/2 then 2/3 * t else -1/3 + 4/3 * t,
    continuous_to_fun := begin
      apply continuous.if; [rintros a (ha : a ∈ frontier (set.Iic (1/2 : ℝ))), continuity, continuity],
      rw [frontier_Iic, set.mem_singleton_iff] at ha,
      norm_num [ha],
    end },
  to_fun_zero' := by norm_num,
  to_fun_one' := by norm_num }

private def path_homotopy_f₀_f₁ : path_homotopy f₀ f₁ :=
{ to_fun :=
  { to_fun := λ p, if p.1 ≤ 1/2 then 2/3 * p.1 * (2 - p.2) else 1/3 + 2/3 * p.1 - 2/3 * p.2 + 2/3 * p.1 * p.2,
    continuous_to_fun := begin
      apply continuous.if; [skip, continuity, continuity],
      intros a ha,
      rw mem_frontier_fst_le at ha,
      rw ha,
      linarith,
    end },
  to_fun_zero' := λ x, begin
    simp only [f₀, one_div, path'.coe_apply, add_zero, mul_one, one_mul, path'.mk_apply,
               continuous_map.coe_mk, sub_zero, zero_add, neg_neg, mul_zero, neg_zero],
    split_ifs; linarith
  end,
  to_fun_one' := λ x, begin
    simp only [f₁, path'.coe_apply, add_zero, mul_one, one_mul, path'.mk_apply,
               continuous_map.coe_mk, zero_add, neg_neg, mul_zero, neg_zero],
    split_ifs; linarith
  end,
  prop := λ t, by norm_num }

variables {γ₀ : path' x₀ x₁} {γ₁ : path' x₁ x₂} {γ₂ : path' x₂ x₃}

private lemma f₀_map_δ_eq : ((f₀.map (δ γ₀ γ₁ γ₂)) : ℝ → X) = ((γ₀.trans γ₁).trans γ₂) :=
begin
  ext t,
  unfold f₀ δ path'.trans,
  simp only [δ, path'.map, path'.coe_apply, path'.mk_apply, continuous_map.comp_coe,
             continuous_map.coe_mk, function.comp_app, mul_ite],
  split_ifs with h₁ h₂ h₃ h₄ h₅ h₆ h₇ h₈;
    [apply congr_arg, exfalso, exfalso, apply congr_arg, exfalso, exfalso, exfalso, exfalso,
     apply congr_arg]; linarith
end .

private lemma f₁_map_δ_eq : (f₁.map (δ γ₀ γ₁ γ₂) : ℝ → X) = (γ₀.trans (γ₁.trans γ₂)) :=
begin
  ext t,
  unfold f₁ δ path'.trans,
  simp only [δ, path'.map, path'.coe_apply, path'.mk_apply, continuous_map.comp_coe,
             continuous_map.coe_mk, function.comp_app, mul_ite],
  split_ifs with h₁ h₂ h₃ h₄ h₅ h₆ h₇ h₈;
    [apply congr_arg, exfalso, exfalso, exfalso, exfalso, apply congr_arg, exfalso, exfalso,
     apply congr_arg]; linarith,
end

/--
When dealing with `path_homotopy`s, sometimes we end up in a case where the end points have a
different type from what we expect.

Consider for example if we had maps `f g : C(X, X)` such that `f x₀ = x₀` and `g x₁ = x₁`,
(which can be proven, but is not true "by definition"). Then say if we had a homotopy between
`p : path' x₀ x₁` and `q : path' x₀ x₁`, we can use this to define a homotopy between
`p' : path' (f x₀) (g x₁)` and `q' : path' (f x₀) (g x₁)`, where `p'` as a function is the same
as `p`, and `q'` as a function is the same as `q`.
-/
def change_end_points {x₁ x₂ y₁ y₂ : X} {f₁ f₂ : path' x₁ x₂} {g₁ g₂ : path' y₁ y₂}
  (h : path_homotopy f₁ f₂) (hfg₁ : (f₁ : ℝ → X) = g₁) (hfg₂ : (f₂ : ℝ → X) = g₂) :
  path_homotopy g₁ g₂ :=
{ to_fun := h,
  to_fun_zero' := by simp [←hfg₁],
  to_fun_one' := by simp [←hfg₂],
  prop := λ t, begin
    simp only [to_fun_one, to_fun_zero, homotopy_with.coe_coe_apply_eq_coe],
    split,
    { simp [←f₁.to_fun_zero, hfg₁, g₁.to_fun_zero] },
    { simp [←f₁.to_fun_one, hfg₁, g₁.to_fun_one] },
  end }

/--
If we have paths `γ₀`, `γ₁` and `γ₂`, then the two paths formed by joined them in different ways
are different, but there is a homotopy between them.
-/
def assoc : path_homotopy ((γ₀.trans γ₁).trans γ₂) (γ₀.trans (γ₁.trans γ₂)) :=
  (path_homotopy_f₀_f₁.map (δ γ₀ γ₁ γ₂)).change_end_points f₀_map_δ_eq f₁_map_δ_eq

end assoc

section inv

variable {f : path' x₀ x₁}

/--
A path joined to it's inverse is homotopic to the constant path.
-/
def trans_right_inv : path_homotopy (f.trans f.inv) (path'.const x₀) :=
{ to_fun :=
  { to_fun := λ p, f (if p.1 ≤ 1/2 then 2 * p.1 * (1 - p.2) else (1 - p.2) * (2 - 2 * p.1)),
    continuous_to_fun := begin
      apply continuous.comp; [continuity, skip],
      apply continuous.if; [skip, continuity, continuity],
      intros a ha,
      rw mem_frontier_fst_le at ha,
      rw ha,
      linarith,
    end },
  to_fun_zero' := λ x, begin
    unfold path'.trans path'.inv,
    simp only [path'.coe_apply, add_zero, mul_one, one_mul, path'.mk_apply, continuous_map.coe_mk,
               sub_zero, zero_add, neg_neg, neg_zero],
    split_ifs; apply congr_arg; linarith
  end,
  to_fun_one' := by norm_num,
  prop := λ t, by norm_num }

/--
A path joined to it's inverse is homotopic to the constant path.
-/
def trans_left_inv : path_homotopy (f.inv.trans f) (path'.const x₁) :=
{ to_fun :=
  { to_fun := λ p, f (if p.1 ≤ 1/2 then (1 - p.2) * (1 - 2 * p.1) + p.2 else (1 - p.2) * (2 * p.1 - 1) + p.2),
    continuous_to_fun := begin
      apply continuous.comp; [continuity, skip],
      apply continuous.if; [skip, continuity, continuity],
      intros a ha,
      rw mem_frontier_fst_le at ha,
      rw ha,
      linarith,
    end },
  to_fun_zero' := λ x, begin
    unfold path'.trans path'.inv,
    simp only [path'.coe_apply, add_zero, mul_one, one_mul, path'.mk_apply, continuous_map.coe_mk,
               zero_mul, sub_zero, zero_add, mul_zero, neg_zero],
    split_ifs; apply congr_arg; linarith
  end,
  to_fun_one' := by norm_num,
  prop := λ t, by norm_num }

end inv

end path_homotopy

/--
Two paths are homotopic if there exists a homotopy between them.
-/
def path_homotopic (f₀ f₁ : path' x₀ x₁) := nonempty (path_homotopy f₀ f₁)

lemma path_homotopic.equiv : equivalence (@path_homotopic X _ x₀ x₁) :=
⟨λ p, ⟨path_homotopy.refl p⟩, λ f g ⟨h⟩, ⟨h.symm⟩, λ f₀ f₁ f₂ ⟨h₀⟩ ⟨h₁⟩, ⟨h₀.trans h₁⟩⟩


import tactic -- hide

/-
## Basic definition

Below we have one possible notion of being a subgroup. We will want to prove that
this definition matches the more natural one, and we will do so in this and the next levels.

On the left you will see a tab with theorems that you can use in your proofs. In this level
you will need to use `nonempty_of_subgroup` and `mul_inv_of_subgroup`, which follow
directly from the definition of subgroup and are in fact the way that we will be able
to access the definition.

Throughout, you will find very useful the `group` tactic, which works like the powerful `ring`
tactic but with equalities involving elements of a group.

You will need to type inverses, which are written using a superindex "-1". You type it as
`\-1`, and you will see how the `-1` appears as a superindex.
-/

variables {G : Type} [group G] {H : set G} -- hide

@[class] -- hide
def subgroup (X : set G) := X.nonempty ∧ (∀ x y, x ∈ X → y ∈ X → x * y⁻¹ ∈ X)

/- Axiom: subgroup (X : set G)
X.nonempty ∧ (∀ x y, x ∈ X → y ∈ X → x * y⁻¹ ∈ X)
-/

lemma nonempty_of_subgroup (X : set G) [h : subgroup X] : ∃ x, x ∈ X
:= h.1 -- hide

/- Axiom : nonempty_of_subgroup (X : set G) [subgroup X]
∃ x, x ∈ X
-/

lemma mul_inv_of_subgroup {X : set G} [h : subgroup X] {x y : G} (hx : x ∈ X) (hy : y ∈ X) : x * y⁻¹ ∈ X
:= h.2 x y hx hy -- hide

/- Axiom : mul_inv_of_subgroup {X : set G} [h : subgroup X] {x y : G}
(hx : x ∈ X) (hy : y ∈ X) :
x * y⁻¹ ∈ X
-/

/- Lemma:
If $H\leq G$, then $1 \in H$.
-/
lemma subgroup.one_mem [h : subgroup H]: (1 : G) ∈ H :=
begin
  cases h.1 with x hx,
  have h2 :=  h.2 x x hx hx,
  rw show (1 : G) = x * x⁻¹, by group,
  assumption,

end


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

import algebra.polynomial.big_operators
import data.nat.choose.cast
import data.nat.choose.vandermonde
import data.polynomial.degree.lemmas
import data.polynomial.derivative

/-!
# Hasse derivative of polynomials

The `k`th Hasse derivative of a polynomial `∑ a_i X^i` is `∑ (i.choose k) a_i X^(i-k)`.
It is a variant of the usual derivative, and satisfies `k! * (hasse_deriv k f) = derivative^[k] f`.
The main benefit is that is gives an atomic way of talking about expressions such as
`(derivative^[k] f).eval r / k!`, that occur in Taylor expansions, for example.

## Main declarations

In the following, we write `D k` for the `k`-th Hasse derivative `hasse_deriv k`.

* `polynomial.hasse_deriv`: the `k`-th Hasse derivative of a polynomial
* `polynomial.hasse_deriv_zero`: the `0`th Hasse derivative is the identity
* `polynomial.hasse_deriv_one`: the `1`st Hasse derivative is the usual derivative
* `polynomial.factorial_smul_hasse_deriv`: the identity `k! • (D k f) = derivative^[k] f`
* `polynomial.hasse_deriv_comp`: the identity `(D k).comp (D l) = (k+l).choose k • D (k+l)`
* `polynomial.hasse_deriv_mul`:
  the "Leibniz rule" `D k (f * g) = ∑ ij in antidiagonal k, D ij.1 f * D ij.2 g`

For the identity principle, see `polynomial.eq_zero_of_hasse_deriv_eq_zero`
in `data/polynomial/taylor.lean`.

## Reference

https://math.fontein.de/2009/08/12/the-hasse-derivative/

-/

noncomputable theory

namespace polynomial

open_locale nat big_operators
open function nat (hiding nsmul_eq_mul)

variables {R : Type*} [semiring R] (k : ℕ) (f : polynomial R)

/-- The `k`th Hasse derivative of a polynomial `∑ a_i X^i` is `∑ (i.choose k) a_i X^(i-k)`.
It satisfies `k! * (hasse_deriv k f) = derivative^[k] f`. -/
def hasse_deriv (k : ℕ) : polynomial R →ₗ[R] polynomial R :=
lsum (λ i, (monomial (i-k)) ∘ₗ distrib_mul_action.to_linear_map R R (i.choose k))

lemma hasse_deriv_apply :
  hasse_deriv k f = f.sum (λ i r, monomial (i - k) (↑(i.choose k) * r)) :=
by simpa only [← nsmul_eq_mul]

lemma hasse_deriv_coeff (n : ℕ) :
  (hasse_deriv k f).coeff n = (n + k).choose k * f.coeff (n + k) :=
begin
  rw [hasse_deriv_apply, coeff_sum, sum_def, finset.sum_eq_single (n + k), coeff_monomial],
  { simp only [if_true, add_tsub_cancel_right, eq_self_iff_true], },
  { intros i hi hink,
    rw [coeff_monomial],
    by_cases hik : i < k,
    { simp only [nat.choose_eq_zero_of_lt hik, if_t_t, nat.cast_zero, zero_mul], },
    { push_neg at hik, rw if_neg, contrapose! hink,
      exact (tsub_eq_iff_eq_add_of_le hik).mp hink, } },
  { intro h, simp only [not_mem_support_iff.mp h, monomial_zero_right, mul_zero, coeff_zero] }
end

lemma hasse_deriv_zero' : hasse_deriv 0 f = f :=
by simp only [hasse_deriv_apply, tsub_zero, nat.choose_zero_right,
  nat.cast_one, one_mul, sum_monomial_eq]

@[simp] lemma hasse_deriv_zero : @hasse_deriv R _ 0 = linear_map.id :=
linear_map.ext $ hasse_deriv_zero'

lemma hasse_deriv_eq_zero_of_lt_nat_degree (p : polynomial R) (n : ℕ)
  (h : p.nat_degree < n) : hasse_deriv n p = 0 :=
begin
  rw [hasse_deriv_apply, sum_def],
  refine finset.sum_eq_zero (λ x hx, _),
  simp [nat.choose_eq_zero_of_lt ((le_nat_degree_of_mem_supp _ hx).trans_lt h)]
end

lemma hasse_deriv_one' : hasse_deriv 1 f = derivative f :=
by simp only [hasse_deriv_apply, derivative_apply, monomial_eq_C_mul_X, nat.choose_one_right,
    (nat.cast_commute _ _).eq]

@[simp] lemma hasse_deriv_one : @hasse_deriv R _ 1 = derivative :=
linear_map.ext $ hasse_deriv_one'

@[simp] lemma hasse_deriv_monomial (n : ℕ) (r : R) :
  hasse_deriv k (monomial n r) = monomial (n - k) (↑(n.choose k) * r) :=
begin
  ext i,
  simp only [hasse_deriv_coeff, coeff_monomial],
  by_cases hnik : n = i + k,
  { rw [if_pos hnik, if_pos, ← hnik], apply tsub_eq_of_eq_add_rev, rwa add_comm },
  { rw [if_neg hnik, mul_zero],
    by_cases hkn : k ≤ n,
    { rw [← tsub_eq_iff_eq_add_of_le hkn] at hnik, rw [if_neg hnik] },
    { push_neg at hkn, rw [nat.choose_eq_zero_of_lt hkn, nat.cast_zero, zero_mul, if_t_t] } }
end

lemma hasse_deriv_C (r : R) (hk : 0 < k) : hasse_deriv k (C r) = 0 :=
by rw [← monomial_zero_left, hasse_deriv_monomial, nat.choose_eq_zero_of_lt hk,
    nat.cast_zero, zero_mul, monomial_zero_right]

lemma hasse_deriv_apply_one (hk : 0 < k) : hasse_deriv k (1 : polynomial R) = 0 :=
by rw [← C_1, hasse_deriv_C k _ hk]

lemma hasse_deriv_X (hk : 1 < k) : hasse_deriv k (X : polynomial R) = 0 :=
by rw [← monomial_one_one_eq_X, hasse_deriv_monomial, nat.choose_eq_zero_of_lt hk,
    nat.cast_zero, zero_mul, monomial_zero_right]

lemma factorial_smul_hasse_deriv :
  ⇑(k! • @hasse_deriv R _ k) = ((@derivative R _)^[k]) :=
begin
  induction k with k ih,
  { rw [hasse_deriv_zero, factorial_zero, iterate_zero, one_smul, linear_map.id_coe], },
  ext f n : 2,
  rw [iterate_succ_apply', ← ih],
  simp only [linear_map.smul_apply, coeff_smul, linear_map.map_smul_of_tower, coeff_derivative,
    hasse_deriv_coeff, ← @choose_symm_add _ k],
  simp only [nsmul_eq_mul, factorial_succ, mul_assoc, succ_eq_add_one, ← add_assoc,
    add_right_comm n 1 k, ← cast_succ],
  rw ← (cast_commute (n+1) (f.coeff (n + k + 1))).eq,
  simp only [← mul_assoc], norm_cast, congr' 2,
  apply @cast_injective ℚ,
  have h1 : n + 1 ≤ n + k + 1 := succ_le_succ le_self_add,
  have h2 : k + 1 ≤ n + k + 1 := succ_le_succ le_add_self,
  have H : ∀ (n : ℕ), (n! : ℚ) ≠ 0, { exact_mod_cast factorial_ne_zero },
  -- why can't `field_simp` help me here?
  simp only [cast_mul, cast_choose ℚ, h1, h2, -one_div, -mul_eq_zero,
    succ_sub_succ_eq_sub, add_tsub_cancel_right, add_tsub_cancel_left] with field_simps,
  rw [eq_div_iff_mul_eq (mul_ne_zero (H _) (H _)), eq_comm, div_mul_eq_mul_div,
    eq_div_iff_mul_eq (mul_ne_zero (H _) (H _))],
  norm_cast,
  simp only [factorial_succ, succ_eq_add_one], ring,
end

lemma hasse_deriv_comp (k l : ℕ) :
  (@hasse_deriv R _ k).comp (hasse_deriv l) = (k+l).choose k • hasse_deriv (k+l) :=
begin
  ext i : 2,
  simp only [linear_map.smul_apply, comp_app, linear_map.coe_comp, smul_monomial,
    hasse_deriv_apply, mul_one, monomial_eq_zero_iff, sum_monomial_index, mul_zero,
    ← tsub_add_eq_tsub_tsub, add_comm l k],
  rw_mod_cast nsmul_eq_mul,
  congr' 2,
  by_cases hikl : i < k + l,
  { rw [choose_eq_zero_of_lt hikl, mul_zero],
    by_cases hil : i < l,
    { rw [choose_eq_zero_of_lt hil, mul_zero] },
    { push_neg at hil, rw [← tsub_lt_iff_right hil] at hikl,
      rw [choose_eq_zero_of_lt hikl , zero_mul], }, },
  push_neg at hikl, apply @cast_injective ℚ,
  have h1 : l ≤ i     := nat.le_of_add_le_right hikl,
  have h2 : k ≤ i - l := le_tsub_of_add_le_right hikl,
  have h3 : k ≤ k + l := le_self_add,
  have H : ∀ (n : ℕ), (n! : ℚ) ≠ 0, { exact_mod_cast factorial_ne_zero },
  -- why can't `field_simp` help me here?
  simp only [cast_mul, cast_choose ℚ, h1, h2, h3, hikl, -one_div, -mul_eq_zero,
    succ_sub_succ_eq_sub, add_tsub_cancel_right, add_tsub_cancel_left] with field_simps,
  rw [eq_div_iff_mul_eq, eq_comm, div_mul_eq_mul_div, eq_div_iff_mul_eq, ← tsub_add_eq_tsub_tsub,
    add_comm l k],
  { ring, },
  all_goals { apply_rules [mul_ne_zero, H] }
end

lemma nat_degree_hasse_deriv_le (p : polynomial R) (n : ℕ) :
  nat_degree (hasse_deriv n p) ≤ nat_degree p - n :=
begin
  classical,
  rw [hasse_deriv_apply, sum_def],
  refine (nat_degree_sum_le _ _).trans _,
  simp_rw [function.comp, nat_degree_monomial],
  rw [finset.fold_ite, finset.fold_const],
  { simp only [if_t_t, max_eq_right, zero_le', finset.fold_max_le, true_and, and_imp,
               tsub_le_iff_right, mem_support_iff, ne.def, finset.mem_filter],
    intros x hx hx',
    have hxp : x ≤ p.nat_degree := le_nat_degree_of_ne_zero hx,
    have hxn : n ≤ x,
    { contrapose! hx',
      simp [nat.choose_eq_zero_of_lt hx'] },
    rwa [tsub_add_cancel_of_le (hxn.trans hxp)] },
  { simp }
end

lemma nat_degree_hasse_deriv [no_zero_smul_divisors ℕ R] (p : polynomial R) (n : ℕ) :
  nat_degree (hasse_deriv n p) = nat_degree p - n :=
begin
  cases lt_or_le p.nat_degree n with hn hn,
  { simpa [hasse_deriv_eq_zero_of_lt_nat_degree, hn] using (tsub_eq_zero_of_le hn.le).symm },
  { refine map_nat_degree_eq_sub _ _,
    { exact λ h, hasse_deriv_eq_zero_of_lt_nat_degree _ _ },
    { classical,
      simp only [ite_eq_right_iff, ne.def, nat_degree_monomial, hasse_deriv_monomial],
      intros k c c0 hh,
      -- this is where we use the `smul_eq_zero` from `no_zero_smul_divisors`
      rw [←nsmul_eq_mul, smul_eq_zero, nat.choose_eq_zero_iff] at hh,
      exact (tsub_eq_zero_of_le (or.resolve_right hh c0).le).symm } }
end

section
open add_monoid_hom finset.nat

lemma hasse_deriv_mul (f g : polynomial R) :
  hasse_deriv k (f * g) = ∑ ij in antidiagonal k, hasse_deriv ij.1 f * hasse_deriv ij.2 g :=
begin
  let D := λ k, (@hasse_deriv R _ k).to_add_monoid_hom,
  let Φ := @add_monoid_hom.mul (polynomial R) _,
  show (comp_hom (D k)).comp Φ f g =
    ∑ (ij : ℕ × ℕ) in antidiagonal k, ((comp_hom.comp ((comp_hom Φ) (D ij.1))).flip (D ij.2) f) g,
  simp only [← finset_sum_apply],
  congr' 2, clear f g,
  ext m r n s : 4,
  simp only [finset_sum_apply, coe_mul_left, coe_comp, flip_apply, comp_app,
    hasse_deriv_monomial, linear_map.to_add_monoid_hom_coe, comp_hom_apply_apply, coe_mul,
    monomial_mul_monomial],
  have aux : ∀ (x : ℕ × ℕ), x ∈ antidiagonal k →
    monomial (m - x.1 + (n - x.2)) (↑(m.choose x.1) * r * (↑(n.choose x.2) * s)) =
    monomial (m + n - k) (↑(m.choose x.1) * ↑(n.choose x.2) * (r * s)),
  { intros x hx, rw [finset.nat.mem_antidiagonal] at hx, subst hx,
    by_cases hm : m < x.1,
    { simp only [nat.choose_eq_zero_of_lt hm, nat.cast_zero, zero_mul, monomial_zero_right], },
    by_cases hn : n < x.2,
    { simp only [nat.choose_eq_zero_of_lt hn, nat.cast_zero,
        zero_mul, mul_zero, monomial_zero_right], },
    push_neg at hm hn,
    rw [tsub_add_eq_add_tsub hm, ← add_tsub_assoc_of_le hn, ← tsub_add_eq_tsub_tsub,
      add_comm x.2 x.1, mul_assoc, ← mul_assoc r, ← (nat.cast_commute _ r).eq, mul_assoc,
      mul_assoc], },
  conv_rhs { apply_congr, skip, rw aux _ H, },
  rw_mod_cast [← linear_map.map_sum, ← finset.sum_mul, ← nat.add_choose_eq],
end

end

end polynomial


import game.order.level06
import data.real.irrational

open real

namespace xena -- hide

/-
# Chapter 2 : Order

## Level 7

Prove by example that there exist pairs of real numbers
$a$ and $b$ such that $a \in \mathbb{R} \setminus \mathbb{Q}$,
$b \in \mathbb{R} \setminus \mathbb{Q}$,
but their sum $a + b$ is a rational number, $(a+b) \in \mathbb{Q}$.
You may use this result in the Lean mathlib library:

`irrational_sqrt_two : irrational (sqrt 2)`

-/

/- Axiom : irrational_sqrt_two : irrational (sqrt 2)

theorem irrational_neg_iff : irrational (-x) ↔ irrational x

.2 after irrational_neg_iff gives the left side of the biconditional

existsi in this case brings up 0 to the rational numbers.
-/

/- Lemma
Not true that for any $a$, $b$, irrational numbers, the sum is
also an irrational number.
-/
theorem not_sum_irrational :
    ¬ ( ∀ (a b : ℝ), irrational a →  irrational b → irrational (a+b) ) :=
begin
  intro h,
  have H := h (sqrt 2) (-sqrt 2),
  have H3 := H irrational_sqrt_two (irrational_neg_iff.2 irrational_sqrt_two),
  apply H3,
  existsi (0 : ℚ),
  simp,
end

end xena -- hide