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

import algebra.geom_sum
import data.rat.basic
import data.real.basic

/-!
# IMO 2013 Q5

Let `ℚ>₀` be the positive rational numbers. Let `f : ℚ>₀ → ℝ` be a function satisfying
the conditions

1. `f(x) * f(y) ≥ f(x * y)`
2. `f(x + y) ≥ f(x) + f(y)`

for all `x, y ∈ ℚ>₀`. Given that `f(a) = a` for some rational `a > 1`, prove that `f(x) = x` for
all `x ∈ ℚ>₀`.

# Solution

We provide a direct translation of the solution found in
https://www.imo-official.org/problems/IMO2013SL.pdf
-/

open_locale big_operators

lemma le_of_all_pow_lt_succ {x y : ℝ} (hx : 1 < x) (hy : 1 < y)
  (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) :
  x ≤ y :=
begin
  by_contra' hxy,
  have hxmy : 0 < x - y := sub_pos.mpr hxy,
  have hn : ∀ n : ℕ, 0 < n → (x - y) * (n : ℝ) ≤ x^n - y^n,
  { intros n hn,
    have hterm : ∀ i : ℕ, i ∈ finset.range n → 1 ≤ x^i * y^(n - 1 - i),
    { intros i hi,
      have hx' : 1 ≤ x ^ i := one_le_pow_of_one_le hx.le i,
      have hy' : 1 ≤ y ^ (n - 1 - i) := one_le_pow_of_one_le hy.le (n - 1 - i),
      calc 1 ≤ x^i             : hx'
         ... = x^i * 1         : (mul_one _).symm
         ... ≤ x^i * y^(n-1-i) : mul_le_mul_of_nonneg_left hy' (zero_le_one.trans hx') },

    calc (x - y) * (n : ℝ)
            = (n : ℝ) * (x - y) : mul_comm _ _
        ... = (∑ (i : ℕ) in finset.range n, (1 : ℝ)) * (x - y) :
                                  by simp only [mul_one, finset.sum_const, nsmul_eq_mul,
                                    finset.card_range]
        ... ≤ (∑ (i : ℕ) in finset.range n, x ^ i * y ^ (n - 1 - i)) * (x-y) :
                                  (mul_le_mul_right hxmy).mpr (finset.sum_le_sum hterm)
        ... = x^n - y^n         : geom_sum₂_mul x y n, },

  -- Choose n larger than 1 / (x - y).
  obtain ⟨N, hN⟩ := exists_nat_gt (1 / (x - y)),
  have hNp : 0 < N, { exact_mod_cast (one_div_pos.mpr hxmy).trans hN },

  have := calc 1 = (x - y) * (1 / (x - y)) : by field_simp [ne_of_gt hxmy]
             ... < (x - y) * N             : (mul_lt_mul_left hxmy).mpr hN
             ... ≤ x^N - y^N               : hn N hNp,
  linarith [h N hNp]
end

/--
 Like le_of_all_pow_lt_succ, but with a weaker assumption for y.
-/
lemma le_of_all_pow_lt_succ' {x y : ℝ} (hx : 1 < x) (hy : 0 < y)
  (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) :
  x ≤ y :=
begin
  refine le_of_all_pow_lt_succ hx _ h,
  by_contra' hy'' : y ≤ 1,

  -- Then there exists y' such that 0 < y ≤ 1 < y' < x.
  let y' := (x + 1) / 2,
  have h_y'_lt_x : y' < x,
  { have hh : (x + 1)/2 < (x * 2) / 2, { linarith },
    calc y' < (x * 2) / 2 : hh
        ... = x           : by field_simp },
  have h1_lt_y' : 1 < y',
  { have hh' : 1 * 2 / 2 < (x + 1) / 2, { linarith },
    calc 1 = 1 * 2 / 2 : by field_simp
       ... < y'        : hh' },
  have h_y_lt_y' : y < y' := hy''.trans_lt h1_lt_y',
  have hh : ∀ n, 0 < n → x^n - 1 < y'^n,
  { intros n hn,
    calc x^n - 1 < y^n  : h n hn
            ...  ≤ y'^n : pow_le_pow_of_le_left hy.le h_y_lt_y'.le n },
  exact h_y'_lt_x.not_le (le_of_all_pow_lt_succ hx h1_lt_y' hh)
end

lemma f_pos_of_pos {f : ℚ → ℝ} {q : ℚ} (hq : 0 < q)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  0 < f q :=
begin
  have num_pos : 0 < q.num := rat.num_pos_iff_pos.mpr hq,
  have hmul_pos :=
    calc (0 : ℝ) < q.num   : int.cast_pos.mpr num_pos
      ... = ((q.num.nat_abs : ℤ) : ℝ) : congr_arg coe (int.nat_abs_of_nonneg num_pos.le).symm
      ... ≤ f q.num.nat_abs           : H4 q.num.nat_abs
                                          (int.nat_abs_pos_of_ne_zero num_pos.ne')
      ... = f q.num : by { rw ←int.nat_abs_of_nonneg num_pos.le, norm_cast }
      ... = f (q * q.denom) : by rw ←rat.mul_denom_eq_num
      ... ≤ f q * f q.denom : H1 q q.denom hq (nat.cast_pos.mpr q.pos),
  have h_f_denom_pos :=
    calc (0 : ℝ) < q.denom : nat.cast_pos.mpr q.pos
      ... ≤ f q.denom : H4 q.denom q.pos,
  exact pos_of_mul_pos_right hmul_pos h_f_denom_pos.le,
end

lemma fx_gt_xm1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 ≤ x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  (x - 1 : ℝ) < f x :=
begin
  have hx0 :=
    calc (x - 1 : ℝ)
          < ⌊x⌋₊   : by exact_mod_cast nat.sub_one_lt_floor x
      ... ≤ f ⌊x⌋₊ : H4 _ (nat.floor_pos.2 hx),

  obtain h_eq | h_lt := (nat.floor_le $ zero_le_one.trans hx).eq_or_lt,
  { rwa h_eq at hx0 },

  calc (x - 1 : ℝ) < f ⌊x⌋₊ : hx0
    ... < f (x - ⌊x⌋₊) + f ⌊x⌋₊ : lt_add_of_pos_left _ (f_pos_of_pos (sub_pos.mpr h_lt) H1 H4)
    ... ≤ f (x - ⌊x⌋₊ + ⌊x⌋₊)   : H2 _ _ (sub_pos.mpr h_lt) (nat.cast_pos.2 (nat.floor_pos.2 hx))
    ... = f x                   : by rw sub_add_cancel
end

lemma pow_f_le_f_pow {f : ℚ → ℝ} {n : ℕ} (hn : 0 < n) {x : ℚ} (hx : 1 < x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  f (x^n) ≤ (f x)^n :=
begin
  induction n with pn hpn,
  { exfalso, exact nat.lt_asymm hn hn },
  cases pn,
  { simp only [pow_one] },
  have hpn' := hpn pn.succ_pos,
  rw [pow_succ' x (pn + 1), pow_succ' (f x) (pn + 1)],
  have hxp : 0 < x := zero_lt_one.trans hx,
  calc f ((x ^ (pn+1)) * x)
          ≤ f (x ^ (pn+1)) * f x : H1 (x ^ (pn+1)) x (pow_pos hxp (pn+1)) hxp
      ... ≤ (f x) ^ (pn+1) * f x : (mul_le_mul_right (f_pos_of_pos hxp H1 H4)).mpr hpn'
end

lemma fixed_point_of_pos_nat_pow {f : ℚ → ℝ} {n : ℕ} (hn : 0 < n)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n)
  (H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x)
  {a : ℚ} (ha1 : 1 < a) (hae : f a = a) :
  f (a^n) = a^n :=
begin
  have hh0 : (a : ℝ) ^ n ≤ f (a ^ n),
  { exact_mod_cast H5 (a ^ n) (one_lt_pow ha1 hn.ne') },

  have hh1 := calc f (a^n) ≤ (f a)^n   : pow_f_le_f_pow hn ha1 H1 H4
                       ... = (a : ℝ)^n : by rw ← hae,

  exact hh1.antisymm hh0
end

lemma fixed_point_of_gt_1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 < x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n)
  (H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x)
  {a : ℚ} (ha1 : 1 < a) (hae : f a = a) :
  f x = x :=
begin
  -- Choose n such that 1 + x < a^n.
  obtain ⟨N, hN⟩ := pow_unbounded_of_one_lt (1 + x) ha1,
  have h_big_enough : (1:ℚ) < a^N - x := lt_sub_iff_add_lt.mpr hN,

  have h1 := calc (x : ℝ) + ((a^N - x) : ℚ)
                        ≤ f x + ((a^N - x) : ℚ) : add_le_add_right (H5 x hx) _
                    ... ≤ f x + f (a^N - x)     : add_le_add_left (H5 _ h_big_enough) _,

  have hxp : 0 < x := zero_lt_one.trans hx,

  have hNp : 0 < N,
  { by_contra' H, rw [nat.le_zero_iff.mp H] at hN, linarith },

  have h2 := calc f x + f (a^N - x)
                        ≤ f (x + (a^N - x)) : H2 x (a^N - x) hxp (zero_lt_one.trans h_big_enough)
                    ... = f (a^N)           : by ring_nf
                    ... = a^N               : fixed_point_of_pos_nat_pow hNp H1 H4 H5 ha1 hae
                    ... = x + (a^N - x)     : by ring,

  have heq := h1.antisymm (by exact_mod_cast h2),
  linarith [H5 x hx, H5 _ h_big_enough]
end

theorem imo2013_q5
  (f : ℚ → ℝ)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H_fixed_point : ∃ a, 1 < a ∧ f a = a) :
  ∀ x, 0 < x → f x = x :=
begin
  obtain ⟨a, ha1, hae⟩ := H_fixed_point,
  have H3 : ∀ x : ℚ, 0 < x → ∀ n : ℕ, 0 < n → ↑n * f x ≤ f (n * x),
  { intros x hx n hn,
    cases n,
    { exact (lt_irrefl 0 hn).elim },
    induction n with pn hpn,
    { simp only [one_mul, nat.cast_one] },
    calc (↑pn + 1 + 1) * f x
          = ((pn : ℝ) + 1) * f x + 1 * f x : add_mul (↑pn + 1) 1 (f x)
      ... = (↑pn + 1) * f x + f x          : by rw one_mul
      ... ≤ f ((↑pn.succ) * x) + f x       : by exact_mod_cast add_le_add_right
                                                  (hpn pn.succ_pos) (f x)
      ... ≤ f ((↑pn + 1) * x + x)          : by exact_mod_cast H2 _ _
                                                  (mul_pos pn.cast_add_one_pos hx) hx
      ... = f ((↑pn + 1) * x + 1 * x)      : by rw one_mul
      ... = f ((↑pn + 1 + 1) * x)          : congr_arg f (add_mul (↑pn + 1) 1 x).symm },
  have H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n,
  { intros n hn,
    have hf1 : 1 ≤ f 1,
    { have a_pos : (0 : ℝ) < a := rat.cast_pos.mpr (zero_lt_one.trans ha1),
      suffices : ↑a * 1 ≤ ↑a * f 1, from (mul_le_mul_left a_pos).mp this,
      calc ↑a * 1 = ↑a        : mul_one ↑a
              ... = f a       : hae.symm
              ... = f (a * 1) : by rw mul_one
              ... ≤ f a * f 1 : (H1 a 1) (zero_lt_one.trans ha1) zero_lt_one
              ... = ↑a * f 1  : by rw hae },

    calc (n : ℝ) = (n : ℝ) * 1   : (mul_one _).symm
             ... ≤ (n : ℝ) * f 1 : mul_le_mul_of_nonneg_left hf1 (nat.cast_nonneg _)
             ... ≤ f (n * 1)     : H3 1 zero_lt_one n hn
             ... = f n           : by rw mul_one },

  have H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x,
  { intros x hx,
    have hxnm1 : ∀ n : ℕ, 0 < n → (x : ℝ)^n - 1 < (f x)^n,
    { intros n hn,
      calc (x : ℝ)^n - 1 < f (x^n) : by exact_mod_cast fx_gt_xm1 (one_le_pow_of_one_le hx.le n)
                                          H1 H2 H4
                     ... ≤ (f x)^n : pow_f_le_f_pow hn hx H1 H4 },
    have hx' : 1 < (x : ℝ) := by exact_mod_cast hx,
    have hxp : 0 < x := zero_lt_one.trans hx,
    exact le_of_all_pow_lt_succ' hx' (f_pos_of_pos hxp H1 H4) hxnm1 },

  have h_f_commutes_with_pos_nat_mul : ∀ n : ℕ, 0 < n → ∀ x : ℚ, 0 < x → f (n * x) = n * f x,
  { intros n hn x hx,
    have h2 : f (n * x) ≤ n * f x,
    { cases n,
      { exfalso, exact nat.lt_asymm hn hn },
      cases n,
      { simp only [one_mul, nat.cast_one] },
      have hfneq : f (n.succ.succ) = n.succ.succ,
      { have := fixed_point_of_gt_1
                  (nat.one_lt_cast.mpr (nat.succ_lt_succ n.succ_pos)) H1 H2 H4 H5 ha1 hae,
        rwa (rat.cast_coe_nat n.succ.succ) at this },
      rw ← hfneq,
      exact H1 (n.succ.succ : ℚ) x (nat.cast_pos.mpr hn) hx },
    exact h2.antisymm (H3 x hx n hn) },

  -- For the final calculation, we expand x as (2*x.num) / (2*x.denom), because
  -- we need the top of the fraction to be strictly greater than 1 in order
  -- to apply fixed_point_of_gt_1.
  intros x hx,
  let x2denom := 2 * x.denom,
  let x2num := 2 * x.num,

  have hx2pos := calc 0 < x.denom           : x.pos
                    ... < x.denom + x.denom : lt_add_of_pos_left x.denom x.pos
                    ... = 2 * x.denom       : by ring,

  have hxcnez   : (x.denom : ℚ) ≠ (0 : ℚ) := ne_of_gt (nat.cast_pos.mpr x.pos),
  have hx2cnezr : (x2denom : ℝ) ≠ (0 : ℝ) := nat.cast_ne_zero.mpr (ne_of_gt hx2pos),

  have hrat_expand2 := calc x = x.num / x.denom : by exact_mod_cast rat.num_denom.symm
                          ... = x2num / x2denom : by { field_simp [-rat.num_div_denom], linarith },

  have h_denom_times_fx :=
    calc (x2denom : ℝ) * f x = f (x2denom * x)                 : (h_f_commutes_with_pos_nat_mul
                                                                    x2denom hx2pos x hx).symm
                         ... = f (x2denom * (x2num / x2denom)) : by rw hrat_expand2
                         ... = f x2num                         : by { congr, field_simp, ring },

  have h_fx2num_fixed : f x2num = x2num,
  { have hx2num_gt_one : (1 : ℚ) < (2 * x.num : ℤ),
    { norm_cast, linarith [rat.num_pos_iff_pos.mpr hx] },
    have hh := fixed_point_of_gt_1 hx2num_gt_one H1 H2 H4 H5 ha1 hae,
    rwa (rat.cast_coe_int x2num) at hh },

  calc f x = f x * 1                                 : (mul_one (f x)).symm
       ... = f x * (x2denom / x2denom)               : by rw ←(div_self hx2cnezr)
       ... = (f x * x2denom) / x2denom               : mul_div_assoc' (f x) _ _
       ... = (x2denom * f x) / x2denom               : by rw mul_comm
       ... = f x2num / x2denom                       : by rw h_denom_times_fx
       ... = x2num / x2denom                         : by rw h_fx2num_fixed
       ... = (((x2num : ℚ) / (x2denom : ℚ) : ℚ) : ℝ) : by norm_cast
       ... = x                                       : by rw ←hrat_expand2
end


namespace xena

inductive xnat
| zero : xnat
| succ : xnat → xnat

open xnat

definition add : xnat → xnat → xnat
| n zero := n
| n (succ p) := succ (add n p)

notation a + b := add a b
definition one := succ zero
definition two := succ one
definition three := succ two
definition four := succ three

example : one + one = two :=
begin
refl
end

example : two + two = four :=
begin
dunfold two,
dunfold add,
refl,
end

theorem add_assoc (a b c : xnat) : (a + b) + c = a + (b + c) :=

begin
induction c with n Hn,
  unfold add,
unfold add,
rw [Hn],
end

theorem add_zero (n : xnat) : n + zero = n := by unfold add

theorem zero_add (n : xnat) : zero + n = n :=
begin
induction n with t Ht,
  refl,
unfold add,
rw [Ht],
end

theorem zero_add_eq_add_zero (n : xnat) : zero + n = n + zero :=
begin
rewrite [zero_add,add_zero]
end

theorem one_add_eq_succ (n : xnat) : (succ zero) + n = succ n :=
begin
induction n with a Ha,
  refl,
  unfold add,
  rw [Ha],
end

theorem add_one_eq_succ (n : xnat) : n + (succ zero) = succ n :=
begin
unfold add
end

theorem add_comm (a b : xnat) : a + b = b + a :=
begin
induction a with m Hm,
  exact zero_add_eq_add_zero b,
unfold add,
rewrite ←one_add_eq_succ,
rewrite ←one_add_eq_succ (b+m),
rewrite add_assoc,
rewrite Hm
end

theorem eq_iff_succ_eq_succ (a b : xnat) : succ a = succ b ↔ a = b :=
begin
split,
  exact succ.inj,
assume H : a = b,
rw [H]
end

theorem add_cancel_right (a b t : xnat) :  a = b ↔ a+t = b+t :=
begin
split,
  assume H : a=b,
  induction t with n Hn,
    unfold add,
    exact H,
  unfold add,
  rw [Hn],

induction t with n Hn,
  unfold add,
  assume H : a=b,
  exact H,
unfold add,
rwa [eq_iff_succ_eq_succ],
end

definition mul : xnat → xnat → xnat
| n zero := zero
| n (succ p) := (mul n p) + n

notation a * b := mul a b

theorem mul_zero (a : xnat) : a * zero = zero := rfl

theorem zero_mul (a : xnat) : zero * a = zero :=
begin
induction a with n Hn,
  refl,
unfold mul,
rw Hn,
refl
end

theorem mul_one (a : xnat) : a * (succ zero) = a :=
begin
unfold mul,
exact zero_add a,
end

theorem one_mul (a : xnat) : (succ zero) * a = a :=
begin
induction a with n Hn,
  refl,
unfold mul,
rewrite Hn,
exact add_one_eq_succ n
end

theorem right_distrib (a b c : xnat) : a * (b + c) = a* b + a * c :=
begin
induction c with n Hn,
  unfold add,
  unfold mul,
  unfold add,
unfold add,
unfold mul,
rewrite Hn,
rewrite add_assoc
end

theorem left_distrib (a b c : xnat) : (a + b) * c = a * c + b * c :=
begin
induction c with n Hn,
  unfold mul,
  refl,
rw [←add_one_eq_succ,right_distrib,Hn,right_distrib,right_distrib],
rw [mul_one,mul_one,mul_one],
rw [add_assoc,←add_assoc (b*n),add_comm (b*n),←add_assoc,←add_assoc,←add_assoc],
end

theorem mul_assoc (a b c : xnat) : (a * b) * c = a * (b * c) :=
begin
induction c with n Hn,
  unfold mul,
unfold mul,
rewrite right_distrib,
rewrite Hn,
end

theorem mul_comm (a b : xnat) : a * b = b * a :=
begin
induction b with n Hn,
  rewrite zero_mul,
  exact mul_zero a,
unfold mul,
rewrite Hn,
rewrite ←add_one_eq_succ,
rewrite left_distrib,
rewrite one_mul,
end

definition less_than : xnat → xnat → Prop
| n zero := false
| zero (succ p) := true
| (succ m) (succ p) := less_than m p

notation a < b := less_than a b

notation b > a := less_than a b

theorem add_succ_equals_succ (a b : xnat) : a + (succ b) = succ (a + b) :=
begin
  rw [←add_one_eq_succ,←add_one_eq_succ (a+b)],
  rw add_assoc,
end

theorem inequality_A1 (a b t : xnat) : a < b → a + t < b + t :=
begin
assume H : a < b,
induction t with n Hn,
  unfold add,
  exact H,
repeat {rw [add_succ_equals_succ]},
unfold less_than,
exact Hn
end

-- set_option pp.notation false

theorem not_less_than_zero (a : xnat) : ¬ (a < zero) :=
begin
assume H : a < zero,
  cases a,
  exact H,
exact H,
end

-- set_option pp.notation false

definition less_than_or_equal (a b : xnat) := a=b ∨ a<b

notation a ≤ b := less_than_or_equal a b
notation b ≤ a := a ≤ b

theorem zero_leq (a : xnat) : zero ≤ a :=
begin
cases a,
  unfold less_than_or_equal,
  left,
  refl,
unfold less_than_or_equal,
right,
unfold less_than,
end

theorem zero_lt_succ (a : xnat) : zero < succ a := trivial

theorem not_succ_le_zero (a : xnat) : ¬ (succ a ≤ zero) :=
begin
assume H : succ a ≤ zero,
cases H with H1 H2,
  exact xnat.no_confusion H1,
  exact H2,
end

theorem lt_succ (a : xnat) : a < succ a :=
begin
induction a with n Hn,
  unfold less_than,
unfold less_than,
exact Hn,
end

theorem succ_lt_succ_of_lt (a b : xnat) : a < b → succ a < succ b :=
begin
assume H : a < b,
unfold less_than,
exact H,
end

theorem le_of_succ_le_succ (a b : xnat) : succ a ≤ succ b → a ≤ b :=
begin
assume H : succ a ≤ succ b,
cases H with H1 H2,
  left,
  rwa [←eq_iff_succ_eq_succ],
right,
unfold less_than at H2,
assumption,
end

theorem lt_or_eq_or_gt' (a : xnat) : ∀ b, a < b ∨ a = b ∨ b < a :=
begin
induction a with n Hn,
  intro b,
  cases b,
    right,left,
    trivial,
  left,
  trivial,
intro b,
cases b with m,
  cases n,
    right,right,
    trivial,
  right,right,
  trivial,
unfold less_than,
rw [eq_iff_succ_eq_succ],
exact Hn m,
end

theorem lt_or_eq_or_gt (a b : xnat) : a < b ∨ a = b ∨ b < a :=
begin
exact lt_or_eq_or_gt' a b,
end

theorem lt_irrefl (a : xnat) : ¬ (a < a) :=
begin
  induction a with n Hn,
  unfold less_than,
  trivial,
unfold less_than,
assumption,
end

theorem ne_of_lt (a b : xnat) : a < b → ¬ (a=b) :=
begin
assume Hlt : a < b,
assume Heq : a = b,
rw Heq at Hlt,
exact lt_irrefl b Hlt,
end

theorem lt_antisymm' (b : xnat) : ∀ a, a < b → ¬ (b < a) :=
begin
induction b with n Hn,
  intro a,
  assume H : a < zero,
  exfalso,
  exact not_less_than_zero a H,
intro a,
cases a with m Hm,
  intro,
  exact not_less_than_zero (succ n),
unfold less_than,
exact Hn m,
end

theorem lt_antisymm (a b : xnat) : a < b → ¬  (b < a) :=
begin
exact lt_antisymm' b a
end

theorem inequality_A2' (a : xnat) : ∀ b c, a < b → b < c → a < c :=
begin
induction a with n Hn,
  intros b c,
  assume H1 : zero < b,
  assume H2 : b < c,
  induction c with m Hm,
    exfalso,
    exact not_less_than_zero b H2,
  unfold less_than,
intros b c,
cases b with m,
  unfold less_than,
  intro H,
  exfalso,
  exact H,
cases c,
  intro H1,
  unfold less_than,
  intro,assumption,
unfold less_than,
exact Hn m c,
end

theorem inequality_A2 (a b c : xnat) : a<b → b<c → a<c :=
begin
exact inequality_A2' a b c,
end

theorem inequality_A3 (a b : xnat) : (a<b ∨ a=b ∨ b < a)
                                   ∧ (a<b → ¬ (a=b))
                                   ∧ (a<b → ¬ (b<a))
                                   ∧ ((a=b)→ ¬ (b<a)) :=
begin
split,
  exact lt_or_eq_or_gt a b,
split,
  exact ne_of_lt a b,
split,
  exact lt_antisymm a b,
intro H1,
intro H2,
exact ne_of_lt b a H2 (eq.symm H1),
end

theorem inequality_A4 (a b : xnat) : a>zero → b>zero → a*b > zero :=
begin
assume Ha : a > zero,
assume Hb : b > zero,
cases a with n,
  exfalso,
  exact Ha,
cases b with m,
  exfalso,
  exact Hb,
dunfold mul,
dunfold add,
dunfold less_than,
trivial,
end

theorem lt_succ_of_lt (a b : xnat) : a < b → a < succ b :=
begin
admit,
end

theorem le_iff_add (a b : xnat) : a < b ↔ ∃ t : xnat, b = a + succ t :=
begin
split,
  assume H : a < b,
  induction b with n Hn,
    exfalso,
    exact not_less_than_zero a H,
  admit,admit
end

theorem lt_succ_iff_leq (a b : xnat) : a < succ b ↔ a ≤ b :=
begin
split,
  assume H : a < succ b,
  induction b with n Hn,
    cases a,
      left,
      refl,
    exfalso,
    unfold less_than at H,
    cases a,
      exact H,
    exact H,
  admit,
admit,
end

end xena


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

/-!

# Lists

An example of a list of naturals is [1,5,8,1]. More generally, given a
type `X`, a term of type `mylist X` is a finite list of terms of type `X`,
with repeats allowed.

## The definition of a list

The empty list is traditionally called `nil`, and the constructor which
takes a list and adds an element to the beginning is called `cons`,
so `cons 3 [1,5,4] = [3,1,5,4]`.

We don't set up the `[a,b,c]` notation in this file.

-/

/-- `mylist X` is the type of (finite) lists of elements of `X`. -/
inductive mylist (X : Type) : Type
| nil : mylist -- empty list
| cons (x : X) (l : mylist) : mylist -- "put `(x : X)` at the beginning of `(l : mylist X)`"

namespace mylist

variables (a b c : ℕ)

-- list [a,b,c] of naturals
example : mylist ℕ := cons a (cons b (cons c nil))

variable {X : Type} -- make X implicit

-- joining lists together: [1,5,4] + [2,1] = [1,5,4,2,1]. Defined
-- by induction on the left list.

/-- Addition of lists. Often called `append` in the literature. -/
def add : mylist X → mylist X → mylist X
| nil l := l
| (cons x m) l := cons x (add m l)

-- Enable `+` notation for addition of lists.
instance : has_add (mylist X) :=
{ add := add }

@[simp] lemma nil_add (a : mylist X) : nil + a = a :=
begin
  sorry
end

@[simp] lemma cons_add (x : X) (m l) : cons x m + l = cons x (m + l) :=
begin
  sorry
end

-- You might want to start this one with `induction a with h t IH`,
@[simp] lemma add_nil (a : mylist X) : a + nil = a :=
begin
  sorry
end

lemma add_assoc (a b c : mylist X) : (a + b) + c = a + (b + c) :=
begin
  sorry
end

-- singleton list
def singleton (x : X) : mylist X := cons x nil

@[simp] lemma singleton_def (x : X) : singleton x = cons x nil :=
begin
  sorry
end

/-- The reverse of a list. -/
def reverse : mylist X → mylist X
| nil := nil
| (cons x m) := (reverse m) + (singleton x)

-- surprisingly difficult question. Geometrically obvious, but so
-- is a + b = b + a for naturals, and this takes some preliminary work.
-- Don't just jump in! Prove things like `reverse_add` and even more basic things first
-- (and consider tagging them with `@[simp]` if you want to train Lean's
-- simplifier to do the work)

theorem reverse_reverse (l : mylist X) : reverse (reverse l) = l :=
begin
  sorry,
end

end mylist


import Mathlib.Data.Real.Basic

variable {A B C D E F: Type}
open Nat
/-
Everything in green or orange text is a `comment`.

This means that Lean ignores it.

A single line comment starts with --

A multi-line comment starts with /- and s with -/

Comments are our way of explaining what our code does.

# What is Lean?

Lean is at least three things:

1) A programming language in which we can write proofs (and more);

2) A kernel that can verify the correctness of proofs written in this language;

3) A set of tools that help us to write proofs (automation).

We will gradually introduce the Lean language and we will rely on its kernel to check
our code/proofs. The different tools for automation will also become apparent as we progress.

# Infoview

One of the most helpful tools that Lean has is the Infoview.

Open the `Infoview` panel by pressing `Ctrl + Shift + Enter`

You should now have a split-window with this Lean code file
on the left and the `Lean Infoview` on the right.

Before we start to introduce the Lean syntax and tactics,
lets first see what information this Lean Infoview provides.

As you move your cursor through the lines of text below, watch how
the Infoview updates. -/

-- 01
example  (x : A) : A :=
by
/-
If you place your cursor anywhere within this comment
the Infoview should display:
1 goal
A : Type
x : A
⊢ A
-/
exact x
/-
  # Type theory vs Set theory

Lean is based on type theory.

While mathematicians usually talk about `sets` and `elements`, in Lean
we have `types` and `terms`.

In our example above we told Lean that:

`x` is a term a of type A `(x : A)` we can think of this as saying `x ∈ A`

The final line of the Infoview is our goal: `⊢ A` which tells us the type of the
term that Lean is expecting us to produce.

This is the `return type` of the function and is determined by the `: A` after the hypotheses in our example.

The `:=` tells Lean we are going to define the body of this function.

The function body bys with `by` and s with ``. This tells Lean
we are entering `tactic-mode`.

(There are other `modes`, in particular `term-mode` but we will mainly focus on tactics.)

The only line of code inside the body is `exact x`. This is a tactic that says
`x` is `exactly` a term of the type required by the goal. (Because `x` is a term of type `A`.)

Our next tactic is `sorry`. This is a magic tactic that will accomplish any goal.

Unfortunately this is cheating (notice the example below has a yellow wavy-line under it to
warn us that something is wrong and `sorry` is in bright red).

Throughout this course you will encounter Lean code containing `sorry` that you will need to
edit, replacing the `sorry` with an actual proof of the required goal.

Can you replace the `sorry` with something that will actually accomplish the goal? -/

-- 02
example  (x : A) (y : B) (z : C) : B :=
by
/-
1 goal
A B C : Type
x : A
y : B
z : C
⊢ B
-/
exact y

/-
If A and B are types,  then `A → B` is the type of functions from A to B.

(Note that if you hover over any symbol Lean will tell you how to write it,
for example `→` is `\to`.)

If `f : A → B` and `a : A` then `f a` is Lean for `f(a)`.
This may look strange, but will actually make our proofs easier to read.
-/

-- 03
example  (f : A → B) (a : A) : B :=
by
/-
1 goal
A B : Type
f : A → B
a : A
⊢ B
-/
  exact f a -- Note that `exact f(a)` or `exact (f a)` or `exact (f(a))` will also work.

-- A different way to achieve the same goal is to use the `apply` tactic
-- 04
example (f : A → B) (a : A) : B :=
by
/-
1 goal
A B : Type
f : A → B
a : A
⊢ B
-/
apply f
/-
Notice that our goal has changed from `⊢ B` to `⊢ A`.

Think of this as saying if we have a function `f: A → B`
and our goal is `⊢ B` then we can `apply f` and this reduces our goal to supplying
an input to the function `f`, namely a term of type A.
-/
exact a  -- since our goal is now `⊢ A` we can close it with `a` since this is a term of type `A`.

-- 05
example  (f : A  → B) (g : B → C) (a : A) : C :=
by
-- goal `⊢ C`
  apply g -- goal changes from `⊢ C` to `⊢ B`
  apply f -- goal changes from `⊢ B` to `⊢ A`
  exact a -- done!

/-
See how many different ways you can find to complete the next example
using `exact` and/or `apply` -/

-- 06
example  (f : A  → B) (g : B → C) (h : C → D) (a : A): D :=
by
  apply h;  apply g;  apply f; exact a

-- 07
example (f :A → B) (g: B → C) (h: D → E) (i : C → E) (x : A) : E:=
by
  sorry

-- 08 Can you work out what `f: A → B → C` means and complete this example?
example (f : A → B → C)  (x : A) (y : B): C:=
by
  sorry

/- Mathematicians and Computer Scientists have slightly different ideas of how to
   write functions of more than one variable.

Math: `f : A × B → C`    Comp Sci: `g : A → B → C`

Both of these can be defined in Lean, however the CS version (which is known as a
`curried` function) turns out to be extremely useful.

But what do we mean by `A → B → C` ? We need to know where the brackets should go.

We need to know whether  `A → B → C` is `A → (B → C)` or `(A → B) → C`

Lets see how we can use Lean's `#check`  command to work this out.  -/

--variable (f : A → (B → C))
--variable (g : (A → B) → C)
--#check f  -- f : A → B → C    Lean has removed our unnecessary brackets from f.
--#check g  -- g : (A → B) → C  The brackets in g are required!

-- 09  What is f?
example (f : A → B → C → D) (g : A → B) (x : A)(z : C): D :=
by
  apply f; exact x; apply g;exact x;exact z

/- So far all our examples have involved applying functions to obtain new terms,
 but what if our goal is to construct a function itself?

  In order to define functions we need a new tactic: `intro`    -/

-- 10
example : A → A :=
by
/-
1 goal
A : Type
⊢ A → A
-/
  intro x -- Now we have a `x : A`, a term x of type A and our goal is now `⊢ A`
/-
1 goal
A : Type
x : A
⊢ A
-/
  exact x

-- 11
example (b : B) : A → B :=
by
  sorry

-- 12 [Tip: Rather than `intro a, intro b` you can just use `intros a b`]
example (c : C) : A → B → C → A → B →  C → A :=
by
  sorry

-- 13
example (f : (A → B) → (C → D) → E) (b : B) (d : D) : E :=
by
  sorry

-- 14
example (f : (A → B → C) → D → (E → C) → B) (g : B → A → C) (h : (B → C) → D) (c : C): A → B:=
by
  sorry

-- 15 Can you find a two line proof of this? (Hint: first find a longer proof and then shorten it)
example : ((A → D) → ((B → E) → (C → F))) → (((A → D) → (B → E)) → ((A → D) → (C → F))) :=
by
  intro f g ad c; apply f ad (g ad) c;


-- En los naturales: mcd(a,b) = a syss a divide a b
-- ================================================

-- Sean a y b son números naturales. Entonces,
--    a ∣ b ↔ gcd a b = a

-- Lemas auxiliares:
-- + dvd_refl:      a ∣ a
-- + dvd_antisymm : a ∣ b → b ∣ a → a = b
-- + dvd_gcd_iff :  c ∣ gcd a b ↔ c ∣ a ∧ c ∣ b
-- + gcd_dvd :      gcd a b ∣ a ∧ gcd a b ∣ b

import data.nat.gcd

open nat

variables (a b : ℕ)

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

example : a ∣ b ↔ gcd a b = a :=
begin
  have h1 : gcd a b ∣ a ∧ gcd a b ∣ b,
  { exact gcd_dvd a b, },
  split,
  { intro h2,
    apply dvd_antisymm h1.left,
    rw dvd_gcd_iff,
    exact ⟨dvd_refl a, h2⟩, },
  { intro h3,
    rw ← h3,
    exact h1.right, },
end

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

example : a ∣ b ↔ gcd a b = a :=
gcd_eq_left_iff_dvd


import Mathlib

/-!
# Subtraction: example of intertwined proofs and definitions.

The difference of natural numbers is not a natural number. We see three ways of overcoming this problem, which illustrate various important concepts in Lean.

The first two are in an earlier module while the third is in this one.

Here we subtract natural numbers only when given a proof that the second is less than or equal to the first. Note that as any two terms whose type is the same proposition are equal by definition, the value will not depend on the specific proof.
-/

namespace Nat

/-- Subtract `m` and `n` in the presence of a proof that `n ≤ m`. -/
def minus (m n : ℕ)(hyp : n ≤ m) : ℕ :=
  match m, n, hyp with
  | m, 0, _ => m
  | 0, _ +1, pf => nomatch pf
  | m + 1, n + 1 , pf =>
    minus m n (le_of_succ_le_succ pf)

/-!
An example using `minus` (using `decide` for the proof).

```lean
#eval minus 5 3 (by decide) -- 2
```

-/

#eval minus 5 3 (by decide) -- 2

/-- Subtraction (when valid) and addition are inverses
-/
theorem minus_add_cancel
  (m n : ℕ)(hyp : n ≤ m) :
    minus m n hyp + n = m := by
  match m, n, hyp with
  | m, 0, _ => simp [minus]
  | 0, _ +1, pf => contradiction
  | m + 1, n + 1 , pf =>
    simp [minus]
    rw [← add_assoc]
    simp [minus_add_cancel]

#check Nat.sub_add_cancel -- Nat.sub_add_cancel {n m : ℕ} (h : m ≤ n) : n - m + m = n

/-!
Note that in `Lean 4` there is a result `Nat.sub_add_cancel` which is analogous to `minus_add_cancel` above. However the statement of the result requires that the subtraction is valid.

```lean
#check Nat.sub_add_cancel -- Nat.sub_add_cancel {n m : ℕ} (h : m ≤ n) : n - m + m = n
```
-/

end Nat


import data.set.basic
import data.list.basic
import tactic

open set list

-- Будем рассматривать языкы над алфавитом α
-- Язык это просто set (list α)
namespace languages

variables {α : Type} {L M : set (list α)}

-- Несколько удобных сокращений: ε = пустой список, 0 = ∅, 1 = {ε}, A + B = A ∪ B
def ε {α} : list α := []
instance : has_zero (set (list α)) := ⟨(∅ : set _)⟩
instance : has_one (set (list α)) := ⟨({[]} : set _)⟩
instance : has_add (set (list α)) := ⟨set.union⟩

-- Конкатенация языков состоит из таких слов `w`, что существуют слова `left ∈ L` и `right ∈ M`, что `w = left ++ right`)
def append (L M: set (list α)) :=
    { w : list α | ∃ (left ∈ L) (right ∈ M), w = left ++ right}

-- Будем обозначать умножение как `L * M`
instance : has_mul (set (list α)) := ⟨append⟩

-- И вспомогательные леммы
def zero_def : (0 : set (list α)) = ∅ := rfl
def one_def : (1 : set (list α)) = {[]} := rfl
@[simp] def mem_zero {w : list α} : w ∉ (0 : set (list α)) := by simp
@[simp] def mem_one {w : list α} : w ∈ (1 : set (list α)) ↔ w = [] := by refl
@[simp] def nil_mem_one : [] ∈ (1 : set (list α)) := by simp

-- Умелое использование `rcases` и `rintro` сильно вам поможет!
@[simp] lemma zero_mul (L : set (list α)) : 0 * L = 0 :=
begin
  sorry,
end

@[simp] lemma mul_zero (L : set (list α)) : L * 0 = 0 :=
begin
  sorry,
end

@[simp] lemma append_one (A : set (list α)) : A * 1 = A :=
begin
  apply subset.antisymm, {
    sorry,
  }, {
    sorry,
  },
end

@[simp] lemma one_append (A : set (list α)) : 1 * A = A :=
begin
  sorry,
end

lemma append_assoc (A B C : set (list α)):
    (A * B) * C = A * (B * C) :=
begin
  sorry,
end

lemma left_distrib (A B C : set (list α)) : A * (B + C) = A * B + A * C :=
begin
  sorry,
end

lemma right_distrib (A B C : set (list α)) : (A + B) * C = A * C + B * C :=
begin
  sorry,
end

-- Докажем, что множество языков с операциями + = ∪ и * = append образуют полукольцо:
-- A + B - коммутативный моноид: 0, ассоциативность, коммутативность
-- A * B - полугруппа: 1, ассоциативность
-- Дистрибутивность и умножение на 0
-- Свойства (+) можно достать из стандартной библиотеки про `set.union`, а свойства (*) пришлось доказать
instance : semiring (set (list α)) := {
  add := (+),
  add_assoc := set.union_assoc,
  zero := 0,
  zero_add := set.empty_union,
  add_zero := set.union_empty,
  add_comm := set.union_comm,
  mul := (*),
  mul_assoc := append_assoc,
  zero_mul := zero_mul,
  mul_zero := mul_zero,
  one := 1,
  one_mul := one_append,
  mul_one := append_one,
  left_distrib := left_distrib,
  right_distrib := right_distrib,
}

-- Теперь можно использовать L^n = L * L * ... * L (n раз)
-- Полезные леммы: `pow_zero`, `pow_succ`, `pow_add`, ...

lemma append_subset_of_subset {A B C D : set (list α)} : A ⊆ C → B ⊆ D → A * B ⊆ C * D :=
begin
  sorry,
end

lemma pow_subset_of_subset {A B : set (list α)} {n : ℕ} : A ⊆ B → A^n ⊆ B^n :=
begin
  sorry,
end

lemma contain_eps_subset_power {A : set (list α)} {n : ℕ} (h : 1 ⊆ A) : A ⊆ A^(n.succ) :=
begin
  sorry,
end

-- Замыкание Клини языка L равно объединению L^n по всем натуральным n
def star (L : set (list α)) := {w : list α | ∃ (n : ℕ), w ∈ L^n}

@[simp] lemma mem_star {w : list α} : w ∈ star L ↔ ∃ (n : ℕ), w ∈ L^n := by refl

lemma star_eq_Union : star L = ⋃ (n : ℕ), L^n :=
begin
  ext w, simp only [mem_Union, mem_star],
end

@[simp] lemma nil_mem_star : [] ∈ star L :=
begin
  sorry,
end

@[simp] lemma one_subset_star : 1 ⊆ star L :=
begin
  simp,
end

@[simp] lemma pow_subset_star (n : ℕ) : L^n ⊆ star L :=
begin
  sorry,
end

@[simp] lemma subset_star : L ⊆ star L :=
begin
  sorry,
end

lemma star_subset_star : L ⊆ M → star L ⊆ star M :=
begin
  sorry,
end

lemma append_subset_star {A B L : set (list α)} :
    A ⊆ star L → B ⊆ star L → (A * B) ⊆ star L :=
begin
  sorry,
end

lemma star_append_star_eq_star : star L * star L = star L :=
begin
  sorry,
end

lemma pow_star_eq_star (n : ℕ) : (star L)^n.succ = star L :=
begin
  sorry,
end

-- Это было в ДЗ по дискретке!
theorem star_star_eq_star : star (star L) = star L :=
begin
  sorry,
end

-- L^n равен множеству слов, которые можно получить, как конкатенацию `n` слов из `L`.
-- Как записать, что `w` представляется как конкатенация `n` слов из `L`?
-- `∃ (l : list (list α)) (h : ∀ x ∈ l, x ∈ L), w = list.join l ∧ l.length = n`
-- Буквально: существует список слов `l`, что все слова в `l` принадлежат `L`, `w` равен `list.join l`, и длина `l` равна `n`
-- Начались сложные задания! Изучите подробнее API `list`, `list.has_mem`, `list.join` и прочие полезные вещи, или увереннее используйте `simp` :)
#check list.mem
#check mem_cons_self
#check list.join
#check join_eq_nil

lemma pow_eq_list_join {n : ℕ} :
    L^n = {w | ∃ (l : list (list α)) (h : ∀ x ∈ l, x ∈ L), w = list.join l ∧ l.length = n} :=
begin
  sorry,
end

lemma mem_pow_iff_list_join {w : list α} {n : ℕ}
  : w ∈ L^n ↔ ∃ l (h : ∀ x ∈ l, x ∈ L), w = list.join l ∧ l.length = n :=
begin
  rw pow_eq_list_join,
  refl,
end

-- Замыкание Клини - все слова, которые можно представить как конкатенацию слов из L (без ограничения на количество)
lemma star_eq_list_join :
  star L = {w | ∃ l (h : ∀ x, x ∈ l → x ∈ L), w = list.join l} :=
begin
  sorry,
end

lemma mem_star_iff_list_join {w : list α} :
  w ∈ star L ↔ ∃ l (h : ∀ x ∈ l, x ∈ L), w = list.join l :=
begin
  rw star_eq_list_join,
  refl,
end

-- Еще одно ДЗ из курса формальных языков
lemma union_star_eq_star_mul_star_star : star (L + M) = star (star L * star M) :=
begin
  sorry,
end

lemma mul_star_subset_star : L * star L ⊆ star L :=
begin
  sorry,
end

-- Решаем уравнения в языках: если [] ∉ A, то L = A * L + B ↔ L = star A * b
lemma linear_eq_iff {A B : set (list α)} (hnil : [] ∉ A) : L = A * L + B ↔ L = star A * B :=
begin
  sorry,
end

end languages


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

import tactic
import combinatorics.simple_graph.basic -- definition of graph
/-

# Graph theory

A year ago Lean's graph theory was a bit patchy, but now I think
it's robust enough to be taken seriously as a topic for a final project.

So, how do graphs work in Lean? Actually it took a long time
to come up with a definition people were happy with. One issue
is that different people mean different things by "graph". In this
section we're going to stick to "simple graphs", which means
that you have a type of vertices `V`, and edges go between two
distinct vertices in `V`. The rules for a simple graph:

1) Edges are undirected (so they don't have a source and a target, they
just have two ends, which are vertices)
2) You can't have more than one edge between two distinct vertices.
3) You can't have an edge going from a vertex to itself.

Because of rule 2, you can represent an edge as a yes/no question:
"is there an edge between `v` and `w` or not?". In other words
you can represent edges as a function `adj: V → V → Prop`, and you
don't need a separate set or type `E` for edges. `adj` is short
for "adjacent", so `adj v w` means "there's an edge between `v` and `w`,
i.e. "`v` is adjacent to `w`".

Rule 1 means that `adj` is symmetric (if `v` is adjacent to `w` then
`w` is adjacent to `v`), and rule 3 means that it is irreflexive,
i.e. `∀ v, ¬ adj v v`.

Here's how to say "let `G` be a (simple) graph with vertex set `V`"

-/

variables (V : Type) (G : simple_graph V)

-- Here's how to say two edges are adjacent

example (v w : V) : Prop := G.adj v w

-- If v is adjacent to w then w is adjacent to v
example (v w : V) : G.adj v w → G.adj w v := G.adj_symm

-- v isn't adjacent to itself
example (v : V) : ¬ G.adj v v := G.irrefl

/-

Longish interlude: here's how to make a square graph. It's quite laborious.
Lean is better at proving theorems than making explicit examples!

v1 -- v2
|     |
|     |
v3 -- v4
-/

section square_graph

-- the vertex set of the square graph; we make it a type with four terms
inductive sqV : Type
| v1 : sqV
| v2 : sqV
| v3 : sqV
| v4 : sqV

open sqV -- so I can write `v1` not `sqV.v1`

-- here's one boring way of making the edges -- an inductive proposition
inductive sqE : sqV → sqV → Prop
| e12 : sqE v1 v2
| e21 : sqE v2 v1
| e24 : sqE v2 v4
| e42 : sqE v4 v2
| e34 : sqE v3 v4
| e43 : sqE v4 v3
| e13 : sqE v1 v3
| e31 : sqE v3 v1

-- Now let's make the graph
def sqG : simple_graph sqV :=
{ adj := sqE,
  symm := begin
    -- do all the cases for the two vertices and the edge
    rintro (_ | _ | _ | _) (_ | _ | _ | _) (_ | _ | _ | _ | _ | _ | _ | _),
    -- now 8 goals; find the right constructor for sqE in all cases
    repeat {constructor},
  end,
  loopless := begin
    rintro (_ | _ | _ | _) (_ | _ | _ | _ | _ | _ | _ | _),
  end }

end square_graph

-- Here's how to make a triangle graph; it's rather easier

-- Here `fin 3` is the "canonical" type with 3 terms; to give a term of type `fin 3`
-- is to give a pair consisting of a natural `n` and a proof that `n < 3`.
-- Here the `complete_graph` function is doing all the work for you.
example : simple_graph (fin 3) := complete_graph (fin 3)

-- The collection of all simple graphs on a fixed vertex set `V` form a Boolean algebra
-- (whatever that is)
example : boolean_algebra (simple_graph V) := by apply_instance

-- and in particular they form a lattice, so you can do stuff like this:

example : simple_graph V := ⊥ -- empty graph
example : simple_graph V := ⊤ -- complete graph
example (G H : simple_graph V) : simple_graph V := G ⊔ H -- union of vertices
-- etc etc, and you can even do this
example (G : simple_graph V) : simple_graph V := Gᶜ -- complement, i.e. an edge exists in `Gᶜ` between
                                                    -- distinct vertices `v` and `w` iff it doesn't
                                                    -- exist in `G`

-- The *support* of a graph is the vertices that have an edge coming from them.

example (v : V) : v ∈ G.support ↔ ∃ w, G.adj v w :=
begin
  refl, -- true by definition
end

-- The `neighbor_set` of a vertex is all the vertices connected to it by an edge.

example (v : V) : set V := G.neighbor_set v

example (v w : V) : w ∈ G.neighbor_set v ↔ G.adj v w := iff.rfl -- true by defn

-- The type `sym2 V` is the type of unordered pairs of elements of `V`, i.e. `V × V`
-- modulo the equivalence relation generated by `(v,w)~(w,v)`.
-- So you can regard the edges as a subset of `sym2 V`, and that's `G.edge_set`

example : set (sym2 V) := G.edge_set

-- You can use `v ∈ e` notation if `e : sym2 v`
-- For example, `G.incidence_set v` is the set of edges coming out of `v`,
-- regarded as elements of `sym2 V`

example (v : V) : G.incidence_set v = {e ∈ G.edge_set | v ∈ e} := rfl

-- You can delete a set of edges from `G` using `G.delete_edges`

example (E : set (sym2 V)) : simple_graph V := G.delete_edges E

-- if E contains edges not in G then this doesn't matter, they're just ignored.

-- You can push a graph forward along an injection

example (W : Type) (f : V ↪ W) : simple_graph W := G.map f

-- and pull it back along an arbitrary map

example (U : Type) (g : U → V) : simple_graph U := G.comap g

-- The degree of a vertex is the size of its neighbor_set.
-- Better assume some finiteness conditions to make this work.

variable [G.locally_finite]

-- now we have `finset` versions of some `set` things. For example
example (v : V) : G.degree v = finset.card (G.neighbor_finset v) := rfl

-- If `H` is another graph on a vertex set `W`
variables (W : Type) (H : simple_graph W)

-- then we can consider types of various maps between graphs

example : Type := G →g H -- maps f:V → W such that v₁~v₂ -> f(v₁)~f(v₂)
example : Type := G ↪g H -- injections f : V → W such that v₁~v₂ ↔ f(v₁)~f(v₂)
example : Type := G ≃g H -- isomorphisms of graphs


import ..lovelib

/-! # LoVe Demo 4: Functional Programming

We take a closer look at the basics of typed functional programming: inductive
types, proofs by induction, recursive functions, pattern matching, structures
(records), and type classes. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Inductive Types

Recall the definition of type `nat` (= `ℕ`): -/

#print nat

/-! Mottos:

* **No junk**: The type contains no values beyond those expressible using the
  constructors.

* **No confusion**: Values built in a different ways are different.

For `nat` (= `ℕ`):

* "No junk" means that there are no special values, say, `–1` or `ε`, that
  cannot be expressed using a finite combination of `zero` and `succ`.

* "No confusion" is what ensures that `zero` ≠ `succ x`.

In addition, terms of inductive types are always finite. `succ (succ (succ …))`
is not a value.

## Structural Induction

__Structural induction__ is a generalization of mathematical induction to
inductive types. To prove a property `P[n]` for all natural numbers `n`, it
suffices to prove the base case

    `P[0]`

and the induction step

    `∀k, P[k] → P[k + 1]`

For lists, the base case is

    `P[[]]`

and the induction step is

    `∀y ys, P[ys] → P[y :: ys]`

In general, there is one subgoal per constructor, and induction hypotheses are
available for all constructor arguments of the type we are doing the induction
on. -/

lemma nat.succ_neq_self (n : ℕ) :
  nat.succ n ≠ n :=
begin
  induction' n,
  { simp },
  { simp [ih] }
end

/-! The `case` tactic can be used to supply custom names, and potentially
reorder the cases. -/

lemma nat.succ_neq_self₂ (n : ℕ) :
  nat.succ n ≠ n :=
begin
  induction' n,
  case succ : m IH {
    simp [IH] },
  case zero {
    simp }
end

/-! ## Structural Recursion

__Structural recursion__ is a form of recursion that allows us to peel off
one or more constructors from the value on which we recurse. Such functions are
guaranteed to call themselves only finitely many times before the recursion
stops. This is a prerequisite for establishing that the function terminates. -/

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

def fact₂ : ℕ → ℕ
| 0       := 1
| 1       := 1
| (n + 1) := (n + 1) * fact₂ n

/-! For structurally recursive functions, Lean can automatically prove
termination. For more general recursive schemes, the termination check may fail.
Sometimes it does so for a good reason, as in the following example: -/

-- fails
def illegal : ℕ → ℕ
| n := illegal n + 1

constant immoral : ℕ → ℕ

axiom immoral_eq (n : ℕ) :
  immoral n = immoral n + 1

lemma proof_of_false :
  false :=
have immoral 0 = immoral 0 + 1 :=
  immoral_eq 0,
have immoral 0 - immoral 0 = immoral 0 + 1 - immoral 0 :=
  by cc,
have 0 = 1 :=
  by simp [*] at *,
show false, from
  by cc

/-! ## Pattern Matching Expressions

    `match` _term₁_, …, _termM_ `with`
    | _pattern₁₁_, …, _pattern₁M_ := _result₁_
        ⋮
    | _patternN₁_, …, _patternNM_ := _resultN_
    `end`

`match` allows nonrecursive pattern matching within terms.

In contrast to pattern matching after `lemma` or `def`, the patterns are
separated by commas, so parentheses are optional. -/

def bcount {α : Type} (p : α → bool) : list α → ℕ
| []        := 0
| (x :: xs) :=
  match p x with
  | tt := bcount xs + 1
  | ff := bcount xs
  end

def min (a b : ℕ) : ℕ :=
if a ≤ b then a else b

/-! ## Structures

Lean provides a convenient syntax for defining records, or structures. These are
essentially nonrecursive, single-constructor inductive types. -/
structure rgb :=
(red green blue : ℕ)

#check rgb.mk
#check rgb.red
#check rgb.green
#check rgb.blue

namespace rgb_as_inductive

inductive rgb : Type
| mk : ℕ → ℕ → ℕ → rgb

def rgb.red : rgb → ℕ
| (rgb.mk r _ _) := r

def rgb.green : rgb → ℕ
| (rgb.mk _ g _) := g

def rgb.blue : rgb → ℕ
| (rgb.mk _ _ b) := b

end rgb_as_inductive

structure rgba extends rgb :=
(alpha : ℕ)

#print rgba

def pure_red : rgb :=
{ red   := 0xff,
  green := 0x00,
  blue  := 0x00 }

def semitransparent_red : rgba :=
{ alpha := 0x7f,
  ..pure_red }

#print pure_red
#print semitransparent_red

def shuffle (c : rgb) : rgb :=
{ red   := rgb.green c,
  green := rgb.blue c,
  blue  := rgb.red c }

/-! `cases'` performs a case distinction on the specified term. This gives rise
to as many subgoals as there are constructors in the definition of the term's
type. The tactic behaves the same as `induction'` except that it does not
produce induction hypotheses. -/

lemma shuffle_shuffle_shuffle (c : rgb) :
  shuffle (shuffle (shuffle c)) = c :=
begin
  cases' c,
  refl
end

lemma shuffle_shuffle_shuffle₂ (c : rgb) :
  shuffle (shuffle (shuffle c)) = c :=
match c with
| rgb.mk _ _ _ := eq.refl _
end

structure Group :=
(carrier : Type)
(zero : carrier)
(add : carrier → carrier → carrier)
(add_zero : ∀ x : carrier, add x zero = x)

/-! ## Type Classes

A __type class__ is a structure type combining abstract constants and their
properties. A type can be declared an instance of a type class by providing
concrete definitions for the constants and proving that the properties hold.
Based on the type, Lean retrieves the relevant instance. -/

#print inhabited
#check inhabited.default

@[instance] def nat.inhabited : inhabited ℕ :=
{ default := 0 }

@[instance] def list.inhabited {α : Type} :
  inhabited (list α) :=
{ default := [] }

#eval inhabited.default ℕ          -- result: 0
#eval inhabited.default (list ℤ)   -- result: []

def head {α : Type} [inhabited α] : list α → α
| []       := inhabited.default α
| (x :: _) := x

lemma head_head {α : Type} [inhabited α] (xs : list α) :
  head [head xs] = head xs :=
begin
  cases' xs,
  { refl },
  { refl }
end

#eval head ([] : list ℕ)   -- result: 0

#check list.head

@[instance] def fun.inhabited {α β : Type} [inhabited β] :
  inhabited (α → β) :=
{ default := λa : α, inhabited.default β }

inductive empty : Type

@[instance] def fun_empty.inhabited {β : Type} :
  inhabited (empty → β) :=
{ default := λa : empty, match a with end }

@[instance] def prod.inhabited {α β : Type}
    [inhabited α] [inhabited β] :
  inhabited (α × β) :=
{ default := (inhabited.default α, inhabited.default β) }

/-! Here are other type classes without properties: -/

#check has_zero
#check has_neg
#check has_add
#check has_one
#check has_inv
#check has_mul

#check (1 : ℕ)
#check (1 : ℤ)
#check (1 : ℝ)

/-! We encountered these type classes in lecture 2: -/

#print is_commutative
#print is_associative

/-! ## Lists

`list` is an inductive polymorphic type constructed from `nil` and `cons`: -/

#print list

/-! `cases'` can also be used on a hypothesis of the form `l = r`. It matches `r`
against `l` and replaces all occurrences of the variables occurring in `r` with
the corresponding terms in `l` everywhere in the goal. -/

lemma injection_example {α : Type} (x y : α) (xs ys : list α)
    (h : list.cons x xs = list.cons y ys) :
  x = y ∧ xs = ys :=
begin
  cases' h,
  cc
end

/-! If `r` fails to match `l`, no subgoals emerge; the proof is complete. -/

lemma distinctness_example {α : Type} (y : α) (ys : list α)
    (h : [] = y :: ys) :
  false :=
by cases' h

def map {α β : Type} (f : α → β) : list α → list β
| []        := []
| (x :: xs) := f x :: map xs

def map₂ {α β : Type} : (α → β) → list α → list β
| _ []        := []
| f (x :: xs) := f x :: map₂ f xs

#check list.map

lemma map_ident {α : Type} (xs : list α) :
  map (λx, x) xs = xs :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : y ys {
    simp [map, ih] }
end

lemma map_comp {α β γ : Type} (f : α → β) (g : β → γ)
    (xs : list α) :
  map g (map f xs) = map (λx, g (f x)) xs :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : y ys {
    simp [map, ih] }
end

lemma map_append {α β : Type} (f : α → β) (xs ys : list α) :
  map f (xs ++ ys) = map f xs ++ map f ys :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : y ys {
    simp [map, ih] }
end

def tail {α : Type} : list α → list α
| []        := []
| (_ :: xs) := xs

#check list.tail

def head_opt {α : Type} : list α → option α
| []       := option.none
| (x :: _) := option.some x

def head_pre {α : Type} : ∀xs : list α, xs ≠ [] → α
| []       hxs := by cc
| (x :: _) _   := x

#eval head_opt [3, 1, 4]
#eval head_pre [3, 1, 4] (by simp)
-- fails
#eval head_pre ([] : list ℕ) sorry

def zip {α β : Type} : list α → list β → list (α × β)
| (x :: xs) (y :: ys) := (x, y) :: zip xs ys
| []        _         := []
| (_ :: _)  []        := []

#check list.zip

def length {α : Type} : list α → ℕ
| []        := 0
| (x :: xs) := length xs + 1

#check list.length

/-! `cases'` can also be used to perform a case distinction on a proposition, in
conjunction with `classical.em`. Two cases emerge: one in which the proposition
is true and one in which it is false. -/

#check classical.em

lemma min_add_add (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
begin
  cases' classical.em (m ≤ n),
  case inl {
    simp [min, h] },
  case inr {
    simp [min, h] }
end

lemma min_add_add₂ (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
match classical.em (m ≤ n) with
| or.inl h := by simp [min, h]
| or.inr h := by simp [min, h]
end

lemma min_add_add₃ (l m n : ℕ) :
  min (m + l) (n + l) = min m n + l :=
if h : m ≤ n then
  by simp [min, h]
else
  by simp [min, h]

lemma length_zip {α β : Type} (xs : list α) (ys : list β) :
  length (zip xs ys) = min (length xs) (length ys) :=
begin
  induction' xs,
  case nil {
    refl },
  case cons : x xs' {
    cases' ys,
    case nil {
      refl },
    case cons : y ys' {
      simp [zip, length, ih ys', min_add_add] } }
end

lemma map_zip {α α' β β' : Type} (f : α → α') (g : β → β') :
  ∀xs ys,
    map (λab : α × β, (f (prod.fst ab), g (prod.snd ab)))
      (zip xs ys) =
    zip (map f xs) (map g ys)
| (x :: xs) (y :: ys) := by simp [zip, map, map_zip xs ys]
| []        _         := by refl
| (_ :: _)  []        := by refl

/-! ## Binary Trees

Inductive types with constructors taking several recursive arguments define
tree-like objects. __Binary trees__ have nodes with at most two children. -/

inductive btree (α : Type) : Type
| empty {} : btree
| node     : α → btree → btree → btree

/-! The type `aexp` of arithmetic expressions was also an example of a tree data
structure.

The nodes of a tree, whether inner nodes or leaf nodes, often carry labels or
other annotations.

Inductive trees contain no infinite branches, not even cycles. This is less
expressive than pointer- or reference-based data structures (in imperative
languages) but easier to reason about.

Recursive definitions (and proofs by induction) work roughly as for lists, but
we may need to recurse (or invoke the induction hypothesis) on several child
nodes. -/

def mirror {α : Type} : btree α → btree α
| btree.empty        := btree.empty
| (btree.node a l r) := btree.node a (mirror r) (mirror l)

lemma mirror_mirror {α : Type} (t : btree α) :
  mirror (mirror t) = t :=
begin
  induction' t,
  case empty {
    refl },
  case node : a l r ih_l ih_r {
    simp [mirror, ih_l, ih_r] }
end

lemma mirror_mirror₂ {α : Type} :
  ∀t : btree α, mirror (mirror t) = t
| btree.empty        := by refl
| (btree.node a l r) :=
  calc  mirror (mirror (btree.node a l r))
      = mirror (btree.node a (mirror r) (mirror l)) :
    by refl
  ... = btree.node a (mirror (mirror l)) (mirror (mirror r)) :
    by refl
  ... = btree.node a l (mirror (mirror r)) :
    by rw mirror_mirror₂ l
  ... = btree.node a l r :
    by rw mirror_mirror₂ r

lemma mirror_eq_empty_iff {α : Type} :
  ∀t : btree α, mirror t = btree.empty ↔ t = btree.empty
| btree.empty        := by refl
| (btree.node _ _ _) := by simp [mirror]

/-! ## Dependent Inductive Types (**optional**) -/

#check vector

inductive vec (α : Type) : ℕ → Type
| nil {}                           : vec 0
| cons (a : α) {n : ℕ} (v : vec n) : vec (n + 1)

#check vec.nil
#check vec.cons

def list_of_vec {α : Type} : ∀{n : ℕ}, vec α n → list α
| _ vec.nil        := []
| _ (vec.cons a v) := a :: list_of_vec v

def vec_of_list {α : Type} :
  ∀xs : list α, vec α (list.length xs)
| []        := vec.nil
| (x :: xs) := vec.cons x (vec_of_list xs)

lemma length_list_of_vec {α : Type} :
  ∀{n : ℕ} (v : vec α n), list.length (list_of_vec v) = n
| _ vec.nil        := by refl
| _ (vec.cons a v) :=
  by simp [list_of_vec, length_list_of_vec v]

end LoVe


import MyNat
import MyNat.addition_world

open MyNat

lemma succ_inj (a b : ℕ) : succ a = succ b → a = b := by
  intro h
  cases h
  rfl

lemma zero_ne_succ (a : ℕ) : zero ≠ succ a := by
  intro h
  cases h

theorem succ_succ_inj (a b : ℕ) (h : succ (succ a) = succ (succ b)) : a = b := by
  apply succ_inj
  apply succ_inj
  exact h

theorem succ_eq_succ_of_eq (a b : ℕ) :
  a = b → succ a = succ b := by
  intro h
  rewrite [h]
  rfl

theorem succ_eq_succ_iff (c d : ℕ) :
  succ c = succ d ↔ c = d := by
  constructor
  exact succ_inj c d
  exact succ_eq_succ_of_eq c d

theorem add_right_cancel (a t b : ℕ) :
  a + t = b + t → a = b := by
  intro h
  induction t with
  | zero =>
    rewrite [add_zero, add_zero] at h
    exact h
  | succ t' ih =>
    rewrite [add_succ, add_succ] at h
    let h' := (succ_inj (a + t') (b + t') h)
    apply (ih h')

theorem add_left_cancel (t a b : ℕ) :
  t + a = t + b → a = b := by
  rewrite [add_comm, add_comm t b]
  exact add_right_cancel a t b

theorem add_right_cancel_iff (t a b : ℕ) :
  a + t = b + t ↔ a = b := by
  constructor
  exact add_right_cancel _ _ _
  intro h
  rewrite [h]
  rfl

lemma eq_zero_of_add_right_eq_self (a b : ℕ) :
  a + b = a → b = 0 := by
  rewrite [←add_zero a, add_assoc, zero_add]
  intro h
  exact add_left_cancel _ _ _ h

theorem succ_ne_zero (a : ℕ) : succ a ≠ 0 := by
  intro h
  exact zero_ne_succ a h.symm

lemma add_left_eq_zero
  (a b : ℕ) (H : a + b = 0) : b = 0 := by
  cases b with
  | zero => rfl
  | succ b' =>
    rewrite [add_succ] at H
    exact False.elim (succ_ne_zero (a + b') H)

lemma add_right_eq_zero (a b : ℕ) :
  a + b = 0 → a = 0 := by
  rewrite [add_comm]
  exact add_left_eq_zero _ _

lemma add_one_eq_succ (d : ℕ) : d + 1 = succ d := by
  apply Eq.symm _
  exact succ_eq_add_one _

lemma ne_succ_self (n : ℕ) : n ≠ succ n := by
  rewrite [succ_eq_add_one, ←add_zero n, add_assoc, zero_add]
  intro h
  let f := add_left_cancel _ _ _ h
  rewrite [one_eq_succ_zero] at f
  exact zero_ne_succ zero f


import analysis.real tactic.norm_num algebra.group_power

theorem Q5a1 (S : set ℝ) : (∃ x : ℝ, x ∈ lower_bounds S)
    ↔ (∃ y : ℝ, y ∈ upper_bounds {t : ℝ | ∃ s ∈ S, t = -s }) := sorry

theorem Q5a2 (S : set ℝ) (x : ℝ) : is_glb S x ↔
    is_lub {t : ℝ | ∃ s ∈ S, t = -s} (-x) := sorry

lemma Q5bhelper (S : set ℝ) (x₁ x₂ : ℝ) : is_glb S x₁ ∧ is_glb S x₂ → x₁ ≤ x₂ :=
begin
intro H,
have Hglb1 := H.left,
have Hlb1 := Hglb1.left,
have Hglb2 := H.right,
have H1 := Hglb2.right,
exact H1 _ Hlb1,
end

theorem Q5b (S : set ℝ) (x₁ x₂ : ℝ) : is_glb S x₁ ∧ is_glb S x₂ → x₁ = x₂ := sorry

theorem Q5c :  (∀ S : set ℝ, (∃ w : ℝ, w ∈ S) → (∃ x : ℝ, x ∈ upper_bounds S) → ∃ y : ℝ, is_lub S y)
   →   (∀ T : set ℝ, (∃ w₁ : ℝ, w₁ ∈ T) → (∃ x₁ : ℝ, x₁ ∈ lower_bounds T) → ∃ y₁ : ℝ, is_glb T y₁) := sorry


import automata.dfa
import data.list.basic
import regular.regex
import regular.list_lemmas
import regular.pumping_lemma

open DFA list pumping

def L0ⁿ1ⁿ := {w | ∃ n, w = (repeat bool.ff n) ++ (repeat bool.tt n)}

@[simp] lemma mem_L0ⁿ1ⁿ_iff {w} : w ∈ L0ⁿ1ⁿ ↔ ∃ n, w = (repeat bool.ff n) ++ (repeat bool.tt n) :=
  iff.rfl

theorem not_regular_0ⁿ1ⁿ : ¬dfa_lang L0ⁿ1ⁿ :=
begin
    apply pumping_lemma_negation,
    intro n,
    use [(repeat bool.ff n) ++ (repeat bool.tt n), n],
    simp only [not_exists, true_and, length_repeat, zero_le, le_add_iff_nonneg_left, mem_L0ⁿ1ⁿ_iff,
  length_append],
    rintro x y z hxyz ynil hpref,
    use 0,
    simp only [join, repeat, append_nil],
    rintro l hl,
    rw [← length_repeat ff n, ← length_append] at hpref,
    have tt_n_suffix := suffix_of_append_eq_append hpref hxyz,
    have tt_eq_ff := repeat_suffix_of_append_repeat _ (is_suffix.trans tt_n_suffix ⟨x, hl⟩),
    contradiction,
    apply_fun length at hxyz hl,
    simp only [length_repeat, length_append] at hpref hl hxyz,
    rw [← length_pos_iff_ne_nil] at ynil,
    linarith,
end


import data.nat.basic

def is_even (a : nat) := ∃ b, a = 2 * b

theorem even_plus_even {a b : nat}
  (h1 : is_even a) (h2 : is_even b) : is_even (a + b) :=
  exists.elim h1 (assume w1, assume hw1 : a = 2 * w1,
  exists.elim h2 (assume w2, assume hw2 : b = 2 * w2,
    exists.intro (w1 + w2)
      (calc
        a + b = 2 * w1 + 2 * w2 : by rw [hw1, hw2]
        ...   = 2 * (w1 + w2)   : by rw mul_add)))

theorem even_plus_even' {a b : nat}
  (h1 : is_even a) (h2 : is_even b) : is_even (a + b) :=
match h1, h2 with
  ⟨ w1, hw1⟩, ⟨ w2, hw2⟩ := ⟨ w1 + w2, by rw [hw1, hw2, mul_add]⟩
end


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que en un orden parcial
--     a < b ↔ a ≤ b ∧ a ≠ b
-- ----------------------------------------------------------------------

import tactic

variables {α : Type*} [partial_order α]
variables a b : α

example : a < b ↔ a ≤ b ∧ a ≠ b :=
begin
  rw lt_iff_le_not_le,
  split,
    rintros ⟨h1, h2⟩,
      split,
        exact h1,
        contrapose ! h2,
        rw h2,
    rintros ⟨h3, h4⟩,
      split,
        exact h3,
        contrapose ! h4,
        apply le_antisymm h3 h4,
end

-- Prueba
-- ======

/-α : Type u_1,
_inst_1 : partial_order α,
a b : α
⊢ a < b ↔ a ≤ b ∧ a ≠ b
  >> rw lt_iff_le_not_le,
⊢ a ≤ b ∧ ¬b ≤ a ↔ a ≤ b ∧ a ≠ b
  >> split,
| ⊢ a ≤ b ∧ ¬b ≤ a → a ≤ b ∧ a ≠ b
|   >>   rintros ⟨h1, h2⟩,
| h1 : a ≤ b,
| h2 : ¬b ≤ a
|   >>     split,
| ⊢ a ≤ b ∧ a ≠ b
| | ⊢ a ≤ b
|   >>       exact h1,
| ⊢ a ≠ b
|   >>       contrapose ! h2,
| h2 : a = b
| ⊢ b ≤ a
|   >>       rw h2,
α : Type u_1,
_inst_1 : partial_order α,
a b : α
⊢ a ≤ b ∧ a ≠ b → a ≤ b ∧ ¬b ≤ a
  >>   rintros ⟨h3, h4⟩,
h3 : a ≤ b,
h4 : a ≠ b
⊢ a ≤ b ∧ ¬b ≤ a
  >>     split,
| ⊢ a ≤ b
|   >>       exact h3,
⊢ ¬b ≤ a
  >>       contrapose ! h4,
h4 : b ≤ a
⊢ a = b
  >>       apply le_antisymm h3 h4,
no goals
-/

-- Comentario: Los lemas usados son
-- + lt_iff_le_not_le : a < b ↔ a ≤ b ∧ ¬b ≤ a
-- + le_antisymm : a ≤ b → b ≤ a → a = b


import MyNat.Addition
namespace MyNat
open MyNat
/-!

# Tutorial world

## Level 4: addition

We have a new import -- the definition of addition.

Peano defined addition `a + b` by induction on `b`, or, more precisely, by recursion on `b`. He first
explained how to add 0 to a number: this is the base case.

- `add_zero (a : MyNat) : a + 0 = a`

We will call this theorem `add_zero`. More precisely, `add_zero` is the name of the _proof_ of the
theorem. Note the name of this proof. Mathematicians sometimes call it "Lemma 2.1" or "Hypothesis
P6" or something. But computer scientists call it `add_zero` because it tells you what the answer to
"x add zero" is. It's a much better name than "Lemma 2.1". Even better, you can use the `rewrite` tactic
with `add_zero`. If you ever see `x + 0` in your goal, `rewrite [add_zero]` should simplify it to `x`. This is
because `add_zero` is a proof that `x + 0 = x` (more precisely, `add_zero x` is a proof that `x + 0 = x` but
Lean can figure out the `x` from the context).

Now here's the inductive step. If you know how to add `d` to `a`, then Peano tells you how to add
`succ d` to `a`. It looks like this:

- `add_succ (a d : MyNat) : a + (succ d) = succ (a + d)`

What's going on here is that we assume `a + d` is already defined, and we define `a + (succ d)` to
be the number after it. Note the name of this proof too -- `add_succ` tells you how to add a successor
to something. If you ever see `... + succ ...` in your goal, you should be able to use `rewrite [add_succ]`, to
make progress.

**Lemma**`

For all natural numbers `a`, we have `a + (succ 0`) = succ a`.
-/
lemma add_succ_zero (a : MyNat) : a + (succ 0) = succ a := by
  rewrite [add_succ]
  rewrite [add_zero]
  rfl

/-!
Do you see that the goal at the end of the first `rewrite` now mentions `... + 0 ...`? So this
matches the `add_zero` theorem so you can now add the `rewrite [add_zero]`.

After the `rfl` the proof is now complete: "Goals accomplished 🎉".
Note that because `rewrite` takes a list, you can also write the above two lines in one
using `rewrite [add_succ, add_zero]`.

And remember `rw` also does `rfl`, you can replace the whole proof with `rw [add_succ, add_zero]`.

### Examining proofs.

You might want to review this proof now; at three lines long it is your current record.
Don't worry there are much longer proofs, in fact, the
[Liquid Tensor Experiment](https://xenaproject.wordpress.com/2022/09/12/beyond-the-liquid-tensor-experiment/)
contains 90,000 lines of Lean proofs! For this reason Lean is a real programming language
with support for abstraction and extension so that you can get as much reusability as
possible in your Lean code.

The easiest way to see how the proof goal state progresses is to place your cursor at the
beginning of each line using the Up/Down arrow key to move down the proof and see the effect
of the previous line on the goal shown in the InfoView.

### Next

You have finished tutorial world! When you're happy, please move onto [Addition
World](../AdditionWorld.lean.md), and learn about proof by induction.

### Troubleshooting

**Question**: why has the InfoView gone blank?

**Answer**: try placing the cursor at different places in the file, the InfoView shows the
context at the cursor location.  If the InfoView is not updating at all no matter what you
do then there might be a problem with your VS Code setup.
See the [Quick
Start](https://leanprover.github.io/lean4/doc/quickstart.html) for more information.

-/


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

import linear_algebra.free_module.basic
import linear_algebra.finsupp_vector_space

/-!

# Rank of free modules

This is a basic API for the rank of free modules.

-/

universes u v w

variables (R : Type u) (M : Type v) (N : Type w)

open_locale tensor_product direct_sum big_operators cardinal

open cardinal

namespace module.free

section ring

variables [ring R] [strong_rank_condition R]
variables [add_comm_group M] [module R M] [module.free R M]
variables [add_comm_group N] [module R N] [module.free R N]

/-- The rank of a free module `M` over `R` is the cardinality of `choose_basis_index R M`. -/
lemma rank_eq_card_choose_basis_index : module.rank R M = #(choose_basis_index R M) :=
(choose_basis R M).mk_eq_dim''.symm

/-- The rank of `(ι →₀ R)` is `(# ι).lift`. -/
@[simp] lemma rank_finsupp {ι : Type v} : module.rank R (ι →₀ R) = (# ι).lift :=
by simpa [lift_id', lift_umax] using
  (basis.of_repr (linear_equiv.refl _ (ι →₀ R))).mk_eq_dim.symm

/-- If `R` and `ι` lie in the same universe, the rank of `(ι →₀ R)` is `# ι`. -/
lemma rank_finsupp' {ι : Type u} : module.rank R (ι →₀ R) = # ι := by simp

/-- The rank of `M × N` is `(module.rank R M).lift + (module.rank R N).lift`. -/
@[simp] lemma rank_prod :
  module.rank R (M × N) = lift.{w v} (module.rank R M) + lift.{v w} (module.rank R N) :=
by simpa [rank_eq_card_choose_basis_index R M, rank_eq_card_choose_basis_index R N,
  lift_umax, lift_umax'] using ((choose_basis R M).prod (choose_basis R N)).mk_eq_dim.symm

/-- If `M` and `N` lie in the same universe, the rank of `M × N` is
  `(module.rank R M) + (module.rank R N)`. -/
lemma rank_prod' (N : Type v) [add_comm_group N] [module R N] [module.free R N] :
  module.rank R (M × N) = (module.rank R M) + (module.rank R N) := by simp

/-- The rank of the direct sum is the sum of the ranks. -/
@[simp] lemma rank_direct_sum  {ι : Type v} (M : ι → Type w) [Π (i : ι), add_comm_group (M i)]
  [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] :
  module.rank R (⨁ i, M i) = cardinal.sum (λ i, module.rank R (M i)) :=
begin
  let B := λ i, choose_basis R (M i),
  let b : basis _ R (⨁ i, M i) := dfinsupp.basis (λ i, B i),
  simp [← b.mk_eq_dim'', λ i, (B i).mk_eq_dim''],
end

/-- The rank of a finite product is the sum of the ranks. -/
@[simp] lemma rank_pi_finite {ι : Type v} [finite ι] {M : ι → Type w}
  [Π (i : ι), add_comm_group (M i)] [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] :
  module.rank R (Π i, M i) = cardinal.sum (λ i, module.rank R (M i)) :=
by { casesI nonempty_fintype ι,
  rw [←(direct_sum.linear_equiv_fun_on_fintype _ _ M).dim_eq, rank_direct_sum] }

/-- If `m` and `n` are `fintype`, the rank of `m × n` matrices is `(# m).lift * (# n).lift`. -/
@[simp] lemma rank_matrix (m : Type v) (n : Type w) [finite m] [finite n] :
  module.rank R (matrix m n R) = (lift.{(max v w u) v} (# m)) * (lift.{(max v w u) w} (# n)) :=
begin
  casesI nonempty_fintype m,
  casesI nonempty_fintype n,
  have h := (matrix.std_basis R m n).mk_eq_dim,
  rw [← lift_lift.{(max v w u) (max v w)}, lift_inj] at h,
  simpa using h.symm,
end

/-- If `m` and `n` are `fintype` that lie in the same universe, the rank of `m × n` matrices is
  `(# n * # m).lift`. -/
@[simp] lemma rank_matrix' (m n : Type v) [finite m] [finite n] :
  module.rank R (matrix m n R) =  (# m * # n).lift :=
by rw [rank_matrix, lift_mul, lift_umax]

/-- If `m` and `n` are `fintype` that lie in the same universe as `R`, the rank of `m × n` matrices
  is `# m * # n`. -/
@[simp] lemma rank_matrix'' (m n : Type u) [finite m] [finite n] :
  module.rank R (matrix m n R) =  # m * # n := by simp

end ring

section comm_ring

variables [comm_ring R] [strong_rank_condition R]
variables [add_comm_group M] [module R M] [module.free R M]
variables [add_comm_group N] [module R N] [module.free R N]

/-- The rank of `M ⊗[R] N` is `(module.rank R M).lift * (module.rank R N).lift`. -/
@[simp] lemma rank_tensor_product : module.rank R (M ⊗[R] N) = lift.{w v} (module.rank R M) *
  lift.{v w} (module.rank R N) :=
begin
  let ιM := choose_basis_index R M,
  let ιN := choose_basis_index R N,

  have h₁ := linear_equiv.lift_dim_eq (tensor_product.congr (repr R M) (repr R N)),
  let b : basis (ιM × ιN) R (_ →₀ R) := finsupp.basis_single_one,
  rw [linear_equiv.dim_eq (finsupp_tensor_finsupp' R ιM ιN), ← b.mk_eq_dim, mk_prod] at h₁,
  rw [lift_inj.1 h₁, rank_eq_card_choose_basis_index R M, rank_eq_card_choose_basis_index R N],
end

/-- If `M` and `N` lie in the same universe, the rank of `M ⊗[R] N` is
  `(module.rank R M) * (module.rank R N)`. -/
lemma rank_tensor_product' (N : Type v) [add_comm_group N] [module R N] [module.free R N] :
  module.rank R (M ⊗[R] N) = (module.rank R M) * (module.rank R N) := by simp

end comm_ring

end module.free


import ..lectures.love02_backward_proofs_demo

/-! # LoVe Exercise 2: Backward Proofs -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/-! ## Question 1: Connectives and Quantifiers

1.1. Carry out the following proofs using basic tactics.

Hint: Some strategies for carrying out such proofs are described at the end of
Section 2.3 in the Hitchhiker's Guide. -/

lemma I (a : Prop) :
  a → a :=
sorry

lemma K (a b : Prop) :
  a → b → b :=
sorry

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
sorry

lemma proj_1st (a : Prop) :
  a → a → a :=
sorry

/-! Please give a different answer than for `proj_1st`: -/

lemma proj_2nd (a : Prop) :
  a → a → a :=
sorry

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
sorry

/-! 1.2. Prove the contraposition rule using basic tactics. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
sorry

/-! 1.3. Prove the distributivity of `∀` over `∧` using basic tactics.

Hint: This exercise is tricky, especially the right-to-left direction. Some
forward reasoning, like in the proof of `and_swap₂` in the lecture, might be
necessary. -/

lemma forall_and {α : Type} (p q : α → Prop) :
  (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
sorry

/-! ## Question 2: Natural Numbers

2.1. Prove the following recursive equations on the first argument of the
`mul` operator defined in lecture 1. -/

#check mul

lemma mul_zero (n : ℕ) :
  mul 0 n = 0 :=
sorry

lemma mul_succ (m n : ℕ) :
  mul (nat.succ m) n = add (mul m n) n :=
sorry

/-! 2.2. Prove commutativity and associativity of multiplication using the
`induction'` tactic. Choose the induction variable carefully. -/

lemma mul_comm (m n : ℕ) :
  mul m n = mul n m :=
sorry

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
sorry

/-! 2.3. Prove the symmetric variant of `mul_add` using `rw`. To apply
commutativity at a specific position, instantiate the rule by passing some
arguments (e.g., `mul_comm _ l`). -/

lemma add_mul (l m n : ℕ) :
  mul (add l m) n = add (mul n l) (mul n m) :=
sorry

/-! ## Question 3 (**optional**): Intuitionistic Logic

Intuitionistic logic is extended to classical logic by assuming a classical
axiom. There are several possibilities for the choice of axiom. In this
question, we are concerned with the logical equivalence of three different
axioms: -/

def excluded_middle : Prop :=
∀a : Prop, a ∨ ¬ a

def peirce : Prop :=
∀a b : Prop, ((a → b) → a) → a

def double_negation : Prop :=
∀a : Prop, (¬¬ a) → a

/-! For the proofs below, please avoid using lemmas from Lean's `classical`
namespace, as this would defeat the purpose of the exercise.

3.1 (**optional**). Prove the following implication using tactics.

Hint: You will need `or.elim` and `false.elim`. You can use
`rw excluded_middle` to unfold the definition of `excluded_middle`,
and similarly for `peirce`. -/

lemma peirce_of_em :
  excluded_middle → peirce :=
sorry

/-! 3.2 (**optional**). Prove the following implication using tactics. -/

lemma dn_of_peirce :
  peirce → double_negation :=
sorry

/-! We leave the remaining implication for the homework: -/

namespace sorry_lemmas

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

end sorry_lemmas

end backward_proofs

end LoVe


/-
In this class, we introduce conjunction,
∧ (and), as connective that combines any
two propositions into a larger one; and
we show how we define the introduction and
elimination rules for this connective *so
that* it behaves in Lean as it behaves in
predicate logic: to prove P ∧ Q we need to
provide proofs of P and of Q, respectively
(the introduction rule), and given a proof
of P ∧ Q, we can *use* it to obtain a proof
of P, and a proof of Q (the left and right
elimination rules for ∧).

Once we've defined these rules as "axioms"
then we can use them to prove new theorems
about the properties of the ∧ connective:
that it's *commutative* and *associative*.

That's our agenda.
-/

/-
THE AXIOMS (INTRO & ELIM RULES) FOR ∧.
-/

/-
To get started, let assume that P and Q
are arbitrary propositions. We'll use the
"axiom" keyword in Lean, which introduces
assumptions into the current environment,
which is here the "global" environment of
this file.
-/
axioms P Q : Prop

/- The syntax of predicate logic dictates that if
P and Q are propositions, then P ∧ Q is one as well.
For this reason we use the term "connective" for
logical symbols such as ∧, in that they "connect"
give propositions (P, Q) into larger propositions
(here, P ∧ Q).

Given thatwe propositions are types in the logic of
Lean, you can also say that ∧ is a "type builder:"
it takes two types as arguments (P, Q) and returns
a new, type, P ∧ Q, as a result. What is the type of
P ∧ Q? Try to answer yourself before leaning on the
proof assistant (ha ha) to tell you.
-/
#check P ∧ Q

/-
∧ is just an infix notation for "and", with the
correct precendence to work together correctly
with the other logical connectives Lean defines,
and with *right* associativity. That means that
Lean will parse P ∧ Q ∧ R as P ∧ (Q ∧ R), not as
(P ∧ Q) ∧ R.
-/
#check and P Q

/-
∧ is a logical "connective." That means
it "connects" (a better word is "composes")
two propositions into a larger proposition.
Given the propositions are types in Lean,
∧ is a *polymorphic type building function
that takes two propositions (types) as its
arguments and yields a proposition (type)
as a result.

What, then, is the type of "and,"" viewed
as a function? Try hard to answer yourself
before using Lean to get the answer for you.
-/
#check @and

/-
Right. ∧ takes two propositions, P and Q,
and gives us back a new proposition, P ∧ Q,
(which "desugars" to "and P Q").
-/

/-
What we are going to see now is that ∧ is
implemented in Lean as a polymorphic type.
It's implemented as an inductive type that
takes two propositions (types!) as arguments.
These type arguments are the propositions to
be connected.

The constructor for this type then defines
the introduction rule (a way to build proof
objects) for this new type.

Finally, the elimination rules allow us to
use a proof of P ∧ Q to derive proofs of P
and of Q. We'll see later in this file how
to implement these logical rules, again as
functions, in Lean.
-/

/-
First, though, we want to see exactly where
the and.intro rule comes from. Here's Lean's
definition of and (∧). What you can see is
that and.intro is just a constructor of data
values (proofs!) of *type* (and a b), where
a and b are themselves propositions.

structure and (a b : Prop) : Prop :=
intro :: (left : a) (right : b)

Constructors are introduction rules! Indeed,
if you look back at the eq polymorphic type,
you will be reminded that eq.refl is just a
(the only) constructor for building terms of
type (@eq α a b), the shorthand notation for
which is a = b. Constructors are introduction
"axioms" for their types.
-/

/-
We now use this example to explore a number
of core concepts in the Lean language. First,
and hew here, is the use of "structure"  as a
keywork. It can be used in place of inductive
when a type has just exactly one constructor.
The main benefit of using "structure" is that
it tells Lean to *synthesize* functions with
the same names as the fields for *accessing*
the field values in any instances of the type.

It allows the argument names, left and right,
in this case, to be used as names of functions
to "access" the field values of an object of
type P ∧ Q. So, if you have an object, pf, of
type P ∧ Q , then (and.left pf) and (and.right
pf) give you proofs of P and of Q. For these
function calls you can also use the notation,
pf.left and pf.right. These functions are, of
course, the two elimination rules for and!
-/

/-
In sum, the "intro" constructor for ∧
implements the introduction rule for ∧,
while the Lean-provided accessor functions,
left and right, implement the elimination
rules for ∧: left and right, respectively.
-/

/-
With these "rules" in hand, we can now
construct proofs of theorems about the
*and* operator, just as we did for eq
(proving symmetry and transitivity) once
we had the intro (refl) and elim (subst)
rules for equality.
-/

/-
To illustrate, beyond assuming that P and
Q are propositions (above), we'll now also
assume that we have proofs of P and of Q.
Remember that the propositions P and Q are
*types*. What we want now are values of
these types, which we now understand are
proofs. Heres how we assume "axiomatically"
that p and q are proofs of P and of Q.respectively.
-/
axioms (p : P) (q : Q)

/-
Given that we're now in a (global) context
in which we have assumed P and Q are in Prop
and that p and q are proofs of P and of Q,
we can now claim that there must be a proof
of P ∧ Q --- that P ∧ Q is true. Now we can
produce a proof to show that it is true.
-/
example : P ∧ Q := and.intro p q

/-
Yay. That's how we use the introduction
rule for ∧ to prove propositions of the
form P ∧ Q (conjunctions).
-/

/-
Here's the equivalent formulation using
ordinary function definition notation. We
define func (a name we're just making
up) to be a function that takes P, Q, p,
and q as arguments and returns a proof of
P ∧ Q.
-/
def func
  (P Q : Prop)
  (p : P)
  (q : Q) :
  P ∧ Q :=
and.intro p q

/-
We can also write our own functions that mimic
the elimination rules for and (by "wrapping"
them in an added layer of abstraction)
-/
def and_elim_left
  (P Q : Prop)
  (pq : P ∧ Q) :
  P
  :=
and.elim_left pq

/-
Homework #1: Define an analogous function,
and_elim_right.
-/

-- Here.

/-
From a proof of P ∧ Q we can derive a proof
of P, and we can derive a proof of Q, using
the elimination rules for ∧:
-/

#check @and.elim_left
#check @and.left
#check @and.elim_right
#check @and.right

/-
Mental exercise: To what values do the following
expressions evaluate/reduce?

and.elim_left (and.intro p q)
and.elim_right (and.intro p q)
-/
#reduce and.elim_left (and.intro p q)
#reduce and.elim_right (and.intro p q)

/-
and.left : ∀ {a b : Prop}, a ∧ b → a
and.right : ∀ {a b : Prop}, a ∧ b → b

Conceptually, each elimination rules takes
a pair and returns either the first or the
second of its two fields. They are what we
can call "projection functions."
-/

/-
THEOREM CONCERNING ∧
-/

/-
We now have the basic *axioms* for
creating and using proofs of *conjunctions*
(propositions built using ∧). With them we
can state and prove new *theorems* about the
behavior of the ∧ connective. For example,
we can now prove (almost) that it's both
"commutative" and "associative."
-/

/-
Example 1: From a proof of P ∧ Q we can
construct/derive a proof of Q ∧ P.
-/
theorem and_commutes
  (P Q : Prop) (pq : P ∧ Q) : Q ∧ P :=
  and.intro
    (and.right pq)
    (and.left pq)

/-
The idea here is pretty simple. A proof of
P ∧ Q is of the form (and.intro p q), which
you can think of as a labelled order pair of
proofs. (The label is and.intro.) Given such
a proof, we use our elimination functions,
left and right, to extract p and q, then we
use and.intro to put them together again, in
the opposite order, to construct a proof,
(and.intro q p), of Q ∧ P.

Here's another version of our proof. We use
example to avoid giving it a name. We specify
the same arguments (before the colon) and the
same return type (just after the colon). We
then write the "implementation" (after the :=)
using both angle-bracket and dot notation for
field access. What's new here is the use of
⟨...⟩ notation. It can be used whenever you
are creating a value of structure (a type
with just one constructor and zero or more
arguments). This angle bracket notation calls
the single constructor with its arguments in
the comma separated list inside the angle
bracket pair. Note that you have to type a
backslash before a less-than or greater-than
keyboard character to get these special angle
brackets.
-/

example (P Q : Prop) (pq : P ∧ Q) : Q ∧ P :=
  ⟨ pq.right, pq.left ⟩

/-
At this point, we've now seen the introduction
and elimination "rules" for both = and ∧. The
introduction rules are eq.refl and and.intro,
while the elimination rules are eq.subst, and
and.left and and.right (aka and.elim_left and
and.elim_right).

/-
Seeing the introduction and elimination
rules for ∀ and →.
-/

We've also seen, implicitly, the introduction
and elimination rules for ∀ and →. The intro
rule says "assume the argument/premise and, in
that context, show that you can construct and
"return" a proof of the conclusion/return type.

To prove P → Q, assume you're given a proof of
P and in that context show that you can have a
proof of Q. That proves P → Q. Similarly, to
prove ∀ (p : P), Q, assume that you're given
an arbitrary proof/value of P and show that
in that context you can construct a proof/value
of type Q.

In Lean these connectives, ∀ and →, are in fact
essentially just notations for the same idea! To
see that this is the case, look at how Lean prints
the proposition, ∀ (p : P), Q. It's just P → Q!
(Recall again that we defined P and Q above.)
-/

#check ∀ (p : P), Q

/-
Homework #2: NFormally state and prove the
proposition that "∧ is associative."

Okay, any logic text or web page will tell you
that this statement, "∧ is associative", means
that for any three propositions, P, Q, and R,
if (P ∧ Q) ∧ R is true then P ∧ (Q ∧ R) is too,
and vice versa! We will just state and prove
the first of these.
-/

-- theorem and_assoc (partial) ...

-- TOP DOWN
example : ∀ (P Q R), (P ∧ (Q ∧ R)) → ((P ∧ Q) ∧ R) :=
begin
  intros P Q R h,
  apply and.intro
    (and.intro
      (and.elim_left h)
      (h.right.left)
    )
    (h.right.right),
end

/-
BOTTOM UP
-/

example : ∀ (P Q R), (P ∧ (Q ∧ R)) → ((P ∧ Q) ∧ R) :=
begin
  intros P Q R h,
  have p : P := h.left,       -- binds identifier, p, to h.left
  have q : Q := h.right.left, -- scoped locally to this tactic script
  have r : R := h.right.right,-- we're building objects to be assembled
  have pq : P ∧ Q := and.intro p q, -- here's the final assembly
  exact and.intro pq r,       -- exactly the proof term we needed
end

/-
Note that we can move arguments to the left or right of
the colon. When to the left, we give them names. If on the
right, if one or more needs names, then we use ∀ or Π to
bind names, then a comma, then the rest of the type. In
this example, we move the ∀ (P Q R : Prop) in the last
example to the left of the colon in this example. In
both cases, the effect is to bind names, P, Q, and R,
to assumed objects which enables us to use those names
in the rest of the expression that specifies the overall
type of the function.
-/
example (P Q R : Prop) : (P ∧ (Q ∧ R)) → ((P ∧ Q) ∧ R) :=
begin
  intros h,
  have p : P := h.left,
  have q : Q := h.right.left,
  have r : R := h.right.right,
  have pq : P ∧ Q := and.intro p q,
  exact and.intro pq r,
end

namespace hidden

#check and

/-
DEEP DIVE: Now let's take an even deeper
look at how the and elimination rules are
actually implemented. In short, they are
just functions. The first takes a proof
of P ∧ Q, comprising a pair of proofs,
⟨ p, q ⟩, takes apart this pair, and
returns its first element, p. The and
elimination right rules takes the same
pair, takes it apart, and returns q.

The technical means for doing this kind
of taking apart, or "analysis", of an
object is by "pattern matching." (There
is an even deeper level involving what
Lean calls recursors, but we can't go
there yet.)
-/

/-
To begin, recall Lean's actual definition
of and (∧).

structure and (a b : Prop) : Prop :=
intro :: (left : a) (right : b)

Let's go ahead an implement this ourselves
to make the details clear. The first point
is that we could have used inductive instead
of structure. The following definition is
equivalent to Leans (almost).
-/

inductive and (P Q : Prop) : Prop
| intro (p : P) (q : Q) : and

#check and
#check and P Q

/-
What about that almost? The definition
above is logically equivalent to Lean's,
but if we use inductive, we have to write
our own "accessor functions" to get at
the fields of a proof of P ∧ Q.
-/

def elim_left : (and P Q) → P
| (and.intro x y) := x  -- pattern matching

/-
After the type signature, (and P Q) → P,
we give a list of cases, typically one per
constructor for the type of the argument,
(and P Q). For ∧, there is only one case
to consider: a proof ⟨ p, q ⟩ of P ∧ Q can
*only* have been constructed by applying
and.intro to two arguments, here we give
them arbitrary names, x and y; and what
pattern matching does is to match the term
we're given as an argument, (and.intro p q)
with the pattern (and.intro x y), *unifying*
x with p and y with q. That is, if there's
a match, then x becomes bound to p and y
becomes bound to q. In this way, we get at
the fields of the object we were given and
we give the field values names, *so that
we can refer to these objects using these
names in the expression to the right of the
:=, which gives the value that the function
returns "in this case." A little further
on, we'll see examples of case analysis
of objects of types with several constructors.
-/

def elim_right : (and P Q) → Q
| (and.intro x y) := y

/-
To see that our functions appear to be doing
the right thing, let's assume h is bound to a
proof of and P Q (using our definition of and),
and then see that our elim_left and elim_right
functions are returning values of the right
types, namely proofs of P and Q, respectively.

-/
axiom h : and P Q
#check elim_left h
#check elim_right h

/-
We can't really expect to use reduce here
because h is assumed as an axiom, without
specified field values. What happens if you
try to reduce, say, (elim_left h)? The answer
is that such terms are of the right types
but simply will not reduce any further.
-/
#reduce elim_left h
#reduce elim_right h

/-
BASIC ABSTRACT DATA TYPES
-/

/-
An abstract data type associates a type of
object with a set of fundamental operations
on values of that type.
-/

/-
Consider the Boolean type, bool, in Lean. Here
is how it's defined. It's a simple enumerated
type, with just two constant values, ff and tt.

inductive bool : Type
| ff : bool
| tt : bool
-/

/-
Now that we've defined our inductive data type,
we define fundamental operations on values of
this type, and the combination of the type and
this set of operations constitutes an abstract
data type, rudimentary but complete.

Here's an example of a function that operates
on values of type bool: negate. It takes a bool
value and returns one. It's interesting aspect
is that it has to analyze the argument value to
which it is applied in order to decice which of
two possible return values to actually return.
-/

def negate : bool → bool
| ff := tt  -- if argument is ff reduce to tt
| tt := ff  -- if argument is tt reduce to ff

-- here are a few test cases
example : negate tt = ff := rfl
example : negate ff = tt := rfl

/-
We discussed the option type. It has at least
three interesting features: it's polymorphic
(in α); it has *two* constructors; and one of
them takes as an argument a value of type α.

inductive option (α : Type u)
| none : option
| some (val : α) : option
-/

/-
Here's the standard definition of the nat
type in Lean. There are two shapes that a
given nat can have: it is either zero or
it is succ applied to another term of type
nat, we could call it n. And in this second
case, n, being just some nat, could also
be either zero or succ of an even "smaller"
nat. What is guaranteed by the semantics
of inductive definitions is that one will
eventually reach zero after some finite, even
if large. number of steps.

inductive nat
| zero : nat
| succ (n : nat) : nat
-/

/-
We can now put a few pieces together into a
working example. We represent a partial function
from natural numbers to natural numbers as a
total function (all functions in Lean are total)
from nat to option nat. A value of type otion
nat, in turn, is either "none" or "some a." If
the value of the mathematical function on some
argument, a, is defined, and has value b, then
our total function would return (some b). In
the case where the mathematical function is
*undefined*, e.g., at zero, then our total
function applied to that view would return
option.none.

Let part_fun be a partial function of type
ℕ to ℕ, and suppose that at every value n
it's defined to have the value n, except at
zero, at which part_fun is simply undefined.
Here's a standard solution using an option
return type.
-/
def posnat : nat → option nat
/-
Case analysis using pattern matching
on argument. For an argument of type
nat, there are two basis cases: it's
either zero or it's the successor of
some smaller nat.
-/
| nat.zero := none
| n := n

#reduce posnat 5
#reduce posnat 4
#reduce posnat 3
#reduce posnat 2
#reduce posnat 1
#reduce posnat 0

end hidden

/-
To finish up, we started to compare and
contrast the definitions in Lean of = and
of ∧. We've now seen that we implement each
as a parameterized family of propositions.
-/

#check @eq
/-
eq : Π {α : Sort u_1}, α → α → PropLean
-/

#check @and
/-
and : Prop → Prop → Prop
-/

/-
Finally, and very briefly, the ↔ operator (if and only if,
often written as iff): it's like a special case of and, in
that it has one intro rule, and it takes two arguments, but
now they are of type P → Q and Q → P. And with analogy with
and, iff has two elimination rules, so if h is a proof of
P ↔ Q, then h.left is a proof of P → Q, and h.right is a
proof of Q → P.
-/

/-
For example, suppose h is a proof of P ↔ Q
-/
axiom h : P ↔ Q

/-
Now we can see that the elimination rules work
as one should expect.
-/
#check iff.elim_left h
#check iff.mp h   -- weird names but whatever

#check iff.elim_right h
#check iff.mpr h  -- weird names but whatever

/-
Similarly, if we have proofs of P → Q and of
Q → P, then we can compose them into a proof
of P ↔ Q using iff.intro.
-/

axioms (pq : P → Q) (qp : Q → P)
#check iff.intro pq qp

/-
Can you guess how iff is defined in Lean's libraries?
-/

#print iff

/-
`iff P Q`, with notation `P ↔ Q`, is the proposition
asserting that `P` and `Q` are equivalent, that is,
that they have the same truth value.

structure iff (a b : Prop) : Prop :=
intro :: (mp : a → b) (mpr : b → a)
-/

/-
Example: ∧ is associative
-/

example : ∀ ( P Q R : Prop), P ∧ Q ∧ R ↔ (P ∧ Q) ∧ R :=
begin
  intros P Q R,
  split,    -- does apply iff.intro _ _

  -- forward
  sorry,   -- skip proof, fill in later

  -- reverse
  sorry,   -- skip proof, fill in later
end

/-
Example: P ∧ (P ↔ Q) → Q
-/

example : P ∧ (P ↔ Q) → Q :=
begin
  assume h,
  cases h,
  cases h_right,
  exact h_right_mp h_left,
end

/-
The cases tactic does case analysis
on a value in the context, here h.
For each possible way in which h
could have been constructed, you'll
need to show that you can satisfy
the goal. In each case, Lean will
also provide values of the arguments
that that case's constructor would
have to have been given in that case.

Here there is just one constructor,
and.intro, with two arguments, a proof
of P and a proof of P ↔ Q. So in the
case being analyzed, we can assume
we have such values. The rest is
straightforward.
-/


-- ---------------------------------------------------------------------
-- Ejercicio. Realizar las siguientes acciones:
-- 1. Importar la teoría data.set.lattice
-- 2. Importar la teoría data.nat.prime
-- 3. Abrir los espacios de nombre set y nat.
-- ----------------------------------------------------------------------

import data.set.lattice   -- 1
import data.nat.prime     -- 2
open set nat              -- 3

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el conjunto de los números primos.
-- ----------------------------------------------------------------------

def primes : set ℕ := {x | prime x}

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (⋃ p ∈ primes, {x | p^2 ∣ x}) = {x | ∃ p ∈ primes, p^2 ∣ x} :=
-- ----------------------------------------------------------------------

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

example : (⋃ p ∈ primes, {x | p^2 ∣ x}) = {x | ∃ p ∈ primes, p^2 ∣ x} :=
begin
  ext,
  rw mem_bUnion_iff,
  refl,
end

-- Prueba
-- ======

/-
⊢ (⋃ (p : ℕ) (H : p ∈ primes), {x : ℕ | p ^ 2 ∣ x}) =
    {x : ℕ | ∃ (p : ℕ) (H : p ∈ primes), p ^ 2 ∣ x}
  >> ext,
x : ℕ
⊢ (x ∈ ⋃ (p : ℕ) (H : p ∈ primes), {x : ℕ | p ^ 2 ∣ x}) ↔
    x ∈ {x : ℕ | ∃ (p : ℕ) (H : p ∈ primes), p ^ 2 ∣ x}
  >> rw mem_bUnion_iff,
⊢ (∃ (x_1 : ℕ) (H : x_1 ∈ primes), x ∈ {x : ℕ | x_1 ^ 2 ∣ x}) ↔
    x ∈ {x : ℕ | ∃ (p : ℕ) (H : p ∈ primes), p ^ 2 ∣ x}
  >> refl,
no goals
-/

-- Comentario: Se ha usado el lema
-- + mem_bUnion_iff : y ∈ (⋃ x ∈ s, t x) ↔ ∃ x ∈ s, y ∈ t x

-- Comprobación:
universes u v
variable α : Type u
variable β : Type v
variable s : set α
variable t : α → set β
variable y : β
-- #check @mem_bUnion_iff α β s t y

example : y ∈ (⋃ x ∈ s, t x) ↔ ∃ x ∈ s, y ∈ t x :=
mem_bUnion_iff

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

example : (⋃ p ∈ primes, {x | p^2 ∣ x}) = {x | ∃ p ∈ primes, p^2 ∣ x} :=
by { ext, rw mem_bUnion_iff, refl }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (⋃ p ∈ primes, {x | p^2 ∣ x}) = {x | ∃ p ∈ primes, p^2 ∣ x}
-- ----------------------------------------------------------------------

example : (⋃ p ∈ primes, {x | p^2 ∣ x}) = {x | ∃ p ∈ primes, p^2 ∣ x} :=
by { ext, simp }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (⋂ p ∈ primes, {x | ¬ p ∣ x}) ⊆ {x | x < 2}
-- ----------------------------------------------------------------------

example : (⋂ p ∈ primes, {x | ¬ p ∣ x}) ⊆ {x | x < 2} :=
begin
  intro x,
  contrapose!,
  simp,
  apply exists_prime_and_dvd,
end

-- Prueba
-- ======

/-
⊢ (⋂ (p : ℕ) (H : p ∈ primes), {x : ℕ | ¬p ∣ x}) ⊆ {x : ℕ | x < 2}
  >> intro x,
x : ℕ
⊢ (x ∈ ⋂ (p : ℕ) (H : p ∈ primes), {x : ℕ | ¬p ∣ x}) → x ∈ {x : ℕ | x < 2}
  >> contrapose!,
⊢ x ∉ {x : ℕ | x < 2} → (x ∉ ⋂ (p : ℕ) (H : p ∈ primes), {x : ℕ | ¬p ∣ x})
  >> simp,
⊢ 2 ≤ x → (∃ (x_1 : ℕ), x_1 ∈ primes ∧ x_1 ∣ x)
  >> apply exists_prime_and_dvd,
no goals
-/

-- Comentario: Se ha aplicado el lema
-- + exists_prime_and_dvd : 2 ≤ n → (∃ (p : ℕ), p.prime ∧ p ∣ n)

variable n : ℕ
-- #check @exists_prime_and_dvd n

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    (⋃ p ∈ primes, {x | x ≤ p}) = univ
-- ----------------------------------------------------------------------

example : (⋃ p ∈ primes, {x | x ≤ p}) = univ :=
begin
  apply eq_univ_of_forall,
  intro x,
  simp,
  rcases exists_infinite_primes x with ⟨p, pge, primep⟩,
  use [p, primep, pge],
end

-- Prueba
-- ======

/-
⊢ (⋃ (p : ℕ) (H : p ∈ primes), {x : ℕ | x ≤ p}) = univ
  >> apply eq_univ_of_forall,
⊢ ∀ (x : ℕ), x ∈ ⋃ (p : ℕ) (H : p ∈ primes), {x : ℕ | x ≤ p}
  >> intro x,
x : ℕ
⊢ x ∈ ⋃ (p : ℕ) (H : p ∈ primes), {x : ℕ | x ≤ p}
  >> simp,
⊢ ∃ (i : ℕ), i ∈ primes ∧ x ≤ i
  >> rcases exists_infinite_primes x with ⟨p, pge, primep⟩,
x p : ℕ,
pge : x ≤ p,
primep : p.prime
⊢ ∃ (i : ℕ), i ∈ primes ∧ x ≤ i
  >> use [p, primep, pge],
no goals
-/

-- Comentario: Se han usado los lemas
-- + eq_univ_of_forall : (∀ x, x ∈ s) → s = univ
-- + exists_infinite_primes : ∀ (n : ℕ), ∃ (p : ℕ), n ≤ p ∧ p.prime

-- variable α : Type*
-- variable s : set α
-- #check @eq_univ_of_forall α s
-- #check exists_infinite_primes