/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Antoine Chambert-Loir, María Inés de Frutos-Fernández

! This file was ported from Lean 3 source module ring_theory.mv_polynomial.weighted_homogeneous
! leanprover-community/mathlib commit bcbee715ab85a4f516c814effdf232618c0322af
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GradedMonoid
import Mathlib.Data.MvPolynomial.Variables

/-!
# Weighted homogeneous polynomials

It is possible to assign weights (in a commutative additive monoid `M`) to the variables of a
multivariate polynomial ring, so that monomials of the ring then have a weighted degree with
respect to the weights of the variables. The weights are represented by a function `w : σ → M`,
where `σ` are the indeterminates.

A multivariate polynomial `φ` is weighted homogeneous of weighted degree `m : M` if all monomials
occuring in `φ` have the same weighted degree `m`.

## Main definitions/lemmas

* `weightedTotalDegree' w φ` : the weighted total degree of a multivariate polynomial with respect
to the weights `w`, taking values in `with_bot M`.

* `weightedTotalDegree w φ` : When `M` has a `⊥` element, we can define the weighted total degree
of a multivariate polynomial as a function taking values in `M`.

* `IsWeightedHomogeneous w φ m`: a predicate that asserts that `φ` is weighted homogeneous
of weighted degree `m` with respect to the weights `w`.

* `weightedHomogeneousSubmodule R w m`: the submodule of homogeneous polynomials
of weighted degree `m`.

* `weightedHomogeneousComponent w m`: the additive morphism that projects polynomials
onto their summand that is weighted homogeneous of degree `n` with respect to `w`.

* `sum_weightedHomogeneousComponent`: every polynomial is the sum of its weighted homogeneous
components.
-/

noncomputable section

open Classical BigOperators

open Set Function Finset Finsupp AddMonoidAlgebra

variable {R M : Type _} [CommSemiring R]

namespace MvPolynomial

variable {σ : Type _}

section AddCommMonoid

variable [AddCommMonoid M]

/-! ### `weightedDegree'` -/

/-- The `weightedDegree'` of the finitely supported function `s : σ →₀ ℕ` is the sum
  `∑(s i)•(w i)`. -/
def weightedDegree' (w : σ → M) : (σ →₀ ℕ) →+ M :=
  (Finsupp.total σ M ℕ w).toAddMonoidHom
#align mv_polynomial.weighted_degree' MvPolynomial.weightedDegree'

section SemilatticeSup

variable [SemilatticeSup M]

/-- The weighted total degree of a multivariate polynomial, taking values in `WithBot M`. -/
def weightedTotalDegree' (w : σ → M) (p : MvPolynomial σ R) : WithBot M :=
  p.support.sup fun s => weightedDegree' w s
#align mv_polynomial.weighted_total_degree' MvPolynomial.weightedTotalDegree'

/-- The `weightedTotalDegree'` of a polynomial `p` is `⊥` if and only if `p = 0`. -/
theorem weightedTotalDegree'_eq_bot_iff (w : σ → M) (p : MvPolynomial σ R) :
    weightedTotalDegree' w p = ⊥ ↔ p = 0 := by
  simp only [weightedTotalDegree', Finset.sup_eq_bot_iff, mem_support_iff, WithBot.coe_ne_bot,
    MvPolynomial.eq_zero_iff]
  exact forall_congr' fun _ => Classical.not_not
#align mv_polynomial.weighted_total_degree'_eq_bot_iff MvPolynomial.weightedTotalDegree'_eq_bot_iff

/-- The `weightedTotalDegree'` of the zero polynomial is `⊥`. -/
theorem weightedTotalDegree'_zero (w : σ → M) : weightedTotalDegree' w (0 : MvPolynomial σ R) = ⊥ :=
  by simp only [weightedTotalDegree', support_zero, Finset.sup_empty]
#align mv_polynomial.weighted_total_degree'_zero MvPolynomial.weightedTotalDegree'_zero

section OrderBot

variable [OrderBot M]

/-- When `M` has a `⊥` element, we can define the weighted total degree of a multivariate
  polynomial as a function taking values in `M`. -/
def weightedTotalDegree (w : σ → M) (p : MvPolynomial σ R) : M :=
  p.support.sup fun s => weightedDegree' w s
#align mv_polynomial.weighted_total_degree MvPolynomial.weightedTotalDegree

/-- This lemma relates `weightedTotalDegree` and `weightedTotalDegree'`. -/
theorem weightedTotalDegree_coe (w : σ → M) (p : MvPolynomial σ R) (hp : p ≠ 0) :
    weightedTotalDegree' w p = ↑(weightedTotalDegree w p) := by
  rw [Ne.def, ← weightedTotalDegree'_eq_bot_iff w p, ← Ne.def, WithBot.ne_bot_iff_exists] at hp
  obtain ⟨m, hm⟩ := hp
  apply le_antisymm
  · simp only [weightedTotalDegree, weightedTotalDegree', Finset.sup_le_iff, WithBot.coe_le_coe]
    intro b
    exact Finset.le_sup
  · simp only [weightedTotalDegree]
    have hm' : weightedTotalDegree' w p ≤ m := le_of_eq hm.symm
    rw [← hm]
    simpa [weightedTotalDegree'] using hm'
#align mv_polynomial.weighted_total_degree_coe MvPolynomial.weightedTotalDegree_coe

/-- The `weightedTotalDegree` of the zero polynomial is `⊥`. -/
theorem weightedTotalDegree_zero (w : σ → M) : weightedTotalDegree w (0 : MvPolynomial σ R) = ⊥ :=
  by simp only [weightedTotalDegree, support_zero, Finset.sup_empty]
#align mv_polynomial.weighted_total_degree_zero MvPolynomial.weightedTotalDegree_zero

theorem le_weightedTotalDegree (w : σ → M) {φ : MvPolynomial σ R} {d : σ →₀ ℕ}
    (hd : d ∈ φ.support) : weightedDegree' w d ≤ φ.weightedTotalDegree w :=
  le_sup hd
#align mv_polynomial.le_weighted_total_degree MvPolynomial.le_weightedTotalDegree

end OrderBot

end SemilatticeSup

/-- A multivariate polynomial `φ` is weighted homogeneous of weighted degree `m` if all monomials
  occuring in `φ` have weighted degree `m`. -/
def IsWeightedHomogeneous (w : σ → M) (φ : MvPolynomial σ R) (m : M) : Prop :=
  ∀ ⦃d⦄, coeff d φ ≠ 0 → weightedDegree' w d = m
#align mv_polynomial.is_weighted_homogeneous MvPolynomial.IsWeightedHomogeneous

variable (R)

/-- The submodule of homogeneous `MvPolynomial`s of degree `n`. -/
def weightedHomogeneousSubmodule (w : σ → M) (m : M) : Submodule R (MvPolynomial σ R) where
  carrier := { x | x.IsWeightedHomogeneous w m }
  smul_mem' r a ha c hc := by
    rw [coeff_smul] at hc
    exact ha (right_ne_zero_of_mul hc)
  zero_mem' d hd := False.elim (hd <| coeff_zero _)
  add_mem' {a} {b} ha hb c hc := by
    rw [coeff_add] at hc
    obtain h | h : coeff c a ≠ 0 ∨ coeff c b ≠ 0 := by
      contrapose! hc
      simp only [hc, add_zero]
    · exact ha h
    · exact hb h
#align mv_polynomial.weighted_homogeneous_submodule MvPolynomial.weightedHomogeneousSubmodule

@[simp]
theorem mem_weightedHomogeneousSubmodule (w : σ → M) (m : M) (p : MvPolynomial σ R) :
    p ∈ weightedHomogeneousSubmodule R w m ↔ p.IsWeightedHomogeneous w m :=
  Iff.rfl
#align mv_polynomial.mem_weighted_homogeneous_submodule MvPolynomial.mem_weightedHomogeneousSubmodule

/-- The submodule `weightedHomogeneousSubmodule R w m` of homogeneous `MvPolynomial`s of
  degree `n` is equal to the `R`-submodule of all `p : (σ →₀ ℕ) →₀ R` such that
  `p.support ⊆ {d | weightedDegree' w d = m}`. While equal, the former has a
  convenient definitional reduction. -/

variable {R}

/-- The submodule generated by products `Pm * Pn` of weighted homogeneous polynomials of degrees `m`
  and `n` is contained in the submodule of weighted homogeneous polynomials of degree `m + n`. -/
theorem weightedHomogeneousSubmodule_mul (w : σ → M) (m n : M) :
    weightedHomogeneousSubmodule R w m * weightedHomogeneousSubmodule R w n ≤
      weightedHomogeneousSubmodule R w (m + n) := by
  rw [Submodule.mul_le]
  intro φ hφ ψ hψ c hc
  rw [coeff_mul] at hc
  obtain ⟨⟨d, e⟩, hde, H⟩ := Finset.exists_ne_zero_of_sum_ne_zero hc
  have aux : coeff d φ ≠ 0 ∧ coeff e ψ ≠ 0 := by
    contrapose! H
    by_cases h : coeff d φ = 0 <;>
      simp_all only [Ne.def, not_false_iff, MulZeroClass.zero_mul, MulZeroClass.mul_zero]
  rw [← Finsupp.mem_antidiagonal.mp hde, ← hφ aux.1, ← hψ aux.2, map_add]
#align mv_polynomial.weighted_homogeneous_submodule_mul MvPolynomial.weightedHomogeneousSubmodule_mul

/-- Monomials are weighted homogeneous. -/
theorem isWeightedHomogeneous_monomial (w : σ → M) (d : σ →₀ ℕ) (r : R) {m : M}
    (hm : weightedDegree' w d = m) : IsWeightedHomogeneous w (monomial d r) m := by
  intro c hc
  rw [coeff_monomial] at hc
  split_ifs at hc with h
  · subst c
    exact hm
  · contradiction
#align mv_polynomial.is_weighted_homogeneous_monomial MvPolynomial.isWeightedHomogeneous_monomial

/-- A polynomial of weightedTotalDegree `⊥` is weighted_homogeneous of degree `⊥`. -/
theorem isWeightedHomogeneous_of_total_degree_zero [SemilatticeSup M] [OrderBot M] (w : σ → M)
    {p : MvPolynomial σ R} (hp : weightedTotalDegree w p = (⊥ : M)) :
    IsWeightedHomogeneous w p (⊥ : M) := by
  intro d hd
  have h := weightedTotalDegree_coe w p (MvPolynomial.ne_zero_iff.mpr ⟨d, hd⟩)
  simp only [weightedTotalDegree', hp] at h
  rw [eq_bot_iff, ← WithBot.coe_le_coe, ← h]
  apply Finset.le_sup (mem_support_iff.mpr hd)
#align mv_polynomial.is_weighted_homogeneous_of_total_degree_zero MvPolynomial.isWeightedHomogeneous_of_total_degree_zero

/-- Constant polynomials are weighted homogeneous of degree 0. -/
theorem isWeightedHomogeneous_C (w : σ → M) (r : R) :
    IsWeightedHomogeneous w (C r : MvPolynomial σ R) 0 :=
  isWeightedHomogeneous_monomial _ _ _ (map_zero _)
set_option linter.uppercaseLean3 false in
#align mv_polynomial.is_weighted_homogeneous_C MvPolynomial.isWeightedHomogeneous_C

variable (R)

/-- 0 is weighted homogeneous of any degree. -/
theorem isWeightedHomogeneous_zero (w : σ → M) (m : M) :
    IsWeightedHomogeneous w (0 : MvPolynomial σ R) m :=
  (weightedHomogeneousSubmodule R w m).zero_mem
#align mv_polynomial.is_weighted_homogeneous_zero MvPolynomial.isWeightedHomogeneous_zero

/-- 1 is weighted homogeneous of degree 0. -/
theorem isWeightedHomogeneous_one (w : σ → M) : IsWeightedHomogeneous w (1 : MvPolynomial σ R) 0 :=
  isWeightedHomogeneous_C _ _
#align mv_polynomial.is_weighted_homogeneous_one MvPolynomial.isWeightedHomogeneous_one

/-- An indeterminate `i : σ` is weighted homogeneous of degree `w i`. -/
theorem isWeightedHomogeneous_X (w : σ → M) (i : σ) :
    IsWeightedHomogeneous w (X i : MvPolynomial σ R) (w i) := by
  apply isWeightedHomogeneous_monomial
  simp only [weightedDegree', LinearMap.toAddMonoidHom_coe, total_single, one_nsmul]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.is_weighted_homogeneous_X MvPolynomial.isWeightedHomogeneous_X

namespace IsWeightedHomogeneous

variable {R}

variable {φ ψ : MvPolynomial σ R} {m n : M}

/-- The weighted degree of a weighted homogeneous polynomial controls its support. -/
theorem coeff_eq_zero {w : σ → M} (hφ : IsWeightedHomogeneous w φ n) (d : σ →₀ ℕ)
    (hd : weightedDegree' w d ≠ n) : coeff d φ = 0 := by
  have aux := mt (@hφ d) hd
  rwa [Classical.not_not] at aux
#align mv_polynomial.is_weighted_homogeneous.coeff_eq_zero MvPolynomial.IsWeightedHomogeneous.coeff_eq_zero

/-- The weighted degree of a nonzero weighted homogeneous polynomial is well-defined. -/
theorem inj_right {w : σ → M} (hφ : φ ≠ 0) (hm : IsWeightedHomogeneous w φ m)
    (hn : IsWeightedHomogeneous w φ n) : m = n := by
  obtain ⟨d, hd⟩ : ∃ d, coeff d φ ≠ 0 := exists_coeff_ne_zero hφ
  rw [← hm hd, ← hn hd]
#align mv_polynomial.is_weighted_homogeneous.inj_right MvPolynomial.IsWeightedHomogeneous.inj_right

/-- The sum of two weighted homogeneous polynomials of degree `n` is weighted homogeneous of
  weighted degree `n`. -/
theorem add {w : σ → M} (hφ : IsWeightedHomogeneous w φ n) (hψ : IsWeightedHomogeneous w ψ n) :
    IsWeightedHomogeneous w (φ + ψ) n :=
  (weightedHomogeneousSubmodule R w n).add_mem hφ hψ
#align mv_polynomial.is_weighted_homogeneous.add MvPolynomial.IsWeightedHomogeneous.add

/-- The sum of weighted homogeneous polynomials of degree `n` is weighted homogeneous of
  weighted degree `n`. -/
theorem sum {ι : Type _} (s : Finset ι) (φ : ι → MvPolynomial σ R) (n : M) {w : σ → M}
    (h : ∀ i ∈ s, IsWeightedHomogeneous w (φ i) n) : IsWeightedHomogeneous w (∑ i in s, φ i) n :=
  (weightedHomogeneousSubmodule R w n).sum_mem h
#align mv_polynomial.is_weighted_homogeneous.sum MvPolynomial.IsWeightedHomogeneous.sum

/-- The product of weighted homogeneous polynomials of weighted degrees `m` and `n` is weighted
  homogeneous of weighted degree `m + n`. -/
theorem mul {w : σ → M} (hφ : IsWeightedHomogeneous w φ m) (hψ : IsWeightedHomogeneous w ψ n) :
    IsWeightedHomogeneous w (φ * ψ) (m + n) :=
  weightedHomogeneousSubmodule_mul w m n <| Submodule.mul_mem_mul hφ hψ
#align mv_polynomial.is_weighted_homogeneous.mul MvPolynomial.IsWeightedHomogeneous.mul

/-- A product of weighted homogeneous polynomials is weighted homogeneous, with weighted degree
  equal to the sum of the weighted degrees. -/
theorem prod {ι : Type _} (s : Finset ι) (φ : ι → MvPolynomial σ R) (n : ι → M) {w : σ → M} :
    (∀ i ∈ s, IsWeightedHomogeneous w (φ i) (n i)) →
      IsWeightedHomogeneous w (∏ i in s, φ i) (∑ i in s, n i) := by
  refine Finset.induction_on s ?_ ?_
  · intro
    simp only [isWeightedHomogeneous_one, Finset.sum_empty, Finset.prod_empty]
  · intro i s his IH h
    simp only [his, Finset.prod_insert, Finset.sum_insert, not_false_iff]
    apply (h i (Finset.mem_insert_self _ _)).mul (IH _)
    intro j hjs
    exact h j (Finset.mem_insert_of_mem hjs)
#align mv_polynomial.is_weighted_homogeneous.prod MvPolynomial.IsWeightedHomogeneous.prod

/-- A non zero weighted homogeneous polynomial of weighted degree `n` has weighted total degree
  `n`. -/
theorem weighted_total_degree [SemilatticeSup M] {w : σ → M} (hφ : IsWeightedHomogeneous w φ n)
    (h : φ ≠ 0) : weightedTotalDegree' w φ = n := by
  simp only [weightedTotalDegree']
  apply le_antisymm
  · simp only [Finset.sup_le_iff, mem_support_iff, WithBot.coe_le_coe]
    exact fun d hd => le_of_eq (hφ hd)
  · obtain ⟨d, hd⟩ : ∃ d, coeff d φ ≠ 0 := exists_coeff_ne_zero h
    simp only [← hφ hd, Finsupp.sum]
    replace hd := Finsupp.mem_support_iff.mpr hd
    apply Finset.le_sup hd
#align mv_polynomial.is_weighted_homogeneous.weighted_total_degree MvPolynomial.IsWeightedHomogeneous.weighted_total_degree

/-- The weighted homogeneous submodules form a graded monoid. -/
instance WeightedHomogeneousSubmodule.gcomm_monoid {w : σ → M} :
    SetLike.GradedMonoid (weightedHomogeneousSubmodule R w) where
  one_mem := isWeightedHomogeneous_one R w
  mul_mem _ _ _ _ := IsWeightedHomogeneous.mul
#align mv_polynomial.is_weighted_homogeneous.weighted_homogeneous_submodule.gcomm_monoid MvPolynomial.IsWeightedHomogeneous.WeightedHomogeneousSubmodule.gcomm_monoid

end IsWeightedHomogeneous

variable {R}

/-- `weightedHomogeneousComponent w n φ` is the part of `φ` that is weighted homogeneous of
  weighted degree `n`, with respect to the weights `w`.
  See `sum_weightedHomogeneousComponent` for the statement that `φ` is equal to the sum
  of all its weighted homogeneous components. -/
def weightedHomogeneousComponent (w : σ → M) (n : M) : MvPolynomial σ R →ₗ[R] MvPolynomial σ R :=
  (Submodule.subtype _).comp <| Finsupp.restrictDom _ _ { d | weightedDegree' w d = n }
#align mv_polynomial.weighted_homogeneous_component MvPolynomial.weightedHomogeneousComponent

section WeightedHomogeneousComponent

variable {w : σ → M} (n : M) (φ ψ : MvPolynomial σ R)

theorem coeff_weightedHomogeneousComponent (d : σ →₀ ℕ) :
    coeff d (weightedHomogeneousComponent w n φ) =
      if weightedDegree' w d = n then coeff d φ else 0 :=
  Finsupp.filter_apply (fun d : σ →₀ ℕ => weightedDegree' w d = n) φ d
#align mv_polynomial.coeff_weighted_homogeneous_component MvPolynomial.coeff_weightedHomogeneousComponent

theorem weightedHomogeneousComponent_apply :
    weightedHomogeneousComponent w n φ =
      ∑ d in φ.support.filter fun d => weightedDegree' w d = n, monomial d (coeff d φ) :=
  Finsupp.filter_eq_sum (fun d : σ →₀ ℕ => weightedDegree' w d = n) φ
#align mv_polynomial.weighted_homogeneous_component_apply MvPolynomial.weightedHomogeneousComponent_apply

/-- The `n` weighted homogeneous component of a polynomial is weighted homogeneous of
weighted degree `n`. -/
theorem weightedHomogeneousComponent_isWeightedHomogeneous :
    (weightedHomogeneousComponent w n φ).IsWeightedHomogeneous w n := by
  intro d hd
  contrapose! hd
  rw [coeff_weightedHomogeneousComponent, if_neg hd]
#align mv_polynomial.weighted_homogeneous_component_is_weighted_homogeneous MvPolynomial.weightedHomogeneousComponent_isWeightedHomogeneous

@[simp]
theorem weightedHomogeneousComponent_C_mul (n : M) (r : R) :
    weightedHomogeneousComponent w n (C r * φ) = C r * weightedHomogeneousComponent w n φ := by
  simp only [C_mul', LinearMap.map_smul]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.weighted_homogeneous_component_C_mul MvPolynomial.weightedHomogeneousComponent_C_mul

theorem weightedHomogeneousComponent_eq_zero'
    (h : ∀ d : σ →₀ ℕ, d ∈ φ.support → weightedDegree' w d ≠ n) :
    weightedHomogeneousComponent w n φ = 0 := by
  rw [weightedHomogeneousComponent_apply, sum_eq_zero]
  intro d hd; rw [mem_filter] at hd
  exfalso; exact h _ hd.1 hd.2
#align mv_polynomial.weighted_homogeneous_component_eq_zero' MvPolynomial.weightedHomogeneousComponent_eq_zero'

theorem weightedHomogeneousComponent_eq_zero [SemilatticeSup M] [OrderBot M]
    (h : weightedTotalDegree w φ < n) : weightedHomogeneousComponent w n φ = 0 := by
  rw [weightedHomogeneousComponent_apply, sum_eq_zero]
  intro d hd
  have := @Finset.mem_filter _ _
      (fun a => propDecidable ((fun d => weightedDegree' w d = n) a)) (support φ)
  rw [this] at hd
  exfalso
  apply lt_irrefl n
  nth_rw 1 [← hd.2]
  exact lt_of_le_of_lt (le_weightedTotalDegree w hd.1) h
#align mv_polynomial.weighted_homogeneous_component_eq_zero MvPolynomial.weightedHomogeneousComponent_eq_zero

theorem weightedHomogeneousComponent_finsupp :
    (Function.support fun m => weightedHomogeneousComponent w m φ).Finite := by
  suffices
    (Function.support fun m => weightedHomogeneousComponent w m φ) ⊆
      (fun d => weightedDegree' w d) '' φ.support by
    exact Finite.subset ((fun d : σ →₀ ℕ => (weightedDegree' w) d) '' ↑(support φ)).toFinite this
  intro m hm
  by_contra hm'
  apply hm
  simp only [mem_support, Ne.def] at hm
  simp only [Set.mem_image, not_exists, not_and] at hm'
  exact weightedHomogeneousComponent_eq_zero' m φ hm'
#align mv_polynomial.weighted_homogeneous_component_finsupp MvPolynomial.weightedHomogeneousComponent_finsupp

variable (w)

/-- Every polynomial is the sum of its weighted homogeneous components. -/
theorem sum_weightedHomogeneousComponent :
    (finsum fun m => weightedHomogeneousComponent w m φ) = φ := by
  rw [finsum_eq_sum _ (weightedHomogeneousComponent_finsupp φ)]
  ext1 d
  simp only [coeff_sum, coeff_weightedHomogeneousComponent]
  rw [Finset.sum_eq_single (weightedDegree' w d)]
  · rw [if_pos rfl]
  · intro m _ hm'
    rw [if_neg hm'.symm]
  · intro hm
    rw [if_pos rfl]
    simp only [Finite.mem_toFinset, mem_support, Ne.def, Classical.not_not] at hm
    have := coeff_weightedHomogeneousComponent (w := w) (weightedDegree' w d) φ d
    rw [hm, if_pos rfl, coeff_zero] at this
    exact this.symm
#align mv_polynomial.sum_weighted_homogeneous_component MvPolynomial.sum_weightedHomogeneousComponent

variable {w}

/-- The weighted homogeneous components of a weighted homogeneous polynomial. -/
theorem weightedHomogeneousComponent_weighted_homogeneous_polynomial (m n : M)
    (p : MvPolynomial σ R) (h : p ∈ weightedHomogeneousSubmodule R w n) :
    weightedHomogeneousComponent w m p = if m = n then p else 0 := by
  simp only [mem_weightedHomogeneousSubmodule] at h
  ext x
  rw [coeff_weightedHomogeneousComponent]
  by_cases zero_coeff : coeff x p = 0
  · split_ifs
    all_goals simp only [zero_coeff, coeff_zero]
  · rw [h zero_coeff]
    simp only [show n = m ↔ m = n from eq_comm]
    split_ifs with h1
    · rfl
    · simp only [coeff_zero]
#align mv_polynomial.weighted_homogeneous_component_weighted_homogeneous_polynomial MvPolynomial.weightedHomogeneousComponent_weighted_homogeneous_polynomial

end WeightedHomogeneousComponent

end AddCommMonoid

section CanonicallyOrderedAddMonoid

variable [CanonicallyOrderedAddMonoid M] {w : σ → M} (φ : MvPolynomial σ R)

/-- If `M` is a `CanonicallyOrderedAddMonoid`, then the `weightedHomogeneousComponent`
  of weighted degree `0` of a polynomial is its constant coefficient. -/
@[simp]
theorem weightedHomogeneousComponent_zero [NoZeroSMulDivisors ℕ M] (hw : ∀ i : σ, w i ≠ 0) :
    weightedHomogeneousComponent w 0 φ = C (coeff 0 φ) := by
  ext1 d
  rcases Classical.em (d = 0) with (rfl | hd)
  · simp only [coeff_weightedHomogeneousComponent, if_pos, map_zero, coeff_zero_C]
  · rw [coeff_weightedHomogeneousComponent, if_neg, coeff_C, if_neg (Ne.symm hd)]
    simp only [weightedDegree', LinearMap.toAddMonoidHom_coe, Finsupp.total_apply, Finsupp.sum,
      sum_eq_zero_iff, Finsupp.mem_support_iff, Ne.def, smul_eq_zero, not_forall, not_or,
      and_self_left, exists_prop]
    simp only [FunLike.ext_iff, Finsupp.coe_zero, Pi.zero_apply, not_forall] at hd
    obtain ⟨i, hi⟩ := hd
    exact ⟨i, hi, hw i⟩
#align mv_polynomial.weighted_homogeneous_component_zero MvPolynomial.weightedHomogeneousComponent_zero

end CanonicallyOrderedAddMonoid

end MvPolynomial


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

-/

import data.nat.choose
import algebra.prod_equiv
import tactic.squeeze

/-
 Consider the identity
 (choose n k) =  (choose k-1 k-1) + (choose k k-1) + ... + (choose n-1 k-1)

 or
 (choose n+1 k+1) = (choose k k) + (choose k+1 k) + ... + (choose n k)
 This can be proved algebraically by induction.
 Alternatively, we can consider the set (P n k) of
 subsets A of size k in {0,..,n-1}, so |(P n k)| = (choose n k).
 We can split this set up according to the value of (max A),
 and recover a combinatorial proof of the identity.

-/

lemma choose_sum' (k m : ℕ) :
 nat.choose (k + m) (k + 1) =
  (finset.range m).sum (λ i, nat.choose (k + i) k) :=
begin
 induction m with m ih,
 {rw[finset.range_zero,finset.sum_empty,add_zero,nat.choose_succ_self]},
 {rw[finset.sum_range_succ,← ih,nat.add_succ,nat.choose, add_comm],}
end

lemma choose_sum (n k : ℕ) :
 nat.choose n.succ k.succ = (finset.Ico k n.succ).sum (λ i, nat.choose i k) :=
begin
 by_cases h : k ≤ n.succ,
 { let m := n.succ - k,
   have : n.succ = k + m := by rw [add_comm, nat.sub_add_cancel h],
   rw [this] at h ⊢,
   rw [choose_sum' k m],
   let f : ℕ → ℕ := λ p, nat.choose p k,
   let g : ℕ → ℕ := has_add.add k,
   change (finset.range m).sum (λ i, f (g i)) = (finset.Ico k (k + m)).sum f,
   rw [← @finset.sum_image ℕ ℕ ℕ f _ _ (finset.range m) g
       (λ _ _ _ _, nat.add_left_cancel)],
   have : finset.range m = finset.Ico 0 m :=
   begin
     ext i,
     simp only [finset.mem_range, finset.mem_Ico, nat.zero_le i, true_and]
   end,
   rw [this],
   have := finset.image_add_left_Ico 0 m k,
   rw[add_zero] at this, rw[← this]},
  { have : finset.Ico k n.succ = ∅ :=
     finset.Ico_eq_empty_iff.mpr (λ h₀, h (le_of_lt h₀)),
    rw[this, finset.sum_empty],
    rw [nat.choose_eq_zero_of_lt (lt_trans (lt_of_not_ge h) k.lt_succ_self)] }
end


/-
Copyright (c) 2022 Georgi Kocharyan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.txt.
Author: Georgi Kocharyan.
-/

import .quasiisometry
import tactic
import data.real.basic
import topology.metric_space.isometry

variables {X : Type*} [pseudo_metric_space X]

def geodesic {X : Type*} [pseudo_metric_space X] (L : ℝ) (Lnonneg : L ≥ 0) (f: ((set.Icc) (0 : ℝ) L) → X) (x : X) (y: X) :=
 f (⟨0, le_rfl, Lnonneg⟩) = x ∧ f (⟨L, Lnonneg, le_rfl⟩) = y ∧ isometry f

def conn_by_geodesic {X : Type*} [pseudo_metric_space X] (x : X) (y: X) : Prop :=
∃ (L : ℝ) (Lpos : L ≥ 0) (f: ((set.Icc) (0 : ℝ) L) → X), geodesic L Lpos f x y

class geodesic_space (β : Type*)  extends pseudo_metric_space β :=
(geodesics: ∀ x y : β, conn_by_geodesic x y)

-- def quasigeodesic {X : Type*} [pseudo_metric_space X] (L : ℝ) (Lnonneg : L ≥ 0) (f: ((set.Icc) (0 : ℝ) L) → X)
--  (x : X) (y: X) (c : ℝ) (b : ℝ) :=
--  f (⟨0, le_rfl, Lnonneg⟩) = x ∧ f (⟨L, Lnonneg, le_rfl⟩) = y ∧ is_QIE' f c b

def quasigeodesic {X : Type*} [pseudo_metric_space X] (L : ℝ) (Lnonneg : L ≥ 0) (f: ℝ → X)
 (x : X) (y: X) (c : ℝ) (b : ℝ) :=
 f 0 = x ∧ f L = y ∧ (∀ m n  ∈ {x : ℝ| 0 ≤ x ∧ x ≤ L}, (1/c)*(abs (m-n)) - b ≤ dist (f m) (f n) ∧ dist (f m) (f n) ≤ c * (abs (m-n)) + b)

-- any segment of a quasigeodesic is also a quasigeodesic

lemma trunc_quasigeodesic {X : Type*} [pseudo_metric_space X] (L : ℝ) (Lnonneg : L ≥ 0) (f: ℝ → X)
 (x : X) (y: X) (c : ℝ) (b : ℝ) {L' : ℝ} (hL' : L' ≤ L) (L'nonneg : L' ≥ 0) (hf : quasigeodesic L Lnonneg f x y c b)
  : quasigeodesic L' L'nonneg f x (f L') c b :=
begin
split,
exact hf.1,
split, refl,
intros a ha b hb,
have ha' : a ∈ {x : ℝ| 0 ≤ x ∧ x ≤ L},
  { exact ⟨ha.1, le_trans ha.2 hL'⟩, },
have hb' : b ∈ {x : ℝ| 0 ≤ x ∧ x ≤ L},
  { exact ⟨hb.1, le_trans hb.2 hL'⟩,},
apply (hf.2).2 a ha' b hb',
end

-- if a geodesic has length 0, the endpoints are the same

lemma degenerate_quasigeodesic {X : Type*} [pseudo_metric_space X] (f: ℝ → X)
 (x : X) (y: X) (c : ℝ) (b : ℝ) (hf : quasigeodesic 0 (le_refl 0) f x y c b) : x = y :=
 eq.trans (hf.1.symm) hf.2.1

definition fpi (L : ℝ) (Lpos : L ≥ 0) (f: ((set.Icc) (0 : ℝ) L) → X) : Π (a : ℝ),(a ≥ 0 ∧ a ≤ L) → X :=
begin
intros a ha,
cases ha with h1 h2,
exact f(⟨a, h1, h2 ⟩),
end

def conn_by_quasigeodesic {X : Type*} [pseudo_metric_space X] (x : X) (y: X) : Prop :=
∃ (L : ℝ) (Lnonneg : L ≥ 0) (f: ℝ → X) (c : ℝ) (b : ℝ), quasigeodesic L Lnonneg f x y c b

def conn_by_quasigeodesic' {X : Type*} [pseudo_metric_space X] (x : X) (y: X) (c : ℝ) (b : ℝ) : Prop :=
∃ (L : ℝ) (Lnonneg : L ≥ 0) (f: ℝ → X) , quasigeodesic L Lnonneg f x y c b

class quasigeodesic_space (β : Type*) (c : ℝ) (b : ℝ) (cpos: c > 0) (bnonneg: b ≥ 0)  extends pseudo_metric_space β :=
(quasigeodesics: ∀ x y : β, conn_by_quasigeodesic' x y c b)


import ..prooflab
import lectures.lec6_proposition

/-! # Homework 5: ...
Homework must be done individually.
Replace the placeholders (e.g., `:= sorry`) with your solutions.

You are allowed to use all the tactics we have learned so far.
 -/

namespace PROOFS

/-! ## Question 1 (20 points):
(**Part I**) Give a proof of the following propositional formula.
-/

theorem  disj_conj {P Q R : Prop} :
  (P ∨ Q → R) ↔ (P → R) ∧ (Q → R) :=
begin
  sorry,
end

/-
(**Part II**) In `lec6_proposition` we proved that
`P ∨ Q → ¬ P → Q`. The proof was `resolve_right`.

Use the previous theorem (`disj_conj`) to give a new proof of `P ∨ Q → ¬ P → Q`.
-/

theorem resolve_right_alt {P Q : Prop} :
 P ∨ Q → ¬ P → Q :=
begin
  sorry,
end

/-! ## Question 2 (20 points):
Give a proof of the following statement.
-/
example (a b c : ℝ) (h₁ : c * a ≤ c * b) (h₂ : ¬ b ≤ a) :
  c * a ≤ c * b ∧ a ≠ b :=
begin
  sorry,
end

/-! ## Question 3 (20 points):
Give a proof of the following statements using only lemmas `neg_neg`, `neg_lt`, `neg_le`. The first one states that negation flips the strict order (<) , and the second one states that negation flips the order (≤).
-/

lemma lt_rev_of_neg {x y : ℝ} (h : x < y)
  : - y < - x :=
begin
  sorry,
end

lemma le_rev_of_neg {x y : ℝ} (h : x ≤ y)
  : - y ≤ - x :=
begin
  sorry,
end

/-! ## Question 4 (20 points):
Use the two lemmas `lt_rev_of_neg` and `le_rev_of_neg` above together with some/all of the following lemmas to prove the following statement.
-/

#check le_or_gt
#check abs_of_nonneg
#check abs_of_neg
#check neg_neg
#check lt_of_lt_of_le
#check lt_of_le_of_lt
#check le_trans
#check lt_trans

example (x y : ℝ ) :
  abs x < y ↔ - y < x ∧ x < y :=
begin
  sorry,
end

/-! ## Question 5 (20 points): -/

def EM (P : Prop) :=
P ∨ ¬ P

#check EM

def DN (P : Prop) :=
(¬ P → false) → P

#check DN

theorem excluded_implies_double_negation  {P : Prop} : EM P → DN P :=
begin
 unfold EM,
 unfold DN,
 sorry,
end

end PROOFS


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

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 4 : "and" (`∧`)

We learn about how to manipulate `P ∧ Q` in Lean.

## Tactics

You'll need to know about the tactics from the previous sheets,
and also the following tactics:

* `cases`
* `split`

### The `cases` tactic

If `h : P ∧ Q` is a hypothesis, then `cases h with hP hQ,`
decomposes it into two hypotheses `hP : P` and `hQ : Q`.

### The `split` tactic

If `⊢ P ∧ Q` is in the goal, The `split` tactic will turn it into
two goals, `⊢ P` and `⊢ Q`. NB tactics operate on the first goal only.

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variables (P Q R : Prop)

example : P ∧ Q → P :=
begin
  sorry
end

example : P ∧ Q → Q :=
begin
  sorry
end

example : (P → Q → R) → (P ∧ Q → R) :=
begin
  sorry
end

example : P → Q → P ∧ Q :=
begin
  sorry
end

/-- `∧` is symmetric -/
example : P ∧ Q → Q ∧ P :=
begin
  sorry
end

example : P → P ∧ true :=
begin
  sorry
end

example : false → P ∧ false :=
begin
  sorry
end

/-- `∧` is transitive -/
example : (P ∧ Q) → (Q ∧ R) → (P ∧ R) :=
begin
  sorry,
end

example : ((P ∧ Q) → R) → (P → Q → R) :=
begin
  sorry,
end


-- BOTH:
import data.real.basic

/- TEXT:
Calculating
-----------

We generally learn to carry out mathematical calculations
without thinking of them as proofs.
But when we justify each step in a calculation,
as Lean requires us to do,
the net result is a proof that the left-hand side of the calculation
is equal to the right-hand side.

.. index:: rewrite, rw, tactics ; rw and rewrite

In Lean, stating a theorem is tantamount to stating a goal,
namely, the goal of proving the theorem.
Lean provides the ``rewrite`` tactic, abbreviated ``rw``,
to replace the left-hand side of an identity by the right-hand side
in the goal. If ``a``, ``b``, and ``c`` are real numbers,
``mul_assoc a b c``  is the identity ``a * b * c = a * (b * c)``
and ``mul_comm a b`` is the identity ``a * b = b * a``.
Lean provides automation that generally eliminates the need
to refer the facts like these explicitly,
but they are useful for the purposes of illustration.
In Lean, multiplication associates to the left,
so the left-hand side of ``mul_assoc`` could also be written ``(a * b) * c``.
However, it is generally good style to be mindful of Lean's
notational conventions and leave out parentheses when Lean does as well.

Let's try out ``rw``.

.. index:: real numbers
TEXT. -/
/- An example. -/

-- QUOTE:
import data.real.basic
example (a b c : ℝ) : (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  rw mul_assoc b a c
end
-- QUOTE.

/- TEXT:
The ``import`` line at the beginning of the example
imports the theory of the real numbers from ``mathlib``.
For the sake of brevity,
we generally suppress information like this when it
is repeated from example to example.
Clicking the ``try it!`` button displays the full
example as it is meant to be processed and checked by Lean.

You are welcome to make changes to see what happens.
You can type the ``ℝ`` character as ``\R`` or ``\real``
in VS Code.
The symbol doesn't appear until you hit space or the tab key.
If you hover over a symbol when reading a Lean file,
VS Code will show you the syntax that can be used to enter it.
If your keyboard does not have an easily accessible backslash,
you can change the leading character by changing the
``lean.input.leader`` setting.

.. index:: proof state, local context, goal

When a cursor is in the middle of a tactic proof,
Lean reports on the current *proof state* in the
*Lean infoview* window.
As you move your cursor past each step of the proof,
you can see the state change.
A typical proof state in Lean might look as follows:

.. code-block::

    1 goal
    x y : ℕ,
    h₁ : prime x,
    h₂ : ¬even x,
    h₃ : y > x
    ⊢ y ≥ 4

The lines before the one that begins with ``⊢`` denote the *context*:
they are the objects and assumptions currently at play.
In this example, these include two objects, ``x`` and ``y``,
each a natural number.
They also include three assumptions,
labelled ``h₁``, ``h₂``, and ``h₃``.
In Lean, everything in a context is labelled with an identifier.
You can type these subscripted labels as ``h\1``, ``h\2``, and ``h\3``,
but any legal identifiers would do:
you can use ``h1``, ``h2``, ``h3`` instead,
or ``foo``, ``bar``, and ``baz``.
The last line represents the *goal*,
that is, the fact to be proved.
Sometimes people use *target* for the fact to be proved,
and *goal* for the combination of the context and the target.
In practice, the intended meaning is usually clear.

Try proving these identities,
in each case replacing ``sorry`` by a tactic proof.
With the ``rw`` tactic, you can use a left arrow (``\l``)
to reverse an identity.
For example, ``rw ← mul_assoc a b c``
replaces ``a * (b * c)`` by ``a * b * c`` in the current goal.
TEXT. -/
/- Try these.-/

-- QUOTE:
example (a b c : ℝ) : (c * b) * a = b * (a * c) :=
begin
  sorry
end

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  sorry
end
-- QUOTE.

-- SOLUTIONS:
example (a b c : ℝ) : (c * b) * a = b * (a * c) :=
begin
  rw mul_comm c b,
  rw mul_assoc b c a,
  rw mul_comm c a
end

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw ←mul_assoc a b c,
  rw mul_comm a b,
  rw mul_assoc b a c
end

/- TEXT:
You can also use identities like ``mul_assoc`` and ``mul_comm`` without arguments.
In this case, the rewrite tactic tries to match the left-hand side with
an expression in the goal,
using the first pattern it finds.
TEXT. -/
/- An example. -/

-- QUOTE:
example (a b c : ℝ) : a * b * c = b * c * a :=
begin
  rw mul_assoc,
  rw mul_comm
end
-- QUOTE.

/- TEXT:
You can also provide *partial* information.
For example, ``mul_comm a`` matches any pattern of the form
``a * ?`` and rewrites it to ``? * a``.
Try doing the first of these examples without
providing any arguments at all,
and the second with only one argument.
TEXT. -/
/- Try doing the first of these without providing any arguments at all,
   and the second with only one argument. -/

-- QUOTE:
example (a b c : ℝ) : a * (b * c) = b * (c * a) :=
begin
  sorry
end

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  sorry
end
-- QUOTE.

-- SOLUTIONS:
example (a b c : ℝ) : a * (b * c) = b * (c * a) :=
begin
  rw mul_comm,
  rw mul_assoc
end

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw ←mul_assoc,
  rw mul_comm a,
  rw mul_assoc
end

/- TEXT:
You an also use ``rw`` with facts from the local context.
TEXT. -/
/- Using facts from the local context. -/

-- QUOTE:
example (a b c d e f : ℝ) (h : a * b = c * d) (h' : e = f) :
  a * (b * e) = c * (d * f) :=
begin
  rw h',
  rw ←mul_assoc,
  rw h,
  rw mul_assoc
end
-- QUOTE.

/- TEXT:
Try these:
TEXT. -/
/- Try these. For the second one, use the theorem `sub_self`. -/

-- QUOTE:
example (a b c d e f : ℝ) (h : b * c = e * f) :
  a * b * c * d = a * e * f * d :=
begin
  sorry
end

example (a b c d : ℝ) (hyp : c = b * a - d) (hyp' : d = a * b) : c = 0 :=
begin
  sorry
end
-- QUOTE.

-- SOLUTIONS:
example (a b c d e f : ℝ) (h : b * c = e * f) :
  a * b * c * d = a * e * f * d :=
begin
  rw mul_assoc a,
  rw h,
  rw ←mul_assoc
end

example (a b c d : ℝ) (hyp : c = b * a - d) (hyp' : d = a * b) : c = 0 :=
begin
  rw hyp,
  rw hyp',
  rw mul_comm,
  rw sub_self
end

/- TEXT:
For the second one, you can use the theorem ``sub_self``,
where ``sub_self a`` is the identity ``a - a = 0``.

We now introduce some useful features of Lean.
First, multiple rewrite commands can be carried out
with a single command,
by listing the relevant identities within square brackets.
Second, when a tactic proof is just a single command,
we can replace the ``begin ... end`` block with a ``by``.
TEXT. -/
/- Examples. -/

-- QUOTE:
example (a b c d e f : ℝ) (h : a * b = c * d) (h' : e = f) :
  a * (b * e) = c * (d * f) :=
by rw [h', ←mul_assoc, h, mul_assoc]
-- QUOTE.

/- TEXT:
You still see the incremental progress by placing the cursor after
a comma in any list of rewrites.

Another trick is that we can declare variables once and for all outside
an example or theorem.
When Lean sees them mentioned in the statement of the theorem,
it includes them automatically.
TEXT. -/
section

-- QUOTE:
variables a b c d e f g : ℝ

example (h : a * b = c * d) (h' : e = f) :
  a * (b * e) = c * (d * f) :=
by rw [h', ←mul_assoc, h, mul_assoc]
-- QUOTE.

end

/- TEXT:
Inspection of the tactic state at the beginning of the above proof
reveals that Lean indeed included the relevant variables, leaving out
`g` that doesn't feature in the statement.
We can delimit the scope of the declaration by putting it
in a ``section ... end`` block.
Finally, recall from the introduction that Lean provides us with a
command to determine the type of an expression:
TEXT. -/
-- QUOTE:
section
variables a b c : ℝ

#check a
#check a + b
#check (a : ℝ)
#check mul_comm a b
#check (mul_comm a b : a * b = b * a)
#check mul_assoc c a b
#check mul_comm a
#check mul_comm
#check @mul_comm

end
-- QUOTE.

/- TEXT:
The ``#check`` command works for both objects and facts.
In response to the command ``#check a``, Lean reports that ``a`` has type ``ℝ``.
In response to the command ``#check mul_comm a b``,
Lean reports that ``mul_comm a b`` is a proof of the fact ``a * b = b * a``.
The command ``#check (a : ℝ)`` states our expectation that the
type of ``a`` is ``ℝ``,
and Lean will raise an error if that is not the case.
We will explain the output of the last three ``#check`` commands later,
but in the meanwhile, you can take a look at them,
and experiment with some ``#check`` commands of your own.

Let's try some more examples. The theorem ``two_mul a`` says
that ``2 * a = a + a``. The theorems ``add_mul`` and ``mul_add``
express the distributivity of multiplication over addition,
and the theorem ``add_assoc`` expresses the associativity of addition.
Use the ``#check`` command to see the precise statements.

.. index:: calc, tactics ; calc
TEXT. -/
section
variables a b : ℝ

-- QUOTE:
example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
begin
  rw [mul_add, add_mul, add_mul],
  rw [←add_assoc, add_assoc (a * a)],
  rw [mul_comm b a, ←two_mul]
end
-- QUOTE.

/- TEXT:
Whereas it is possible to figure out what it going on in this proof
by stepping through it in the editor,
it is hard to read on its own.
Lean provides a more structured way of writing proofs like this
using the ``calc`` keyword.
TEXT. -/
-- QUOTE:
example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
calc
  (a + b) * (a + b)
      = a * a + b * a + (a * b + b * b) :
          by rw [mul_add, add_mul, add_mul]
  ... = a * a + (b * a + a * b) + b * b :
          by rw [←add_assoc, add_assoc (a * a)]
  ... = a * a + 2 * (a * b) + b * b     :
          by rw [mul_comm b a, ←two_mul]
-- QUOTE.

/- TEXT:
Notice that there is no more ``begin ... end`` block:
an expression that begins with ``calc`` is a *proof term*.
A ``calc`` expression can also be used inside a tactic proof,
but Lean interprets it as the instruction to use the resulting
proof term to solve the goal.

The ``calc`` syntax is finicky: the dots and colons and justification
have to be in the format indicated above.
Lean ignores whitespace like spaces, tabs, and returns,
so you have some flexibility to make the calculation look more attractive.
One way to write a ``calc`` proof is to outline it first
using the ``sorry`` tactic for justification,
make sure Lean accepts the expression modulo these,
and then justify the individual steps using tactics.
TEXT. -/

-- QUOTE:
example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
calc
  (a + b) * (a + b)
      = a * a + b * a + (a * b + b * b) :
    begin
      sorry
    end
  ... = a * a + (b * a + a * b) + b * b : by sorry
  ... = a * a + 2 * (a * b) + b * b     : by sorry
-- QUOTE.
end

/- TEXT:
Try proving the following identity using both a pure ``rw`` proof
and a more structured ``calc`` proof:
TEXT. -/
/- Try these. For the second, use the theorems listed underneath. -/

section
variables a b c d : ℝ

-- QUOTE:
example : (a + b) * (c + d) = a * c + a * d + b * c + b * d :=
sorry
-- QUOTE.

/- TEXT:
The following exercise is a little more challenging.
You can use the theorems listed underneath.
TEXT. -/
-- QUOTE:
example (a b : ℝ) : (a + b) * (a - b) = a^2 - b^2 :=
begin
  sorry
end

#check pow_two a
#check mul_sub a b c
#check add_mul a b c
#check add_sub a b c
#check sub_sub a b c
#check add_zero a
-- QUOTE.

end

/- TEXT:
.. index:: rw, tactics ; rw and rewrite

We can also perform rewriting in an assumption in the context.
For example, ``rw mul_comm a b at hyp`` replaces ``a * b`` by ``b * a``
in the assumption ``hyp``.
TEXT. -/
/- Examples. -/

section
variables a b c d : ℝ

-- QUOTE:
example (a b c d : ℝ) (hyp : c = d * a + b) (hyp' : b = a * d) :
  c = 2 * a * d :=
begin
  rw hyp' at hyp,
  rw mul_comm d a at hyp,
  rw ← two_mul (a * d) at hyp,
  rw ← mul_assoc 2 a d at hyp,
  exact hyp
end
-- QUOTE.

/- TEXT:
.. index:: exact, tactics ; exact

In the last step, the ``exact`` tactic can use ``hyp`` to solve the goal
because at that point ``hyp`` matches the goal exactly.

.. index:: ring (tactic), tactics ; ring

We close this section by noting that ``mathlib`` provides a
useful bit of automation with a ``ring`` tactic,
which is designed to prove identities in any commutative ring.
TEXT. -/
-- QUOTE:
example : (c * b) * a = b * (a * c) :=
by ring

example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
by ring

example : (a + b) * (a - b) = a^2 - b^2 :=
by ring

example (hyp : c = d * a + b) (hyp' : b = a * d) :
  c = 2 * a * d :=
begin
  rw [hyp, hyp'],
  ring
end
-- QUOTE.

end

/- TEXT:
The ``ring`` tactic is imported indirectly when we
import ``data.real.basic``,
but we will see in the next section that it can be used
for calculations on structures other than the real numbers.
It can be imported explicitly with the command
``import tactic``.
We will see there are similar tactics for other common kind of algebraic
structures.

There is a variation of ``rw`` called ``nth_rewrite`` that allows you to replace only particular instances of an expression in the goal.
Possible matches are enumerated starting with zero,
so in the following example, ``nth_rewrite 1 h`` replaces the *second*
occurrence of ``a + b`` with ``c``.
EXAMPLES: -/
-- QUOTE:
example (a b c : ℕ) (h : a + b = c) : (a + b) * (a + b) = a * c + b * c :=
begin
  nth_rewrite 1 h,
  rw add_mul
end
-- QUOTE.

/- TEXT:
See also ``nth_rewrite_lhs`` and ``nth_rewrite_rhs``.
For a more sophisticed means of rewriting particular subexpressions,
see the `documentation for the conversion tactic <https://leanprover-community.github.io/extras/conv.html>`_.
TEXT. -/


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll
-/
import data.zmod.basic
import ring_theory.int.basic

/-!
# Coprimality and vanishing

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

We show that for prime `p`, the image of an integer `a` in `zmod p` vanishes if and only if
`a` and `p` are not coprime.
-/

namespace zmod

/-- If `p` is a prime and `a` is an integer, then `a : zmod p` is zero if and only if
`gcd a p ≠ 1`. -/
lemma eq_zero_iff_gcd_ne_one {a : ℤ} {p : ℕ} [pp : fact p.prime] : (a : zmod p) = 0 ↔ a.gcd p ≠ 1 :=
by rw [ne, int.gcd_comm, int.gcd_eq_one_iff_coprime,
       (nat.prime_iff_prime_int.1 pp.1).coprime_iff_not_dvd, not_not, int_coe_zmod_eq_zero_iff_dvd]

/-- If an integer `a` and a prime `p` satisfy `gcd a p = 1`, then `a : zmod p` is nonzero. -/
lemma ne_zero_of_gcd_eq_one {a : ℤ} {p : ℕ} (pp : p.prime) (h : a.gcd p = 1) :
  (a : zmod p) ≠ 0 :=
mt (@eq_zero_iff_gcd_ne_one a p ⟨pp⟩).mp (not_not.mpr h)

/-- If an integer `a` and a prime `p` satisfy `gcd a p ≠ 1`, then `a : zmod p` is zero. -/
lemma eq_zero_of_gcd_ne_one {a : ℤ} {p : ℕ} (pp : p.prime) (h : a.gcd p ≠ 1) :
  (a : zmod p) = 0 :=
(@eq_zero_iff_gcd_ne_one a p ⟨pp⟩).mpr h

end zmod


variables p q r : Prop

namespace mth1001

section false_and_negation

/-
`false` is the name of a special proposition from which we can derive anything.
In ordinary mathematics, `false` is written `⊥` and is referred to as an
'arbitrary contradiction' or sometimes just 'contradiction'.

The tactic `exfalso` is used to turn any goal into a proof of `false`.

Side note: `exfalso` is short for the Latin 'ex falso sequitur quodlibet',
which translates to, 'from a contradiction, whatever you please follows'.
-/

example : false → p :=
begin
  assume h : false, -- I could equally have written `intro h`.
  exfalso,
  exact h,
end

/-
In term style, `false.elim h` provides a proof of anything, given that `h` is
a proof of `false`.`
-/
example : false → p :=
assume h, false.elim h

/-
An more powerful tactic is `contradiction`. This tactic looks in the context and goal for a
contradition and closes the goal if it finds one.
-/
example : false → p :=
begin
  contradiction,
end

-- Exercise 057:
-- Use `exfalso` in proving the following result. Try another proof using `contradiction`.
example : (¬p ∨ q) → (p → q) :=
begin
  intros h hp,  /- `intros h hp` is equivalent to `intro h, intro hp`. -/

  sorry
end

/-
`false` may seem bizzare, but it's just what we need for formalising the notion
of 'not'. The notation `¬p` is an abbreviation for `p → false`. The symbol
`¬` is written `\n`. We read `¬p` as 'not p'.

In general, to prove `a → b` is to assume `a` and deduce `b`. Thus, to prove
`¬p` is to assume `p` and deduce `false`.
-/

/-
The first thing to observe is that we may derive `false` from `¬p` and `p` by
implication elimination, as `¬p` means `p → false`.
-/
example (h₁ : ¬p) (h₂ : p) : false :=
h₁ h₂

/-
Given it's not the case that you like tea or coffe, one can deduce it's not
the case that you like tea.
-/
example (h : ¬(p ∨ q)) : ¬p :=
begin
  intro hp, -- Assume hp : p. It remains to prove `false`.
  have hpq : p ∨ q, from or.inl hp,
  show false, from h hpq, -- Or just `h hpq` or `contradiction`.
end

-- Exercise 058:
-- Given `p`, we can derive `¬¬p`. This is part of the law of double negation.
theorem not_not_of_self : p → ¬¬p :=
begin
  intros hp hnp,
  sorry
end

/-
British mathematician Augustus De Morgan is famous in part for several laws of
logic. We'll build them up from scratch.
-/

-- Exercise 059:
theorem not_or_of_not_and_not : ¬p ∧ ¬q →  ¬(p ∨ q) :=
begin
  intros h hpq,
  cases hpq with hp hq,
  { sorry, },
  { sorry, },
end

-- Exercise 060:
theorem not_and_of_not_or_not : ¬p ∨ ¬q → ¬(p ∧ q) :=
begin
  sorry
end

-- Exercise 061:
theorem not_and_not_of_not_or : ¬(p ∨ q) → ¬p ∧ ¬q :=
begin
  sorry
end

/-
We'll later see that `p → q` is equivalent to `¬q → ¬p`, the so-called 'contrapositive' of
`p → q`. We prove one direction of this equivalence below.
-/

-- Exercise 062:
example : (p → q) → (¬q → ¬p) :=
begin
  intros hpq hnq hp,
  sorry
end

end false_and_negation

/-
SUMMARY:

* `false`, the name for an arbitrary contradiction.
* Anything can be proved from false, using `exfalso` (tactic-style) or `false.elim` (term-style).
* The `contradiction` tactic to automate contradiction finding.
* Introducing multiple assumptions with `intros`.
* `¬p` as a shortcut for `p → false`.
* The law of double negation.
-/

end mth1001


axiom excluded_middle : ∀ P: Prop, P ∨ ¬ P
#check excluded_middle

theorem double_neg_elim: ∀ P: Prop, ¬ ¬ P → P :=
begin
  assume P : Prop,
  assume pfNotNotP : ¬ ¬ P,
  cases excluded_middle P,
    -- case 1:
    show P, from h,

    have f: false := pfNotNotP h,
    exact false.elim f
end

theorem nat_eq : ∀ (n : nat), ∀ (m : nat),
    m = n ∨ m ≠ n :=
begin
    assume n m: nat,
    cases excluded_middle (m=n) with h1 h2,
        exact or.inl h1,
        exact or.inr h2
end

open classical
theorem nat_eq' : ∀ (n : nat), ∀ (m : nat),
    m = n ∨ m ≠ n :=
begin
    assume n m: nat,
    cases em (m=n),
        exact or.inl h,
        exact or.inr h
end

theorem double_neg_elim'': ∀ {P}, (P ∨ ¬P) → ¬¬P → P :=
begin
    assume P: Prop,
    assume h: P ∨ ¬P,
    assume notnotP: ¬¬P,
    cases h with a b,
        show P, from a,
        show P, from false.elim (notnotP b),
end

theorem p_b_c' : ∀ P: Prop, (¬P → false) → P :=
begin
    intro P,
    assume nnp: ¬P → false,
    have a := double_neg_elim P nnp,
    exact a
end

theorem p_b_c'' : ∀ P: Prop, (¬P → false) → P := double_neg_elim


/-
Copyright (c) 2020 The Xena project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kevin Buzzard
Thanks: Imperial College London, leanprover-community
-/

-- import levels 1 and 2
import complex.Level_02_I

/-! # Level 3: Complex conjugation -/

namespace complex

-- First complete the definition using `complex.mk` or `⟨x, y⟩` notation

/-- The complex conjugate of a complex number -/
def conj (z : ℂ) : ℂ := sorry

-- Now prove how it interacts with everything else

/-! ## Real and imaginary parts -/

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

/-! ## Behaviour with respect to 0, 1 and I -/

@[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_neg_I : conj (-I) = I := sorry

/-! ## Behaviour with respect to +, - and * -/

@[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_mul (z w : ℂ) : conj (z * w) = conj z * conj w :=
sorry

/-! ## Behaviour with respect to real numbers -/

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

lemma im_eq_zero_of_eq_conj {z : ℂ} : conj z = z → im 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

/-! ## Properties of the `conj` map -/

@[simp] lemma conj_conj (z : ℂ) : conj (conj z) = z :=
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

/-

A ring homomorphism in Lean is the following collection
of data: a map, and the proof that it commutes with
the ring structures in the obvious way. Here we observe
that the work we've done is enough to define the
ring homomorphism complex conjugation.

-/

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

-- Two optional lemmas which computer scientists like,
-- giving us easy access to some basic properties
-- of conj

open function

lemma conj_involutive : involutive conj := sorry

lemma conj_bijective : bijective conj := sorry

end complex


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module data.int.div
! leanprover-community/mathlib commit ee0c179cd3c8a45aa5bffbf1b41d8dbede452865
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Int.Dvd.Basic
import Mathlib.Data.Nat.Order.Lemmas
import Mathlib.Algebra.Ring.Regular

/-!
# Lemmas relating `/` in `ℤ` with the ordering.
-/

open Nat

namespace Int

theorem eq_mul_div_of_mul_eq_mul_of_dvd_left {a b c d : ℤ} (hb : b ≠ 0) (hbc : b ∣ c)
    (h : b * a = c * d) : a = c / b * d := by
  cases' hbc with k hk
  subst hk
  rw [Int.mul_ediv_cancel_left _ hb]
  rw [mul_assoc] at h
  apply mul_left_cancel₀ hb h
#align int.eq_mul_div_of_mul_eq_mul_of_dvd_left Int.eq_mul_div_of_mul_eq_mul_of_dvd_left

/-- If an integer with larger absolute value divides an integer, it is
zero. -/
theorem eq_zero_of_dvd_of_natAbs_lt_natAbs {a b : ℤ} (w : a ∣ b) (h : natAbs b < natAbs a) :
    b = 0 := by
  rw [← natAbs_dvd, ← dvd_natAbs, coe_nat_dvd] at w
  rw [← natAbs_eq_zero]
  exact eq_zero_of_dvd_of_lt w h
#align int.eq_zero_of_dvd_of_nat_abs_lt_nat_abs Int.eq_zero_of_dvd_of_natAbs_lt_natAbs

theorem eq_zero_of_dvd_of_nonneg_of_lt {a b : ℤ} (w₁ : 0 ≤ a) (w₂ : a < b) (h : b ∣ a) : a = 0 :=
  eq_zero_of_dvd_of_natAbs_lt_natAbs h (natAbs_lt_natAbs_of_nonneg_of_lt w₁ w₂)
#align int.eq_zero_of_dvd_of_nonneg_of_lt Int.eq_zero_of_dvd_of_nonneg_of_lt

/-- If two integers are congruent to a sufficiently large modulus,
they are equal. -/
theorem eq_of_mod_eq_of_natAbs_sub_lt_natAbs {a b c : ℤ} (h1 : a % b = c)
    (h2 : natAbs (a - c) < natAbs b) : a = c :=
  eq_of_sub_eq_zero (eq_zero_of_dvd_of_natAbs_lt_natAbs (dvd_sub_of_emod_eq h1) h2)
#align int.eq_of_mod_eq_of_nat_abs_sub_lt_nat_abs Int.eq_of_mod_eq_of_natAbs_sub_lt_natAbs

theorem ofNat_add_negSucc_of_ge {m n : ℕ} (h : n.succ ≤ m) :
    ofNat m + -[n+1] = ofNat (m - n.succ) := by
  rw [negSucc_eq, ofNat_eq_cast, ofNat_eq_cast, ← Nat.cast_one, ← Nat.cast_add,
    ← sub_eq_add_neg, ← Nat.cast_sub h]
#align int.of_nat_add_neg_succ_of_nat_of_ge Int.ofNat_add_negSucc_of_ge

theorem natAbs_le_of_dvd_ne_zero {s t : ℤ} (hst : s ∣ t) (ht : t ≠ 0) : natAbs s ≤ natAbs t :=
  not_lt.mp (mt (eq_zero_of_dvd_of_natAbs_lt_natAbs hst) ht)
#align int.nat_abs_le_of_dvd_ne_zero Int.natAbs_le_of_dvd_ne_zero

end Int


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Author: Leonardo de Moura

Formalization of Theorem 1 from the following paper:
"The inconsistency of a Brouwerian continuity
principle with the Curry–Howard interpretation"
by Martín Escardó and Chuangjie Xu
-/
import data.nat
open nat sigma.ops

/- Bounded equality: α and β agree in the first n positions. -/
definition beq (α β : nat → nat) (n : nat) : Prop :=
∀ a, a < n → α a = β a

notation α `=[`:50 n:50 `]` β:50 := beq α β n

lemma pred_beq {α β : nat → nat} {n : nat} : α =[n+1] β → α =[n] β :=
λ h a altn, h a (lt.step altn)

definition continuous (f : (nat → nat) → nat) : Type₁ :=
∀ α, Σ n, ∀ β, α =[n] β → f α = f β

definition zω : nat → nat :=
λ x, zero

definition znkω (n : nat) (k : nat) : nat → nat :=
λ x, if x < n then 0 else k

lemma znkω_succ (n : nat) (k : nat) : znkω (n+1) k 0 = 0 :=
rfl

lemma znkω_bound (n : nat) (k : nat) : znkω n k n = k :=
if_neg !nat.lt_irrefl

lemma zω_eq_znkω (n : nat) (k : nat) : zω =[n] znkω n k :=
λ a altn, begin esimp [zω, znkω], rewrite [if_pos altn] end

section
hypothesis all_continuous : ∀ f, continuous f

definition M (f : (nat → nat) → nat) : nat :=
(all_continuous f zω).1

lemma M_spec (f : (nat → nat) → nat) : ∀ β, zω =[M f] β → f zω = f β :=
(all_continuous f zω).2

definition m := M (λα, zero)

definition f β :=  M (λα, β (α m))

lemma β0_eq (β : nat → nat) : ∀ α, zω =[f β] α → β 0 = β (α m) :=
λ α, M_spec (λα, β (α m)) α

lemma not_all_continuous : false :=
let β := znkω (M f + 1) 1 in
let α := znkω m (M f + 1) in
have βeq₁ : zω =[M f + 1] β, from
  λ (a : nat) (h : a < M f + 1), begin unfold zω, unfold znkω, rewrite [if_pos h] end,
have βeq₂    : zω =[M f] β,                    from pred_beq βeq₁,
have m_eq_fβ : m = f β,                        from M_spec f β βeq₂,
have aux     : ∀ α, zω =[m] α → β 0 = β (α m), by rewrite m_eq_fβ at {1}; exact (β0_eq β),
have zero_eq_one : 0 = 1, from calc
  0   = β 0         : by rewrite znkω_succ
  ... = β (α m)     : aux α (zω_eq_znkω m (M f + 1))
  ... = β (M f + 1) : by rewrite znkω_bound
  ... = 1           : by rewrite znkω_bound,
by contradiction
end

/-
Additional remarks:
By using the slightly different definition of continuous
  ∀ α, ∃ n, ∀ β, α =[n] β → f α = f β
i.e., using ∃ instead of Σ, we can assume the following axiom
  all_continuous : ∀ f, continuous f
However, the system becomes inconsistent again if we also assume Hilbert's choice,
because with Hilbert's choice we can convert ∃ into Σ
-/


--#check list.reverse
--#check list
namespace z

inductive nt: Type
| zero : nt
| succ : nt → nt

definition add_n : nt → nt → nt
| nt.zero x := x
| (nt.succ x) y := nt.succ (add_n x y)

definition product_n : nt → nt → nt
| x (nt.succ nt.zero) := x
| _ nt.zero := nt.zero
| x (nt.succ y) := add_n x (product_n x y)

definition eq_n : nt → nt → bool
| nt.zero nt.zero := tt
| (nt.succ a) (nt.succ b) := eq_n a b
| _ _ := ff

inductive nat_pair : Type
| p : nat → nat → nat_pair

open nat_pair
notation a ; b := p a b

#check p 5 5

def fst : nat_pair → nat
| (p x _) := x

def snd : nat_pair → nat
| (p _ x) := x

def first_or_second : nat_pair → bool → nat
| (p x _) ff := x
| (p _ x) tt := x

def swap : nat_pair → nat_pair
| (x;y)  := y;x

theorem surjective_pairing : ∀ (n m : nat), (n;m) =
((first_or_second (n;m) ff) ; (first_or_second (n;m) tt)) := begin

intros n m,

have H₁ : ∀ n m : ℕ, first_or_second (n;m) ff = n,
{
    unfold first_or_second,
    intro h,
    intro g,
    refl
},
{
    rw H₁,
    have H₂ : ∀ n m : ℕ, first_or_second (n;m) tt = m,
    {
        unfold first_or_second,
        intro h, intro g, refl
    },
    rw H₂
}

end

theorem snd_fst_is_swap : ∀ (p : nat_pair),
  (snd p ; fst p) = swap p := begin

  intro p,
  cases p with x y,
  refl

  end

theorem fst_swap_is_snd : ∀ (p : nat_pair),
  fst (swap p) = snd p := begin

  intro p,
  cases p,
  refl

  end

inductive natlist : Type
| emp : natlist
| ap : nat → natlist → natlist

open natlist
notation {} := emp
notation x :: y := ap x y

def repeat : ℕ → ℕ → natlist
|  0 _ := {}
| (n+1) x := ap x (repeat n x)

def len : natlist → ℕ
| {} := 0
| (ap _ x) := 1 + len x

def append : natlist → natlist → natlist
| {} x := x
| (ap n L) x := ap n (append L x)

def ap_r : natlist → nat → natlist := λ L n,
append L (ap n {})

def reverse : natlist → natlist
| {} := {}
| (ap n L) := append (reverse L) (n::{})
--ap_r changed to append
--n changed to (n::{})

def first_element : natlist → ℕ
| {} := 0
| (n::L) := n

def last_element : natlist → ℕ
| {} := 0
| (a::{}) := a
| (a::b) := last_element b

def up_to_last : natlist → natlist
| {} := {}
| (a::{}) := {}
| (a::L) := a::(up_to_last L)

def is_odd : ℕ → bool
| 1 := tt
| 0 := ff
| (n+2) := is_odd n

def append_if_odd : ℕ → bool → natlist → natlist
| x tt L := ap x L
| x ff L := L

def oddmembers : natlist → natlist
| {} := {}
| (ap n L) := append_if_odd n (is_odd n) (oddmembers L)

def count_odd_members : natlist → ℕ
| {} := 0
| L := len (oddmembers L)

def list_zip : natlist → natlist → natlist
| {} {} := {}
-- at least one not empty
| {} L := L
| L {} := L
-- neither empty
| (ap n₁ L₁) (ap n₂ L₂) := ap n₁ (ap n₂ (list_zip L₁ L₂))

def one_if_equal_else_zero : ℕ → ℕ → ℕ
| x y := if x=y then 1 else 0

def count : natlist → ℕ → ℕ
| {} _ := 0
| (ap n L) x := one_if_equal_else_zero x n + (count L x)

def sum_of_list : natlist → ℕ
| {} := 0
| (ap n L) := n + sum_of_list L

def sum := append
def add := ap

def member : natlist → ℕ → bool
| {} _ := false
| (ap n L) x := if n=x then tt else member L x

def remove_one : natlist → ℕ → natlist
| {} _ := {}
| (ap n L) x := if n=x then L else ap n (remove_one L x)

def remove_all : natlist → ℕ → natlist
| {} _ := {}
| (ap n L) x := if n=x then remove_all L x else ap n (remove_all L x)

def to_set : natlist → natlist
| {} := {}
| (ap n L) := if count L n = 0 then ap n (to_set L) else to_set L

def is_a_subset_of_b : natlist → natlist → bool
| {} _ := tt
| (a::L) x := if count L a < count x a then is_a_subset_of_b L x else ff

-- ascending order
definition sort_into_list : natlist → ℕ → natlist
| {} x := x::{}
| (n::L) x := if n>=x then (x::n::L) else append (n::{}) (sort_into_list L x)

-- sort             a   into  b={}
definition SORT : natlist → natlist → natlist
| {} x := x
| (n::L) x := SORT L (sort_into_list x n)

definition sort_list : natlist → natlist := λ n, SORT n {}

-- only equal if same values in same places
definition list_equality : natlist → natlist → bool
| {} {} := tt
| (ap a L1) (ap b L2) := if a=b then list_equality L1 L2 else ff
| _ _ := ff

definition same_values : natlist → natlist → bool :=
λ a b, list_equality (sort_list a) (sort_list b)

@[derive decidable_eq] inductive nat_error : Type
| Some : nat → nat_error
| None : nat_error
open nat_error

definition nth_in_list : natlist → ℕ → nat_error
| {} _ := None
| (x::L) 0 := Some x
| (x::L) (nat.succ n) := nth_in_list L n

theorem a : ∀ n y:ℕ, count (repeat n y) y = n := begin intros n y,
induction n with d Hd,
{
    refl
},
{
    unfold repeat,
    unfold count,
    unfold one_if_equal_else_zero,
    rw Hd,
    simp
} end

theorem b : ∀ a b : ℕ, sum_of_list (repeat a b) = a*b := begin intros a b,
induction a with d Hd,
{
    simp,
    cases b;refl
},
{
    unfold repeat,
    unfold sum_of_list,
    rw Hd,
    simp,

    rw mul_add b d 1, simp
} end

@[simp] theorem count_append (a L : natlist) (n : ℕ) :
count (append a L) n = count a n + count L n :=begin induction a with new L₂ Hd,
{
    unfold count append,
    simp
},
{
    unfold append count one_if_equal_else_zero ,
    by_cases (n=new),
    {
        simp [h],
        --clear h,
        congr,
        rw h at Hd,
        rw Hd,
        simp
    },
    {
        simp [h],
        rw Hd,
        simp
    }
} end

@[simp] theorem c : ∀ L : natlist, ∀ n:ℕ, count (reverse L) n = count L n := begin
intros L n,
induction L with new L₂ H₁, {refl},
{
    by_cases (n=new),
    {
        unfold reverse ap_r count one_if_equal_else_zero,
        subst h, simp,
        unfold count one_if_equal_else_zero,
        simp, congr,
        rw H₁
    },
    {
        unfold reverse count ap_r one_if_equal_else_zero,
        simp [h],
        unfold reverse count ap_r one_if_equal_else_zero,
        simp [h],
        rw H₁
    }
}
end

@[simp] theorem append_unchanged : ∀ a : natlist, append a {} = a := begin
intro a,
induction a,{refl},
{
    unfold append,
    rw ih_1
} end

@[simp] theorem append_ass : ∀ a b c : natlist,
append (append a b) c = append a (append b c) := begin
intros a b c,
induction a,
{
    refl
},
{
    unfold append,
    rw ih_1
} end

@[simp]theorem d: ∀ L₁ L₂ : natlist,
  reverse (append L₁ L₂) = append (reverse L₂) (reverse L₁) := begin
  intros L₁ L₂,
  induction L₁ with new L H,
  {
      unfold reverse,
      unfold append,
      simp
  },
  {
      unfold append reverse ap_r,
      rw H,
      exact append_ass (reverse L₂) (reverse L)(new :: {})
  } end

-- [1,2,3] [4,5,6]
-- [3,2,1] [6,5,4]
-- [3,2,1,6,5,4]
-- [4,5,6,1,2,3]

theorem e : ∀ L : natlist, reverse (reverse L) = L := begin
intro L,
induction L with new L_shorter H,{refl},
{
    unfold reverse,
    simp,
    rw H, refl
}
end

@[simp]theorem same_eq : ∀ x : natlist, list_equality x x = tt := begin
intro x,
induction x,{refl},
{
    unfold list_equality,
    simp, rw ih_1
}
end

@[simp]theorem same_eq2 : ∀ x : natlist, same_values x x = tt := begin
intro x, unfold same_values, simp
end

theorem g (L : natlist) (n : ℕ) : same_values (append (n::{}) L) (append L (n::{})) := sorry

theorem t : 1=1 := begin

by_cases (Some 5 = None),
{
    admit
},
{
    admit
}

end

theorem f : ∀ L : natlist, same_values L (reverse L) = tt := begin

intro L,
induction L with new L_shorter H,{refl},
{
    unfold reverse,

    -- new + L == L_r + new
    --unfold same_values sort_into_list
    --list_equality sort_into_list,
    --unfold same_values sort_into_list
    --list_equality sort_into_list at H,

    admit

}

end

end z


-- ---------------------------------------------------------------------
-- Ejercicio. Sean a y b números reales. Demostrar que
--    abs (a*b) ≤ (a^2 + b^2) / 2
-- ----------------------------------------------------------------------

import data.real.basic
import tactic

variables a b : ℝ

-- 1ª demostración
example : abs (a*b) ≤ (a^2 + b^2) / 2 :=
begin
  apply abs_le.mpr,
  split,
  { have h1 : 0 ≤ a^2 + 2*a*b + b^2,
      calc 0 ≤ (a+b)^2                : by exact pow_two_nonneg (a + b)
         ... = a^2+2*a*b+b^2          : by ring,
    have h2 : -2*(a*b) ≤ a^2 + b^2,
      calc -2*(a*b)
           ≤ -2*(a*b)+(a^2+2*a*b+b^2) : by exact le_add_of_nonneg_right h1
       ... = a^2 + b^2                : by ring,
    show -((a^2 + b^2) / 2) ≤ a*b,      by linarith [h2] },
  { have h3 : 0 ≤ a^2 - 2*a*b + b^2,
      calc 0 ≤ (a-b)^2                : by exact pow_two_nonneg (a - b)
         ... = a^2-2*a*b+b^2          : by ring,
    have h4 : 2*(a*b) ≤ a^2 + b^2,
      calc 2*(a*b)
           ≤ 2*(a*b)+(a^2-2*a*b+b^2)  : by exact le_add_of_nonneg_right h3
       ... = a^2 + b^2                : by ring,
    show a * b ≤ (a^2 + b^2)/2,         by linarith [h4] },
end

-- 2ª demostración
example : abs (a*b) ≤ (a^2 + b^2) / 2 :=
begin
  apply abs_le.mpr,
  split,
  { have h1 : 0 ≤ a^2 + 2*a*b + b^2,
      calc 0 ≤ (a+b)^2                : by exact pow_two_nonneg (a + b)
         ... = a^2+2*a*b+b^2          : by ring,
    have h2 : -2*(a*b) ≤ a^2 + b^2,
      calc -2*(a*b)
           ≤ -2*(a*b)+(a^2+2*a*b+b^2) : by exact le_add_of_nonneg_right h1
       ... = a^2 + b^2                : by ring,
    show -((a^2 + b^2) / 2) ≤ a*b,      by linarith [h2] },
  { have h4 : 2*a*b ≤ a^2 + b^2       := two_mul_le_add_sq a b,
    show a * b ≤ (a^2 + b^2)/2,         by linarith [h4] },
end

-- 3ª demostración
example : abs (a*b) ≤ (a^2 + b^2) / 2 :=
begin
  apply abs_le.mpr,
  split,
  { have h1 : 0 ≤ a^2 + 2*a*b + b^2,
      calc 0 ≤ (a+b)^2                : by exact pow_two_nonneg (a + b)
         ... = a^2+2*a*b+b^2          : by ring,
    have h2 : -2*(a*b) ≤ a^2 + b^2,
      calc -2*(a*b)
           ≤ -2*(a*b)+(a^2+2*a*b+b^2) : by exact le_add_of_nonneg_right h1
       ... = a^2 + b^2                : by ring,
    show -((a^2 + b^2) / 2) ≤ a*b,      by linarith [h2] },
  { show a * b ≤ (a^2 + b^2)/2,         by linarith [two_mul_le_add_sq a b] },
end


-- *  Level 1
import game.world3.level9

theorem mul_pos (a b : mynat) : a ≠ 0 → b ≠ 0 → a * b ≠ 0 :=

begin

intro h,
intro g,
intro f,
cases b,
rw mul_zero at f,
apply g,
exact f,
apply h,
rw mul_succ at f,
have foo := add_left_eq_zero(f),
exact foo,

end

-- * Level 2

theorem eq_zero_or_eq_zero_of_mul_eq_zero (a b : mynat) (h : a * b = 0) :  a = 0 ∨ b = 0 :=

begin

cases b,
right,
rw mul_zero at h,
exact h,
left,
rw mul_succ at h,
have foo := add_left_eq_zero(h),
exact foo,

end
-- * Level 3
theorem mul_eq_zero_iff (a b : mynat): a * b = 0 ↔ a = 0 ∨ b = 0 :=

begin

split,
apply eq_zero_or_eq_zero_of_mul_eq_zero,
intro g,
cases g,
rw g,
rw zero_mul,
refl,
rw g,
rw mul_zero,
refl

end
-- * Level 4
-- Couldn't do it lol


import Mathlib.Algebra.Group.Defs

/-
Source: https://en.wikipedia.org/wiki/Word_problem_(mathematics)#Example:_A_term_rewriting_system_to_decide_the_word_problem_in_the_free_group
-/

namespace Group

variable {G : Type _} [Group G] (x y z : G)

-- the group axioms

attribute [simp] one_mul

attribute [simp] mul_left_inv

attribute [simp] mul_assoc

attribute [simp] mul_one

@[simp] theorem left_inv_cancel : x⁻¹ * (x * y) = y := by rw [← mul_assoc]; simp

@[simp] theorem one_inv : (1 : G)⁻¹ = (1 : G) := by
  have := left_inv_cancel (1 : G) (1 : G)
  rw [mul_one, mul_one] at this; assumption

@[simp] theorem inv_inv : (x⁻¹)⁻¹ = x := by
  have := left_inv_cancel (x⁻¹) x
  rw [mul_left_inv, mul_one] at this; assumption

@[simp] theorem mul_right_inv : x * x⁻¹ = 1 := by
  have := left_inv_cancel (x⁻¹) (1 : G)
  rw [inv_inv, mul_one] at this; assumption

@[simp] theorem left_cancel_inv : x * (x⁻¹ * y) = y := by
  have := left_inv_cancel (x⁻¹) y
  rw [inv_inv] at this; assumption

@[simp] theorem prod_inv : (x * y)⁻¹ = y⁻¹ * x⁻¹ := by
  have := left_cancel_inv (x * y)⁻¹ (y⁻¹ * x⁻¹)
  simp at this; assumption

end Group

variable {G : Type _} [Group G] (a b c : G)

example : ((a⁻¹ * a) * (b * b⁻¹))⁻¹ = (1 : G) := by simp

example : b * ((a * b)⁻¹ * a) = 1 := by simp

example : a * (c⁻¹ * b) * (((b⁻¹ * c) * b) * (a * b)⁻¹) = (1 : G) := by simp


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

import tactic -- imports all the Lean tactics
import group_theory.subgroup.basic -- imports the theory of subgroups

/-!

# Subgroups

In Lean, a subgroup is not a group. This is for the same reason that a subset
is not a type. The way subgroups work is that if `G` is a group:

`variables (G : Type) [group G]`

then the type of *all* subgroups of `G` is called `subgroup G`. So if you want
one subgroup of G:

`variable (H : subgroup G)`

then, as you can see, `H` is not a type (we don't write `H : Type`), it's a term.
So how do we do elements of `H` then? It's just the same as sets: an element `x` of
`H` is a term `x` of type `G`, such that the proposition `x ∈ H` holds.

Here's the basic API for subgroups.

-/

-- Let `G` be a group, let `a` and `b` be elements of `H`, and let `H` and `K` be subgroups of `G`.
variables (G : Type) [group G] (a b : G) (H K : subgroup G)

-- The basic API for subgroups
example : (1 : G) ∈ H := one_mem H
example (ha : a ∈ H) : a⁻¹ ∈ H := inv_mem ha
example (ha : a ∈ H) (hb : b ∈ H) : a * b ∈ H := mul_mem ha hb

-- Let's use these axioms to make more API for subgroups.

-- First, see if you can put the axioms together to prove subgroups are closed under "division".
example (ha : a ∈ H) (hb : b ∈ H) : a * b⁻¹ ∈ H :=
begin
  sorry,
end

-- Now try these. You might want to remind yourself of the API for groups as explained
-- in an earlier section, or make use of the `group` tactic.

-- This lemma is called `inv_mem_iff` but try proving it yourself
example : a⁻¹ ∈ H ↔ a ∈ H :=
begin
  sorry,
end

-- this is `mul_mem_cancel_left` but see if you can do it from the axioms of subgroups.
-- Again feel free to use the `group` tactic.
example (ha : a ∈ H) : a * b ∈ H ↔ b ∈ H :=
begin
  sorry,
end

/-

## Complete lattice structure on subgroups of G

Subgroups of a group form a complete lattice. Let's just check this:

-/

example : complete_lattice (subgroup G) := infer_instance

/-

The "type class inference system" (the system which deals with square bracket inputs to
functions) already knows this. `infer_instance` means "find this construction in the
database".

Because subgroups are a complete lattice, there will be a smallest subgroup `⊥` of `G`
and a largest subgroup `⊤`. You can guess what these are (note that `⊥` isn't the empty set,
this isn't a subgroup). Let's get the hang of these subgroups. Here's their API
(by the way, I don't have a clue about these APIs, I don't have them all committed to memory,
I just write down the natural statements and then either guess the names of the proofs or
use `library_search`):

-/

example : a ∈ (⊥ : subgroup G) ↔ a = 1 := subgroup.mem_bot
example : a ∈ (⊤ : subgroup G) := subgroup.mem_top a

/-

# Conjugating a subgroup by an element.

Let's define the conjugate `xHx⁻¹` of a subgroup `H` by an element `x`. To do this we
are going to have to know how to *make* subgroups, not just prove things about subgroups.

To create a subgroup of `G`, you need to give a subset of `G` and then a proof
that the subset satisfies the three axioms `one_mem`, `inv_mem` and `mul_mem` for subgroups.
If `H : subgroup G` and `x : G` then the *conjugate* of `H` by `x` is
the set `{a : G | ∃ h, h ∈ H ∧ a = x * h * x⁻¹}`. So let's show that this set
satisfies the axioms for a subgroup.

-/

variables {G H} {x : G}

variables (y z : G)

lemma conjugate.one_mem : (1 : G) ∈ {a : G | ∃ h, h ∈ H ∧ a = x * h * x⁻¹} :=
begin
  sorry,
end

lemma conjugate.inv_mem (hy : y ∈ {a : G | ∃ h, h ∈ H ∧ a = x * h * x⁻¹}) :
  y⁻¹ ∈ {a : G | ∃ h, h ∈ H ∧ a = x * h * x⁻¹} :=
begin
  sorry,
end

lemma conjugate.mul_mem (hy : y ∈ {a : G | ∃ h, h ∈ H ∧ a = x * h * x⁻¹})
  (hz : z ∈ {a : G | ∃ h, h ∈ H ∧ a = x * h * x⁻¹}) :
  y * z ∈ {a : G | ∃ h, h ∈ H ∧ a = x * h * x⁻¹} :=
begin
  sorry,
end

-- Now here's the way to put everything together:
def conjugate (H : subgroup G) (x : G) : subgroup G :=
{ carrier := {a : G | ∃ h, h ∈ H ∧ a = x * h * x⁻¹},
  one_mem' := conjugate.one_mem,
  inv_mem' := conjugate.inv_mem,
  mul_mem' := conjugate.mul_mem, }

/-

## The cost of a definition

You might think "we're done, we made conjugates"! But not so fast!

If we were putting the definition of `conjugate` into mathlib then the next thing we would have to
do would be to prove a whole bunch of things about it. Every definition in a formalised system
comes with a cost. If you just make the definition and don't prove theorems about it,
then other people can't use your definition easily in their theorems.

What kind of theorems would we want to prove about conjugates? We might want to prove
that if `H ≤ K` then `conjugate H x ≤ conjugate K x`. We might want to prove
that `conjugate ⊥ x = ⊥` and `conjugate ⊤ x = ⊤`. And we might want to prove
that if `G` is abelian then `conjugate H x = H` for all `H`. Before we embark on this,
I had better tell you how to prove that two subgroups of a group are equal in Lean.
To check two subgroups are equal it suffices to prove they have the same elements:
this is called "extensionality" for subgroups, and you can make this step using the `ext`
tactic. I'll show you below.

Let's make some API for conjugates. I'll suggest some names for the lemmas.

-/

-- This one is always handy: you will be able to `rw` it when faced with goals
-- of the form `a ∈ conjugate H x`.

lemma mem_conjugate_iff : a ∈ conjugate H x ↔ ∃ h, h ∈ H ∧ a = x * h * x⁻¹ :=
begin
  -- true by definition!
  refl,
end

lemma conjugate_mono (H K : subgroup G) (h : H ≤ K) : conjugate H x ≤ conjugate K x :=
begin
  -- start with `intro g` because the goal is definitionally
  -- `∀ g, g ∈ conjugate H x → g ∈ conjugate K x`
  sorry,
end

lemma conjugate_bot : conjugate ⊥ x = ⊥ :=
begin
  -- recall that ⊥ is the trivial subgroup and I showed you the basic API for it above.
  -- Start this proof with `ext a`.
  sorry,
end

lemma conjugate_top : conjugate ⊤ x = ⊤ :=
begin
  sorry,
end

lemma conjugate_eq_of_abelian (habelian : ∀ a b : G, a * b = b * a) : conjugate H x = H :=
begin
  sorry,
end


import SciLean
open SciLean

/-!
==========================
Differentiation in SciLean
==========================

The backbone of any numerical/scientific/machine learing software is
an automatic and/or symbolic differentiation. In SciLean, automatic and
symbolic differentiation is build on top of these two operators:

1. Differential `∂ : (X → Y) → (X → X → Y)`

2. Adjoint `†: (X → Y) → (Y → X)`

The differential `∂` tells us how much does the function `f : X → Y`
changes in the direction `dx : X` at the point `x : X`. The usual
mathematical definition is:

.. math::

  \partial \texttt{f x dx} := \lim_{h \rightarrow 0} \frac{f(x + dx) - f(x)}{h}

..

Because mathlib is not yet ported to Lean 4 this definition is not used
in SciLean. Right now, the differential `∂` is just postulated to exist.

The adjoint `†` is just well known matrix transposition. Thus for real
valued matrix `A`

.. math:: (A^\dagger)_{ij} = A_{ji}

..

For a general linear map `A : X → Y` between two Hilbert spaces `X` and `Y`,
the adjoint is defined via

.. math :: \langle A x, y \rangle = \langle x, A^\dagger y \rangle  \qquad \, \forall x \in X, \,y \in Y

-/

/-!

We will show that these two operators give a rise to a whole zoo of operators

1. Differential `∂ : (X → Y) → (X → X → Y)`

2. Adjoint `†: (X → Y) → (Y → X)`

3. Adjoint Differantial `∂† : (X → Y) → (X → Y → X)`

4. Derivative `ⅆ : (ℝ → X) → (ℝ → X)`

5. Gradient `∇ : (X → ℝ) → (X → X)`

6. Divergence `∇· : (X → X) → (X → ℝ)`

7. Forward Mode AD `fwdDiff : (X → Y) → (X → X×(X → Y))`

8. Reverse Mode AD `revDiff : (X → Y) → (X → X×(Y → X))`

9. Dual Number AD `dualDiff : (X → Y) → (X×X → Y×Y)`

 -/

/-!

Differential
============

 -/

section Differential

/-!

The simples possible example: What is the differential of identity function?

 -/

  #check (∂ λ x : ℝ => x)
    rewrite_by (simp; trace_state /- .unfold -/ )

/-!

As expected the change of identity function is just `dx` and it does not depend
on the position `x`.

(Note: The SciLean's custom notation `x:term rewrite_by t:convSeq`
applies tactic `t` on the term `x`. This notation confuses the `#check`
command. To see the actual result it is better to use the `trace_state`
tactic. TODO: Add a document explaining the technical detail of `rewrite_by`
notation. TODO: Add delaborator for terms created with `AutoImpl`)

Another way to check that the differential is computed correctly

 -/

 example : (∂ λ x : ℝ => x) = (λ x dx => dx) := by simp

/-!

This has the disadvantages that we need to know the result beforehand.

Few more basic derivatives: of a constant, quadratic function, sine

 -/

  #check (∂ λ x : ℝ => (1 : ℝ))
    rewrite_by
    (simp; trace_state) /- .unfold -/

  #check (∂ λ x : ℝ => x * x)
    rewrite_by
    (simp; trace_state) /- .unfold -/

  #check (∂ λ x : ℝ => Math.sin x)
    rewrite_by
    (simp; trace_state) /- .unfold -/

/-!

The result `fun x dx => dx * x + x * dx` is slightly undesirable. We
would like to get `fun x dx => 2 * dx * x`. Such algebraic manipulation
is within the scope of mathlib's tactics so we will wait for mathlib
port to Lean 4.

 -/

/-!

Let's introduce few generic functions  to demonstrate some general differentiation
results

 -/
  variable {X Y Z : Type} [Vec X] [Vec Y] [Vec Z]
  variable (f : Y → Z) [IsSmooth f]
  variable (g : X → Y) [IsSmooth g]

/-!

The most crucial tool when computing derivatives is the chain rule, as a proof

 -/

  example : (∂ λ x => f (g x)) = (λ x dx => ∂ f (g x) (∂ g x dx)) :=
    by simp

/-!

Or as a symbolic computation

 -/

  #check (∂ λ x => f (g x))
    rewrite_by
    (simp; trace_state) /- .unfold -/

/-!

Another common rule is the product rule

 -/

  variable (ϕ ψ : ℝ → ℝ) [IsSmooth ϕ] [IsSmooth ψ]

  #check (∂ λ x => ϕ x * ψ x)
    rewrite_by
    (simp; trace_state) /- .unfold -/

/-!

Derivative
----------

The standard notion of derivative takes a function from reals to reals, `f : ℝ → ℝ`,
and produces again a function from, usually denoted with `f' : ℝ → ℝ`.

The differential `∂` does not fit this. The well know result that
derivative of exponential is exponential `exp' = exp` can't be expressed as
easily with differential.

The naive statement does not even typecheck

 -/

  #check_failure ∂ Math.exp = Math.exp

/-!

The `exp' = exp` is this slightly cumbersome statement

 -/

  example : (λ t => ∂ Math.exp t 1) = Math.exp := by simp

/-!

For this reason we introduce a new operator, derivative `ⅆ : (ℝ → X) → (ℝ → X)`.
Which is defines as follows

 -/

  example (f : ℝ → X) : ⅆ f = λ t => ∂ f t 1 :=
    by simp

/-!

Now we have

 -/

  example : ⅆ Math.exp = Math.exp := by simp

/-!

(TODO: Right now simplifier needs to unfold `derivative`. Fix it!)

We provide convenient notation, `ⅆ t, f t` and `ⅆ (t:=t₀), f t`, for
taking derivative with a respect to an explicit variable.

 -/
  section DerivativeNotation

    variable (f : ℝ → X) (t₀ : ℝ)

    -- effectively translates `t,` to `λ t =>`
    example : (ⅆ t, f t) = ⅆ (λ t => f t ) := by rfl

    -- similar as above but also applies `t₀`
    example : (ⅆ (t:=t₀), f t) = ⅆ (λ t => f t) t₀ := by rfl

  end DerivativeNotation

/-!

..

The notation `ⅆ (t:=t₀), f t` tries to mimick the mathematical notation

.. math:: \frac{d}{dt}\bigg\rvert_{t=t_0} f(t)

 -/

/-!

Debugging Differentiation
-------------------------

Sometimes the differentiation is not doing what we expect. It is crucial
to know how to figure out what went wrong.

To demonstrate this, let's introduce a function `h` but without the smoothenss
proof i.e. we do not introduce `[IsSmooth h]`

 -/

  variable (h : X → Y)

/-!

Now the chain rule for `f` and `h` fails

 -/

  example : (∂ λ x => f (h x)) = (λ x dx => ∂ f (h x) (∂ h x dx)) :=
    by simp   -- no progress
       admit  -- we have to give up

/-!

We have to use the `admit` tactic to close the goal as `simp` is unable
to do it right now.

The problem is that `simp` can't apply chain rule because it is missing
the proof of smoothenss of `h`. To figure this out, we turn on the option
`trace.Meta.Tactic.simp.discharge`

 -/

  set_option trace.Meta.Tactic.simp.discharge true in
  example : (∂ λ x => f (h x)) = (λ x dx => ∂ f (h x) (∂ h x dx)) :=
    by simp; admit

/-!

If you click on `simp`, one of the messages will be

::

  [Meta.Tactic.simp.discharge] SciLean.diff_of_comp, failed to synthesize instance
      SciLean.IsSmooth fun x => h x

(TODO: currently there is tons of crap that should not be there)

If we provide the smoothenss proof we can observe all rewrites by turning on
`trace.Meta.Tactic.simp.rewrite`

-/

  variable [IsSmooth h]

  set_option trace.Meta.Tactic.simp.rewrite true in
  example : (∂ λ x => f (h x)) = (λ x dx => ∂ f (h x) (∂ h x dx)) :=
    by simp

/-!

Now `simp` shows the application of the chain rule

::

  [Meta.Tactic.simp.rewrite] SciLean.diff_of_comp:99, ∂fun x =>
        f (h x) ==> fun x dx => SciLean.differential f (h x) (SciLean.differential (fun x => h x) x dx)

A bit more complicated computation

 -/

  set_option trace.Meta.Tactic.simp.rewrite true in
  #check (∂ λ x : ℝ => x * Math.exp (x*x) + x)
    rewrite_by
    (simp; trace_state) /- .unfold -/

/-!

Clicking on `simp` reveals fairly long list of rewrites.

 -/

end Differential

/-!

Defining Differentiable Function
================================

Sometimes we want to define our own differentiable functions

 -/

def square (x : ℝ) := x * x

/-!

We might be surprized that differentiating this function does not work

 -/

example : (∂ square) = (λ x dx => dx * x + x * dx) :=
by
  simp  -- this does nothing as we know nothing about `square`
  unfold square  -- unfold definition of `square`
  simp  -- now it works

/-!

Manually unfolding every definition can get tedious. To circumvent that,
we can anotate the definition of `square` to indicate that it is
differentiable.

 -/

def square_v1 (x : ℝ) : ℝ := x * x
argument x
  isSmooth, diff

/-!

(TODO: When using `def` with annotations, we **have to** explicitely specify
the return type. Remove this limitation or add a warrning when the
return type is missing.)

The `argument x` specifies that everything that follows concerns the
argument `x`. The `isSmooth` generates proof that `square_v1` is
smooth in the argument `x` and `diff` defines a new function
`square_v1.arg_x.diff` that is the function's differential.

There are few variants that are usefull when full automation fails or
produces undesirable results.

 -/

def square_v2 (x : ℝ) : ℝ := x * x
argument x
  -- specify how to prove smoothenss
  isSmooth := by unfold square_v2; infer_instance,
  -- specify what the differential is and how to prove it
  diff := 2 * dx * x by simp[diff, square_v2]; funext x dx; ring

def square_v3 (x : ℝ) : ℝ := x * x
argument x
  -- proof is done automatically
  isSmooth,
  -- specify how to compute differential
  diff by simp[square_v3]

/-!

Defining a new function, `square_v1.arg_x.diff` for the differential
can be undesirable. Sometimes we want `∂ square` to directly simplify
to `λ x dx => dx * x + x * dx`. To achieve this, we use `diff_simp`
instead of `diff`.

 -/

def square_v4 (x : ℝ) : ℝ := x * x
argument x
  isSmooth,
  diff_simp by simp[square_v4]

/-!

The `diff_simp` annotation allows the same variants as `diff`.

Proof that the second derivative is `2`. We have to do manual unfolding
when working with `square_v3` but with `square_v4` the proof is immediate

 -/

example : (λ x => ∂ ∂ square_v2 x 1 1) = (λ x => 2) :=
by
  simp  -- simp gets stopped on `square_v3.arg_x.diff`
  unfold square_v2.arg_x.diff -- manually unfold definition
  simp  -- we can continue with computation

example : (λ x => ∂ ∂ square_v4 x 1 1) = (λ x => 2) :=
by
  simp  -- done immediately

/-!

We missed our chance to add annotations to the original function `square`.
We can add additional annotations later on with `function_properties`.

-/

function_properties square (x : ℝ) : ℝ
argument x
  isSmooth, diff_simp

-- now we can differentiate `square`
example : ∂ square = λ x dx => dx * x + x * dx := by simp

/-!

The keyword `function_properties` works exactly like `def` with annotations
but you do not provide the function definition `:= ...`. Argument types
and order have to match exactly the original definition but the argument
names do not have to be the same.

 -/

/-!

Multiple Arguments
------------------

(TODO: Explain how annotations work with multiple arguments. The current
behavior is a bit limiting, so I should rewrite how they work before
I write this section.)

 -/

/-!

How Do Annotations Work?
------------------------

The `isSmooth` and `diff` annotations might appear misterious but they
are simple macros.

This definition
 -/

def cube (x : ℝ) : ℝ := x * x * x
argument x
  isSmooth := by unfold cube; infer_instance,
  diff := 3 * dx * x * x by simp[diff,cube]; funext x dx; ring

/-!

Is unfolded to (we have to use a new identifier `cube_v1` as `cube` is
already defined)

 -/

def cube_v1 (x : ℝ) : ℝ := x * x * x

-- proof of smoothness
instance cube_v1.arg_x.isSmooth : IsSmooth (λ x => cube_v1 x) :=
by unfold cube_v1; infer_instance

-- differential definition
def cube_v1.arg_x.diff (x dx : ℝ) : ℝ := 3 * dx * x * x

-- simplifier rule
@[simp]
theorem cube_v1.arg_x.diff_simp
  : ∂ cube_v1 = cube_v1.arg_x.diff :=
by simp[diff,cube_v1]; funext x dx; ring

/-!

Using `diff_simp` annotation does not define `cube_v1.arg_x.diff` and
the simp theorem states directly `∂ cube_v1 = λ x dx => 3 * dx * x * x`.

 -/

/-!

Adjoint Differential
====================

Finding the minimum of a function `f : X → ℝ` with gradient descent
requires function's gradient `∇ f : X → X`.

However, can we compute the gradient just with the differential `∂`?
No we can't! We need an adjoint `†` too!

The differential `∂ f x` at point `x` is a linear function `X → R`.
When we take an adjoint and apply one we get an element of `X`. That
is the gradient of `f` at `x`!

In finite dimension, we can think about differential `∂ f x` is a row vector.
To get a column vector we have to transpose it i.e. take its adjoint.

For general function `f : X → Y`, we define adjoint differential
`∂† : (X → Y) → (X → Y → X)` as `∂† f x dy := (∂ f x)† dy`

Taking adjoint makes sense only for functions between Hilberts spaces.
Let's introduce few of those

 -/

section AdjointDifferential

  variable {X Y Z} [Hilbert X] [Hilbert Y] [Hilbert Z]

/-!

To stress the definition of adjoint differential

 -/

  example (f : X → Y) : ∂† f = λ x dy => (∂ f x)† dy := by rfl

/-!

Similarly to derivative `ⅆ`, we define a specialized operator gradient `∇`
for real valued functions over any Hilbert space

 -/

  example (f : X → ℝ) : ∇ f = λ x => (∂ f x)† 1 := by rfl

/-!

The important result is that the gradient of squared norm `∥x∥²` is `2*x`

 -/

  #check (∇ (x : X), ∥x∥²)
    rewrite_by
    (simp; trace_state)  /- .unfold -/

/-!

(TODO: Make sure we do not need to unfold gradient and hold here`)

Another fun result is that the gradient of `⟪A x, x⟫` is `(A† + A) x`

 -/

  variable (A : X → X) [HasAdjDiff A] [IsLin A]

  #check (∇ x, ⟪A x, x⟫)
    rewrite_by
    (simp[adjointDifferential]; trace_state) /- .unfold -/

/-!

(TODO: Ughh, this requires too many assumptions on A and too many unfolding`)

Similar to chain rule for differential, we have a chain rule for the adjoint
differential but the composition is in reverse

 -/

  variable (f : Y → Z) [HasAdjDiff f]
  variable (g : X → Y) [HasAdjDiff g]

  example : (∂† λ x => f (g x)) = (λ x dz => ∂† g x (∂† f (g x) dz)) :=
    by simp

/-!

(TODO: Explain what `HasAdjDiff f` is)

 -/

/-!

Euler-Lagrange Equations
------------------------

Let's write down Euler-Lagrange equations to demonstrate SciLean's notation
in a bit complicated scenario.

They are usally written in the following way

.. math:: \frac{d}{dt} \frac{\partial}{\partial \dot x} L(x(t),\dot x(t)) - \frac{\partial}{\partial x} L(x(t),\dot x(t)) = 0

However, the partial derivative notation is really ambigous. Thus a bit
more explicit form is

.. math:: \frac{d}{ds}\bigg\rvert_{s=t} \frac{\partial}{\partial v}\bigg\rvert_{v=\dot y(s)} L(y(s),v) - \frac{\partial}{\partial x}\bigg\rvert_{x=y(t)} L(x, \dot y(t)) = 0

And this form can be written in SciLean relativelly nicely.

 -/

  variable (L : X → X → ℝ)  -- Lagrangian
  variable (y : ℝ → X)      -- trajectory
  variable (t : ℝ)          -- time

  #check
    ⅆ (s:=t), ∇ (v:=ⅆ y s), L (y s) v - ∇ (x:=y t), L x (ⅆ y t) = 0

/-!

Let's plug in a Lagrangian for a particle in a potential field and hopefully
we get the correct equations of motion.

 -/
  def L' (ϕ : X → ℝ) (m : ℝ) (x v : X) := 1/2*m*∥v∥² - ϕ x

  variable [IsSmooth y]  -- trajectory is smooth
  variable (ϕ : X → ℝ)  [HasAdjDiff ϕ]
  variable (m : ℝ) -- mass

  #check
    (ⅆ (s:=t), ∇ (v:=ⅆ y s), L' ϕ m (y s) v
     -
     ∇ (x:=y t), L' ϕ m x (ⅆ y t))
    rewrite_by
    (-- Currently broken :(
     -- simp
     -- simp[gradient,hold]
     -- simp[derivative]
     trace_state) /- .unfold -/

/-!

(TODO: Make sure we get these rewrite to make the result look nicer

  `2 * (1/2) = 1`

  `differential (∂y) t 1 1 = ⅆ (ⅆ y) t`

  `adjointDifferential (fun x => ϕ x) (y t) (-1) = - ∇ ϕ (y t)`)

The result is (with the TODO rewrites) `m * ⅆ (ⅆ y) t + ∇ ϕ (y t)` which
exacly corresponts to the equation of a particle in a potential field `ϕ`

.. math:: m \ddot y(t) = - \nabla \phi (y(t))

 -/

end AdjointDifferential


import MyNat.Definition
namespace MyNat
open MyNat
/-!
# Function world.

## Level 7: `(P → Q) → ((Q → R) → (P → R))`

If you start with `intro hpq` and then `intro hqr`
the dust will clear a bit and the level will look like this:
```
P Q R : Prop,
hpq : P → Q,
hqr : Q → R
⊢ P → R
```
So this level is really about showing transitivity of `⟹`,
if you like that sort of language.

## Lemma : imp_trans

From `P ⟹ Q` and `Q ⟹ R` we can deduce `P ⟹ R`.
-/
lemma imp_trans (P Q R : Prop) : (P → Q) → ((Q → R) → (P → R)) := by
  intros hpq hqr
  intro p
  apply hqr
  apply hpq
  assumption

/-!
Here we finish this proof with a new tactic `assumption` instead of `exact p`.
The `assumption` tactic tries to solve the goal using a
hypothesis of compatible type.  Since we have the hypothesis named `p` it finds
it and completes the proof.

Next up [Level 8](./Level8.lean.md)
-/


import data.real.basic
import tactic
/-
Q2. The functions f , g : ℝ → ℝ are defined as follows:
f(x) = 2x if 0 ≤ x ≤ 1, and f (x) = 1 otherwise;
g(x) = x^2 if 0 ≤ x ≤ 1, and g(x) = 0 otherwise.

Give formulae describing the functions `g ∘ f` and
`f ∘ g`. (Draw the graphs of these functions.)
-/

noncomputable theory

def f (x : ℝ) := if 0 ≤ x ∧ x ≤ 1 then 2 * x else 1

def g (x : ℝ) := if 0 ≤ x ∧ x ≤ 1 then x ^ 2 else 0

example (x : ℝ) : (g ∘ f) x = if 0 ≤ x ∧ x ≤ 1/2 then 4 * x ^ 2 else if 1/2 < x ∧ x ≤ 1 then 0 else 1 -- replace with formula for g ∘ f
:=
begin
  change g (f x) = _,
  unfold f,
  unfold g,
  split_ifs;
  try {simp};
  try {rw not_and_distrib at *};
  try {cases h};
  try {cases h_1};
  try {cases h_2};
  try {cases h_3};
  try {linarith},
end

example (x : ℝ) : (f ∘ g) x = if 0 ≤ x ∧ x ≤ 1 then 2 * x ^ 2 else 0
:=
begin
  change f (g x) = _,
  unfold f,
  unfold g,
  split_ifs;
  try {simp};
  try {rw not_and_distrib at *};
  try {cases h};
  try {cases h_1};
  try {nlinarith},
end


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

! This file was ported from Lean 3 source module analysis.convex.complex
! leanprover-community/mathlib commit 15730e8d0af237a2ebafeb8cfbbcf71f6160c2e9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Basic
import Mathbin.Data.Complex.Module

/-!
# Convexity of half spaces in ℂ

The open and closed half-spaces in ℂ given by an inequality on either the real or imaginary part
are all convex over ℝ.
-/

theorem convex_halfspace_re_lt (r : ℝ) : Convex ℝ { c : ℂ | c.re < r } :=
  convex_halfspace_lt (IsLinearMap.mk Complex.add_re Complex.smul_re) _
#align convex_halfspace_re_lt convex_halfspace_re_lt

theorem convex_halfspace_re_le (r : ℝ) : Convex ℝ { c : ℂ | c.re ≤ r } :=
  convex_halfspace_le (IsLinearMap.mk Complex.add_re Complex.smul_re) _
#align convex_halfspace_re_le convex_halfspace_re_le

theorem convex_halfspace_re_gt (r : ℝ) : Convex ℝ { c : ℂ | r < c.re } :=
  convex_halfspace_gt (IsLinearMap.mk Complex.add_re Complex.smul_re) _
#align convex_halfspace_re_gt convex_halfspace_re_gt

theorem convex_halfspace_re_ge (r : ℝ) : Convex ℝ { c : ℂ | r ≤ c.re } :=
  convex_halfspace_ge (IsLinearMap.mk Complex.add_re Complex.smul_re) _
#align convex_halfspace_re_ge convex_halfspace_re_ge

theorem convex_halfspace_im_lt (r : ℝ) : Convex ℝ { c : ℂ | c.im < r } :=
  convex_halfspace_lt (IsLinearMap.mk Complex.add_im Complex.smul_im) _
#align convex_halfspace_im_lt convex_halfspace_im_lt

theorem convex_halfspace_im_le (r : ℝ) : Convex ℝ { c : ℂ | c.im ≤ r } :=
  convex_halfspace_le (IsLinearMap.mk Complex.add_im Complex.smul_im) _
#align convex_halfspace_im_le convex_halfspace_im_le

theorem convex_halfspace_im_gt (r : ℝ) : Convex ℝ { c : ℂ | r < c.im } :=
  convex_halfspace_gt (IsLinearMap.mk Complex.add_im Complex.smul_im) _
#align convex_halfspace_im_gt convex_halfspace_im_gt

theorem convex_halfspace_im_ge (r : ℝ) : Convex ℝ { c : ℂ | r ≤ c.im } :=
  convex_halfspace_ge (IsLinearMap.mk Complex.add_im Complex.smul_im) _
#align convex_halfspace_im_ge convex_halfspace_im_ge


import Mynat.Add

namespace mynat

def mymul (m n : mynat) : mynat :=
  match n with
  | zero => zero
  | succ n' => myadd (mymul m n') m

instance : Mul mynat where
  mul := mymul

theorem mul_zero (a : mynat) : a * 0 = 0 := rfl
theorem mul_succ (a b : mynat) : a * (succ b) = a * b + a := rfl

theorem zero_mul (m : mynat) : 0 * m = 0 := by
  cases m
  case zero =>
    rw [mynat_zero_eq_zero]
    rfl
  case succ m' =>
    rw [mul_succ]
    rw [zero_mul m']
    rfl

theorem mul_one (m : mynat) : m * 1 = m := by
  rw [one_eq_succ_zero]
  rw [mul_succ]
  rw [mul_zero]
  rw [zero_add]

theorem one_mul (m : mynat) : 1 * m = m := by
  cases m
  case zero =>
    rw [mynat_zero_eq_zero]
    rw [mul_zero]
  case succ m' =>
    rw [mul_succ]
    rw [one_mul m']
    rw [succ_eq_add_one]

theorem mul_add (t a b : mynat) : t * (a + b) = t * a + t * b := by
  cases b
  case zero =>
    rw [mynat_zero_eq_zero]
    rw [add_zero]
    rw [mul_zero]
    rw [add_zero]
  case succ b' =>
    rw [add_succ]
    rw [mul_succ]
    rw [mul_succ]
    rw [mul_add t a b']
    rw [add_assoc]

theorem mul_assoc (a b c : mynat) : (a * b) * c = a * (b * c) := by
  cases c
  case zero =>
    rw [mynat_zero_eq_zero]
    rw [mul_zero]
    rw [mul_zero]
    rw [mul_zero]
  case succ c' =>
    rw [mul_succ]
    rw [mul_succ]
    rw [mul_assoc a b c', mul_add]

theorem succ_mul (a b : mynat) : succ a * b = a * b + b := by
  cases b
  case zero =>
    rw [mynat_zero_eq_zero]
    rw [mul_zero]
    rw [mul_zero]
    rfl
  case succ b' =>
    rw [mul_succ]
    rw [mul_succ]
    rw [succ_mul a b']
    rw [add_succ]
    rw [add_succ]
    rw [add_assoc]
    rw [add_comm b' a]
    rw [add_assoc]

theorem add_mul (a b t : mynat) : (a + b) * t = a * t + b * t := by
  cases t
  case zero =>
    rw [mynat_zero_eq_zero]
    repeat {rw [mul_zero]}
    rfl
  case succ t' =>
    rw [mul_succ]
    rw [mul_succ]
    rw [mul_succ]
    rw [add_mul a b t']
    rw [← add_assoc]
    rw [← add_assoc]
    rw [add_assoc (a * t') (b * t') a]
    rw [add_comm (b * t') a]
    rw [add_assoc (a * t') a (b * t')]

theorem mul_comm (a b : mynat) : a * b = b * a := by
  cases b
  case zero =>
    rw [mynat_zero_eq_zero]
    rw [mul_zero]
    rw [zero_mul]
  case succ b' =>
    rw [mul_succ]
    rw [succ_mul]
    rw [mul_comm a b']

theorem mul_left_comm (a b c : mynat) : a * (b * c) = b * (a * c) := by
  rw [← mul_assoc]
  rw [← mul_assoc]
  rw [mul_comm a b]

attribute [simp] mul_assoc mul_comm mul_left_comm

end mynat