import topology.instances.real
import analysis.normed_space.banach_steinhaus

open set filter
open_locale topological_space filter

/- TEXT:
.. index:: metric space

.. _metric_spaces:

Metric spaces
--------------

Examples in the previous section focus on sequences of real numbers. In this section we will go up a bit in generality and focus on
metric spaces. A metric space is a type ``X`` equipped with a distance function ``dist : X → X → ℝ`` which is a generalization of
the function ``λ x y, |x - y|`` from the case where ``X = ℝ``.

Introducing such a space is easy and we will check all properties required from the distance function.
BOTH: -/
-- QUOTE:

variables {X : Type*} [metric_space X] (a b c : X)

#check (dist a b : ℝ)

#check (dist_nonneg : 0 ≤ dist a b)

#check (dist_eq_zero : dist a b  = 0 ↔ a = b)

#check (dist_comm a b : dist a b  = dist b a)

#check (dist_triangle a b c : dist a c ≤ dist a b + dist b c)
-- QUOTE.

/- TEXT:
Note we also have variants where the distance can be infinite or where ``dist a b`` can be zero without having ``a = b`` or both.
They are called ``emetric_space``, ``pseudo_metric_space`` and ``pseudo_emetric_space`` respectively (here "e" stands for "extended").

BOTH: -/

-- Note the next three lines are not quoted, their purpose is to make sure those things don't get renamed while we're looking elsewhere.
#check emetric_space
#check pseudo_metric_space
#check pseudo_emetric_space

/- TEXT:
Note that our journey from ``ℝ`` to metric spaces jumped over the special case of normed spaces that also require linear algebra and
will be explained as part of the calculus chapter.

Convergence and continuity
^^^^^^^^^^^^^^^^^^^^^^^^^^

Using distance functions, we can already define convergent sequences and continuous functions between metric spaces.
They are actually defined in a more general setting covered in the next section,
but we have lemmas recasting the definition is terms of distances.
BOTH: -/
-- QUOTE:

example {u : ℕ → X} {a : X} :
  tendsto u at_top (𝓝 a) ↔ ∀ ε > 0, ∃ N, ∀ n ≥ N, dist (u n) a < ε :=
metric.tendsto_at_top

example {X Y : Type*} [metric_space X] [metric_space Y] {f : X → Y} :
  continuous f ↔
  ∀ x : X, ∀ ε > 0, ∃ δ > 0, ∀ x', dist x' x < δ → dist (f x') (f x) < ε :=
metric.continuous_iff

-- QUOTE.

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

A *lot* of lemmas have some continuity assumptions, no we end up proving a lot of continuity results and there
is a ``continuity`` tactic devoted to this task. Let's prove a continuity statement that will be needed
in an exercise below. Notice that Lean knows how to treat a product of two metric spaces as a metric space, so
it makes sense to consider continuous functions from ``X × X`` to ``ℝ``.
In particular the (uncurried version of the) distance function is such a function.

BOTH: -/

-- QUOTE:
example {X Y : Type*} [metric_space X] [metric_space Y] {f : X → Y} (hf : continuous f) :
  continuous (λ p : X × X, dist (f p.1) (f p.2)) :=
by continuity
-- QUOTE.

/- TEXT:
This tactic is a bit slow, so it is also useful to know
how to do it by hand. We first need to use that ``λ p : X × X, f p.1`` is continuous because it
is the composition of ``f``, which is continuous by assumption ``hf``, and the projection ``prod.fst`` whose continuity
is the content of the lemma ``continuous_fst``. The composition property is ``continuous.comp`` which is
in the ``continuous`` namespace so we can use dot notation to compress
``continuous.comp hf continuous_fst`` into ``hf.comp continuous_fst`` which is actually more readable
since it really reads as composing our assumption and our lemma.
We can do the same for the second component to get continuity of ``λ p : X × X, f p.2``. We then assemble
those two continuities using ``continuous.prod_mk`` to get
``(hf.comp continuous_fst).prod_mk (hf.comp continuous_snd) : continuous (λ p : X × X, (f p.1, f p.2))``
and compose once more to get our full proof.
BOTH: -/
-- QUOTE:

example {X Y : Type*} [metric_space X] [metric_space Y] {f : X → Y} (hf : continuous f) :
  continuous (λ p : X × X, dist (f p.1) (f p.2)) :=
continuous_dist.comp ((hf.comp continuous_fst).prod_mk (hf.comp continuous_snd))

-- QUOTE.

/- TEXT:
The combination of ``continuous.prod_mk`` and ``continuous_dist`` via ``continuous.comp`` feels clunky,
even when heavily using dot notation as above. A more serious issue is that this nice proof requires a lot of
planning. Lean accepts the above proof term because it is a full term proving a statement which is
definitionally equivalent to our goal, the crucial definition to unfold being that of a composition of functions.
Indeed our target function ``λ p : X × X, dist (f p.1) (f p.2)`` is not presented as a composition.
The proof term we provided proves continuity of ``dist ∘ (λ p : X × X, (f p.1, f p.2))`` which happens
to be definitionally equal to our target function. But if we try to build this proof gradually using
tactics starting with ``apply continuous_dist.comp`` then Lean's elaborator will fail to recognize a
composition and refuse to apply this lemma. It is especially bad at this when products of types are involved.

A better lemma to apply here is
``continuous.dist {f g : X → Y} : continuous f → continuous g → continuous (λ x, dist (f x) (g x))``
which is nicer to Lean's elaborator and also provides a shorter proof when directly providing a full
proof term, as can be seen from the following two new proofs of the above statement:
BOTH: -/

-- QUOTE:

example {X Y : Type*} [metric_space X] [metric_space Y] {f : X → Y} (hf : continuous f) :
  continuous (λ p : X × X, dist (f p.1) (f p.2)) :=
begin
  apply continuous.dist,
  exact hf.comp continuous_fst,
  exact hf.comp continuous_snd
end

example {X Y : Type*} [metric_space X] [metric_space Y] {f : X → Y} (hf : continuous f) :
  continuous (λ p : X × X, dist (f p.1) (f p.2)) :=
(hf.comp continuous_fst).dist (hf.comp continuous_snd)

-- QUOTE.

/- TEXT:
Note that, without the elaboration issue coming from composition, another way to compress
our proof would be to use ``continuous.prod_map`` which is sometimes useful and gives
as an alternate proof term ``continuous_dist.comp (hf.prod_map hf)`` which even shorter to type.

Since it is sad to decide between a version which is better for elaboration and a version which is shorter
to type, let us wrap this discussion with a last bit of compression offered
by ``continuous.fst'`` which allows to compress ``hf.comp continuous_fst`` to ``hf.fst'`` (and the same with ``snd``)
and get our final proof, now bordering obfuscation.

BOTH: -/

-- QUOTE:
example {X Y : Type*} [metric_space X] [metric_space Y] {f : X → Y} (hf : continuous f) :
  continuous (λ p : X × X, dist (f p.1) (f p.2)) :=
hf.fst'.dist hf.snd'

-- QUOTE.

/- TEXT:
It's your turn now to prove some continuity lemma. After trying the continuity tactic, you will need
``continuous.add``, ``continuous_pow`` and ``continuous_id`` to do it by hand.

BOTH: -/

-- QUOTE:
example {f : ℝ → X} (hf : continuous f) : continuous (λ x : ℝ, f (x^2 + x)) :=
sorry

-- QUOTE.

-- SOLUTIONS:
example {f : ℝ → X} (hf : continuous f) : continuous (λ x : ℝ, f (x^2 + x)) :=
hf.comp $ (continuous_pow 2).add continuous_id

/- TEXT:
So far we saw continuity as a global notion, but one can also define continuity at a point.
BOTH: -/

-- QUOTE:

example {X Y : Type*} [metric_space X] [metric_space Y] (f : X → Y) (a : X) :
continuous_at f a ↔ ∀ ε > 0, ∃ δ > 0, ∀ {x}, dist x a < δ → dist (f x) (f a) < ε :=
metric.continuous_at_iff

-- QUOTE.

/- TEXT:

Balls, open sets and closed sets
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Once we have a distance function, the most important geometric definitions are (open) balls and closed balls.

BOTH: -/
-- QUOTE:

variables r : ℝ

example : metric.ball a r = {b | dist b a < r} := rfl

example : metric.closed_ball a r = {b | dist b a ≤ r} := rfl

-- QUOTE.

/- TEXT:
Note that `r` is any real number here, there is no sign restriction. Of course some statements do require a radius condition.
BOTH: -/
-- QUOTE:

example (hr : 0 < r) : a ∈ metric.ball a r := metric.mem_ball_self hr

example (hr : 0 ≤ r) : a ∈ metric.closed_ball a r := metric.mem_closed_ball_self hr

-- QUOTE.
/- TEXT:
Once we have balls, we can define open sets. They are actually defined in a more general setting covered in the next section,
but we have lemmas recasting the definition is terms of balls.

BOTH: -/

-- QUOTE:
example (s : set X) : is_open s ↔ ∀ x ∈ s, ∃ ε > 0, metric.ball x ε ⊆ s :=
metric.is_open_iff

-- QUOTE.

/- TEXT:
Then closed sets are sets whose complement is open. Their important property is they are closed under limits. The closure of a set is the smallest subset containing it.
BOTH: -/
-- QUOTE:

example {s : set X} : is_closed s ↔ is_open sᶜ :=
is_open_compl_iff.symm

example {s : set X} (hs : is_closed s) {u : ℕ → X} (hu : tendsto u at_top (𝓝 a))
  (hus : ∀ n, u n ∈ s) : a ∈ s :=
hs.mem_of_tendsto hu (eventually_of_forall hus)

example {s : set X} : a ∈ closure s ↔ ∀ ε > 0, ∃ b ∈ s, a ∈ metric.ball b ε :=
metric.mem_closure_iff
-- QUOTE.

/- TEXT:
Do the next exercise without using `mem_closure_iff_seq_limit`
BOTH: -/

-- QUOTE:
example {u : ℕ → X} (hu : tendsto u at_top (𝓝 a)) {s : set X} (hs : ∀ n, u n ∈ s) :
  a ∈ closure s :=
sorry

-- QUOTE.

-- SOLUTIONS:
example {u : ℕ → X} (hu : tendsto u at_top (𝓝 a)) {s : set X} (hs : ∀ n, u n ∈ s) :
  a ∈ closure s :=
begin
  rw metric.tendsto_at_top at hu,
  rw metric.mem_closure_iff,
  intros ε ε_pos,
  rcases hu ε ε_pos with ⟨N, hN⟩,
  refine ⟨u N, hs _, _⟩,
  rw dist_comm,
  exact hN N le_rfl
end

/- TEXT:

Remember from the filters sections that neighborhood filters play a big role in mathlib.
In the metric space context, the crucial point is that balls provide bases for those filters.
The main lemmas here are ``metric.nhds_basis_ball`` and ``metric.nhds_basis_closed_ball``
that claim this for open and closed balls with positive radius. The center point is an implicit
argument so we can invoke ``filter.has_basis.mem_iff`` as in the following example.

BOTH: -/

-- QUOTE:
example {x : X} {s : set X} : s ∈ 𝓝 x ↔ ∃ ε > 0, metric.ball x ε ⊆ s :=
metric.nhds_basis_ball.mem_iff

example {x : X} {s : set X} : s ∈ 𝓝 x ↔ ∃ ε > 0, metric.closed_ball x ε ⊆ s :=
metric.nhds_basis_closed_ball.mem_iff

-- QUOTE.

/- TEXT:

Compactness
^^^^^^^^^^^

Compactness is an important topological notion. It distinguishes subsets of a metric space
that enjoy the same kind of properties as segments in reals compared to other intervals:

* Any sequence taking value in a compact set has a subsequence that converges in this set
* Any continuous function on a nonempty compact set with values in real numbers is bounded and achieves its bounds somewhere (this is called the extreme values theorem).
* Compact sets are closed sets.

Let us first check that the unit interval in reals is indeed a compact set, and then check the above
claims for compact sets in general metric spaces. In the second statement we only
need continuity on the given set so we will use ``continuous_on`` instead of ``continuous``, and
we will give separate statements for the minimum and the maximum. Of course all these results
are deduced from more general versions, some of which will be discussed in later sections.

BOTH: -/

-- QUOTE:

example : is_compact (set.Icc 0 1 : set ℝ) :=
is_compact_Icc

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

example {s : set X} (hs : is_compact s) (hs' : s.nonempty)
  {f : X → ℝ} (hfs : continuous_on f s) :
  ∃ x ∈ s, ∀ y ∈ s, f x ≤ f y :=
hs.exists_forall_le hs' hfs

example {s : set X} (hs : is_compact s) (hs' : s.nonempty)
  {f : X → ℝ} (hfs : continuous_on f s) :
  ∃ x ∈ s, ∀ y ∈ s, f y ≤ f x :=
hs.exists_forall_ge hs' hfs

example {s : set X} (hs : is_compact s) : is_closed s :=
hs.is_closed

-- QUOTE.

/- TEXT:

We can also metric spaces which are globally compact, using an extra ``Prop``-valued type class:

BOTH: -/

-- QUOTE:
example {X : Type*} [metric_space X] [compact_space X] : is_compact (univ : set X) :=
compact_univ
-- QUOTE.

/- TEXT:

In a compact metric space any closed set is compact, this is ``is_compact.is_closed``.

BOTH: -/

#check is_compact.is_closed

/- TEXT:
Uniformly continuous functions
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

We now turn to uniformity notions on metric spaces : uniformly continuous functions, Cauchy sequences and completeness.
Again those are defined in a more general context but we have lemmas in the metric name space to access their elementary definitions.
We start with uniform continuity.

BOTH: -/

-- QUOTE:
example {X : Type*} [metric_space X] {Y : Type*} [metric_space Y] {f : X → Y} :
  uniform_continuous f ↔ ∀ ε > 0, ∃ δ > 0, ∀ {a b : X}, dist a b < δ → dist (f a) (f b) < ε :=
metric.uniform_continuous_iff

-- QUOTE.

/- TEXT:
In order to practice manipulating all those definitions, we will prove that continuous
functions from a compact metric space to a metric space are uniformly continuous
(we will see a more general version in a later section).

We will first give an informal sketch. Let ``f : X → Y`` be a continuous function from
a compact metric space to a metric space.
We fix ``ε > 0`` and start looking for some ``δ``.

Let ``φ : X × X → ℝ := λ p, dist (f p.1) (f p.2)`` and let ``K := { p : X × X | ε ≤ φ p }``.
Observe ``φ`` is continuous since ``f`` and distance are continuous.
And ``K`` is clearly closed (use ``is_closed_le``) hence compact since ``X`` is compact.

Then we discuss two possibilities using ``eq_empty_or_nonempty``.
If ``K`` is empty then we are clearly done (we can set ``δ = 1`` for instance).
So let's assume ``K`` is not empty, and use the extreme value theorem to choose ``(x₀, x₁)`` attaining the infimum
of ``φ`` on ``K``. We can then set ``δ = dist x₀ x₁`` and check everything works.

BOTH: -/

-- QUOTE:
example {X : Type*} [metric_space X] [compact_space X] {Y : Type*} [metric_space Y]
  {f : X → Y} (hf : continuous f) : uniform_continuous f :=
sorry

-- QUOTE.

-- SOLUTIONS:
example {X : Type*} [metric_space X] [compact_space X] {Y : Type*} [metric_space Y]
  {f : X → Y} (hf : continuous f) : uniform_continuous f :=
begin
  rw metric.uniform_continuous_iff,
  intros ε ε_pos,
  let φ : X × X → ℝ := λ p, dist (f p.1) (f p.2),
  have φ_cont : continuous φ := hf.fst'.dist hf.snd',
  let K := { p : X × X | ε ≤ φ p },
  have K_closed : is_closed K := is_closed_le continuous_const φ_cont,
  have K_cpct : is_compact K := K_closed.is_compact,
  cases eq_empty_or_nonempty K with hK hK,
  { use [1, by norm_num],
    intros x y hxy,
    have : (x, y) ∉ K, by simp [hK],
    simpa [K] },
  { rcases K_cpct.exists_forall_le hK continuous_dist.continuous_on with ⟨⟨x₀, x₁⟩, xx_in, H⟩,
    use dist x₀ x₁,
    split,
    { change _ < _,
      rw dist_pos,
      intro h,
      have : ε ≤ 0, by simpa [*] using xx_in,
      linarith },
    { intros x x',
      contrapose!,
      intros hxx',
      exact H (x, x') hxx' } },
end

/- TEXT:
Completeness
^^^^^^^^^^^^

A Cauchy sequence in a metric space is a sequence whose terms get closer and closer to each other.
There are a couple of equivalent ways to state that idea.
In particular converging sequences are Cauchy. The converse is true only in so-called *complete*
spaces.

BOTH: -/

-- QUOTE:

example (u : ℕ → X) : cauchy_seq u ↔ ∀ ε > 0, ∃ N : ℕ, ∀ m ≥ N,  ∀ n ≥ N, dist (u m) (u n) < ε :=
metric.cauchy_seq_iff

example (u : ℕ → X) : cauchy_seq u ↔ ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, dist (u n) (u N) < ε :=
metric.cauchy_seq_iff'

example [complete_space X] (u : ℕ → X) (hu : cauchy_seq u) : ∃ x, tendsto u at_top (𝓝 x) :=
cauchy_seq_tendsto_of_complete hu

-- QUOTE.

/- TEXT:

We'll practice using this definition by proving a convenient criterion which is a special case of a
criterion appearing in mathlib. This is also a good opportunity to practive using big sums in
a geometric context. In addition to the explanations from the filters section, you will probably need
``tendsto_pow_at_top_nhds_0_of_lt_1``, ``tendsto.mul`` and ``dist_le_range_sum_dist``.
BOTH: -/

open_locale big_operators
open finset

-- QUOTE:

lemma cauchy_seq_of_le_geometric_two' {u : ℕ → X} (hu : ∀ (n : ℕ), dist (u n) (u (n + 1)) ≤ (1 / 2) ^ n) :
  cauchy_seq u :=
begin
  rw metric.cauchy_seq_iff',
  intros ε ε_pos,
  obtain ⟨N, hN⟩ : ∃ N : ℕ, 1 / 2 ^ N * 2 < ε,
  { sorry },
  use N,
  intros n hn,
  obtain ⟨k, rfl : n = N + k⟩ := le_iff_exists_add.mp hn,
  calc dist (u (N + k)) (u N) = dist (u (N+0)) (u (N + k)) : sorry
  ... ≤ ∑ i in range k, dist (u (N + i)) (u (N + (i + 1))) : sorry
  ... ≤ ∑ i in range k, (1/2 : ℝ)^(N+i) : sorry
  ... = 1/2^N*∑ i in range k, (1 / 2) ^ i : sorry
  ... ≤ 1/2^N*2 : sorry
  ... < ε : sorry
end
-- QUOTE.

-- SOLUTIONS:
example {u : ℕ → X} (hu : ∀ (n : ℕ), dist (u n) (u (n + 1)) ≤ (1 / 2) ^ n) :
  cauchy_seq u :=
begin
  rw metric.cauchy_seq_iff',
  intros ε ε_pos,
  obtain ⟨N, hN⟩ : ∃ N : ℕ, 1 / 2 ^ N * 2 < ε,
  { have : tendsto (λ N : ℕ, (1 / 2 ^ N * 2 : ℝ)) at_top (𝓝 0),
    { rw ← zero_mul (2 : ℝ),
      apply tendsto.mul,
      simp_rw ← one_div_pow (2 : ℝ),
      apply tendsto_pow_at_top_nhds_0_of_lt_1 ; linarith,
      exact tendsto_const_nhds },
    rcases (at_top_basis.tendsto_iff (nhds_basis_Ioo_pos (0 : ℝ))).mp this ε ε_pos with ⟨N, H, hN⟩,
    exact  ⟨N, by simpa using (hN N le_rfl).2⟩ },
  use N,
  intros n hn,
  obtain ⟨k, rfl : n = N + k⟩ := le_iff_exists_add.mp hn,
  calc dist (u (N + k)) (u N) = dist (u (N+0)) (u (N + k)) : by rw [dist_comm, add_zero]
  ... ≤ ∑ i in range k, dist (u (N + i)) (u (N + (i + 1))) : dist_le_range_sum_dist (λ i, u (N+i)) k
  ... ≤ ∑ i in range k, (1/2 : ℝ) ^ (N+i) : sum_le_sum (λ i hi, hu $ N+i)
  ... = 1/2^N*∑ i in range k, (1 / 2)^i : by simp_rw [← one_div_pow, pow_add, ← mul_sum]
  ... ≤ 1/2^N*2 : mul_le_mul_of_nonneg_left (sum_geometric_two_le _) (one_div_nonneg.mpr (pow_nonneg (zero_le_two : (0 : ℝ) ≤ 2)_))
  ... < ε : hN
end

/- TEXT:

We are ready for the final boss of this section: Baire's theorem for complete metric spaces!
The proof skeleton below shows interesting techniques. It uses the ``choose`` tactic in its exclamation
mark variant (you should experiment with removing this exclamation mark) and it shows how to
define something inductively in the middle of a proof using ``nat.rec_on``.

BOTH: -/

-- QUOTE:
open metric

example [complete_space X] (f : ℕ → set X) (ho : ∀ n, is_open (f n)) (hd : ∀ n, dense (f n)) : dense (⋂n, f n) :=
begin
  let B : ℕ → ℝ := λ n, (1/2)^n,
  have Bpos : ∀ n, 0 < B n, sorry,
  /- Translate the density assumption into two functions `center` and `radius` associating
  to any n, x, δ, δpos a center and a positive radius such that
  `closed_ball center radius` is included both in `f n` and in `closed_ball x δ`.
  We can also require `radius ≤ (1/2)^(n+1)`, to ensure we get a Cauchy sequence later. -/
  have : ∀ (n : ℕ)  (x : X) (δ > 0), ∃ (y : X) (r > 0), r ≤ B (n+1) ∧ closed_ball y r ⊆ (closed_ball x δ) ∩ f n,
  { sorry },
  choose! center radius Hpos HB Hball using this,
  intros x,
  rw mem_closure_iff_nhds_basis nhds_basis_closed_ball,
  intros ε εpos,
  /- `ε` is positive. We have to find a point in the ball of radius `ε` around `x` belonging to all
  `f n`. For this, we construct inductively a sequence `F n = (c n, r n)` such that the closed ball
  `closed_ball (c n) (r n)` is included in the previous ball and in `f n`, and such that
  `r n` is small enough to ensure that `c n` is a Cauchy sequence. Then `c n` converges to a
  limit which belongs to all the `f n`. -/
  let F : ℕ → (X × ℝ) := λn, nat.rec_on n (prod.mk x (min ε (B 0)))
                              (λn p, prod.mk (center n p.1 p.2) (radius n p.1 p.2)),
  let c : ℕ → X := λ n, (F n).1,
  let r : ℕ → ℝ := λ n, (F n).2,
  have rpos : ∀ n, 0 < r n,
  { sorry },

  have rB : ∀n, r n ≤ B n,
  { sorry },
  have incl : ∀n, closed_ball (c (n+1)) (r (n+1)) ⊆ (closed_ball (c n) (r n)) ∩ (f n),
  { sorry },
  have cdist : ∀ n, dist (c n) (c (n+1)) ≤ B n,
  { sorry },
  have : cauchy_seq c, from cauchy_seq_of_le_geometric_two' cdist,
  -- as the sequence `c n` is Cauchy in a complete space, it converges to a limit `y`.
  rcases cauchy_seq_tendsto_of_complete this with ⟨y, ylim⟩,
  -- this point `y` will be the desired point. We will check that it belongs to all
  -- `f n` and to `ball x ε`.
  use y,
  have I : ∀n, ∀ m ≥ n, closed_ball (c m) (r m) ⊆ closed_ball (c n) (r n),
  { sorry },
  have yball : ∀n, y ∈ closed_ball (c n) (r n),
  { sorry },
  sorry
end

-- QUOTE.

-- SOLUTIONS:
example [complete_space X] (f : ℕ → set X) (ho : ∀ n, is_open (f n)) (hd : ∀ n, dense (f n)) : dense (⋂n, f n) :=
begin
  let B : ℕ → ℝ := λ n, (1/2)^n,
  have Bpos : ∀ n, 0 < B n, from λ n, (pow_pos sorry n),
  /- Translate the density assumption into two functions `center` and `radius` associating
  to any n, x, δ, δpos a center and a positive radius such that
  `closed_ball center radius` is included both in `f n` and in `closed_ball x δ`.
  We can also require `radius ≤ (1/2)^(n+1)`, to ensure we get a Cauchy sequence later. -/
  have : ∀ (n : ℕ)  (x : X) (δ > 0), ∃ (y : X) (r > 0), r ≤ B (n+1) ∧ closed_ball y r ⊆ (closed_ball x δ) ∩ f n,
  { intros n x δ δpos,
    have : x ∈ closure (f n) := hd n x,
    rcases metric.mem_closure_iff.1 this (δ/2) (half_pos δpos) with ⟨y, ys, xy⟩,
    rw dist_comm at xy,
    obtain ⟨r, rpos, hr⟩ : ∃ r > 0, closed_ball y r ⊆ f n :=
      nhds_basis_closed_ball.mem_iff.1 (is_open_iff_mem_nhds.1 (ho n) y ys),
    refine ⟨y, min (min (δ/2) r) (B (n+1)), _, _, λz hz, ⟨_, _⟩⟩,
    show 0 < min (min (δ / 2) r) (B (n+1)),
      from lt_min (lt_min (half_pos δpos) rpos) (Bpos (n+1)),
    show min (min (δ / 2) r) (B (n+1)) ≤ B (n+1), from min_le_right _ _,
    show z ∈ closed_ball x δ, from calc
      dist z x ≤ dist z y + dist y x : dist_triangle _ _ _
      ... ≤ (min (min (δ / 2) r) (B (n+1))) + (δ/2) : add_le_add hz xy.le
      ... ≤ δ/2 + δ/2 : add_le_add_right ((min_le_left _ _).trans (min_le_left _ _)) _
      ... = δ : add_halves δ,
    show z ∈ f n, from hr (calc
      dist z y ≤ min (min (δ / 2) r) (B (n+1)) : hz
      ... ≤ r : (min_le_left _ _).trans (min_le_right _ _)) },
  choose! center radius Hpos HB Hball using this,
  refine λ x, (mem_closure_iff_nhds_basis nhds_basis_closed_ball).2 (λ ε εpos, _),
  /- `ε` is positive. We have to find a point in the ball of radius `ε` around `x` belonging to all
  `f n`. For this, we construct inductively a sequence `F n = (c n, r n)` such that the closed ball
  `closed_ball (c n) (r n)` is included in the previous ball and in `f n`, and such that
  `r n` is small enough to ensure that `c n` is a Cauchy sequence. Then `c n` converges to a
  limit which belongs to all the `f n`. -/
  let F : ℕ → (X × ℝ) := λn, nat.rec_on n (prod.mk x (min ε (B 0)))
                              (λn p, prod.mk (center n p.1 p.2) (radius n p.1 p.2)),
  let c : ℕ → X := λ n, (F n).1,
  let r : ℕ → ℝ := λ n, (F n).2,
  have rpos : ∀ n, 0 < r n,
  { assume n,
    induction n with n hn,
    exact lt_min εpos (Bpos 0),
    exact Hpos n (c n) (r n) hn },

  have rB : ∀n, r n ≤ B n,
  { assume n,
    induction n with n hn,
    exact min_le_right _ _,
    exact HB n (c n) (r n) (rpos n) },
  have incl : ∀n, closed_ball (c (n+1)) (r (n+1)) ⊆ (closed_ball (c n) (r n)) ∩ (f n) :=
    λ n, Hball n (c n) (r n) (rpos n),
  have cdist : ∀ n, dist (c n) (c (n+1)) ≤ B n,
  { assume n,
    rw dist_comm,
    have A : c (n+1) ∈ closed_ball (c (n+1)) (r (n+1)) := mem_closed_ball_self (rpos $ n +1).le,
    have I := calc
      closed_ball (c (n+1)) (r (n+1)) ⊆ closed_ball (c n) (r n) :
         (incl n).trans (inter_subset_left _ _)
      ... ⊆ closed_ball (c n) (B n) : closed_ball_subset_closed_ball (rB n),
    exact I A },
  have : cauchy_seq c,
  from cauchy_seq_of_le_geometric_two' cdist,
  -- as the sequence `c n` is Cauchy in a complete space, it converges to a limit `y`.
  rcases cauchy_seq_tendsto_of_complete this with ⟨y, ylim⟩,
  -- this point `y` will be the desired point. We will check that it belongs to all
  -- `f n` and to `ball x ε`.
  use y,

  have I : ∀n, ∀ m ≥ n, closed_ball (c m) (r m) ⊆ closed_ball (c n) (r n),
  { assume n,
    refine nat.le_induction _ (λm hnm h, _),
    { exact subset.rfl },
    { exact (incl m).trans ((set.inter_subset_left _ _).trans h) }},
  have yball : ∀n, y ∈ closed_ball (c n) (r n),
  { assume n,
    refine is_closed_ball.mem_of_tendsto ylim _,
    refine (filter.eventually_ge_at_top n).mono (λ m hm, _),
    exact I n m hm (mem_closed_ball_self (rpos _).le) },
  split,
  { suffices : ∀ n, y ∈ f n, by rwa set.mem_Inter,
    intro n,
    have : closed_ball (c (n+1)) (r (n+1)) ⊆ f n := subset.trans (incl n) (inter_subset_right _ _),
    exact this (yball (n+1)) },
  calc dist y x ≤ r 0 : yball 0
            ... ≤ ε : min_le_left _ _,
end

/- TEXT:

BOTH: -/


-- https://leanprover.github.io/theorem_proving_in_lean/propositions_and_proofs.html#exercises
open classical

variables p q r s : Prop

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
assume (h: p -> r ∨ s),
by_cases (
  assume hp: p,
  have hrs: r ∨ s, from h hp,
  hrs.elim (λ hr: r, or.inl (λ hp: p, hr)) (λ hs: s, or.inr (λ hp:p, hs))
) (
  assume hnp: ¬ p,
  have hpr: p -> r, from (λ hp: p, absurd hp hnp),
  or.inl hpr
)

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
assume (h: ¬ (p ∧ q)),
by_cases (
  assume hp: p,
  have hnq: ¬ q, from
    assume hq: q, h ⟨hp, hq⟩,
  or.inr hnq
) (
  assume hnp: ¬ p,
  or.inl hnp
)

lemma dne {p: Prop} (h: ¬ ¬ p) : p :=
or.elim (em p)
  (assume hp: p, hp)
  (assume hnp: ¬ p, absurd hnp h)

lemma L : ¬(p → q) → p ∧ ¬q :=
assume h: ¬ (p -> q),
by_contradiction (
  assume h': ¬ (p ∧ ¬ q),
  have h'': p -> (¬ q) -> false, from λ (hp) (hnq), h' ⟨hp, hnq⟩,
  show false, from h (
    show p -> q, from
    assume hp: p,
    dne (h'' hp)
  )
)
example : ¬(p → q) → p ∧ ¬q := L p q

example : (p → q) → (¬p ∨ q) :=
assume h: p -> q,
by_cases (λ hp, or.inr (h hp)) (λ hnp, or.inl hnp)

example : (¬q → ¬p) → (p → q) :=
assume h: ¬ q -> ¬ p,
by_cases (
  assume hnq: ¬ q,
  have hnp: ¬ p, from h hnq,
  λ hp, absurd hp hnp
) (
  assume hnnq: ¬ ¬ q,
  have hq: q, from dne hnnq,
  λ hp, hq
)

example : p ∨ ¬p := em p

example : (((p → q) → p) → p) :=
assume h: (p -> q) -> p,
show p, from
by_cases (
  assume hpq: p -> q, h hpq
) (
  assume hnpq: ¬ (p -> q),
  have hpnq: p ∧ ¬ q, from L p q hnpq,
  hpnq.left
)


import topology.basic data.set.intervals analysis.exponential data.complex.basic tactic.ring
open real set
open complex

-- * Example 4: y(x)=1/(x^2-2x+3) is continuous over [1,2].

-- Here's a way to start sketching, anyway.

constants A B C : ℝ

-- some specific quadratic
noncomputable def quadratic := (λ (x:ℝ), A * (x^2) + B * x + C)

-- take in some coefficients and generate the corresponding quadratic polynomial
def quadratic_poly := (λ (a b c : ℝ), (λ (x:ℝ), a * (x^2) + b * x + c))

-- Here's a useful lemma: also easy to prove.  We'll use this to prove the nonmonic case as well.
lemma cs_monic (b c : ℝ) : ∀ (x:ℝ), x^2 + b*x + c = (x + b/2)^2 + (c-(b^2)/4) :=
begin
intro,
ring,
end
-- use this for an example, e.g. x^2-2x+3, to show this one is continuous

-- As a quick warm-up, the polynomial itself is continuous.
-- A more general version of this result would say that *all* such polynomials are continuous.
-- Is that a known result?  Anyway, this will do for now
lemma cont_example_quad : continuous (quadratic_poly 1 (-2) 3) :=
begin
unfold quadratic_poly,
refine continuous_add _ _,
refine continuous_add _ _,
refine continuous_mul _ _,
exact continuous_const,
exact continuous_pow 2,
refine continuous_mul _ _,
exact continuous_const,
exact continuous_id,
exact continuous_const,
end

-- Now let's set up 1/quad
#check (λ (x:ℝ), 1/x)
#check function.comp (λ (x:ℝ), 1/x) (quadratic_poly 1 (-2) 3)

lemma example_inv_quad : continuous (function.comp (λ (x:ℝ), 1/x) (quadratic_poly 1 (-2) 3)) :=
begin
unfold quadratic_poly function.comp,
-- the setup looks good.
-- adjust it so that we can apply the lemma:
simp only [one_div_eq_inv],
refine real.continuous_inv _ _,
intro x,
rw one_mul,
rw cs_monic,
-- The first summand is (x + (-2) / 2) ^ 2
-- which we deem to be nonnegative because it is a square;
-- so it is sufficient to show the second summand is positive.
-- But that's easy:
-- (3 - (-2) ^ 2 / 4) = (3 - 4 / 4) = (3 - 1) = 2 > 0
-- So let's apply these ideas.
apply ne_of_gt,                 -- this is a sufficient condition
apply add_pos_of_nonneg_of_pos, -- Break the proof into parts at the + sign
rw pow_two,                     -- rewrite the square
apply mul_self_nonneg,          -- draw the first required conclusion
-- For the next part, we need to do a bit of arithmetic
-- but we can let Lean do that for us.
ring,
norm_num,
-- the last goal is the continuity of the polynomial
exact cont_example_quad,
end


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

import tactic -- imports all the Lean tactics
import measure_theory.measurable_space

/-

# The extended nonnegative reals [0,∞]

The big dilemma when a designer is faced with "minor modifications"
of a standard type, is whether to just stick with the standard type
and make do, or whether to make a new type and then be faced with the
problem of having to make all the API for that type. Example: in measure
theory a key role is played by the "extended non-negative reals",
namely {x : ℝ | 0 ≤ x} ∪ {∞}. In Lean these are their own type,
called `ennreal`. There is a "locale" containing standard notation
associated for this type. Let's open it.

localized "notation (name := ennreal) `ℝ≥0∞` := ennreal" in ennreal
localized "notation (name := ennreal.top) `∞` := (⊤ : ennreal)" in ennreal
-/

open_locale ennreal

#print notation ℝ≥0∞
#check ennreal

#check ℝ≥0∞ -- [0,∞]

#check ∞ -- it's the ∞ in ℝ≥0∞

-- What can we do with extended non-negative reals?

variables (a b : ℝ≥0∞)

#check a + b
#check a - b -- surprising?
#check a * b -- what is 0 * ∞ then?
#check a / b -- is 1 / 0 = 0 or ∞? In ℝ it's 0 but here there's another possibility

example : (0 : ℝ≥0∞) * ∞ = 0 :=
begin
  norm_num,
end

example : (1 : ℝ≥0∞) / 0 = ∞ :=
begin
  simp,
end

example (a b c : ℝ≥0∞) : (a + b) * c = a * c + b * c :=
begin
  ring,
end


import algebra.big_operators.ring
import data.real.basic

@[ext] structure point := (x : ℝ) (y : ℝ) (z : ℝ)

#check point.ext

example (a b : point) (hx : a.x = b.x) (hy : a.y = b.y) (hz : a.z = b.z) :
  a = b :=
begin
  ext,
  assumption',
end

def my_point1 : point :=
{ x := 2,
  y := -1,
  z := 4 }

def my_point2 :=
{ point .
  x := 2,
  y := -1,
  z := 4 }

def my_point3 : point := ⟨2, -1, 4⟩

def my_point4 := point.mk 2 (-1) 4

structure point' := build :: (x : ℝ) (y : ℝ) (z : ℝ)

#check point'.build 2 (-1) 4

namespace point

def add (a b : point) : point := ⟨a.x + b.x, a.y + b.y, a.z + b.z⟩

protected theorem add_comm (a b : point) : add a b = add b a :=
begin
  rw [add, add],
  ext; dsimp,
  repeat { apply add_comm },
end

theorem add_x (a b : point) : (a.add b).x = a.x + b.x := rfl

def add_alt : point → point → point
| ⟨x₁, y₁, z₁⟩ ⟨x₂, y₂, z₂⟩ := ⟨x₁ + x₂, y₁ + y₂, z₁ + z₂⟩

theorem add_alt_comm (a b : point) : add_alt a b = add_alt b a :=
begin
  rcases a with ⟨xa, ya, za⟩,
  rcases b with ⟨xb, yb, zb⟩,
  simp [add_alt, add_comm],
end

protected theorem add_assoc (a b c : point) :
  (a.add b).add c = a.add (b.add c) :=
by { simp [add, add_assoc]}

def smul (r : ℝ) (a : point) : point :=
  ⟨r * a.x, r * a.y, r * a.z⟩

theorem smul_distrib (r : ℝ) (a b : point) :
  (smul r a).add (smul r b) = smul r (a.add b) :=
by { simp [add, smul, mul_add],}

end point

structure standard_two_simplex :=
  (x y z: ℝ)
  (x_nonneg : 0 ≤ x)
  (y_nonneg : 0 ≤ y)
  (z_nonneg : 0 ≤ z)
  (sum_eq : x + y + z = 1)

namespace standard_two_simplex

def swap_xy (a : standard_two_simplex) : standard_two_simplex :=
{
  x := a.y,
  y := a.x,
  z := a.z,
  x_nonneg := a.y_nonneg,
  y_nonneg := a.x_nonneg,
  z_nonneg := a.z_nonneg,
  sum_eq := by rw [add_comm a.y a.x, a.sum_eq],
}

noncomputable theory

def midpoint (a b : standard_two_simplex) : standard_two_simplex :=
{
  x := (a.x + b.x) / 2,
  y := (a.y + b.y) / 2,
  z := (a.z + b.z) / 2,
  x_nonneg := div_nonneg (add_nonneg a.x_nonneg b.x_nonneg) (by norm_num),
  y_nonneg := div_nonneg (add_nonneg a.y_nonneg b.y_nonneg) (by norm_num),
  z_nonneg := div_nonneg (add_nonneg a.z_nonneg b.z_nonneg) (by norm_num),
  sum_eq := by { field_simp, linarith [a.sum_eq, b.sum_eq]}
}

def weighted_average (lambda : real)
    (lambda_nonneg : 0 ≤ lambda) (lambda_le : lambda ≤ 1)
    (a b : standard_two_simplex) :
  standard_two_simplex :=
{
  x := lambda * a.x + (1 - lambda) * b.x,
  y := lambda * a.y + (1 - lambda) * b.y,
  z := lambda * a.z + (1 - lambda) * b.z,
  x_nonneg := by { apply add_nonneg, all_goals { apply mul_nonneg}, assumption,
    from a.x_nonneg, linarith [lambda_le], from b.x_nonneg },
  y_nonneg := by { apply add_nonneg, all_goals { apply mul_nonneg}, assumption,
    from a.y_nonneg, linarith [lambda_le], from b.y_nonneg },
  z_nonneg := by { apply add_nonneg, all_goals { apply mul_nonneg}, assumption,
    from a.z_nonneg, linarith [lambda_le], from b.z_nonneg },
  sum_eq :=
    begin
      transitivity (a.x + a.y + a.z) * lambda + (b.x + b.y + b.z) * (1 - lambda),
      { ring },
      simp [a.sum_eq, b.sum_eq]
    end
}

end standard_two_simplex

open_locale big_operators

structure standard_simplex (n : ℕ) :=
  (v : fin n → ℝ)
  (nonneg : ∀ i : fin n, 0 ≤ v i)
  (sum_eq_one : ∑ i, v i = 1)

namespace standard_simplex

def midpoint (n : ℕ) (a b : standard_simplex n) : standard_simplex n :=
{ v := λ i, (a.v i + b.v i) / 2,
  nonneg :=
    begin
      intro i,
      apply div_nonneg,
      { linarith [a.nonneg i, b.nonneg i] },
      norm_num
    end,
  sum_eq_one :=
    begin
      simp [div_eq_mul_inv, ←finset.sum_mul, finset.sum_add_distrib,
        a.sum_eq_one, b.sum_eq_one],
      field_simp
    end  }

end standard_simplex

structure is_linear (f : ℝ → ℝ) :=
(is_additive : ∀ x y, f (x + y) = f x + f y)
(preserves_mul : ∀ x c, f (c * x) = c * f x)

section
variables (f : ℝ → ℝ) (linf : is_linear f)

#check linf.is_additive
#check linf.preserves_mul

end

def preal := { y : ℝ | 0 < y}

section
variable x : preal

#check x.val
#check x.property

end

def standard_two_simplex' :=
{ p : ℝ × ℝ × ℝ // 0 ≤ p.1 ∧ 0 ≤ p.2.1 ∧ 0 ≤ p.2.2 ∧ p.1 + p.2.1 + p.2.2 = 1 }

def standard_simplex' (n : ℕ) :=
{ v : fin n → ℝ // (∀ i : fin n, 0 ≤ v i) ∧ (∑ i, v i = 1) }

def std_simplex := Σ n : ℕ, standard_simplex n

section
variable s : std_simplex

#check s.fst
#check s.snd

#check s.1
#check s.2

end


/-
This file contains the definition of the "explode" operation, which
creates a "powerset" of literals from a list of variables. Associated
theorems dealing with the contents of explode are also included.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon University
-/

import cnf.literal
import cnf.clause
import cnf.cnf

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

universe u

-- Represents the parametric type of the variable stored in the literal
variables {V : Type*}

open literal clause
open list function

namespace explode

variables {v : V} {l : list V} {c : clause V}

/-! # Explode -/

-- Produces a list of all possible polarities on a list of variables, maintaining order
def explode : list V → list (clause V)
| []        := [[]]
| (v :: l) := (explode l).map (cons (Pos v)) ++ (explode l).map (cons (Neg v))

@[simp] theorem explode_nil : explode ([] : list V) = [[]] := rfl

@[simp] theorem explode_singleton (v : V) : explode [v] = [[Pos v], [Neg v]] := rfl

theorem length_explode (l : list V) : length (explode l) = 2^(length l) :=
begin
  induction l with v vs ih,
  { refl },
  { simp only [explode, length_cons, length_append, length_map, pow_succ, two_mul, ih] }
end

theorem length_explode_pos (l : list V) : length (explode l) > 0 :=
by { rw length_explode, exact pow_pos zero_lt_two _ }

theorem exists_mem_explode (l : list V) : ∃ (c : clause V), c ∈ explode l :=
exists_mem_of_length_pos (length_explode_pos _)

theorem length_eq_of_mem_explode : c ∈ explode l → length c = length l :=
begin
  induction l with v vs ih generalizing c,
  { rw [explode_nil, mem_singleton],
    rintro rfl, refl },
  { simp only [explode, mem_append, mem_map],
    rintros (⟨c, hc, rfl⟩ | ⟨c, hc, rfl⟩);
    { simp [ih hc, length_cons] } }
end

theorem cons_mem_explode_cons_of_mem_explode (lit : literal V) :
  c ∈ explode l → (lit :: c) ∈ explode (lit.var :: l) :=
assume hc, by { cases lit; simp [explode, literal.var, hc] }

variable [decidable_eq V]

theorem mem_of_mem_explode_of_mem_vars : c ∈ explode l → v ∈ c.vars → v ∈ l :=
begin
  induction l with v vs ih generalizing c,
  { rw [explode_nil, mem_singleton],
    rintros rfl hv,
    rw clause.vars_nil at hv,
    exact absurd hv (finset.not_mem_empty _) },
  { simp only [explode, mem_append, mem_map],
    rintros (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩);
    { rw [clause.vars, finset.mem_union, mem_cons_iff],
      rintros (hv | hv),
      { rw [var, finset.mem_singleton] at hv,
        exact or.inl hv },
      { exact or.inr (ih ha hv) } } }
end

theorem mem_vars_of_mem_explode_of_mem : c ∈ explode l → v ∈ l → v ∈ c.vars :=
begin
  induction l with v vs ih generalizing c,
  { intros _ hv, exact absurd hv (not_mem_nil v) } ,
  { simp only [explode, mem_append, mem_map],
    rintros (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩) hv;
    { unfold clause.vars var,
      rcases eq_or_mem_of_mem_cons hv with rfl | hv,
      { exact finset.mem_union.mpr (or.inl (mem_singleton_self _)) },
      { exact finset.mem_union.mpr (or.inr (ih ha hv)) } } }
end

theorem not_mem_vars_of_mem_explode_of_not_mem : c ∈ explode l → v ∉ l → v ∉ c.vars :=
λ h hv, mt (mem_of_mem_explode_of_mem_vars h) hv

theorem not_mem_of_mem_explode_of_not_mem_vars : c ∈ explode l → v ∉ c.vars → v ∉ l :=
λ h hv, mt (mem_vars_of_mem_explode_of_mem h) hv

theorem pos_or_neg_of_mem_explode_of_mem : c ∈ explode l → v ∈ l → Pos v ∈ c ∨ Neg v ∈ c :=
λ h hv, mem_vars_iff_pos_or_neg_mem_clause.mp (mem_vars_of_mem_explode_of_mem h hv)

theorem pos_and_neg_not_mem_of_mem_explode_of_not_mem : c ∈ explode l → v ∉ l → Pos v ∉ c ∧ Neg v ∉ c :=
begin
  intro h,
  contrapose,
  rw not_and_distrib,
  simp only [not_not],
  intro hv,
  exact mem_of_mem_explode_of_mem_vars h
    (mem_vars_iff_pos_or_neg_mem_clause.mpr hv)
end

-- If the variables in a clause match the input to explode, then it's in explode
theorem map_var_eq_iff_mem_explode : c.map var = l ↔ c ∈ explode l :=
begin
  induction l with v vs ih generalizing c,
  { simp only [map_eq_nil, explode_nil, mem_singleton] },
  { split,
    { intro h,
      rcases exists_cons_of_map_cons h with ⟨l, ls, rfl, hl, hls⟩,
      cases l; simp only [explode, mem_append, mem_map],
      { rw var at hl, subst hl, left, use [ls, ih.mp hls] },
      { rw var at hl, subst hl, right, use [ls, ih.mp hls] } },
    { simp only [explode, mem_map, mem_append],
      rintros (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩);
      { simp only [ih.mpr ha, var, map, eq_self_iff_true, and_self] } } }
end

/-! # nodup properties of explode -/

theorem explode_nodup (l : list V) : nodup (explode l) :=
begin
  induction l with v vs ih,
  { rw explode_nil, exact nodup_singleton nil },
  { simp only [explode, nodup_cons, nodup_append, (nodup_map_iff (cons_injective)).mpr ih, true_and],
    intros x hxp hxn,
    rcases mem_map.mp hxp with ⟨c, _, rfl⟩,
    rcases mem_map.mp hxn with ⟨d, _, h⟩,
    have := head_eq_of_cons_eq h,
    contradiction }
end

theorem nodup_of_nodup_of_mem (h : nodup l) : c ∈ explode l → nodup c :=
begin
  induction l with n ns ih generalizing c,
  { rw [explode_nil, mem_singleton], rintro rfl, exact nodup_nil },
  { simp only [explode, mem_append, mem_map],
    rintro (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩);
    rw nodup_cons;
    have := pos_and_neg_not_mem_of_mem_explode_of_not_mem ha ((nodup_cons.mp h).1),
    { exact ⟨this.1, ih (nodup_cons.mp h).2 ha⟩ },
    { exact ⟨this.2, ih (nodup_cons.mp h).2 ha⟩ } }
end

theorem xor_pos_neg_mem_clause_of_nodup_of_mem_explode_of_mem (h : nodup l) :
  c ∈ explode l → v ∈ l → xor (Pos v ∈ c) (Neg v ∈ c) :=
begin
  induction l with v vs ih generalizing c,
  { intros _ h, exact absurd h (not_mem_nil _) },
  { simp only [explode, mem_append, mem_map],
    rintros (⟨a, ha, rfl⟩ | ⟨a, ha, rfl⟩) hc;
    { rcases eq_or_mem_of_mem_cons hc with (rfl | hv),
      { simp [pos_and_neg_not_mem_of_mem_explode_of_not_mem ha (nodup_cons.mp h).1] },
      { rcases ih (nodup_cons.mp h).2 ha hv with ⟨hp, hn⟩ | ⟨hp, hn⟩;
        { simp [hp, hn, ne_of_mem_of_not_mem hv (nodup_cons.mp h).1] } } } }
end

end explode


/-
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 3 : "not" (`¬`)

We learn about how to manipulate `¬ P` in Lean.

# The definition of `¬ P`

In Lean, `¬ P` is *defined* to mean `P → false`. So `¬ P` and `P → false`
are *definitionally equal*. Check out the explanation of definitional
equality in the "equality" section of Part B of the course notes:
https://www.ma.imperial.ac.uk/~buzzard/xena/formalising-mathematics-2023/Part_B/equality.html

## Tactics

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

* `change`
* `by_contra`
* `by_cases`

-/

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

variables (P Q R : Prop)

example : ¬ true → false :=
begin
  intro h,
  change true → false at h,
  apply h,
  triv,
end

example : false → ¬ true :=
begin
  intro h,
  intro h2,
  exact h,
end

example : ¬ false → true :=
begin
  intro h,
  triv,
end

example : true → ¬ false :=
begin
  intro h,
  intro h2,
  exact h2,
end

example : false → ¬ P :=
begin
  intro h,
  intro hP,
  exact h,
end

example : P → ¬ P → false :=
begin
  intro hP,
  intro hnP,
  apply hnP,
  exact hP,
end

example : P → ¬ (¬ P) :=
begin
  intro hP,
  intro hnP,
  apply hnP,
  exact hP,
end

example : (P → Q) → (¬ Q → ¬ P) :=
begin
  intros hPQ hnQ hP,
  apply hnQ,
  apply hPQ,
  assumption,
end

example : ¬ ¬ false → false :=
begin
  intro h,
  apply h,
  intro h2,
  exact h2,
end

example : ¬ ¬ P → P :=
begin
  intro h,
  by_contra h2,
  apply h,
  exact h2,
end

example : (¬ Q → ¬ P) → (P → Q) :=
begin
  intros h hP,
  change (Q → false) → (P → false) at h,
  by_contra hnQ,
  apply h,
  { exact hnQ, },
  { exact hP }
end


/-
The purpose of this lecture/assignment is to
develop and deepen your understanding of the
lofical concepts covered so far: equality of
values/terms of any type, and conjunction of
propositions. We present the embedding of the
∨ connective of predicate logic into Lean and
elaborate on the representation of relations,
such as equality, as inductive families of
propositions along with proof-building and
proof-consuming inference rules for them, in
Lean.
-/

/-
Compare and contrast the distinct ways that
we represented these ideas in Lean.

- inductive eq  { α : Sort u }, α → α → Prop
- inductive and (α β : Prop) : Prop

Each of "eq" and and builds "propositions",
but they build them in different ways.

For any given type, eq takes two *values* of
that type, yields a proposition "about" those
values, and provides constructors that define
the only possible proofs of a proposition of
this kind.

By contrast, "and" takes two propositions, i.e.,
*types, not values*, as its arguments, reduces to
another proposition as a result, namely (and P Q),
also written P ∧ Q, and also provide a constructor
(introduction axiom) for building proofs of this
type.

Popping into the everyday language of programming
languages, we can say that "and" is a polymorphic
type; but, by contrast eq, defines a family of binary
(equality) relations *indexed by an arbitrary type*,
α. There's thus a separate binary equality relation
on terms for each distinct type, (α : Sort u).
-/

/-
Ex 1: Embed the concept of the logical or (∨)
connective into Lean in the same style we used
to embed ∧. To do this we'll need to represent
the connective as a family of propositions of
the form P ∨ Q, parameterized by propositions,
P and Q. Then we'll need to define introduction
and elimination rules for ∨ that capture the
intended meaning of this connective: that it's
true (and there's a proof of that) if at least
one of P or Q is true (has a proof).
-/

namespace hidden

/-
Represent ∨ as a family of propositions,
α ∨ β, parameterized by (polymorphic in)
two propositions, α and β, where such a
proposition, α ∨ β has a proof, iff at
least one of α and β has a proof. That is,
we must be able to construct a proof of
α ∨ β from a proof of α or from a proof
of β. We define the introduction rules
for "or" accordingly.
-/
inductive or (α β : Prop) : Prop
| inl (a : α) : or
| inr (b : β) : or

/-
Now we can state and prove disjunctive
(or) propositions. To do so at least one
"disjuct" has to be true, and we have to
pick one and apply the right constructor.
In the following example, it would not
do to use or.intro_right because there
is no proof of that proposition.
-/
example : or (3=3) (3=4) :=
or.inl rfl

/-
Similarly here it wouldn't do to use
or.intro_left, again because the left
disjunct, 3=4, doesn't have a proof.
-/
example : or (3=4) (3=3) :=
or.inr rfl

/-
In this example, we could use either
the left or right introduction rules.
There are thus two distinct proofs in
this case.
-/

lemma left_proof : or (3=3) (4=4) := or.inl rfl
lemma right_proof : or (3=3) (4=4) := or.inr rfl

-- You can see that these are different proofs
#reduce left_proof
#reduce right_proof

/-
Both of these proofs are of type "or (3=3) (4=4)"
and you can see that they're different. And yet,
as you can see next, Lean treats them as equal!
This behavior implements the concept of "proof
irrelevance." Lean enforces the notion that any
proof of a given proposition "will do" by treating
all proofs of the same proposition as being equal.
-/
example : left_proof = right_proof := rfl

end hidden

/-
Now let's see the same ideas using Lean's own
definitions (from its libraries) of "or" and
its related introduction rules.
-/
#check @or
#check or (3=3) (1=0)

example : 3 = 3 ∨ 1 = 0 :=
or.inl rfl

example : 1 = 0 ∨ 3 = 3  :=
or.inr rfl

/-
In the preceding examples, Lean knows
what proposition is to be proved because
it's stated explicitly in each case (right
after the colons). Here's a case where we
leave out the proposition to be proved and
where Lean can't infer it.
-/

-- can't infer second disjunct (return type)
lemma ex1 := or.inl (eq.refl 3)

/-
Here, the term, or.inl (eq.refl 3), is a
proof of "(3=3) ∨ ___", but we have no way
of knowing what that something, the second
disjuct, is. In such cases, we can use an
alternative introduction function, called
or.intro_left, where we specify the right
conjunct explicitly (first argument), and
give a proof of the left, from which the
left conjunct is inferred.
-/

#check or.intro_left (4=5) (eq.refl 3)
--  right proposition ^^^   ^^^^ left proof
#check or.intro_right (4=5) (eq.refl 3)
--    left proposition ^^^   ^^^^ right proof

/-
NEW STUFF: Elim rule for or
-/

#check @or.elim

/-
or.elim : ∀ {a b c : Prop}, a ∨ b → (a → c) → (b → c) → c
-/

axioms
  (Person : Type)
  (Tom : Person)
  (FromCville FromRichmond FromVirginia: Person → Prop)
  (pf : FromCville Tom ∨ FromRichmond Tom)
  (cv : ∀ {p :Person}, FromCville p → FromVirginia p)
  (rv : ∀ {p :Person}, FromRichmond p → FromVirginia p)

  theorem TomIsFromVa : (FromVirginia Tom) :=
  begin
    cases pf,
    exact cv h,
    exact rv h,
  end

  /-
  Properties as single-argument predicates
  -/

  def ev' : ℕ → Prop := λ n, n%2 = 0

inductive ev : ℕ → Prop
| ev_0 : ev 0
| ev_2 : ∀ (n : ℕ), ev n → ev (n + 2)

example : ev 0 := ev.ev_0

example : ev 2 :=
begin
  apply ev.ev_2 _ _,
  exact ev.ev_0,
end

example : ev 8 :=
begin
  apply ev.ev_2 6 _,
    {apply ev.ev_2 4 _,
    apply ev.ev_2 2 _,
    apply ev.ev_2 0 _,
    exact ev.ev_0,}
end

example : ev 1000 :=
begin
  repeat {apply ev.ev_2},
  exact ev.ev_0,
end

inductive lte : ℕ → ℕ → Prop
| base : ∀ {n : ℕ}, lte n n
| step : ∀ {n m : ℕ}, lte n m → lte n (nat.succ m)

example : lte 3 3 := lte.base
example : lte 3 4 :=
begin
  apply lte.step,
  exact lte.base,
end

example : lte 3 6 :=
begin
  apply lte.step,
  apply lte.step,
  apply lte.step,
  exact lte.base,
end

#check nat.le

/-
The propositions, true and false.
-/

namespace hidden

inductive false : Prop
/-
inductive empty : Type
-/

inductive true : Prop
| intro
/-
inductive unit : Type
| star
-/

example : true := true.intro
example : false := _

end hidden
/-
#2. Define an inductive family of propositions
to specify the successor relationship, succ_rel,
between pairs of natural numbers. Given any two
natural numbers, n and m, (n, m) ∈ succ_rel if
and only if m = n + 1. Then state and prove the
lemma, (0,1) ∈ succ_rel.
-/

/-
Before specifying this relation logically, let's
write a *computational* definition. (As a review
of syntactic alternatives for defining functions,
we give three variants.)
-/
def incr (n : ℕ) : ℕ := n + 1
def incr' : ℕ → ℕ := λ (n : ℕ), n + 1
def incr'' : ℕ → ℕ | n := n + 1

/-
The wonderful thing about function definitions in
Lean and other programming languages, is that they
compute. You can apply a function to an argument
and the machine will derive the result. Here for
example, we apply the incr function to the actual
parameter 7. To reduce this application expression,
Lean fetches the body of the function, substitutes
the 7 for each occurence of n, yielding (7 + 1) in
this case. It then reduces that expression, giving
8, as a final result. In this sense, we *computed*
that the pair, (7, 8), belongs to the relation.
-/
#reduce incr 7

/-
By contrast, we *specify* the relation "declaratively"
by giving rules that can be used to prove (or not) that
a given pair is in the relation. The rule in this case
is succ_rel.intro. What it specifies is that if one is
given any two natural numbers, n and m, along with a
proof, h, that (m = n + 1) then (succ_rel n m h) is a
a proof of succ_rel n m.
-/
inductive succ_rel : ℕ → ℕ → Prop
| intro (n m : ℕ) (h : m = n + 1) : succ_rel n m

/-
Note that applying succ_rel to n and m, say 3 and 4,
just returns the *proposition*, (n,m) is in succ_rel.
You can't apply succ_rel to 3 and expect to get a 4
in return as is possible with the incr functions we
defined above.
-/
#check succ_rel 3 4
#check @succ_rel.intro

/-
Rather, with such a declarative specification in hand,
what we can do is to try to prove that certain pairs
of numbers are in this relation. Next, for example, we
first prove that (3, 4) is in this relation, and then
we see that we get stuck if we try to prove that the
pair, (3,5), satisfies the specification of succ_rel.

-/

example : succ_rel 3 4 := succ_rel.intro 3 4 rfl
example : succ_rel 3 5 := succ_rel.intro 3 5 rfl

/-
We've now seen that we can specify a mathematical
function either computationally, as a function, or
declaratively, as a relation. Two questions arise.
First, are these definitions mathematically equivalent?
Second, why would we ever want to use a declarative
specification rather than a "computable" function?
-/

/-
To answer the first question, we formulate the claim
that the two definitions are equivalent as a formal
proposition, and we prove it. We claim and show that
(n,m) ∈ succ_rel if and only if m = incr m. This is
your first example of a kind of program verification,
wherein we prove that a function that we can run will
always give us the answer that the declarative spec
says it should give us.
-/
theorem def_equivalent : ∀ (n m : ℕ), (m = incr n) ↔ succ_rel n m :=
begin
  intros,
  apply iff.intro _ _,  -- hint: try "split" instead

  -- forward
  assume h,
  rw h,
  unfold incr,
  apply succ_rel.intro,
  trivial,
  --
  assume h,
  cases h,
  unfold incr,
  assumption,
end

/-
Yay! Now for the second question: why would we ever
want to use a declarative specification of a binary
relation rather than a function that we can "run" to
get the second element of any pair from the value of
the first?

The answer is that functions in Lean are total, so
if we want to represent partial functions, we need
to use declarative specifications.

To make this idea concrete, consider the partial
function, F, that is exactly the identity function
on natural numbers except that it's undefined for
the input, zero. The mathematical function, F, is
of type ℕ → ℕ, but we can't implement it properly in
Lean as a function, say f1, of type ℕ → ℕ, because
what this type really means is ∀ (n : ℕ), ℕ, which
is to say that it has to return a value of type ℕ
*for any* argument, n, including 0.

There are some workarounds, but none is perfect.
Let's look at a few work-arounds.
-/

/-
Alternative #1. Just use the identify function and
leave the programmer resposible for never applying
it to the value, zero.
-/
def f1 : ℕ → ℕ := λ n, n

/-
Alternative #2. For zero, return an unusual value
as a sort of error flag. This solution also demands
that the programmer understand the "hack" that we're
using here. Clearly g doesn't *really* represent the
partial function
-/
def f2 : ℕ → ℕ :=
  λ n, if (n = 0) then 1000 else n

#reduce f2 2
#reduce f2 1
#reduce f2 0

/-
Alternative #3: Use an option return type. Now we
have an implementation that is more faithful to the
behavior of our mathematical function, F, but at
the cost of (1) changing the type from ℕ → ℕ to
ℕ → option ℕ, and (2) forcing the user of f3 always
to check whether they received an error (none) or
a normal return value (some n).
-/
def f3 : ℕ → option ℕ :=
  λ n, if (n = 0) then none else some n

def demo_f3 : ℕ → string :=
λ n,
  let r := f3 n in      -- temporarily bind r to result
  match r with          -- error check: case analysis on r
    | none := "error"   -- if "none", return "error" string
    | some n := "good"  -- else return "good" string
  end

#eval demo_f3 2
#eval demo_f3 1
#eval demo_f3 0

/-
Whereas f3 requires the caller to check for an
error *after* calling the function, we can also
add an argument to our implementation requiring
the programmer to show *before* the function is
called that the argument is good.
-/
def f4 : ∀ (n : ℕ), (n ≠ 0) → ℕ := λ n h, n

/-
The proof argument establishes a "precondition"
for f4. One cannot even call it without having
a proof that n≠0.  In each of the following
examples, we apply f4 to n and a proof of n≠0,
and we provide the proof argument as the result
of a simple tactic script. In the final case,
of n = 0, you will see that we can't provide
that second proof argument, which prevents us
from calling the function without getting an
error.
-/

#reduce f4 2 begin assume k, cases k, end
#reduce f4 1 begin assume k, cases k, end
#reduce f4 0 begin assume k, cases k, end

/-
In the last case we're prevented from
calling the function properly by the
non-existence of the required proof
argument.

This solution shows that in Lean we can
incorporate precondition specifications
and a kind of precondition checking by
defining functions that require proofs
be given as arguments to show that the
required conditions for using a function
are satisfied.
-/

/-
For the sake of completeness, another
similar solution is based on the notion
of a subtype in Lean. Here we define a
subtype, positive, of the natural numbers,
then we use pos as the argument type.
-/

def positive : Type := { n : ℕ // n ≠ 0 }

/-
A value of this type is a pair, comprising
a natural number, n, and a proof that n ≠ 0.
We then implement F as a total function from
positive to ℕ, knowing that if we do get a
value of type, positive, as input, that it's
a number and a proof that that number is not
zero. So we just extract the number from the
pair and return it.

But this is still not perfect. The domain
of F is ℕ, even though the domain on which
it's defined (it's domain of definition) does
not include 0. So mathematically speaking, F
is a partial function from ℕ to ℕ, not a total
function from positive to nat. Our code does
not quite express the nature of the concept
(F) that we're implementing.
-/

def f5 : positive → ℕ :=
  λ n, match n with
    | ⟨ n, pf ⟩ := n
  end

/-
In many cases, the most practical solution will
be to switch from a "computable" function to a
declarative specification of a relation. That is
what we've done in this file.
-/

inductive F : ℕ → ℕ → Prop
| intro : ∀ (n m : ℕ), (n≠0) → (n=m) → F n m

/-
Now instead of computing m from n in any given
case, we assert and prove that a given m relates
to a given n. And of course we require that n≠0
in any case.
-/

-- (2,2) is in the identity relation on pos nats
example : F 2 2 :=
  F.intro 2 2 (begin intro h, cases h end) rfl

-- (1,1) is in the identity relation on pos nats
example : F 1 1 :=
  F.intro 1 1 (begin intro h, cases h end) rfl

-- (1,2) is not in the relation: the check that m=n fails
example : F 1 2 :=
  F.intro 1 2 (begin intro h, cases h end) rfl

-- (0,0) is not in the relation: the check that n≠0 fails
example : F 0 0 :=
  F.intro 0 0 (begin intro h, cases h end) rfl


import data.int.modeq

/-
Show that every square is congruent to 0, 1, or -1 modulo 5, and is congruent to 0, 1, or 4 modulo 8.

Suppose n is a positive integer such that 2n + 1 and 3n + 1 are squares. Prove that n is divisible by 40.

Find a value of n such that 2n + 1 and 3n + 1 are squares. Can you find another value? (Calculators allowed!)
-/

lemma sq_mod_five (n : ℤ) : n^2 ≡ 0 [ZMOD 5] ∨ n^2 ≡ 1 [ZMOD 5] ∨ n^2 ≡ -1 [ZMOD 5] :=
begin
  sorry
end

lemma sq_mod_eight (n : ℤ) : n^2 ≡ 0 [ZMOD 8] ∨ n^2 ≡ 1 [ZMOD 8] ∨ n^2 ≡ 4 [ZMOD 8] :=
begin
  sorry
end

lemma div_by_forty (n : ℤ) (hn : n > 0) (h₁ : ∃k : ℤ, k^2 = 2 * n + 1) (h₂ : ∃l : ℤ, l^2 = 3 * n + 1) : 40 ∣ n :=
begin
  sorry
end

lemma exist_sq : ∃n : ℤ, n > 0 ∧ (∃k : ℤ, k^2 = 2 * n + 1) ∧ (∃l : ℤ, l^2 = 3 * n + 1) :=
begin
  sorry
end


-- Un número es par syss lo es su cuadrado
-- =======================================

import data.int.parity
open int

variable (n : ℤ)

-- ----------------------------------------------------
-- Ejercicio. Demostrar que un número es par syss lo es
-- su cuadrado.
-- ----------------------------------------------------

-- 1ª demostración
example :
  even (n^2) ↔ even n :=
begin
  split,
  { contrapose,
    rw ← odd_iff_not_even,
    rw ← odd_iff_not_even,
    unfold odd,
    intro h,
    cases h with k hk,
    use 2*k*(k+1),
    rw hk,
    ring, },
  { unfold even,
    intro h,
    cases h with k hk,
    use 2*k^2,
    rw hk,
    ring, },
end

-- 2ª demostración
example :
  even (n^2) ↔ even n :=
begin
  split,
  { contrapose,
    rw ← odd_iff_not_even,
    rw ← odd_iff_not_even,
    rintro ⟨k, rfl⟩,
    use 2*k*(k+1),
    ring, },
  { rintro ⟨k, rfl⟩,
    use 2*k^2,
    ring, },
end

-- 3ª demostración
example :
  even (n^2) ↔ even n :=
iff.intro
  ( have h : ¬even n → ¬even (n^2),
      { assume h1 : ¬even n,
        have h2 : odd n,
          from odd_iff_not_even.mpr h1,
        have h3: odd (n^2), from
          exists.elim h2
            ( assume k,
              assume hk : n = 2*k+1,
              have h4 : n^2 = 2*(2*k*(k+1))+1, from
                calc  n^2
                    = (2*k+1)^2       : by rw hk
                ... = 4*k^2+4*k+1     : by ring
                ... = 2*(2*k*(k+1))+1 : by ring,
              show odd (n^2),
                from exists.intro (2*k*(k+1)) h4),
        show ¬even (n^2),
          from odd_iff_not_even.mp h3 },
    show even (n^2) → even n,
      from not_imp_not.mp h )
  ( assume h1 : even n,
    show even (n^2), from
      exists.elim h1
        ( assume k,
          assume hk : n = 2*k ,
          have h2 : n^2 = 2*(2*k^2), from
            calc  n^2
                = (2*k)^2   : by rw hk
            ... = 2*(2*k^2) : by ring,
          show even (n^2),
            from exists.intro (2*k^2) h2 ))


inductive Expr where
  | const : Nat → Expr
  | var : Nat → Expr
  | plus : Expr → Expr → Expr
  | times : Expr → Expr → Expr
  deriving Repr

open Expr

def sampleExpr : Expr := plus (times (var 0) (const 7)) (times (const 2) (var 1))

def eval (v : Nat → Nat) : Expr → Nat
  | const n     => n
  | var n       => v n
  | plus e₁ e₂  => (eval v e₁) + (eval v e₂)
  | times e₁ e₂ => (eval v e₁) * (eval v e₂)

def sampleVal : Nat → Nat
  | 0 => 5
  | 1 => 6
  | _ => 0

#eval (eval sampleVal sampleExpr)

def simpConst : Expr → Expr
  | plus (const n₁) (const n₂)  => const (n₁ + n₂)
  | times (const n₁) (const n₂) => const (n₁ * n₂)
  | e                           => e

def fuse : Expr → Expr
 | plus e₁ e₂ => simpConst (plus (fuse e₁) (fuse e₂))
 | times e₁ e₂ => simpConst (times (fuse e₁) (fuse e₂))
 | e => e

def anotherExpr : Expr := times (plus (const 1) (const 2)) (plus (const 5) (var 0))

#eval (fuse anotherExpr)

theorem simpConst_eq (v : Nat → Nat) : ∀ e : Expr, eval v (simpConst e) = eval v e := by sorry

theorem fuse_eq (v : Nat → Nat) : ∀ e : Expr, eval v (fuse e) = eval v e := by sorry


import lib.m154
open m154

/- # Le quantificateur existentiel

Dans ce fichier, on aborde la manipulation du quantificateur existentiel.
Pour démontrer un énoncé de la forme `∃ x, P x`,
on fournit un `x₀` qui convient à l'aide de la commande `Montrons que x₀ convient`.
Ce `x₀` peut être un objet du contexte, une constante ou une expression plus
compliquée. Ensuite il faut démontrer l'énoncé `P x₀`.
-/
example : ∃ x : ℝ, x*x = 4 :=
begin
  Montrons que -2 convient,  -- Est-ce la seule possibilité ?
  On calcule,
end

example : ∃ x : ℝ, x*x = 16 :=
begin
  sorry
end

/-
Pour utiliser un énoncé de la forme `h : ∃ x, P x`, on utilise la commande
`Par h on obtient x₀ tel que hx₀ : P x₀`
qui fixe un `x₀` et une hypothèse `hx₀` affirmant `P x₀`.

Ici `h` peut être directement un énoncé du contexte ou une expression plus
compliquée. On peut aussi utiliser la forme
`Par h appliqué à args on obtient ...` où `args` est un argument ou une liste d'arguments.
-/

example (n : ℕ) (h : ∃ n', n = n' + 1) : n > 0 :=
begin
  Par h on obtient n' tel que hn' : n = n' + 1,
  On réécrit via hn',
  On calcule,
end

example (n : ℕ) (h : ∃ n', n = n' + 3) : n > 0 :=
begin
  sorry
end

/-
Il faut bien noter qu'en général il y a plusieurs `x` qui conviennent. Dans
l'exemple suivant, il y en a deux (sauf si y est nul).
Pour insister sur le fait qu'on en a fixé un, on l'appelle `x₀`.
On utilise aussi les lemmes `pos_pos` et `neg_neg` de la feuille 2, et le lemme
`le_total` de la feuille 6.
-/
example (y : ℝ) (h : ∃ x, y = x*x) : y ≥ 0 :=
begin
  Par h on obtient x₀ tel que hy₀ : y = x₀*x₀,
  On réécrit via hy₀,
  On discute en utilisant (le_total 0 x₀ : 0 ≤ x₀ ∨ 0 ≥ x₀),
    Supposons h' : 0 ≤ x₀,
    On conclut par pos_pos appliqué à [h', h'],
  Supposons h' : 0 ≥ x₀,
  On conclut par neg_neg appliqué à [h', h'],
end

/-
Les exercices suivants utilisent la relation de divisibilité dans ℤ
(attention à la barre de divisibilité qui n'est pas celle du clavier
mais obtenue par ,|).
Contrairement au contexte de la feuille 4, le seul lemme utile est ici
`divise_def (a b : ℤ) : a ∣ b ↔ ∃ k, b = a*k`
-/

-- Dans toute la suite, a b et c désignent des entiers relatifs
variables (a b c : ℤ)

/-
Dans des démonstrations un peu longues, il peut être utile de rappeler au lecteur
ce que « convient » signifie dans dans « Montrons que x₀ convient ».
Pour cela on peut écrire : `Montrons que x₀ convient : P x₀` comme dans l'exmple suivant.

Cet exemple illustre aussi la commande `On renomme` qui permet de renommer une variable
liée dans le but. On peut aussi renommer dans une hypothèse `hyp` en terminant
la commande par `dans hyp`. Ce renommage n'est jamais utile pour Lean, mais permet
de gagner en lisibilité.
-/

example (h1 : a ∣ b) (h2 : b ∣ c) : a ∣ c :=
begin
  Par h1 on obtient k tel que hk : b = a*k, -- (1)
  Par h2 on obtient l tel que hl : c = b*l, -- (2)
  -- Pour montrer que a ∣ c, il suffit de trouver m tel que c = a*m
  On réécrit via divise_def,
  -- Comme nous avons déjà fixé un entier nommé `k`, le nom de la variable muette
  -- dans le but est perturbant.
  On renomme k en m,

  Montrons que k*l convient : c = a * (k * l),
  calc c = b*l     : by On conclut par hl -- par (2)
     ... = (a*k)*l : by On réécrit via hk -- par (1)
     ... = a*(k*l) : by On calcule,
end

/-
Dans la démonstration précédente, la commande `On renomme ... en ... (dans ...)`
est purement psychologique, elle renomme une variable liée pour éviter
un conflit apparent avec le k fixé dans le contexte.

En fait l'utilisation du lemme divise_def est aussi psychologique, Lean
sait que c'est la définition de la divisibilité.
Vous pouvez essayer de commenter ces deux lignes psychologiques en ajoutant
« -- » en début de ligne.

Voyons maintenant un autre énoncé semblable.
-/

example (h1 : a ∣ b) (h2 : a ∣ c) : a ∣ b+c :=
begin
  sorry
end

example : 0 ∣ a ↔ a = 0 :=
begin
  sorry
end

/-
L'exercice suivant utilise les définitions « pair » et « impair »

`def pair (n : ℤ) := ∃ k, n = 2*k`
`def impair (n : ℤ) := ∃ k, n = 2*k + 1`

et le lemme :

`pair_ou_impair (n : ℤ) : pair n ∨ impair n`
-/

example (n : ℤ) : pair (n*(n+1)) :=
begin
  sorry
end

/-
On commence maintenant à combiner explicitement les quantificateurs,
avec la définition de la surjectivité.
-/

def surjective (f : ℝ → ℝ) := ∀ y, ∃ x, f x = y

/-
Dans la démonstration suivante, il sera psychologiquement confortable de demander
à Lean de déplier cette définition, à l'aide de la commande `On déplie`.
-/

-- Dans la suite f et g sont des fonctions de ℝ dans ℝ.
variables(f g : ℝ → ℝ)

-- On suppose que g ∘ f est surjective. Alors g est surjective.
example (h : surjective (g ∘ f)) : surjective g :=
/- On commence par donner une démonstration très bavarde, mais
   cette discussion est très importante pour comprendre l'enjeu des
   variables liées et variables libres. -/
begin
  -- Il s'agit de montrer que ∀ y, ∃ x, g(x) = y
  On déplie surjective, -- On pourrait aussi écrire `Montrons que ∀ y, ∃ x, g x = y`
  -- Soit y un réel. On veut trouver x tel que g(x) = y
  Soit y,
  -- Or notre hypothèse sur g ∘ f garantit que ∀ y, ∃ x, (g ∘ f)(x) = y
  On déplie surjective dans h,
  -- A priori le symbole y apparaissant dans cette hypothèse n'a rien à voir
  -- avec le y que nous avons fixé. C'est une variable liée (ou muette),
  -- on peut la renommer z.
  On renomme y en z dans h,
  -- On a également des variables nommées x dans l'hypothèse et dans le but.
  -- Mais ce sont toutes deux des variables liées, n'ayant aucun rapport
  -- entre elles. En fait le (ou les) x promis par l'hypothèse ne conviennent
  -- pas pour notre but.
  -- Renommons donc la variable liée de l'hypothèse pour clarifier la situation.
  On renomme x en w dans h,
  -- On peut spécialiser l'hypothèse h au y que nous avons fixé,
  -- ce qui fournit w tel que (g ∘ f)(w) = y
  Par h appliqué à y on obtient w tel que hw : g (f w) = y,
  -- Montrons que f(w) convient pour notre but
  Montrons que f w convient,
  -- Il s'agit de montrer que g(f(w)) = y mais ce n'est rien d'autre
  -- que notre hypothèse sur w, par définition de la composition.
  -- Sur papier on écrirait simplement « f(w) convient », sans le
  -- « Montrons que ».
  On conclut par hw,
end
/-
Bien sûr l'essentiel de la discussion ci-dessus est inutile d'un point
de vue logique. Ni Lean ni une rédaction pour experts n'ont besoin
de tous ces discours. Voici la même démonstration sans bavardage.
-/
example (h : surjective (g ∘ f)) : surjective g :=
begin
  Soit y,
  Par h appliqué à y on obtient w tel que hw : (g ∘ f) w = y,
  Montrons que f w convient,
  On conclut par hw,
end

/-
La démonstration précédente est sans doute trop concise. Avant de la transcrire sur papier,
il vaut mieux ajouter une ligne inutile explicitant quel est le but après la première ligne.
On peut aussi ajouter quelques annotations pour nos lecteurs distraits qui auraient oublié
que f et g sont des fonctions de ℝ dans ℝ. De plus l'hypothèse h ne serait
sans doute pas nommée dans une version papier de cet exercice donc on ajoute aussi
une annotation au moment de l'utiliser.
-/

example (h : surjective (g ∘ f)) : surjective g :=
begin
  Soit y : ℝ,
  Montrons que ∃ x, g x = y,
  Par (h : surjective (g ∘ f)) appliqué à y on obtient (w : ℝ) tel que hw : (g ∘ f) w = y,
  Montrons que f w convient,
  On conclut par hw,
end

/-
Et on peut passer à la rédaction « sur papier », par exemple :

  Soit y réel. Montrons qu'il existe x réel tel que g(x) = y.
  Par l'hypothèse de surjectivité de g ∘ f appliquée à y, on obtient w réel tel que
  g ∘ f(w) = y. Le réel f(w) convient.
-/

example (hf : surjective f) (hg : surjective g) : surjective (g ∘ f) :=
begin
  sorry
end


/-
Derek Johnson dej3tc
11/1/2019
-/

import .prop_logic
import .bool_sat

open prop_logic
open prop_logic.var
open prop_logic.pExp

/-
An example: The 0th, 1st, and
2nd bits from the right in 100,
the binary numeral for decimal
4, are 0, 0, and 1, respectively.
-/
#eval mth_bit_from_right_in_n 2 4

/-
#1. Write and evaluate expressions
(using eval) to determine what is
the bit in the 9th position from
the right in the binary expansion
of the decimal number 8485672345?

Hint: don't use reduce here. Eval
uses hardware (machine) int values
to represent nats, while reduce
uses the unary nat representation.

Self-test: How much memory might
it take to represent the decimal
number, 8485672345, as a ℕ value
in unary?
-/

#eval mth_bit_from_right_in_n 9 8485672345

/-
The next section presents examples
to set up test cases for definitions
to follow.
-/

/-
We define a few variables to use
in the rest of this assignment.
-/
def P : pExp:= varExp (mkVar 0)
def Q: pExp := varExp (mkVar 1)
def R : pExp := varExp (mkVar 2)

/-
We set parameter values used in
some function definitions to follow.
-/
def max_var_index := 2
def num_vars := max_var_index + 1

/-
An example of a propositional logic
expression.
-/
def theExpr : pExp := (P ⇒ (P ∧ R))

/-
An example using the truth_table_results
function to compute and return a list of
the truth values of theExpr under each of
its possible interpretations.
-/
#eval truth_table_results theExpr num_vars

/-
#2. Define interp5 to be the interpretation
in the six row (m=5) of the truth table that
our interps_for_n_vars functions returns for
our three variables (P, Q, and R).

Hint: use the mth_interp_n_vars function.
Definitely check out the definition of the
function, and any specification text, even
if informal, given with the formal definition.
-/

def interp5 := mth_interp_n_vars 5 3

/-
#3. What Boolean values are assigned to
P, Q, and R by this interpretation (interp5)?
Use three #eval commands to compute answers by
evaluating each variable expressions under the
interp5 interpretation.
-/

#eval pEval P interp5
#eval pEval Q interp5
#eval pEval R interp5

#eval pEval R (mth_interp_n_vars 7 3)
/-
#4. Write a truth table within this
comment block showing the values for
P, Q, and R, in each row in the truth
table, represented by a corresponding
valule in the list of interpretations
returned by interps_for_n_vars. Label
your columns as R, Q, and P, in that
order. (Try to understand why.)
Hint: Don't just write what you think
the answers are:, evaluate each of
the three variable expression under
each interpretation. You can use the
mth_interp_n_vars function if you want
to obtain interpretation functions for
each of the rows individually if you
want.

Answer:
   R     Q       P
   -     -       -
   f     f       f
   f     f       t
   f     t       f
   f     t       t
   t     f       f
   t     f       t
   t     t       f
   t     t       t

-/

/-
#5. Write an expression here to
compute the "results" column of
the truth table for "theExpr" as
defined above.
-/

#eval truth_table_results theExpr 2

/-
#6. Copy and paste the truth table
from question #4 here and extend it
with the results you just obtained.
Check the results for correctness.

Answer here:
R     Q       P     Out
-     -       -     -
f     f       f     t
f     f       t     t
f     t       f     t
f     t       t     t
t     f       f     f
t     f       t     t
t     t       f     f
t     t       t     t

-/

/-
#7.

Write a "predicate" function, isModel,
that takes a propositional logic
expression, e, and an interpretation,
i, as its arguments and that returns
the Boolean true (tt) value if and only
if i is a model of e (otherwise false).
-/

def isModel :pExp → (var → bool) → bool
| e i := if(pEval e i)
            then tt
        else ff

#eval  mth_interp_n_vars 3 2( mkVar 0)
#eval isModel P (mth_interp_n_vars 3 2)
/-
#7. Write a one-line implementation
of a function, is_valid, that takes as
its arguments a propositional expression,
e, and the number of variables, n, in its
truth table, and that returns true if and
only if it is valid, construed to mean
tha every result in the list returned by
the truth_table_results function is true.

To do so, define and use a fold function
to reduce returned lists of Boolean truth
values to single truth values. Define and
use a bool-specific function, fold_bool :
    (bool → bool → bool) →
    bool →
    (list bool) →
    bool,
where the arguments are, respectively,
a binary operator, an identity element
for that operator, and a list of bools
to be reduced to a single bool result.
-/
open list
def fold_bool :
    (bool → bool → bool) → bool → (list bool) → bool
| i val nil := val
| i val (cons h t) :=
    i h (fold_bool i val t)

def is_valid : pExp → ℕ → bool
| p n := fold_bool band tt (truth_table_results p n)

/-
Write similar one-line implementations of the
functions, is_satisfiable and is_unsatisfiable,
respectively. Do not use fold (directly) in your
implementation of is_unsatisfiable.
-/

def is_satisfiable : pExp → ℕ → bool
| p n := fold_bool bor ff (truth_table_results p n)

def is_unsatisfiable : pExp → ℕ → bool
| p n := if (is_satisfiable p n) then ff else tt

/-
8. Use your is_valid function to determine which
of the following putative valid laws of reasoning
really are valid, and which ones are not. For each
one that is not, give a real-world scenario that
shows that the rule doesn't always lead to a valid
deduction. Use #eval to evaluate the validity of
each proposition. Use -- to put a comment after
each of the following definitions indicating
either "-- valid" or "-- NOT valid".
-/

def true_intro : pExp := pFalse -- Valid
def false_elim := pFalse ⇒ P -- valid
def and_intro := P ⇒ Q ⇒ (P ∧ Q)   --valid
def and_elim_left := (P ∧ Q) ⇒ P   --valid
def and_elim_right := (P ∧ Q) ⇒ Q  --valid
def or_intro_left := P ⇒ (P ∨ Q) --valid
def or_intro_right := Q ⇒ (P ∨ Q) -- valid
def or_elim := (P ∨ Q) ⇒ (P ⇒ R) ⇒ (Q ⇒ R) ⇒ R -- valid
def iff_intro := (P ⇒ Q) ⇒ (Q ⇒ P) ⇒ (P ↔ Q) -- valid
def iff_elim_left := (P ↔ Q) ⇒ (P ⇒ Q) -- valid
def iff_elim_right := (P ↔ Q) ⇒ (Q ⇒ P) -- valid
def arrow_elim := (P ⇒ Q) ⇒ P ⇒ Q -- valid
def affirm_consequence := (P ⇒ Q) ⇒ Q ⇒ P  --not valid Q=ff P=tt
-- if it is raining then it is wet. Then, if it is wet then it is raining
def resolution := (P ∨ Q) ⇒ (¬ Q ∨ R) ⇒ (P ∨ R) -- valid
def unit_resolution := (P ∨ Q) ⇒ (¬ Q) ⇒ P -- valid
def syllogism := (P ⇒ Q) ⇒ (Q ⇒ R) ⇒ (P ⇒ R) -- valid
def modus_tollens := (P ⇒ Q) ⇒ ¬ Q ⇒ ¬ P -- valid
def neg_elim := ¬ ¬ P ⇒ P -- valid
def excluded_middle := P ∨ ¬ P -- valid
def neg_intro := (P ⇒ pFalse) ⇒ ¬ P -- valid
def affirm_disjunct := (P ∨ Q) ⇒ P ⇒ ¬ Q --Not Valid Q==ff P==ff
-- if it is raining and it is wet, then if it is raining then it is not wet.
def deny_antecedent := (P ⇒ Q) ⇒ (¬ P ⇒ ¬ Q) --Not Valid Q==ff P==ff
-- if it is raining then it is wet. Therefore, if it is not raining it implies it is not wet

-- Answer below
#eval is_valid true_intro 1
#eval is_valid false_elim 1
#eval is_valid and_elim_left 2
#eval is_valid and_elim_right 2
#eval is_valid and_intro 2
#eval is_valid or_intro_left 2
#eval is_valid or_intro_right 2
#eval is_valid or_elim 3
#eval is_valid iff_intro 2
#eval is_valid iff_elim_left 2
#eval is_valid iff_elim_right 2
#eval is_valid arrow_elim 2
#eval is_valid affirm_consequence 2
#eval is_valid resolution 3
#eval is_valid unit_resolution 2
#eval is_valid syllogism 3
#eval is_valid modus_tollens 2
#eval is_valid neg_elim 1
#eval is_valid excluded_middle 1
#eval is_valid neg_intro 1
#eval is_valid affirm_disjunct 2
#eval is_valid deny_antecedent 2


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

/-!

# Sets in Lean, example sheet 4 : exists (`∃`)

In this sheet we learn how to manipulate `∃` in Lean. We will see
statements of the form `∃ x, x ∈ A`. We will need to learn two new
tactics -- one for making progress when the goal is `⊢ ∃ x, x ∈ A`,
and one for making progress when we have a hypothesis `h : ∃ x, x ∈ A`.

Now we have `∃` and `∀`, and `∈` and `∉`, we can finally get going
with some harder levels.

## New tactics you will need to know

`cases` or `rcases` -- to get the `x` from a hypothesis `h : ∃ x, ...`
`use` -- to make progress on goals of the form `⊢ ∃ x, ...`

### The `cases` tactic

We've seen this tactic before to take apart `h : P ∧ Q`. We can also
use it to take apart `h : ∃ t : X, F t`: if `h` is such a hypothesis
then `cases h with x hx,` will give us `x : X` and `hx : F x`

### The `use` tactic

If we have a goal `⊢ ∃ x : X, F x` and a term `a : X` which we know
will work, then `use a` will change the goal to `F a`. By the way,
`use` tries `refl` so it might magically close goals early

-/

open set

variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

example : x ∈ A → ∃ t, t ∈ A :=
begin
  sorry
end

example : (∀ x, x ∈ A) ↔ ¬ (∃ x, x ∉ A) :=
begin
  sorry
end

example : (∃ x, x ∈ A) ↔ ¬ (∀ x, x ∉ A) :=
begin
  sorry
end


/-
Copyright (c) 2020 James Arthur. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: James Arthur, Chris Hughes, Shing Tak Lam
-/
import analysis.special_functions.trigonometric

/-!
# Inverse of the sinh function

In this file we prove that sinh is bijective and hence has an
inverse, arsinh.

## Main Results

- `sinh_injective`: The proof that `sinh` is injective
- `sinh_surjective`: The proof that `sinh` is surjective
- `sinh_bijective`: The proof `sinh` is bijective
- `arsinh`: The inverse function of `sinh`

## Tags

arsinh, arcsinh, argsinh, asinh, sinh injective, sinh bijective, sinh surjective
-/
noncomputable theory

namespace real

/-- `arsinh` is defined using a logarithm, `arsinh x = log (x + sqrt(1 + x^2))`. -/
@[pp_nodot] def arsinh (x : ℝ) := log (x + sqrt (1 + x^2))

/-- `sinh` is injective, `∀ a b, sinh a = sinh b → a = b`. -/
lemma sinh_injective : function.injective sinh := sinh_strict_mono.injective

private lemma aux_lemma (x : ℝ) : 1 / (x + sqrt (1 + x ^ 2)) = -x + sqrt (1 + x ^ 2) :=
begin
  refine (eq_one_div_of_mul_eq_one _).symm,
  have : 0 ≤ 1 + x ^ 2 := add_nonneg zero_le_one (sq_nonneg x),
  rw [add_comm, ← sub_eq_neg_add, ← mul_self_sub_mul_self,
      mul_self_sqrt this, sq, add_sub_cancel]
end

private lemma b_lt_sqrt_b_one_add_sq (b : ℝ) : b < sqrt (1 + b ^ 2) :=
calc  b
    ≤ sqrt (b ^ 2)     : le_sqrt_of_sq_le $ le_refl _
... < sqrt (1 + b ^ 2) : (sqrt_lt (sq_nonneg _)).2 (lt_one_add _)

private lemma add_sqrt_one_add_sq_pos (b : ℝ) : 0 < b + sqrt (1 + b ^ 2) :=
by { rw [← neg_neg b, ← sub_eq_neg_add, sub_pos, sq, neg_mul_neg, ← sq],
  exact b_lt_sqrt_b_one_add_sq (-b) }

/-- `arsinh` is the right inverse of `sinh`. -/
lemma sinh_arsinh (x : ℝ) : sinh (arsinh x) = x :=
by rw [sinh_eq, arsinh, ← log_inv, exp_log (add_sqrt_one_add_sq_pos x),
      exp_log (inv_pos.2 (add_sqrt_one_add_sq_pos x)),
      inv_eq_one_div, aux_lemma x, sub_eq_add_neg, neg_add, neg_neg, ← sub_eq_add_neg,
      add_add_sub_cancel, add_self_div_two]

/-- `sinh` is surjective, `∀ b, ∃ a, sinh a = b`. In this case, we use `a = arsinh b`. -/
lemma sinh_surjective : function.surjective sinh := function.left_inverse.surjective sinh_arsinh

/-- `sinh` is bijective, both injective and surjective. -/
lemma sinh_bijective : function.bijective sinh :=
⟨sinh_injective, sinh_surjective⟩

/-- A rearrangement and `sqrt` of `real.cosh_sq_sub_sinh_sq`. -/
lemma sqrt_one_add_sinh_sq (x : ℝ): sqrt (1 + sinh x ^ 2) = cosh x :=
begin
  have H := real.cosh_sq_sub_sinh_sq x,
  have G : cosh x ^ 2 - sinh x ^ 2 + sinh x ^ 2 = 1 + sinh x ^ 2 := by rw H,
  rw sub_add_cancel at G,
  rw [←G, sqrt_sq],
  exact le_of_lt (cosh_pos x),
end

/-- `arsinh` is the left inverse of `sinh`. -/
lemma arsinh_sinh (x : ℝ) : arsinh (sinh x) = x :=
function.right_inverse_of_injective_of_left_inverse sinh_injective sinh_arsinh x

end real


import Playground.Data.BinaryTree.Basic
import Playground.Data.List.Is_Sorted
import Mathlib.Data.List.Perm
import Mathlib.Init.Algebra.Order

namespace Data.BinaryTree

section
  variable {type} [LinearOrder type]

  inductive IsBST : BinaryTree type → Prop
  | nil : nil.IsBST
  | node {value left right}
    (left_IsBST : left.IsBST) (left_le : ∀ x ∈ left, x ≤ value)
    (right_IsBST : right.IsBST) (right_ge : ∀ x ∈ right, value ≤ x)
    : (node value left right).IsBST

  theorem IsBST_iff (value : type) (left right) : (node value left right).IsBST ↔
    (left.IsBST ∧ ∀ x ∈ left, x ≤ value) ∧ (right.IsBST ∧ ∀ x ∈ right, value ≤ x) := by
    constructor
    . intro h; cases h with | node _ _ _ _ =>
      constructor
      . constructor; assumption; assumption
      . constructor; assumption; assumption
    . intro ⟨⟨_, _⟩, ⟨_, _⟩⟩
      apply IsBST.node; assumption; assumption; assumption; assumption

  theorem IsBST_iff_infixList_IsSorted (tree : BinaryTree type)
    : tree.IsBST ↔ tree.infixList.IsSorted := by
    induction tree with
    | nil =>
      constructor
      . intro _; constructor
      . intro _; constructor
    | node value left right left_rec right_rec =>
      rw [IsBST_iff]
      show _ ↔ (left.infixList ++ value :: right.infixList).IsSorted
      rw [List.append_cons_IsSorted_iff_left_IsSorted_and_forall_le_and_right_IsSorted_and_forall_ge]
      rw [left_rec, left.forall_iff_forall_infixList]
      rw [right_rec, right.forall_iff_forall_infixList]
end

section
  variable {type} [LinearOrder type]

  def insertAsInBST (tree : BinaryTree type) (x : type) : BinaryTree type
  := match tree with
  | nil => node x nil nil
  | node value left right =>
      if x ≤ value then node value (left.insertAsInBST x) right
      else node value left (right.insertAsInBST x)

  theorem Mem_insertAsInBST_iff (tree : BinaryTree type) (v : type) (x : type)
  : x ∈ tree.insertAsInBST v ↔ x ∈ tree ∨ x = v
  := match tree with
  | nil => ⟨λ (.eq hx) => .inr hx, λ (.inr hx) => .eq hx⟩
  | node value left right =>
  have left_rec : x ∈ _ ↔ x ∈ _ ∨ x = v := left.Mem_insertAsInBST_iff _ _
  have right_rec : x ∈ _ ↔ x ∈ _ ∨ x = v := right.Mem_insertAsInBST_iff _ _
  show x ∈ ite .. ↔ _ from
  if h_v : v ≤ value then if_pos h_v ▸ ⟨
      λ | .eq hx => .inl (Mem.eq hx)
        | .left hx => match left_rec.mp hx with
          | .inl hx => .inl hx.left
          | .inr hx => .inr hx
        | .right hx => .inl hx.right
    , λ | .inl hx => match hx with
          | .eq hx => .eq hx
          | .left hx => .left $ left_rec.mpr $ .inl hx
          | .right hx => hx.right
        | .inr hx => .left $ left_rec.mpr $ .inr hx⟩
  else if_neg h_v ▸ ⟨
      λ | .eq hx => .inl (Mem.eq hx)
        | .left hx => .inl hx.left
        | .right hx => match right_rec.mp hx with
          | .inl hx => .inl hx.right
          | .inr hx => .inr hx
    , λ | .inl hx => match hx with
          | .eq hx => .eq hx
          | .left hx => hx.left
          | .right hx => .right $ right_rec.mpr $ .inl hx
        | .inr hx => .right $ right_rec.mpr $ .inr hx⟩

  theorem insertAsInBST_IsBST_of_IsBST {tree : BinaryTree type} (h_tree : tree.IsBST) (x : type)
  : (tree.insertAsInBST x).IsBST
  := match tree, h_tree with
  | nil, _ => .node .nil (λ _ => λ.) .nil (λ _ => λ.)
  | node value left right,
    .node left_IsBST left_le right_IsBST right_ge =>
    show IsBST (ite ..) from
    if h_value : x ≤ value then if_pos h_value ▸
      have left_IsBST := left.insertAsInBST_IsBST_of_IsBST left_IsBST x
      have left_le := λ x hx => match (left.Mem_insertAsInBST_iff ..).mp hx with
        | .inl hx => left_le x hx
        | .inr hx => hx ▸ h_value
      .node left_IsBST left_le right_IsBST right_ge
    else if_neg h_value ▸
      have h_value := le_of_lt (lt_of_not_ge h_value)
      have right_IsBST := right.insertAsInBST_IsBST_of_IsBST right_IsBST x
      have right_ge := λ x hx => match (right.Mem_insertAsInBST_iff ..).mp hx with
        | .inl hx => right_ge x hx
        | .inr hx => hx ▸ h_value
      .node left_IsBST left_le right_IsBST right_ge

  theorem insertAsInBST_infixList_Perm_cons_infixList (tree : BinaryTree type) (x : type)
  : (tree.insertAsInBST x).infixList ~ x :: tree.infixList
  :=
  open List in
  match tree with
  | nil => List.Perm.refl [x]
  | node value _ _ =>
    show infixList (ite ..) ~ _ from
    if h_value : x ≤ value then if_pos h_value ▸
      (insertAsInBST_infixList_Perm_cons_infixList ..).append_right _
    else if_neg h_value ▸
      ((((insertAsInBST_infixList_Perm_cons_infixList ..).cons _).trans
        (List.Perm.swap ..).symm).append_left _).trans List.perm_middle

  def searchAsInBST (tree : BinaryTree type) (x : type) : Bool
  := match tree with
  | .nil => false
  | .node value left right =>
    if value = x then true
    else if x < value then left.searchAsInBST x
    else right.searchAsInBST x

  theorem searchAsInBST_eq_decide_Mem_of_IsBST {tree : BinaryTree type} (h_tree : tree.IsBST)
  (x : type) : tree.searchAsInBST x = decide (x ∈ tree)
  := match tree, h_tree with
  | nil, _ => rfl
  | node value left right,
    .node left_is_bst left_le right_is_bst right_ge =>
    show ite .. = ite .. from
    if h_e : value = x then if_pos h_e ▸ if_pos (Mem.eq h_e.symm) ▸ rfl
    else if h_l : x < value then if_neg h_e ▸ if_pos h_l ▸
      searchAsInBST_eq_decide_Mem_of_IsBST left_is_bst _ ▸
      show ite .. = _ from
      if v_in_left : x ∈ left then if_pos v_in_left ▸ if_pos v_in_left.left ▸ rfl
      else if_neg v_in_left ▸ if_neg
      (show ¬x ∈ node value left right from
      λ | .eq h => h_e h.symm
        | .left h => v_in_left h
        | .right h => not_le_of_gt h_l $ right_ge x h
      ) ▸ rfl
    else have h_r : value < x := lt_of_le_of_ne (le_of_not_lt h_l) h_e
      if_neg h_e ▸ if_neg h_l ▸
      searchAsInBST_eq_decide_Mem_of_IsBST right_is_bst _ ▸
      show ite .. = _ from
      if v_in_right : x ∈ right then if_pos v_in_right ▸ if_pos v_in_right.right ▸ rfl
      else if_neg v_in_right ▸ if_neg
      (show ¬x ∈ node value left right from
      λ | .eq h => h_e h.symm
        | .left h => not_le_of_gt h_r $ left_le x h
        | .right h => v_in_right h
      ) ▸ rfl

end

end Data.BinaryTree


/- NATURAL NUMBERS

We saw the definition of the natural numbers `Nat` and the addition on them on the slides.
Since we want to define it ourselves and not use Lean's built-in version, we will call ours `Nat'`.
 -/
inductive Nat' : Type
  | zero : Nat'
  | succ : Nat' → Nat'

open Nat'

def add (m n : Nat') : Nat' :=
  match n with
  | zero   => m
  | succ n => succ (add m n)

-- Let us now try to recursively define multiplication on the `Nat'`.
def mul (m n : Nat') : Nat' := _

-- Let's define `≤` as an inductive predicate on `Nat'`s!
inductive LE' : Nat' → Nat' → Prop where
  | refl (n : Nat') : LE' n n
  -- TODO: We're off to a good start since `≤` is certainly reflexive, but something is still
  -- missing (or else we'd just redefine `Eq` for `Nat'`s). Can you think of one more constructor
  -- that makes it so `LE' n m` holds whenever we would intuitively expect `n ≤ m` to hold?
  -- hint: it remains to be shown that `LE' n m` should hold when `m` is *greater* than `n`, so
  -- the new constructor should probably involve `Nat'`'s `succ` constructor to reach those greater numbers.
  -- hint: it should be an *inductive* case, meaning using another `LE'` application as an assumption
  -- note: `LE'` could also be defined in terms of `add`, but that makes working with it awkward,
  -- so let's not do that.
  | _

-- Now let's prove some things about `LE'`. But first we'll give it the standard notation.
infix:50 " ≤ " => LE'

example (n : Nat') : n ≤ succ (succ n) := _

-- This one is a bit harder: we will need induction!
-- As described on the slides, induction is just a special case of recursion
theorem le_add (m n : Nat') : m ≤ add m n :=
  match n with
  -- This is the base case
  | zero => _
  -- This is the inductive case. You probably want to use `le_add m n` (the inductive hypothesis) somewhere inside of it!
  | succ n =>
    -- Lean automatically converts `add m (succ n)` to `succ (add m n)` for us when necessary, but it can help
    -- to make the conversion explicit. `show` simply lets us restate the goal, using any definitionally equivalent type.
    show m ≤ succ (add m n) from
    _

-- Now try proving this theorem on `add` using the same induction scheme
theorem zero_add (n : Nat') : add zero n = add n zero := _

/-
LISTS

The type List α of lists on a Type α is defined to be the type on the constructors
nil : List α
and
cons : (x : α) → (xs : List α) → List α.

We can use [] as a notation for nil and x :: xs as a notation for cons x xs.
-/
open List

-- Let's define something we can't in most other functional languages:
-- a function returning the first element of a list given a proof that is is non-empty! (xs ≠ [] is shorthand for ¬ (xs = []))
-- hint: match on `xs` *before* using `fun` so that the `xs` in the assumption is replaced by the match!
def hd (xs : List α) : xs ≠ [] → α := _

/-
TREES

Define a type Tree α of binary trees with labels of type α. Each tree is either a labelled leaf or a labelled node with two trees attached to it.
 -/

inductive Tree (α : Type) : Type where

open Tree

-- Now, let us define the depth and the size of a tree. You can use the function Nat.max to get the maximum of two natural numbers. The depth of a leaf is 1.
def depth (t : Tree α) : Nat := _

def size (t : Tree α) : Nat := _

-- We can turn a tree into a list by traversing it in various ways, depending on whether we add the root
-- before its subtrees (preOrder), between its subtrees (inOrder) or after its subtrees (postOrder).
-- Define preOrder, inOrder, and postOrder as functions Tree α → List α.
def preOrder (t : Tree α) : List α := _

def inOrder (t : Tree α) : List α := _

def postOrder (t : Tree α) : List α := _

-- Define a function which returns the mirror image of a given tree.
def mirror (t : Tree α) : Tree α := _

-- Now we prove to facts about this function:
-- First, we prove that it is involutive (mirroring a tree twice returns the original tree).
-- Then, we prove that the mirror image of two trees is equal, if and only if the trees themselves are.
-- Useful lemmas, if you don't want to use ▸ as much (but it is also just as doable with some `have`s and ▸):
#check @Eq.trans
#check @Eq.symm
#check @congrArg

theorem mirror_involutive (t : Tree α) : mirror (mirror t) = t := _

theorem mirror_eq (s t : Tree α) : mirror s = mirror t ↔ s = t := _

/- STRUCTURES -/

-- Define the structure `Semigroup α` for a semigroup on a type `α`.
-- Reminder: A semigroup is an algebraic structure with an associative binary operation `mul`.
structure Semigroup (α : Type) where

-- Now extend the structure to one for a monoid on α.
-- Reminder : A monoid is a semigroup with an element which acts as the left and right identity on `mul`.
structure Monoid (α : Type) extends Semigroup α where

-- Now try to instantiate the type `Nat'` as a monoid.
-- Leave out the three proofs (associativiy, left and right inverse), we'll learn better ways to write such proofs next week.
def Nat'Monoid : Monoid Nat' := _