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

import data.real.basic

/-!
# IMO 2011 Q3

Let f : ℝ → ℝ be a function that satisfies

   f(x + y) ≤ y * f(x) + f(f(x))

for all x and y. Prove that f(x) = 0 for all x ≤ 0.

# Solution

Direct translation of the solution found in https://www.imo-official.org/problems/IMO2011SL.pdf
-/

theorem imo2011_q3 (f : ℝ → ℝ) (hf : ∀ x y, f (x + y) ≤ y * f x + f (f x)) :
  ∀ x ≤ 0, f x = 0 :=
begin
  -- reparameterize
  have hxt : ∀ x t, f t ≤ t * f x - x * f x + f (f x),
  { intros x t,
    calc f t = f (x + (t - x))             : by rw (add_eq_of_eq_sub' rfl)
         ... ≤ (t - x) * f x + f (f x)     : hf x (t - x)
         ... = t * f x - x * f x + f (f x) : by rw sub_mul },

  have h_ab_combined : ∀ a b, a * f a + b * f b ≤ 2 * f a * f b,
  { intros a b,
    linarith [hxt b (f a), hxt a (f b)] },

  have h_f_nonneg_of_pos : ∀ a < 0, 0 ≤ f a,
  { intros a han,
    suffices : a * f a ≤ 0, from nonneg_of_mul_nonpos_right this han,
    exact add_le_iff_nonpos_left.mp (h_ab_combined a (2 * f a)) },

  have h_f_nonpos : ∀ x, f x ≤ 0,
  { intros x,
    by_contra h_suppose_not,
    -- If we choose a small enough argument for f, then we get a contradiction.
    let s := (x * f x - f (f x)) / (f x),
    have hm : min 0 s - 1 < s := (sub_one_lt _).trans_le (min_le_right 0 s),
    have hml : min 0 s - 1 < 0 := (sub_one_lt _).trans_le (min_le_left 0 s),

    suffices : f (min 0 s - 1) < 0, from not_le.mpr this (h_f_nonneg_of_pos (min 0 s - 1) hml),

    have hp : 0 < f x := not_le.mp h_suppose_not,
    calc f (min 0 s - 1)
           ≤ (min 0 s - 1) * f x - x * f x + f (f x) : hxt x (min 0 s - 1)
      ...  < s * f x - x * f x + f (f x) : by linarith [(mul_lt_mul_right hp).mpr hm]
      ...  = 0 : by { rw [(eq_div_iff hp.ne.symm).mp rfl], linarith } },

  have h_fx_zero_of_neg : ∀ x < 0, f x = 0,
  { intros x hxz,
    exact (h_f_nonpos x).antisymm (h_f_nonneg_of_pos x hxz) },

  intros x hx,
  obtain (h_x_neg : x < 0) | (rfl : x = 0) := hx.lt_or_eq,
  { exact h_fx_zero_of_neg _ h_x_neg },
  { suffices : 0 ≤ f 0, from le_antisymm (h_f_nonpos 0) this,
    have hno : f (-1) = 0 := h_fx_zero_of_neg (-1) neg_one_lt_zero,
    have hp := hxt (-1) (-1),
    rw hno at hp,
    linarith },
end


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

/-!
# Intervals in a pi type

This file shows that (dependent) functions to locally finite orders equipped with the pointwise
order are locally finite and calculates the cardinality of their intervals.
-/

open finset fintype
open_locale big_operators

variables {ι : Type*} {α : ι → Type*} [decidable_eq ι] [fintype ι] [Π i, decidable_eq (α i)]
  [Π i, partial_order (α i)] [Π i, locally_finite_order (α i)]

namespace pi

instance : locally_finite_order (Π i, α i) :=
locally_finite_order.of_Icc _
  (λ a b, pi_finset $ λ i, Icc (a i) (b i))
  (λ a b x, by { simp_rw [mem_pi_finset, mem_Icc], exact forall_and_distrib })

variables (a b : Π i, α i)

lemma card_Icc : (Icc a b).card = ∏ i, (Icc (a i) (b i)).card := card_pi_finset _

lemma card_Ico : (Ico a b).card = (∏ i, (Icc (a i) (b i)).card) - 1 :=
by rw [card_Ico_eq_card_Icc_sub_one, card_Icc]

lemma card_Ioc : (Ioc a b).card = (∏ i, (Icc (a i) (b i)).card) - 1 :=
by rw [card_Ioc_eq_card_Icc_sub_one, card_Icc]

lemma card_Ioo : (Ioo a b).card = (∏ i, (Icc (a i) (b i)).card) - 2 :=
by rw [card_Ioo_eq_card_Icc_sub_two, card_Icc]

end pi


import data.nat.gcd data.nat.prime algebra.group_power

open nat

variables {a b p q r n : ℕ}
variables {N x y : ℤ}

theorem Q0805i (hp : gcd a b = 1) : N % a = 0 ∧ N % b = 0 → N % (a*b) = 0 := sorry

theorem Q0805ii (hp : prime p ∧ prime q ∧ prime r) (hq : p ≠ q) (h : q ≠ r) : x % (p*q*r) = y ↔ (x % p = y) ∧ (x % q = y) ∧ (x % r = y) := sorry

--(iii) (tough) Consider the set of positive integers {2^7 − 2, 3^7 − 3, 4^7 − 4, . . . , 1000^7 − 1000}. What is the greatest common divisor of all the elements of this set? Feel free to use a calculator to get the hang of this; feel free to use Fermat’s Little Theorem and the previous part to nail it.

--theorem Q0805iii

theorem Q0805iv : n^(561) % 561 = n :=
begin
induction n,
trivial,

end

theorem Q0805iv_cor  : (x^p % p = 1 → prime p) → ff := sorry

#eval 2^7 -2 --126
#eval 3^7-3 --2184
#eval 4^7-4 --16380
#eval gcd 16380 126


theorem ExF002{X : Type}{P Q : X → Prop}{a : X}: (∀x , (P x → Q x)) → P a → Q a :=
  assume H1: (∀x , (P x → Q x)),
    take (a:X),
    assume H2: P a,
    have A: P a → Q a, from H1 a,
    show Q a, from A H2


open nat

def mod2 : nat → nat
| 0 := 0
| (succ n) :=
  match mod2 n with
  | 0 := 1
  | (succ n) := 0
  end

lemma add2 : ∀ (n : nat), mod2 (n + 2) = mod2 n :=
begin
  intros,
  unfold mod2,
  induction n,
    simp [mod2],
  simp [mod2, n_ih]
end

lemma lem : ∀ (k n: nat), mod2 (n + k + k) = mod2 n :=
begin
    intro k, induction k,
        simp [mod2],
    intros,
    show mod2 (n + succ k_n + succ k_n) = mod2 n, from calc
    mod2 (n + succ k_n + succ k_n)
        = mod2 (n + (k_n + 1) + (k_n + 1)) : by refl
    ... = mod2 ((n + k_n + k_n) + 2) : by simp [add_comm, add_assoc]
    ... = mod2 (n + k_n + k_n) : by rw add2
    ... = mod2 n : by rw k_ih
end

example : ∀ (n : nat), mod2 n = mod2 (n * n) :=
begin
    intros,
    induction n,
        simp,
    simp [mul_succ, succ_mul],
    rw (add_comm (succ n_n)),
    rw ←(add_assoc n_n),
    rw add_succ,
    unfold mod2,
    have: mod2 (n_n + n_n * n_n + n_n) = mod2 n_n, from calc
    mod2 (n_n + n_n * n_n + n_n) = mod2 (n_n * n_n + n_n + n_n) : by simp [add_assoc, add_comm]
    ... = mod2 (n_n * n_n) : by rw (lem n_n (n_n * n_n))
    ... = mod2 n_n : by simp [n_ih],
    simp only [this],
end


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

Elegant pairing function.
-/
import data.nat.sqrt data.nat.div
open prod decidable

namespace nat
definition mkpair (a b : nat) : nat :=
if a < b then b*b + a else a*a + a + b

definition unpair (n : nat) : nat × nat :=
let s := sqrt n in
if n - s*s < s then (n - s*s, s) else (s, n - s*s - s)

theorem mkpair_unpair (n : nat) : mkpair (pr1 (unpair n)) (pr2 (unpair n)) = n :=
let s := sqrt n in
by_cases
  (suppose n - s*s < s,
    begin
      esimp [unpair],
      rewrite [if_pos this],
      esimp [mkpair],
      rewrite [if_pos this, add_sub_of_le (sqrt_lower n)]
    end)
  (suppose h₁ : ¬ n - s*s < s,
    have s ≤ n - s*s,                  from le_of_not_gt h₁,
    have s + s*s ≤ n - s*s + s*s,      from add_le_add_right this (s*s),
    have s*s + s ≤ n,                  by rewrite [nat.sub_add_cancel (sqrt_lower n) at this,
                                              add.comm at this]; assumption,
    have n ≤ s*s + s + s,              from sqrt_upper n,
    have n - s*s ≤ s + s,              from calc
        n - s*s ≤ (s*s + s + s) - s*s    : nat.sub_le_sub_right this (s*s)
            ... = (s*s + (s+s)) - s*s    : by rewrite add.assoc
            ... = s + s                  : by rewrite nat.add_sub_cancel_left,
    have   n - s*s - s ≤ s,              from calc
        n - s*s - s ≤ (s + s) - s        : nat.sub_le_sub_right this s
                ... = s                  : by rewrite nat.add_sub_cancel_left,
    have h₂ : ¬ s < n - s*s - s,       from not_lt_of_ge this,
    begin
      esimp [unpair],
      rewrite [if_neg h₁], esimp,
      esimp [mkpair],
      rewrite [if_neg h₂, nat.sub_sub, add_sub_of_le `s*s + s ≤ n`],
    end)

theorem unpair_mkpair (a b : nat) : unpair (mkpair a b) = (a, b) :=
by_cases
 (suppose a < b,
  have a ≤ b + b, from calc
    a   ≤ b   : le_of_lt this
    ... ≤ b+b : !le_add_right,
  begin
    esimp [mkpair],
    rewrite [if_pos `a < b`],
    esimp [unpair],
    rewrite [sqrt_offset_eq `a ≤ b + b`, nat.add_sub_cancel_left, if_pos `a < b`]
  end)
 (suppose ¬ a < b,
  have   b ≤ a,           from le_of_not_gt this,
  have a + b ≤ a + a,   from add_le_add_left this a,
  have   a + b ≥ a,       from !le_add_right,
  have ¬ a + b < a,     from not_lt_of_ge this,
  begin
    esimp [mkpair],
    rewrite [if_neg `¬ a < b`],
    esimp [unpair],
    rewrite [add.assoc (a * a) a b, sqrt_offset_eq `a + b ≤ a + a`, *nat.add_sub_cancel_left,
             if_neg `¬ a + b < a`]
  end)

open prod.ops

theorem unpair_lt_aux {n : nat} : n ≥ 1 → (unpair n).1 < n :=
suppose n ≥ 1,
or.elim (eq_or_lt_of_le this)
  (suppose 1 = n, by subst n; exact dec_trivial)
  (suppose n > 1,
   let s := sqrt n in
   by_cases
    (suppose h : n - s*s < s,
      have n > 0, from lt_of_succ_lt `n > 1`,
      have sqrt n > 0, from sqrt_pos_of_pos this,
      have sqrt n * sqrt n > 0, from mul_pos this this,
      begin unfold unpair, rewrite [if_pos h], esimp, exact sub_lt `n > 0` `sqrt n * sqrt n > 0` end)
    (suppose ¬ n - s*s < s, begin unfold unpair, rewrite [if_neg this], esimp, apply sqrt_lt `n > 1` end))

theorem unpair_lt : ∀ (n : nat), (unpair n).1 < succ n
| 0        := dec_trivial
| (succ n) :=
  have (unpair (succ n)).1 < succ n, from unpair_lt_aux dec_trivial,
  lt.step this
end nat


import interior_world.level1 --hide

/-

# Level 2: Second definition of the interior

Before we keep proving properties of the iterior of an arbitrary set, we will prove an alternative definition of it.

-/
variables {X : Type} -- hide
variables [topological_space X] (x : X)  (A : set X) -- hide

namespace topological_space -- hide

/- Lemma
The interior of a set A is the union of all the open sets that it contains:
$ \operatorname{int}(A) = \bigcup_{U \subseteq A, U\text{ open}} U$
-/
lemma interior_def' : interior A = ⋃₀ {U : set X | is_open U ∧ U ⊆ A} :=
begin
  simp only [interior, is_neighborhood, set.sUnion],
  ext,
  norm_num,
  tauto,

end

end topological_space -- hide


-- Reflexive
-- Does A ↔ A?
example: ∀(A: Prop), A ↔ A :=
begin
  assume A,
  split,
    assume pf_A,
    assumption,
    assume pf_A,
    assumption,
end

-- Symmetric (exercise)
-- Does (A ↔ B) → (B ↔ A)?
example: ∀(A B: Prop),
  (A ↔ B) → (B ↔ A) :=
begin
  assume A B,
  assume pf_A_iff_B,
  have pf_A_to_B := (iff.elim_left pf_A_iff_B),
  have pf_B_to_A := (iff.elim_right pf_A_iff_B),
  exact iff.intro pf_B_to_A pf_A_to_B,
end

axiom em: ∀(P: Prop), P ∨ ¬P

-- Uses axiom of the excluded middle (classical)
theorem implicationToDisjunction{P Q: Prop}:
  (P → Q) → (¬P ∨ Q) :=
begin
  assume pf_P_to_Q,
  cases (em P) with pf_P pf_not_P,
    -- pf_P
    have pf_Q := pf_P_to_Q pf_P,
    exact or.inr pf_Q,
    -- pf_not_P
    exact or.inl pf_not_P,
end

-- constructive
theorem modusTollens{P Q: Prop}:
  (P → Q) → (¬Q → ¬P) :=
begin
  assume pf_P_to_Q,
  assume pf_not_Q,
  assume pf_P,
  have pf_Q := pf_P_to_Q pf_P,
  exact pf_not_Q pf_Q,
end

-- Associative
-- Does ((A ↔ B) ↔ C) ↔ (A ↔ (B ↔ C))?
example: ∀(A B C: Prop),
  ((A ↔ B) ↔ C) ↔ (A ↔ (B ↔ C)) :=
begin
  assume A B C,
  split,
    -- ((A ↔ B) ↔ C) → (A ↔ (B ↔ C))
    assume pf_A_iff_B_iff_C,
    split,
      -- A → (B ↔ C)
      assume pf_A,
      split,
        -- B → C
        assume pf_B,
        have pf_A_iff_B_to_C :=
          (iff.elim_left pf_A_iff_B_iff_C),
        have pf_A_to_B: A → B :=
          begin
            assume pf_A',
            assumption,
          end,
        have pf_B_to_A :=
          λ(pf_B: B), pf_A,
        have pf_A_iff_B :=
          (iff.intro pf_A_to_B pf_B_to_A),
        exact pf_A_iff_B_to_C pf_A_iff_B,

        -- C → B
        assume pf_C,
        have pf_C_to_A_iff_B :=
          (iff.elim_right pf_A_iff_B_iff_C),
        have pf_A_iff_B := pf_C_to_A_iff_B pf_C,
        have pf_A_to_B := (iff.elim_left pf_A_iff_B),
        exact pf_A_to_B pf_A,
      -- (B ↔ C) → A
      assume pf_B_iff_C,
      have pf_C_to_A_iff_B :=
        (iff.elim_right pf_A_iff_B_iff_C),
      cases (em C) with pf_C pf_not_C,
        -- pf_C
        have pf_A_iff_B := pf_C_to_A_iff_B pf_C,
        have pf_B_to_A := (iff.elim_right pf_A_iff_B),
        cases (em B) with pf_B pf_not_B,
          -- pf_B
          exact pf_B_to_A pf_B,
          -- pf_not_B
          have pf_C_to_B := (iff.elim_right pf_B_iff_C),
          have pf_B := pf_C_to_B pf_C,
          exact false.elim (pf_not_B pf_B),
        -- pf_not_C
        cases (em B) with pf_B pf_not_B,
          -- pf_B
          have pf_B_to_C := (iff.elim_left pf_B_iff_C),
          have pf_C := pf_B_to_C pf_B,
          exact false.elim (pf_not_C pf_C),
          -- pf_not_B
          cases (em A) with pf_A pf_not_A,
            -- pf_A
            assumption,
            -- pf_not_A,
            have pf_A_iff_B_to_C := (iff.elim_left pf_A_iff_B_iff_C),
            have pf_A_to_B: A → B :=
              λ(pf_A: A), false.elim (pf_not_A pf_A),
            have pf_B_to_A: B → A :=
              λ(pf_B: B), false.elim (pf_not_B pf_B),
            have pf_A_iff_B := iff.intro pf_A_to_B pf_B_to_A,
            have pf_C := pf_A_iff_B_to_C pf_A_iff_B,
            exact false.elim (pf_not_C pf_C),
    -- (A ↔ (B ↔ C)) → ((A ↔ B) ↔ C)
    assume pf_A_iff__B_iff_C,
    split,
      -- (A ↔ B) → C
      assume pf_A_iff_B,
      cases (em A) with pf_A pf_not_A,
        -- pf_A
        -- Note the shorthand used here
        have pf_B := (iff.elim_left pf_A_iff_B) pf_A,
        have pf_B_iff_C := (iff.elim_left pf_A_iff__B_iff_C) pf_A,
        exact (iff.elim_left pf_B_iff_C) pf_B,
        -- pf_not_A
        cases (em B) with pf_B pf_not_B,
          -- pf_B
          -- Note the shorthand used here
          have pf_A := (iff.elim_right pf_A_iff_B) pf_B,
          exact false.elim (pf_not_A pf_A),
          -- pf_not_B
          cases (em C) with pf_C pf_not_C,
            -- pf_C
            assumption,
            -- pf_not_C
            have pf_B_to_C: B → C :=
              λ(pf_B: B), false.elim (pf_not_B pf_B),
            have pf_C_to_B: C → B :=
              λ(pf_C: C), false.elim (pf_not_C pf_C),
            have pf_B_iff_C := iff.intro pf_B_to_C pf_C_to_B,
            have pf_A := (iff.elim_right pf_A_iff__B_iff_C) pf_B_iff_C,
            exact false.elim (pf_not_A pf_A),
      -- C → (A ↔ B)
      assume pf_C,
      split,
        -- A → B
        assume pf_A,
        have pf_B_iff_C := (iff.elim_left pf_A_iff__B_iff_C) pf_A,
        have pf_C_to_B := (iff.elim_right pf_B_iff_C),
        exact pf_C_to_B pf_C,
        -- B → A
        assume pf_B,
        have pf_B_iff_C__to_A := (iff.elim_right pf_A_iff__B_iff_C),
        -- Note the shorthand used here
        have pf_B_iff_C := (iff.intro (λ(pfB: B), pf_C) (λ(pfC: C), pf_B)),
        exact pf_B_iff_C__to_A pf_B_iff_C,
end

-- Transitive (exercise)
-- Does (A ↔ B) → (B ↔ C) → (A ↔ C)?
example: ∀(A B C: Prop),
  (A ↔ B) → (B ↔ C) → (A ↔ C) :=
begin
  assume A B C,
  assume pf_A_iff_B pf_B_iff_C,
  split,
    -- prove A → C
    have pf_A_to_B := (iff.elim_left pf_A_iff_B),
    have pf_B_to_C := (iff.elim_left pf_B_iff_C),
    assume pf_A,
    have pf_B := pf_A_to_B pf_A,
    exact pf_B_to_C pf_B,
    -- prove C → A
    have pf_C_to_B := (iff.elim_right pf_B_iff_C),
    have pf_B_to_A := (iff.elim_right pf_A_iff_B),
    assume pf_C,
    have pf_B := pf_C_to_B pf_C,
    exact pf_B_to_A pf_B,
end

-- Connected
-- Does (A ≠ B) → ((A ↔ B) ∨ (B ↔ A))?
-- No
example: ¬∀(A B: Prop),
  (A ≠ B) → ((A ↔ B) ∨ (B ↔ A)) :=
begin
  assume pf_forall,
  have pf_false_true := pf_forall false true,
  have pf_false_neq_true: false ≠ true :=
    begin
      assume pf_false_is_true,
      have t := true.intro,
      have pf_true_is_false := eq.symm pf_false_is_true,
      rewrite pf_true_is_false at t,
      assumption,
    end,
  have pf_false_iff_true := pf_false_true pf_false_neq_true,
  cases pf_false_iff_true,
    -- false ↔ true
    have pf_true_to_false := (iff.elim_right pf_false_iff_true),
    exact pf_true_to_false true.intro,
    -- true ↔ false
    have pf_true_to_false := (iff.elim_left pf_false_iff_true),
    exact pf_true_to_false true.intro,
end

-- Exercise
example: ∀(P Q: Prop),
   P ∧ Q ↔ Q ∧ P :=
begin
  assume P Q,
  split,
    -- P ∧ Q → Q ∧ P
    assume pf_P_and_Q,
    have pf_Q := pf_P_and_Q.right,
    have pf_P := pf_P_and_Q.left,
    exact and.intro pf_Q pf_P,
    -- Q ∧ P → P ∧ Q
    assume pf_Q_and_P,
    have pf_P := pf_Q_and_P.right,
    have pf_Q := pf_Q_and_P.left,
    exact and.intro pf_P pf_Q,
end

-- Exercise
lemma a_imp_b_imp_c_iff_a_and_b_imp_c:
  ∀(A B C: Prop), A → B → C ↔ A ∧ B → C :=
begin
  assume A B C,
  split,
    -- (A → B → C) → A ∧ B → C
    assume pf_A_to_B_to_C,
    assume pf_A_and_B,
    have pf_A := pf_A_and_B.left,
    have pf_B_to_C := pf_A_to_B_to_C pf_A,
    have pf_B := pf_A_and_B.right,
    exact pf_B_to_C pf_B,
    -- (A ∧ B → C) → A → B → C
    assume pf_A_and_B_to_C,
    assume pf_A,
    assume pf_B,
    have pf_A_and_B := and.intro pf_A pf_B,
    exact pf_A_and_B_to_C pf_A_and_B,
end


/-
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
-/
import algebra.graded_monoid
import data.mv_polynomial.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

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

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

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

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

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

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

noncomputable theory

open_locale classical big_operators

open set function finset finsupp add_monoid_algebra

variables {R M : Type*} [comm_semiring R]

namespace mv_polynomial
variables {σ : Type*}

section add_comm_monoid
variables [add_comm_monoid M]

/-! ### `weighted_degree'` -/

/-- The `weighted degree'` of the finitely supported function `s : σ →₀ ℕ` is the sum
  `∑(s i)•(w i)`. -/
def weighted_degree' (w : σ → M) : (σ →₀ ℕ) →+ M :=
(finsupp.total σ M ℕ w).to_add_monoid_hom

section semilattice_sup
variable [semilattice_sup M]

/-- The weighted total degree of a multivariate polynomial, taking values in `with_bot M`. -/
def weighted_total_degree' (w : σ → M) (p : mv_polynomial σ R) : with_bot M :=
p.support.sup (λ s, weighted_degree' w s)

/-- The `weighted_total_degree'` of a polynomial `p` is `⊥` if and only if `p = 0`. -/
lemma weighted_total_degree'_eq_bot_iff (w : σ → M) (p : mv_polynomial σ R) :
  weighted_total_degree' w p = ⊥ ↔ p = 0 :=
begin
  simp only [weighted_total_degree',finset.sup_eq_bot_iff, mem_support_iff, with_bot.coe_ne_bot,
    mv_polynomial.eq_zero_iff ],
  exact forall_congr (λ _, not_not)
end

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

section order_bot
variable [order_bot 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 weighted_total_degree (w : σ → M) (p : mv_polynomial σ R) : M :=
p.support.sup (λ s, weighted_degree' w s)

/-- This lemma relates `weighted_total_degree` and `weighted_total_degree'`. -/
lemma weighted_total_degree_coe (w : σ → M) (p : mv_polynomial σ R) (hp : p ≠ 0):
  weighted_total_degree' w p = ↑(weighted_total_degree w p) :=
begin
  rw [ne.def, ← weighted_total_degree'_eq_bot_iff w p, ← ne.def, with_bot.ne_bot_iff_exists] at hp,
  obtain ⟨m, hm⟩ := hp,
  apply le_antisymm,
  { simp only [weighted_total_degree, weighted_total_degree', finset.sup_le_iff,
      with_bot.coe_le_coe],
    intro b,
    exact finset.le_sup },
  { simp only [weighted_total_degree],
    have hm' : weighted_total_degree' w p ≤ m := le_of_eq hm.symm,
    rw ← hm,
    simpa [weighted_total_degree'] using hm' }
end

/-- The `weighted_total_degree` of the zero polynomial is `⊥`. -/
lemma weighted_total_degree_zero (w : σ → M) :
  weighted_total_degree w (0 : mv_polynomial σ R) = ⊥ :=
by simp only [weighted_total_degree, support_zero, finset.sup_empty]

lemma le_weighted_total_degree (w : σ → M) {φ : mv_polynomial σ R} {d : σ →₀ ℕ}
  (hd : d ∈ φ.support) : weighted_degree' w d ≤ φ.weighted_total_degree w :=
le_sup hd

end order_bot
end semilattice_sup

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

variable (R)

/-- The submodule of homogeneous `mv_polynomial`s of degree `n`. -/
def weighted_homogeneous_submodule (w : σ → M) (m : M) :
  submodule R (mv_polynomial σ R) :=
{ carrier := { x | x.is_weighted_homogeneous w m },
  smul_mem' := λ r a ha c hc, begin
    rw coeff_smul at hc,
    exact ha (right_ne_zero_of_mul hc),
  end,
  zero_mem' := λ d hd, false.elim (hd $ coeff_zero _),
  add_mem' := λ a b ha hb c hc, begin
    rw coeff_add at hc,
    obtain h|h : coeff c a ≠ 0 ∨ coeff c b ≠ 0,
    { contrapose! hc, simp only [hc, add_zero] },
    { exact ha h },
    { exact hb h },
  end }

@[simp] lemma mem_weighted_homogeneous_submodule (w : σ → M) (m : M) (p : mv_polynomial σ R) :
  p ∈ weighted_homogeneous_submodule R w m ↔ p.is_weighted_homogeneous w m := iff.rfl

variables (R)

/-- The submodule ` weighted_homogeneous_submodule R w m` of homogeneous `mv_polynomial`s of
  degree `n` is equal to the `R`-submodule of all `p : (σ →₀ ℕ) →₀ R` such that
  `p.support ⊆ {d | weighted_degree' w d = m}`. While equal, the former has a
  convenient definitional reduction. -/
lemma weighted_homogeneous_submodule_eq_finsupp_supported (w : σ → M) (m : M) :
  weighted_homogeneous_submodule R w m =
  finsupp.supported _ R {d | weighted_degree' w d = m} :=
begin
  ext,
  simp only [mem_supported, set.subset_def, finsupp.mem_support_iff, mem_coe],
  refl,
end

variables {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`. -/
lemma weighted_homogeneous_submodule_mul (w : σ → M) (m n : M) :
  weighted_homogeneous_submodule R w m * weighted_homogeneous_submodule R w n ≤
    weighted_homogeneous_submodule R w (m + n) :=
begin
  rw submodule.mul_le,
  intros φ 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,
  { contrapose! H,
    by_cases h : coeff d φ = 0;
    simp only [*, ne.def, not_false_iff, zero_mul, mul_zero] at * },
  rw [← (finsupp.mem_antidiagonal.mp hde), ← hφ aux.1, ← hψ aux.2, map_add],
end

/-- Monomials are weighted homogeneous. -/
lemma is_weighted_homogeneous_monomial (w : σ → M) (d : σ →₀ ℕ) (r : R) {m : M}
  (hm : weighted_degree' w d = m) : is_weighted_homogeneous w (monomial d r) m :=
begin
  intros c hc,
  rw coeff_monomial at hc,
  split_ifs at hc with h,
  { subst c, exact hm },
  { contradiction }
end

/-- A polynomial of weighted_total_degree `⊥` is weighted_homogeneous of degree `⊥`. -/
lemma is_weighted_homogeneous_of_total_degree_zero [semilattice_sup M] [order_bot M]
  (w : σ → M) {p : mv_polynomial σ R} (hp : weighted_total_degree w p = (⊥ : M)) :
  is_weighted_homogeneous w p (⊥ : M) :=
begin
  intros d hd,
  have h := weighted_total_degree_coe w p (mv_polynomial.ne_zero_iff.mpr ⟨d, hd⟩),
  simp only [weighted_total_degree', hp] at h,
  rw [eq_bot_iff, ← with_bot.coe_le_coe, ← h],
  exact finset.le_sup (mem_support_iff.mpr hd),
end

/-- Constant polynomials are weighted homogeneous of degree 0. -/
lemma is_weighted_homogeneous_C (w : σ → M) (r : R) :
  is_weighted_homogeneous w (C r : mv_polynomial σ R) 0 :=
is_weighted_homogeneous_monomial _ _ _ (map_zero _)

variables (R)

/-- 0 is weighted homogeneous of any degree. -/
lemma is_weighted_homogeneous_zero (w : σ → M) (m : M) :
  is_weighted_homogeneous w (0 : mv_polynomial σ R) m :=
(weighted_homogeneous_submodule R w m).zero_mem

/-- 1 is weighted homogeneous of degree 0. -/
lemma is_weighted_homogeneous_one (w : σ → M) :
  is_weighted_homogeneous w (1 : mv_polynomial σ R) 0 :=
is_weighted_homogeneous_C _ _

/-- An indeterminate `i : σ` is weighted homogeneous of degree `w i`. -/
lemma is_weighted_homogeneous_X (w : σ → M) (i : σ) :
  is_weighted_homogeneous w (X i : mv_polynomial σ R) (w i) :=
begin
  apply is_weighted_homogeneous_monomial,
  simp only [weighted_degree', linear_map.to_add_monoid_hom_coe, total_single, one_nsmul],
end

namespace is_weighted_homogeneous
variables {R} {φ ψ : mv_polynomial σ R} {m n : M}

/-- The weighted degree of a weighted homogeneous polynomial controls its support. -/
lemma coeff_eq_zero {w : σ → M} (hφ : is_weighted_homogeneous w φ n) (d : σ →₀ ℕ)
  (hd : weighted_degree' w d ≠ n) : coeff d φ = 0 :=
by { have aux := mt (@hφ d) hd, rwa not_not at aux }

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

/-- The sum of two weighted homogeneous polynomials of degree `n` is weighted homogeneous of
  weighted degree `n`. -/
lemma add {w : σ → M} (hφ : is_weighted_homogeneous w φ n) (hψ : is_weighted_homogeneous w ψ n) :
  is_weighted_homogeneous w (φ + ψ) n :=
(weighted_homogeneous_submodule R w n).add_mem hφ hψ

/-- The sum of weighted homogeneous polynomials of degree `n` is weighted homogeneous of
  weighted degree `n`. -/
lemma sum  {ι : Type*} (s : finset ι)  (φ : ι → mv_polynomial σ R) (n : M) {w : σ → M}
  (h : ∀ i ∈ s, is_weighted_homogeneous w (φ i) n) :
  is_weighted_homogeneous w (∑ i in s, φ i) n :=
(weighted_homogeneous_submodule R w n).sum_mem h

/-- The product of weighted homogeneous polynomials of weighted degrees `m` and `n` is weighted
  homogeneous of weighted degree `m + n`. -/
lemma mul {w : σ → M} (hφ : is_weighted_homogeneous w φ m) (hψ : is_weighted_homogeneous w ψ n) :
  is_weighted_homogeneous w (φ * ψ) (m + n) :=
weighted_homogeneous_submodule_mul w m n $ submodule.mul_mem_mul hφ hψ

/-- A product of weighted homogeneous polynomials is weighted homogeneous, with weighted degree
  equal to the sum of the weighted degrees. -/
lemma prod {ι : Type*} (s : finset ι) (φ : ι → mv_polynomial σ R) (n : ι → M) {w : σ → M} :
  (∀ i ∈ s, is_weighted_homogeneous w (φ i) (n i)) →
  is_weighted_homogeneous w (∏ i in s, φ i) (∑ i in s, n i) :=
begin
  apply finset.induction_on s,
  { intro, simp only [is_weighted_homogeneous_one, finset.sum_empty, finset.prod_empty] },
  { intros 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 _),
    intros j hjs,
    exact h j (finset.mem_insert_of_mem hjs) }
end

/-- A non zero weighted homogeneous polynomial of weighted degree `n` has weighted total degree
  `n`. -/
lemma weighted_total_degree [semilattice_sup M] {w : σ → M} (hφ : is_weighted_homogeneous w φ n)
  (h : φ ≠ 0) : weighted_total_degree' w φ = n :=
begin
  simp only [weighted_total_degree'],
  apply le_antisymm,
  { simp only [finset.sup_le_iff, mem_support_iff, with_bot.coe_le_coe],
    exact λ 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,
    exact finset.le_sup hd, }
end

/-- The weighted homogeneous submodules form a graded monoid. -/
instance weighted_homogeneous_submodule.gcomm_monoid {w : σ → M} :
  set_like.graded_monoid (weighted_homogeneous_submodule R w) :=
{ one_mem := is_weighted_homogeneous_one R w,
  mul_mem := λ i j xi xj, is_weighted_homogeneous.mul }

end is_weighted_homogeneous

variables {R}

/-- `weighted_homogeneous_component w n φ` is the part of `φ` that is weighted homogeneous of
  weighted degree `n`, with respect to the weights `w`.
  See `sum_weighted_homogeneous_component` for the statement that `φ` is equal to the sum
  of all its weighted homogeneous components. -/
def weighted_homogeneous_component (w : σ → M) (n : M) :
  mv_polynomial σ R →ₗ[R] mv_polynomial σ R :=
(submodule.subtype _).comp $ finsupp.restrict_dom _ _ {d | weighted_degree' w d = n}

section weighted_homogeneous_component

variables {w : σ → M} (n : M) (φ ψ : mv_polynomial σ R)

lemma coeff_weighted_homogeneous_component (d : σ →₀ ℕ) :
  coeff d (weighted_homogeneous_component w n φ) =
    if weighted_degree' w d = n then coeff d φ else 0 :=
finsupp.filter_apply (λ d : σ →₀ ℕ, weighted_degree' w d = n) φ d

lemma weighted_homogeneous_component_apply :
  weighted_homogeneous_component w n φ =
  ∑ d in φ.support.filter (λ d, weighted_degree' w d = n), monomial d (coeff d φ) :=
finsupp.filter_eq_sum (λ d : σ →₀ ℕ, weighted_degree' w d = n) φ

/-- The `n` weighted homogeneous component of a polynomial is weighted homogeneous of
weighted degree `n`. -/
lemma weighted_homogeneous_component_is_weighted_homogeneous :
  (weighted_homogeneous_component w n φ).is_weighted_homogeneous w n :=
begin
  intros d hd,
  contrapose! hd,
  rw [coeff_weighted_homogeneous_component, if_neg hd]
end

@[simp]

lemma weighted_homogeneous_component_eq_zero' (h : ∀ d : σ →₀ ℕ, d ∈ φ.support →
  weighted_degree' w d ≠ n) : weighted_homogeneous_component w n φ = 0 :=
begin
  rw [weighted_homogeneous_component_apply, sum_eq_zero],
  intros d hd, rw mem_filter at hd,
  exfalso, exact h _ hd.1 hd.2
end

lemma weighted_homogeneous_component_eq_zero [semilattice_sup M] [order_bot M]
  (h : weighted_total_degree w φ < n) : weighted_homogeneous_component w n φ = 0 :=
begin
  rw [weighted_homogeneous_component_apply, sum_eq_zero],
  intros d hd, rw mem_filter at hd,
  exfalso,
  apply lt_irrefl n,
  nth_rewrite 0 ← hd.2,
  exact lt_of_le_of_lt (le_weighted_total_degree w hd.1) h,
end

lemma weighted_homogeneous_component_finsupp :
  (function.support (λ m, weighted_homogeneous_component w m φ)).finite :=
begin
  suffices : function.support (λ m, weighted_homogeneous_component w m φ) ⊆
    (λ d, weighted_degree' w d) '' φ.support,
  { exact finite.subset ((λ (d : σ →₀ ℕ), (weighted_degree' w) d) '' ↑(support φ)).to_finite this },
  intros m hm,
  by_contradiction hm', apply hm,
  simp only [mem_support, ne.def] at hm,
  simp only [set.mem_image, not_exists, not_and] at hm',
  exact weighted_homogeneous_component_eq_zero' m φ hm',
end

variable (w)

/-- Every polynomial is the sum of its weighted homogeneous components. -/
lemma sum_weighted_homogeneous_component :
  finsum (λ m, weighted_homogeneous_component w m φ) = φ :=
begin
  rw finsum_eq_sum _ (weighted_homogeneous_component_finsupp φ),
  ext1 d,
  simp only [coeff_sum, coeff_weighted_homogeneous_component],
  rw finset.sum_eq_single (weighted_degree' w d),
  { rw if_pos rfl, },
  { intros m hm hm', rw if_neg hm'.symm, },
  { intro hm, rw if_pos rfl,
    simp only [finite.mem_to_finset, mem_support, ne.def, not_not] at hm,
    have := coeff_weighted_homogeneous_component _ φ d,
    rw [hm, if_pos rfl, coeff_zero] at this,
    exact this.symm, },
end

variable {w}

/-- The weighted homogeneous components of a weighted homogeneous polynomial. -/
lemma weighted_homogeneous_component_weighted_homogeneous_polynomial (m n : M)
  (p : mv_polynomial σ R) (h : p ∈ weighted_homogeneous_submodule R w n) :
  weighted_homogeneous_component w m p = if m = n then p else 0 :=
begin
  simp only [mem_weighted_homogeneous_submodule] at h,
  ext x,
  rw coeff_weighted_homogeneous_component,
  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,
    { refl },
    { simp only [coeff_zero] } }
end

end weighted_homogeneous_component

end add_comm_monoid

section canonically_ordered_add_monoid

variables [canonically_ordered_add_monoid M] {w : σ → M} (φ : mv_polynomial σ R)

/-- If `M` is a `canonically_ordered_add_monoid`, then the `weighted_homogeneous_component`
  of weighted degree `0` of a polynomial is its constant coefficient. -/
@[simp] lemma weighted_homogeneous_component_zero [no_zero_smul_divisors ℕ M]
  (hw : ∀ i : σ, w i ≠ 0) : weighted_homogeneous_component w 0 φ = C (coeff 0 φ) :=
begin
  ext1 d,
  rcases em (d = 0) with (rfl|hd),
  { simp only [coeff_weighted_homogeneous_component, if_pos, map_zero, coeff_zero_C] },
  { rw [coeff_weighted_homogeneous_component, if_neg, coeff_C, if_neg (ne.symm hd)],
    simp only [weighted_degree', linear_map.to_add_monoid_hom_coe, finsupp.total_apply,
      finsupp.sum, sum_eq_zero_iff, finsupp.mem_support_iff, ne.def, smul_eq_zero,
      not_forall, not_or_distrib, and_self_left, exists_prop],
    simp only [finsupp.ext_iff, finsupp.coe_zero, pi.zero_apply, not_forall] at hd,
    obtain ⟨i, hi⟩ := hd,
    exact ⟨i, hi, hw i⟩ }
end

end canonically_ordered_add_monoid

end mv_polynomial


-- ---------------------------------------------------------------------
-- Ejercicio. Realizar las siguientes acciones:
-- 1. Importar la teoría Definicion_de_funciones_acotadas
-- 2. Habilitar la lógica clásica.
-- 3. Declarar f como una variable de ℝ en ℝ.
-- ----------------------------------------------------------------------

import .Definicion_de_funciones_acotadas   -- 1
open_locale classical                      -- 2
variable (f : ℝ → ℝ)                       -- 3

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que si
--    ¬ ∀ a, ∃ x, f x > a
-- entonces f está acotada superiormente.
-- ----------------------------------------------------------------------

example
  (h : ¬ ∀ a, ∃ x, f x > a)
  : fn_has_ub f :=
begin
  push_neg at h,
  exact h,
end

-- Prueba
-- ======

/-
f : ℝ → ℝ,
h : ¬∀ (a : ℝ), ∃ (x : ℝ), f x > a
⊢ fn_has_ub f
  >> push_neg at h,
h : ∃ (a : ℝ), ∀ (x : ℝ), f x ≤ a
⊢ fn_has_ub f
  >> exact h,
no goals
-/

-- Comentario. La táctica (push_neg at h) interioriza las negaciones de
-- la hipótesis h.

-- ---------------------------------------------------------------------
-- Ejercicio 3. Demostrar que si f no tiene cota superior, entonces para
-- cada a existe un x tal que f(x) > a.
-- ----------------------------------------------------------------------

example
  (h : ¬ fn_has_ub f)
  : ∀ a, ∃ x, f x > a :=
begin
  simp only [fn_has_ub, fn_ub] at h,
  push_neg at h,
  exact h,
end

-- Prueba
-- ======

/-
f : ℝ → ℝ,
h : ¬fn_has_ub f
⊢ ∀ (a : ℝ), ∃ (x : ℝ), f x > a
  >> simp only [fn_has_ub, fn_ub] at h,
h : ¬∃ (a : ℝ), ∀ (x : ℝ), f x ≤ a
⊢ ∀ (a : ℝ), ∃ (x : ℝ), f x > a
  >> push_neg at h,
h : ∀ (a : ℝ), ∃ (x : ℝ), a < f x
⊢ ∀ (a : ℝ), ∃ (x : ℝ), f x > a
  >> exact h,
no goals
-/

-- Comentario: La táctica (simp only [h₁, ..., hₙ] at h) simplifica la
-- hipótesis h usando sólo los lemas h₁, ..., hₙ. (Ver
-- https://bit.ly/38O60EV)


/- Let α be a type. We can represent a predicate p on α by an object of type
α → Prop. Likewise an object r : α → a → Prop represent a binary relation
on α. The universal quantifier  ∀ x:α, p x denotes "for every x of type α, the
proposition p x is True." It is associated with elim/intro rules based on
natural deduction: given a proof of p x where x is arbitrary, then we have
∀ x, p x. Likewise, given a proof ∀ x, p x, if t:α, then we have a proof of p t.

In the calculus of constructions, ∀ x, p x ↔ x:α → p x, so proving a universal
quantifier is really just constructing an ordinary function (albeit between
dependent function spaces).  -/

example (α : Type) (p q : α → Prop) : (∀ x : α, p x ∧ q x) → ∀ y : α, p y :=
  fun h : ∀ x : α, p x ∧ q x =>
    fun y : α =>
      show p y from (h y).left

-- I prefer the more functional way:
example (α : Type) (p q : α → Prop) (proof : ((x : α) → p x ∧ q x))
  : ((y : α) → p y) :=
    (fun y:α => (proof y).left)

-- Another example, expressing that a relation is transitive:

variable (α : Type) (r : α → α → Prop)
variable (trans_r : ∀ x y z, r x y → r y z → r x z)

variable (a b c : α)
variable (hab : r a b) (hbc : r b c)

#check trans_r    -- ∀ (x y z : α), r x y → r y z → r x z
#check trans_r a b c
#check trans_r a b c hab
#check trans_r a b c hab hbc

variable (α : Type) (r : α → α → Prop)

variable (refl_r : ∀ x, r x x)
variable (symm_r : ∀ {x y}, r x y → r y x)
variable (trans_r : ∀ {x y z}, r x y → r y z → r x z)

example (a b c d : α) (hab : r a b) (hcb : r c b) (hcd : r c d) : r a d :=
  trans_r (trans_r hab (symm_r hcb)) hcd

-- Equality --

-- Equality in Lean is an equivalence relation:

#check Eq.refl
#check Eq.symm
#check Eq.trans

-- The output is ugly because Lean is throwing in implicit metavariables. We can
-- clean it up by making things more explicit:

universe u
-- The inscription .{u} tells Lean to instantiate the constants at the universe u.
#check @Eq.refl.{u}
#check @Eq.symm.{u}
#check @Eq.trans.{u}

-- In particular this means we can specialize the above example to equality:

variable (α : Type) (a b c d : α)
variable (hab : a = b) (hcb : c = b) (hcd : c = d)

example : a = d :=
  Eq.trans (Eq.trans hab (Eq.symm hcb)) hcd

-- We can also use the projection relations (NL - ??? Just properties I guess.)

example : a = d := (hab.trans hcb.symm).trans hcd

/- Since all terms in CoC have computational interpretation and Lean treats all
CoC-equivalent objects as equal reflexivity can be used to prove nontrivial
identities: -/

variable (α β : Type)

example (f : α→β) (a:α) : (fun x => f x) a = f a := Eq.refl _ -- really Eq.refl (f a)
example (a:α) (b:α) : (a,b).1 = a := Eq.refl _
example : 2 + 3 = 5 := Eq.refl _

-- The library defines the shortcut "rfl" for Eq.refl _

example : 5 + 4 = 9 := rfl

/- One important structure equality has distinguishing it from other equivalence
relations is that every assertion respects the equivalence: given hxy : x = y and
hpx : p x, we have a proof of p y using substitution: -/

example (α:Type) (a b : α) (p: α -> Prop) (h1 : a = b) (h2 : p a) : p b :=
  Eq.subst h1 h2

example (α : Type) (a b : α) (p : α → Prop)
    (h1 : a = b) (h2 : p a) : p b :=
      h1 ▸ h2 -- ▸ is a macro for applying Eq.symm and Eq.subst, by typing `\t`.

/- There are auxillary rules defined with Eq.subst: congrArg can be used to
replace the argument, congrFun can be used to replace the term that is being
applied, and congr can be used to replace both at once: -/

variable (α : Type)
variable (a b : α)
variable (f g : α → Nat)
variable (h₁ : a = b)
variable (h₂ : f = g)

example : f a = f b := congrArg f h₁
example : f a = g a := congrFun h₂ a
example : f a = g b := congr h₂ h₁

variable (a b c d : Nat)

example : a + 0 = a := Nat.add_zero a
example : 0 + a = a := Nat.zero_add a
example : a * 1 = a := Nat.mul_one a
example : 1 * a = a := Nat.one_mul a
example : a + b = b + a := Nat.add_comm a b
example : a + b + c = a + (b + c) := Nat.add_assoc a b c
example : a * b = b * a := Nat.mul_comm a b
example : a * b * c = a * (b * c) := Nat.mul_assoc a b c
example : a * (b + c) = a * b + a * c := Nat.mul_add a b c
example : a * (b + c) = a * b + a * c := Nat.left_distrib a b c
example : (a + b) * c = a * c + b * c := Nat.add_mul a b c
example : (a + b) * c = a * c + b * c := Nat.right_distrib a b c

example (x y z : Nat) : x * (y + z) = x * y + x * z := Nat.mul_add x y z
example (x y z : Nat) : (x + y) * z = x * z + y * z := Nat.add_mul x y z
example (x y z : Nat) : x + y + z = x + (y + z) := Nat.add_assoc x y z

example (x y : Nat) : (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  let pf1 : (x + y) * (x + y) = (x + y) * x + (x + y) * y
    := Nat.mul_add (x + y) x y
  let pf2 : (x + y) * (x + y) = x * x + y * x + (x * y + y * y) :=
    (Nat.add_mul x y x) ▸ (Nat.add_mul x y y ) ▸ pf1
  pf2.trans (Nat.add_assoc (x*x + y*x) (x*y) (y*y)).symm

/- Note the signature for subst:
Eq.subst : ∀ {α : Sort u} {motive : α → Prop} {a b : α},
  a = b → motive a → motive b

If motive is implicit then Lean often has trouble figuring out what it is -
it is an instance of the higher-order unification problem which is in fact
undecidable. The macro ▸ uses certain heuristics behind the scenes and often
succeeds when Eq.subst fails.
-/

-- Exercises --

-- 1. Prove these equivalences:

 variable (α : Type) (p q : α → Prop)

 example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  ⟨fun pfpaq => ⟨fun x => (pfpaq x).1,fun x => (pfpaq x).2⟩,
  fun ⟨pfp,pfq⟩ => fun x => ⟨pfp x,pfq x⟩⟩

 example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) := fun f =>
  fun fp => (fun px => (f px) (fp px))

 example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x := fun pOr =>
  Or.elim pOr (fun forallP => (fun px => Or.inl (forallP px))) (fun forallQ => (fun px => Or.inr (forallQ px)))

/-2. It is often possible to bring a component of a formula outside a universal
quantifier, when it does not depend on the quantified variable. Try proving
these (one direction of the second of these requires classical logic):-/

variable (α : Type) (p q : α → Prop)
variable (r : Prop)
open Classical

example : α → ((∀ x : α, r) ↔ r) := fun a =>
  ⟨fun pxr => pxr a, fun pXr => (fun pX => pXr)⟩

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
  ⟨fun pXO => byContradiction (fun contra =>
                                -- need to rewrite the contradition to ¬(∀ x, px) ∧ ¬ r,
                                -- then use Or.elim to get the contradiction
                                let ⟨rwp,rwr⟩ : ¬(∀ x, p x) ∧ ¬ r := sorry
                                sorry),
   fun ppOR => Or.elim ppOR
                       (fun fX => (fun pX => Or.inl (fX pX)))
                       (fun fR => fun fX => Or.inr fR)⟩

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
  ⟨fun pf => (fun pR => (fun pX => (pf pX) pR)),
   fun pf => fun pX => fun pR => (pf pR) pX⟩

/- 3. Consider the "barber paradox," that is, the claim that in a certain town
there is a (male) barber that shaves all and only the men who do not shave
themselves. Prove that this is a contradiction: -/

variable (men : Type) (barber : men)
variable  (shaves : men → men → Prop)

-- presumably this is in the standard library...
theorem noSelfCont {p:Prop} : ¬(p ↔ ¬p) :=
  fun ⟨c,d⟩ =>
    let r := (fun hp:p => (c hp) hp)
    r (d r)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : False :=
  noSelfCont (h barber)

/- 4. Remember that, without any parameters, an expression of type Prop is just
an assertion. Fill in the definitions of prime and Fermat_prime below, and
construct each of the given assertions. -/

def even (n : Nat) : Prop := n % 2 = 0

def prime (n : Nat) : Prop := ∀a b, a*b=n → a = 1 ∨ b = 1

def infinitely_many_primes : Prop := ∀ n:Nat, prime n → ∃ k, prime k ∧ k > n

def Fermat_prime (n : Nat) : Prop := prime n ∧ ∃ k, n = (Nat.pow 2 k) + 1

def infinitely_many_Fermat_primes : Prop :=
   ∀ n:Nat, Fermat_prime n → ∃ k, Fermat_prime k ∧ k > n

def goldbach_conjecture : Prop :=
  ∀ n:Nat, even n ∧ n > 2 -> ∃ k j, prime k ∧ prime j ∧ n = k+j

def Goldbach's_weak_conjecture : Prop :=
  ∀ n:Nat, (¬(even n)) ∧ n > 5 -> ∃ j k l, prime k ∧ prime j ∧ prime l ∧ n = k+j+l

def Fermat's_last_theorem : Prop :=
  ∀ a b c n :Nat, (Nat.pow a n) + (Nat.pow b n) = (Nat.pow c n) -> n = 1 ∨ n = 2

/- 5. Prove as many of the identities listed in the Existential Quantifier
section as you can. We also leave it to you to determine which are
nonconstructive, and hence require some form of classical reasoning.-/

open Classical

variable (α : Type) (p q : α → Prop)
variable (r : Prop)

example : (∃ x : α, r) → r :=
  fun pf => Exists.elim pf (fun _ => (fun prf => prf))

example (a : α) : r → (∃ x : α, r) :=
  fun prf => Exists.intro a prf

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
  ⟨fun prf => Exists.elim prf (fun y => fun ⟨py,pr⟩ => ⟨Exists.intro y py,pr⟩),
   fun ⟨pxPx,pr⟩ => Exists.elim pxPx (fun y => fun px => Exists.intro y ⟨px, pr⟩)⟩

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
  ⟨fun prf => Exists.elim prf (fun y =>
    fun pf => Or.elim pf (fun py => Or.inl (Exists.intro y py))
                          (fun pq => Or.inr (Exists.intro y pq))),
   fun prf => Or.elim prf
                (fun pp => Exists.elim pp (fun y => fun pf =>
                                            (Exists.intro y (Or.inl pf))))
                (fun pq => Exists.elim pq (fun y => fun pf =>
                                            (Exists.intro y (Or.inr pf))))⟩

-- Pretty sure ← requires classical reasoning.
example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
  ⟨fun pf => fun ePf => Exists.elim ePf (fun y => fun c => c (pf y)),
   fun contra => fun y => sorry⟩

-- Pretty sure ← requires classical reasoning.
example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
  ⟨fun pf => Exists.elim pf (fun y => fun pr => (fun ow => (ow y) pr)),
  fun contra =>
    byCases
      (fun hp:  ∃ x, p x => hp)
      (fun hnp => sorry)⟩

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
  ⟨fun prf => (fun x => fun (pr:p x) => prf (Exists.intro x pr)),
  fun prf => (fun ePf => Exists.elim ePf (fun y => fun pf => (prf y) pf))⟩

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
  ⟨fun contra => Exists.intro sorry sorry,
   fun prf => fun contra => Exists.elim prf (fun y => fun c => c (contra y))⟩

example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
  ⟨fun prf => fun ePrf => Exists.elim ePrf prf,
   fun prf => fun y => sorry⟩

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
  ⟨fun pf => fun allPf => Exists.elim pf sorry,
   fun pf => sorry⟩

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := sorry


-- #4

import data.nat.basic
import data.nat.pow

#check pow
#check pow 2 3
#check 2 ^ 3

#check even

def prime (n : ℕ) : Prop :=
n > 1 ∧ ∀ a b : ℕ, n = a * b → a = 1 ∧ b = n ∨ a = n ∧ b = 1

def infinitely_many_primes : Prop := ∀ n : ℕ, ∃ p : ℕ, prime p ∧ p > n

def two_pow : ℕ → ℕ
| 0 := 1
| (n + 1) := 2 * two_pow n

def two_pow' (n : ℕ) : ℕ := 2 ^ n

def pow' (b n : ℕ ) : ℕ := b ^ n

#eval 2 ^ 3
#eval 0 ^ 3
#eval 3 ^ 0
#eval 0 ^ 0

def Fermat_number (n : ℕ) : ℕ := 2 ^ (2 ^ n) + 1

def Fermat_prime (n : ℕ) : Prop := prime n ∧ ∃ m : ℕ, n = Fermat_number m

def infinitely_many_Fermat_primes : Prop := ∀ n : ℕ, ∃ m : ℕ, m > n ∧ Fermat_prime m

def goldbach_conjecture : Prop :=
∀ n : ℕ, even n ∧ n > 2 → ∃ a b : ℕ, prime a ∧ prime b ∧ n = a + b

def Goldbach's_weak_conjecture : Prop :=
∀ n : ℕ, odd n ∧ n > 5 → ∃ a b c : ℕ, prime a ∧ prime b ∧ prime c ∧ n = a + b + c

def Fermat's_last_theorem : Prop :=
∀ x y z n : ℕ, x > 0 ∧ y > 0 ∧ n > 1 ∧ x ^ n + y ^ n = z ^ n → n = 2


namespace nat

/-
  Part 1. Summation.
-/
-- define summation up to (but not including) n
def sum_upto (n : ℕ) (f : ℕ → ℕ) : ℕ :=
nat.rec_on n 0 (λ n recval, recval + f n)

-- the computation rules
theorem sum_upto_zero (f : ℕ → ℕ) : sum_upto 0 f = 0 := rfl
theorem sum_upto_succ (f : ℕ → ℕ) (n : ℕ) : sum_upto (succ n) f = sum_upto n f + f n := rfl

-- fill in the next two proofs
theorem sum_upto_mul (n m : ℕ) (f : ℕ → ℕ) : sum_upto n (λ x, m * f x) = m * (sum_upto n f) :=
nat.induction_on n rfl
(take n,
 assume ih: sum_upto n (λ x, m * f x) = m * (sum_upto n f),
 show sum_upto (succ n) (λ x, m * f x) = m * (sum_upto (succ n) f), from
calc
  sum_upto (succ n) (λ x, m * f x) = sum_upto n (λ x, m * f x) + (λ x, m * f x) n : by rw sum_upto_succ
          ...                      = m * (sum_upto n f) + (λ x, m * f x) n        : by rw ih
          ...                      = m * (sum_upto n f) + m * ((λ x, f x ) n)     : rfl
          ...                      = m * (sum_upto n f + (λ x, f x) n)            : by rw mul_add
          ...                      = m * (sum_upto n f + f n)                     : rfl
          ...                      = m * (sum_upto (succ n) f)                    : by rw sum_upto_succ)

theorem sum_upto_id (n : ℕ) : 2 * sum_upto (succ n) id = n * (n + 1) :=
nat.induction_on n rfl
(take n,
  assume ih: 2 * sum_upto (succ n) id = n * (n + 1),
  show 2 * sum_upto (succ (succ n)) id = (succ n) * ((succ n) + 1), from
  calc
    2 * sum_upto (succ (succ n)) id = 2 * (sum_upto (succ n) id + id (succ n)) : by rw sum_upto_succ
            ...                     = 2 * (sum_upto (succ n) id) + 2 * id(succ n) : by rw mul_add
            ...                     = n * (n + 1) + 2 * id (succ n)          : by rw ih
            ...                     = n * (n + 1) + 2 * (succ n)             : rfl
            ...                     = n * (succ n) + 2 * (succ n)            : rfl
            ...                     = (succ n) * n + 2 * (succ n)            : by rw mul_comm
            ...                     = (succ n) * n + (succ n) * 2            : by simp --by rw mul_comm
            ...                     = (succ n) * (n + 2)                     : by rw mul_add
            ...                     = (succ n) * (n + 1 + 1)                 : rfl
            ...                     = (succ n) * ((succ n) + 1)              : rfl)

/-
   Part 2. Exponentiation on nat.
-/

-- the definition
def pow : ℕ → ℕ → ℕ
| m 0 := 1
| m (succ n) := m * pow m n

-- declare the notation
infix ^ := pow

-- the computation rules
theorem pow_zero (m : ℕ) : m ^ 0 = 1 := rfl
theorem pow_succ (m n : ℕ) : m ^ (succ n) = m * m ^ n := rfl

-- fill in the next four proofs
theorem zero_pow_succ (n : ℕ) : 0^(succ n) = 0 :=
nat.induction_on n rfl
( take n,
  assume ih,
  show 0^(succ (succ n)) = 0, from
  calc
      0^(succ (succ n)) = 0 * 0^(succ n)  : by rw pow_succ
          ...           = 0 * 0           : by rw ih
          ...           = 0               : by rw mul_zero)

theorem pow_add (m n k : ℕ) : m ^ (n + k) = m ^ n * m ^ k :=
nat.induction_on n
  (calc
      m ^ (0 + k) = m ^ k         : by rw zero_add
          ...     = 1 * m ^ k     : by rw one_mul
          ...     = m ^ 0 * m ^ k : rfl)
  (take n,
    assume ih,
    show m ^ ((succ n) + k) = m ^ (succ n) * m ^ k, from
    calc
     m ^ ((succ n) + k) = m ^ ((n + 1) + k)    : rfl
          ...          = m ^ (k + (n + 1))    : by rw add_comm
          ...          = m ^ ((k + n) + 1)    : by rw add_assoc
          ...          = m ^ ((n + k) + 1)    : by simp
          ...          = m ^ (succ (n + k))   : rfl
          ...          = m * m ^ (n + k)      : by rw pow_succ
          ...          = m * (m ^ n * m ^ k)  : by rw ih
          ...          = (m * m ^ n) * m ^ k  : by rw mul_assoc
          ...          = m ^ (succ n) * m ^ k : by rw pow_succ)

theorem pow_mul (m n k : ℕ) : m ^ (n * k) = (m ^ n) ^ k :=
nat.induction_on k
(calc
  m ^ (n * 0) = m ^ (0)     : by rw mul_zero
      ...     = 1           : by rw pow_zero
      ...     = (m ^ n) ^ 0 : by rw pow_zero)
(take k,
 assume ih,
 show  m ^ (n * (succ k)) = (m ^ n) ^ (succ k), from
 calc
      m ^ (n * (succ k)) = m ^ (n * (k + 1))      : rfl
            ...          = m ^ (n * k + n * 1)    : by rw mul_add
            ...          = m ^ (n * k) * m ^ (n * 1) : sorry
            ...          = (m ^ n) ^ k * m ^ (n * 1) : by rw ih
            ...          = (m ^ n) ^ k * (m ^ n) : by rw mul_one
            ...          = (m ^ n) * (m ^ n) ^ k : by rw mul_comm
            ...          = (m ^ n) ^ (succ k)     : by rw pow_succ)

check zero_lt_one
check @mul_pos

theorem pow_pos {m : ℕ} (h : m > 0) {n : ℕ} : m^n > 0 :=
nat.induction_on n
( have H1: m^0 = 1, from rfl,
  show m^0 > 0, from zero_lt_one)
( take n,
  assume ih,
  have H1: m^ (succ n) = m * m^n, from rfl,
  show m^(succ n) > 0, from mul_pos h ih)

/- The last one is pow_le, below. It is not easy, so just give it your best
   shot. The next few examples might be helpful. -/

-- By the way, this is a useful trick. I will explain it in class.
example : 3 < 7 := dec_trivial

check @mul_le_mul
check @mul_le_mul_left
check @nat.zero_le

example (m : ℕ) (h : m > 0) : m ≥ 1 := succ_le_of_lt h
-- actually, on ℕ, x < y is defined to mean succ x < y
example (m : ℕ) (h : m > 0) : m ≥ 1 := h

example (m n : ℕ) (h : m ≤ n) : ∃ k, m + k = n := le.dest h

lemma le_mul_self (m n : ℕ) (h : m = 0 ∨ n > 0) : m ≤ m * n :=
or.elim h
  (suppose m = 0,
    begin simp [this] end)
  (suppose n > 0,
    have m * 1 ≤ m * n,
      from mul_le_mul_left _ this,
    begin
      rw mul_one at this, exact this
    end)
check @mul_le_mul_left
-- Be careful! The following theorem is false without the hypotheses m > 0 (why?)
theorem pow_le (m : ℕ) {n k : ℕ} (h : n ≤ k) (mpos : m > 0) : m^n ≤ m^k :=
have H1: m*n ≤ m*k, from (mul_le_mul_left m h),
sorry
--Are you supposed to use induction? Because I couldn't figure out what I
--was supposed to induct on.
--Without induction, I do not know how to expand m ^ n since ^ is defined for
--m ^ succ n

check le_of_eq

/-
  Part 3. Division on the Natural Numbers.

  These have nothing to do with inductive types (except for the fact that
  the existential quantifier is really an inductive type).
-/

protected def dvd (m n : ℕ) : Prop := ∃ k, n = m * k

instance : has_dvd nat := ⟨nat.dvd⟩

-- type "dvd" with \|

theorem dvd_rfl (m : ℕ) : m ∣ m :=
exists.intro 1 (by rw [(mul_one m)])

theorem dvd_trans : ∀ {m n k : ℕ}, m ∣ n → n ∣ k → m ∣ k :=
take m n k,
assume h1 h2,
have H1: ∃ a, n = m * a, from h1,
have H2: ∃ b, k = n * b, from h2,
exists.elim H1
(take a,
  assume H3: n = m * a,
  exists.elim H2
  (take b,
    assume H4: k = n * b,
    show ∃ c, k = m * c, from
      (have H5: k = m * a * b, from (by rw [-H3, H4]),
       have H6: k = m * (a * b), from (by rw [H5, mul_assoc]),
      exists.intro (a * b) H6)))

theorem dvd_mul_left (m n : ℕ) : m ∣ m * n :=
have H1: m ∣ m, from (dvd_rfl m),
have H2: ∃ a, m = m * a, from H1,
exists.elim H2
(take a,
  assume H3: m = m * a,
  have H4: m * n = m * a * n, from (by rw [-H3]),
  have H5: m * n = m * (a * n), from (by rw [H4, mul_assoc]),
  show m ∣ m * n , from exists.intro (a * n) H5)

theorem dvd_mul_right (m n : ℕ) : m ∣ n * m :=
have H1: m ∣ m * n, from (dvd_mul_left m n),
have H2: ∃ a, m * n = m * a, from H1,
exists.elim H2
(take a,
  assume H3: m * n = m * a,
  have H4: n * m = m * a, from (by rw [-H3, mul_comm]),
  show m ∣ n * m, from exists.intro a H4)

theorem dvd_add : ∀ {m n k : ℕ}, m ∣ n → m ∣ k → m ∣ (n + k) :=
take m n k,
take h₁ h₂,
have H1: ∃ a, n = m * a, from h₁,
have H2: ∃ b, k = m * b, from h₂,
exists.elim H1
(take a,
  assume H3: n = m * a,
  exists.elim H2
  (take b,
   assume H4: k = m * b,
   have H5: n + k = m * (a + b), from (by rw [H3, H4, mul_add]),
   show m ∣ (n + k), from exists.intro (a + b) H5))

end nat

/-
  Part 4. The size of a binary tree.

  This one is really optional, for those of you who said you want something
  more challenging.
-/

open nat

inductive btree : Type
| leaf : btree
| node : btree → btree → btree

namespace btree

def size : btree → ℕ
| leaf := 1
| (node b₁ b₂) := size b₁ + size b₂ + 1

theorem size_pos (b : btree) : size b > 0 :=
btree.induction_on b
  dec_trivial
  (take b₁ b₂,
    assume ih₁ ih₂,
     succ_pos _)

def depth : btree → ℕ
| leaf := 1
| (node b₁ b₂) := max (depth b₁) (depth b₂) + 1

-- This is a scandal. I promise, eventually the simplifier will do this.
lemma add_self_eq_two_mul (m : ℕ) : m + m = 2 * m :=
calc
  m + m = (1 + 1) * m : by simp [add_mul, one_mul]
    ... = 2 * m       : rfl

-- these might be useful.
check @nat.sub_add_cancel
check @nat.add_sub_assoc

-- prove this by induction on binary trees
theorem size_le' : ∀ b : btree, size b + 1 ≤ 2 ^ depth b :=
take b,
btree.induction_on b
dec_trivial
(take b₁ b₂,
 assume ih₁ ih₂,
 have H1: (size b₁ + 1) + (size b₂ + 1) ≤ (2 ^ depth b₁) + (2 ^ depth b₂), from (add_le_add ih₁ ih₂),
 have H2: 2 ^ (max (depth b₁) (depth b₂) + 1) = 2 ^ depth (node b₁ b₂), from rfl,
 have H3:  2 ^ (max (depth b₁) (depth b₂) + 1) ≤ 2 ^ depth (node b₁ b₂), from (le_of_eq H2),
 calc
    size (node b₁ b₂) + 1 = (size b₁ + size b₂ + 1) + 1 : rfl
          ...             = (size b₁ + 1) + (size b₂ + 1) : by simp
          ...             ≤ (2 ^ depth b₁) + (2 ^ depth b₂) : H1
          ...             ≤ 2 ^ (max (depth b₁) (depth b₂) + 1) : sorry
          ...             = 2 ^ depth (node b₁ b₂) : rfl
          ...             ≤ 2 ^ depth (node b₁ b₂) : H3)
check @add_le_add

theorem size_le : ∀ b : btree, size b ≤ 2 ^ depth b - 1:=
take b,
have size b = size b + 1 - 1, from rfl,
calc
  size b = size b + 1 - 1 : this
     ... ≤ 2 ^ depth b - 1 : nat.sub_le_sub_right (size_le' b) _

end btree


import .love10_denotational_semantics_demo

/-! # LoVe Exercise 10: Denotational Semantics -/

set_option pp.beta true

namespace LoVe

/-! ## Question 1: Monotonicity

1.1. Prove the following lemma from the lecture. -/

lemma monotone_comp {α β : Type} [partial_order α] (f g : α → set (β × β))
    (hf : monotone f) (hg : monotone g) :
  monotone (λa, f a ◯ g a) :=
sorry

/-! 1.2. Prove its cousin. -/

lemma monotone_restrict {α β : Type} [partial_order α] (f : α → set (β × β))
    (p : β → Prop) (hf : monotone f) :
  monotone (λa, f a ⇃ p) :=
sorry

/-! ## Question 2: Regular Expressions

__Regular expressions__, or __regexes__, are a highly popular tool for software
development, to analyze textual inputs. Regexes are generated by the following
grammar:

    R ::= ∅
        | ε
        | a
        | R ⬝ R
        | R + R
        | R*

Informally, the semantics of regular expressions is as follows:

* `∅` accepts nothing;
* `ε` accepts the empty string;
* `a` accepts the atom `a`;
* `R ⬝ R` accepts the concatenation of two regexes;
* `R + R` accepts either of two regexes;
* `R*` accepts arbitrary many repetitions of a regex.

Notice the rough correspondence with a WHILE language:

    `∅` ~ diverging statement (e.g., `while true do skip`)
    `ε` ~ `skip`
    `a` ~ `:=`
    `⬝` ~ `;`
    `+` ~ `if then else`
    `*` ~ `while` loop -/

inductive regex (α : Type) : Type
| nothing {} : regex
| empty {}   : regex
| atom       : α → regex
| concat     : regex → regex → regex
| alt        : regex → regex → regex
| star       : regex → regex

/-! In this exercise, we explore an alternative semantics of regular
expressions. Namely, we can imagine that the atoms represent binary relations,
instead of letters or symbols. Concatenation corresponds to composition of
relations, and alternation is union. Mathematically, regexes and binary
relations are both instances of Kleene algebras.

2.1. Complete the following translation of regular expressions to relations.

Hint: Exploit the correspondence with the WHILE language. -/

def rel_of_regex {α : Type} : regex (set (α × α)) → set (α × α)
| regex.nothing        := ∅
| regex.empty          := Id
| (regex.atom s)       := s
-- enter the missing cases here

/-! 2.2. Prove the following recursive equation about your definition. -/

lemma rel_of_regex_star {α : Type} (r : regex (set (α × α))) :
  rel_of_regex (regex.star r) =
  rel_of_regex (regex.alt (regex.concat r (regex.star r)) regex.empty) :=
sorry

end LoVe


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Anne Baanen
-/
import linear_algebra.dimension

/-!
# Finite dimension of vector spaces

Definition of the rank of a module, or dimension of a vector space, as a natural number.

## Main definitions

Defined is `finite_dimensional.finrank`, the dimension of a finite dimensional space, returning a
`nat`, as opposed to `module.rank`, which returns a `cardinal`. When the space has infinite
dimension, its `finrank` is by convention set to `0`.

The definition of `finrank` does not assume a `finite_dimensional` instance, but lemmas might.
Import `linear_algebra.finite_dimensional` to get access to these additional lemmas.

Formulas for the dimension are given for linear equivs, in `linear_equiv.finrank_eq`

## Implementation notes

Most results are deduced from the corresponding results for the general dimension (as a cardinal),
in `dimension.lean`. Not all results have been ported yet.

You should not assume that there has been any effort to state lemmas as generally as possible.
-/

universes u v v' w
open_locale classical cardinal

open cardinal submodule module function

variables {K : Type u} {V : Type v}

namespace finite_dimensional

open is_noetherian

section division_ring

variables [division_ring K] [add_comm_group V] [module K V]
{V₂ : Type v'} [add_comm_group V₂] [module K V₂]

/-- The rank of a module as a natural number.

Defined by convention to be `0` if the space has infinite rank.

For a vector space `V` over a field `K`, this is the same as the finite dimension
of `V` over `K`.
-/
noncomputable def finrank (R V : Type*) [semiring R]
  [add_comm_group V] [module R V] : ℕ :=
(module.rank R V).to_nat

lemma finrank_eq_of_dim_eq {n : ℕ} (h : module.rank K V = ↑ n) : finrank K V = n :=
begin
  apply_fun to_nat at h,
  rw to_nat_cast at h,
  exact_mod_cast h,
end

lemma finrank_le_of_dim_le {n : ℕ} (h : module.rank K V ≤ ↑ n) : finrank K V ≤ n :=
begin
  rwa [← cardinal.to_nat_le_iff_le_of_lt_aleph_0, to_nat_cast] at h,
  { exact h.trans_lt (nat_lt_aleph_0 n) },
  { exact nat_lt_aleph_0 n },
end

lemma finrank_lt_of_dim_lt {n : ℕ} (h : module.rank K V < ↑ n) : finrank K V < n :=
begin
  rwa [← cardinal.to_nat_lt_iff_lt_of_lt_aleph_0, to_nat_cast] at h,
  { exact h.trans (nat_lt_aleph_0 n) },
  { exact nat_lt_aleph_0 n },
end

lemma dim_lt_of_finrank_lt {n : ℕ} (h : n < finrank K V) : ↑n < module.rank K V :=
begin
  rwa [← cardinal.to_nat_lt_iff_lt_of_lt_aleph_0, to_nat_cast],
  { exact nat_lt_aleph_0 n },
  { contrapose! h,
    rw [finrank, cardinal.to_nat_apply_of_aleph_0_le h],
    exact n.zero_le },
end

/-- If a vector space has a finite basis, then its dimension is equal to the cardinality of the
basis. -/
lemma finrank_eq_card_basis {ι : Type w} [fintype ι] (h : basis ι K V) :
  finrank K V = fintype.card ι :=
finrank_eq_of_dim_eq (dim_eq_card_basis h)

/-- If a vector space has a finite basis, then its dimension is equal to the cardinality of the
basis. This lemma uses a `finset` instead of indexed types. -/
lemma finrank_eq_card_finset_basis {ι : Type w} {b : finset ι}
  (h : basis.{w} b K V) :
  finrank K V = finset.card b :=
by rw [finrank_eq_card_basis h, fintype.card_coe]

/-- A finite dimensional space is nontrivial if it has positive `finrank`. -/
lemma nontrivial_of_finrank_pos (h : 0 < finrank K V) : nontrivial V :=
dim_pos_iff_nontrivial.mp (dim_lt_of_finrank_lt h)

/-- A finite dimensional space is nontrivial if it has `finrank` equal to the successor of a
natural number. -/
lemma nontrivial_of_finrank_eq_succ {n : ℕ} (hn : finrank K V = n.succ) : nontrivial V :=
nontrivial_of_finrank_pos (by rw hn; exact n.succ_pos)

/-- A (finite dimensional) space that is a subsingleton has zero `finrank`. -/
lemma finrank_zero_of_subsingleton [h : subsingleton V] :
  finrank K V = 0 :=
begin
  by_contra h0,
  obtain ⟨x, y, hxy⟩ := (nontrivial_of_finrank_pos (nat.pos_of_ne_zero h0)),
  exact hxy (subsingleton.elim _ _)
end

lemma basis.subset_extend {s : set V} (hs : linear_independent K (coe : s → V)) :
  s ⊆ hs.extend (set.subset_univ _) :=
hs.subset_extend _

variable (K)
/-- A division_ring is one-dimensional as a vector space over itself. -/
@[simp] lemma finrank_self : finrank K K = 1 :=
finrank_eq_of_dim_eq (by simp)

/-- The vector space of functions on a fintype ι has finrank equal to the cardinality of ι. -/
@[simp] lemma finrank_fintype_fun_eq_card {ι : Type v} [fintype ι] :
  finrank K (ι → K) = fintype.card ι :=
finrank_eq_of_dim_eq dim_fun'

/-- The vector space of functions on `fin n` has finrank equal to `n`. -/
@[simp] lemma finrank_fin_fun {n : ℕ} : finrank K (fin n → K) = n :=
by simp

end division_ring

end finite_dimensional

variables {K V}

section zero_dim

variables [division_ring K] [add_comm_group V] [module K V]

open finite_dimensional

lemma finrank_eq_zero_of_basis_imp_not_finite
  (h : ∀ s : set V, basis.{v} (s : set V) K V → ¬ s.finite) : finrank K V = 0 :=
dif_neg (λ dim_lt, h _ (basis.of_vector_space K V)
  ((basis.of_vector_space K V).finite_index_of_dim_lt_aleph_0 dim_lt))

lemma finrank_eq_zero_of_basis_imp_false
  (h : ∀ s : finset V, basis.{v} (s : set V) K V → false) : finrank K V = 0 :=
finrank_eq_zero_of_basis_imp_not_finite (λ s b hs, h hs.to_finset (by { convert b, simp }))

lemma finrank_eq_zero_of_not_exists_basis
  (h : ¬ (∃ s : finset V, nonempty (basis (s : set V) K V))) : finrank K V = 0 :=
finrank_eq_zero_of_basis_imp_false (λ s b, h ⟨s, ⟨b⟩⟩)

lemma finrank_eq_zero_of_not_exists_basis_finite
  (h : ¬ ∃ (s : set V) (b : basis.{v} (s : set V) K V), s.finite) : finrank K V = 0 :=
finrank_eq_zero_of_basis_imp_not_finite (λ s b hs, h ⟨s, b, hs⟩)

lemma finrank_eq_zero_of_not_exists_basis_finset
  (h : ¬ ∃ (s : finset V), nonempty (basis s K V)) : finrank K V = 0 :=
finrank_eq_zero_of_basis_imp_false (λ s b, h ⟨s, ⟨b⟩⟩)

variables (K V)

@[simp] lemma finrank_bot : finrank K (⊥ : submodule K V) = 0 :=
finrank_eq_of_dim_eq (dim_bot _ _)

end zero_dim

namespace linear_equiv
open finite_dimensional

variables [division_ring K] [add_comm_group V] [module K V]
{V₂ : Type v'} [add_comm_group V₂] [module K V₂]

variables {R M M₂ : Type*} [ring R] [add_comm_group M] [add_comm_group M₂]
variables [module R M] [module R M₂]

/-- The dimension of a finite dimensional space is preserved under linear equivalence. -/
theorem finrank_eq (f : M ≃ₗ[R] M₂) : finrank R M = finrank R M₂ :=
by { unfold finrank, rw [← cardinal.to_nat_lift, f.lift_dim_eq, cardinal.to_nat_lift] }

/-- Pushforwards of finite-dimensional submodules along a `linear_equiv` have the same finrank. -/
lemma finrank_map_eq (f : M ≃ₗ[R] M₂) (p : submodule R M) :
  finrank R (p.map (f : M →ₗ[R] M₂)) = finrank R p :=
(f.submodule_map p).finrank_eq.symm

end linear_equiv

namespace linear_map
open finite_dimensional

section division_ring
variables [division_ring K] [add_comm_group V] [module K V]
{V₂ : Type v'} [add_comm_group V₂] [module K V₂]

/-- The dimensions of the domain and range of an injective linear map are equal. -/
lemma finrank_range_of_inj {f : V →ₗ[K] V₂} (hf : function.injective f) :
  finrank K f.range = finrank K V :=
by rw (linear_equiv.of_injective f hf).finrank_eq

end division_ring

end linear_map

open module finite_dimensional

section
variables [division_ring K] [add_comm_group V] [module K V]

@[simp]
theorem finrank_top : finrank K (⊤ : submodule K V) = finrank K V :=
by { unfold finrank, simp [dim_top] }

end

namespace submodule

section division_ring
variables [division_ring K] [add_comm_group V] [module K V]
{V₂ : Type v'} [add_comm_group V₂] [module K V₂]

lemma lt_of_le_of_finrank_lt_finrank {s t : submodule K V}
  (le : s ≤ t) (lt : finrank K s < finrank K t) : s < t :=
lt_of_le_of_ne le (λ h, ne_of_lt lt (by rw h))

lemma lt_top_of_finrank_lt_finrank {s : submodule K V}
  (lt : finrank K s < finrank K V) : s < ⊤ :=
begin
  rw ← @finrank_top K V at lt,
  exact lt_of_le_of_finrank_lt_finrank le_top lt
end

end division_ring

end submodule

section span

open submodule

section division_ring
variables [division_ring K] [add_comm_group V] [module K V]

variable (K)

/-- The rank of a set of vectors as a natural number. -/
protected noncomputable def set.finrank (s : set V) : ℕ := finrank K (span K s)

variable {K}

lemma finrank_span_le_card (s : set V) [fintype s] :
  finrank K (span K s) ≤ s.to_finset.card :=
finrank_le_of_dim_le (by simpa using dim_span_le s)

lemma finrank_span_finset_le_card (s : finset V)  :
  (s : set V).finrank K ≤ s.card :=
calc (s : set V).finrank K ≤ (s : set V).to_finset.card : finrank_span_le_card s
                                ... = s.card : by simp

lemma finrank_range_le_card {ι : Type*} [fintype ι] {b : ι → V} :
  (set.range b).finrank K ≤ fintype.card ι :=
(finrank_span_le_card _).trans $ by { rw set.to_finset_range, exact finset.card_image_le }

lemma finrank_span_eq_card {ι : Type*} [fintype ι] {b : ι → V}
  (hb : linear_independent K b) :
  finrank K (span K (set.range b)) = fintype.card ι :=
finrank_eq_of_dim_eq
begin
  have : module.rank K (span K (set.range b)) = #(set.range b) := dim_span hb,
  rwa [←lift_inj, mk_range_eq_of_injective hb.injective, cardinal.mk_fintype, lift_nat_cast,
       lift_eq_nat_iff] at this,
end

lemma finrank_span_set_eq_card (s : set V) [fintype s]
  (hs : linear_independent K (coe : s → V)) :
  finrank K (span K s) = s.to_finset.card :=
finrank_eq_of_dim_eq
begin
  have : module.rank K (span K s) = #s := dim_span_set hs,
  rwa [cardinal.mk_fintype, ←set.to_finset_card] at this,
end

lemma finrank_span_finset_eq_card (s : finset V)
  (hs : linear_independent K (coe : s → V)) :
  finrank K (span K (s : set V)) = s.card :=
begin
  convert finrank_span_set_eq_card ↑s hs,
  ext,
  simp,
end

lemma span_lt_of_subset_of_card_lt_finrank {s : set V} [fintype s] {t : submodule K V}
  (subset : s ⊆ t) (card_lt : s.to_finset.card < finrank K t) : span K s < t :=
lt_of_le_of_finrank_lt_finrank
  (span_le.mpr subset)
  (lt_of_le_of_lt (finrank_span_le_card _) card_lt)

lemma span_lt_top_of_card_lt_finrank {s : set V} [fintype s]
  (card_lt : s.to_finset.card < finrank K V) : span K s < ⊤ :=
lt_top_of_finrank_lt_finrank (lt_of_le_of_lt (finrank_span_le_card _) card_lt)

end division_ring

end span

section basis

section division_ring
variables [division_ring K] [add_comm_group V] [module K V]

lemma linear_independent_of_top_le_span_of_card_eq_finrank {ι : Type*} [fintype ι] {b : ι → V}
  (spans : ⊤ ≤ span K (set.range b)) (card_eq : fintype.card ι = finrank K V) :
  linear_independent K b :=
linear_independent_iff'.mpr $ λ s g dependent i i_mem_s,
begin
  by_contra gx_ne_zero,
  -- We'll derive a contradiction by showing `b '' (univ \ {i})` of cardinality `n - 1`
  -- spans a vector space of dimension `n`.
  refine not_le_of_gt (span_lt_top_of_card_lt_finrank
    (show (b '' (set.univ \ {i})).to_finset.card < finrank K V, from _)) _,
  { calc (b '' (set.univ \ {i})).to_finset.card = ((set.univ \ {i}).to_finset.image b).card
      : by rw [set.to_finset_card, fintype.card_of_finset]
    ... ≤ (set.univ \ {i}).to_finset.card : finset.card_image_le
    ... = (finset.univ.erase i).card : congr_arg finset.card (finset.ext (by simp [and_comm]))
    ... < finset.univ.card : finset.card_erase_lt_of_mem (finset.mem_univ i)
    ... = finrank K V : card_eq },

  -- We already have that `b '' univ` spans the whole space,
  -- so we only need to show that the span of `b '' (univ \ {i})` contains each `b j`.
  refine spans.trans (span_le.mpr _),
  rintros _ ⟨j, rfl, rfl⟩,
  -- The case that `j ≠ i` is easy because `b j ∈ b '' (univ \ {i})`.
  by_cases j_eq : j = i,
  swap,
  { refine subset_span ⟨j, (set.mem_diff _).mpr ⟨set.mem_univ _, _⟩, rfl⟩,
    exact mt set.mem_singleton_iff.mp j_eq },

  -- To show `b i ∈ span (b '' (univ \ {i}))`, we use that it's a weighted sum
  -- of the other `b j`s.
  rw [j_eq, set_like.mem_coe, show b i = -((g i)⁻¹ • (s.erase i).sum (λ j, g j • b j)), from _],
  { refine neg_mem (smul_mem _ _ (sum_mem (λ k hk, _))),
    obtain ⟨k_ne_i, k_mem⟩ := finset.mem_erase.mp hk,
    refine smul_mem _ _ (subset_span ⟨k, _, rfl⟩),
    simpa using k_mem },

  -- To show `b i` is a weighted sum of the other `b j`s, we'll rewrite this sum
  -- to have the form of the assumption `dependent`.
  apply eq_neg_of_add_eq_zero_left,
  calc b i + (g i)⁻¹ • (s.erase i).sum (λ j, g j • b j)
      = (g i)⁻¹ • (g i • b i + (s.erase i).sum (λ j, g j • b j))
    : by rw [smul_add, ←mul_smul, inv_mul_cancel gx_ne_zero, one_smul]
  ... = (g i)⁻¹ • 0 : congr_arg _ _
  ... = 0           : smul_zero _,
  -- And then it's just a bit of manipulation with finite sums.
  rwa [← finset.insert_erase i_mem_s, finset.sum_insert (finset.not_mem_erase _ _)] at dependent
end

/-- A finite family of vectors is linearly independent if and only if
its cardinality equals the dimension of its span. -/
lemma linear_independent_iff_card_eq_finrank_span {ι : Type*} [fintype ι] {b : ι → V} :
  linear_independent K b ↔ fintype.card ι = (set.range b).finrank K :=
begin
  split,
  { intro h,
    exact (finrank_span_eq_card h).symm },
  { intro hc,
    let f := (submodule.subtype (span K (set.range b))),
    let b' : ι → span K (set.range b) :=
      λ i, ⟨b i, mem_span.2 (λ p hp, hp (set.mem_range_self _))⟩,
    have hs : ⊤ ≤ span K (set.range b'),
    { intro x,
      have h : span K (f '' (set.range b')) = map f (span K (set.range b')) := span_image f,
      have hf : f '' (set.range b') = set.range b, { ext x, simp [set.mem_image, set.mem_range] },
      rw hf at h,
      have hx : (x : V) ∈ span K (set.range b) := x.property,
      conv at hx { congr, skip, rw h },
      simpa [mem_map] using hx },
    have hi : f.ker = ⊥ := ker_subtype _,
    convert (linear_independent_of_top_le_span_of_card_eq_finrank hs hc).map' _ hi }
end

lemma linear_independent_iff_card_le_finrank_span {ι : Type*} [fintype ι] {b : ι → V} :
  linear_independent K b ↔ fintype.card ι ≤ (set.range b).finrank K :=
by rw [linear_independent_iff_card_eq_finrank_span, finrank_range_le_card.le_iff_eq]

/-- A family of `finrank K V` vectors forms a basis if they span the whole space. -/
noncomputable def basis_of_top_le_span_of_card_eq_finrank {ι : Type*} [fintype ι] (b : ι → V)
  (le_span : ⊤ ≤ span K (set.range b)) (card_eq : fintype.card ι = finrank K V) :
  basis ι K V :=
basis.mk (linear_independent_of_top_le_span_of_card_eq_finrank le_span card_eq) le_span

@[simp] lemma coe_basis_of_top_le_span_of_card_eq_finrank {ι : Type*} [fintype ι] (b : ι → V)
  (le_span : ⊤ ≤ span K (set.range b)) (card_eq : fintype.card ι = finrank K V) :
   ⇑(basis_of_top_le_span_of_card_eq_finrank b le_span card_eq) = b :=
basis.coe_mk _ _

/-- A finset of `finrank K V` vectors forms a basis if they span the whole space. -/
@[simps]
noncomputable def finset_basis_of_top_le_span_of_card_eq_finrank {s : finset V}
  (le_span : ⊤ ≤ span K (s : set V)) (card_eq : s.card = finrank K V) :
  basis (s : set V) K V :=
basis_of_top_le_span_of_card_eq_finrank (coe : (s : set V) → V)
  ((@subtype.range_coe_subtype _ (λ x, x ∈ s)).symm ▸ le_span)
  (trans (fintype.card_coe _) card_eq)

/-- A set of `finrank K V` vectors forms a basis if they span the whole space. -/
@[simps]
noncomputable def set_basis_of_top_le_span_of_card_eq_finrank {s : set V} [fintype s]
  (le_span : ⊤ ≤ span K s) (card_eq : s.to_finset.card = finrank K V) :
  basis s K V :=
basis_of_top_le_span_of_card_eq_finrank (coe : s → V)
  ((@subtype.range_coe_subtype _ s).symm ▸ le_span)
  (trans s.to_finset_card.symm card_eq)

end division_ring

end basis

/-!
We now give characterisations of `finrank K V = 1` and `finrank K V ≤ 1`.
-/
section finrank_eq_one

variables [division_ring K] [add_comm_group V] [module K V]

/-- If there is a nonzero vector and every other vector is a multiple of it,
then the module has dimension one. -/
lemma finrank_eq_one (v : V) (n : v ≠ 0) (h : ∀ w : V, ∃ c : K, c • v = w) :
  finrank K V = 1 :=
begin
  obtain ⟨b⟩ := (basis.basis_singleton_iff punit).mpr ⟨v, n, h⟩,
  rw [finrank_eq_card_basis b, fintype.card_punit]
end

/--
If every vector is a multiple of some `v : V`, then `V` has dimension at most one.
-/
lemma finrank_le_one (v : V) (h : ∀ w : V, ∃ c : K, c • v = w) :
  finrank K V ≤ 1 :=
begin
  rcases eq_or_ne v 0 with rfl | hn,
  { haveI := subsingleton_of_forall_eq (0 : V) (λ w, by { obtain ⟨c, rfl⟩ := h w, simp }),
    rw finrank_zero_of_subsingleton,
    exact zero_le_one },
  { exact (finrank_eq_one v hn h).le }
end

end finrank_eq_one

section subalgebra_dim
open module
variables {F E : Type*} [field F] [ring E] [algebra F E]

@[simp] lemma subalgebra.dim_bot [nontrivial E] : module.rank F (⊥ : subalgebra F E) = 1 :=
((subalgebra.to_submodule_equiv (⊥ : subalgebra F E)).symm.trans $
  linear_equiv.of_eq _ _ algebra.to_submodule_bot).dim_eq.trans $
  by { rw dim_span_set, exacts [mk_singleton _, linear_independent_singleton one_ne_zero] }

@[simp] lemma subalgebra.dim_to_submodule (S : subalgebra F E) :
  module.rank F S.to_submodule = module.rank F S := rfl

@[simp] lemma subalgebra.finrank_to_submodule (S : subalgebra F E) :
  finrank F S.to_submodule = finrank F S := rfl

lemma subalgebra_top_dim_eq_submodule_top_dim :
  module.rank F (⊤ : subalgebra F E) = module.rank F (⊤ : submodule F E) :=
by { rw ← algebra.top_to_submodule, refl }

lemma subalgebra_top_finrank_eq_submodule_top_finrank :
  finrank F (⊤ : subalgebra F E) = finrank F (⊤ : submodule F E) :=
by { rw ← algebra.top_to_submodule, refl }

lemma subalgebra.dim_top : module.rank F (⊤ : subalgebra F E) = module.rank F E :=
by { rw subalgebra_top_dim_eq_submodule_top_dim, exact dim_top F E }

@[simp]
lemma subalgebra.finrank_bot [nontrivial E] : finrank F (⊥ : subalgebra F E) = 1 :=
finrank_eq_of_dim_eq (by simp)

end subalgebra_dim


import data.real.basic

/-
One of the earliest kind of proofs one encounters while learning mathematics is proving by
a calculation. It may not sound like a proof, but this is actually using lemmas expressing
properties of operations on numbers. It also uses the fundamental property of equality: if two
mathematical objects A and B are equal then, in any statement involving A, one can replace A
by B. This operation is called rewriting, and the Lean "tactic" for this is `rw`.

In the following exercises, we will use the following two lemmas:
  mul_assoc a b c : a * b * c = a * (b * c)
  mul_comm a b : a*b = b*a

Hence the command
  rw mul_assoc a b c,
will replace a*b*c by a*(b*c) in the current goal.

In order to replace backward, we use
  rw ← mul_assoc a b c,
replacing a*(b*c) by a*b*c in the current goal.

Of course we don't want to constantly invoke those lemmas, and we will eventually introduce
more powerful solutions.
-/

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

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

-- 0002
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

/-
Now let's return to the preceding example to experiment with what happens
if we don't give arguments to mul_assoc or mul_comm.
For instance, you can start the next proof with
  rw ← mul_assoc,
Try to figure out what happens.
-/

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

/-
We can also perform rewriting in an assumption of the local context, using for instance
  rw mul_comm a b at hyp,
in order to replace a*b by b*a in assumption hyp.

The next example will use a third lemma:
  two_mul a : 2*a = a + a

Also we use the `exact` tactic, which allows to provide a direct proof term.
-/

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, -- Our assumption hyp is now exactly what we have to prove
end

/-
And the next one can use:
  sub_self x : x - x = 0
-/

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

/-
What is written in the two preceding example is very far away from what we would write on
paper. Let's now see how to get a more natural layout.
Inside each pair of curly braces below, the goal is to prove equality with the preceding line.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  calc c = d*a + b : by { rw hyp }
  ... = d*a + a*d  : by { rw hyp' }
  ... = a*d + a*d  : by { rw mul_comm d a }
  ... = 2*(a*d)    : by { rw two_mul }
  ... = 2*a*d      : by { rw mul_assoc },
end

/-
Let's note there is no comma at the end of each line of calculation. `calc` is really one
command, and the comma comes only after it's fully done.

From a practical point of view, when writing such a proof, it is convenient to:
* pause the tactic state view update in VScode by clicking the Pause icon button
  in the top right corner of the Lean Goal buffer
* write the full calculation, ending each line with ": by {}"
* resume tactic state update by clicking the Play icon button and fill in proofs between
  curly braces.

Let's return to the other example using this method.
-/

-- 0005
example (a b c d : ℝ) (hyp : c = b*a - d) (hyp' : d = a*b) : c = 0 :=
begin
  calc c = b * a - d  : by { rw hyp }
  ... = a * b - d     : by { rw mul_comm a b }
  ... = a * b - a * b : by { rw hyp' }
  ... = 0             : by { rw sub_self (a * b) },
end

/-
The preceding proofs have exhausted our supply of "mul_comm" patience. Now it's time
to get the computer to work harder. The `ring` tactic will prove any goal that follows by
applying only the axioms of commutative (semi-)rings, in particular commutativity and
associativity of addition and multiplication, as well as distributivity.

We also note that curly braces are not necessary when we write a single tactic proof, so
let's get rid of them.
-/

example (a b c d : ℝ) (hyp : c = d*a + b) (hyp' : b = a*d) : c = 2*a*d :=
begin
  calc c = d*a + b   : by rw hyp
     ... = d*a + a*d : by rw hyp'
     ... = 2*a*d     : by ring,
end

/-
Of course we can use `ring` outside of `calc`. Let's do the next one in one line.
-/

-- 0006
example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  calc a * (b * c) = b * (a * c) : by ring,
end

/-
This is too much fun. Let's do it again.
-/

-- 0007
example (a b : ℝ) : (a + b) + a = 2*a + b :=
begin
  calc (a + b) + a = 2 * a + b : by ring,
end

/-
Maybe this is cheating. Let's try to do the next computation without ring.
We could use:
pow_two x : x^2 = x*x
mul_sub a b c : a*(b-c) = a*b - a*c
add_mul a b c : (a+b)*c = a*c + b*c
add_sub a b c : a + (b - c) = (a + b) - c
sub_sub a b c : a - b - c = a - (b + c)
add_zero a : a + 0 = a
-/

-- 0008
example (a b : ℝ) : (a + b)*(a - b) = a^2 - b^2 :=
begin
  calc (a + b) * (a - b) = (a + b) * a - (a + b) * b  : by rw mul_sub
  ... = a * a + b * a - (a + b) * b                   : by rw add_mul
  ... = a * a + b * a - (a * b + b * b)               : by rw add_mul
  ... = a * a + b * a - a * b - b * b                 : by rw sub_sub
  ... = a * a + (b * a - a * b) - b * b               : by rw <- add_sub
  ... = a * a + (a * b - a * b) - b * b               : by rw mul_comm a b
  ... = a * a + 0 - b * b                             : by rw sub_self
  ... = a * a - b * b                                 : by rw add_zero
  ... = a^2 - b * b                                   : by rw <- pow_two a
  ... = a^2 - b^2                                     : by rw <- pow_two b,
end

/- Let's stick to ring in the end. -/


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.hom.iterate
import algebra.regular.basic

/-!
# Regular elements

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

## Implementation details

Group powers and other definitions import a lot of the algebra hierarchy.
Lemmas about them are kept separate to be able to provide `is_regular` early in the
algebra hierarchy.

-/

variables {R : Type*} {a b : R}

section monoid

variable [monoid R]

/--  Any power of a left-regular element is left-regular. -/
lemma is_left_regular.pow (n : ℕ) (rla : is_left_regular a) : is_left_regular (a ^ n) :=
by simp only [is_left_regular, ← mul_left_iterate, rla.iterate n]

/--  Any power of a right-regular element is right-regular. -/
lemma is_right_regular.pow (n : ℕ) (rra : is_right_regular a) : is_right_regular (a ^ n) :=
by { rw [is_right_regular, ← mul_right_iterate], exact rra.iterate n }

/--  Any power of a regular element is regular. -/
lemma is_regular.pow (n : ℕ) (ra : is_regular a) : is_regular (a ^ n) :=
⟨is_left_regular.pow n ra.left, is_right_regular.pow n ra.right⟩

/--  An element `a` is left-regular if and only if a positive power of `a` is left-regular. -/
lemma is_left_regular.pow_iff {n : ℕ} (n0 : 0 < n) :
  is_left_regular (a ^ n) ↔ is_left_regular a :=
begin
  refine ⟨_, is_left_regular.pow n⟩,
  rw [← nat.succ_pred_eq_of_pos n0, pow_succ'],
  exact is_left_regular.of_mul,
end

/--  An element `a` is right-regular if and only if a positive power of `a` is right-regular. -/
lemma is_right_regular.pow_iff {n : ℕ} (n0 : 0 < n) :
  is_right_regular (a ^ n) ↔ is_right_regular a :=
begin
  refine ⟨_, is_right_regular.pow n⟩,
  rw [← nat.succ_pred_eq_of_pos n0, pow_succ],
  exact is_right_regular.of_mul,
end

/--  An element `a` is regular if and only if a positive power of `a` is regular. -/
lemma is_regular.pow_iff {n : ℕ} (n0 : 0 < n) :
  is_regular (a ^ n) ↔ is_regular a :=
⟨λ h, ⟨(is_left_regular.pow_iff n0).mp h.left, (is_right_regular.pow_iff n0).mp h.right⟩,
  λ h, ⟨is_left_regular.pow n h.left, is_right_regular.pow n h.right⟩⟩

end monoid


-- Lista 8

-- Lucas Machado Moschen

open nat

--1.a.
example : ∀ m n k : nat, m * (n + k) = m * n + m * k :=
assume m n k,
nat.rec_on k
    (show m*(n + 0) = m*n + m*0, from calc
    m*(n + 0) = m*n : by rw add_zero
          ... = m*n + 0 : by rw add_zero
          ... = m*n + m*0 : by rw mul_zero
    )
    (assume k,
    assume ih: m*(n + k) = m*n + m*k,
    show m*(n + succ k) = m*n + m*(succ k), from calc
    m*(n + succ k) = m*(succ(n + k)) : by rw add_succ
               ... = m*(n + k) + m : by rw mul_succ
               ... = m*n + m*k + m : by rw ih
               ... = m*n + (m*k + m) : by rw add_assoc
               ... = m*n + m*(succ k) : by rw mul_succ
    )

--1.b.
theorem mul_zero_left : ∀ n : nat, 0 * n = 0 :=
assume n,
nat.rec_on n
    (show 0*0 = 0, by rw mul_zero)
    (assume n,
    assume ih: 0*n = 0,
    show 0*(succ n) = 0, from calc
    0*(succ n) = 0*n + 0 : by rw mul_succ
         ...   = 0 + 0 : by rw ih
         ...   = 0 : by rw add_zero
    )

--1.c.
theorem mul_one_left : ∀ n : nat, 1 * n = n :=
assume n,
nat.rec_on n
    (show 1*0 = 0, from mul_zero 1)
    (assume n,
    assume ih: 1*n = n,
    show 1*(succ n) = succ n, from calc
    1*(succ n) = 1*n + 1 : by rw mul_succ
           ... = n + 1 : by rw ih
           ... = succ n : by simp
    )

--1.d.
example : ∀ m n k : nat, (m * n) * k = m * (n * k) :=
assume m n k,
nat.rec_on k
    (show (m*n)*0 = m*(n*0), by rw
    [mul_zero,mul_zero,mul_zero])
    (assume k,
    assume ih : (m * n) * k = m * (n * k),
    show (m * n) * (succ k) = m * (n * (succ k)), from calc
    (m * n) * (succ k) = (m*n)*k + (m*n) : by rw mul_succ
                   ... = m * (n * k) + m * n : by rw ih
                   ... = m * (n*k + n) : by rw left_distrib
                   ... = m * (n*(succ k)) : by rw mul_succ
                   ... = m * (n * succ k) : by simp
    )

--1.e.
example : ∀ m n : nat, m * n= n * m :=
assume m n,
nat.rec_on n
    (show m*0 = 0*m, by rw [mul_zero,mul_zero_left])
    (assume n,
    assume ih : m*n = n*m,
    show m*(succ n) = (succ n)*m, from calc
    m*(succ n) = m*n + m : by rw mul_succ
           ... = n*m + m : by rw ih
           ... = n*m + 1*m : by rw mul_one_left
           ... = (n + 1)*m : by rw right_distrib
           ... = (succ n)*m : by simp
    )

--2.a.
theorem summing_k: ∀ m n k : nat, n ≤ m → n + k ≤ m + k :=
begin
    assume m n k,
    intro h1,
    apply nat.rec_on k,
    exact h1,
    intro k,
    intro h2,
    have h3: m+k < succ(m + k), from lt_succ_self (m + k),
    apply lt_of_le_of_lt h2 h3
end

--2.b.
example : ∀ m n k : nat, n + k ≤ m + k → n ≤ m :=
begin
    assume m n k,
    apply nat.rec_on k,
    intro h, exact h,
    assume k',
    intros ih h,
    repeat {rw add_succ at h},
    have h1: n + k' ≤ m + k', from le_of_succ_le_succ h,
    apply ih h1,
end

--2.c.
example : ∀ m n k : nat, n ≤ m → n * k ≤ m * k :=
begin
    assume m n k,
    intro h,
    apply nat.rec_on k,
        apply less_than_or_equal.refl,
    assume k',
    intro ih,
        repeat {rw mul_succ},
        have h1: n*k' + n ≤ m*k' + n, from summing_k _ _ _ ih,
        have h2: m*k' + n ≤ m*k' + m, from add_le_add_left h (m*k'),
        apply le_trans h1 h2,
end

--2.d.
example : ∀ m n : nat, m ≥ n → m = n ∨ m ≥ n+1 :=
assume m n,
begin
    assume h,
    cases lt_or_eq_of_le h with h1 h2,
    have h3: succ n ≤ m, from h1,
    apply or.inr h3,
    apply or.inl (eq.symm h2)
end

--2.e.

example : ∀ n : nat, 0 ≤ n :=
begin
    assume n,
    apply nat.rec_on n,
        apply less_than_or_equal.refl 0,
        assume n h,
        have h1: n < succ n, from lt_succ_self n,
        apply le_of_lt (lt_of_le_of_lt h h1),
end


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import analysis.normed_space.conformal_linear_map
import analysis.inner_product_space.basic

/-!
# Conformal maps between inner product spaces

In an inner product space, a map is conformal iff it preserves inner products up to a scalar factor.
-/

variables {E F : Type*} [inner_product_space ℝ E] [inner_product_space ℝ F]

open linear_isometry continuous_linear_map
open_locale real_inner_product_space

lemma is_conformal_map_iff (f' : E →L[ℝ] F) :
  is_conformal_map f' ↔ ∃ (c : ℝ), 0 < c ∧
  ∀ (u v : E), ⟪f' u, f' v⟫ = (c : ℝ) * ⟪u, v⟫ :=
begin
  split,
  { rintros ⟨c₁, hc₁, li, h⟩,
    refine ⟨c₁ * c₁, mul_self_pos hc₁, λ u v, _⟩,
    simp only [h, pi.smul_apply, inner_map_map,
               real_inner_smul_left, real_inner_smul_right, mul_assoc], },
  { rintros ⟨c₁, hc₁, huv⟩,
    let c := real.sqrt c₁⁻¹,
    have hc : c ≠ 0 := λ w, by {simp only [c] at w;
      exact (real.sqrt_ne_zero'.mpr $ inv_pos.mpr hc₁) w},
    let f₁ := c • f',
    have minor : (f₁ : E → F) = c • f' := rfl,
    have minor' : (f' : E → F) = c⁻¹ • f₁ := by ext;
      simp_rw [minor, pi.smul_apply]; rw [smul_smul, inv_mul_cancel hc, one_smul],
    refine ⟨c⁻¹, inv_ne_zero hc, f₁.to_linear_map.isometry_of_inner (λ u v, _), minor'⟩,
    simp_rw [to_linear_map_eq_coe, continuous_linear_map.coe_coe, minor, pi.smul_apply],
    rw [real_inner_smul_left, real_inner_smul_right,
        huv u v, ← mul_assoc, ← mul_assoc,
        real.mul_self_sqrt $ le_of_lt $ inv_pos.mpr hc₁,
        inv_mul_cancel $ ne_of_gt hc₁, one_mul], },
end