import ..lectures.love04_functional_programming_demo

/-! # LoVe Homework 4: Functional Programming

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (2 points): Maps

1.1 (1 point). Complete the following definition. The `map_btree` function
should apply its argument `f` to all values of type `α` stored in the tree and
otherwise preserve the tree's structure. -/

def map_btree {α β : Type} (f : α → β) : btree α → btree β :=
sorry

/-! 1.2 (1 point). Prove the following lemma about your `map_btree` function. -/

lemma map_btree_iden {α : Type} :
  ∀t : btree α, map_btree (λa, a) t = t :=
sorry

/-! ## Question 2 (4 points): Tail-Recursive Factorials

Recall the definition of the factorial functions: -/

#check fact

/-! 2.1 (2 points). Experienced functional programmers tend to avoid definitions
such as the above, because they lead to a deep call stack. Tail recursion can be
used to avoid this. Results are accumulated in an argument and returned. This
can be optimized by compilers. For factorials, this gives the following
definition: -/

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

/-! Prove that, given 1 as the accumulator `a`, `accufact` computes `fact`.

Hint: You will need to prove a generalized version of the statement as a
separate lemma or `have`, because the desired property fixes `a` to 1, which
yields a too weak induction hypothesis. -/

lemma accufact_1_eq_fact (n : ℕ) :
  accufact 1 n = fact n :=
sorry

/-! 2.2 (2 points). Prove the same property as above again, this time as a
"paper" proof. Follow the guidelines given in question 1.4 of the exercise. -/

-- enter your paper proof here

/-! ## Question 3 (3 points): Gauss's Summation Formula -/

-- `sum_upto f n = f 0 + f 1 + ⋯ + f n`
def sum_upto (f : ℕ → ℕ) : ℕ → ℕ
| 0       := f 0
| (m + 1) := sum_upto m + f (m + 1)

/-! 3.1 (2 point). Prove the following lemma, discovered by Carl Friedrich Gauss
as a pupil.

Hint: The `mul_add` and `add_mul` lemmas might be useful to reason about
multiplication. -/

#check mul_add
#check add_mul

lemma sum_upto_eq :
  ∀m : ℕ, 2 * sum_upto (λi, i) m = m * (m + 1) :=
sorry

/-! 3.2 (1 point). Prove the following property of `sum_upto`. -/

lemma sum_upto_mul (f g : ℕ → ℕ) :
  ∀n : ℕ, sum_upto (λi, f i + g i) n = sum_upto f n + sum_upto g n :=
sorry

/-! # Question 4: Heterogeneous Lists (6 points)
We've become familiar with `list`s, which contain multiple ordered values of the
same type. But what if we want to store values of different types? Can this be
done in a type-safe way?

Yes! Below we define `hlist`, a type of *heterogeneous lists*. While `list` is
parametrized by a single type (e.g., a `list string` contains `string`s, and a
`list bool` contains `bools`), `hlist` is parametrized by a *list* of types.
Each element of this type-level list defines the type of the entry at the same
position in the `hlist`. For instance, an `hlist [ℕ, string, bool]` contains a
natural number in the first position, a string in the second position, and a
boolean in the third position. Be sure you see how this achieved by the
following inductive definition. -/

inductive hlist : list Type → Type 1
| nil : hlist []
| cons {α : Type} {αs : list Type} : α → hlist αs → hlist (α :: αs)

-- This is notation to let us succinctly write `hlist`s. Note that this notation
-- cannot be used when pattern-matching.
local notation `H[]` := hlist.nil
local notation `H[` l:(foldr `,` (h t, hlist.cons h t) hlist.nil) `]` := l

#check H[]
#check H[9, "hello", tt]
#check H[("value", 4), (λ x, x + 1)]

/-! If we write a function that adds, removes, or changes the types of elements
in an `hlist`, therefore, we must also reflect these changes at the type level.
For instance, consider the function `hlist.snoc` (which appends an element to
the end of an `hlist`) below. Notice the parallel between the type it returns
and the structure of the data it returns! -/

-- Note: for reasons that may become clearer later in this question, the type
-- index variable `αs : list Type` can't go before the colon (i.e., we can't
-- parametrize `snoc` over `αs`). Instead, we take `αs` as an argument to the
-- function and simply "ignore" it when pattern-matching by using an underscore.
def hlist.snoc {α : Type} : ∀ {αs : list Type}, hlist αs → α → hlist (αs ++ [α])
| _ hlist.nil         y := hlist.cons y hlist.nil
| _ (hlist.cons x xs) y := hlist.cons x (hlist.snoc xs y)

#check hlist.snoc H[14, tt] 52
#reduce hlist.snoc H[14, tt] 52

/-! 4.1 (1 point). Write a function `append` that appends two `hlist`s together.
You'll need to complete the type as well as implement the function!

Note: when you're testing a function that returns an `hlist`, you'll need to use
`#reduce` instead of `#eval` (for complicated reasons). Therefore, you'll want
to avoid writing tests using types that are difficult for the kernel to compute
with, such as `string` and `char`. -/

def hlist.append : ∀ {αs βs : list Type}, hlist αs → hlist βs → sorry :=
sorry

/-! Heterogeneous lists can be used in conjunction with traditional lists to
store multi-typed tabular data (similar to Pyret, for those who are familiar).
We can think of some `αs : list Type` as indicating the type stored in each
column and an `hlist αs` as a row. Since every row contains the same types as
the others, a collection of such rows would simply be a list of values of type
`hlist αs`. Therefore, a table, which is a collection of rows, is represented
by a value of type `list (hlist αs)`. For instance, the following table is
represented by a `list (hlist [string, string, nat])`:

------------------------------
| "Providence" | "RI" | 2912 |
| "Pawtucket"  | "RI" | 2860 |
| "Boston"     | "MA" | 2110 |
------------------------------

But we can also think of a table as a collection of columns: each column
contains data of a single type and so is a traditional `list`, but since each
column has a different type, the collection of all the columns must be an
`hlist`. For instance, the column-wise representation of the above would have
type `hlist [list string, list string, list nat]`.

Since these representations are storing equivalent data, it would be useful to
be able to convert between them. This conversion will be our focus for the rest
of this question.

4.2 (1 point). Let `αs : list Type` represent the types stored in a given row of
a table with row-wise representation of type `list (hlist αs)`. Write a function
that produces some `βs : list Type` such that `hlist βs` is the type of the
column-wise representation of that same table. -/

def columnwise_type (αs : list Type) : list Type :=
sorry

/-! 4.3 (2 points). Now that we can state its type, implement the function
`list_hlist_to_hlist_list` that converts the row-wise representation of a table
into a column-wise representation.

Hint: In prior problems, we've simply been ignoring `αs` when pattern-matching.
Here, however, you may find it useful to pattern-match on it! -/

-- You may use these helper functions in your solution
def hlist.hd {α αs} : hlist (α :: αs) → α
| (hlist.cons x _) := x

def hlist.tl {α αs} : hlist (α :: αs) → hlist αs
| (hlist.cons _ xs) := xs

def list_hlist_to_hlist_list :
  ∀ {αs : list Type}, list (hlist αs) → hlist (columnwise_type αs) :=
sorry

/-! But what about the other direction? We might be tempted to declare a
function that turns a collection of columns into a collection of rows. That
function might have this signature: -/

constant hlist_list_to_list_hlist :
  ∀ {αs : list Type}, hlist (columnwise_type αs) → list (hlist αs)

/-! We can describe the type of behavior we expect this function to have. For
instance, if we have a table that consists of a single cell, we'd expect to get
back a table with a single cell: -/
axiom hllh_singleton :
  ∀ (τ : Type) (hl : hlist (columnwise_type [τ])),
    ∃ v : τ, @hlist_list_to_list_hlist [τ] hl = [H[v]]

/- 4.4 (1 point). But, in fact, we cannot define a function with this behavior!
Show that we can obtain `false` using the above declarations. -/

-- Hint: You will likely find `empty.elim` helpful
#check @empty.elim

theorem false_via_hllh : false :=
sorry

/-! 4.5 (1 point). In fact, there is only one function with type
`∀ {αs : list Type}, hlist (αs.map list) → list (hlist αs)`,
and it does not satisfy the property in `hllh_singleton`. Describe this
function's behavior and why it is the only function with this type. Then explain
what we would need to be able to assume about the argument to
`hlist_list_to_list_hlist` in order to create a function that inverts the
row-column representation as we desire. -/

/-
Write your answer to part 7 here.
-/

/-! A final note! This is not the only possible encoding of a heterogeneous
list. Below, we declare a type `hlist'` that stores heterogeneously typed data
but does *not* contain any data about the types it contains at type level. We
also declare a function `hlist'.append` that appends two heterogeneous lists of
this type. -/

inductive hlist'
| nil : hlist'
| cons {α : Type} : α → hlist' → hlist'

def hlist'.append : hlist' → hlist' → hlist'
| hlist'.nil ys := ys
| (hlist'.cons x xs) ys := hlist'.cons x (hlist'.append xs ys)

/-!

Food for thought: what are some pros and cons of this approach compared to
`hlist`? (How easy is each to declare? To extract data from? How confident
are you that each `append` function is correct by virtue of the fact that it
type-checks?)

We won't be grading your answers here, but if you'd like to share your thoughts,
we're happy to read them!

-/

end LoVe


constants p q : Prop

theorem t1 : p → q → p := λ hp : p, λ hq : q, hp
#check t1
#print t1

theorem t1' : p → q → p :=
assume hp : p,
assume hq : q,
hp
#print t1

theorem t1'' : p → q → p :=
assume hp : p,
assume hq : q,
show p, from hp
#print t1''

lemma t1l : p → q → p :=
assume hp : p,
assume hq : q,
show p, from hp
#check t1l
#print t1l

theorem t1f (hp : p) (hq : q) : p := hp
#check t1f
#print t1f

axiom hp : p

theorem t2 : q → p := t1 hp
#check t2
#print t2

theorem t1g (p q : Prop) (hp : p) (hq : q) : p : hp
#check t1g

theorem t1g' : ∀ (p q : Prop), p → q → p :=
λ (p q : Prop) (hp : p) (hq : q), hp
#check ∀ (p q : Prop), p → q → p
#check λ (p q : Prop) (hp : p) (hq : q), hp
#check t1g'
#print t1g'


/-
Copyright (c) 2021 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning, Jireh Loreaux
-/
import group_theory.subsemigroup.center

/-!
# Centralizers of magmas and semigroups

## Main definitions

* `set.centralizer`: the centralizer of a subset of a magma
* `subsemigroup.centralizer`: the centralizer of a subset of a semigroup
* `set.add_centralizer`: the centralizer of a subset of an additive magma
* `add_subsemigroup.centralizer`: the centralizer of a subset of an additive semigroup

We provide `monoid.centralizer`, `add_monoid.centralizer`, `subgroup.centralizer`, and
`add_subgroup.centralizer` in other files.
-/

variables {M : Type*} {S T : set M}

namespace set

variables (S)

/-- The centralizer of a subset of a magma. -/
@[to_additive add_centralizer /-" The centralizer of a subset of an additive magma. "-/]
def centralizer [has_mul M] : set M := {c | ∀ m ∈ S, m * c = c * m}

variables {S}

@[to_additive mem_add_centralizer]
lemma mem_centralizer_iff [has_mul M] {c : M} : c ∈ centralizer S ↔ ∀ m ∈ S, m * c = c * m :=
iff.rfl

@[to_additive decidable_mem_add_centralizer]
instance decidable_mem_centralizer [has_mul M] [decidable_eq M] [fintype M]
  [decidable_pred (∈ S)] : decidable_pred (∈ centralizer S) :=
λ _, decidable_of_iff' _ (mem_centralizer_iff)

variables (S)

@[simp, to_additive zero_mem_add_centralizer]
lemma one_mem_centralizer [mul_one_class M] : (1 : M) ∈ centralizer S :=
by simp [mem_centralizer_iff]

@[simp]
lemma zero_mem_centralizer [mul_zero_class M] : (0 : M) ∈ centralizer S :=
by simp [mem_centralizer_iff]

variables {S} {a b : M}

@[simp, to_additive add_mem_add_centralizer]
lemma mul_mem_centralizer [semigroup M] (ha : a ∈ centralizer S) (hb : b ∈ centralizer S) :
  a * b ∈ centralizer S :=
λ g hg, by rw [mul_assoc, ←hb g hg, ← mul_assoc, ha g hg, mul_assoc]

@[simp, to_additive neg_mem_add_centralizer]
lemma inv_mem_centralizer [group M] (ha : a ∈ centralizer S) : a⁻¹ ∈ centralizer S :=
λ g hg, by rw [mul_inv_eq_iff_eq_mul, mul_assoc, eq_inv_mul_iff_mul_eq, ha g hg]

@[simp]
lemma add_mem_centralizer [distrib M] (ha : a ∈ centralizer S) (hb : b ∈ centralizer S) :
  a + b ∈ centralizer S :=
λ c hc, by rw [add_mul, mul_add, ha c hc, hb c hc]

@[simp]
lemma neg_mem_centralizer [has_mul M] [has_distrib_neg M] (ha : a ∈ centralizer S) :
  -a ∈ centralizer S :=
λ c hc, by rw [mul_neg, ha c hc, neg_mul]

@[simp]
lemma inv_mem_centralizer₀ [group_with_zero M] (ha : a ∈ centralizer S) : a⁻¹ ∈ centralizer S :=
(eq_or_ne a 0).elim (λ h, by { rw [h, inv_zero], exact zero_mem_centralizer S })
  (λ ha0 c hc, by rw [mul_inv_eq_iff_eq_mul₀ ha0, mul_assoc, eq_inv_mul_iff_mul_eq₀ ha0, ha c hc])

@[simp, to_additive sub_mem_add_centralizer]
lemma div_mem_centralizer [group M] (ha : a ∈ centralizer S) (hb : b ∈ centralizer S) :
  a / b ∈ centralizer S :=
begin
  rw [div_eq_mul_inv],
  exact mul_mem_centralizer ha (inv_mem_centralizer hb),
end

@[simp]
lemma div_mem_centralizer₀ [group_with_zero M] (ha : a ∈ centralizer S) (hb : b ∈ centralizer S) :
  a / b ∈ centralizer S :=
begin
  rw div_eq_mul_inv,
  exact mul_mem_centralizer ha (inv_mem_centralizer₀ hb),
end

@[to_additive add_centralizer_subset]
lemma centralizer_subset [has_mul M] (h : S ⊆ T) : centralizer T ⊆ centralizer S :=
λ t ht s hs, ht s (h hs)

variables (M)

@[simp, to_additive add_centralizer_univ]
lemma centralizer_univ [has_mul M] : centralizer univ = center M :=
subset.antisymm (λ a ha b, ha b (set.mem_univ b)) (λ a ha b hb, ha b)

variables {M} (S)

@[simp, to_additive add_centralizer_eq_univ]
lemma centralizer_eq_univ [comm_semigroup M] : centralizer S = univ :=
subset.antisymm (subset_univ _) $ λ x hx y hy, mul_comm y x

end set

namespace subsemigroup
section
variables {M} [semigroup M] (S)

/-- The centralizer of a subset of a semigroup `M`. -/
@[to_additive "The centralizer of a subset of an additive semigroup."]
def centralizer : subsemigroup M :=
{ carrier := S.centralizer,
  mul_mem' := λ a b, set.mul_mem_centralizer }

@[simp, norm_cast, to_additive] lemma coe_centralizer : ↑(centralizer S) = S.centralizer := rfl

variables {S}

@[to_additive] lemma mem_centralizer_iff {z : M} : z ∈ centralizer S ↔ ∀ g ∈ S, g * z = z * g :=
iff.rfl

@[to_additive] instance decidable_mem_centralizer [decidable_eq M] [fintype M]
  [decidable_pred (∈ S)] : decidable_pred (∈ centralizer S) :=
λ _, decidable_of_iff' _ mem_centralizer_iff

@[to_additive]
lemma centralizer_le (h : S ⊆ T) : centralizer T ≤ centralizer S :=
set.centralizer_subset h

variables (M)

@[simp, to_additive]
lemma centralizer_univ : centralizer set.univ = center M :=
set_like.ext' (set.centralizer_univ M)

end

end subsemigroup


/-
Copyright (c) 2018 Jan-David Salchow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jan-David Salchow, Patrick Massot
-/
import topology.bases
import topology.subset_properties
import topology.metric_space.basic

/-!
# Sequences in topological spaces

In this file we define sequences in topological spaces and show how they are related to
filters and the topology. In particular, we
* define the sequential closure of a set and prove that it's contained in the closure,
* define a type class "sequential_space" in which closure and sequential closure agree,
* define sequential continuity and show that it coincides with continuity in sequential spaces,
* provide an instance that shows that every first-countable (and in particular metric) space is
  a sequential space.
* define sequential compactness, prove that compactness implies sequential compactness in first
  countable spaces, and prove they are equivalent for uniform spaces having a countable uniformity
  basis (in particular metric spaces).
-/

open set filter
open_locale topological_space

variables {α : Type*} {β : Type*}

local notation f ` ⟶ ` limit := tendsto f at_top (𝓝 limit)

/-! ### Sequential closures, sequential continuity, and sequential spaces. -/
section topological_space
variables [topological_space α] [topological_space β]

/-- A sequence converges in the sence of topological spaces iff the associated statement for filter
holds. -/
lemma topological_space.seq_tendsto_iff {x : ℕ → α} {limit : α} :
  tendsto x at_top (𝓝 limit) ↔
    ∀ U : set α, limit ∈ U → is_open U → ∃ N, ∀ n ≥ N, (x n) ∈ U :=
(at_top_basis.tendsto_iff (nhds_basis_opens limit)).trans $
  by simp only [and_imp, exists_prop, true_and, set.mem_Ici, ge_iff_le, id]

/-- The sequential closure of a subset M ⊆ α of a topological space α is
the set of all p ∈ α which arise as limit of sequences in M. -/
def sequential_closure (M : set α) : set α :=
{p | ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ M) ∧ (x ⟶ p)}

lemma subset_sequential_closure (M : set α) : M ⊆ sequential_closure M :=
assume p (_ : p ∈ M), show p ∈ sequential_closure M, from
  ⟨λ n, p, assume n, ‹p ∈ M›, tendsto_const_nhds⟩

/-- A set `s` is sequentially closed if for any converging sequence `x n` of elements of `s`,
the limit belongs to `s` as well. -/
def is_seq_closed (s : set α) : Prop := s = sequential_closure s

/-- A convenience lemma for showing that a set is sequentially closed. -/
lemma is_seq_closed_of_def {A : set α}
  (h : ∀(x : ℕ → α) (p : α), (∀ n : ℕ, x n ∈ A) → (x ⟶ p) → p ∈ A) : is_seq_closed A :=
show A = sequential_closure A, from subset.antisymm
  (subset_sequential_closure A)
  (show ∀ p, p ∈ sequential_closure A → p ∈ A, from
    (assume p ⟨x, _, _⟩, show p ∈ A, from h x p ‹∀ n : ℕ, ((x n) ∈ A)› ‹(x ⟶ p)›))

/-- The sequential closure of a set is contained in the closure of that set.
The converse is not true. -/
lemma sequential_closure_subset_closure (M : set α) : sequential_closure M ⊆ closure M :=
assume p ⟨x, xM, xp⟩,
mem_closure_of_tendsto xp (univ_mem_sets' xM)

/-- A set is sequentially closed if it is closed. -/
lemma is_seq_closed_of_is_closed (M : set α) (_ : is_closed M) : is_seq_closed M :=
suffices sequential_closure M ⊆ M, from
  set.eq_of_subset_of_subset (subset_sequential_closure M) this,
calc sequential_closure M ⊆ closure M : sequential_closure_subset_closure M
  ... = M : is_closed.closure_eq ‹is_closed M›

/-- The limit of a convergent sequence in a sequentially closed set is in that set.-/
lemma mem_of_is_seq_closed {A : set α} (_ : is_seq_closed A) {x : ℕ → α}
  (_ : ∀ n, x n ∈ A) {limit : α} (_ : (x ⟶ limit)) : limit ∈ A :=
have limit ∈ sequential_closure A, from
  show ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ A) ∧ (x ⟶ limit), from ⟨x, ‹∀ n, x n ∈ A›, ‹(x ⟶ limit)›⟩,
eq.subst (eq.symm ‹is_seq_closed A›) ‹limit ∈ sequential_closure A›

/-- The limit of a convergent sequence in a closed set is in that set.-/
lemma mem_of_is_closed_sequential {A : set α} (_ : is_closed A) {x : ℕ → α}
  (_ : ∀ n, x n ∈ A) {limit : α} (_ : x ⟶ limit) : limit ∈ A :=
mem_of_is_seq_closed (is_seq_closed_of_is_closed A ‹is_closed A›) ‹∀ n, x n ∈ A› ‹(x ⟶ limit)›

/-- A sequential space is a space in which 'sequences are enough to probe the topology'. This can be
 formalised by demanding that the sequential closure and the closure coincide. The following
 statements show that other topological properties can be deduced from sequences in sequential
 spaces. -/
class sequential_space (α : Type*) [topological_space α] : Prop :=
(sequential_closure_eq_closure : ∀ M : set α, sequential_closure M = closure M)

/-- In a sequential space, a set is closed iff it's sequentially closed. -/
lemma is_seq_closed_iff_is_closed [sequential_space α] {M : set α} :
  is_seq_closed M ↔ is_closed M :=
iff.intro
  (assume _, closure_eq_iff_is_closed.mp (eq.symm
    (calc M = sequential_closure M : by assumption
        ... = closure M            : sequential_space.sequential_closure_eq_closure M)))
  (is_seq_closed_of_is_closed M)

/-- In a sequential space, a point belongs to the closure of a set iff it is a limit of a sequence
taking values in this set. -/
lemma mem_closure_iff_seq_limit [sequential_space α] {s : set α} {a : α} :
  a ∈ closure s ↔ ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ s) ∧ (x ⟶ a) :=
by { rw ← sequential_space.sequential_closure_eq_closure, exact iff.rfl }

/-- A function between topological spaces is sequentially continuous if it commutes with limit of
 convergent sequences. -/
def sequentially_continuous (f : α → β) : Prop :=
∀ (x : ℕ → α), ∀ {limit : α}, (x ⟶ limit) → (f∘x ⟶ f limit)

/- A continuous function is sequentially continuous. -/
lemma continuous.to_sequentially_continuous {f : α → β} (_ : continuous f) :
  sequentially_continuous f :=
assume x limit (_ : x ⟶ limit),
have tendsto f (𝓝 limit) (𝓝 (f limit)), from continuous.tendsto ‹continuous f› limit,
show (f ∘ x) ⟶ (f limit), from tendsto.comp this ‹(x ⟶ limit)›

/-- In a sequential space, continuity and sequential continuity coincide. -/
lemma continuous_iff_sequentially_continuous {f : α → β} [sequential_space α] :
  continuous f ↔ sequentially_continuous f :=
iff.intro
  (assume _, ‹continuous f›.to_sequentially_continuous)
  (assume : sequentially_continuous f, show continuous f, from
    suffices h : ∀ {A : set β}, is_closed A → is_seq_closed (f ⁻¹' A), from
      continuous_iff_is_closed.mpr (assume A _, is_seq_closed_iff_is_closed.mp $ h ‹is_closed A›),
    assume A (_ : is_closed A),
      is_seq_closed_of_def $
        assume (x : ℕ → α) p (_ : ∀ n, f (x n) ∈ A) (_ : x ⟶ p),
        have (f ∘ x) ⟶ (f p), from ‹sequentially_continuous f› x ‹(x ⟶ p)›,
        show f p ∈ A, from
          mem_of_is_closed_sequential ‹is_closed A› ‹∀ n, f (x n) ∈ A› ‹(f∘x ⟶ f p)›)

end topological_space

namespace topological_space

namespace first_countable_topology

variables [topological_space α] [first_countable_topology α]

/-- Every first-countable space is sequential. -/
@[priority 100] -- see Note [lower instance priority]
instance : sequential_space α :=
⟨show ∀ M, sequential_closure M = closure M, from assume M,
  suffices closure M ⊆ sequential_closure M,
    from set.subset.antisymm (sequential_closure_subset_closure M) this,
  -- For every p ∈ closure M, we need to construct a sequence x in M that converges to p:
  assume (p : α) (hp : p ∈ closure M),
  -- Since we are in a first-countable space, the neighborhood filter around `p` has a decreasing
  -- basis `U` indexed by `ℕ`.
  let ⟨U, hU⟩ := (nhds_generated_countable p).exists_antimono_basis in
  -- Since `p ∈ closure M`, there is an element in each `M ∩ U i`
  have hp : ∀ (i : ℕ), ∃ (y : α), y ∈ M ∧ y ∈ U i,
    by simpa using (mem_closure_iff_nhds_basis hU.1).mp hp,
  begin
    -- The axiom of (countable) choice builds our sequence from the later fact
    choose u hu using hp,
    rw forall_and_distrib at hu,
    -- It clearly takes values in `M`
    use [u, hu.1],
    -- and converges to `p` because the basis is decreasing.
    apply hU.tendsto hu.2,
  end⟩

end first_countable_topology

end topological_space

section seq_compact
open topological_space topological_space.first_countable_topology
variables [topological_space α]

/-- A set `s` is sequentially compact if every sequence taking values in `s` has a
converging subsequence. -/
def is_seq_compact (s : set α) :=
  ∀ ⦃u : ℕ → α⦄, (∀ n, u n ∈ s) →
    ∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x)

/-- A space `α` is sequentially compact if every sequence in `α` has a
converging subsequence. -/
class seq_compact_space (α : Type*) [topological_space α] : Prop :=
(seq_compact_univ : is_seq_compact (univ : set α))

lemma is_seq_compact.subseq_of_frequently_in {s : set α} (hs : is_seq_compact s) {u : ℕ → α}
  (hu : ∃ᶠ n in at_top, u n ∈ s) :
  ∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
let ⟨ψ, hψ, huψ⟩ := extraction_of_frequently_at_top hu, ⟨x, x_in, φ, hφ, h⟩ := hs huψ in
⟨x, x_in, ψ ∘ φ, hψ.comp hφ, h⟩

lemma seq_compact_space.tendsto_subseq [seq_compact_space α] (u : ℕ → α) :
  ∃ x (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
let ⟨x, _, φ, mono, h⟩ := seq_compact_space.seq_compact_univ (by simp : ∀ n, u n ∈ univ) in
⟨x, φ, mono, h⟩

section first_countable_topology
variables [first_countable_topology α]
open topological_space.first_countable_topology

lemma is_compact.is_seq_compact {s : set α} (hs : is_compact s) : is_seq_compact s :=
λ u u_in,
let ⟨x, x_in, hx⟩ := @hs (map u at_top) _
  (le_principal_iff.mpr (univ_mem_sets' u_in : _)) in ⟨x, x_in, tendsto_subseq hx⟩

lemma is_compact.tendsto_subseq' {s : set α} {u : ℕ → α} (hs : is_compact s)
  (hu : ∃ᶠ n in at_top, u n ∈ s) :
∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
hs.is_seq_compact.subseq_of_frequently_in hu

lemma is_compact.tendsto_subseq {s : set α} {u : ℕ → α} (hs : is_compact s) (hu : ∀ n, u n ∈ s) :
∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
hs.is_seq_compact hu

@[priority 100] -- see Note [lower instance priority]
instance first_countable_topology.seq_compact_of_compact [compact_space α] : seq_compact_space α :=
⟨compact_univ.is_seq_compact⟩

lemma compact_space.tendsto_subseq [compact_space α] (u : ℕ → α) :
  ∃ x (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
seq_compact_space.tendsto_subseq u

end first_countable_topology
end seq_compact

section uniform_space_seq_compact

open_locale uniformity
open uniform_space prod

variables [uniform_space β] {s : set β}

lemma lebesgue_number_lemma_seq {ι : Type*} {c : ι → set β}
  (hs : is_seq_compact s) (hc₁ : ∀ i, is_open (c i)) (hc₂ : s ⊆ ⋃ i, c i)
  (hU : is_countably_generated (𝓤 β)) :
  ∃ V ∈ 𝓤 β, symmetric_rel V ∧ ∀ x ∈ s, ∃ i, ball x V ⊆ c i :=
begin
  classical,
  obtain ⟨V, hV, Vsymm⟩ :
    ∃ V : ℕ → set (β × β), (𝓤 β).has_antimono_basis (λ _, true) V ∧  ∀ n, swap ⁻¹' V n = V n,
      from uniform_space.has_seq_basis hU, clear hU,
  suffices : ∃ n, ∀ x ∈ s, ∃ i, ball x (V n) ⊆ c i,
  { cases this with n hn,
    exact ⟨V n, hV.to_has_basis.mem_of_mem trivial, Vsymm n, hn⟩ },
  by_contradiction H,
  obtain ⟨x, x_in, hx⟩ : ∃ x : ℕ → β, (∀ n, x n ∈ s) ∧ ∀ n i, ¬ ball (x n) (V n) ⊆ c i,
  { push_neg at H,
    choose x hx using H,
    exact ⟨x, forall_and_distrib.mp hx⟩ }, clear H,
  obtain ⟨x₀, x₀_in, φ, φ_mono, hlim⟩ : ∃ (x₀ ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ (x ∘ φ ⟶ x₀),
    from hs x_in, clear hs,
  obtain ⟨i₀, x₀_in⟩ : ∃ i₀, x₀ ∈ c i₀,
  { rcases hc₂ x₀_in with ⟨_, ⟨i₀, rfl⟩, x₀_in_c⟩,
    exact ⟨i₀, x₀_in_c⟩ }, clear hc₂,
  obtain ⟨n₀, hn₀⟩ : ∃ n₀, ball x₀ (V n₀) ⊆ c i₀,
  { rcases (nhds_basis_uniformity hV.to_has_basis).mem_iff.mp
      (is_open_iff_mem_nhds.mp (hc₁ i₀) _ x₀_in) with ⟨n₀, _, h⟩,
    use n₀,
    rwa ← ball_eq_of_symmetry (Vsymm n₀) at h }, clear hc₁,
  obtain ⟨W, W_in, hWW⟩ : ∃ W ∈ 𝓤 β, W ○ W ⊆ V n₀,
    from comp_mem_uniformity_sets (hV.to_has_basis.mem_of_mem trivial),
  obtain ⟨N, x_φ_N_in, hVNW⟩ : ∃ N, x (φ N) ∈ ball x₀ W ∧ V (φ N) ⊆ W,
  { obtain ⟨N₁, h₁⟩ : ∃ N₁, ∀ n ≥ N₁, x (φ n) ∈ ball x₀ W,
      from tendsto_at_top'.mp hlim _ (mem_nhds_left x₀ W_in),
    obtain ⟨N₂, h₂⟩ : ∃ N₂, V (φ N₂) ⊆ W,
    { rcases hV.to_has_basis.mem_iff.mp W_in with ⟨N, _, hN⟩,
      use N,
      exact subset.trans (hV.decreasing trivial trivial $  φ_mono.id_le _) hN },
    have : φ N₂ ≤ φ (max N₁ N₂),
      from φ_mono.le_iff_le.mpr (le_max_right _ _),
    exact ⟨max N₁ N₂, h₁ _ (le_max_left _ _), trans (hV.decreasing trivial trivial this) h₂⟩ },
  suffices : ball (x (φ N)) (V (φ N)) ⊆ c i₀,
    from hx (φ N) i₀ this,
  calc
    ball (x $ φ N) (V $ φ N) ⊆ ball (x $ φ N) W : preimage_mono hVNW
                         ... ⊆ ball x₀ (V n₀)   : ball_subset_of_comp_subset x_φ_N_in hWW
                         ... ⊆ c i₀             : hn₀,
end

lemma is_seq_compact.totally_bounded (h : is_seq_compact s) : totally_bounded s :=
begin
  classical,
  apply totally_bounded_of_forall_symm,
  unfold is_seq_compact at h,
  contrapose! h,
  rcases h with ⟨V, V_in, V_symm, h⟩,
  simp_rw [not_subset] at h,
  have : ∀ (t : set β), finite t → ∃ a, a ∈ s ∧ a ∉ ⋃ y ∈ t, ball y V,
  { intros t ht,
    obtain ⟨a, a_in, H⟩ : ∃ a ∈ s, ∀ (x : β), x ∈ t → (x, a) ∉ V,
      by simpa [ht] using h t,
    use [a, a_in],
    intro H',
    obtain ⟨x, x_in, hx⟩ := mem_bUnion_iff.mp H',
    exact H x x_in hx },
  cases seq_of_forall_finite_exists this with u hu, clear h this,
  simp [forall_and_distrib] at hu,
  cases hu with u_in hu,
  use [u, u_in], clear u_in,
  intros x x_in φ,
  intros hφ huφ,
  obtain ⟨N, hN⟩ : ∃ N, ∀ p q, p ≥ N → q ≥ N → (u (φ p), u (φ q)) ∈ V,
    from huφ.cauchy_seq.mem_entourage V_in,
  specialize hN N (N+1) (le_refl N) (nat.le_succ N),
  specialize hu (φ $ N+1) (φ N) (hφ $ lt_add_one N),
  exact hu hN,
end

protected lemma is_seq_compact.is_compact (h : is_countably_generated $ 𝓤 β)
  (hs : is_seq_compact s) :
  is_compact s :=
begin
  classical,
  rw compact_iff_finite_subcover,
  intros ι U Uop s_sub,
  rcases lebesgue_number_lemma_seq hs Uop s_sub h with ⟨V, V_in, Vsymm, H⟩,
  rcases totally_bounded_iff_subset.mp hs.totally_bounded V V_in with ⟨t,t_sub, tfin,  ht⟩,
  have : ∀ x : t, ∃ (i : ι), ball x.val V ⊆ U i,
  { rintros ⟨x, x_in⟩,
    exact H x (t_sub x_in) },
  choose i hi using this,
  haveI : fintype t := tfin.fintype,
  use finset.image i finset.univ,
  transitivity ⋃ y ∈ t, ball y V,
  { intros x x_in,
    specialize ht x_in,
    rw mem_bUnion_iff at *,
    simp_rw ball_eq_of_symmetry Vsymm,
    exact ht },
  { apply bUnion_subset_bUnion,
    intros x x_in,
    exact ⟨i ⟨x, x_in⟩, finset.mem_image_of_mem _ (finset.mem_univ _), hi ⟨x, x_in⟩⟩ },
end

protected lemma uniform_space.compact_iff_seq_compact (h : is_countably_generated $ 𝓤 β) :
 is_compact s ↔ is_seq_compact s :=
begin
  haveI := uniform_space.first_countable_topology h,
  exact ⟨λ H, H.is_seq_compact, λ H, H.is_compact h⟩
end

lemma uniform_space.compact_space_iff_seq_compact_space (H : is_countably_generated $ 𝓤 β) :
  compact_space β ↔ seq_compact_space β :=
have key : is_compact univ ↔ is_seq_compact univ := uniform_space.compact_iff_seq_compact H,
⟨λ ⟨h⟩, ⟨key.mp h⟩, λ ⟨h⟩, ⟨key.mpr h⟩⟩

end uniform_space_seq_compact

section metric_seq_compact

variables [metric_space β] {s : set β}
open metric

/-- A version of Bolzano-Weistrass: in a metric space, is_compact s ↔ is_seq_compact s -/
lemma metric.compact_iff_seq_compact : is_compact s ↔ is_seq_compact s :=
uniform_space.compact_iff_seq_compact emetric.uniformity_has_countable_basis

/-- A version of Bolzano-Weistrass: in a proper metric space (eg. $ℝ^n$),
every bounded sequence has a converging subsequence. This version assumes only
that the sequence is frequently in some bounded set. -/
lemma tendsto_subseq_of_frequently_bounded [proper_space β] (hs : bounded s)
  {u : ℕ → β} (hu : ∃ᶠ n in at_top, u n ∈ s) :
∃ b ∈ closure s, ∃ φ : ℕ → ℕ, strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 b) :=
begin
  have hcs : is_compact (closure s) :=
    compact_iff_closed_bounded.mpr ⟨is_closed_closure, bounded_closure_of_bounded hs⟩,
  replace hcs : is_seq_compact (closure s),
    by rwa metric.compact_iff_seq_compact at hcs,
  have hu' : ∃ᶠ n in at_top, u n ∈ closure s,
  { apply frequently.mono hu,
    intro n,
    apply subset_closure },
  exact hcs.subseq_of_frequently_in hu',
end

/-- A version of Bolzano-Weistrass: in a proper metric space (eg. $ℝ^n$),
every bounded sequence has a converging subsequence. -/
lemma tendsto_subseq_of_bounded [proper_space β] (hs : bounded s)
  {u : ℕ → β} (hu : ∀ n, u n ∈ s) :
∃ b ∈ closure s, ∃ φ : ℕ → ℕ, strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 b) :=
tendsto_subseq_of_frequently_bounded hs $ frequently_of_forall hu

lemma metric.compact_space_iff_seq_compact_space : compact_space β ↔ seq_compact_space β :=
uniform_space.compact_space_iff_seq_compact_space emetric.uniformity_has_countable_basis

lemma seq_compact.lebesgue_number_lemma_of_metric
  {ι : Type*} {c : ι → set β} (hs : is_seq_compact s)
  (hc₁ : ∀ i, is_open (c i)) (hc₂ : s ⊆ ⋃ i, c i) :
  ∃ δ > 0, ∀ x ∈ s, ∃ i, ball x δ ⊆ c i :=
begin
  rcases lebesgue_number_lemma_seq hs hc₁ hc₂ emetric.uniformity_has_countable_basis
    with ⟨V, V_in, _, hV⟩,
  rcases uniformity_basis_dist.mem_iff.mp V_in with ⟨δ, δ_pos, h⟩,
  use [δ, δ_pos],
  intros x x_in,
  rcases hV x x_in with ⟨i, hi⟩,
  use i,
  have := ball_mono h x,
  rw ball_eq_ball' at this,
  exact subset.trans this hi,
end

end metric_seq_compact


import tuto_lib

section
/-
The first part of this file makes sure you can negate quantified statements
in your head without the help of `push_neg`.

You need to complete the statement and then use the `check_me` tactic
to check your answer. This tactic exists only for those exercises,
it mostly calls `push_neg` and then cleans up a bit.

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε
-/

-- In this section, u denotes a sequence of real numbers
-- f is a function from ℝ to ℝ
-- x₀ and l are real numbers
variables (u : ℕ → ℝ) (f : ℝ → ℝ) (x₀ l : ℝ)

/- Negation of "u tends to l" -/
-- 0062
example : ¬ (∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε) ↔
-- sorry
∃ ε > 0, ∀ N, ∃ n ≥ N, |u n - l| > ε
-- sorry
:=
begin
  -- sorry
  check_me,
  -- sorry
end

/- Negation of "f is continuous at x₀" -/
-- 0063
example : ¬ (∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ →  |f x - f x₀| ≤ ε) ↔
-- sorry
∃ ε > 0, ∀ δ > 0, ∃ x, |x - x₀| ≤ δ ∧ |f x - f x₀| > ε
-- sorry
:=
begin
  -- sorry
  check_me,
  -- sorry
end

/-
In the next exercise, we need to keep in mind that
`∀ x x', ...` is the abbreviation of
`∀ x, ∀ x', ... `.

Also, `∃ x x', ...` is the abbreviation of `∃ x, ∃ x', ...`.
-/

/- Negation of "f is uniformly continuous on ℝ" -/
-- 0064
example : ¬ (∀ ε > 0, ∃ δ > 0, ∀ x x', |x' - x| ≤ δ →  |f x' - f x| ≤ ε) ↔
-- sorry
∃ ε > 0, ∀ δ > 0, ∃ x x', |x' - x| ≤ δ ∧ |f x' - f x| > ε
-- sorry
:=
begin
  -- sorry
  check_me,
  -- sorry
end

/- Negation of "f is sequentially continuous at x₀" -/
-- 0065
example : ¬ (∀ u : ℕ → ℝ, (∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - x₀| ≤ ε) → (∀ ε > 0, ∃ N, ∀ n ≥ N, |(f ∘ u) n - f x₀| ≤ ε))  ↔
-- sorry
∃ u : ℕ → ℝ,
  (∀ δ > 0, ∃ N, ∀ n ≥ N, |u n - x₀| ≤ δ) ∧
  (∃ ε > 0,  ∀ N, ∃ n ≥ N, |f (u n) - f x₀| > ε)
-- sorry
:=
begin
  -- sorry
  check_me,
  -- sorry
end
end

/-
We now turn to elementary applications of negations to limits of sequences.
Remember that `linarith` can find easy numerical contradictions.

Also recall the following lemmas:

abs_le {x y : ℝ} : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

/-- The sequence `u` tends to `+∞`. -/
def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A
-/

-- 0066
example {u : ℕ → ℝ} : tendsto_infinity u → ∀ l, ¬ seq_limit u l :=
begin
  -- sorry
  intros lim_infinie l lim_l,
  cases lim_l 1 (by linarith) with N hN,
  cases lim_infinie (l+2) with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (le_max_left _ _),
  specialize hN' N₀ (le_max_right _ _),
  rw abs_le at hN,
  linarith,
  -- sorry
end

def nondecreasing_seq (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

-- 0067
example (u : ℕ → ℝ) (l : ℝ) (h : seq_limit u l) (h' : nondecreasing_seq u) :
  ∀ n, u n ≤ l :=
begin
  -- sorry
  intro n,
  by_contradiction H,
  push_neg at H,
  cases h ((u n - l)/2) (by linarith) with N hN,
  specialize hN (max n N) (le_max_right _ _),
  specialize h' n (max n N) (le_max_left _ _),
  rw abs_le at hN,
  linarith,
  -- sorry
end

/-
In the following exercises, `A : set ℝ` means that A is a set of real numbers.
We can use the usual notation x ∈ A.

The notation `∀ x ∈ A, ...` is the abbreviation of `∀ x, x ∈ A → ... `

The notation `∃ x ∈ A, ...` is the abbreviation of `∃ x, x ∈ A ∧ ... `.
More precisely it is the abbreviation of `∃ x (H : x ∈ A), ...`
which is Lean's strange way of saying `∃ x, x ∈ A ∧ ... `.
You can convert between these forms using the lemma
  exists_prop {p q : Prop} : (∃ (h : p), q) ↔ p ∧ q

We'll work with upper bounds and supremums.
Again we'll introduce specialized definitions for the sake of exercises, but mathlib
has more general versions.

def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

Remark: one can easily show that a set of real numbers has at most one sup,
but we won't need this.
-/

-- 0068
example {A : set ℝ} {x : ℝ} (hx : is_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  -- sorry
  intro y,
  contrapose!,
  exact hx.right y,
  -- sorry
end

/-
Let's do a variation on an example from file 07 that will be useful in the last
exercise below.
-/

-- 0069
lemma le_of_le_add_all' {x y : ℝ} :
  (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  -- sorry
  contrapose!,
  intro h,
  use (y-x)/2,
  split ; linarith,
  -- sorry
end

-- 0070
example {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∀ n, u n ≤ y) : x ≤ y :=
begin
  -- sorry
  apply le_of_le_add_all',
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  specialize hN N (by linarith),
  rw abs_le at hN,
  linarith [ineg N],
  -- sorry
end


import M4R.Algebra.Group.Monoid

namespace M4R
  namespace Group
    open Monoid

    protected instance Product (α₁ : Type _) (α₂ : Type _) [Group α₁] [Group α₂] : Group (α₁ × α₂) where
      neg := fun (x₁, x₂) => (-x₁, -x₂)
      add_neg := fun (a₁, a₂) => by simp [HAdd.hAdd, Add.add, product_zero]; exact ⟨add_neg a₁, add_neg a₂⟩

    theorem product_neg {α₁ : Type _} {α₂ : Type _} [Group α₁] [Group α₂] : ∀ x : α₁ × α₂, -x = (-x.fst, -x.snd) :=
      fun (x₁, x₂) => rfl

    protected instance multi_product.Neg {ι : Type _} (fι : ι → Type _) [∀ i, Neg (fι i)] : Neg (MultiProd fι) where
      neg := (- · ·)
    protected theorem multi_product.Neg_def {ι : Type _} {fι : ι → Type _} [∀ i, Neg (fι i)] (a : MultiProd fι) :
      ∀ i, (- a) i = - (a i) := fun _ => rfl

    protected instance multi_product {ι : Type _} (fι : ι → Type _) [∀ i, Group (fι i)] : Group (MultiProd fι) where
      add_neg := fun a => funext fun i => Group.add_neg (a i)

    theorem neg_add [Group α] (a : α) : -a + a = 0 := by
      calc
        -a + a = -a + a + (-a + - -a) := by rw [add_neg, add_zero]
        _      = -a + (a + -a) + - -a := by rw [←add_assoc (-a + a), add_assoc (-a)]
        _      = (0 : α)              := by rw [add_neg, add_zero, add_neg]
    theorem add_neg_comm [Group α] (a : α) : a + (-a) = (-a) + a :=
      Eq.trans (add_neg a) (Eq.symm (neg_add a))

    theorem neg_zero [Group α] : -(0 : α) = 0 := by
      rw [←zero_add (-0), add_neg]

    theorem sub_def [Group α] (a b : α) : a - b = a + -b := rfl
    theorem sub_self [Group α] (a : α) : a - a = 0 := by rw [sub_def, add_neg]
    theorem sub_add [Group α] (a b : α) : a - b + b = a := by rw [sub_def, add_assoc, neg_add, add_zero]

    theorem add_right_cancel [Group α] (a b c : α) : a + c = b + c ↔ a = b  := by
      have : ∀ (x y z : α), x = y → x + z = y + z := fun x y z => congrArg (· + z)
      apply Iff.intro
      case mpr => exact this a b c
      case mp =>
        intro hacbc
        rw [← add_zero a, ← add_zero b, ← add_neg c, ← add_assoc a, ← add_assoc b]
        exact this (a+c) (b+c) (-c) hacbc

    theorem sub_right [Group α] {a b c : α} : a + c = b ↔ a = b + -c :=
      ⟨by intro h; rw [←h, add_assoc, add_neg, add_zero],
      by intro h; rw [h, add_assoc, neg_add, add_zero]⟩
    theorem sub_eq [Group α] {a b c : α} : a - b = c ↔ a = c + b :=
      ⟨fun h => (sub_right.mpr h.symm).symm, fun h => (sub_right.mp h.symm).symm⟩

    theorem neg_neg [Group α] (a : α) : - - a = a := by
      rw [←add_right_cancel _ _ (-a), neg_add, add_neg]

    /-- Use `AbelianGroup.neg_add_distrib` for `-(a + b) = -a + -b`. -/
    theorem neg_add_distrib [Group α] (a b : α) : -(a + b) = -b + -a := by
      rw [←add_right_cancel _ _ (a + b), neg_add, add_assoc, ←add_assoc (-a), neg_add, zero_add, neg_add]

    theorem neg_inj [g : Group α] : Function.injective g.neg := by
      intro x y h; rw [←neg_neg x, ←neg_neg y]; exact congrArg g.neg h

    protected class constructor_g (α : Type _) extends Zero α, Add α, Neg α where
      add_zero  : ∀ a : α, a + 0 = a
      add_assoc : ∀ a b c : α, (a + b) + c = a + (b + c)
      add_neg   : ∀ a : α, a + (-a) = 0

    protected def construct {α : Type _} (c : Group.constructor_g α) : Group α where
      add_zero := c.add_zero
      zero_add := fun a => by
        rw [←c.add_neg a, c.add_assoc]
        (conv => lhs rhs rhs rw [←c.add_zero a, ←c.add_neg (-a), ←c.add_assoc, c.add_neg])
        rw [←c.add_assoc (-a), c.add_zero, c.add_neg, c.add_zero]
      add_assoc := c.add_assoc
      add_neg := c.add_neg

    protected def to_constructor (α : Type _) [Group α] : Group.constructor_g α where
      add_zero  := Monoid.add_zero
      add_assoc := Monoid.add_assoc
      add_neg   := Group.add_neg

  end Group

  namespace AbelianGroup

    protected instance Product (α₁ : Type _) (α₂ : Type _) [AbelianGroup α₁] [AbelianGroup α₂] : AbelianGroup (α₁ × α₂) where
      add_comm := (CommMonoid.Product α₁ α₂).add_comm

    protected instance multi_product {ι : Type _} (fι : ι → Type _) [∀ i, AbelianGroup (fι i)] : AbelianGroup (MultiProd fι) where
      add_comm := (CommMonoid.multi_product fι).add_comm

    protected class constructor_ab (α : Type _) extends Group.constructor_g α, CommMonoid.constructor_cm α

    protected def construct {α : Type _} (c : AbelianGroup.constructor_ab α) : AbelianGroup α where
      toGroup  := Group.construct c.toconstructor_g
      add_comm := c.add_comm

    protected def to_constructor (α : Type _) [AbelianGroup α] : AbelianGroup.constructor_ab α where
      toconstructor_g := Group.to_constructor α
      add_comm        := CommMonoid.add_comm

    protected theorem neg_add_distrib [AbelianGroup α] (a b : α) : -(a + b) = -a + -b := by
      rw [Group.neg_add_distrib, add_comm]

  end AbelianGroup

  instance IntGroup : AbelianGroup Int := AbelianGroup.construct
  {
    add_zero  := Int.add_zero
    add_assoc := Int.add_assoc
    add_neg   := Int.add_neg
    add_comm  := Int.add_comm
  }

end M4R


import tuto_lib

section
/-
The first part of this file makes sure you can negate quantified statements
in your head without the help of `push_neg`.

You need to complete the statement and then use the `check_me` tactic
to check your answer. This tactic exists only for those exercises,
it mostly calls `push_neg` and then cleans up a bit.

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε
-/

-- In this section, u denotes a sequence of real numbers
-- f is a function from ℝ to ℝ
-- x₀ and l are real numbers
variables (u : ℕ → ℝ) (f : ℝ → ℝ) (x₀ l : ℝ)

/- Negation of "u tends to l" -/
-- 0062
example : ¬ (∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε) ↔
sorry
:=
begin
  sorry
end

/- Negation of "f is continuous at x₀" -/
-- 0063
example : ¬ (∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ →  |f x - f x₀| ≤ ε) ↔
sorry
:=
begin
  sorry
end

/-
In the next exercise, we need to keep in mind that
`∀ x x', ...` is the abbreviation of
`∀ x, ∀ x', ... `.

Also, `∃ x x', ...` is the abbreviation of `∃ x, ∃ x', ...`.
-/

/- Negation of "f is uniformly continuous on ℝ" -/
-- 0064
example : ¬ (∀ ε > 0, ∃ δ > 0, ∀ x x', |x' - x| ≤ δ →  |f x' - f x| ≤ ε) ↔
sorry
:=
begin
  sorry
end

/- Negation of "f is sequentially continuous at x₀" -/
-- 0065
example : ¬ (∀ u : ℕ → ℝ, (∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - x₀| ≤ ε) → (∀ ε > 0, ∃ N, ∀ n ≥ N, |(f ∘ u) n - f x₀| ≤ ε))  ↔
sorry
:=
begin
  sorry
end
end

/-
We now turn to elementary applications of negations to limits of sequences.
Remember that `linarith` can find easy numerical contradictions.

Also recall the following lemmas:

abs_le (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

/-- The sequence `u` tends to `+∞`. -/
def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A
-/

-- 0066
example {u : ℕ → ℝ} : tendsto_infinity u → ∀ l, ¬ seq_limit u l :=
begin
  sorry
end

def nondecreasing_seq (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

-- 0067
example (u : ℕ → ℝ) (l : ℝ) (h : seq_limit u l) (h' : nondecreasing_seq u) :
  ∀ n, u n ≤ l :=
begin
  sorry
end

/-
In the following exercises, `A : set ℝ` means that A is a set of real numbers.
We can use the usual notation x ∈ A.

The notation `∀ x ∈ A, ...` is the abbreviation of `∀ x, x ∈ A → ... `

The notation `∃ x ∈ A, ...` is the abbreviation of `∃ x, x ∈ A ∧ ... `.
More precisely it is the abbreviation of `∃ x (H : x ∈ A), ...`
which is Lean's strange way of saying `∃ x, x ∈ A ∧ ... `.
You can convert between these forms using the lemma
  exists_prop {p q : Prop} : (∃ (h : p), q) ↔ p ∧ q

We'll work with upper bounds and supremums.
Again we'll introduce specialized definitions for the sake of exercises, but mathlib
has more general versions.

def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

Remark: one can easily show that a set of real numbers has at most one sup,
but we won't need this.
-/

-- 0068
example {A : set ℝ} {x : ℝ} (hx : is_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  sorry
end

/-
Let's do a variation on an example from file 07 that will be useful in the last
exercise below.
-/

-- 0069
lemma le_of_le_add_all' {x y : ℝ} :
  (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  sorry
end

-- 0070
example {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∀ n, u n ≤ y) : x ≤ y :=
begin
  sorry
end


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

/-!

# Functions in Lean.

In this sheet we'll learn how to manipulate the concepts of
injectivity and surjectivity in Lean.

The notation for functions is the usual one in mathematics:
if `X` and `Y` are types, then `f : X → Y` denotes a function
from `X` to `Y`. In fact what is going on here is that `X → Y`
denotes the type of all functions from `X` to `Y`, and `f : X → Y`
means that `f` is a term of type `X → Y`, i.e., a function
from `X` to `Y`.

One thing worth mentioning is that the simplest kind of function
evaluation, where you have `x : X` and `f : X → Y`, doesn't need
brackets: you can just write `f x` instead of `f(x)`. You only
need it when evaluating a function at a more complex object;
for example if we also had `g : Y → Z` then we can't write
`g f x` for `g(f(x))`, we have to write `g(f x)` otherwise
`g` would eat `f` and get confused. Without brackets,
a function just eats the next term greedily.

## The API we'll be using

Lean has the predicates `function.injective` and `function.surjective` on functions.
In other words, if `f : X → Y` is a function, then `function.injective f`
and `function.surjective f` are true-false statements.

-/

-- Typing `function.` gets old quite quickly, so let's open the function namespace
open function

-- Now we can just write `injective f` and `surjective f`.

 -- Our functions will go between these sets, or Types as Lean calls them
variables (X Y Z : Type)

-- Let's prove some theorems, each of which are true by definition.

theorem injective_def (f : X → Y) :
  injective f ↔ ∀ (a b : X), f a = f b → a = b :=
begin
  refl -- this proof works, because `injective f`
       -- means ∀ a b, f a = f b → a = b *by definition*
       -- so the proof is "it's reflexivity of `↔`"
end

-- similarly this is the *definition* of `surjective f`
theorem surjective_def (f : X → Y) :
  surjective f ↔ ∀ b : Y, ∃ a : X, f a = b :=
begin
  refl
end

-- similarly the *definition* of `id x` is `x`
theorem id_eval (x : X) :
  id x = x :=
begin
  refl
end

-- Function composition is `∘` in Lean (find out how to type it by putting your cursor on it).
-- The *definition* of (g ∘ f) (x) is g(f(x)).
theorem comp_eval (f : X → Y) (g : Y → Z) (x : X) :
  (g ∘ f) x = g (f x) :=
begin
  refl
end

-- Why did we just prove all those theorems with a proof
-- saying "it's true by definition"? Because now, if we want,
-- we can `rw` the theorems to replace things by their definitions.

example : injective (id : X → X) :=
begin
  -- you can start with `rw injective_def` if you like,
  -- and later you can `rw id_eval`, although `rw` doesn't
  -- work under binders like `∀`, so use `intro` first.
  sorry
end

example : surjective (id : X → X) :=
begin
  sorry
end

example (f : X → Y) (g : Y → Z) (hf : injective f) (hg : injective g) :
  injective (g ∘ f) :=
begin
  sorry
end

example (f : X → Y) (g : Y → Z) (hf : surjective f) (hg : surjective g) :
  surjective (g ∘ f) :=
begin
  sorry,
end

-- This is a question on the IUM function problem sheet
example (f : X → Y) (g : Y → Z) :
  injective (g ∘ f) → injective f :=
begin
  sorry
end

-- This is another one
example (f : X → Y) (g : Y → Z) :
  surjective (g ∘ f) → surjective g :=
begin
  sorry
end


import MyNat.Definition
namespace MyNat
open MyNat
/-!

# Advanced proposition world.

## Level 4: `iff_trans`.

The mathematical statement `P ↔ Q` is equivalent to `(P ⟹ Q) ∧ (Q ⟹ P)`. The `cases`
and `split` tactics work on hypotheses and goals (respectively) of the form `P ↔ Q`.

> If you need to write an `↔` arrow in Visual Studio Code you can do so by typing `\iff`.
See the "Lean 4: Show All Abbreviations" command.

After an initial `intro h` you can type `cases h with hpq hqp` to break `h : P ↔ Q` into its constituent parts.

## Lemma
If `P`, `Q` and `R` are true/false statements, then `P ↔ Q` and `Q ↔ R` together imply `P ↔ R`.
-/
lemma iff_trans (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) := by
  intro hpq
  intro hqr
  constructor
  cases hpq with
  | intro pq qp =>
    cases hqr with
    | intro qr rq =>
      intro p
      apply qr
      apply pq
      exact p
  cases hpq with
  | intro pq qp =>
    cases hqr with
    | intro qr rq =>
      intro r
      apply qp
      apply rq
      exact r
/-!

Next up [Level 5](./Level5.lean.md)
-/


import tactic
import data.real.sqrt
import analysis.specific_limits.basic
import analysis.specific_limits.normed

open filter real

open_locale topological_space
noncomputable theory

theorem rudin_3_1 (f : ℕ → ℝ)
  (h : ∃ (a : ℝ), tendsto (λ (n : ℕ), f n) at_top (𝓝 a)) :
  ∃ (a : ℝ), tendsto (λ (n : ℕ), |f n|) at_top (𝓝 a) :=
begin
  cases h with a h,
  use |a|,
  apply filter.tendsto.abs h,
end

theorem rudin_3_2 :
  tendsto (λ (n : ℝ), (sqrt (n^2 + n) - n)) at_top (𝓝 (1/2)) :=
begin
  sorry,
end

theorem rudin_3_3 (f : ℕ → ℝ) (hf1 : f 0 = sqrt 2)
  (hf2 : ∀ n : ℕ, f n.succ = sqrt(2 + sqrt (f n))) :
  ∃ (x : ℝ), tendsto f at_top (𝓝 x) ∧ ∀ n, f n < 2 :=
begin
  sorry,
end

theorem rudin_3_22 (X : Type*) [metric_space X] [complete_space X] (G : ℕ → set X)
  (hG : ∀ n : ℕ, is_open (G n) ∧ dense (G n)) :
  ∃ x : X, ∀ n : ℕ, x ∈ G n
:=
begin
  sorry,
end


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import linear_algebra.basis
import algebra.free_algebra
import linear_algebra.finsupp_vector_space
/-!
# Linear algebra properties of `free_algebra R X`

This file provides a `free_monoid X` basis on the `free_algebra R X`, and uses it to show the
dimension of the algebra is the cardinality of `list X`
-/

universes u v

namespace free_algebra

/-- The `free_monoid X` basis on the `free_algebra R X`,
mapping `[x₁, x₂, ..., xₙ]` to the "monomial" `1 • x₁ * x₂ * ⋯ * xₙ` -/
@[simps]
noncomputable def basis_free_monoid (R : Type u) (X : Type v) [comm_ring R] :
  basis (free_monoid X) R (free_algebra R X) :=
finsupp.basis_single_one.map
  (equiv_monoid_algebra_free_monoid.symm.to_linear_equiv : _ ≃ₗ[R] free_algebra R X)

-- TODO: generalize to `X : Type v`
lemma dim_eq {K : Type u} {X : Type (max u v)} [field K] :
  module.rank K (free_algebra K X) = cardinal.mk (list X) :=
(cardinal.lift_inj.mp (basis_free_monoid K X).mk_eq_dim).symm

end free_algebra


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

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 6 : "or" (∨`)

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

## Tactics

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

* `left` and `right`
* `cases` (new functionality)

### The `left` and `right` tactics.

If your goal is `⊢ P ∨ Q` then `left,` will change it to `⊢ P`
and `right,` will change it to `⊢ Q`.

### The `cases` tactic again

If we have `h : P ∨ Q` as a hypothesis then `cases h with hP hQ`
will turn your goal into two goals, one with `hP : P` as a hypothesis
and the other with `hQ : Q`.

-/

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

variables (P Q R S : Prop)

example : P → P ∨ Q :=
begin
  intro hP,
  left,
  apply hP,
end

example : Q → P ∨ Q :=
begin
  intro hQ,
  right, apply hQ,
end

example : P ∨ Q → (P → R) → (Q → R) → R :=
begin
  intros hPQ h₁ h₂,
  cases hPQ with hP hQ,
  apply h₁ hP,
  apply h₂ hQ,
end

-- symmetry of `or`
example : P ∨ Q → Q ∨ P :=
begin
  intro hPQ,
  cases hPQ with hP hQ,
  right,
  exact hP,
  left,
  exact hQ,
end

-- associativity of `or`
example : (P ∨ Q) ∨ R ↔ P ∨ (Q ∨ R) :=
begin
  split,
  {intros h,
  cases h with hPQ hR,
  cases hPQ with hP hQ,
  left, apply hP,
  right, left, apply hQ,
  right, right, apply hR,},
  intro h,
  cases h with hP hQR,
  left, left, apply hP,
  cases hQR with hQ hR,
  left, right, apply hQ,
  right, apply hR,
end

example : (P → R) → (Q → S) → P ∨ Q → R ∨ S :=
begin
  intros hPR hQS hPQ,
  cases hPQ with hP hQ,
  left,
  apply hPR hP,
  right,
  apply hQS hQ,
end

example : (P → Q) → P ∨ R → Q ∨ R :=
begin
  intros hPQ hPR,
  cases hPR,
  left,
  apply hPQ hPR,
  right,
  apply hPR,
end

example : (P ↔ R) → (Q ↔ S) → (P ∨ Q ↔ R ∨ S) :=
begin
  intros hPR hQS,
  split,
  {intro hPQ,
  cases hPQ with hP hQ,
  left, rw ←hPR, apply hP,
  right, rw ←hQS, apply hQ,},
  intro hRS,
  cases hRS,
  left, rw hPR, apply hRS,
  right, rw hQS, apply hRS,
end

-- de Morgan's laws
example : ¬ (P ∨ Q) ↔ ¬ P ∧ ¬ Q :=
begin
  split,
  {intro h1,
  by_cases P,
  {have hPQ: P ∨ Q, {left, exact h,},
  trivial,},
  split,
  exact h,
  by_cases Q,
  {have hPQ : P ∨ Q, {right, exact h,},
  by_contra hPQ,
  trivial,},
  exact h,
  },
  intro h,
  by_cases P ∨ Q,
  cases h with hP hQ,
  have hP': ¬ P, by exact h.1,
  trivial,                          /-attention!-/
  have hQ': ¬ Q, by exact h.2,
  trivial,
  exact h,
end

example : ¬ (P ∧ Q) ↔ ¬ P ∨ ¬ Q :=
begin
  split,
  {intro h,
  by_cases P,
  {have hQ : Q ∨ ¬ Q,
  {by_cases Q, left, exact h, right, exact h},
  cases hQ with hQ hQ',
  {have hPQ : P ∧ Q, {split, exact h, exact hQ,},
  trivial,},
  right, exact hQ',},
  left, exact h,
  },
  intro h,
  cases h with hP' hQ',
  {change P → false at hP',
  have hPQ': P ∧ Q → false,
  {intro h₁, exact hP' h₁.1,},
  trivial,},
  {change Q → false at hQ',
  have hPQ': P ∧ Q → false,
  {intro h₂, exact hQ' h₂.2,},
  trivial,},
end


import tactic

/-!
# Cubic equations with infinitely many solutions

The goal of this project is to prove the following

**Theorem.** If a > 2 is a cube-free integer such that the equation
  x³ + y³ = a                                                       (59)
has a solution in rational numbers, then it has infinitely many rational solutions.

See Ireland-Rosen, §17.9:

We say that an integer a is *cube-free* if ordₚ a ≤ 2 for all primes p, that is,
no cube ≠ ±1 divides a.

PROOF (of the theorem above).
Let (α, β) be a rational point on (59). If α = x₁/z₁, β = y₁/z₁' and
gcd(x₁, z₁) = gcd(y₁, z₁') = 1 with x₁, y₁, z₁, z₁' integers, then it is easy to see
that z₁ = z₁'. Since a > 2 is cube-free, x₁ y₁ ≠ 0 and x₁ ≠ y₁. The tangent line to (59) at
(α, β) is α² x + β² y = a. Solving for y and substituting in (59) gives
  x³ + ((a - α² x)/β²)³ - a = 0.                                    (60)
The left-hand side of (60) is a cubic pol ynomial with α as a double root (at least).
Ifthe third root is γ, then since the sum of the roots is the negative of
the coefficient of x², we obtain after a simple calculation,
  2 α + γ = 3 α⁴/(α³ - β³) .                                        (61)
Thus
  γ = α(α³ + 2β³)/(α³ - β³) = (x₁/z₁) (x₁³ + 2y₁³)/(x₁³ - y₁³) .    (62)
The corresponding value for y = (a - α² x)/β² is
  ρ = (-y₁/z₁) (2x₁³ + y₁³)/(x₁³ - y₁³)                             (63)
and by (60), (γ, ρ) is a rational point on the cubic. The reader may verify
directly, of course, that (γ, ρ) satisfies γ³ + ρ³ = a. It remains to show that
(γ, ρ) is distinct from (α, β) and moreover that one obtains by this process an
infinite number of points on the curve. Define the integer A by A > 0 and
  A x₂ = x₁(x₁³ + 2y₁³),
  A y₂ = -y₁(2x₁³ + y₁³),                                           (64)
  A z₂ = z₁(x₁³ - y₁³),
with gcd(x₂, y₂, z₂) = 1. Thus A is the greatest common divisor of the integers on
the right-hand side of (64). Clearly one has
  x₂³ + y₂³ = a z₂³,  z₂ ≠ 0.                                       (65)
Since a is cube-free and gcd(x₂, y₂, z₂) = 1, we see that gcd(x₂, y₂) = gcd(x₂, z₂) =
gcd(y₂, z₂) = 1. We claim that A is equal to 1 or 3. For if p is prime and p ∣ A, then
it follows without difficulty from (64) that p does not divide x₁ y₁ z₁. Thus p divides
each of the second factors on the right-hand side of (64) and consequently p ∣ 3 y₁³.
Thus p is 1 or 3. Notice, also, that gcd(A, z₁) = 1 implies A ∣ x₁³ - y₁³.

The proof will be completed by showing that |z₂| > |z₁|. To this end one has
  |z₂| = (|z₁|/A) |x₁³ - y₁³| = (|z₁|/A) |x₁ - y₁| |x₁² + x₁ y₁ + y₁²|. (66)
One sees, 4 |x₁² + x₁ y₁ + y₁²| = |(2x₁ + Y₁)² + 3y₁²| > 4 and consequently
one has the inequality |z₂| > |z₁| |x₁ - y₁|/A. If A = 1, then (66) shows
that |z₂| > |z₁|. On the other hand, if A = 3, then since A | x₁³ - y₁³, one has
x₁³ ≡ y₁³ mod 3, which implies that x₁ ≡ y₁ mod 3, and once again (66) implies
that |z₂| > |z₁|. Continuing in this manner, one obtains a succession of points
(xₙ/zₙ, yₙ/zₙ), xₙ yₙ ≠ 0, gcd(xₙ, zₙ) = gcd(yₙ, zₙ) = 1 and |zₙ| > |zₙ₋₁|, and the
proof is co mplete. QED

-/


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import analysis.special_functions.bernstein
import topology.algebra.algebra

/-!
# The Weierstrass approximation theorem for continuous functions on `[a,b]`

We've already proved the Weierstrass approximation theorem
in the sense that we've shown that the Bernstein approximations
to a continuous function on `[0,1]` converge uniformly.

Here we rephrase this more abstractly as
`polynomial_functions_closure_eq_top' : (polynomial_functions I).topological_closure = ⊤`
and then, by precomposing with suitable affine functions,
`polynomial_functions_closure_eq_top : (polynomial_functions (set.Icc a b)).topological_closure = ⊤`
-/

open continuous_map filter
open_locale unit_interval

/--
The special case of the Weierstrass approximation theorem for the interval `[0,1]`.
This is just a matter of unravelling definitions and using the Bernstein approximations.
-/
theorem polynomial_functions_closure_eq_top' :
  (polynomial_functions I).topological_closure = ⊤ :=
begin
  apply eq_top_iff.mpr,
  rintros f -,
  refine filter.frequently.mem_closure _,
  refine filter.tendsto.frequently (bernstein_approximation_uniform f) _,
  apply frequently_of_forall,
  intro n,
  simp only [set_like.mem_coe],
  apply subalgebra.sum_mem,
  rintro n -,
  apply subalgebra.smul_mem,
  dsimp [bernstein, polynomial_functions],
  simp,
end

/--
The **Weierstrass Approximation Theorem**:
polynomials functions on `[a, b] ⊆ ℝ` are dense in `C([a,b],ℝ)`

(While we could deduce this as an application of the Stone-Weierstrass theorem,
our proof of that relies on the fact that `abs` is in the closure of polynomials on `[-M, M]`,
so we may as well get this done first.)
-/
theorem polynomial_functions_closure_eq_top (a b : ℝ) :
  (polynomial_functions (set.Icc a b)).topological_closure = ⊤ :=
begin
  by_cases h : a < b, -- (Otherwise it's easy; we'll deal with that later.)
  { -- We can pullback continuous functions on `[a,b]` to continuous functions on `[0,1]`,
    -- by precomposing with an affine map.
    let W : C(set.Icc a b, ℝ) →ₐ[ℝ] C(I, ℝ) :=
      comp_right_alg_hom ℝ ℝ (Icc_homeo_I a b h).symm.to_continuous_map,
    -- This operation is itself a homeomorphism
    -- (with respect to the norm topologies on continuous functions).
    let W' : C(set.Icc a b, ℝ) ≃ₜ C(I, ℝ) := comp_right_homeomorph ℝ (Icc_homeo_I a b h).symm,
    have w : (W : C(set.Icc a b, ℝ) → C(I, ℝ)) = W' := rfl,
    -- Thus we take the statement of the Weierstrass approximation theorem for `[0,1]`,
    have p := polynomial_functions_closure_eq_top',
    -- and pullback both sides, obtaining an equation between subalgebras of `C([a,b], ℝ)`.
    apply_fun (λ s, s.comap W) at p,
    simp only [algebra.comap_top] at p,
    -- Since the pullback operation is continuous, it commutes with taking `topological_closure`,
    rw subalgebra.topological_closure_comap_homeomorph _ W W' w at p,
    -- and precomposing with an affine map takes polynomial functions to polynomial functions.
    rw polynomial_functions.comap_comp_right_alg_hom_Icc_homeo_I at p,
    -- 🎉
    exact p },
  { -- Otherwise, `b ≤ a`, and the interval is a subsingleton,
    -- so all subalgebras are the same anyway.
    haveI : subsingleton (set.Icc a b) := ⟨λ x y, le_antisymm
      ((x.2.2.trans (not_lt.mp h)).trans y.2.1) ((y.2.2.trans (not_lt.mp h)).trans x.2.1)⟩,
    apply subsingleton.elim, }
end

/--
An alternative statement of Weierstrass' theorem.

Every real-valued continuous function on `[a,b]` is a uniform limit of polynomials.
-/
theorem continuous_map_mem_polynomial_functions_closure (a b : ℝ) (f : C(set.Icc a b, ℝ)) :
  f ∈ (polynomial_functions (set.Icc a b)).topological_closure :=
begin
  rw polynomial_functions_closure_eq_top _ _,
  simp,
end

open_locale polynomial

/--
An alternative statement of Weierstrass' theorem,
for those who like their epsilons.

Every real-valued continuous function on `[a,b]` is within any `ε > 0` of some polynomial.
-/
theorem exists_polynomial_near_continuous_map (a b : ℝ) (f : C(set.Icc a b, ℝ))
  (ε : ℝ) (pos : 0 < ε) :
  ∃ (p : ℝ[X]), ‖p.to_continuous_map_on _ - f‖ < ε :=
begin
  have w := mem_closure_iff_frequently.mp (continuous_map_mem_polynomial_functions_closure _ _ f),
  rw metric.nhds_basis_ball.frequently_iff at w,
  obtain ⟨-, H, ⟨m, ⟨-, rfl⟩⟩⟩ := w ε pos,
  rw [metric.mem_ball, dist_eq_norm] at H,
  exact ⟨m, H⟩,
end

/--
Another alternative statement of Weierstrass's theorem,
for those who like epsilons, but not bundled continuous functions.

Every real-valued function `ℝ → ℝ` which is continuous on `[a,b]`
can be approximated to within any `ε > 0` on `[a,b]` by some polynomial.
-/
theorem exists_polynomial_near_of_continuous_on
  (a b : ℝ) (f : ℝ → ℝ) (c : continuous_on f (set.Icc a b)) (ε : ℝ) (pos : 0 < ε) :
  ∃ (p : ℝ[X]), ∀ x ∈ set.Icc a b, |p.eval x - f x| < ε :=
begin
  let f' : C(set.Icc a b, ℝ) := ⟨λ x, f x, continuous_on_iff_continuous_restrict.mp c⟩,
  obtain ⟨p, b⟩ := exists_polynomial_near_continuous_map a b f' ε pos,
  use p,
  rw norm_lt_iff _ pos at b,
  intros x m,
  exact b ⟨x, m⟩,
end


/-
Copyright (c) 2020 Heather Macbeth, Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.subgroup
import Mathlib.algebra.archimedean
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Archimedean groups

This file proves a few facts about ordered groups which satisfy the `archimedean` property, that is:
`class archimedean (α) [ordered_add_comm_monoid α] : Prop :=`
`(arch : ∀ (x : α) {y}, 0 < y → ∃ n : ℕ, x ≤ n •ℕ y)`

They are placed here in a separate file (rather than incorporated as a continuation of
`algebra.archimedean`) because they rely on some imports from `group_theory` -- bundled subgroups
in particular.

The main result is `add_subgroup.cyclic_of_min`:  a subgroup of a decidable archimedean abelian
group is cyclic, if its set of positive elements has a minimal element.

This result is used in this file to deduce `int.subgroup_cyclic`, proving that every subgroup of `ℤ`
is cyclic.  (There are several other methods one could use to prove this fact, including more purely
algebraic methods, but none seem to exist in mathlib as of writing.  The closest is
`subgroup.is_cyclic`, but that has not been transferred to `add_subgroup`.)

The result is also used in `topology.instances.real` as an ingredient in the classification of
subgroups of `ℝ`.
-/

/-- Given a subgroup `H` of a decidable linearly ordered archimedean abelian group `G`, if there
exists a minimal element `a` of `H ∩ G_{>0}` then `H` is generated by `a`. -/
theorem add_subgroup.cyclic_of_min {G : Type u_1} [linear_ordered_add_comm_group G] [archimedean G] {H : add_subgroup G} {a : G} (ha : is_least (set_of fun (g : G) => g ∈ H ∧ 0 < g) a) : H = add_subgroup.closure (singleton a) := sorry

/-- Every subgroup of `ℤ` is cyclic. -/
theorem int.subgroup_cyclic (H : add_subgroup ℤ) : ∃ (a : ℤ), H = add_subgroup.closure (singleton a) := sorry


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

! This file was ported from Lean 3 source module init.data.int.comp_lemmas
! leanprover-community/mathlib commit 4a03bdeb31b3688c31d02d7ff8e0ff2e5d6174db
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Int.Order

namespace Int

/-!
# Auxiliary lemmas for proving that two int numerals are differen
-/

/-! 1. Lemmas for reducing the problem to the case where the numerals are positive -/

protected theorem ne_neg_of_ne {a b : ℤ} : a ≠ b → -a ≠ -b := fun h₁ h₂ =>
  absurd (Int.neg_eq_neg h₂) h₁
#align int.ne_neg_of_ne Int.ne_neg_of_ne

protected theorem neg_ne_zero_of_ne {a : ℤ} : a ≠ 0 → -a ≠ 0 := fun h₁ h₂ =>
  by
  have : -a = -0 := by rwa [Int.neg_zero]
  have : a = 0 := Int.neg_eq_neg this
  contradiction
#align int.neg_ne_zero_of_ne Int.neg_ne_zero_of_ne

protected theorem zero_ne_neg_of_ne {a : ℤ} (h : 0 ≠ a) : 0 ≠ -a :=
  Ne.symm (Int.neg_ne_zero_of_ne (Ne.symm h))
#align int.zero_ne_neg_of_ne Int.zero_ne_neg_of_ne

protected theorem neg_ne_of_pos {a b : ℤ} : 0 < a → 0 < b → -a ≠ b := fun h₁ h₂ h =>
  by
  rw [← h] at h₂
  change 0 < a at h₁
  have := le_of_lt h₁
  exact absurd (le_of_lt h₁) (not_le_of_gt (Int.neg_of_neg_pos h₂))
#align int.neg_ne_of_pos Int.neg_ne_of_pos

protected theorem ne_neg_of_pos {a b : ℤ} : 0 < a → 0 < b → a ≠ -b := fun h₁ h₂ =>
  Ne.symm (Int.neg_ne_of_pos h₂ h₁)
#align int.ne_neg_of_pos Int.ne_neg_of_pos

/-! 2. Lemmas for proving that positive int numerals are nonneg and positive -/

protected theorem one_pos : 0 < (1 : Int) :=
  Int.zero_lt_one
#align int.one_pos Int.one_pos

protected theorem bit0_pos {a : ℤ} : 0 < a → 0 < bit0 a := fun h => Int.add_pos h h
#align int.bit0_pos Int.bit0_pos

protected theorem bit1_pos {a : ℤ} : 0 ≤ a → 0 < bit1 a := fun h =>
  Int.lt_add_of_le_of_pos (Int.add_nonneg h h) Int.zero_lt_one
#align int.bit1_pos Int.bit1_pos

protected theorem zero_nonneg : 0 ≤ (0 : ℤ) :=
  le_refl 0
#align int.zero_nonneg Int.zero_nonneg

protected theorem one_nonneg : 0 ≤ (1 : ℤ) :=
  le_of_lt Int.zero_lt_one
#align int.one_nonneg Int.one_nonneg

protected theorem bit0_nonneg {a : ℤ} : 0 ≤ a → 0 ≤ bit0 a := fun h => Int.add_nonneg h h
#align int.bit0_nonneg Int.bit0_nonneg

protected theorem bit1_nonneg {a : ℤ} : 0 ≤ a → 0 ≤ bit1 a := fun h => le_of_lt (Int.bit1_pos h)
#align int.bit1_nonneg Int.bit1_nonneg

protected theorem nonneg_of_pos {a : ℤ} : 0 < a → 0 ≤ a :=
  le_of_lt
#align int.nonneg_of_pos Int.nonneg_of_pos

/-! 3. nat_abs auxiliary lemmas -/

/- warning: int.neg_succ_of_nat_lt_zero clashes with int.neg_succ_lt_zero -> Int.negSucc_lt_zero
Case conversion may be inaccurate. Consider using '#align int.neg_succ_of_nat_lt_zero Int.negSucc_lt_zeroₓ'. -/
#print Int.negSucc_lt_zero /-
theorem negSucc_lt_zero (n : ℕ) : negSucc n < 0 :=
  @lt.intro _ _ n
    (by
      simp [neg_succ_of_nat_coe, Int.ofNat_succ, Int.ofNat_add, Int.ofNat_one, Int.add_comm,
        Int.add_left_comm, Int.neg_add, Int.add_right_neg, Int.zero_add])
#align int.neg_succ_of_nat_lt_zero Int.negSucc_lt_zero
-/

theorem zero_le_ofNat (n : ℕ) : 0 ≤ ofNat n :=
  @le.intro _ _ n (by rw [Int.zero_add, Int.coe_nat_eq])
#align int.zero_le_of_nat Int.zero_le_ofNat

#print Int.ofNat_natAbs_eq_of_nonneg /-
theorem ofNat_natAbs_eq_of_nonneg : ∀ {a : ℤ}, 0 ≤ a → ofNat (natAbs a) = a
  | of_nat n, h => rfl
  | neg_succ_of_nat n, h => absurd (negSucc_lt_zero n) (not_lt_of_ge h)
#align int.of_nat_nat_abs_eq_of_nonneg Int.ofNat_natAbs_eq_of_nonneg
-/

theorem ne_of_natAbs_ne_natAbs_of_nonneg {a b : ℤ} (ha : 0 ≤ a) (hb : 0 ≤ b)
    (h : natAbs a ≠ natAbs b) : a ≠ b := fun h =>
  by
  have : ofNat (natAbs a) = ofNat (natAbs b) := by
    rwa [of_nat_nat_abs_eq_of_nonneg ha, of_nat_nat_abs_eq_of_nonneg hb]
  injection this
  contradiction
#align int.ne_of_nat_abs_ne_nat_abs_of_nonneg Int.ne_of_natAbs_ne_natAbs_of_nonneg

protected theorem ne_of_nat_ne_nonneg_case {a b : ℤ} {n m : Nat} (ha : 0 ≤ a) (hb : 0 ≤ b)
    (e1 : natAbs a = n) (e2 : natAbs b = m) (h : n ≠ m) : a ≠ b :=
  have : natAbs a ≠ natAbs b := by rwa [e1, e2]
  ne_of_natAbs_ne_natAbs_of_nonneg ha hb this
#align int.ne_of_nat_ne_nonneg_case Int.ne_of_nat_ne_nonneg_case

/-! 4. Aux lemmas for pushing nat_abs inside numerals
   nat_abs_zero and nat_abs_one are defined at init/data/int/basic.lean -/

theorem natAbs_ofNat_core (n : ℕ) : natAbs (ofNat n) = n :=
  rfl
#align int.nat_abs_of_nat_core Int.natAbs_ofNat_core

theorem natAbs_of_negSucc (n : ℕ) : natAbs (negSucc n) = Nat.succ n :=
  rfl
#align int.nat_abs_of_neg_succ_of_nat Int.natAbs_of_negSucc

protected theorem natAbs_add_nonneg :
    ∀ {a b : Int}, 0 ≤ a → 0 ≤ b → natAbs (a + b) = natAbs a + natAbs b
  | of_nat n, of_nat m, h₁, h₂ =>
    by
    have : ofNat n + ofNat m = ofNat (n + m) := rfl
    simp [nat_abs_of_nat_core, this]
  | _, neg_succ_of_nat m, h₁, h₂ => absurd (negSucc_lt_zero m) (not_lt_of_ge h₂)
  | neg_succ_of_nat n, _, h₁, h₂ => absurd (negSucc_lt_zero n) (not_lt_of_ge h₁)
#align int.nat_abs_add_nonneg Int.natAbs_add_nonneg

protected theorem natAbs_add_neg :
    ∀ {a b : Int}, a < 0 → b < 0 → natAbs (a + b) = natAbs a + natAbs b
  | neg_succ_of_nat n, neg_succ_of_nat m, h₁, h₂ =>
    by
    have : -[n+1] + -[m+1] = -[Nat.succ (n + m)+1] := rfl
    simp [nat_abs_of_neg_succ_of_nat, this, Nat.succ_add, Nat.add_succ]
#align int.nat_abs_add_neg Int.natAbs_add_neg

protected theorem natAbs_bit0 : ∀ a : Int, natAbs (bit0 a) = bit0 (natAbs a)
  | of_nat n => Int.natAbs_add_nonneg (zero_le_ofNat n) (zero_le_ofNat n)
  | neg_succ_of_nat n => Int.natAbs_add_neg (negSucc_lt_zero n) (negSucc_lt_zero n)
#align int.nat_abs_bit0 Int.natAbs_bit0

protected theorem natAbs_bit0_step {a : Int} {n : Nat} (h : natAbs a = n) :
    natAbs (bit0 a) = bit0 n := by rw [← h]; apply Int.natAbs_bit0
#align int.nat_abs_bit0_step Int.natAbs_bit0_step

protected theorem natAbs_bit1_nonneg {a : Int} (h : 0 ≤ a) : natAbs (bit1 a) = bit1 (natAbs a) :=
  show natAbs (bit0 a + 1) = bit0 (natAbs a) + natAbs 1 by
    rw [Int.natAbs_add_nonneg (Int.bit0_nonneg h) (le_of_lt Int.zero_lt_one), Int.natAbs_bit0]
#align int.nat_abs_bit1_nonneg Int.natAbs_bit1_nonneg

protected theorem natAbs_bit1_nonneg_step {a : Int} {n : Nat} (h₁ : 0 ≤ a) (h₂ : natAbs a = n) :
    natAbs (bit1 a) = bit1 n := by rw [← h₂]; apply Int.natAbs_bit1_nonneg h₁
#align int.nat_abs_bit1_nonneg_step Int.natAbs_bit1_nonneg_step

end Int


/- Even more induction! -/

variable (r : α → α → Prop)

-- The reflexive transitive closure of `r` as an inductive predicate
inductive RTC : α → α → Prop where
  -- Notice how declaring `r` as a `variable` instead of as a parameter instead of declaring it
  -- directly as a parameter of `RTC` means we don't have to write `RTC r a a` inside the
  -- declaration of `RTC`. This also works with recursive `def`s!
  | refl : RTC a a
  | trans : r a b → RTC b c → RTC a c

-- We have arbitrarily chosen a "left-biased" definition of `RTC.trans`, but can easily show the
-- mirror version by induction on the predicate
theorem RTC.trans' : RTC r a b → r b c → RTC r a c := by
  intros hab hbc
  induction hab with
  | refl => exact RTC.trans hbc RTC.refl
  -- `a/b/c` in the constructor `RTC.trans` are marked as *implicit* because we didn't specify them
  -- explicitly.
  -- Just like in other contexts, we can use `@` to specify/match implicit parameters in `induction`.
  | @trans a a' b haa' ha'b ih => exact RTC.trans haa' (ih hbc)

open Nat

-- By the way, we can leave out `:= fun p1 ... => match p1, ... with` at `def`
def double : Nat → Nat
  | zero   => 0
  | succ n => succ (succ (double n))

theorem double.inj : double n = double m → n = m := by
  intro h
  -- Try to finish this proof. You might find that the inductive case is impossible to solve!
  -- Do you see a different approach? If not, read on!
  induction n generalizing m with/-SOL-/
  | zero => cases m <;> trivial
  | succ n ih =>
    cases m with
    | zero => contradiction
    | succ m =>
      simp only [double] at h
      injection h with h
      injection h with h
      rw [ih h]
      -- alternatively:
      --apply congrArg
      --apply ih
      -- -- with `simp_all` we sometimes have to exclude "problematic" assumptions such as `ih` from fixpoint simplification
      --simp_all [-ih, double]

-- The issue with the above approach is that our inductive hypothesis is not sufficiently general!
-- When we begin induction, we have already fixed (introduced) a particular `m`, but for the inductive
-- step we need the inductive hypothesis for a *different* m.
-- We could avoid this by carefully introducing `m` (and `h`, which depends on it) only after `induction`:
-- ```
-- theorem double.inj : ∀ m, double n = double m → n = m := by
--   induction n with
--   | zero => intro m h; ...
--   ...
-- ```
-- `induction` even allows us to apply a tactic before *each* case:
-- ```
-- theorem double.inj : ∀ m, double n = double m → n = m := by
--   induction n with
--       intro m h
--   | zero => ...
--   ...
-- ```
-- However, it turns out that we do not have to change the theorem statement at all: if we simply say
-- ```
-- induction n generalizing m with
-- ```
-- then `induction` will automatically `revert` (yes, that's also a tactic) and re`intro`duce the variable(s)
-- before/after induction for us! So add `generalizing m` above, see how the inductive hypothesis is
-- affected, and then go finish that proof!

/- Partial & dependent maps -/

-- *Partial maps* are a useful data type for the semantics project and many other topics.
-- They map *some* keys of one type to values of another type.
abbrev Map (α β : Type) := α → Option β
-- We express partiality via the `Option` type, which either holds `some b` for `b : β`, or `none`.
-- Ctrl+click it for the whole definition.

namespace Map

def empty : Map α β := fun k => none

-- If we wanted a partial map for programming, we might choose a more efficient implementation such
-- as a search tree or a hash map. If, on the other hand, we are only interested in using it in a
-- formalization, a simple function like above is usually the simpler solution. For example, a
-- simple typing context `Γ` can be formalized as a partial map from variable names to their types.

-- The function-based definition makes defining operations such as a map update quite easy:

/-- Set the entry `k` of the map `m` to the value `v`. All other entries are unchanged. -/
def update [DecidableEq α] (m : Map α β) (k : α) (v : Option β) : Map α β :=
  fun k' => if k = k' then v else m k'

-- A `scoped` notation is activated only when opening/inside the current namespace
scoped notation:max m "[" k " ↦ " v "]" => update m k v

theorem apply_update [DecidableEq α] (m : Map α β) : m[k ↦ v] k = v := by simp [update]

-- hint: use function extensionality (`apply funext`)
theorem update_self [DecidableEq α] (m : Map α β) : m[k ↦ m k] = m := by
  funext k'  -- an abbreviation for `apply funext; intro k'`
  byCases h : k = k' <;> simp [update, h]

end Map

-- One interesting generalization of partial maps we can express in Lean are *dependent maps* where
-- the *type* of the value may depend on the key:
abbrev DepMap (α : Type) (β : α → Type) := (k : α) → Option (β k)

namespace DepMap

def empty : DepMap α β := fun k => none

-- If we try to define `update` as above, it turns out that we run into a type error!
-- You may want to use the "dependent if" `if h : p then t else e` that makes a *proof* of
-- the condition `p` available in each branch: `h : p` in the `then` branch and `h : ¬p` in the
-- `else` branch. You should then be able to use rewriting (e.g. `▸`) to fix the type error.
def update [DecidableEq α] (m : DepMap α β) (k : α) (v : Option (β k)) : DepMap α β :=
  fun k' => if h : k = k' then h ▸ v else m k'

local notation:max m "[" k " ↦ " v "]" => update m k v

-- This one should be as before...
theorem apply_update [DecidableEq α] (m : DepMap α β) : m[k ↦ v] k = v := by simp [update]

-- ...but this one is where the fun starts: try replicating the corresponding `Map` proof...
theorem update_self [DecidableEq α] (m : DepMap α β) : m[k ↦ m k] = m := by
  funext k'
  byCases h : k = k'
  case inl =>
    rw [h]
    simp [update]
  case inr =>
    simp [update, h]
-- and you should end up with an unsolved goal containing a subterm of the shape `(_ : a = b) ▸ c`. This
-- is the rewrite from `update`; the proof is elided as `_` by default because, as we said in week 1, Lean
-- considers all proofs of a proposition as equal, so we really don't care what proof is displayed there.
-- So how do we get rid of the `▸`? We know it is something like a match  on `Eq.refl`; more formally,
-- both `▸` and such a match compile down to an application of `Eq`'s *recursor* (week 3).
-- We know matches/recursors reduce ("go away") when applied to a matching constructor application,
-- i.e. for `▸` we have `(rfl ▸ c) ≡ c`.
-- So why didn't `simp` reduce away `(_ : a = b) ▸` if it works for `rfl` and all proofs are the same?
-- Well, all proofs of a *single* proposition are the same, but `rfl` is not a proof of `a = b` unless
-- `a` and `b` are in fact the same term! Thus the general way to get rid of `(_ : a = b) ▸` is to
-- first rewrite the goal with a proof of the very equality `a = b`. After that, `simp`, or definitional
-- equality in general, will get rid of the `▸`.
-- Now, for technical reasons we should use `rw` instead of `simp` itself to do this rewrite. The short
-- answer as to why that is is that `simp` tries to be *too clever* in this case: it will rewrite `a = b`
-- on both sides of the `▸` individually, which usually makes it more flexible (week 4, slide pages 17 & 20),
-- but in this case unfortunately leads to a type-incorrect proof. The "naive" strategy of `rw`, which will
-- simply replace all `a` with `b` everywhere simultaneously by applying the `Eq` recursor once at the root,
-- turns out to be the better approach in this case.
-- Phew, that was a lot of typing (in the theoretic sense and on my keyboard). If you can't get the proof to
-- work, don't worry about it, we will not bother you with this kind of "esoteric" proof again. If, on the
-- other hand, you are interested in this kind of strong dependent typing, we may have an interesting variant
-- of the semantics project to offer you next week!

end DepMap

open List Nat

/- Insertion Sort -/

-- We want to implement insertion sort in Lean and show that the resulting `List` is indeed sorted.
-- To that end, we first assume that the type `α` is of the type class `LE`, meaning that we can use
-- the symbol `≤` (\le) as notation.
-- We also assume (notice that cool dot notation) that this relation is decidable:
variable [LE α] [DecidableRel ((· ≤ ·) : α → α → Prop)]

-- First, we want to define a predicate that holds if a list is sorted.
-- The predicate should have three constructors:
-- The empty list `[]` and the single element list `[a]` are sorted,
-- and we can add `a` to the front of a sorted list `b :: l`, if `a ≤ b`.s
inductive Sorted : List α → Prop where
  | nil : Sorted []
  | single : Sorted [a]
  | cons_cons : a ≤ b → Sorted (b::l) → Sorted (a::b::l)

-- The main ingredient to insertion sort is a function `insertInOrder` which inserts
-- a given element `a` before the first entry `x` of a list for which `a ≤ x` holds.
-- Define that function by recursion on the list. Remember that `≤` is decidable.
def insertInOrder (a : α) (xs : List α) : List α :=
  match xs with
  | [] => [a]
  | x :: xs =>
    if a ≤ x then
      a :: x :: xs
    else
      x :: insertInOrder a xs

-- Now, see whether the function actually does what it should do.
#eval insertInOrder 4 [1, 3, 4, 6, 7]
#eval insertInOrder 4 [1, 2, 3]

-- Defining `insertionSort` itself is now an easy recursion.
def insertionSort (xs : List α) : List α :=
  match xs with
  | []      => []
  | x :: xs => insertInOrder x (insertionSort xs)

-- Let's test the sorting algorithm next.
#eval insertionSort [6, 2, 4, 4, 1, 3, 64]
#eval insertionSort [1, 2, 3]
#eval insertionSort (repeat (fun xs => xs.length :: xs) 500 [])

-- Now we want to move on to actually verify that the algorithm does what it claims to do!
-- To prove this, we don't need the relation to be transitive, but we need to assume the following property:
variable (antisymm : ∀ {x y : α}, ¬ x ≤ y → (y ≤ x))

-- Okay, now prove the statement itself!
-- Hints:
--   * You might at one point have the choice to either apply induction on a list or on a witness of `Sorted`.
--     Choose wisely.
--   * Remember the tactic `byCases` from the fifth exercise!
theorem sorted_insertInOrder {xs : List α} (h : Sorted xs) : Sorted (insertInOrder x xs) := by
  induction h with
  | nil => exact Sorted.single
  | @single a =>
    simp only [insertInOrder]
    byCases hxa : x ≤ a <;> simp only [hxa]
    case inl => exact Sorted.cons_cons hxa Sorted.single
    case inr => exact Sorted.cons_cons (antisymm hxa) Sorted.single
  | @cons_cons a b l hab hbl ih =>
    simp only [insertInOrder]
    byCases hxa : x ≤ a <;> simp only [hxa]
    case inl => exact Sorted.cons_cons hxa (Sorted.cons_cons hab hbl)
    case inr =>
      byCases hxb : x ≤ b <;> simp only [hxb]
      case inl => exact Sorted.cons_cons (antisymm hxa) (Sorted.cons_cons hxb hbl)
      case inr =>
        simp only [insertInOrder, hxb] at ih
        exact Sorted.cons_cons hab ih

theorem sorted_insertionSort (as : List α) : Sorted (insertionSort as) :=
  match as with
  | []      => Sorted.nil
  | x :: xs => sorted_insertInOrder antisymm (sorted_insertionSort xs)

-- Here's a "soft" question: Have we now fully verified that `insertionSort` is a sorting algorithm?
-- What other property would be an obvious one to verify?

/-
We need to show that the resulting list is a permutation of the input.
Otherwise, `insertionSort (as : List α) := []` would be a valid sorting algorithm.
-/


/-
Copyright (c) 2022 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shing Tak Lam, Frédéric Dupuis
-/
import algebra.star.basic
import group_theory.submonoid.operations

/-!
# Unitary elements of a star monoid

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

This file defines `unitary R`, where `R` is a star monoid, as the submonoid made of the elements
that satisfy `star U * U = 1` and `U * star U = 1`, and these form a group.
This includes, for instance, unitary operators on Hilbert spaces.

See also `matrix.unitary_group` for specializations to `unitary (matrix n n R)`.

## Tags

unitary
-/

/--
In a *-monoid, `unitary R` is the submonoid consisting of all the elements `U` of
`R` such that `star U * U = 1` and `U * star U = 1`.
-/
def unitary (R : Type*) [monoid R] [star_semigroup R] : submonoid R :=
{ carrier := {U | star U * U = 1 ∧ U * star U = 1},
  one_mem' := by simp only [mul_one, and_self, set.mem_set_of_eq, star_one],
  mul_mem' := λ U B ⟨hA₁, hA₂⟩ ⟨hB₁, hB₂⟩,
  begin
    refine ⟨_, _⟩,
    { calc star (U * B) * (U * B) = star B * star U * U * B     : by simp only [mul_assoc, star_mul]
                            ...   = star B * (star U * U) * B   : by rw [←mul_assoc]
                            ...   = 1                           : by rw [hA₁, mul_one, hB₁] },
    { calc U * B * star (U * B) = U * B * (star B * star U)     : by rw [star_mul]
                            ... = U * (B * star B) * star U     : by simp_rw [←mul_assoc]
                            ... = 1                             : by rw [hB₂, mul_one, hA₂] }
  end }

variables {R : Type*}

namespace unitary

section monoid
variables [monoid R] [star_semigroup R]

lemma mem_iff {U : R} : U ∈ unitary R ↔ star U * U = 1 ∧ U * star U = 1 := iff.rfl
@[simp] lemma star_mul_self_of_mem {U : R} (hU : U ∈ unitary R) : star U * U = 1 := hU.1
@[simp] lemma mul_star_self_of_mem {U : R} (hU : U ∈ unitary R) : U * star U = 1 := hU.2

lemma star_mem {U : R} (hU : U ∈ unitary R) : star U ∈ unitary R :=
⟨by rw [star_star, mul_star_self_of_mem hU], by rw [star_star, star_mul_self_of_mem hU]⟩

@[simp] lemma star_mem_iff {U : R} : star U ∈ unitary R ↔ U ∈ unitary R :=
⟨λ h, star_star U ▸ star_mem h, star_mem⟩

instance : has_star (unitary R) := ⟨λ U, ⟨star U, star_mem U.prop⟩⟩

@[simp, norm_cast] lemma coe_star {U : unitary R} : ↑(star U) = (star U : R) := rfl

lemma coe_star_mul_self (U : unitary R) : (star U : R) * U = 1 := star_mul_self_of_mem U.prop
lemma coe_mul_star_self (U : unitary R) :  (U : R) * star U = 1 := mul_star_self_of_mem U.prop

@[simp] lemma star_mul_self (U : unitary R) : star U * U = 1 := subtype.ext $ coe_star_mul_self U
@[simp] lemma mul_star_self (U : unitary R) : U * star U = 1 := subtype.ext $ coe_mul_star_self U

instance : group (unitary R) :=
{ inv := star,
  mul_left_inv := star_mul_self,
  ..submonoid.to_monoid _ }

instance : has_involutive_star (unitary R) :=
⟨λ _, by { ext, simp only [coe_star, star_star] }⟩

instance : star_semigroup (unitary R) :=
⟨λ _ _, by { ext, simp only [coe_star, submonoid.coe_mul, star_mul] }⟩

instance : inhabited (unitary R) := ⟨1⟩

lemma star_eq_inv (U : unitary R) : star U = U⁻¹ := rfl

lemma star_eq_inv' : (star : unitary R → unitary R) = has_inv.inv := rfl

/-- The unitary elements embed into the units. -/
@[simps]
def to_units : unitary R →* Rˣ :=
{ to_fun := λ x, ⟨x, ↑(x⁻¹), coe_mul_star_self x, coe_star_mul_self x⟩,
  map_one' := units.ext rfl,
  map_mul' := λ x y, units.ext rfl }

lemma to_units_injective : function.injective (to_units : unitary R → Rˣ) :=
λ x y h, subtype.ext $ units.ext_iff.mp h

end monoid

section comm_monoid
variables [comm_monoid R] [star_semigroup R]

instance : comm_group (unitary R) :=
{ ..unitary.group,
  ..submonoid.to_comm_monoid _ }

lemma mem_iff_star_mul_self {U : R} : U ∈ unitary R ↔ star U * U = 1 :=
mem_iff.trans $ and_iff_left_of_imp $ λ h, mul_comm (star U) U ▸ h

lemma mem_iff_self_mul_star {U : R} : U ∈ unitary R ↔ U * star U = 1 :=
mem_iff.trans $ and_iff_right_of_imp $ λ h, mul_comm U (star U) ▸ h

end comm_monoid

section group_with_zero
variables [group_with_zero R] [star_semigroup R]

@[norm_cast] lemma coe_inv (U : unitary R) : ↑(U⁻¹) = (U⁻¹ : R) :=
eq_inv_of_mul_eq_one_right $ coe_mul_star_self _

@[norm_cast] lemma coe_div (U₁ U₂ : unitary R) : ↑(U₁ / U₂) = (U₁ / U₂ : R) :=
by simp only [div_eq_mul_inv, coe_inv, submonoid.coe_mul]

@[norm_cast] lemma coe_zpow (U : unitary R) (z : ℤ) : ↑(U ^ z) = (U ^ z : R) :=
begin
  induction z,
  { simp [submonoid_class.coe_pow], },
  { simp [coe_inv] },
end

end group_with_zero

section ring
variables [ring R] [star_ring R]

instance : has_neg (unitary R) :=
{ neg := λ U, ⟨-U, by { simp_rw [mem_iff, star_neg, neg_mul_neg], exact U.prop }⟩ }

@[norm_cast] lemma coe_neg (U : unitary R) : ↑(-U) = (-U : R) := rfl

instance : has_distrib_neg (unitary R) :=
subtype.coe_injective.has_distrib_neg _ coe_neg (unitary R).coe_mul

end ring

end unitary