/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import data.finset.card
import data.multiset.nat_antidiagonal

/-!
# Antidiagonals in ℕ × ℕ as finsets

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

This file defines the antidiagonals of ℕ × ℕ as finsets: the `n`-th antidiagonal is the finset of
pairs `(i, j)` such that `i + j = n`. This is useful for polynomial multiplication and more
generally for sums going from `0` to `n`.

## Notes

This refines files `data.list.nat_antidiagonal` and `data.multiset.nat_antidiagonal`.
-/

namespace finset
namespace nat

/-- The antidiagonal of a natural number `n` is
    the finset of pairs `(i, j)` such that `i + j = n`. -/
def antidiagonal (n : ℕ) : finset (ℕ × ℕ) :=
⟨multiset.nat.antidiagonal n, multiset.nat.nodup_antidiagonal n⟩

/-- A pair (i, j) is contained in the antidiagonal of `n` if and only if `i + j = n`. -/
@[simp] lemma mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} :
  x ∈ antidiagonal n ↔ x.1 + x.2 = n :=
by rw [antidiagonal, mem_def, multiset.nat.mem_antidiagonal]

/-- The cardinality of the antidiagonal of `n` is `n + 1`. -/
@[simp] lemma card_antidiagonal (n : ℕ) : (antidiagonal n).card = n+1 :=
by simp [antidiagonal]

/-- The antidiagonal of `0` is the list `[(0, 0)]` -/
@[simp] lemma antidiagonal_zero : antidiagonal 0 = {(0, 0)} :=
rfl

lemma antidiagonal_succ (n : ℕ) :
  antidiagonal (n + 1) = cons (0, n + 1) ((antidiagonal n).map
  (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ (function.embedding.refl _)))
  (by simp) :=
begin
  apply eq_of_veq,
  rw [cons_val, map_val],
  { apply multiset.nat.antidiagonal_succ },
end

lemma antidiagonal_succ' (n : ℕ) :
  antidiagonal (n + 1) = cons (n + 1, 0) ((antidiagonal n).map
  (function.embedding.prod_map (function.embedding.refl _) ⟨nat.succ, nat.succ_injective⟩))
  (by simp) :=
begin
  apply eq_of_veq,
  rw [cons_val, map_val],
  exact multiset.nat.antidiagonal_succ',
end

lemma antidiagonal_succ_succ' {n : ℕ} :
  antidiagonal (n + 2) =
    cons (0, n + 2)
      (cons (n + 2, 0) ((antidiagonal n).map
        (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ ⟨nat.succ, nat.succ_injective⟩))
        $ by simp) (by simp) :=
by { simp_rw [antidiagonal_succ (n + 1), antidiagonal_succ', finset.map_cons, map_map], refl }

lemma map_swap_antidiagonal {n : ℕ} :
  (antidiagonal n).map ⟨prod.swap, prod.swap_right_inverse.injective⟩ = antidiagonal n :=
eq_of_veq $ by simp [antidiagonal, multiset.nat.map_swap_antidiagonal]

/-- A point in the antidiagonal is determined by its first co-ordinate. -/
lemma antidiagonal_congr {n : ℕ} {p q : ℕ × ℕ} (hp : p ∈ antidiagonal n)
  (hq : q ∈ antidiagonal n) : p = q ↔ p.fst = q.fst :=
begin
  refine ⟨congr_arg prod.fst, (λ h, prod.ext h ((add_right_inj q.fst).mp _))⟩,
  rw mem_antidiagonal at hp hq,
  rw [hq, ← h, hp],
end

lemma antidiagonal.fst_le {n : ℕ} {kl : ℕ × ℕ} (hlk : kl ∈ antidiagonal n) :
  kl.1 ≤ n :=
begin
  rw le_iff_exists_add,
  use kl.2,
  rwa [mem_antidiagonal, eq_comm] at hlk
end

lemma antidiagonal.snd_le {n : ℕ} {kl : ℕ × ℕ} (hlk : kl ∈ antidiagonal n) :
  kl.2 ≤ n :=
begin
  rw le_iff_exists_add,
  use kl.1,
  rwa [mem_antidiagonal, eq_comm, add_comm] at hlk
end

lemma filter_fst_eq_antidiagonal (n m : ℕ) :
  filter (λ x : ℕ × ℕ, x.fst = m) (antidiagonal n) = if m ≤ n then {(m, n - m)} else ∅ :=
begin
  ext ⟨x, y⟩,
  simp only [mem_filter, nat.mem_antidiagonal],
  split_ifs with h h,
  { simp [and_comm, eq_tsub_iff_add_eq_of_le h, add_comm] {contextual := tt} },
  { rw not_le at h,
    simp only [not_mem_empty, iff_false, not_and],
    exact λ hn, ne_of_lt (lt_of_le_of_lt (le_self_add.trans hn.le) h) }
end

lemma filter_snd_eq_antidiagonal (n m : ℕ) :
  filter (λ x : ℕ × ℕ, x.snd = m) (antidiagonal n) = if m ≤ n then {(n - m, m)} else ∅ :=
begin
  have : (λ (x : ℕ × ℕ), x.snd = m) ∘ prod.swap = (λ (x : ℕ × ℕ), x.fst = m),
  { ext, simp },
  rw ←map_swap_antidiagonal,
  simp [filter_map, this, filter_fst_eq_antidiagonal, apply_ite (finset.map _)]
end

section equiv_prod

/-- The disjoint union of antidiagonals `Σ (n : ℕ), antidiagonal n` is equivalent to the product
    `ℕ × ℕ`. This is such an equivalence, obtained by mapping `(n, (k, l))` to `(k, l)`. -/
@[simps] def sigma_antidiagonal_equiv_prod : (Σ (n : ℕ), antidiagonal n) ≃ ℕ × ℕ :=
{ to_fun := λ x, x.2,
  inv_fun := λ x, ⟨x.1 + x.2, x, mem_antidiagonal.mpr rfl⟩,
  left_inv :=
    begin
      rintros ⟨n, ⟨k, l⟩, h⟩,
      rw mem_antidiagonal at h,
      exact sigma.subtype_ext h rfl,
    end,
  right_inv := λ x, rfl }

end equiv_prod

end nat

end finset


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.partition_of_unity
import analysis.convex.combination

/-!
# Partition of unity and convex sets

In this file we prove the following lemma, see `exists_continuous_forall_mem_convex_of_local`. Let
`X` be a normal paracompact topological space (e.g., any extended metric space). Let `E` be a
topological real vector space. Let `t : X → set E` be a family of convex sets. Suppose that for each
point `x : X`, there exists a neighborhood `U ∈ 𝓝 X` and a function `g : X → E` that is continuous
on `U` and sends each `y ∈ U` to a point of `t y`. Then there exists a continuous map `g : C(X, E)`
such that `g x ∈ t x` for all `x`.

We also formulate a useful corollary, see `exists_continuous_forall_mem_convex_of_local_const`, that
assumes that local functions `g` are constants.

## Tags

partition of unity
-/

open set function
open_locale big_operators topology

variables {ι X E : Type*} [topological_space X] [add_comm_group E] [module ℝ E]

lemma partition_of_unity.finsum_smul_mem_convex {s : set X} (f : partition_of_unity ι X s)
  {g : ι → X → E} {t : set E} {x : X} (hx : x ∈ s) (hg : ∀ i, f i x ≠ 0 → g i x ∈ t)
  (ht : convex ℝ t) :
  ∑ᶠ i, f i x • g i x ∈ t :=
ht.finsum_mem (λ i, f.nonneg _ _) (f.sum_eq_one hx) hg

variables [normal_space X] [paracompact_space X] [topological_space E] [has_continuous_add E]
  [has_continuous_smul ℝ E] {t : X → set E}

/-- Let `X` be a normal paracompact topological space (e.g., any extended metric space). Let `E` be
a topological real vector space. Let `t : X → set E` be a family of convex sets. Suppose that for
each point `x : X`, there exists a neighborhood `U ∈ 𝓝 X` and a function `g : X → E` that is
continuous on `U` and sends each `y ∈ U` to a point of `t y`. Then there exists a continuous map
`g : C(X, E)` such that `g x ∈ t x` for all `x`. See also
`exists_continuous_forall_mem_convex_of_local_const`. -/
lemma exists_continuous_forall_mem_convex_of_local (ht : ∀ x, convex ℝ (t x))
  (H : ∀ x : X, ∃ (U ∈ 𝓝 x) (g : X → E), continuous_on g U ∧ ∀ y ∈ U, g y ∈ t y) : ∃
  g : C(X, E), ∀ x, g x ∈ t x :=
begin
  choose U hU g hgc hgt using H,
  obtain ⟨f, hf⟩ := partition_of_unity.exists_is_subordinate is_closed_univ (λ x, interior (U x))
    (λ x, is_open_interior) (λ x hx, mem_Union.2 ⟨x, mem_interior_iff_mem_nhds.2 (hU x)⟩),
  refine ⟨⟨λ x, ∑ᶠ i, f i x • g i x,
    hf.continuous_finsum_smul (λ i, is_open_interior) $ λ i, (hgc i).mono interior_subset⟩,
    λ x, f.finsum_smul_mem_convex (mem_univ x) (λ i hi, hgt _ _ _) (ht _)⟩,
  exact interior_subset (hf _ $ subset_closure hi)
end

/-- Let `X` be a normal paracompact topological space (e.g., any extended metric space). Let `E` be
a topological real vector space. Let `t : X → set E` be a family of convex sets. Suppose that for
each point `x : X`, there exists a vector `c : E` that belongs to `t y` for all `y` in a
neighborhood of `x`. Then there exists a continuous map `g : C(X, E)` such that `g x ∈ t x` for all
`x`. See also `exists_continuous_forall_mem_convex_of_local`. -/
lemma exists_continuous_forall_mem_convex_of_local_const (ht : ∀ x, convex ℝ (t x))
  (H : ∀ x : X, ∃ c : E, ∀ᶠ y in 𝓝 x, c ∈ t y) :
  ∃ g : C(X, E), ∀ x, g x ∈ t x :=
exists_continuous_forall_mem_convex_of_local ht $ λ x,
  let ⟨c, hc⟩ := H x in ⟨_, hc, λ _, c, continuous_on_const, λ y, id⟩


/-  Math40001 : Introduction to university mathematics.

Problem Sheet 2, October 2020.

This is a Lean file. It can be read with the Lean theorem prover.

You can work on this file online via the link at
https://github.com/ImperialCollegeLondon/M40001_lean/blob/master/README.md

or you can install Lean and its maths library following the
instructions at
https://leanprover-community.github.io/get_started.html

and then just clone the project onto your own computer
with `leanproject get ImperialCollegeLondon/M40001_lean`.

There are advantages to installing Lean on your own computer
(for example it's faster), but it's more hassle than
just using it online.

In the below, delete "sorry" and replace it with some
tactics which prove the result.

-/

import data.real.basic -- need real numbers for Q5

-- Q1 prove that ∩ is symmetric
lemma question1 (α : Type) (X Y : set α) : X ∩ Y = Y ∩ X :=
begin

end

-- question 2 defs
def A := {x : ℝ | x ^ 2 < 3}
def B := {x : ℝ | ∃ n : ℤ, x = n ∧ x ^ 2 < 3}
def C := {x : ℝ | x ^ 3 < 3}

-- Change _true to _false and put a ¬ in front
-- of the goal if you think it's false.
-- e.g. if you think 2c is false then don't
-- try to prove it's true, try proving
-- lemma question2c_false : ¬ (A ⊆ C) := ...

-- Some of these are tricky for Lean beginners.

lemma question2a_true : (1 : ℝ)/2 ∈ A ∩ B :=
begin
  sorry
end

lemma question2b_true : (1 : ℝ)/2 ∈ A ∪ B :=
begin
  sorry
end

lemma question2c_true : A ⊆ C :=
begin
  sorry
end

lemma question2d_true : B ⊆ C :=
begin
  sorry
end

lemma question2e_true : C ⊆ A ∪ B :=
begin
  sorry
end

lemma question2f_true : (A ∩ B) ∪ C = (A ∪ B) ∩ C :=
begin
  sorry
end

-- Q3 set-up
variables (X Y : Type)
variable (P : X → Prop)
variable (Q : X → Prop)
variable (R : X → Y → Prop)

-- for Q3 you're going to have to change the right hand
-- side of the ↔ in the statement
-- of the lemma to the answer you think is correct.

lemma question3a : ¬ (∀ x : X, P x ∧ ¬ Q x) ↔ true := -- change `true`!
begin
  sorry
end

lemma question3b : ¬ (∃ x : X, (¬ P x) ∧ Q x) ↔ true := -- change `true`!
begin
  sorry
end

lemma question3c : ¬ (∀ x : X, ∃ y : Y, R x y) ↔ true := -- change `true`!
begin
  sorry
end

example (f : ℝ → ℝ) (x : ℝ) :
  ¬ (∀ ε : ℝ, ε > 0 → ∃ δ : ℝ, δ > 0 ∧ ∀ y : ℝ, abs (y - x) < δ → abs (f y -f x) < ε )
↔ -- change next line to what you think the answer is
true :=
begin
  sorry
end

-- change _true to _false in 4a, 4b if you think the opposite is true
-- and stick a `¬` in front of it
lemma question4a_true : ∀ x : ℝ, ∃ y : ℝ, x + y = 2 :=
begin
  sorry
end

lemma question4b_true : ∃ y : ℝ, ∀ x : ℝ, x + y = 2 :=
begin
  sorry
end

-- similarly for Q5 -- change _true to _false and add in a negation if you
-- want to prove that the proposition in the question is false.
lemma question5a_true : ∃ x ∈ (∅ : set ℕ), 2 + 2 = 5 :=
begin
  sorry
end

lemma question5b_true : ∀ x ∈ (∅ : set ℕ), 2 + 2 = 5 :=
begin
  sorry
end


/-
Fill in the sorry.

section
  variable A : Type
  variable f : A → A
  variable P : A → Prop
  variable  h : ∀ x, P x → P (f x)

  -- Show the following:
  example : ∀ y, P y → P (f (f y)) :=
  sorry
end
-/

section
  variable A : Type
  variable f : A → A
  variable P : A → Prop
  variable  h : ∀ x, P x → P (f x)

  -- Show the following:
  example : ∀ y, P y → P (f (f y)) :=
  assume y: A,
  assume Py: P y,
  have Pfy_to_Pffy: P(f(y)) → P(f(f(y))), from h(f(y)),
  have Pfy: P(f(y)), from h(y)(Py),
  show P(f(f(y))), from Pfy_to_Pffy(Pfy)
end
-/


import Mathlib.Init.Data.Nat.Basic
import Mathlib.Tactic.Ring
import Mathlib.Init.Data.Nat.Lemmas

/- Div : functions and theorems relative to the division and modulo operations -/

namespace Nat
  def divisible (b a : Nat) : Prop := a % b = 0

  -- TODO : more general version of this will be easy to implement with access to dec_trivial (currently not yet in mathlib4) -> https://github.com/leanprover-community/mathlib/blob/master/src/tactic/dec_trivial.lean
  theorem mod_2_poss (a : Nat) : a % 2 = 0 ∨ a % 2 = 1 :=
    mod_two_eq_zero_or_one a

  theorem mod_3_poss (a : Nat) : a % 3 = 0 ∨ a % 3 = 1 ∨ a % 3 = 2 :=
    -- copied from Mathlib.Init.Data.Nat.Lemmas (and modified from mod_two_eq_zero_or_one)
    match a % 3, @Nat.mod_lt a 3 (by simp) with
    | 0,   _ => Or.inl rfl
    | 1,   _ => Or.inr (Or.inl rfl)
    | 2,   _ => Or.inr (Or.inr rfl)

  theorem mod_4_poss (a : Nat) : a % 4 = 0 ∨ a % 4 = 1 ∨ a % 4 = 2 ∨ a % 4 = 3 :=
    -- copied from Mathlib.Init.Data.Nat.Lemmas (and modified from mod_two_eq_zero_or_one)
    match a % 4, @Nat.mod_lt a 4 (by simp) with
    | 0,   _ => Or.inl rfl
    | 1,   _ => Or.inr (Or.inl rfl)
    | 2,   _ => Or.inr (Or.inr (Or.inl rfl))
    | 3,   _ => Or.inr (Or.inr (Or.inr rfl))

  theorem mod_5_poss (a : Nat) : a % 5 = 0 ∨ a % 5 = 1 ∨ a % 5 = 2 ∨ a % 5 = 3 ∨ a % 5 = 4 :=
    -- copied from Mathlib.Init.Data.Nat.Lemmas (and modified from mod_two_eq_zero_or_one)
    match a % 5, @Nat.mod_lt a 5 (by simp) with
    | 0,   _ => Or.inl rfl
    | 1,   _ => Or.inr (Or.inl rfl)
    | 2,   _ => Or.inr (Or.inr (Or.inl rfl))
    | 3,   _ => Or.inr (Or.inr (Or.inr (Or.inl rfl)))
    | 4,   _ => Or.inr (Or.inr (Or.inr (Or.inr rfl)))

  -- TODO : find equivalent in mathlib / prove it
  axiom mod_rewrite {a b m : Nat} : a % b = m ↔ ∃ k, a = b * k + m

  theorem div_plus_div {a b c : Nat} : divisible c a → divisible c b → divisible c (a + b) := by
    intros h₁ h₂
    rw [divisible, mod_rewrite] at h₁ h₂
    have ⟨n, hn⟩ := h₁
    have ⟨m, hm⟩ := h₂
    rw [hn, hm]
    apply mod_rewrite.mpr
    exact ⟨n+m, by ring⟩

end Nat


import .love03_forward_proofs_demo

/- # LoVe Exercise 4: Functional Programming -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: Reverse of a List

We define a new accumulator-based version of `reverse`. The first argument,
`as`, serves as the accumulator. This definition is __tail-recursive__, meaning
that compilers and interpreters can easily optimize the recursion away,
resulting in more efficient code. -/

def accurev {α : Type} : list α → list α → list α
| as []        := as
| as (x :: xs) := accurev (x :: as) xs

/- 1.1. Our intention is that `accurev [] xs` should be equal to `reverse xs`.
But if we start an induction, we quickly see that the induction hypothesis is
not strong enough. Start by proving the following generalization (using the
`induction'` tactic or pattern matching): -/

lemma accurev_eq_reverse_append {α : Type} :
  ∀as xs : list α, accurev as xs = reverse xs ++ as
| as []        := by refl
| as (x :: xs) := by simp [reverse, accurev, accurev_eq_reverse_append _ xs]

/- 1.2. Derive the desired equation. -/

lemma accurev_eq_reverse {α : Type} (xs : list α) :
  accurev [] xs = reverse xs :=
by simp [accurev_eq_reverse_append]

/- 1.3. Prove the following property.

Hint: A one-line inductionless proof is possible. -/

lemma accurev_accurev {α : Type} (xs : list α) :
  accurev [] (accurev [] xs) = xs :=
by simp [accurev_eq_reverse, reverse_reverse]

/- 1.4. Prove the following lemma by structural induction, as a "paper" proof.
This is a good exercise to develop a deeper understanding of how structural
induction works (and is good practice for the final exam).

    lemma accurev_eq_reverse_append {α : Type} :
      ∀as xs : list α, accurev as xs = reverse xs ++ as

Guidelines for paper proofs:

We expect detailed, rigorous, mathematical proofs. You are welcome to use
standard mathematical notation or Lean structured commands (e.g., `assume`,
`have`, `show`, `calc`). You can also use tactical proofs (e.g., `intro`,
`apply`), but then please indicate some of the intermediate goals, so that we
can follow the chain of reasoning.

Major proof steps, including applications of induction and invocation of the
induction hypothesis, must be stated explicitly. For each case of a proof by
induction, you must list the inductive hypotheses assumed (if any) and the goal
to be proved. Minor proof steps corresponding to `refl`, `simp`, or `cc` need
not be justified if you think they are obvious (to humans), but you should say
which key lemmas they depend on. You should be explicit whenever you use a
function definition or an introduction rule for an inductive predicate. -/

/- We perform the proof by structural induction on `xs`, generalizing `as`.

Case `[]`: The goal is `accurev as [] = reverse [] ++ as`. The left-hand side
is `as` by definition of `accurev`. The right-hand side is `as` by definition
of `reverse` and `++`.

Case `x :: xs`: The goal is `accurev as (x :: xs) = reverse (x :: xs) ++ as`.
The induction hypothesis is `∀as, accurev as xs = reverse xs ++ as`.

Let us simplify the goal's left-hand side:

      accurev as (x :: xs)
    = accurev (x :: as) xs        -- by definition of `accurev`
    = reverse xs ++ (x :: as)     -- by the induction hypothesis

Now let us massage the right-hand side so that it matches the simplified
left-hand side:

      reverse (x :: xs) ++ as
    = (reverse xs ++ [x]) ++ as   -- by definition of `reverse`
    = reverse xs ++ ([x] ++ as)   -- by associativity of `++`
    = reverse xs ++ (x :: as)     -- by definition of `++`

The two sides are equal. QED -/

/- ## Question 2: Drop and Take

The `drop` function removes the first `n` elements from the front of a list. -/

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

/- Its relative `take` returns a list consisting of the the first `n` elements
at the front of a list.

2.1. Define `take`.

To avoid unpleasant surprises in the proofs, we recommend that you follow the
same recursion pattern as for `drop` above. -/

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

#eval take 0 [3, 7, 11]   -- expected: []
#eval take 1 [3, 7, 11]   -- expected: [3]
#eval take 2 [3, 7, 11]   -- expected: [3, 7]
#eval take 3 [3, 7, 11]   -- expected: [3, 7, 11]
#eval take 4 [3, 7, 11]   -- expected: [3, 7, 11]

#eval take 2 ["a", "b", "c"]   -- expected: ["a", "b"]

/- 2.2. Prove the following lemmas, using `induction'` or pattern matching.
Notice that they are registered as simplification rules thanks to the `@[simp]`
attribute. -/

@[simp] lemma drop_nil {α : Type} :
  ∀n : ℕ, drop n ([] : list α) = []
| 0       := by refl
| (_ + 1) := by refl

@[simp] lemma take_nil {α : Type} :
  ∀n : ℕ, take n ([] : list α) = []
| 0       := by refl
| (_ + 1) := by refl

/- 2.3. Follow the recursion pattern of `drop` and `take` to prove the
following lemmas. In other words, for each lemma, there should be three cases,
and the third case will need to invoke the induction hypothesis.

The first case is shown for `drop_drop`. Beware of the fact that there are three
variables in the `drop_drop` lemma (but only two arguments to `drop`).

Hint: The `refl` tactic might be useful in the third case of `drop_drop`. -/

lemma drop_drop {α : Type} :
  ∀(m n : ℕ) (xs : list α), drop n (drop m xs) = drop (n + m) xs
| 0       n xs        := by refl
| (_ + 1) _ []        := by simp [drop]
| (m + 1) n (x :: xs) :=
  begin
    simp [drop, drop_drop m n xs],
    refl
  end

lemma take_take {α : Type} :
  ∀(m : ℕ) (xs : list α), take m (take m xs) = take m xs
| 0       _         := by refl
| (_ + 1) []        := by refl
| (m + 1) (x :: xs) := by simp [take, take_take m xs]

lemma take_drop {α : Type} :
  ∀(n : ℕ) (xs : list α), take n xs ++ drop n xs = xs
| 0       _         := by refl
| (_ + 1) []        := by refl
| (m + 1) (x :: xs) := by simp [take, drop, take_drop m]

/- ## Question 3: A Type of λ-Terms

3.1. Define an inductive type corresponding to the untyped λ-terms, as given
by the following context-free grammar:

    term ::= 'var' string        -- variable (e.g., `x`)
           | 'lam' string term   -- λ-expression (e.g., `λx, t`)
           | 'app' term term     -- application (e.g., `t u`) -/

inductive term : Type
| var : string → term
| lam : string → term → term
| app : term → term → term

/- 3.2. Register a textual representation of the type `term` as an instance of
the `has_repr` type class. Make sure to supply enough parentheses to guarantee
that the output is unambiguous. -/

def term.repr : term → string
| (term.var s)   := s
| (term.lam s t) := "(λ" ++ s ++ ", " ++ term.repr t ++ ")"
| (term.app t u) := "(" ++ term.repr t ++ " " ++ term.repr u ++ ")"

@[instance] def term.has_repr : has_repr term :=
{ repr := term.repr }

/- 3.3. Test your textual representation: -/

#eval (term.lam "x" (term.app (term.app (term.var "y") (term.var "x"))
    (term.var "x")))
  -- should print something like `(λx, ((y x) x))`

end LoVe


import game.sup_inf.level01

namespace xena -- hide
-- World name : Sup and Inf

/-
# Chapter 3 : Sup and Inf

## Level 2

-/

/-
The completeness axiom on the reals states that any non-empty subset
$X \subseteq \mathbb{R}$ that is bounded above has a least upper bound.
Here we explore the converse statement: any set of reals that has a supremum is non-empty and
has an upper bound. The second part of the result is trivial, but showing that the
set is non-empty will ask you to use techniques learned in the first world.
-/

-- definition is_upper_bound' (S : set ℝ) (x : ℝ) := x ∈ upper_bounds S
-- (Definition above deprecated? GT)

definition is_lub (S : set ℝ) (x : ℝ) := is_upper_bound S x ∧
∀ y : ℝ, is_upper_bound S y → x ≤ y

definition has_lub (S : set ℝ) := ∃ x, is_lub S x

local attribute [instance] classical.prop_decidable --hide

/- Lemma
Any set of reals that has a supremum is non-empty and bounded above.
-/
theorem nonempty_and_bounded_of_has_LUB (S : set ℝ) (H : has_lub S) :
  (S ≠ ∅) ∧ (∃ x, is_upper_bound S x) :=
begin
  cases H with b Hb,
  split,
  intro t,
  have H1 : (b-1) ∈ upper_bounds S,
  change ∀ x ∈ S, x ≤ (b-1),
  by_contradiction hn,
  push_neg at hn,
  cases hn with d hd,
  cases hd with y hy,
  rw t at y,
  exact y,
  unfold is_lub at Hb,
  have HH := Hb.2 (b-1) H1,
  linarith,

  existsi b,
  exact Hb.1,

end

end xena -- hide

/-
cases H with b Hb,
  -- b is LUB, Hb is proof it's LUB
  split,
  { -- first prove S is not empty, by contradiction as usual with empty sets
    intro Hempty,
    have H1 : (b-1) ∈ upper_bounds S,
    change ∀ x ∈ S, x ≤ (b-1),
    by_contradiction hn,
    push_neg at hn,
    cases hn with x h1,
    cases h1 with h11 h12,
    rw Hempty at h11,
    exact h11,
    unfold is_lub at Hb,
    have HH := Hb.2 (b-1) H1, -- b - 1 is an upper bound
    linarith,
  },
  {
     existsi b,
     exact Hb.1,
  },
  done
-/


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar el límite de la suma de dos sucesiones
-- convergentes es la suma de los límites.
-- ----------------------------------------------------------------------

import .Definicion_de_convergencia

variables {s t : ℕ → ℝ} {a b c : ℝ}

lemma converges_to_add
  (cs : converges_to s a)
  (ct : converges_to t b)
  : converges_to (λ n, s n + t n) (a + b) :=
begin
  intros ε εpos,
  dsimp,
  have ε2pos : 0 < ε / 2,
    { linarith },
  cases cs (ε / 2) ε2pos with Ns hs,
  cases ct (ε / 2) ε2pos with Nt ht,
  clear cs ct ε2pos εpos,
  use max Ns Nt,
  intros n hn,
  have nNs : n ≥ Ns,
    { exact le_of_max_le_left hn },
  specialize hs n nNs,
  have nNt : n ≥ Nt,
    { exact le_of_max_le_right hn },
  specialize ht n nNt,
  clear hn nNs nNt Ns Nt,
  calc abs (s n + t n - (a + b))
           = abs ((s n - a) + (t n -  b))   : by { congr, ring }
       ... ≤ abs (s n - a) + abs (t n -  b) : by apply abs_add
       ... < ε / 2 + ε / 2                  : by linarith [hs, ht]
       ... = ε                              : by apply add_halves,
end

-- Prueba
-- ======

/-
s t : ℕ → ℝ,
a b : ℝ,
cs : converges_to s a,
ct : converges_to t b
⊢ converges_to (λ (n : ℕ), s n + t n) (a + b)
  >> intros ε εpos,
ε : ℝ,
εpos : ε > 0
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs ((λ (n : ℕ), s n + t n) n - (a + b)) < ε
  >> dsimp,
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (s n + t n - (a + b)) < ε
  >> have ε2pos : 0 < ε / 2,
| 2 goals
| s t : ℕ → ℝ,
| a b : ℝ,
| cs : converges_to s a,
| ct : converges_to t b,
| ε : ℝ,
| εpos : ε > 0
| ⊢ 0 < ε / 2
|   >>   { linarith },
s t : ℕ → ℝ,
a b : ℝ,
cs : converges_to s a,
ct : converges_to t b,
ε : ℝ,
εpos : ε > 0,
ε2pos : 0 < ε / 2
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (s n + t n - (a + b)) < ε
  >> cases cs (ε / 2) ε2pos with Ns hs,
ε2pos : 0 < ε / 2,
Ns : ℕ,
hs : ∀ (n : ℕ), n ≥ Ns → abs (s n - a) < ε / 2
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (s n + t n - (a + b)) < ε
  >> cases ct (ε / 2) ε2pos with Nt ht,
Nt : ℕ,
ht : ∀ (n : ℕ), n ≥ Nt → abs (t n - b) < ε / 2
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (s n + t n - (a + b)) < ε
  >> clear cs ct ε2pos εpos,
s t : ℕ → ℝ,
a b ε : ℝ,
Ns : ℕ,
hs : ∀ (n : ℕ), n ≥ Ns → abs (s n - a) < ε / 2,
Nt : ℕ,
ht : ∀ (n : ℕ), n ≥ Nt → abs (t n - b) < ε / 2
⊢ ∃ (N : ℕ), ∀ (n : ℕ), n ≥ N → abs (s n + t n - (a + b)) < ε
  >> use max Ns Nt,
⊢ ∀ (n : ℕ), n ≥ max Ns Nt → abs (s n + t n - (a + b)) < ε
  >> intros n hn,
n : ℕ,
hn : n ≥ max Ns Nt
⊢ abs (s n + t n - (a + b)) < ε
  >> have nNs : n ≥ Ns,
| 2 goals
| s t : ℕ → ℝ,
| a b ε : ℝ,
| Ns : ℕ,
| hs : ∀ (n : ℕ), n ≥ Ns → abs (s n - a) < ε / 2,
| Nt : ℕ,
| ht : ∀ (n : ℕ), n ≥ Nt → abs (t n - b) < ε / 2,
| n : ℕ,
| hn : n ≥ max Ns Nt
| ⊢ n ≥ Ns
|   >>   { exact le_of_max_le_left hn },
nNs : n ≥ Ns
⊢ abs (s n + t n - (a + b)) < ε
  >> specialize hs n nNs,
hs : abs (s n - a) < ε / 2
⊢ abs (s n + t n - (a + b)) < ε
  >> have nNt : n ≥ Nt,
| 2 goals
| s t : ℕ → ℝ,
| a b ε : ℝ,
| Ns Nt : ℕ,
| ht : ∀ (n : ℕ), n ≥ Nt → abs (t n - b) < ε / 2,
| n : ℕ,
| hn : n ≥ max Ns Nt,
| nNs : n ≥ Ns,
| hs : abs (s n - a) < ε / 2
| ⊢ n ≥ Nt
|   >>   { exact le_of_max_le_right hn },
s t : ℕ → ℝ,
a b ε : ℝ,
Ns Nt : ℕ,
ht : ∀ (n : ℕ), n ≥ Nt → abs (t n - b) < ε / 2,
n : ℕ,
hn : n ≥ max Ns Nt,
nNs : n ≥ Ns,
hs : abs (s n - a) < ε / 2,
nNt : n ≥ Nt
⊢ abs (s n + t n - (a + b)) < ε
  >> specialize ht n nNt,
ht : abs (t n - b) < ε / 2
⊢ abs (s n + t n - (a + b)) < ε
  >> clear hn nNs nNt Ns Nt,
s t : ℕ → ℝ,
a b ε : ℝ,
n : ℕ,
hs : abs (s n - a) < ε / 2,
ht : abs (t n - b) < ε / 2
⊢ abs (s n + t n - (a + b)) < ε
  >> calc abs (s n + t n - (a + b))
  >>          = abs ((s n - a) + (t n -  b))   : by { congr, ring }
  >>      ... ≤ abs (s n - a) + abs (t n -  b) : by apply abs_add
  >>      ... < ε / 2 + ε / 2                  : by linarith [hs, ht]
  >>      ... = ε                              : by apply add_halves,
no goals
-/

-- Comentario. Se han usado los lemas:
-- + le_of_max_le_left : max a b ≤ c → a ≤ c
-- + le_of_max_le_right : max a b ≤ c → b ≤ c
-- + abs_add a b : abs (a + b) ≤ abs a + abs b
-- + add_halves a : a / 2 + a / 2 = a

-- Comprobación
-- #check @le_of_max_le_left _ _ a b c
-- #check @le_of_max_le_right _ _ a b c
-- #check @abs_add _ _ a b
-- #check @add_halves _ _ a


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import data.matrix.basic

/-!
# Trace of a matrix

This file defines the trace of a matrix, the map sending a matrix to the sum of its diagonal
entries.

See also `linear_algebra.trace` for the trace of an endomorphism.

## Tags

matrix, trace, diagonal

-/

open_locale big_operators matrix

namespace matrix

variables {ι m n p : Type*} {α R S : Type*}
variables [fintype m] [fintype n] [fintype p]

section add_comm_monoid
variables [add_comm_monoid R]

/-- The trace of a square matrix. For more bundled versions, see:
* `matrix.trace_add_monoid_hom`
* `matrix.trace_linear_map`
-/
def trace (A : matrix n n R) : R := ∑ i, diag A i

variables (n R)
@[simp] lemma trace_zero : trace (0 : matrix n n R) = 0 :=
(finset.sum_const (0 : R)).trans $ smul_zero _
variables {n R}

@[simp] lemma trace_add (A B : matrix n n R) : trace (A + B) = trace A + trace B :=
finset.sum_add_distrib

@[simp] lemma trace_smul [monoid α] [distrib_mul_action α R] (r : α) (A : matrix n n R) :
  trace (r • A) = r • trace A :=
finset.smul_sum.symm

@[simp] lemma trace_transpose (A : matrix n n R) : trace Aᵀ = trace A := rfl

@[simp] lemma trace_conj_transpose [star_add_monoid R] (A : matrix n n R) :
  trace Aᴴ = star (trace A) :=
(star_sum _ _).symm

variables (n α R)
/-- `matrix.trace` as an `add_monoid_hom` -/
@[simps]
def trace_add_monoid_hom : matrix n n R →+ R :=
{ to_fun := trace, map_zero' := trace_zero n R, map_add' := trace_add }

/-- `matrix.trace` as a `linear_map` -/
@[simps]
def trace_linear_map [semiring α] [module α R] : matrix n n R →ₗ[α] R :=
{ to_fun := trace, map_add' := trace_add, map_smul' := trace_smul }
variables {n α R}

@[simp] lemma trace_list_sum (l : list (matrix n n R)) : trace l.sum = (l.map trace).sum :=
map_list_sum (trace_add_monoid_hom n R) l

@[simp] lemma trace_multiset_sum (s : multiset (matrix n n R)) : trace s.sum = (s.map trace).sum :=
map_multiset_sum (trace_add_monoid_hom n R) s

@[simp] lemma trace_sum (s : finset ι) (f : ι → matrix n n R) :
  trace (∑ i in s, f i) = ∑ i in s, trace (f i) :=
map_sum (trace_add_monoid_hom n R) f s

end add_comm_monoid

section add_comm_group
variables [add_comm_group R]

@[simp] lemma trace_sub (A B : matrix n n R) : trace (A - B) = trace A - trace B :=
finset.sum_sub_distrib

@[simp] lemma trace_neg (A : matrix n n R) : trace (-A) = -trace A :=
finset.sum_neg_distrib

end add_comm_group

section one
variables [decidable_eq n] [add_comm_monoid_with_one R]

@[simp] lemma trace_one : trace (1 : matrix n n R) = fintype.card n :=
by simp_rw [trace, diag_one, pi.one_def, finset.sum_const, nsmul_one, finset.card_univ]

end one

section mul

@[simp] lemma trace_transpose_mul [add_comm_monoid R] [has_mul R]
  (A : matrix m n R) (B : matrix n m R) : trace (Aᵀ ⬝ Bᵀ) = trace (A ⬝ B) := finset.sum_comm

lemma trace_mul_comm [add_comm_monoid R] [comm_semigroup R] (A : matrix m n R) (B : matrix n m R) :
  trace (A ⬝ B) = trace (B ⬝ A) :=
by rw [←trace_transpose, ←trace_transpose_mul, transpose_mul]

lemma trace_mul_cycle [non_unital_comm_semiring R]
  (A : matrix m n R) (B : matrix n p R) (C : matrix p m R) :
  trace (A ⬝ B ⬝ C) = trace (C ⬝ A ⬝ B) :=
by rw [trace_mul_comm, matrix.mul_assoc]

lemma trace_mul_cycle' [non_unital_comm_semiring R]
  (A : matrix m n R) (B : matrix n p R) (C : matrix p m R) :
  trace (A ⬝ (B ⬝ C)) = trace (C ⬝ (A ⬝ B)) :=
by rw [←matrix.mul_assoc, trace_mul_comm]

@[simp] lemma trace_col_mul_row [non_unital_non_assoc_semiring R] (a b : n → R) :
  trace (col a ⬝ row b) = dot_product a b :=
by simp [dot_product, trace]

end mul

section fin
variables [add_comm_monoid R]

/-! ### Special cases for `fin n`

While `simp [fin.sum_univ_succ]` can prove these, we include them for convenience and consistency
with `matrix.det_fin_two` etc.
-/

@[simp] lemma trace_fin_zero (A : matrix (fin 0) (fin 0) R) : trace A = 0 :=
rfl

lemma trace_fin_one (A : matrix (fin 1) (fin 1) R) : trace A = A 0 0 :=
add_zero _

lemma trace_fin_two (A : matrix (fin 2) (fin 2) R) : trace A = A 0 0 + A 1 1 :=
congr_arg ((+) _) (add_zero (A 1 1))

lemma trace_fin_three (A : matrix (fin 3) (fin 3) R) : trace A = A 0 0 + A 1 1 + A 2 2 :=
by { rw [← add_zero (A 2 2), add_assoc], refl }

end fin

end matrix


/-

(X) We agree with sharing this code with the classmates.

Alunos:
 - Lucas Emanuel Resck Domingues
 - Lucas Machado Moschen

Considere uma fonte de água inesgotável e duas garrafas, uma de 5 e
outra de 7 litros, as quais não possuem quaisquer marcações que
possibilitem medidas de volumes intermediários às suas respectivas
capacidades. O formato das mesmas também impede o uso de aparelhos de
medição indireta, assim como não há uma balança disponível.

Considerando essas condições, pergunta-se se é possível armazenar o
volume exato de 6 litros de água.

É possível que você já conheça a solução deste problema ou mesmo saiba
que, no caso geral de duas garrafas com capacidade que representem
números primos entre si, pode-se medir qualquer volume inteiro até a
capacidade da maior garrafa. De qq forma, pretende-se construir
primeiro um conjunto de sentenças que representem o problema e somente
depois, via o uso do conceito de consequência lógica, verificar se é
possível medir 6 litros nas condições estipuladas. Neste exercício,
pede-se apenas a formalização em FOL.

-/

/- How to represent something that changes in time? Now the bottles
are filled up, byt later they can be empty. We can represent time in
the domain, through states, that change in time. Let's represent first
state as z ("zero") in the domain. Each element of the domain will
have a "sucessor". This is analogous to the Piano axioms.-/

constant T : Type
constant z : T
constant s : T → T

/- Let's use G predicate to infer: G(t, x, y) means that exists a
possibility that, in state t, the big bottle (the one with 7L) will
have x liters and the little bottle (5L) will have y liters. That is,
there is a sequence of steps where we can reach x and y liters at step
t. For example (and for formalization), at step 0, we can state that
both bottles are empty: -/

constant G : T → ℕ → ℕ → Prop
constant start : G z 0 0

/- Given a step, which bottle can be filled up in next step,
independently of how many liters it has and which step it is. -/

constant fill1 : ∀ t : T, ∀ x : ℕ, ∀ y : ℕ, (G t x y) → (G (s t) 7 y)
constant fill2 : ∀ t : T, ∀ x : ℕ, ∀ y : ℕ, (G t x y) → (G (s t) x 5)

-- In the same way, they can be empty:

constant empty1 : ∀ t : T, ∀ x : ℕ, ∀ y : ℕ, (G t x y) → (G (s t) 0 y)
constant empty2 : ∀ t : T, ∀ x : ℕ, ∀ y : ℕ, (G t x y) → (G (s t) x 0)

/- But how to tranfer water between these bottles? We have to
condition in the volume of the bottles at step t, because one may be
filled up or the other may become empty: -/

constant transfer1 : ∀ t : T, ∀ x : ℕ, ∀ y : ℕ, (G t x y) ∧ (y ≥ 7 - x) → (G (s t) 7 (y - (7 - x)))
constant transfer2 : ∀ t : T, ∀ x : ℕ, ∀ y : ℕ, (G t x y) ∧ (y < 7 - x) → (G (s t) (x + y) 0)

constant transfer3 : ∀ t : T, ∀ x : ℕ, ∀ y : ℕ, (G t x y) ∧ (x ≥ 5 - y) → (G (s t) (x - (5 - y)) 5)
constant transfer4x : ∀ t : T, ∀ x : ℕ, ∀ y : ℕ, (G t x y) ∧ (x < 5 - y) → (G (s t) 0 (x + y))

/- What was asked to prove is if it's possible to reach 6L with this
process. -/

theorem sixLiters : ∃ t : T, (G t 6 0) := sorry


-- Inverso_del_inverso_en_grupos.lean
-- Inverso del inverso en grupos
-- José A. Alonso Jiménez
-- Sevilla, 7 de julio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Sea G un grupo y a ∈ G. Demostrar que
--    (a⁻¹)⁻¹ = a
-- ---------------------------------------------------------------------

import algebra.group.basic

universe  u
variables {G : Type u} [group G]
variables {a b : G}

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

example : (a⁻¹)⁻¹ = a :=
calc (a⁻¹)⁻¹
     = (a⁻¹)⁻¹ * 1         : (mul_one (a⁻¹)⁻¹).symm
 ... = (a⁻¹)⁻¹ * (a⁻¹ * a) : congr_arg ((*) (a⁻¹)⁻¹) (inv_mul_self a).symm
 ... = ((a⁻¹)⁻¹ * a⁻¹) * a : (mul_assoc _ _ _).symm
 ... = 1 * a               : congr_arg (* a) (inv_mul_self a⁻¹)
 ... = a                   : one_mul a

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

example : (a⁻¹)⁻¹ = a :=
calc (a⁻¹)⁻¹
     = (a⁻¹)⁻¹ * 1         : by simp only [mul_one]
 ... = (a⁻¹)⁻¹ * (a⁻¹ * a) : by simp only [inv_mul_self]
 ... = ((a⁻¹)⁻¹ * a⁻¹) * a : by simp only [mul_assoc]
 ... = 1 * a               : by simp only [inv_mul_self]
 ... = a                   : by simp only [one_mul]

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

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

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

example : (a⁻¹)⁻¹ = a :=
begin
  apply mul_eq_one_iff_inv_eq.mp,
  exact mul_left_inv a,
end

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

example : (a⁻¹)⁻¹ = a :=
mul_eq_one_iff_inv_eq.mp (mul_left_inv a)

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

example : (a⁻¹)⁻¹ = a:=
inv_inv a

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

example : (a⁻¹)⁻¹ = a:=
by simp

-- Referencia
-- ==========

-- Propiedad 3.20 del libro "Abstract algebra: Theory and applications"
-- de Thomas W. Judson.
-- http://abstract.ups.edu/download/aata-20200730.pdf#page=49


-- Formula_de_Gauss_de_la_suma.lean
-- Fórmula de Gauss de la suma
-- José A. Alonso Jiménez
-- Sevilla, 24 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- La fórmula de Gauss para la suma de los primeros números naturales es
--    0 + 1 + 2 + ... + (n-1) = n(n-1)/2
--
-- En un ejercicio anterior https://bit.ly/2Xu3IKh se ha demostrado
-- dicha fórmula por inducción. Otra forma de demostrarla, sin usar
-- inducción, es la siguiente: La suma se puede escribir de dos maneras
--    S = 0     + 1     + 2     + ... + (n-3) + (n-2) + (n-1)
--    S = (n-1) + (n-2) + (n-3) + ... + 2     + 1     + 0
-- Al sumar, se observa que cada par de números de la misma columna da
-- como suma (n-1), y puesto que hay n columnas en total, se sigue
--    2S = n(n-1)
-- lo que prueba la fórmula.
--
-- Demostrar la fórmula de Gauss siguiendo el procedimiento anterior.
-- ---------------------------------------------------------------------

import algebra.big_operators.basic
import algebra.big_operators.intervals

open_locale big_operators
open finset nat

variables (n i : ℕ)

-- Lema auxiliar
-- =============

-- Se usará el siguiente lema auxiliar del que se presentan distintas
-- demostraciones.

-- 1ª demostración del lema auxiliar
example : ∀ x, x ∈ range n → x + (n - 1 - x) = n - 1 :=
begin
  intros x hx,
  replace hx : x < n := mem_range.1 hx,
  replace hx : x ≤ n - 1 := le_pred_of_lt hx,
  exact nat.add_sub_of_le hx,
end

-- 2ª demostración del lema auxiliar
example : ∀ x, x ∈ range n → x + (n - 1 - x) = n - 1 :=
begin
  intros x hx,
  exact nat.add_sub_of_le (le_pred_of_lt (mem_range.1 hx)),
end

-- 3ª demostración del lema auxiliar
lemma auxiliar : ∀ x, x ∈ range n → x + (n - 1 - x) = n - 1 :=
λ x hx, nat.add_sub_of_le (le_pred_of_lt (mem_range.1 hx))

-- Lema principal
-- ==============

-- 1ª demostración
example :
  (∑ i in range n, i) * 2 = n * (n - 1) :=
calc (∑ i in range n, i) * 2
     = (∑ i in range n, i) + (∑ i in range n, i)
         : mul_two _
 ... = (∑ i in range n, i) + (∑ i in range n, (n - 1 - i))
         : congr_arg2 (+) rfl (sum_range_reflect id n).symm
 ... = ∑ i in range n, (i + (n - 1 - i))
         : sum_add_distrib.symm
 ... = ∑ i in range n, (n - 1)
         : sum_congr rfl (auxiliar n)
 ... = card (range n) • (n - 1)
         : sum_const (n - 1)
 ... = card (range n) * (n - 1)
         : nat.nsmul_eq_mul _ _
 ... = n * (n - 1)
         : congr_arg2 (*) (card_range n) rfl

-- 2ª demostración
example :
  (∑ i in range n, i) * 2 = n * (n - 1) :=
calc (∑ i in range n, i) * 2
     = (∑ i in range n, i) + (∑ i in range n, (n - 1 - i))
         : by rw [sum_range_reflect (λ i, i) n, mul_two]
 ... = ∑ i in range n, (i + (n - 1 - i))
         : sum_add_distrib.symm
 ... = ∑ i in range n, (n - 1)
         : sum_congr rfl (auxiliar n)
 ... = n * (n - 1)
         : by rw [sum_const, card_range, nat.nsmul_eq_mul]


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.finsupp.basic

/-!
# The pointwise product on `finsupp`.

For the convolution product on `finsupp` when the domain has a binary operation,
see the type synonyms `add_monoid_algebra`
(which is in turn used to define `polynomial` and `mv_polynomial`)
and `monoid_algebra`.
-/

noncomputable theory
open_locale classical

open finset

universes u₁ u₂ u₃ u₄ u₅
variables {α : Type u₁} {β : Type u₂} {γ : Type u₃} {δ : Type u₄} {ι : Type u₅}

namespace finsupp

/-! ### Declarations about the pointwise product on `finsupp`s -/

section
variables [mul_zero_class β]

/-- The product of `f g : α →₀ β` is the finitely supported function
  whose value at `a` is `f a * g a`. -/
instance : has_mul (α →₀ β) := ⟨zip_with (*) (mul_zero 0)⟩

@[simp] lemma mul_apply {g₁ g₂ : α →₀ β} {a : α} : (g₁ * g₂) a = g₁ a * g₂ a :=
rfl

lemma support_mul {g₁ g₂ : α →₀ β} : (g₁ * g₂).support ⊆ g₁.support ∩ g₂.support :=
begin
  intros a h,
  simp only [mul_apply, mem_support_iff] at h,
  simp only [mem_support_iff, mem_inter, ne.def],
  rw ←not_or_distrib,
  intro w,
  apply h,
  cases w; { rw w, simp },
end

instance : mul_zero_class (α →₀ β) :=
{ zero      := 0,
  mul       := (*),
  mul_zero  := λ f, by { ext, simp only [mul_apply, zero_apply, mul_zero], },
  zero_mul  := λ f, by { ext, simp only [mul_apply, zero_apply, zero_mul], }, }

end

instance [semigroup_with_zero β] : semigroup_with_zero (α →₀ β) :=
{ mul       := (*),
  mul_assoc := λ f g h, by { ext, simp only [mul_apply, mul_assoc], },
  ..(infer_instance : mul_zero_class (α →₀ β)) }

instance [non_unital_non_assoc_semiring β] : non_unital_non_assoc_semiring (α →₀ β) :=
{ left_distrib := λ f g h, by { ext, simp only [mul_apply, add_apply, left_distrib] {proj := ff} },
  right_distrib := λ f g h,
    by { ext, simp only [mul_apply, add_apply, right_distrib] {proj := ff} },
  ..(infer_instance : mul_zero_class (α →₀ β)),
  ..(infer_instance : add_comm_monoid (α →₀ β)) }

instance [non_unital_semiring β] : non_unital_semiring (α →₀ β) :=
{ ..(infer_instance : semigroup (α →₀ β)),
  ..(infer_instance : non_unital_non_assoc_semiring (α →₀ β)) }

end finsupp


/-
Today we will see in that proofs can be understood as formal
objects in their own right.

We will start to make our way through the valid rules of
inference from our unit on propositional logic. We will
emphasize that they are rules for combining and deriving
Boolean truth values. In predicate logic, by contrast, we
will reinterpret them as rules for combining and deriving
*proofs*. In predicate logic, the existence of a proof is
our new basis for deciding whether or not a proposition
can be judged to be true.

In particular, we will look at how to (1) *construct* and
(2) *use* given or assumed proofs of two simple forms of
propositions, namely conjunctions and disjunctions.

We will see that we can view proofs as *computational*
objects.

In particular, we will see that we can view a proof of a
conjunction, P ∧ Q, as a *pair* of proofs (a proof of P
*and* a proof of Q), and thus as a value of a *product*
type. We will then view a proof of a disjunction, P ∨ Q,
as *either* an object constructed from a proof of P *or*
an object built from a proof of Q, and thus a value of a
*sum* type.

Understanding proof construction and manipulation as
computations involving logical types (propositions) and
values (proofs) will give you the precise understanding
of deductive reasoning in predicate logic that you need
to handle a very wide variety of "prove it" problems in
the years to come, whether or not (and more likely not)
you use an automated proof assistant such as Lean or its
formalized proofs.
-/

/-
To begin we will review our polymorphic product (pair)
type. We will then see that the ∧ (and) connective in
predicate logic can be understood and formalized as a
completely analogous polymorphic *logical* type. It's
one costructor implements the and introduction rule,
and its two projection functions implement the two
and elimination rules.
-/

namespace hidden

-- review -- prod abstract data type!

-- be sure you fully understand this type definition
inductive prod (α β : Type) : Type
| mk (a : α) (b : β) : prod

-- here's a named example of a value of this type
def pair1 := prod.mk 1 1

#reduce pair1

-- by the way, we can use "example" for unnamed values
example : prod nat nat := prod.mk 1 1

-- the first, or left, projection function
-- implemented by pattern matching (aka elimination!)
def fst {α β : Type} : prod α β → α
| (prod.mk a b) := a

-- the second, or right, projection function
def snd {α β : Type} : prod α β → β
| (prod.mk a b) := b

-- and a function that from one pair derives its swap
def swap  {α β : Type} : prod α β → prod β α
| (prod.mk a b) := prod.mk b a

/-
Our implementation of the and connective and its rules
of inference (introduction and elimination rules) in
exactly the same way, except that our and polymorphic
pair type now lives in "Prop," the unverse of logical
types (propositions), rather than in "Type", which as
we know is the universe of computational types.

As a reminder from propositional logic, here are three
rules of reasoning that we showed to be semantically valid.

def and_intro := P >> Q >> P ∧ Q
def and_elim_left := P ∧ Q >> P
def and_elim_right := P ∧ Q >> Q

In propositional logic, we read these rules as involving
truth values: e.g., if P "is true" and Q "is true" then
"P ∧ Q" "is true". We now reconceptualize these rules to
involve proofs. E.g., If we have (or assume we have) a
proof, p, of P, and we have (or assume we have) a proof,
q, of Q, then we can construct a proof, ⟨p, q⟩, of P ∧ Q.
That's the and introduction rule. Similarly, if we have
a proof (pair!), ⟨p, q⟩, then from it we can derive a
proof, p, of P, and a proof, q, of Q, by nothing more
complex than projection: we destructure the pair and
return one of the other other of its two components.
-/

structure and (P Q : Prop) : Prop :=    -- Prop not Type!
intro :: (left : P) (right : Q)         -- and.intro rule

-- one poassible way to write left elimination rule
def and_elim_left {P Q : Prop} : and P Q → P
| (and.intro p q) := p

-- here's another, with elim_left in the "and" namespace
-- note that we use projection function from "structure"
def and.elim_left {P Q : Prop}  (pq : and P Q) : P :=
pq.left

-- and here is the right elimination rule in two forms
def and_elim_right {P Q : Prop} : and P Q → Q
| (and.intro p q) := q

def and.elim_right {P Q : Prop}  (pq : and P Q) : Q :=
pq.right

/-
A note on notation. The Lean libraries define the and
connective exactly as we've done here. In addition, the
Lean library defined ∧ as an infix notation for "and".
We won't define that notation here, so wherever we want
to use the and connective, e.g., for P ∧ Q, we'll have
to write "and P Q". Same with or.
-/

-- tests

def pf1 : and (1=1) (eq 0 0) :=  -- 1=1 and 0=0
  and.intro (eq.refl 1) (eq.refl 0) -- proof of it!

-- We now see that pf1 is basically a pair of proofs
#reduce pf1

/- OR

We also formalize the logical connective, ∨, as an
inductive type with two (logical) type arguments,
P and Q (two propositions). The both ∧ and ∨ take
two propositions (logical types) as arguments and
yield a larger proposition (logical type). We then
define constructors to implement the introduction
rules for the given connective.

To build a proof of P ∧ Q, we need proofs of both
P and of Q. To build a proof of P ∨ Q it suffices
to have either a proof of P or a proof of Q.

Here are the propositional logic rules we validated
in the last section.

def or_intro_left := P >> P ∨ Q
def or_intro_right := Q >> P ∨ Q
def or_elim := P ∨ Q >> (P >> R) >> (Q >> R) >> R

We now reconceptualize these rules are rules about
how *proofs* can be built and derived.
-/

#check or

inductive or (P Q : Prop) : Prop
| inl {} (p : P) : or   -- Q is implicit
| inr {} (q : Q) : or   -- P is implicit

-- example, proof of 0=0 ∨ 1=0
example : or (eq 0 0) (eq 1 0) :=
or.inl (eq.refl 0)

#check @or.elim

example : or (eq 1 0) (eq 0 0) :=
or.inr (eq.refl 0)

/-
Prove that 1=1 and 2=2.

Q: What's the form of this proposition?
A: Conjunction. Main connective is and.
Q: What rule of reasoning apply?
A: The "and" introduction and elimination rules.
Q: What is the form of the overall proof?
A: and.intro p q, where p is a proof of P and q is a proof of Q.
Q: So what remains to be done?
A: It will now suffice to produce a proof of 1=1 and one of 2=2.
Q: How to prove 1=1?
A: By the reflexive property of equality.
Q: How to prove 2 =2.
A: Same way.
QED!
-/

-- Here it is formally

example : and (1=1) (2=2) :=
  and.intro (eq.refl 1) (eq.refl 2)

/-
The following versions of the introductions rules take two explicit
arguments each: a *proposition* for which a proof is *not* given and
a proof of the other proposition. Notice carefully the change in which
type argument is implicit in each case. Sometimes Lean can't infer
from, say, a proof, p, of P, what disjunction, P ∨ Q, is being proved
(because it can't figure out what Q is). In such cases, you need to
provide the Q type explicitly. These functions are useful in such cases.
-/
def or.intro_left {P : Prop} (Q : Prop) (p : P) : or P Q :=
or.inl p

def or.intro_right (P : Prop) {Q : Prop} (q : Q) : or P Q :=
or.inr q

/-
Prove 1=0 or 1=1.

Proof: We apply the or introduction on the right rule to a
proof of 1=1. Now all that remains is to to that 1=1. This is
by applying the reflexive property of equality (to the value,
1).
-/

-- Here is this proof formalized
example : or (1=0) (1=1) := or.inr (eq.refl 1)
example : or (1=0) (1=1) := or.intro_right (1=0) (eq.refl 1)

def x : ℕ := 1
example : ℕ := 1

/-
NEXT UP: ∀, →
-/

/-
************************************************************
Universal generalizations. Propositions starting with forall.
************************************************************
-/

/-
Introduction rule: To prove "∀ (p : P), Q" show that if you *assume*
you're given an arbitrary but specific p, you can construct a proof
of Q. This is the ∀ introduction rule of natural deduction.
-/
example : ∀ (n : ℕ), or (n = 0) (n ≠ 0) :=
  λ (n : ℕ),
    match n with
    | nat.zero := or.inl (eq.refl 0)
    | (nat.succ _) := _    -- Homework
    end

/-
Proof:
We start by assuming that we're given an arbitrary but specific
natural number, n. Now in this context, all that remains to be
proved is that n = 0 or n ≠ 0.
-/

/-
Prove that for any propositions, P and Q, P ∧ Q → P ∨ Q
-/

def aProp := ∀ (P Q : Prop), and P Q → or P Q

/-
We start by assuming that P and Q are arbitrary but specific
propositions. In this context, what remains to be proved is
the following implication: and P Q → or P Q. To prove this is
to prove an implication. We do this in the same way we prove
a ∀: by assuming that we're given a proof of the premise, P,
and showing that, in that context, we can construct a proof
of the conclusion, Q.
-/

lemma and_imp_or_1 : aProp :=
  λ (P Q : Prop),
    λ (pq : and P Q),
      or.inl (and.elim_left pq)

lemma and_imp_or_2  : aProp :=
  λ (P Q : Prop),
    λ (pq : and P Q),
      or.inr (and.elim_right pq)

example : and_imp_or_1 = and_imp_or_2 := eq.refl and_imp_or_2

/-
Prove that the "and" connective is commutative.
-/

theorem and_commutes : ∀ {P Q : Prop}, and P Q → and Q P :=
λ (P Q : Prop),
  λ (pq : and P Q),
    and.intro
      (pq.right)
      (pq.left)

/-
Assume that P and Q are arbitary but specific propositions.
We are to show that P ∧ Q → Q ∧ P. Suppose we have a proof,
pq, of P ∧ Q. In this context we need to prove that we can
construct a proof of Q and P. We do this by applying the and
introduction rule to a proof of P and to a proof of Q. What
remains to be proven is that there is a proof of P and a proof
of Q. But we can get these by applying the left and right and
eliminations rules to our proof, pq, of P ∧ Q.
-/

/-
If a proof of a ∀ or → proposition is a function in Lean,
can we apply these functions to arguments to get results?
The answer is yes, absolutely, and this idea is in fact
the *elimination* rule for ∀ and →. If you're given a
proof, pf, of either ∀ (p : P), Q, or of P → Q, which are
in fact equivalent(!), then you can apply pf to a proof or
value, p : P, to obtain a corresponding value/proof of Q.

As an example, let's apply our proof that and is commutative
-/
lemma oneeq1_and_2eq2 : and (1=1) (2=2) :=
  and.intro (eq.refl 1) (eq.refl 2)

#reduce oneeq1_and_2eq2

/-
We now use the elimination rule for ∀/→ by *applying* the
*general* proof of commutative of and to a *specific* proof
of (and 1=1 2=2) to obtain a specific proof of (and 2=2 1=1)!
-/
#reduce and_commutes oneeq1_and_2eq2

/-
The *elimination* rule for ∀ all and implication is "apply!"
-/

/-
This principal is seen very clearly in the proof of the
rule of reasoning that Aristotle called "modus ponens."
It states that if, for any propositions P and Q, you know
that P → Q is true and you also know that P is true then
you can conclude that Q is true. If when it's raining the
streets are wet (P → Q) and it's raining (P) then it must
be the case that the streets are wet (Q). We now prove that
this is a valid form of reasoning.
-/

theorem arrow_elim : ∀ {P Q : Prop}, (P → Q) → P → Q :=
λ (P Q : Prop),
  λ (p2q : P → Q),
    λ (p : P),
      p2q p       ---<<< apply proof of P→Q to proof of P!

/--- TODAY ---/

/-
Propositions that use ¬
-/

/-
Suppose you want to prove ¬P. We have to show that there's no proof of P.
Key strategy: Proof by negation. Assume that P is true, and show that this
assumption leads to a contradiction. Equivalent to a proof of false. So the
idea is this: assume that there is a proof of P and show that this enables
you to construct a proof of false.

¬ P ==== P → false
-/

example : 0 ≠ 1 :=
/- ¬ (0 = 1) -/
/- (0 = 1) → false -/
λ (h : 0 = 1),
  match h with /- NO CASES! -/ end

theorem mt : ∀ {P Q}, (P → Q) → (¬Q → ¬P) :=
λ P Q,
  λ (h : P → Q),
    λ (nq : ¬Q),
      λ (p : P),
       nq (h p)

theorem non_contradiction: ∀ (P : Prop), ¬ (P ∧ ¬ P) :=
  λ P,                    -- forall introduction
    λ (h : P ∧ ¬P),       -- proof by negation
      let p := (h.left) in -- and.elim_left
      let np := (h.right) in -- and.elim_right
      (np p)

theorem zornz : ∀ (n : ℕ), or (n = 0) (n ≠ 0) :=
λ (n : ℕ),
  match n with
  | nat.zero := or.inl (eq.refl 0)
  | (nat.succ n') := or.inr _         -- complete this proof
  end

/-
Propositions that use ∃
-/

example : ∃ n, n = 0 := exists.intro 0 (eq.refl 0)

example : ∃ n, n^2 = 25 := exists.intro 5 rfl

example : ∃ x : nat, ∃ y: nat, ∃ z : ℕ, x^2 +y^2 = z^2 :=
exists.intro 3
  (exists.intro 4
    (exists.intro 5 (rfl)))

/-
Propositions that use both ∃ and ∀
-/

/- Still to do:

def iff_intro := (P >> Q) >> (Q >> P) >> (P ↔ Q)
def iff_intro' := (P >> Q) ∧ (Q >> P) >> (P ↔ Q)
def iff_elim_left := (P ↔ Q) >> (P >> Q)
def iff_elim_right := (P ↔ Q) >> (Q >> P)
def syllogism := (P >> Q) >> (Q >> R) >> (P >> R)
def modus_tollens := (P >> Q) >> (¬ Q >> ¬ P)
def neg_elim := (¬ ¬ P) >> P         -- not a constructive rule
def excluded_middle := P ∨ (¬ P)     -- not a constructive rule
def neg_intro := (P >> pFalse) >> (¬ P)
def true_intro : pExp := pTrue
def false_elim := pFalse >> P
-/

end hidden


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

import field_theory.normal

/-

# Normal extensions

Normal extensions are splitting fields. They play a role in Galois theory
because they correspond to normal subgroups via the fundamental theorem.
In Lean, normal implies algebraic.

Say F/E is an extension of fields

-/

variables (E F : Type) [field E] [field F] [algebra E F]

section is_normal

-- Say furthermore F/E is normal

variable [normal E F]

-- Then F/E is algebraic

example (f : F) : is_algebraic E f := normal.is_algebraic infer_instance f

-- and all min polys split

open polynomial

example (f : F) : splits (algebra_map E F) (minpoly E f) := normal.splits infer_instance f

end is_normal

-- A finite extension is normal iff it's the splitting field of a polynomial

open_locale polynomial
open polynomial

example [finite_dimensional E F] : normal E F ↔ ∃ p : E[X], is_splitting_field E F p :=
⟨λ h, by exactI normal.exists_is_splitting_field E F, λ ⟨p, hp⟩, by exactI normal.of_is_splitting_field p⟩

/-

Note that in that proof I had to use `by exactI` which jumps into tactic mode, resets the instance
cache (because I've just `intro`ed something which should be in it but isn't), and jumps back
into term mode.

PS the proof of `normal.of_is_splitting_field` is a 60 line monster.

## Normal closures

Say E ⊆ F ⊆ Ω is a tower of field extensions. The normal closure of F/E in Ω is naturally a subfield of
Ω containing `F`, and there's a special structure for this: `intermediate_field F Ω`, which we'll
see in the fundamental theorem.

-/

noncomputable theory

-- Say E ⊆ F ⊆ Ω
variables (Ω : Type) [field Ω] [algebra E Ω] [algebra F Ω] [is_scalar_tower E F Ω]

example : intermediate_field F Ω := normal_closure E F Ω

-- Note that `normal_closure E F Ω` is a term (of type `intermediate_field F Ω`) but it has a coercion
-- to a type, and that type has a field structure and is normal over `E` if `Ω/E` is normal

example [normal E Ω] : normal E (normal_closure E F Ω) := normal_closure.normal E F Ω


/-
Copyright (c) 2022 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp
-/
import linear_algebra.matrix.spectrum
import linear_algebra.quadratic_form.basic

/-! # Positive Definite Matrices

This file defines positive definite matrices and connects this notion to positive definiteness of
quadratic forms.

## Main definition

 * `matrix.pos_def` : a matrix `M : matrix n n R` is positive definite if it is hermitian
   and `xᴴMx` is greater than zero for all nonzero `x`.

-/

namespace matrix

variables {R : Type*} [ordered_semiring R] [star_ring R] {n : Type*} [fintype n]

open_locale matrix

/-- A matrix `M : matrix n n R` is positive definite if it is hermitian
   and `xᴴMx` is greater than zero for all nonzero `x`. -/
def pos_def (M : matrix n n R) :=
M.is_hermitian ∧ ∀ x : n → R, x ≠ 0 → 0 < dot_product (star x) (M.mul_vec x)

lemma pos_def_of_to_quadratic_form' [decidable_eq n] {M : matrix n n ℝ}
  (hM : M.is_symm) (hMq : M.to_quadratic_form'.pos_def) :
  M.pos_def :=
begin
  refine ⟨hM, λ x hx, _⟩,
  simp only [to_quadratic_form', quadratic_form.pos_def, bilin_form.to_quadratic_form_apply,
    matrix.to_bilin'_apply'] at hMq,
  apply hMq x hx,
end

lemma pos_def_to_quadratic_form' [decidable_eq n] {M : matrix n n ℝ} (hM : M.pos_def) :
  M.to_quadratic_form'.pos_def :=
begin
  intros x hx,
  simp only [to_quadratic_form', bilin_form.to_quadratic_form_apply, matrix.to_bilin'_apply'],
  apply hM.2 x hx,
end

end matrix

namespace quadratic_form

variables {n : Type*} [fintype n]

lemma pos_def_of_to_matrix'
  [decidable_eq n] {Q : quadratic_form ℝ (n → ℝ)} (hQ : Q.to_matrix'.pos_def) :
  Q.pos_def :=
begin
  rw [←to_quadratic_form_associated ℝ Q,
      ←bilin_form.to_matrix'.left_inv ((associated_hom _) Q)],
  apply matrix.pos_def_to_quadratic_form' hQ
end

lemma pos_def_to_matrix' [decidable_eq n] {Q : quadratic_form ℝ (n → ℝ)} (hQ : Q.pos_def) :
  Q.to_matrix'.pos_def :=
begin
  rw [←to_quadratic_form_associated ℝ Q,
    ←bilin_form.to_matrix'.left_inv ((associated_hom _) Q)] at hQ,
  apply matrix.pos_def_of_to_quadratic_form' (is_symm_to_matrix' Q) hQ,
end

end quadratic_form


/-
In this module, we define a numerical expression type and a parser for this type.
-/

import .parsing

namespace exlean

inductive nexpr
| num : ℕ → nexpr
| nadd : nexpr → nexpr → nexpr
| nmul : nexpr → nexpr → nexpr

open nexpr

example : nexpr := num 10

example : nexpr := nmul (num 10) (num 20)

def nexpr_to_string : nexpr → string
  | (num n) := to_string n
  | (nadd a b) := "(" ++ (nexpr_to_string a) ++ " + " ++ (nexpr_to_string b) ++ ")"
  | (nmul a b) := "(" ++ (nexpr_to_string a) ++ " × " ++ (nexpr_to_string b) ++ ")"

instance : has_repr nexpr := ⟨nexpr_to_string⟩

#eval nadd (num 5) (nmul (num 10) (num 20))

-- `eval_nexpr' t` evaluates the term `t : nexpr` to an integer.
def eval_nexpr' : nexpr → ℕ
  | (num n) := n
  | (nadd a b) := (eval_nexpr' a) + (eval_nexpr' b)
  | (nmul a b) := (eval_nexpr' a) * (eval_nexpr' b)

example : eval_nexpr' (nmul (num 10) (num 20)) = 200 := rfl

/-
Let's parse this type
-/
open parser

/-
`eval_nexpr p inp` parses the string `inp` using the parser `p` and returns either some natural
number representing the parsed value or none if the parsing of `inp` failed.
-/
def eval_nexpr : Parser nexpr → string → option ℕ
  | (Parser.P p) inp := match p inp with
                          | none := none
                          | some (v,out) := eval_nexpr' v
                        end

-- `nump` parses natural number expressions.
meta def nump : Parser nexpr :=
  do  n ← natural,
      return (num n)

#eval eval_nexpr nump "123" -- some 123

#eval parse nump "123 + 5" -- some (123, "+ 5")

#eval parse nump "+ 5" -- fail

/-
The `old_school` parser has no support for order-of-precedence or parentheses.
-/
meta def old_school : Parser nexpr :=
  (do a ← nump,
      symbol "+",
      b ← old_school,
      return (nadd a b)) <|>
  (do a ← nump,
      symbol "*",
      b ← old_school,
      return (nmul a b) ) <|> nump

#eval parse old_school "2 * 3 * 5" -- some ((2 × (3 × 5)), "")

#eval eval_nexpr old_school "2 * 3 * 5" -- some 30

#eval parse old_school "1 + 2 + 3 * 7 + 10" -- some ((1 + (2 + (3 × (7 + 10)))), "")

#eval eval_nexpr old_school "1 + 2 + 3 * 7 + 10" -- some 54

#eval parse old_school "7 * 8 + 2 + 3 * 7 + 10"  -- some ((7 × (8 + (2 + (3 × (7 + 10))))), "")

#eval eval_nexpr old_school "7 * 8 + 2 + 3 * 7 + 10" -- some 427

/-
`brackets_parser` improves `old_school` by introducing parentheses.
-/
meta def brackets_parser : Parser nexpr :=
  (do symbol "(",
      xs ← brackets_parser,
      symbol ")",
      (do symbol "*", ys ← brackets_parser, return (nmul xs ys)) <|>
      (do symbol "+", ys ← brackets_parser, return (nadd xs ys)) <|>
      return xs) <|>
  (do a ← nump,
      symbol "+",
      b ← old_school,
      return (nadd a b)) <|>
  (do a ← nump,
      symbol "*",
      b ← old_school,
      return (nmul a b) ) <|> nump

#eval parse brackets_parser "(1 + 2) + (3 * (7 + 5)) + 10" -- some (((1 + 2) + ((3 × (7 + 5)) + 10)), "")

#eval eval_nexpr brackets_parser "(1 + 2) + (3 * (7 + 5)) + 10" -- some 24

inductive nexpr_index : Type
  | nexpr_type : nexpr_index
  | nterm_type : nexpr_index
  | nfactor_type : nexpr_index

open nexpr_index

meta def nexpr_parser_aux : nexpr_index → Parser nexpr
| nexpr_type := do  t ← nexpr_parser_aux nterm_type,
                    (do symbol "+",
                        e ← nexpr_parser_aux nexpr_type,
                        return (nadd t e)) <|> return t
| nterm_type := do  f ← nexpr_parser_aux nfactor_type,
                    (do symbol "*",
                        t ← nexpr_parser_aux nterm_type,
                        return (nmul f t)) <|> return f
| nfactor_type := (do symbol "(",
                      e ← nexpr_parser_aux nexpr_type,
                      symbol ")",
                      return e) <|> nump

meta def nexpr_parser : Parser nexpr := nexpr_parser_aux nexpr_type

#eval eval_nexpr nexpr_parser  "1 + 2 + 3 * 7 + 5 + 10" -- 39

#eval eval_nexpr nexpr_parser  "1 + 2 + 3 * (7 + 5) + 10" -- 49

end exlean


import tactic

/-
Tactics you may consider
-intro
-cases
-exact
-have
-clear
-/

variables P Q R :  Prop

theorem basic_logic : (P → Q) ∧ (Q → R) → (P → R) :=
begin
    intros h,
    have hpq : P → Q,
    exact h.left,
    have hqr : Q → R,
    exact h.right,
    clear h,
    intro hp,
    have hq : Q,
    exact hpq hp,
    exact hqr hq,
end

/- Alternatively -/
example : (P → Q) ∧ (Q → R) → (P → R) :=
begin
    intros h,
    cases h with hpq hqr,
    intro hp,
    exact (hqr (hpq (hp))),
end


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

import group_theory.free_abelian_group
import data.finsupp.basic

/-!
# Isomorphism between `free_abelian_group X` and `X →₀ ℤ`

In this file we construct the canonical isomorphism between `free_abelian_group X` and `X →₀ ℤ`.
We use this to transport the notion of `support` from `finsupp` to `free_abelian_group`.

## Main declarations

- `free_abelian_group.equiv_finsupp`: group isomorphism between `free_abelian_group X` and `X →₀ ℤ`
- `free_abelian_group.coeff`: the multiplicity of `x : X` in `a : free_abelian_group X`
- `free_abelian_group.support`: the finset of `x : X` that occur in `a : free_abelian_group X`

-/

noncomputable theory

open_locale big_operators

variables {X : Type*}

/-- The group homomorphism `free_abelian_group X →+ (X →₀ ℤ)`. -/
def free_abelian_group.to_finsupp : free_abelian_group X →+ (X →₀ ℤ) :=
free_abelian_group.lift $ λ x, finsupp.single x (1 : ℤ)

/-- The group homomorphism `(X →₀ ℤ) →+ free_abelian_group X`. -/
def finsupp.to_free_abelian_group : (X →₀ ℤ) →+ free_abelian_group X :=
finsupp.lift_add_hom $ λ x, (smul_add_hom ℤ (free_abelian_group X)).flip (free_abelian_group.of x)

open finsupp free_abelian_group

@[simp] lemma finsupp.to_free_abelian_group_comp_single_add_hom (x : X) :
  finsupp.to_free_abelian_group.comp (finsupp.single_add_hom x) =
    (smul_add_hom ℤ (free_abelian_group X)).flip (of x) :=
begin
  ext,
  simp only [add_monoid_hom.coe_comp, finsupp.single_add_hom_apply, function.comp_app,
    one_smul, to_free_abelian_group, finsupp.lift_add_hom_apply_single]
end

@[simp] lemma free_abelian_group.to_finsupp_comp_to_free_abelian_group :
  to_finsupp.comp to_free_abelian_group = add_monoid_hom.id (X →₀ ℤ) :=
begin
  ext x y, simp only [add_monoid_hom.id_comp],
  rw [add_monoid_hom.comp_assoc, finsupp.to_free_abelian_group_comp_single_add_hom],
  simp only [to_finsupp, add_monoid_hom.coe_comp, finsupp.single_add_hom_apply,
    function.comp_app, one_smul, lift.of, add_monoid_hom.flip_apply,
    smul_add_hom_apply, add_monoid_hom.id_apply],
end

@[simp] lemma finsupp.to_free_abelian_group_comp_to_finsupp :
  to_free_abelian_group.comp to_finsupp = add_monoid_hom.id (free_abelian_group X) :=
begin
  ext,
  rw [to_free_abelian_group, to_finsupp, add_monoid_hom.comp_apply, lift.of,
    lift_add_hom_apply_single, add_monoid_hom.flip_apply, smul_add_hom_apply, one_smul,
    add_monoid_hom.id_apply],
end

@[simp] lemma finsupp.to_free_abelian_group_to_finsupp {X} (x : free_abelian_group X) :
  x.to_finsupp.to_free_abelian_group = x :=
by rw [← add_monoid_hom.comp_apply, finsupp.to_free_abelian_group_comp_to_finsupp,
  add_monoid_hom.id_apply]

namespace free_abelian_group
open finsupp

variable {X}

@[simp]

@[simp] lemma to_finsupp_to_free_abelian_group (f : X →₀ ℤ) :
  f.to_free_abelian_group.to_finsupp = f :=
by rw [← add_monoid_hom.comp_apply, to_finsupp_comp_to_free_abelian_group, add_monoid_hom.id_apply]

variable (X)

/-- The additive equivalence between `free_abelian_group X` and `(X →₀ ℤ)`. -/
@[simps]
def equiv_finsupp : free_abelian_group X ≃+ (X →₀ ℤ) :=
{ to_fun := to_finsupp,
  inv_fun := to_free_abelian_group,
  left_inv := to_free_abelian_group_to_finsupp,
  right_inv := to_finsupp_to_free_abelian_group,
  map_add' := to_finsupp.map_add }

variable {X}

/-- `coeff x` is the additive group homomorphism `free_abelian_group X →+ ℤ`
that sends `a` to the multiplicity of `x : X` in `a`. -/
def coeff (x : X) : free_abelian_group X →+ ℤ :=
(finsupp.apply_add_hom x).comp to_finsupp

/-- `support a` for `a : free_abelian_group X` is the finite set of `x : X`
that occur in the formal sum `a`. -/
def support (a : free_abelian_group X) : finset X :=
a.to_finsupp.support

lemma mem_support_iff (x : X) (a : free_abelian_group X) :
  x ∈ a.support ↔ coeff x a ≠ 0 :=
by { rw [support, finsupp.mem_support_iff], exact iff.rfl }

lemma not_mem_support_iff (x : X) (a : free_abelian_group X) :
  x ∉ a.support ↔ coeff x a = 0 :=
by { rw [support, finsupp.not_mem_support_iff], exact iff.rfl }

@[simp] lemma support_zero : support (0 : free_abelian_group X) = ∅ :=
by simp only [support, finsupp.support_zero, add_monoid_hom.map_zero]

@[simp] lemma support_of (x : X) : support (of x) = {x} :=
by simp only [support, to_finsupp_of, finsupp.support_single_ne_zero (one_ne_zero)]

@[simp] lemma support_neg (a : free_abelian_group X) : support (-a) = support a :=
by simp only [support, add_monoid_hom.map_neg, finsupp.support_neg]

@[simp] lemma support_zsmul (k : ℤ) (h : k ≠ 0) (a : free_abelian_group X) :
  support (k • a) = support a :=
begin
  ext x,
  simp only [mem_support_iff, add_monoid_hom.map_zsmul],
  simp only [h, zsmul_int_int, false_or, ne.def, mul_eq_zero]
end

@[simp] lemma support_nsmul (k : ℕ) (h : k ≠ 0) (a : free_abelian_group X) :
  support (k • a) = support a :=
by { apply support_zsmul k _ a, exact_mod_cast h }

open_locale classical

lemma support_add (a b : free_abelian_group X) : (support (a + b)) ⊆ a.support ∪ b.support :=
begin
  simp only [support, add_monoid_hom.map_add],
  apply finsupp.support_add
end

end free_abelian_group


-- Opuesto_de_cero.lean
-- Si R es un anillo, entonces -0 = 0.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 8-septiembre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si R es un anillo, entonces
--    -0 = 0
-- ----------------------------------------------------------------------

import algebra.ring

variables {R : Type*} [ring R]

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

example : (-0 : R) = 0 :=
begin
  have h : 0 - 0 = (-0 : R) := zero_sub 0,
  calc (-0 : R)
       = 0 - 0    : h.symm
   ... = -(0 - 0) : (neg_sub (0 : R) 0).symm
   ... = -(-0)    : congr_arg (λ x, -x) h
   ... = 0        : neg_neg 0
end

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

example : (-0 : R) = 0 :=
begin
  have h : 0 - 0 = (-0 : R) := by rw zero_sub,
  calc (-0 : R)
       = 0 - 0    : by rw h
   ... = -(0 - 0) : by rw neg_sub
   ... = -(-0)    : by {congr; rw h}
   ... = 0        : by rw neg_neg
end

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

example : (-0 : R) = 0 :=
by simpa only [zero_sub, neg_neg] using (neg_sub (0 : R) 0).symm

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

example : (-0 : R) = 0 :=
neg_zero

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

example : (-0 : R) = 0 :=
by simp

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

example : (-0 : R) = 0 :=
begin
  apply neg_eq_of_add_eq_zero_right,
  rw add_zero,
end

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

example : (-0 : R) = 0 :=
neg_eq_of_add_eq_zero_right (add_zero 0)


-- Conmutatividad_del_infimo.lean
-- Si R es un retículo y x, y ∈ R, entonces x ⊓ y = y ⊓ x.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 12-octubre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Sea R un retículo. Demostrar que si x, y ∈ R, entonces
--     x ⊓ y = y ⊓ x
-- ----------------------------------------------------------------------

import order.lattice

variables {R : Type*} [lattice R]
variables x y z : R

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

lemma aux1 : x ⊓ y ≤ y ⊓ x :=
begin
  have h1 : x ⊓ y ≤ y,
    by exact inf_le_right,
  have h2 : x ⊓ y ≤ x,
    by exact inf_le_left,
  show x ⊓ y ≤ y ⊓ x,
    by exact le_inf h1 h2,
end

example : x ⊓ y = y ⊓ x :=
begin
  have h1 : x ⊓ y ≤ y ⊓ x,
    by exact aux1 x y,
  have h2 : y ⊓ x ≤ x ⊓ y,
    by exact aux1 y x,
  show x ⊓ y = y ⊓ x,
    by exact le_antisymm h1 h2,
end

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

lemma aux2 : x ⊓ y ≤ y ⊓ x :=
le_inf inf_le_right inf_le_left

example : x ⊓ y = y ⊓ x :=
le_antisymm (aux2 x y) (aux2 y x)

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

lemma aux3 : x ⊓ y ≤ y ⊓ x :=
begin
  apply le_inf,
  apply inf_le_right,
  apply inf_le_left,
end

example : x ⊓ y = y ⊓ x :=
begin
  apply le_antisymm,
  apply aux3,
  apply aux3,
end

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

example : x ⊓ y = y ⊓ x :=
by apply le_antisymm; simp

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

example : x ⊓ y = y ⊓ x :=
inf_comm