import data.real.basic
import order.filter.at_top_bot
import topology.instances.real
/-

## Sequences, revisited

Recall that in week 3 we made these definitions:

-/

local notation `|` x `|` := abs x

/-- `l` is the limit of the sequence `a` of reals -/
definition is_limit (a : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, | a n - l | < ε

/-

We then spent some time proving things like
if aₙ → l and bₙ → m then aₙ * bₙ → l * m.

Let's see another, much shorter, proof of these things using filters,
and of course also using facts from `mathlib` about filters.

-/

open filter

open_locale topological_space

open metric

theorem is_limit_iff_tendsto (a : ℕ → ℝ) (l : ℝ) :
is_limit a l ↔ tendsto a at_top (𝓝 l) :=
begin
  rw metric.tendsto_at_top,
  refl,
end

theorem is_limit_mul (a b : ℕ → ℝ) (l m : ℝ)
  (ha : is_limit a l) (hb : is_limit b m) :
  is_limit (a * b) (l * m) :=
begin
  rw is_limit_iff_tendsto at *,
  exact tendsto.mul ha hb,
end

/-

This was much less painful than what we went through in week 3! So where
did the work go?

The next 130 lines of this file discuss the first proof, namely
`is_limit_iff_tendsto`. Clearly the key ingredients is
`metric.tendsto_at_top`. There are no exercises here, I will just
explain what's going on, and talk about definitions (e.g. `is_limit`)
and their cost.

The second proof uses `is_limit_iff_tendsto` to reduce `is_limit_mul`
to a theorem about filters, and them proves it with `tendsto.mul`. We will
prove our own version of `tendsto.mul` in this file. So if you want to
get on with the proving you can skip straight down to
the `## tendsto.mul` section on line 184 or so.

The first proof

## Definitions in Lean

Each *definition* you make in Lean comes with a cost. For example
check out Lean's definition of `finset`, the type of finite sets.
Right click on `finset` below and click on "go to definition".
You see one definition, and then over 2000 lines of theorems
about this definition. Don't forget to close the file afterwards!
-/

#check finset

/-
The theorems are necessary because it's no good just defining some
concept of a finite set, you need to make it intuitive to use for the
end user, so you need to prove that a subset of a finite set is finite,
the union of two finite sets is finite, the image of a finite set under
a map is finite, the product of two finite sets is finite, a finite product
of finite sets indexed by a finite set is finite, etc etc. Every one of those
lemmas in that file is completely obvious to a mathematician, but needs
to be proved in Lean so that mathematicians can use finite sets the
way they intuitively want to. See if you can understand some of the
statements proved about finite sets in that file. Be very careful
not to edit it though! If you do accidentally change it, just close the
file without saving, or use ctrl-Z to undo your changes.

When we developed the theory of limits of sequences in week 3, we
made the definition `is_limit`. This definition comes with a cost;
to make it useful to the end user, we need to prove a ton of theorems
about `is_limit`. This is what happens in an undergraduate analysis
class -- you see the definition, and then you make what computer
scientists call the "API" or the "interface" -- a bunch of lemmas
and theorems about `is_limit`, for example `is_limit_add`, which says
that `aₙ → l` and `bₙ → m` implies `a_n + b_n → l + m`, and also `is_limit_neg`,
`is_limit_sub`, `is_limit_mul` and so on.

But it turns out that `is_limit` is just a very special case of `tendsto`,
and because `tendsto` is already in mathlib, there is already a very big
API for `tendsto` which has developed organically over the last few
years. It was started by the original writer of `tendsto` and then
it grew as other people used `tendsto` more, and added to the list of useful
lemmas as they used `tendsto` to do other things and then abstracted out
properties which they discovered were useful. For example, this week
(I write this in Feb 2021) Heather Macbeth was working on modular forms in Lean
and she discovered that she needed a lemma about `tendsto`, which, after some
discussion on the Zulip Lean chat, Heather and I realised was a statement
about how `tendsto` commutes with a certain kind of coproduct. We proved this
lemma, Heather is right now in the process of adding it (`tendsto.prod_map_coprod`)
to `mathlib`, Lean's maths library.

https://github.com/leanprover-community/mathlib/pull/6372

I will remark that I would never have worked on that problem with Heather
if it hadn't been for the fact that I'd been teaching you about filters
and hence I had to learn about them properly!

Let's take a look at our new proof of `tendsto_mul` again. The proof follows
from two 2-line lemmas. I will talk you through the first one, and you can
experiment with the second one. Let's take a look at the first one.

-/

example (a : ℕ → ℝ) (l : ℝ) :
is_limit a l ↔ tendsto a at_top (𝓝 l) :=
begin
  rw metric.tendsto_at_top,
  refl,
end

/-

The guts of the first one is `metric.tendsto_at_top`, which is actually
a statement about metric spaces. It says that in any metric space,
the standard metric space epsilon-N definition of a limit of a sequence
is a special case of this filter `tendsto` predicate. Here is a proof
with more details spelt out (`simp_rw` is just a slightly more powerful
version of `rw` which we need for technical reasons here, because `rw` will
not see under a `∀` statement -- it will not "work under binders"):
-/

example (a : ℕ → ℝ) (l : ℝ) :
is_limit a l ↔ tendsto a at_top (𝓝 l) :=
begin
  simp_rw [metric.tendsto_nhds, eventually_iff, mem_at_top_sets],
  refl,
end

/-

This more explicit proof uses the following fancy notation
called "filter.eventually" :

`(∀ᶠ (x : α) in F, P x) ↔ {x : α | P x} ∈ F` (true by definition, or
you can `rw eventually_iff`)

and then it just boils down to the following two mathematical facts
(here `ball l ε` is the open ball radius `ε` centre `l` ),
the first being `metric.tendsto_nhds` and the second `mem_at_top_sets`:

1) If `a` is in a metric space, then `S ∈ 𝓝 l ↔ ∃ ε > 0, ball l ε ⊆ S`
2) If `at_top` is the filter on on `ℕ` that we saw last time then
`T ∈ at_top ↔ ∃ N : ℕ, {n : ℕ | N ≤ n} ⊆ T`

After that it's easy, because `tendsto a at_top (𝓝 l)` then means,
by definition of `tendsto`,

`∀ S : set ℝ, S ∈ 𝓝 l → a ⁻¹' S ∈ at_top`

which translates into

`∀ S : set ℝ, (∃ ε > 0, ball l ε ⊆ S) → (∃ N, n ≥ N → a n ∈ S)`

and if you unfold the logical packaging you will see that this is just
the usual definition of `is_limit` (note that `a n ∈ ball l ε` is
definitionally equal to `dist (a n) l < ε` which, for the reals, is
definitionally equal to `|a n - l| < ε`).

## tendsto.mul

Now let's look at the second example.

-/

example (a b : ℕ → ℝ) (l m : ℝ) (ha : is_limit a l) (hb : is_limit b m) :
  is_limit (a * b) (l * m) :=
begin
  rw is_limit_iff_tendsto at *,
  exact tendsto.mul ha hb,
end

/-

If you hover over `tendsto.mul` in that proof, you will perhaps be able to make
out that it says the following: if we have a topological space `M` with a
continuous multiplication on it, and if `F` is a filter on `α` and `f` and `g`
are maps `α → M`, then `tendsto f F (𝓝 l)` and `tendsto g F (𝓝 m)` implies
`tendsto (f * g) F 𝓝 (l * m)`. We apply this with `F` the cofinite filter
and we're done, at least modulo the assertion that multiplication
on ℝ is a continuous function. How did Lean know this? Well,
`[has_continuous_mul M]` was in square brackets so that means that
the type class inference system is supposed to deal with it. Let's
see how it gets on with the assertion that multiplication is continuous
on the reals.

-/

-- multiplication is continuous on the reals.
example : has_continuous_mul ℝ :=
begin
  -- Ask the type class inference system whether it knows this
  apply_instance
end
-- It does!

/-

The people who defined `ℝ` in Lean made a definition, and the price they
had to then pay for making it usable was that they had to make a big API for
`ℝ`, proving stuff like a non-empty bounded set of reals has a least
upper bound, and that the reals were a topological ring (and hence
multiplication was continuous). But this price was paid way back in 2018
so we mathematicians can now use these facts for free.

All that remains then, if we want to see the details, is to
*prove* `tendsto.mul`, and this is a statement about filters on topological
spaces, so let's do it. First -- what does `continuous` mean?

## Continuity

Let `X` and `Y` be topological spaces, and say `f : X → Y` is a function.

-/
variables (X Y : Type) [topological_space X] [topological_space Y] (f : X → Y)

/-

If `x : X`, then what does it mean for `f` to be continuous at `x`?
Intuitively, it means that if you move `x` by a small amount, then `f x`
moves by a small amount. In other words, `f` sends a small neighbourhood
of `x` into a small neighbourhood of `f x`.

If our mental model of the neighbourhood filter `𝓝 x` is some kind of
generalised set corresponding to an infinitesimally small
neighbourhood of `x`, you will see why Lean makes the following
definition of `continuous_at`:

-/

lemma continuous_at_def (x : X) :
  continuous_at f x ↔ tendsto f (𝓝 x) (𝓝 (f x)) :=
begin
  -- true by definition
  refl
end

/-

Out of interest, you were probably told the definition of what it means
for a function `f : X → Y` between *metric* spaces to be continuous at `x`.
Were you ever told what it means for a function between *topological* spaces
to be continuous at `x`, rather than just continuous on all of `X`? This
is what it means.

Now let's start on the proof of `tendsto.mul`, by building an API
for the `continuous_at` definition. Don't forget things like

`tendsto_id : tendsto id x x`
`tendsto.comp : tendsto g G H → tendsto f F G → tendsto (g ∘ f) F H`

from Part A.
-/

-- this first lemma called `continuous_at_id`. Prove it yourself using
-- facts from Part A.
example (x : X) : continuous_at id x :=
begin
  sorry
end

-- recall we have `f : X → Y`. Now let's add in a `Z`.
variables (Z : Type) [topological_space Z] (g : Y → Z)

-- this is called `continuous_at.comp`. Prove it yourself using
-- facts from Part A.
example (x : X) (hf : continuous_at f x) (hg : continuous_at g (f x)) :
continuous_at (g ∘ f) x :=
begin
  sorry
end

/-

Now we prove a key result, called `tendsto.prod_mk_nhds`. Notation for product
of types: if `Y` and `Z` are types then `Y × Z` is the product type, and
the notation for a general term is `(y, z) : Y × Z` with `y : Y` and `z : Z`.

A special case of the theorem below is that if `f : X → Y` and `g : X → Z` are
continuous at `x` then the product map `f × g : X → Y × Z` is also continuous
at `x`. We will actually prove something more general -- if `α` is any type
and `F : filter α` is any filter and if `y : Y` and `z : Z` and if
`f : α → Y` and `g : α → Z` satisfy `tendsto f F (𝓝 y)` and `tendsto g F (𝓝 z)`,
then `tendsto (f × g) F (𝓝 (y,z))`, where `f × g` is the map `λ x, (f x, g x)`.
The key fact you will need from the product topology API is
`mem_nhds_prod_iff : S ∈ 𝓝 ((a, b) : X × Y) ↔`
  `∃ (U : set X) (H : U ∈ 𝓝 a) (V : set Y) (H : V ∈ 𝓝 b), U.prod V ⊆ S`
This is all you should need about the product topology (we won't go into how
the product topology is defined, but the key fact mathematically says that a
neighbourhood of `(a,b) : X × Y` contains a product of neighbourhoods of `X` and of `Y`).

You will also need to know

`mk_mem_prod : a ∈ U → b ∈ V → (a, b) ∈ U.prod V`

where for `U : set X` and `V : set Y`, `U.prod V = prod U V` is the
obvious subset of `X × Y`.

Recall also from Part A:
`mem_map : S ∈ map φ F ↔ {x : α | φ x ∈ S} ∈ F`
`tendsto_def : tendsto f F G ↔ ∀ (S : set Y), S ∈ G → f ⁻¹' S ∈ F`
(although there is a gotcha here : the actual definition of
`tendsto f F G` is `∀ {S : set Y}, S ∈ G ...` )
-/

-- this is called `tendsto.prod_mk_nhds` in Lean but try proving it yourself.
example {α : Type} (f : α → Y) (g : α → Z) (x : X) (F : filter α) (y : Y) (z : Z)
  (hf : tendsto f F (𝓝 y)) (hg : tendsto g F (𝓝 z)) :
  tendsto (λ x, (f x, g x)) F (𝓝 (y, z)) :=
begin
  sorry,
end

/- Armed with `tendsto.prod_mk_nhds`, let's prove the version of `tendsto.mul`
 which we need. I would recommend starting with
```
set f1 : M × M → M := λ mn, mn.1 * mn.2 with hf1,
set f2 : α → M × M := λ x, (f x, g x) with hf2,
have h1 : f1 ∘ f2 = f * g,
...
```
because it's `f1` and `f2` that we've been proving theorems about,
and then you can use `tendsto.comp`.
-/

lemma key_lemma {α M : Type} [topological_space M] [has_mul M]
  {f g : α → M} {F : filter α} {a b : M} (hf : tendsto f F (𝓝 a))
  (hg : tendsto g F (𝓝 b))
  (hcontinuous : continuous_at (λ (mn : M × M), mn.1 * mn.2) (a,b)) :
  tendsto (f * g) F (𝓝 (a * b)) :=
begin
  sorry
end

-- The final ingredient is that multiplication is continuous on ℝ, which we
-- just take from the real API:
lemma real.continuous_mul_at (a b : ℝ) :
  continuous_at (λ xy : ℝ × ℝ, xy.1 * xy.2) (a, b) :=
begin
  -- it's in the library
  exact continuous.continuous_at real.continuous_mul,
end

-- and now we have all the ingredients we need for our own proof of `is_limit_mul`!
example  (a b : ℕ → ℝ) (l m : ℝ)
  (ha : is_limit a l) (hb : is_limit b m) :
  is_limit (a * b) (l * m) :=
begin
  rw is_limit_iff_tendsto at *,
  apply key_lemma ha hb,
  apply real.continuous_mul_at,
end

/-

You might think that this new proof "feels longer". But what you have to
understand is that it's shorter in practice, because the user doesn't
have to write `tendsto.mul` themselves, it's already there in the library.
Writing APIs is an extensive process. But using them is easy.
-/


/-
Copyright (c) 2022 Bhavik Mehta, Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Kexing Ying
-/
import probability.cond_count

/-!
# Ballot problem

This file proves Theorem 30 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/).

The ballot problem asks, if in an election, candidate A receives `p` votes whereas candidate B
receives `q` votes where `p > q`, what is the probability that candidate A is strictly ahead
throughout the count. The probability of this is `(p - q) / (p + q)`.

## Main definitions

* `counted_sequence`: given natural numbers `p` and `q`, `counted_sequence p q` is the set of
  all lists containing `p` of `1`s and `q` of `-1`s representing the votes of candidate A and B
  respectively.
* `stays_positive`: is the set of lists of integers which suffix has positive sum. In particular,
  the intersection of this set with `counted_sequence` is the set of lists where candidate A is
  strictly ahead.

## Main result

* `ballot`: the ballot problem.

-/

open set probability_theory measure_theory

namespace ballot

/-- The set of nonempty lists of integers which suffix has positive sum. -/
def stays_positive : set (list ℤ) := {l | ∀ l₂, l₂ ≠ [] → l₂ <:+ l → 0 < l₂.sum}

@[simp] lemma stays_positive_nil : [] ∈ stays_positive :=
λ l hl hl₁, (hl (list.eq_nil_of_suffix_nil hl₁)).elim

lemma stays_positive_cons_pos (x : ℤ) (hx : 0 < x) (l : list ℤ) :
  (x :: l) ∈ stays_positive ↔ l ∈ stays_positive :=
begin
  split,
  { intros hl l₁ hl₁ hl₂,
    apply hl l₁ hl₁ (hl₂.trans (list.suffix_cons _ _)) },
  { intros hl l₁ hl₁ hl₂,
    rw list.suffix_cons_iff at hl₂,
    rcases hl₂ with (rfl | hl₂),
    { rw list.sum_cons,
      apply add_pos_of_pos_of_nonneg hx,
      cases l with hd tl,
      { simp },
      { apply le_of_lt (hl (hd :: tl) (list.cons_ne_nil hd tl) (hd :: tl).suffix_refl) } },
    { apply hl _ hl₁ hl₂ } }
end

/--
`counted_sequence p q` is the set of lists of integers for which every element is `+1` or `-1`,
there are `p` lots of `+1` and `q` lots of `-1`.

This represents vote sequences where candidate `+1` receives `p` votes and candidate `-1` receives
`q` votes.
-/
def counted_sequence (p q : ℕ) : set (list ℤ) :=
{l | l.count 1 = p ∧ l.count (-1) = q ∧ ∀ x ∈ l, x = (1 : ℤ) ∨ x = -1}

/-- An alternative definition of `counted_sequence` that uses `list.perm`. -/
lemma mem_counted_sequence_iff_perm {p q l} :
  l ∈ counted_sequence p q ↔ l ~ list.replicate p (1 : ℤ) ++ list.replicate q (-1) :=
begin
  rw [list.perm_replicate_append_replicate],
  { simp only [counted_sequence, list.subset_def, mem_set_of_eq, list.mem_cons_iff,
      list.mem_singleton] },
  { norm_num1 }
end

@[simp] lemma counted_right_zero (p : ℕ) : counted_sequence p 0 = {list.replicate p 1} :=
by { ext l, simp [mem_counted_sequence_iff_perm] }

@[simp] lemma counted_left_zero (q : ℕ) : counted_sequence 0 q = {list.replicate q (-1)} :=
by { ext l, simp [mem_counted_sequence_iff_perm] }

lemma mem_of_mem_counted_sequence {p q} {l} (hl : l ∈ counted_sequence p q) {x : ℤ} (hx : x ∈ l) :
  x = 1 ∨ x = -1 :=
hl.2.2 x hx

lemma length_of_mem_counted_sequence {p q} {l : list ℤ} (hl : l ∈ counted_sequence p q) :
  l.length = p + q :=
by simp [(mem_counted_sequence_iff_perm.1 hl).length_eq]

lemma counted_eq_nil_iff {p q : ℕ} {l : list ℤ} (hl : l ∈ counted_sequence p q) :
  l = [] ↔ p = 0 ∧ q = 0 :=
list.length_eq_zero.symm.trans $ by simp [length_of_mem_counted_sequence hl]

lemma counted_ne_nil_left {p q : ℕ} (hp : p ≠ 0) {l : list ℤ} (hl : l ∈ counted_sequence p q) :
  l ≠ [] :=
by simp [counted_eq_nil_iff hl, hp]

lemma counted_ne_nil_right {p q : ℕ} (hq : q ≠ 0) {l : list ℤ} (hl : l ∈ counted_sequence p q) :
  l ≠ [] :=
by simp [counted_eq_nil_iff hl, hq]

lemma counted_succ_succ (p q : ℕ) : counted_sequence (p + 1) (q + 1) =
  list.cons 1 '' counted_sequence p (q + 1) ∪ list.cons (-1) '' counted_sequence (p + 1) q  :=
begin
  ext l,
  rw [counted_sequence, counted_sequence, counted_sequence],
  split,
  { intro hl,
    have hlnil := counted_ne_nil_left (nat.succ_ne_zero p) hl,
    obtain ⟨hl₀, hl₁, hl₂⟩ := hl,
    obtain hlast | hlast := hl₂ l.head (list.head_mem_self hlnil),
    { refine or.inl ⟨l.tail, ⟨_, _, _⟩, _⟩,
      { rw [list.count_tail l 1 (list.length_pos_of_ne_nil hlnil), hl₀, if_pos,
          nat.add_succ_sub_one, add_zero],
        rw [list.nth_le_zero, hlast] },
      { rw [list.count_tail l (-1) (list.length_pos_of_ne_nil hlnil), hl₁, if_neg, nat.sub_zero],
        rw [list.nth_le_zero, hlast],
        norm_num },
      { exact λ x hx, hl₂ x (list.mem_of_mem_tail hx) },
      { rw [← hlast, list.cons_head_tail hlnil] } },
    { refine or.inr ⟨l.tail, ⟨_, _, _⟩, _⟩,
      { rw [list.count_tail l 1 (list.length_pos_of_ne_nil hlnil), hl₀, if_neg, nat.sub_zero],
        rw [list.nth_le_zero, hlast],
        norm_num },
      { rw [list.count_tail l (-1) (list.length_pos_of_ne_nil hlnil), hl₁, if_pos,
          nat.add_succ_sub_one, add_zero],
        rw [list.nth_le_zero, hlast] },
      { exact λ x hx, hl₂ x (list.mem_of_mem_tail hx) },
      { rw [← hlast, list.cons_head_tail hlnil] } } },
  { rintro (⟨t, ⟨ht₀, ht₁, ht₂⟩, rfl⟩ | ⟨t, ⟨ht₀, ht₁, ht₂⟩, rfl⟩),
    { refine ⟨_, _, _⟩,
      { rw [list.count_cons, if_pos rfl, ht₀] },
      { rw [list.count_cons, if_neg, ht₁],
        norm_num },
      { rintro x (hx | hx),
        exacts [or.inl hx, ht₂ x hx] } },
    { refine ⟨_, _, _⟩,
      { rw [list.count_cons, if_neg, ht₀],
        norm_num },
      { rw [list.count_cons, if_pos rfl, ht₁] },
      { rintro x (hx | hx),
        exacts [or.inr hx, ht₂ x hx] } } }
end

lemma counted_sequence_finite : ∀ (p q : ℕ), (counted_sequence p q).finite
| 0 q := by simp
| (p + 1) 0 := by simp
| (p + 1) (q + 1) :=
  begin
    rw [counted_succ_succ, set.finite_union, set.finite_image_iff (list.cons_injective.inj_on _),
      set.finite_image_iff (list.cons_injective.inj_on _)],
    exact ⟨counted_sequence_finite _ _, counted_sequence_finite _ _⟩
  end

lemma counted_sequence_nonempty : ∀ (p q : ℕ), (counted_sequence p q).nonempty
| 0 q := by simp
| (p + 1) 0 := by simp
| (p + 1) (q + 1) :=
  begin
    rw [counted_succ_succ, union_nonempty, nonempty_image_iff],
    exact or.inl (counted_sequence_nonempty _ _),
  end

lemma sum_of_mem_counted_sequence {p q} {l : list ℤ} (hl : l ∈ counted_sequence p q) :
  l.sum = p - q :=
by simp [(mem_counted_sequence_iff_perm.1 hl).sum_eq, sub_eq_add_neg]

lemma disjoint_bits (p q : ℕ) :
  disjoint (list.cons 1 '' counted_sequence p (q + 1))
    (list.cons (-1) '' counted_sequence (p + 1) q) :=
begin
  simp_rw [disjoint_left, mem_image, not_exists, exists_imp_distrib],
  rintros _ _ ⟨_, rfl⟩ _ ⟨_, _, _⟩,
end

open measure_theory.measure

private def measureable_space_list_int : measurable_space (list ℤ) := ⊤

local attribute [instance] measureable_space_list_int

private lemma measurable_singleton_class_list_int : measurable_singleton_class (list ℤ) :=
{ measurable_set_singleton := λ s, trivial }

local attribute [instance] measurable_singleton_class_list_int

private lemma list_int_measurable_set {s : set (list ℤ)} : measurable_set s :=
trivial

lemma count_counted_sequence : ∀ p q : ℕ, count (counted_sequence p q) = (p + q).choose p
| p 0 := by simp [counted_right_zero, count_singleton]
| 0 q := by simp [counted_left_zero, count_singleton]
| (p + 1) (q + 1) :=
  begin
    rw [counted_succ_succ, measure_union (disjoint_bits _ _) list_int_measurable_set,
      count_injective_image list.cons_injective, count_counted_sequence,
      count_injective_image list.cons_injective, count_counted_sequence],
    { norm_cast,
      rw [add_assoc, add_comm 1 q, ← nat.choose_succ_succ, nat.succ_eq_add_one, add_right_comm] },
    all_goals { try { apply_instance } },
  end

lemma first_vote_pos :
  ∀ p q, 0 < p + q →
    cond_count (counted_sequence p q : set (list ℤ)) {l | l.head = 1} = p / (p + q)
| (p + 1) 0 h :=
  begin
    rw [counted_right_zero, cond_count_singleton],
    simp [ennreal.div_self _ _],
  end
| 0 (q + 1) _ :=
  begin
    rw [counted_left_zero, cond_count_singleton],
    simpa,
  end
| (p + 1) (q + 1) h :=
  begin
    simp_rw [counted_succ_succ],
    rw [← cond_count_disjoint_union ((counted_sequence_finite _ _).image _)
        ((counted_sequence_finite _ _).image _) (disjoint_bits _ _), ← counted_succ_succ,
      cond_count_eq_one_of ((counted_sequence_finite p (q + 1)).image _)
        (nonempty_image_iff.2 (counted_sequence_nonempty _ _))],
    { have : list.cons (-1) '' counted_sequence (p + 1) q ∩ {l : list ℤ | l.head = 1} = ∅,
      { ext,
        simp only [mem_inter_iff, mem_image, mem_set_of_eq, mem_empty_iff_false, iff_false, not_and,
          forall_exists_index, and_imp],
        rintro l _ rfl,
        norm_num },
      have hint : counted_sequence (p + 1) (q + 1) ∩ list.cons 1 '' counted_sequence p (q + 1) =
        list.cons 1 '' counted_sequence p (q + 1),
      { rw [inter_eq_right_iff_subset, counted_succ_succ],
        exact subset_union_left _ _ },
      rw [(cond_count_eq_zero_iff $ (counted_sequence_finite _ _).image _).2 this,
        cond_count, cond_apply _ list_int_measurable_set, hint,
        count_injective_image list.cons_injective, count_counted_sequence, count_counted_sequence,
        one_mul, zero_mul, add_zero, nat.cast_add, nat.cast_one],
      { rw [mul_comm, ← div_eq_mul_inv, ennreal.div_eq_div_iff],
        { norm_cast,
          rw [mul_comm _ (p + 1), ← nat.succ_eq_add_one p, nat.succ_add,
            nat.succ_mul_choose_eq, mul_comm] },
          all_goals { simp [(nat.choose_pos $ (le_add_iff_nonneg_right _).2 zero_le').ne.symm] } },
      all_goals { apply_instance } },
    { simp },
    { apply_instance }
  end

lemma head_mem_of_nonempty {α : Type*} [inhabited α] :
  ∀ {l : list α} (hl : l ≠ []), l.head ∈ l
| [] h := h rfl
| (x :: l) _ := or.inl rfl

lemma first_vote_neg (p q : ℕ) (h : 0 < p + q) :
  cond_count (counted_sequence p q) {l | l.head = 1}ᶜ = q / (p + q) :=
begin
  have := cond_count_compl {l : list ℤ | l.head = 1}ᶜ
    (counted_sequence_finite p q) (counted_sequence_nonempty p q),
  rw [compl_compl, first_vote_pos _ _ h] at this,
  rw [(_ : (q / (p + q) : ennreal) = 1 - p / (p + q)), ← this, ennreal.add_sub_cancel_right],
  { simp only [ne.def, ennreal.div_eq_top, nat.cast_eq_zero, add_eq_zero_iff,
      ennreal.nat_ne_top, false_and, or_false, not_and],
    intros,
    contradiction },
  rw [eq_comm, ennreal.eq_div_iff, ennreal.mul_sub, ennreal.mul_div_cancel'],
  all_goals { simp, try { rintro rfl, rw zero_add at h, exact h.ne.symm } },
end

lemma ballot_same (p : ℕ) : cond_count (counted_sequence (p + 1) (p + 1)) stays_positive = 0 :=
begin
  rw [cond_count_eq_zero_iff (counted_sequence_finite _ _), eq_empty_iff_forall_not_mem],
  rintro x ⟨hx, t⟩,
  apply ne_of_gt (t x _ x.suffix_refl),
  { simpa using sum_of_mem_counted_sequence hx },
  { refine list.ne_nil_of_length_pos _,
    rw length_of_mem_counted_sequence hx,
    exact nat.add_pos_left (nat.succ_pos _) _ },
end

lemma ballot_edge (p : ℕ) : cond_count (counted_sequence (p + 1) 0) stays_positive = 1 :=
begin
  rw counted_right_zero,
  refine cond_count_eq_one_of (finite_singleton _) (singleton_nonempty _) _,
  { intros l hl,
    rw mem_singleton_iff at hl,
    subst hl,
    refine λ l hl₁ hl₂, list.sum_pos _ (λ x hx, _) hl₁,
    rw list.eq_of_mem_replicate (list.mem_of_mem_suffix hx hl₂),
    norm_num },
end

lemma counted_sequence_int_pos_counted_succ_succ (p q : ℕ) :
  (counted_sequence (p + 1) (q + 1)) ∩ {l | l.head = 1} =
  (counted_sequence p (q + 1)).image (list.cons 1) :=
begin
  rw [counted_succ_succ, union_inter_distrib_right,
    (_ : list.cons (-1) '' counted_sequence (p + 1) q ∩ {l | l.head = 1} = ∅), union_empty];
  { ext,
    simp only [mem_inter_iff, mem_image, mem_set_of_eq, and_iff_left_iff_imp, mem_empty_iff_false,
      iff_false, not_and, forall_exists_index, and_imp],
    rintro y hy rfl,
    norm_num }
end

lemma ballot_pos (p q : ℕ) :
  cond_count ((counted_sequence (p + 1) (q + 1)) ∩ {l | l.head = 1}) stays_positive =
  cond_count (counted_sequence p (q + 1)) stays_positive :=
begin
  rw [counted_sequence_int_pos_counted_succ_succ, cond_count, cond_count,
    cond_apply _ list_int_measurable_set, cond_apply _ list_int_measurable_set,
    count_injective_image list.cons_injective],
  all_goals { try { apply_instance } },
  congr' 1,
  have : (counted_sequence p (q + 1)).image (list.cons 1) ∩ stays_positive =
         (counted_sequence p (q + 1) ∩ stays_positive).image (list.cons 1),
  { ext t,
    simp only [mem_inter_iff, mem_image],
    split,
    { simp only [and_imp, exists_imp_distrib],
      rintro l hl rfl t,
      refine ⟨l, ⟨hl, _⟩, rfl⟩,
      rwa stays_positive_cons_pos at t,
      norm_num },
    { simp only [and_imp, exists_imp_distrib],
      rintro l hl₁ hl₂ rfl,
      refine ⟨⟨_, hl₁, rfl⟩, _⟩,
      rwa stays_positive_cons_pos,
      norm_num } },
  rw [this, count_injective_image],
  exact list.cons_injective,
end

lemma counted_sequence_int_neg_counted_succ_succ (p q : ℕ) :
  (counted_sequence (p + 1) (q + 1)) ∩ {l | l.head = 1}ᶜ =
  (counted_sequence (p + 1) q).image (list.cons (-1)) :=
begin
  rw [counted_succ_succ, union_inter_distrib_right,
    (_ : list.cons 1 '' counted_sequence p (q + 1) ∩ {l : list ℤ | l.head = 1}ᶜ = ∅), empty_union];
  { ext,
    simp only [mem_inter_iff, mem_image, mem_set_of_eq, and_iff_left_iff_imp, mem_empty_iff_false,
      iff_false, not_and, forall_exists_index, and_imp],
    rintro y hy rfl,
    norm_num }
end

lemma ballot_neg (p q : ℕ) (qp : q < p) :
  cond_count ((counted_sequence (p + 1) (q + 1)) ∩ {l | l.head = 1}ᶜ) stays_positive =
  cond_count (counted_sequence (p + 1) q) stays_positive :=
begin
  rw [counted_sequence_int_neg_counted_succ_succ, cond_count, cond_count,
    cond_apply _ list_int_measurable_set, cond_apply _ list_int_measurable_set,
    count_injective_image list.cons_injective],
  all_goals { try { apply_instance } },
  congr' 1,
  have : (counted_sequence (p + 1) q).image (list.cons (-1)) ∩ stays_positive =
         ((counted_sequence (p + 1) q) ∩ stays_positive).image (list.cons (-1)),
  { ext t,
    simp only [mem_inter_iff, mem_image],
    split,
    { simp only [and_imp, exists_imp_distrib],
      rintro l hl rfl t,
      exact ⟨_, ⟨hl, λ l₁ hl₁ hl₂, t l₁ hl₁ (hl₂.trans (list.suffix_cons _ _))⟩, rfl⟩ },
    { simp only [and_imp, exists_imp_distrib],
      rintro l hl₁ hl₂ rfl,
      refine ⟨⟨l, hl₁, rfl⟩, λ l₁ hl₃ hl₄, _⟩,
      rw list.suffix_cons_iff at hl₄,
      rcases hl₄ with (rfl | hl₄),
      { simp [list.sum_cons, sum_of_mem_counted_sequence hl₁, sub_eq_add_neg, ← add_assoc, qp] },
      exact hl₂ _ hl₃ hl₄ } },
  rw [this, count_injective_image],
  exact list.cons_injective
end

theorem ballot_problem' :
  ∀ q p, q < p → (cond_count (counted_sequence p q) stays_positive).to_real = (p - q) / (p + q) :=
begin
  classical,
  apply nat.diag_induction,
  { intro p,
    rw ballot_same,
    simp },
  { intro p,
    rw ballot_edge,
    simp only [ennreal.one_to_real, nat.cast_add, nat.cast_one, nat.cast_zero, sub_zero, add_zero],
    rw div_self ,
    exact nat.cast_add_one_ne_zero p },
  { intros q p qp h₁ h₂,
    haveI := cond_count_is_probability_measure
      (counted_sequence_finite p (q + 1)) (counted_sequence_nonempty _ _),
    haveI := cond_count_is_probability_measure
      (counted_sequence_finite (p + 1) q) (counted_sequence_nonempty _ _),
    have h₃ : p + 1 + (q + 1) > 0 := nat.add_pos_left (nat.succ_pos _) _,
    rw [← cond_count_add_compl_eq {l : list ℤ | l.head = 1} _ (counted_sequence_finite _ _),
      first_vote_pos _ _ h₃, first_vote_neg _ _ h₃, ballot_pos, ballot_neg _ _ qp],
    rw [ennreal.to_real_add, ennreal.to_real_mul, ennreal.to_real_mul, ← nat.cast_add,
      ennreal.to_real_div, ennreal.to_real_div, ennreal.to_real_nat, ennreal.to_real_nat,
      ennreal.to_real_nat, h₁, h₂],
    { have h₄ : (↑(p + 1) + ↑(q + 1)) ≠ (0 : ℝ),
      { apply ne_of_gt,
        assumption_mod_cast },
      have h₅ : (↑(p + 1) + ↑q) ≠ (0 : ℝ),
      { apply ne_of_gt,
        norm_cast,
        linarith },
      have h₆ : (↑p + ↑(q + 1)) ≠ (0 : ℝ),
      { apply ne_of_gt,
        norm_cast,
        linarith },
      field_simp [h₄, h₅, h₆] at *,
      ring },
    all_goals { refine (ennreal.mul_lt_top (measure_lt_top _ _).ne _).ne,
      simp [ne.def, ennreal.div_eq_top] } }
end

/-- The ballot problem. -/
theorem ballot_problem :
  ∀ q p, q < p → cond_count (counted_sequence p q) stays_positive = (p - q) / (p + q) :=
begin
  intros q p qp,
  haveI := cond_count_is_probability_measure
    (counted_sequence_finite p q) (counted_sequence_nonempty _ _),
  have : (cond_count (counted_sequence p q) stays_positive).to_real =
    ((p - q) / (p + q) : ennreal).to_real,
  { rw ballot_problem' q p qp,
    rw [ennreal.to_real_div, ← nat.cast_add, ← nat.cast_add, ennreal.to_real_nat,
      ennreal.to_real_sub_of_le, ennreal.to_real_nat, ennreal.to_real_nat],
    exacts [nat.cast_le.2 qp.le, ennreal.nat_ne_top _] },
  rwa ennreal.to_real_eq_to_real (measure_lt_top _ _).ne at this,
  { simp only [ne.def, ennreal.div_eq_top, tsub_eq_zero_iff_le, nat.cast_le,
      not_le, add_eq_zero_iff, nat.cast_eq_zero, ennreal.add_eq_top, ennreal.nat_ne_top,
      or_self, not_false_iff, and_true],
    push_neg,
    exact ⟨λ _ _, by linarith, (lt_of_le_of_lt tsub_le_self (ennreal.nat_ne_top p).lt_top).ne⟩ },
  apply_instance,
end

end ballot


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import data.finset.card
open nat decidable

namespace finset
variable {A : Type}

protected definition to_nat (s : finset nat) : nat :=
finset.Sum s (λ n, 2^n)

open finset (to_nat)

lemma to_nat_empty : to_nat ∅ = 0 :=
rfl

lemma to_nat_insert {n : nat} {s : finset nat} : n ∉ s → to_nat (insert n s) = 2^n + to_nat s :=
assume h, Sum_insert_of_not_mem _ h

protected definition of_nat (s : nat) : finset nat :=
{ n ∈ upto (succ s) | odd (s / 2^n) }

open finset (of_nat)

private lemma of_nat_zero : of_nat 0 = ∅ :=
rfl

private lemma odd_of_mem_of_nat {n : nat} {s : nat} : n ∈ of_nat s → odd (s / 2^n) :=
assume h, of_mem_sep h

private lemma mem_of_nat_of_odd {n : nat} {s : nat} : odd (s / 2^n) → n ∈ of_nat s :=
assume h,
have 2^n < succ s, from by_contradiction
  (suppose ¬(2^n < succ s),
   have 2^n > s, from lt_of_succ_le (le_of_not_gt this),
   have s / 2^n = 0, from div_eq_zero_of_lt this,
   by rewrite this at h; exact absurd h dec_trivial),
have n < succ s,        from calc
   n   ≤ 2^n    : le_pow_self dec_trivial n
   ... < succ s : this,
have n ∈ upto (succ s), from mem_upto_of_lt this,
mem_sep_of_mem this h

private lemma succ_mem_of_nat (n : nat) (s : nat) : succ n ∈ of_nat s ↔ n ∈ of_nat (s / 2) :=
iff.intro
  (suppose succ n ∈ of_nat s,
   have odd (s / 2^(succ n)),    from odd_of_mem_of_nat this,
   have odd ((s / 2) / (2 ^ n)), by rewrite [pow_succ' at this, nat.div_div_eq_div_mul, mul.comm]; assumption,
   show n ∈ of_nat (s / 2),        from mem_of_nat_of_odd this)
  (suppose n ∈ of_nat (s / 2),
   have odd ((s / 2) / (2 ^ n)), from odd_of_mem_of_nat this,
   have odd (s / 2^(succ n)),      by rewrite [pow_succ', mul.comm, -nat.div_div_eq_div_mul]; assumption,
   show succ n ∈ of_nat s,             from mem_of_nat_of_odd this)

private lemma odd_of_zero_mem (s : nat) : 0 ∈ of_nat s ↔ odd s :=
begin
  unfold of_nat, rewrite [mem_sep_eq, pow_zero, nat.div_one, mem_upto_eq],
  show 0 < succ s ∧ odd s ↔ odd s, from
  iff.intro
    (assume h, and.right h)
    (assume h, and.intro (zero_lt_succ s) h)
end

private lemma even_of_not_zero_mem (s : nat) : 0 ∉ of_nat s ↔ even s :=
have aux : 0 ∉ of_nat s ↔ ¬odd s, from not_iff_not_of_iff (odd_of_zero_mem s),
iff.intro
  (suppose 0 ∉ of_nat s, even_of_not_odd (iff.mp aux this))
  (suppose even s, iff.mpr aux (not_odd_of_even this))

private lemma even_to_nat (s : finset nat) : even (to_nat s) ↔ 0 ∉ s :=
finset.induction_on s dec_trivial
  (λ a s nains ih,
    begin
      rewrite [to_nat_insert nains], apply iff.intro,
        suppose even (2^a + to_nat s), by_cases
          (suppose e : even (2^a), by_cases
            (suppose even (to_nat s),
              have 0 ∉ s, from iff.mp ih this,
              suppose 0 ∈ insert a s, or.elim (eq_or_mem_of_mem_insert this)
                (suppose 0 = a, begin rewrite [-this at e], exact absurd e not_even_one end)
                (by contradiction))
            (suppose odd  (to_nat s), absurd `even (2^a + to_nat s)` (odd_add_of_even_of_odd `even (2^a)` this)))
          (suppose o : odd (2^a), by_cases
            (suppose even (to_nat s), absurd `even (2^a + to_nat s)` (odd_add_of_odd_of_even `odd (2^a)` this))
            (suppose odd  (to_nat s), suppose 0 ∈ insert a s, or.elim (eq_or_mem_of_mem_insert this)
              (suppose 0 = a,
                have even (to_nat s), from iff.mpr ih (by rewrite -this at nains; exact nains),
                absurd this `odd (to_nat s)`)
              (suppose 0 ∈ s,
                have a ≠ 0, from suppose a = 0, by subst a; contradiction,
                begin
                  cases a with a, exact absurd rfl `0 ≠ 0`,
                  have odd (2*2^a),  by rewrite [pow_succ' at o, mul.comm]; exact o,
                  have even (2*2^a), from !even_two_mul,
                  exact absurd `even (2*2^a)` `odd (2*2^a)`
                end))),
        suppose 0 ∉ insert a s,
          have a ≠ 0, from suppose a = 0, absurd (by rewrite this; apply mem_insert) `0 ∉ insert a s`,
          have 0 ∉ s, from suppose 0 ∈ s, absurd (mem_insert_of_mem _ this) `0 ∉ insert a s`,
          have even (to_nat s), from iff.mpr ih this,
          match a with
          | 0         := suppose a = 0, absurd this `a ≠ 0`
          | (succ a') := suppose a = succ a',
            have even (2^(succ a')), by rewrite [pow_succ', mul.comm]; apply even_two_mul,
            even_add_of_even_of_even this `even (to_nat s)`
          end rfl
    end)

private lemma of_nat_eq_insert_zero {s : nat} : 0 ∉ of_nat s → of_nat (2^0 + s) = insert 0 (of_nat s) :=
assume h : 0 ∉ of_nat s,
have even s,                  from iff.mp (even_of_not_zero_mem s) h,
have   odd (s+1),               from odd_succ_of_even this,
have zmem : 0 ∈ of_nat (s+1), from iff.mpr (odd_of_zero_mem (s+1)) this,
obtain w (hw : s = 2*w),        from exists_of_even `even s`,
begin
  rewrite [pow_zero, add.comm, hw],
  show of_nat (2*w+1) = insert 0 (of_nat (2*w)), from
  finset.ext (λ n,
    match n with
    | 0      := iff.intro (λ h, !mem_insert) (λ h, by rewrite [hw at zmem]; exact zmem)
    | succ m :=
       have d₁  : 1 / 2 = (0:nat),  from dec_trivial,
       have aux : _, from calc
         succ m ∈ of_nat (2 * w + 1) ↔ m ∈ of_nat ((2*w+1) / 2) : succ_mem_of_nat
                  ...                ↔ m ∈ of_nat w             : by rewrite [add.comm, add_mul_div_self_left _ _ (dec_trivial : 2 > 0), d₁, zero_add]
                  ...                ↔ m ∈ of_nat (2*w / 2)     : by rewrite [mul.comm, nat.mul_div_cancel _ (dec_trivial : 2 > 0)]
                  ...                ↔ succ m ∈ of_nat (2*w)    : succ_mem_of_nat,
       iff.intro
         (λ hl, finset.mem_insert_of_mem _ (iff.mp aux hl))
         (λ hr, or.elim (eq_or_mem_of_mem_insert hr)
           (by contradiction)
           (iff.mpr aux))
    end)
end

private lemma of_nat_eq_insert : ∀ {n s : nat}, n ∉ of_nat s → of_nat (2^n + s) = insert n (of_nat s)
| 0        s h := of_nat_eq_insert_zero h
| (succ n) s h :=
  have n ∉ of_nat (s / 2),
    from iff.mp (not_iff_not_of_iff !succ_mem_of_nat) h,
  have ih : of_nat (2^n + s / 2) = insert n (of_nat (s / 2)), from of_nat_eq_insert this,
  finset.ext (λ x,
  have gen : ∀ m, m ∈ of_nat (2^(succ n) + s) ↔ m ∈ insert (succ n) (of_nat s)
  | zero     :=
    have even (2^(succ n)), by rewrite [pow_succ', mul.comm]; apply even_two_mul,
    have aux₁ : odd (2^(succ n) + s) ↔ odd s, from iff.intro
      (suppose odd (2^(succ n) + s), by_contradiction
        (suppose ¬ odd s,
         have even s,                from even_of_not_odd this,
         have even (2^(succ n) + s), from even_add_of_even_of_even `even (2^(succ n))` this,
         absurd `odd (2^(succ n) + s)` (not_odd_of_even this)))
      (suppose odd s, odd_add_of_even_of_odd `even (2^(succ n))` this),
    have aux₂ : odd s ↔ 0 ∈ insert (succ n) (of_nat s), from iff.intro
      (suppose odd s, finset.mem_insert_of_mem _ (iff.mpr !odd_of_zero_mem this))
      (suppose 0 ∈ insert (succ n) (of_nat s), or.elim (eq_or_mem_of_mem_insert this)
         (by contradiction)
         (suppose 0 ∈ of_nat s, iff.mp !odd_of_zero_mem this)),
    calc
      0 ∈ of_nat (2^(succ n) + s) ↔ odd (2^(succ n) + s)           : odd_of_zero_mem
                             ...  ↔ odd s                          : aux₁
                             ...  ↔ 0 ∈ insert (succ n) (of_nat s) : aux₂
  | (succ m) :=
    have aux : m ∈ insert n (of_nat (s / 2)) ↔ succ m ∈ insert (succ n) (of_nat s), from iff.intro
      (assume hl, or.elim (eq_or_mem_of_mem_insert hl)
        (suppose m = n,                by subst m; apply mem_insert)
        (suppose m ∈ of_nat (s / 2), finset.mem_insert_of_mem _ (iff.mpr !succ_mem_of_nat this)))
      (assume hr, or.elim (eq_or_mem_of_mem_insert hr)
        (suppose succ m = succ n,
         have m = n, by injection this; assumption,
         by subst m; apply mem_insert)
        (suppose succ m ∈ of_nat s, finset.mem_insert_of_mem _ (iff.mp !succ_mem_of_nat this))),
    calc
      succ m ∈ of_nat (2^(succ n) + s) ↔ succ m ∈ of_nat (2^n * 2 + s)       : by rewrite pow_succ'
                                 ...   ↔ m ∈ of_nat ((2^n * 2 + s) / 2)      : succ_mem_of_nat
                                 ...   ↔ m ∈ of_nat (2^n + s / 2)            : by rewrite [add.comm, add_mul_div_self (dec_trivial : 2 > 0), add.comm]
                                 ...   ↔ m ∈ insert n (of_nat (s / 2))       : by rewrite ih
                                 ...   ↔ succ m ∈ insert (succ n) (of_nat s) : aux,
  gen x)

lemma of_nat_to_nat (s : finset nat) : of_nat (to_nat s) = s :=
finset.induction_on s rfl
  (λ a s nains ih, by rewrite [to_nat_insert nains, -ih at nains, of_nat_eq_insert nains, ih])

private definition predimage (s : finset nat) : finset nat :=
{ n ∈ image pred s | succ n ∈ s }

private lemma mem_image_pred_of_succ_mem {n : nat} {s : finset nat} : succ n ∈ s → n ∈ image pred s :=
assume h,
  have pred (succ n) ∈ image pred s, from mem_image_of_mem _ h,
  begin rewrite [pred_succ at this], assumption end

private lemma mem_predimage_of_succ_mem {n : nat} {s : finset nat} : succ n ∈ s → n ∈ predimage s :=
assume h, begin unfold predimage, rewrite [mem_sep_eq], exact and.intro (mem_image_pred_of_succ_mem h) h end

private lemma succ_mem_of_mem_predimage {n : nat} {s : finset nat} : n ∈ predimage s → succ n ∈ s :=
begin
  unfold predimage, rewrite [mem_sep_eq],
  suppose n ∈ image pred s ∧ succ n ∈ s, and.right this
end

private lemma predimage_insert_zero (s : finset nat) : predimage (insert 0 s) = predimage s :=
finset.ext (λ n,
  begin
    unfold predimage, rewrite [*mem_sep_eq, image_insert, pred_zero], apply iff.intro,
    suppose n ∈ insert 0 (image pred s) ∧ succ n ∈ insert 0 s,
      have succ n ∈ s, from or.elim (eq_or_mem_of_mem_insert (and.right this))
        (by contradiction)
        (λ h, h),
      and.intro (mem_image_pred_of_succ_mem this) this,
    suppose n ∈ image pred s ∧ succ n ∈ s,
      obtain h₁ h₂, from this,
      and.intro (mem_insert_of_mem 0 h₁) (mem_insert_of_mem 0 h₂)
  end)

private lemma predimage_insert_succ (n : nat) (s : finset nat) : predimage (insert (succ n) s) = insert n (predimage s) :=
finset.ext (λ m,
  begin
    unfold predimage, rewrite [*mem_sep_eq, *image_insert, pred_succ, *mem_insert_eq, *mem_sep_eq], apply iff.intro,
      suppose (m = n ∨ m ∈ image pred s) ∧ (succ m = succ n ∨ succ m ∈ s),
        obtain h₁ h₂, from this,
        or.elim h₁
          (suppose m = n, or.inl this)
          (suppose m ∈ image pred s, or.elim h₂
            (suppose succ m = succ n, by injection this; left; assumption)
            (suppose succ m ∈ s, by right; split; repeat assumption)),
      suppose m = n ∨ m ∈ image pred s ∧ succ m ∈ s, or.elim this
        (suppose m = n, and.intro (or.inl this) (or.inl (by subst m)))
        (suppose m ∈ image pred s ∧ succ m ∈ s,
          obtain h₁ h₂, from this,
          and.intro (or.inr h₁) (or.inr h₂))
  end)

private lemma of_nat_div2 (s : nat) : of_nat (s / 2) = predimage (of_nat s) :=
finset.ext (λ n, iff.intro
  (suppose n ∈ of_nat (s / 2),
   have succ n ∈ of_nat s, from iff.mpr !succ_mem_of_nat this,
   mem_predimage_of_succ_mem this)
  (suppose n ∈ predimage (of_nat s),
   have succ n ∈ of_nat s, from succ_mem_of_mem_predimage this,
   iff.mp !succ_mem_of_nat this))

private lemma to_nat_predimage (s : finset nat) : to_nat (predimage s) = (to_nat s) / 2 :=
begin
  induction s with a s nains ih,
   reflexivity,
   cases a with a,
   { rewrite [predimage_insert_zero, ih, to_nat_insert nains, pow_zero],
     have 0 ∉ of_nat (to_nat s), begin rewrite of_nat_to_nat, exact nains end,
     have even (to_nat s), from iff.mp !even_of_not_zero_mem this,
     obtain (w : nat) (hw : to_nat s = 2*w), from exists_of_even this,
     begin
       rewrite hw,
       have d₁ : 1 / 2 = (0:nat),          from dec_trivial,
       show 2 * w / 2 = (1 + 2 * w) / 2, by
         rewrite [add_mul_div_self_left _ _ (dec_trivial : 2 > 0), mul.comm,
                  nat.mul_div_cancel _ (dec_trivial : 2 > 0), d₁, zero_add]
     end },
   { have a ∉ predimage s, from suppose a ∈ predimage s, absurd (succ_mem_of_mem_predimage this) nains,
     rewrite [predimage_insert_succ, to_nat_insert nains, pow_succ', add.comm,
              add_mul_div_self (dec_trivial : 2 > 0), -ih, to_nat_insert this, add.comm] }
end

lemma to_nat_of_nat (s : nat) : to_nat (of_nat s) = s :=
nat.strong_induction_on s
  (λ n ih, by_cases
    (suppose n = 0, by rewrite this)
    (suppose n ≠ 0,
      have n / 2 < n, from div_lt_of_ne_zero this,
      have to_nat (of_nat (n / 2)) = n / 2, from ih _ this,
      have e₁ : to_nat (of_nat n) / 2 = n / 2, from calc
        to_nat (of_nat n) / 2 = to_nat (predimage (of_nat n)) : by rewrite to_nat_predimage
                          ...   = to_nat (of_nat (n / 2))     : by rewrite of_nat_div2
                          ...   = n / 2                       : this,
      have e₂ : even (to_nat (of_nat n)) ↔ even n, from calc
        even (to_nat (of_nat n)) ↔ 0 ∉ of_nat n : even_to_nat
                             ... ↔ even n       : even_of_not_zero_mem,
      eq_of_div2_of_even e₁ e₂))

open equiv

definition finset_nat_equiv_nat : finset nat ≃ nat :=
mk to_nat of_nat of_nat_to_nat to_nat_of_nat

end finset


/-
# References

1. Levin, Oscar. Discrete Mathematics: An Open Introduction. 3rd ed., n.d.
   https://discrete.openmathbooks.org/pdfs/dmoi3-tablet.pdf.
-/

import Mathlib.Tactic.NormNum
import Mathlib.Tactic.Ring

/--[1]
A 0th-indexed arithmetic sequence.
-/
structure Arithmetic where
  a₀ : Int
  Δ : Int

namespace Arithmetic

/--[1]
Returns the value of the `n`th term of an arithmetic sequence.
-/
def termClosed (seq : Arithmetic) (n : Nat) : Int := seq.a₀ + seq.Δ * n

/--[1]
Returns the value of the `n`th term of an arithmetic sequence.
-/
def termRecursive : Arithmetic → Nat → Int
  | seq,       0 => seq.a₀
  | seq, (n + 1) => seq.Δ + seq.termRecursive n

/--[1]
The recursive definition and closed definitions of an arithmetic sequence are
equivalent.
-/
theorem term_recursive_closed (seq : Arithmetic) (n : Nat)
        : seq.termRecursive n = seq.termClosed n :=
  Nat.recOn
    n
    (by unfold termRecursive termClosed; norm_num)
    (fun n ih => calc
      termRecursive seq (Nat.succ n)
          = seq.Δ + seq.termRecursive n := rfl
        _ = seq.Δ + seq.termClosed n := by rw [ih]
        _ = seq.Δ + (seq.a₀ + seq.Δ * n) := rfl
        _ = seq.a₀ + seq.Δ * (n + 1) := by ring
        _ = termClosed seq (n + 1) := rfl)

/--[1]
Summation of the first `n` terms of an arithmetic sequence.
-/
def sum : Arithmetic → Nat → Int
  |   _,       0 => 0
  | seq, (n + 1) => seq.termClosed n + seq.sum n

/--[1]
The closed formula of the summation of the first `n` terms of an arithmetic
series.
--/
theorem sum_closed_formula (seq : Arithmetic) (n : Nat)
        : seq.sum n = (n / 2) * (seq.a₀ + seq.termClosed (n - 1)) :=
  Nat.recOn
    n
    (by unfold sum termClosed; norm_num)
    (fun n ih => calc
      sum seq n.succ
          = seq.termClosed n + seq.sum n := rfl
        _ = seq.termClosed n + (n / 2 * (seq.a₀ + seq.termClosed (n - 1))) := by rw [ih]
        _ = seq.a₀ + seq.Δ * n + (n / 2 * (seq.a₀ + (seq.a₀ + seq.Δ * ↑(n - 1)))) := rfl
        -- TODO: To continue, need to find how to deal with division.
        _ = ↑(n + 1) / 2 * (seq.a₀ + seq.termClosed n) := by sorry)

end Arithmetic


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

/-!
# Unitary elements of a star monoid

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

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

## Tags

unitary
-/

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

variables {R : Type*}

namespace unitary

section monoid
variables [monoid R] [star_semigroup R]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end monoid

section comm_monoid
variables [comm_monoid R] [star_semigroup R]

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

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

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

end comm_monoid

section group_with_zero
variables [group_with_zero R] [star_semigroup R]

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

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

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

end group_with_zero

section ring
variables [ring R] [star_ring R]

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

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

instance : has_distrib_neg (unitary R) :=
{ neg := has_neg.neg,
  neg_neg := λ U, subtype.ext $ neg_neg _,
  neg_mul := λ U₁ U₂, subtype.ext $ neg_mul _ _,
  mul_neg := λ U₁ U₂, subtype.ext $ mul_neg _ _ }

end ring

end unitary


import Mathlib

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

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

The first two are in this module while the third is in a sequel. The first two are in fact available in functional programming langauges such as `scala` and `Haskell`.

To begin with, we see how Lean deals with subtraction on `ℕ`.

```lean
#eval 4 - 3 -- 1

#eval 3 - 4 -- 0
```

The first example is as expected, but the second may be surprising. According to the documentation of Lean 4,  `Nat.sub` is:
> (Truncated) subtraction of natural numbers. Because natural numbers are not closed under subtraction, we define `m - n` to be 0 when `n < m`.

-/

#eval 4 - 3 -- 1

#eval 3 - 4 -- 0

#check Nat.sub

/-!
## Subtraction with panic

Our first remedy is to define subtraction as Lean does but with an error message when the result is incorrect.

```lean
def Nat.sub! (m n: Nat) :=
match m, n with
| m, 0 => m
| m + 1, n + 1 => Nat.sub! m n
| 0, _ + 1 => panic! "cannot subtract a larger number from a smaller one"

#eval Nat.sub! 4 3 -- 1
#eval Nat.sub! 3 4 -- 0 (but with an error message)
```
-/

/-- Subtraction of natural numbers; panics when difference is negative. -/
def Nat.sub! (m n: Nat) :=
match m, n with
| m, 0 => m
| m + 1, n + 1 => Nat.sub! m n
| 0, _ + 1 => panic! "cannot subtract a larger number from a smaller one"

#eval Nat.sub! 4 3 -- 1
-- #eval Nat.sub! 3 4 -- 0

/-!
A brief digression: Lean 4 lets us easily introduce new notation for our variant of subtraction.

```lean
infix:64 "-!" => Nat.sub!
```
-/

/-- infix notation for subtraction with panic. -/
infix:64 "-!" => Nat.sub!

#eval 4 -! 3

/-!
## More on panicking

The intriguing fact about the illegal subtraction is that, while it gave an error, it still had a value. Indeed, we see more of the underlying phenomenon in the following examples.

```lean
def panicNat : ℕ  := panic! "I like to panic"

#check panicNat  -- ℕ
-- #eval panicNat -- 0 (with error)
```

Note that `panicNat` had a type, and the computation of the type did not give an error. Hence for logical consistency, the value of `panicNat` must be a term of type `ℕ`.

Indeed, if we try to make an analogous definition for `Empty` we get an error.

```lean
def badPanic : Empty :=
  panic! "sometimes we are not even allowed to panic"
```
gives the error message:
```lean
failed to synthesize instance
  Inhabited Empty
```

Indeed the empty type has no inhabitants so allowing a definition of `badPanic` would be a contradiction.
-/

/-- A natural number obtained by panicking. -/
def panicNat : ℕ  := panic! "I like to panic"

#check panicNat  -- ℕ
-- #eval panicNat -- 0 (with error)

#check Empty -- Type

-- def badPanic : Empty :=
--   panic! "sometimes we are not even allowed to panic"

/-!
## Default values and typeclasses

The value returned when panicing is the `default` value of the type. Not every type has a default value. For example, the `Empty` type has no default value.

Default values can be _synthesized_ from other default values by so called _typeclass_ inference. First we see some examples of default values.

```lean

-/

/-- The default value in `ℕ`. -/
def defaultNat : ℕ := default
/-!
```lean
#eval defaultNat -- 0
```

As we have seen earlier, the default value of `ℕ` is `0`.
-/

#eval defaultNat -- 0

/-!
As we saw in the case of panic, the default value of `Empty` is not defined. The following gives an error message.

```lean
def defaultEmpty : Empty := default
```

-/
-- def defaultEmpty : Empty := default

/-- The default value in `ℕ × ℕ`. -/
def default₁ : ℕ × ℕ := default

/-!
A more interesting example is the default value of a product type.

```lean
#eval default₁ -- (0, 0)
```

This is inferred from the default values of the components.
-/

#eval default₁ -- (0, 0)

/-!
### Typeclasses

We sketch the basic ideas of typeclasses and how they are used here. The `default` value of a type `α` is based on `Inhabited α`.

* if `α` is a type `Inhabited α` is a type.
* `Inhabited` is called a _typeclass_.
* a term of type `Inhabited α` (called an _instance_) corresponds to a default term of type `α`.
* Lean _infers_ instances from other instances.
-/

/-- The default value in `ℕ × String × (String → ℕ)`. -/
def default₂ : ℕ × String × (String → ℕ) :=
      default

#reduce default₂ -- (Nat.zero, "", fun x => Nat.zero)

/-- The default value in `ℕ × (String → ℕ) × (Empty → Empty)`. -/
def default₃ : ℕ × (String → ℕ) ×
  (Empty → Empty) := default

#reduce default₃ -- (Nat.zero, fun x => Nat.zero, fun a => False.rec (fun x => Empty) (_ : False))

/-!
Some more examples of typeclass inference.

```lean
#reduce default₂ -- (Nat.zero, "", fun x => Nat.zero)

#reduce default₃ -- (Nat.zero, fun x => Nat.zero, fun a => False.rec (fun x => Empty) (_ : False))
```

In the first example, we see that default functions are inferred if the codomains are inhabited, with a constant function used as a default.

Lean has inferred a default function from `Empty` to `Empty` by using the default function from `Empty` to `False`. To illustrate introducing new  defaults we introduce a new type `MyEmpty` which is also an empty type.
-/

/-- An empty type. -/
inductive MyEmpty where

/-- An instance of `Inhabited` corresponding to the identity function from any type to itself. -/
instance (priority := low)(α : Type) : Inhabited (α → α) :=
    ⟨id⟩

/-- The default value in `ℕ × (String → ℕ) × (ℕ → MyEmpty → MyEmpty)`. -/
def default₄  : ℕ × (String → ℕ) ×
  (ℕ → MyEmpty → MyEmpty) := default

/-!
We see this picked up in the following construction. Note that defining a default for `MyEmpty` gives an error.

```lean
#reduce default₄ -- (Nat.zero, fun x => Nat.zero, fun x a => a)
```
-/

#reduce default₄ -- (Nat.zero, fun x => Nat.zero, fun x a => a)

/-- The default value in `ℕ × String (String → ℕ) × (Empty × Empty)` in the presence of the identity default instance. -/
def default₅ : ℕ × (String → ℕ) ×
  (Empty → Empty) := default

#reduce default₅ -- (Nat.zero, fun x => Nat.zero, fun a => a)

/-- The default value in `ℕ × String (ℕ → ℕ) × (MyEmpty × MyEmpty)` in the presence of the identity default instance. -/
def default₆  : ℕ × (ℕ  → ℕ) ×
  (ℕ → MyEmpty → MyEmpty) := default

#reduce default₆ -- (Nat.zero, fun x => Nat.zero, fun x a => a)

/-!
The following example shows the effect of priorities of instances.

```lean
#reduce default₆ -- (Nat.zero, fun x => Nat.zero, fun x a => a)
```

Observe that the second component is the constant function `fun x => Nat.zero` and not the identity function `id`.
-/

/-!
## Second rectification: `Option`

The second choice is to essentially return values only when they are valid, by wrapping them in an `Option`.

* Given `α` a type `Option α` is a type
* Terms of type `Option α` are of two forms
   - `some x` where `x : α`
   - `none`
-/

/-- Option valued subtraction of natural numbers -/
def Nat.sub? : ℕ → ℕ → Option ℕ
| m, 0 => some m
| m + 1, n + 1 => Nat.sub? m n
| 0, _ + 1 => none

infix:64 "-?" => Nat.sub?

/-!
Some examples of subtraction returning option types.

```lean
#eval 4 -? 3 -- some 1

#eval 3 -? 4 -- none
```
-/

#eval 4 -? 3 -- some 1

#eval 3 -? 4 -- none

/-!
If we return option types we need to be able to handle them. We illustrate this by defining a function that returns the double of the difference if it is defined.

```lean
def Nat.doubleSub? (m n : ℕ) : Option ℕ :=
  (m -? n).map (·  * 2)

#eval Nat.doubleSub? 5 3 -- some 4

#eval Nat.doubleSub? 5 32 -- none
```
-/

/-- Optionally return `(m - n) * 2` if `m ≥ n`. -/
def Nat.doubleSub? (m n : ℕ) : Option ℕ :=
  (m -? n).map (·  * 2)

#eval Nat.doubleSub? 5 3 -- some 4

#eval Nat.doubleSub? 5 32 -- none

/-!
A convenient way to handle option types is to use the `do` notation.

```lean
def Nat.tripleSub? (m n : ℕ) : Option ℕ :=
  do
    let d ← m -? n
    return d * 3

#eval Nat.tripleSub? 5 3 -- some 6
```
-/

/-- Optionally return `(m - n) * 3` if `m ≥ n`. -/
def Nat.tripleSub? (m n : ℕ) : Option ℕ :=
  do
    let d ← m -? n
    return d * 3

#eval Nat.tripleSub? 5 3 -- some 6

/-- Optionally return `a - b - c` if this is non-negative. -/
def Nat.sub_sub? (a b c : ℕ) : Option ℕ :=
  do
    let d₁ ← a -? b
    let d₂ ← d₁ -? c
    return d₂

/-!
The `do` notation is even more convenient when we compose option valued functions.

```lean
def Nat.sub_sub? (a b c : ℕ) : Option ℕ :=
  do
    let d₁ ← a -? b
    let d₂ ← d₁ -? c
    return d₂
```
-/


import tactic

-- Let `Ω` be a "big underlying set" and let `X` and `Y` and `Z` be subsets

variables (Ω : Type) (X Y Z : set Ω) (a b c x y z : Ω)

namespace xena

/-!

# subsets

Let's think about `X ⊆ Y`. Typeset `⊆` with `\sub` or `\ss`
-/

-- `X ⊆ Y` is the same as `∀ a, a ∈ X → a ∈ Y` , by definition.

lemma subset_def : X ⊆ Y ↔ ∀ a, a ∈ X → a ∈ Y :=
begin
  -- true by definition
  refl
end

lemma subset_refl : X ⊆ X :=
begin
  intros a h,
  exact h,
end

lemma subset_trans (hXY : X ⊆ Y) (hYZ : Y ⊆ Z) : X ⊆ Z :=
begin
  -- If you start with `rw subset_def at *` then you
  -- will have things like `hYZ : ∀ (a : Ω), a ∈ Y → a ∈ Z`
  -- You need to think of `hYZ` as a function, which has two
  -- inputs: first a term `a` of type `Ω`, and second a proof `haY` that `a ∈ Y`.
  -- It then produces one output `haZ`, a proof that `a ∈ Z`.
  -- You can also think of it as an implication:
  -- "if a is in Ω, and if a ∈ Y, then a ∈ Z". Because it's an implication,
  -- you can `apply hYZ`. This is a really useful skill!
  intros a h,
  have hY : a ∈ Y :=
    begin
      exact hXY h,
    end,
  exact hYZ hY,
end

/-!

# Equality of sets

Two sets are equal if and only if they have the same elements.
The name of this theorem is `set.ext_iff`.
-/

example : X = Y ↔ (∀ a, a ∈ X ↔ a ∈ Y) :=
begin
  exact set.ext_iff
end

-- In practice, you often have a goal `⊢ X = Y` and you want to reduce
-- it to `a ∈ X ↔ a ∈ Y` for an arbitary `a : Ω`. This can be done with
-- the `ext` tactic.

lemma subset.antisymm (hXY : X ⊆ Y) (hYX : Y ⊆ X) : X = Y :=
begin
  -- start with `ext a`,
  ext a,
  split,
  { exact @hXY a },
  { intro hY,
    exact hYX hY },
end

/-!

## Unions and intersections

Type `\cup` or `\un` for `∪`, and `\cap` or `\i` for `∩`

-/

lemma union_def : a ∈ X ∪ Y ↔ a ∈ X ∨ a ∈ Y :=
begin
  -- true by definition
  refl,
end

lemma inter_def : a ∈ X ∩ Y ↔ a ∈ X ∧ a ∈ Y :=
begin
  -- true by definition
  refl,
end

-- You can rewrite with those lemmas above if you're not comfortable with
-- assuming they're true by definition.

-- union lemmas

lemma union_self : X ∪ X = X :=
begin
  ext a,
  split,
  rotate,
  { intro h,
    exact or.inl h },
  { intro h,
    cases h,
    repeat {exact h} },
end

lemma subset_union_left : X ⊆ X ∪ Y :=
begin
  intros a h,
  exact or.inl h,
end

lemma subset_union_right : Y ⊆ X ∪ Y :=
begin
  intros a h,
  exact or.inr h,
end

lemma union_subset_iff : X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
begin
  split,
  { intro,
    split,
    { apply subset_trans,
      { exact subset_union_left _ X Y },
      { assumption }},
    { apply subset_trans,
      { exact subset_union_right _ X Y },
      { assumption }}},
  { intros h a h',
    cases h',
    { exact h.left h' },
    { exact h.right h' }},
end

variable (W : set Ω)

lemma union_subset_union (hWX : W ⊆ X) (hYZ : Y ⊆ Z) : W ∪ Y ⊆ X ∪ Z :=
begin
  have h : W ⊆ X ∪ Z := sorry,
  have h' : Y ⊆ X ∪ Z := sorry,
  apply (union_subset_iff _ W Y (X ∪ Z)).mpr,
  exact ⟨h,h'⟩
end

#check union_subset_union

lemma union_subset_union_left (hXY : X ⊆ Y) : X ∪ Z ⊆ Y ∪ Z :=
begin
  exact union_subset_union _ _ _ Z _ hXY (subset_refl _ _)
end

-- etc etc

-- intersection lemmas

lemma inter_subset_left : X ∩ Y ⊆ X :=
begin
  sorry
end

-- don't forget `ext` to make progress with equalities of sets

lemma inter_self : X ∩ X = X :=
begin
  sorry
end

lemma inter_comm : X ∩ Y = Y ∩ X :=
begin
  ext a,
  split,
  repeat { exact λ h, ⟨h.right,h.left⟩ },
end

lemma inter_assoc : X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z :=
begin
  sorry
end

/-!

### Forall and exists

-/

#check Exists

variable (P : Ω → Prop)

lemma not_exists_iff_forall_not : ¬ (∃ a, P a) ↔ ∀ b, ¬ (P b) :=
begin
  split,
  { intros h b n,
    exact h (exists.intro _ n)},
  { intros h n,
    apply exists.elim n,
    exact h},
end

example : ¬ (∀ a, P a) ↔ ∃ b, ¬ (P b) :=
begin
  split,
  { intros h',
    by_contra,
    apply (not_exists_iff_forall_not Ω (λ a, ¬ P a)).mpr,
    intros b n,
    exact h (exists.intro b n),
    sorry,
    },
  { intros h n,
    cases h with a h',
    exact h' (n a),
    },
end

end xena


import algebra.group algebra.group_power

variable A: Type*

theorem Q_02 (a b: A) [comm_group A]:
  ∀ n: ℕ, (a * b) ^ n = a ^ n * b ^ n
| 0 :=
  calc (a * b) ^ 0
      = 1 : by rw pow_zero
  ... = 1 * 1                 : (mul_one 1).symm
  ... = (a ^ 0) * (b ^ 0)     : by rw [pow_zero, pow_zero]
| (k + 1) :=
  calc (a * b) ^ (k + 1)
      = a * b * (a * b) ^ k       : pow_succ (a * b) k
  ... = b * a * (a * b) ^ k       : by rw mul_comm a b
  ... = b * a * (a ^ k * b ^ k)   : by rw (Q_02 k)
  ... = b * (a * a ^ k) * b ^ k   : by rw [← mul_assoc, mul_assoc b a (a ^ k)]
  ... = b * a ^ (k + 1) * b ^ k   : by rw pow_succ
  ... = a ^ (k + 1) * (b * b ^ k) : by rw [mul_comm b (a ^ (k + 1)), mul_assoc]
  ... = a ^ (k + 1) * b ^ (k + 1) : by rw [←pow_succ]


------------------------------------------------------------------------
-- § Introducción                                                     --
------------------------------------------------------------------------

-- Se importan las tácticas.
import tactic

-- Nota: Las conectivas lógicas son
-- → "condicional"   se escribe con \->
-- ¬ "negación"      se escribe con \not
-- ∧ "conjunción"    se escribe con \and
-- ↔ "bicondicional" se escribe con \<->
-- ∨ "disyunción"    se escribe con \or

-- Nota: Colocando el curso sobre un símbolo y pulsando C-c C-k se
-- indican las formas de escribirlo

-- Nota: Se usarán las siguientes tácticas (que están en
-- https://bit.ly/3pHFhBO )
-- + intro
-- + exact
-- + apply
-- + rw
-- + cases
-- + split
-- + left
-- + right

-- Nota: En https://bit.ly/3pHFhBO se encuentran estas junto con más
-- tácticas. Por ejemplo, cc, tauto, tauto!, finish y library_search.

-- Nota: Para evitar conflictos, se trabajará en el espacio de nombres
-- oculto.
namespace oculto

-- Nota: P, Q y R son variables sobre proposiciones.
variables (P Q R : Prop)

------------------------------------------------------------------------
-- § Implicaciones (→)                                                --
------------------------------------------------------------------------

-- Nota: En esta sección se usarán las tácticas intro, apply, exact y
-- assumption.

-- ----------------------------------------------------
-- Ejercicio 1. Demostrar que
--    P → P
-- ----------------------------------------------------

theorem id :
  P → P :=
begin
  intro hP,
  exact hP
end

-- ----------------------------------------------------
-- Ejercicio 2. Demostrar que el condicional no es
-- asociativa probando que
--    (false → (false → false)) ↔ true
--    ((false → false) → false) ↔ false
-- ----------------------------------------------------

example :
  (false → (false → false)) ↔ true :=
by simp

example :
  ((false → false) → false) ↔ false :=
by simp

-- Nota: En Lean el condicional asocia por la derecha;
-- es decir, (P → Q → R) es P → (Q → R).

-- ----------------------------------------------------
-- Ejercicio 3. Demostrar que
--    (P → Q → R) ↔ (P → (Q → R))
-- ----------------------------------------------------

example : (P → Q → R) ↔ (P → (Q → R)) :=
begin
  refl,
end

-- ----------------------------------------------------
-- Ejercicio 4. Demostrar que
--    P → Q → P
-- ----------------------------------------------------

theorem imp_intro :
  P → Q → P :=
begin
  intro hP,
  intro hQ,
  exact hP,
end

-- ---------------------------------------------------------------------
-- Ejercicio 5. Demostrar que
--    P → (P → Q) → Q
-- ----------------------------------------------------------------------

lemma modus_ponens :
  P → (P → Q) → Q :=
begin
  intro hP,
  intro hPQ,
  apply hPQ,
  exact hP,
end

-- ---------------------------------------------------------------------
-- Ejercicio 6. Demostrar que
--    (P → Q) → (Q → R) → (P → R)
-- ----------------------------------------------------------------------

lemma imp_trans :
  (P → Q) → (Q → R) → (P → R) :=
begin
  intros hPQ hQR hP,
  apply hQR,
  apply hPQ,
  exact hP,
end

-- ---------------------------------------------------------------------
-- Ejercicio 7. Demostrar que
--    (P → Q → R) → (P → Q) → (P → R)
-- ----------------------------------------------------------------------

lemma forall_imp :
  (P → Q → R) → (P → Q) → (P → R) :=
begin
  intro hPQR,
  intro hPQ,
  intro hP,
  apply hPQR,
  { exact hP, },
  { apply hPQ,
    exact hP, },
end

-------------------------------------------------------
-- § Negación (¬)                                    --
-------------------------------------------------------

-- Nota: La negación ¬P es, por definición (P → false).

-- ---------------------------------------------------------------------
-- Ejercicio 8. Demostrar que
--    ¬ P ↔ (P → false)
-- ----------------------------------------------------------------------

theorem not_def
  : ¬ P ↔ (P → false) :=
begin
  refl,
end

-- ---------------------------------------------------------------------
-- Ejercicio 9. Demostrar que
--    P → ¬¬P
-- ----------------------------------------------------------------------

theorem not_not_intro :
  P → ¬¬P :=
begin
  intro hP,
  rw not_def,
  rw not_def,
  intro hnP,
  apply hnP,
  exact hP,
end

-- 2ª demostración
example :
  P → ¬¬P :=
begin
  intro hP,
  intro hnP,
  apply hnP,
  exact hP,
end

-- 3ª demostración
example :
  P → ¬¬P :=
begin
  intros hP hnP,
  exact hnP hP,
end

-- 4ª demostración
example :
  P → ¬¬P :=
λ hP hnP, hnP hP

-- 5ª demostración
example :
  P → ¬¬P :=
begin
  apply modus_ponens,
end

-- 6ª demostración
example :
  P → ¬¬P :=
-- by library_search
not_not.mpr

-- ---------------------------------------------------------------------
-- Ejercicio 10. Demostrar que
--    (P → Q) → (¬ Q → ¬ P)
-- ----------------------------------------------------------------------

theorem modus_tollens :
  (P → Q) → (¬ Q → ¬ P) :=
begin
  apply imp_trans,
end

-- ---------------------------------------------------------------------
-- Ejercicio 11. Demostrar que
--    ¬¬P → P
-- ----------------------------------------------------------------------

theorem double_negation_elimination :
  ¬¬P → P :=
begin
  intro hnnP,
  by_contra h,
  apply hnnP,
  exact h,
end

-------------------------------------------------------
-- § Conjunción                                      --
-------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 12. Demostrar que
--    P, Q ⊢ P ∧ Q
-- ----------------------------------------------------------------------

example
  (hP : P)
  (hQ : Q)
  : P ∧ Q :=
begin
  split,
  { exact hP, },
  { exact hQ, }
end

-- ---------------------------------------------------------------------
-- Ejercicio 13. Demostrar que
--    P ∧ Q → P
-- ----------------------------------------------------------------------

theorem and.elim_left :
  P ∧ Q → P :=
begin
  intro hPaQ,
  cases hPaQ with hP hQ,
  exact hP,
end

-- ---------------------------------------------------------------------
-- Ejercicio 14. Demostrar que
--    P ∧ Q → Q
-- ----------------------------------------------------------------------

-- 1ª demostración
theorem and.elim_right :
  P ∧ Q → Q :=
begin
  intro hPaQ,
  exact hPaQ.2,
end

-- 2ª demostración
example : P ∧ Q → Q :=
λ hPaQ, hPaQ.2

-- ---------------------------------------------------------------------
-- Ejercicio 15. Demostrar que
--    P → Q → P ∧ Q
-- ----------------------------------------------------------------------

theorem and.intro : P → Q → P ∧ Q :=
begin
  intros hP hQ,
  split,
  { assumption },
  { assumption }
end

-- ---------------------------------------------------------------------
-- Ejercicio 16. Demostrar que
--    P ∧ Q → (P → Q → R) → R
-- ----------------------------------------------------------------------

theorem and.elim :
  P ∧ Q → (P → Q → R) → R :=
begin
  rintro ⟨hP, hQ⟩ hPQR,
  exact hPQR hP hQ,
end

-- ---------------------------------------------------------------------
-- Ejercicio 17. Demostrar que
--    (P → Q → R) → P ∧ Q → R
-- ----------------------------------------------------------------------

theorem and.rec :
  (P → Q → R) → P ∧ Q → R :=
begin
  rintro hPQR ⟨hP, hQ⟩,
  exact hPQR hP hQ,
end

-- ---------------------------------------------------------------------
-- Ejercicio 18. Demostrar que
--    P ∧ Q → Q ∧ P
-- ----------------------------------------------------------------------

-- 1ª demostración
theorem and.symm :
  P ∧ Q → Q ∧ P :=
begin
  rintro ⟨hP, hQ⟩,
  exact ⟨hQ, hP⟩
end

-- 2ª demostración
example : P ∧ Q → Q ∧ P :=
λ ⟨hP, hQ⟩, ⟨hQ, hP⟩

-- ---------------------------------------------------------------------
-- Ejercicio 19. Demostrar que
--    (P ∧ Q) → (Q ∧ R) → (P ∧ R)
-- ----------------------------------------------------------------------

theorem and.trans :
  (P ∧ Q) → (Q ∧ R) → (P ∧ R) :=
begin
  rintro ⟨hP, hQ⟩ ⟨hQ', hR⟩,
  exact ⟨hP, hR⟩,
end

lemma imp_imp_of_and_imp :
  ((P ∧ Q) → R) → (P → Q → R) :=
begin
  intros h hP hQ,
  exact h ⟨hP, hQ⟩
end

-------------------------------------------------------
-- § Bicondicional (↔)                               --
-------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 20. Demostrar que
--    P ↔ P
-- ----------------------------------------------------------------------

-- 1ª demostración
theorem iff.refl :
  P ↔ P :=
begin
  split,
  { apply id },
  { apply id },
end

-- 2ª demostración
example :
  P ↔ P :=
begin
  tauto!,
end

-- 3ª demostración
example :
  P ↔ P :=
begin
  refl
end

-- ---------------------------------------------------------------------
-- Ejercicio 21. Demostrar que
--    (P ↔ Q) → (Q ↔ P)
-- ----------------------------------------------------------------------

-- 1ª demostración
theorem iff.symm :
  (P ↔ Q) → (Q ↔ P) :=
begin
  intro h,
  rw h,
end

-- 2ª demostración
example :
  (P ↔ Q) → (Q ↔ P) :=
λ ⟨hPQ, hQP⟩, ⟨hQP, hPQ⟩

-- ---------------------------------------------------------------------
-- Ejercicio 22. Demostrar que
--    (P ↔ Q) ↔ (Q ↔ P)
-- ----------------------------------------------------------------------

theorem iff.comm :
  (P ↔ Q) ↔ (Q ↔ P) :=
begin
  split,
  { apply iff.symm },
  { apply iff.symm },
end

-- ---------------------------------------------------------------------
-- Ejercicio 23. Demostrar que
--    (P ↔ Q) → (Q ↔ R) → (P ↔ R)
-- ----------------------------------------------------------------------

theorem iff.trans :
  (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  intros hPQ hQR,
  rw hPQ,
  exact hQR,
end

-- ---------------------------------------------------------------------
-- Ejercicio 24. Demostrar que
--    ¬(P ↔ ¬P)
-- ----------------------------------------------------------------------

theorem iff.boss :
  ¬(P ↔ ¬P) :=
begin
  rintro ⟨h1, h2⟩,
  have hnP : ¬P,
  { intro hP,
    exact h1 hP hP, },
  have hP : P := h2 hnP,
  exact hnP hP,
end

-------------------------------------------------------
-- § ↔ y ∧                                           --
-------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 25. Demostrar que
--    P ∧ Q ↔ Q ∧ P
-- ----------------------------------------------------------------------

-- 1ª demostración
theorem and.comm :
  P ∧ Q ↔ Q ∧ P :=
begin
  split;
  apply and.symm,
end

-- 2ª demostración
example :
  P ∧ Q ↔ Q ∧ P :=
⟨and.symm _ _, and.symm _ _⟩

-- ---------------------------------------------------------------------
-- Ejercicio 26. Demostrar que
--    ((P ∧ Q) ∧ R) ↔ (P ∧ (Q ∧ R))
-- ----------------------------------------------------------------------

theorem and_assoc :
  ((P ∧ Q) ∧ R) ↔ (P ∧ (Q ∧ R)) :=
begin
  split,
  { rintro ⟨⟨hP, hQ⟩, hR⟩,
    exact ⟨hP, hQ, hR⟩ },
  { rintro ⟨hP, hQ, hR⟩,
    exact ⟨⟨hP, hQ⟩, hR⟩ },
end

-------------------------------------------------------
-- § Disyunción (∨)                                  --
-------------------------------------------------------

variable (S : Prop)

-- ---------------------------------------------------------------------
-- Ejercicio 27. Demostrar que
--    P → P ∨ Q
-- ----------------------------------------------------------------------

theorem or.intro_left :
  P → P ∨ Q :=
begin
  intro P,
  left,
  assumption,
end

-- ---------------------------------------------------------------------
-- Ejercicio 28. Demostrar que
--    Q → P ∨ Q
-- ----------------------------------------------------------------------

theorem or.intro_right :
  Q → P ∨ Q :=
begin
  intro Q,
  right,
  assumption,
end

-- ---------------------------------------------------------------------
-- Ejercicio 29. Demostrar que
--    P ∨ Q → (P → R) → (Q → R) → R
-- ----------------------------------------------------------------------

theorem or.elim :
  P ∨ Q → (P → R) → (Q → R) → R :=
begin
  intros hPoQ hPR hQR,
  cases hPoQ with hP hQ,
  { exact hPR hP },
  { exact hQR hQ },
end

-- ---------------------------------------------------------------------
-- Ejercicio 30. Demostrar que
--    P ∨ Q → Q ∨ P
-- ----------------------------------------------------------------------

theorem or.symm :
  P ∨ Q → Q ∨ P :=
begin
  intro hPoQ,
  cases hPoQ with hP hQ,
  { right, assumption },
  { left, assumption }
end

-- ---------------------------------------------------------------------
-- Ejercicio 31. Demostrar que
--    P ∨ Q ↔ Q ∨ P
-- ----------------------------------------------------------------------

theorem or.comm :
  P ∨ Q ↔ Q ∨ P :=
begin
  split;
  apply or.symm,
end

-- ---------------------------------------------------------------------
-- Ejercicio 32. Demostrar que
--    (P ∨ Q) ∨ R ↔ P ∨ (Q ∨ R)
-- ----------------------------------------------------------------------

theorem or.assoc :
  (P ∨ Q) ∨ R ↔ P ∨ (Q ∨ R) :=
begin
  split,
  { rintro ((hP | hQ) | hR),
    { left, assumption },
    { right, left, assumption },
    { right, right, assumption } },
  { rintro (hP | hQ | hR),
    { left, left, assumption },
    { left, right, assumption },
    { right, assumption } }
end

-------------------------------------------------------
-- § Más sobre → y and                               --
-------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 33. Demostrar que
--    (P → R) → (Q → S) → P ∨ Q → R ∨ S
-- ---------------------------------------------------------------------

theorem or.imp :
  (P → R) → (Q → S) → P ∨ Q → R ∨ S :=
begin
  rintro hPR hQS (hP | hQ),
  { left, exact hPR hP },
  { right, exact hQS hQ }
end

-- ---------------------------------------------------------------------
-- Ejercicio 34. Demostrar que
--    (P → Q) → P ∨ R → Q ∨ R
-- ----------------------------------------------------------------------

theorem or.imp_left :
  (P → Q) → P ∨ R → Q ∨ R :=
begin
  rintro hPQ (hP | hR),
  { left, exact hPQ hP },
  { right, assumption },
end

-- ---------------------------------------------------------------------
-- Ejercicio 35. Demostrar que
--    (P → Q) → R ∨ P → R ∨ Q
-- ----------------------------------------------------------------------

theorem or.imp_right :
  (P → Q) → R ∨ P → R ∨ Q :=
begin
  rw or.comm R,
  rw or.comm R,
  apply or.imp_left,
end

-- ---------------------------------------------------------------------
-- Ejercicio 36. Demostrar que
--    P ∨ Q ∨ R ↔ Q ∨ P ∨ R
-- ----------------------------------------------------------------------

theorem or.left_comm :
  P ∨ Q ∨ R ↔ Q ∨ P ∨ R :=
begin
  rw [or.comm P, or.assoc, or.comm R],
end

-- ---------------------------------------------------------------------
-- Ejercicio 37. Demostrar que
--    (P → R) → (Q → R) → P ∨ Q → R
-- ----------------------------------------------------------------------

theorem or.rec :
  (P → R) → (Q → R) → P ∨ Q → R :=
begin
  intros hPR hQR hPoQ,
  exact or.elim _ _ _ hPoQ hPR hQR,
end

-- ---------------------------------------------------------------------
-- Ejercicio 38. Demostrar que
--    (P ↔ R) → (Q ↔ S) → (P ∨ Q ↔ R ∨ S)
-- ----------------------------------------------------------------------

theorem or_congr :
  (P ↔ R) → (Q ↔ S) → (P ∨ Q ↔ R ∨ S) :=
begin
  rintro hPR hQS,
  rw [hPR, hQS],
end

-------------------------------------------------------
-- § true y false                                    --
-------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 39. Demostrar que
--    false → P
-- ----------------------------------------------------------------------

theorem false.elim :
  false → P :=
begin
  intro h,
  cases h,
end

-- ---------------------------------------------------------------------
-- Ejercicio 40. Demostrar que
--    P ∧ true ↔ P
-- ----------------------------------------------------------------------

theorem and_true_iff :
  P ∧ true ↔ P :=
begin
  split,
  { rintro ⟨hP, -⟩,
    exact hP },
  { intro hP,
    split,
    { exact hP },
    { trivial } }
end

-- ---------------------------------------------------------------------
-- Ejercicio 41. Demostrar que
--    P ∨ false ↔ P
-- ----------------------------------------------------------------------

theorem or_false_iff :
  P ∨ false ↔ P :=
begin
  split,
  { rintro (hP | h),
    { assumption },
    { cases h} },
  { intro hP,
    left,
    exact hP }
end

-- ---------------------------------------------------------------------
-- Ejercicio 42. Demostrar que
--    P ∨ Q → ¬P → Q
-- ----------------------------------------------------------------------

theorem or.resolve_left :
  P ∨ Q → ¬P → Q :=
begin
  rintro (hP | hQ) hnP,
  { apply false.elim,
    exact hnP hP },
  { exact hQ },
end

-- ---------------------------------------------------------------------
-- Ejercicio 43. Demostrar que
--    P ∨ Q ↔ ¬P → Q
-- ----------------------------------------------------------------------

theorem or_iff_not_imp_left :
  P ∨ Q ↔ ¬P → Q :=
begin
  split,
  { apply or.resolve_left },
  { intro hnPQ,
    by_cases h : P,
    { left, assumption },
    { right, exact hnPQ h} }
end

end oculto

-- =====================================================================
-- § Referencias                                                      --
-- =====================================================================

-- + Kevin Buzzard. "Formalising mathematics : workshop 1 — logic, sets,
--   functions, relations" https://bit.ly/3kJo231
-- + Kevin Buzzard. formalising-mathematics: Part_A_logic.lean
--   https://bit.ly/3m5n9kA
-- + Kevin Buzzard. formalising-mathematics: Part_A_logic_solutions.lean
--   https://bit.ly/3oaLwjv


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

Show that tail recursive fib is equal to standard one.
-/
import data.nat
open nat

definition fib : nat → nat
| 0     := 1
| 1     := 1
| (n+2) := fib (n+1) + fib n

private definition fib_fast_aux : nat → nat → nat → nat
| 0     i j := j
| (n+1) i j := fib_fast_aux n j (j+i)

lemma fib_fast_aux_lemma : ∀ n m, fib_fast_aux n (fib m) (fib (succ m)) = fib (succ (n + m))
| 0        m := by rewrite zero_add
| (succ n) m :=
  begin
    have ih : fib_fast_aux n (fib (succ m)) (fib (succ (succ m))) = fib (succ (n + succ m)), from fib_fast_aux_lemma n (succ m),
    have h₁ : fib (succ m) + fib m = fib (succ (succ m)), from rfl,
    unfold fib_fast_aux, rewrite [h₁, ih, succ_add, add_succ]
  end

definition fib_fast (n: nat) :=
fib_fast_aux n 0 1

lemma fib_fast_eq_fib : ∀ n, fib_fast n = fib n
| 0        := rfl
| (succ n) :=
  begin
    have h₁ : fib_fast_aux n (fib 0) (fib 1) = fib (succ n), from !fib_fast_aux_lemma,
    unfold fib_fast, unfold fib_fast_aux, krewrite h₁
  end


import data.set.lattice
import data.set.function
import analysis.special_functions.log.basic

section
variables {α β : Type*}
variable  f : α → β
variables s t : set α
variables u v : set β
open function
open set

example : f ⁻¹' (u ∩ v) = f ⁻¹' u ∩ f ⁻¹' v :=
by { ext, refl }

example : f '' (s ∪ t) = f '' s ∪ f '' t :=
begin
  ext y, split,
  { rintros ⟨x, xs | xt, rfl⟩,
    { left, use [x, xs],},
    { right, use [x, xt]},},
  { rintros (⟨x, xs, rfl⟩ | ⟨x, xt, rfl⟩),
    { use [x, or.inl xs]},
    { use [x, or.inr xt]}},
end

example : f '' s ⊆ v ↔ s ⊆ f ⁻¹' v :=
begin
  split,
  { rintros fsv x xs,
    apply fsv,
    use [x, xs, rfl],},
  { rintros sfv y ⟨x, xs, rfl⟩,
    apply sfv,
    from xs,},
end

#check image_subset_iff

example (h : injective f) : f ⁻¹' (f '' s) ⊆ s :=
begin
  rintros y ⟨x, ⟨xs, heq⟩⟩,
  rw h heq at xs,
  from xs,
end

#check injective f
#check surjective f

example : f '' (f⁻¹' u) ⊆ u :=
begin
  refine image_subset_iff.mpr _,
  apply subset.refl,
end

example (h : surjective f) : u ⊆ f '' (f⁻¹' u) :=
begin
  rintros y yu,
  rcases h y with ⟨x, rfl⟩,
  use x,
  split,
  from yu,
  refl,
end

example (h : s ⊆ t) : f '' s ⊆ f '' t :=
begin
  rintros y ⟨x, ⟨xs, fxeq⟩⟩,
  use [x, h xs, fxeq],
end

example (h : u ⊆ v) : f ⁻¹' u ⊆ f ⁻¹' v :=
begin
  intros x xu,
  apply h,
  from xu,
end

example : f ⁻¹' (u ∪ v) = f ⁻¹' u ∪ f ⁻¹' v :=
begin
  ext x,
  split,
  { rintro (fu | fv),
    left, from fu,
    right, from fv,},
  { rintro (fu | fv),
    left, from fu,
    right, from fv,}
end

example : f '' (s ∩ t) ⊆ f '' s ∩ f '' t :=
begin
  rintros y ⟨x, ⟨⟨xs, xt⟩, fxeq⟩⟩,
  split,
  { use [x, xs, fxeq]},
  { use [x, xt, fxeq]},
end

example (h : injective f) : f '' s ∩ f '' t ⊆ f '' (s ∩ t) :=
begin
  rintros y ⟨⟨x, ⟨xs, fxeq⟩⟩, ⟨z, ⟨zt, fzeq⟩⟩⟩,
  use x,
  split,
  { split, from xs,
    have : x = z,
      apply h,
      apply eq.trans fxeq fzeq.symm,
    rwa this.symm at zt,},
  { from fxeq,},

end

example : f '' s \ f '' t ⊆ f '' (s \ t) :=
begin
  rintros y ⟨fs, fnt⟩,
  rcases fs with ⟨x, ⟨xs, fxeq⟩⟩,
  use x,
  split,
  { split,
    from xs,
    contrapose! fnt,
    use [x, fnt, fxeq],},
  { from fxeq,},
end

example : f ⁻¹' u \ f ⁻¹' v ⊆ f ⁻¹' (u \ v) :=
begin
  rintros x ⟨xu, xnv⟩,
  split; assumption,
end

example : f '' s ∩ v = f '' (s ∩ f ⁻¹' v) :=
begin
  ext y,
  split,
  { rintros ⟨⟨x, ⟨xs, fxeq⟩⟩, yv⟩,
    use x,
    split,
    { split,
      from xs,
      rwa fxeq.symm at yv,},
    { from fxeq,}},
  { rintros ⟨x, ⟨⟨xs, yv⟩, fxeq⟩⟩,
    use x,
    from ⟨xs, fxeq⟩,
    rwa fxeq.symm,}
end

example : f '' (s ∩ f ⁻¹' u) ⊆ f '' s ∪ u :=
begin
  rintros y ⟨x, ⟨xs, yu⟩, fxeq⟩,
  left,
  use [x, xs, fxeq],
end

example : s ∩ f ⁻¹' u ⊆ f ⁻¹' (f '' s ∩ u) :=
begin
  rintros x ⟨xs, fxu⟩,
  split,
  { use [x, xs, rfl],},
  { from fxu,}
end

example : s ∪ f ⁻¹' u ⊆ f ⁻¹' (f '' s ∪ u) :=
begin
  rintros x (xs | fxu),
  { left,
    use [x, xs, rfl],},
  { right,
    use fxu,}
end

variables {I : Type*} (A : I → set α) (B : I → set β)

example : f '' (⋃ i, A i) = ⋃ i, f '' A i :=
begin
  ext y, simp,
  split,
  { rintros ⟨x, ⟨i, xAi⟩, fxeq⟩,
    use [i, x, xAi, fxeq],},
  { rintros ⟨i, x, ⟨xAi, fxeq⟩⟩,
    use [x, i, xAi, fxeq],},
end

example : f '' (⋂ i, A i) ⊆ ⋂ i, f '' A i :=
begin
  intro y, simp,
  intros x h fxeq i,
  use [x, h i, fxeq],
end

example (i : I) (injf : injective f) :
  (⋂ i, f '' A i) ⊆ f '' (⋂ i, A i) :=
begin
  intro y, simp,
  intro h,
  rcases h i with ⟨x, ⟨xAi, fxeq⟩⟩,
  use x, split,
  { intro i',
    rcases h i' with ⟨x', x'Ai, fx'eq⟩,
    have : f x = f x', by rw [fxeq, fx'eq],
    have : x = x', from injf this,
    rwa this,},
  { from fxeq,},
end

end

section
open set real

example : inj_on log { x | x > 0 } :=
begin
  intros x xpos y ypos e,
  calc
    x = exp (log x) : by rw exp_log xpos
    ... = exp (log y) : by rw e
    ... = y : by rw exp_log ypos,
end

example : range exp = { y | y > 0 } :=
begin
  ext y, split,
  { rintros ⟨x, rfl⟩,
    apply exp_pos,},
  { intro ypos,
    use log y,
    apply exp_log ypos,}
end

example : inj_on sqrt { x | x ≥ 0 } :=
begin
  intros x xge y yge e,
  calc
    x = (sqrt x) ^ 2 : by rw sq_sqrt xge
    ... = (sqrt y) ^ 2 : by rw e
    ... = y : by rw sq_sqrt yge,
end

#check sqrt_sq

example : inj_on (λ x, x^2) { x : ℝ | x ≥ 0 } :=
begin
  intros x xge y yge,
  dsimp, intro e,
  calc
    x = sqrt (x ^ 2) : by rw sqrt_sq xge
    ... = sqrt (y ^ 2) : by rw e
    ... = y : by rw sqrt_sq yge,
end

example : sqrt '' { x | x ≥ 0 } = {y | y ≥ 0} :=
begin
  ext y, dsimp, split,
  { rintro ⟨x, xge, fxeq⟩,
    rw ←fxeq,
    apply sqrt_nonneg,},
  { intro yge,
    use y^2,
    dsimp,
    split,
    apply sq_nonneg,
    rw sqrt_sq yge,}
end

example : range (λ x, x^2) = {y : ℝ  | y ≥ 0} :=
begin
  ext y, split,
  { rintro ⟨x, fxeq⟩,
    dsimp at fxeq,
    dsimp, rw ←fxeq,
    apply sq_nonneg,},
  { dsimp, intro yge,
    use sqrt y,
    dsimp,
    rw sq_sqrt yge,},
end

end

section
variables {α β : Type*} [inhabited α]

#check (default : α)

variables (P : α → Prop) (h : ∃ x, P x)

#check classical.some h

example : P (classical.some h) := classical.some_spec h

noncomputable theory
open_locale classical

def inverse (f : α → β) : β → α :=
λ y : β, if h : ∃ x, f x = y then classical.some h else default

theorem inverse_spec {f : α → β} (y : β) (h : ∃ x, f x = y) :
  f (inverse f y) = y :=
begin
  rw inverse, dsimp, rw dif_pos h,
  exact classical.some_spec h
end

variable  f : α → β
open function

example : injective f ↔ left_inverse (inverse f) f  :=
begin
  split,
  { intros injf x,
    apply injf,
    apply inverse_spec,
    use x,},
  { intros lfi x y e,
    calc
      x = inverse f (f x) : by rw lfi
      ... = inverse f (f y) : by rw e
      ... = y : by rw lfi,},
end

example : surjective f ↔ right_inverse (inverse f) f :=
begin
  split,
  { intros surf y,
    apply inverse_spec,
    use surf y,},
  { rintros rfi y,
    use (inverse f) y,
    from rfi y,}
end

theorem Cantor : ∀ f : α → set α, ¬ surjective f :=
begin
  intros f surf,
  let S := { i | i ∉ f i},
  rcases surf S with ⟨j, h⟩,
  have h₁ : j ∉ f j,
    intro h',
    have : j ∉ f j,
      by rwa h at h',
    contradiction,
  have h₂ : j ∈ S,
    from h₁,
  have h₃ : j ∉ S,
    rwa h at h₁,
  contradiction,
end

end


/- Yair Gueta : 208624908 : t3
    Exercise 3
-/
import data.nat.basic
import data.real.basic

variables (α : Type*) (p q : α → Prop)

---- Q1 ----
example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
iff.intro
    (assume h :∀ x, p x ∧ q x,
        have h₁ : ∀ x, p x, from
            assume y,
            show p y, from (h y).left,
        have ∀ x, q x, from
            assume k,
            show q k, from (h k).right,
        ⟨h₁, this⟩)
    (assume h : (∀ x, p x) ∧ (∀ x, q x),
        assume z,
            ⟨h.left z, h.right z⟩)

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
assume h₁ : ∀ x, p x → q x,
assume h₂ : ∀ x, p x,
assume y,
    have hpq : p y → q y, from h₁ y,
    hpq (h₂ y)

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
assume h : (∀ x, p x) ∨ (∀ x, q x),
assume x,
    h.elim
        (assume : (∀ x, p x),
            or.inl (this x))
        (assume : (∀ x, q x),
            or.inr (this x))

---- Q2 ----
open classical
variable r : Prop

example : α → ((∀ x : α, r) ↔ r) :=
assume y: α,
iff.intro
    (assume : (∀ x : α, r), this y)
    (assume hr : r,
        assume y : α, hr)

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
iff.intro
    (assume h : ∀ x, p x ∨ r,
     by_cases
     (assume hr : r,
        show (∀ x, p x) ∨ r, from or.inr hr)
     (assume hnr : ¬r,
        suffices (∀ x, p x), from or.inl this,
        assume y, (h y).elim (assume hpy : p y, hpy)(assume hr:r, absurd hr hnr)
        ))
    (assume h : (∀ x, p x) ∨ r,
        h.elim
        (assume ah : ∀ x, p x,
         assume y, or.inl (ah y))
        (assume hr : r,
         assume y, or.inr hr))

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
iff.intro
  (assume h : ∀ x, r → p x,
   assume hr : r, assume y, (h y) hr)
  (assume h : r → ∀ x, p x, assume y, assume hr : r, h hr y)

---- Q3 ----
variables (men : Type*) (barber : men)
variable  (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) :
  false :=
  have hb : shaves barber barber ↔ ¬ shaves barber barber, from h barber,
  by_cases
    (assume hsb : shaves barber barber, hb.elim_left hsb hsb)
    (assume hnsb : ¬ shaves barber barber, hnsb (hb.elim_right hnsb))

---- Q4 ----
namespace Q4
    def even (n : ℕ) : Prop := 2 ∣ n

    def prime (n : ℕ) : Prop := ∀ (m : ℕ), (m > 1) → (m < n) → ¬ ∃(l : ℕ), m*l = n

    def infinitely_many_primes : Prop := ∀ (n : ℕ), ∃ (p : ℕ), p > n → prime p

    def Fermat_prime (n : ℕ) : Prop := ∃ (m : ℕ), prime n ↔ (n = 2^(2^m)+1)

    def infinitely_many_Fermat_primes : Prop := ∀ (n : ℕ), ∃ (p : ℕ), p > n → Fermat_prime p

    def goldbach_conjecture : Prop :=
        ∀ (n : ℕ), (even n) → (n > 2) → (∃ (m l : ℕ ), prime m → prime l → m+l=n)

    def Goldbach's_weak_conjecture : Prop :=
        ∀ (n : ℕ), (even n) → (n > 5) → (∃ (m₁ m₂ m₃ : ℕ ),
            prime m₁ → prime m₂ → prime m₃ → m₁+m₂+m₃=n)

    def Fermat's_last_theorem : Prop := ∀ (n : ℕ), n > 2 → ¬ (∃ (x y z : ℕ), x^n+y^n=z^n)
end Q4

---- Q6 ----
variables log exp     : real → real
variable  log_exp_eq : ∀ x, log (exp x) = x
variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
variable  exp_pos    : ∀ x, exp x > 0
variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

-- this ensures the assumptions are available in tactic proofs
include log_exp_eq exp_log_eq exp_pos exp_add

example (x y z : real) :
  exp (x + y + z) = exp x * exp y * exp z :=
by rw [exp_add, exp_add]

example (y : real) (h : y > 0)  : exp (log y) = y :=
exp_log_eq h

theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
  log (x * y) = log x + log y :=
    by rw [←log_exp_eq(log x + log y),exp_add,exp_log_eq hx,exp_log_eq hy]