import MyNat.Addition -- imports addition.
import AdditionWorld.Level1 -- zero_add
import AdditionWorld.Level3 -- succ_add
namespace MyNat
open MyNat

/-!
# Addition World

## Level 4: `add_comm`

In this level, you'll prove that addition is commutative.

## Lemma

On the set of natural numbers, addition is commutative.
In other words, for all natural numbers `a` and `b`, we have `a + b = b + a.`
-/
lemma add_comm (a b : MyNat) : a + b = b + a := by
  induction b with
  | zero =>
    rw [zero_is_0]
    rw [add_zero]
    rw [zero_add]
  | succ b ih =>
    rw [add_succ]
    rw [ih]
    rw [succ_add]

/-!

If you are keeping up so far then nice! You're nearly ready to make a choice:
[Multiplication World](../MultiplicationWorld.lean.md) or
[Function World](../FunctionWorld.lean.md). But there are just a couple
more useful lemmas in Addition World which you should prove first.

Press on to [level 5](./Level5.lean.md).

-/


section pred_logic

variables X Y Z : Prop

/- *** NOT *** -/

-- ¬
/-
With an understanding of "false" and its elimination rule, we
can now talk about the inference rules for negation.
-/

/-
Recall that if P is any proposition, then (not P), generally
written as ¬P, is also a proposition. when is ¬P true? It's
true in first-order logic if P is false. It's also true in
constructive logic when P is false, which is to say, *when
there are no proofs of P*.

Now here's the slightly tricky way that we show that there can
be no proof of P. We show (P → false). What this proposition
says is that "If there is a proof of P, then from it we can
derive an impossibility, so there must be no proof of P. This
is the rule of false introduction: prove P → false, conclude
¬P. ¬P is true iff P → false. Indeed, in our logic we simply
*define* ¬P to mean P → false.
-/

/-
Right click on not and click "go to definition" to see the
definition of (not P) and the definition of ¬P as a notation
for (not P).
-/

#check not

/-
Examples
-/

example : 0 = 1 → false :=
begin
assume h,   -- assume 0 = 1; this can't happen, of course
cases h,    -- there's no way to prove 0 = 1, so NOT (0=1)
end

/-
Here's exactly the same proposition but using ¬ notation
-/
example : ¬(0 = 1) :=
begin
assume h,
cases h,

/-
Remember!  0 ≠ 1 means ¬(0 = 1) means 0 = 1 → false. You
must remember that when you want to prove ¬P, that means
you need to prove P → false: that a proof of P is an
impossibility.  Remember this, because it tells you how
to prove ¬P. To show it, assume the premise, 0 = 1, then
show that this assumption gives rise to an impossibility
(a proof of false).
-/
end

/- PROOF BY NEGATION

What we've now seen is a crucial "proof strategy" often
called "proof by negation."" To show ¬P (that P is false),
we prove P → false. How? assume P is true and show that from
this assumption you can derive a contradiction, something
that cannot be, such as proof of false.
-/

/-
HW #3 Exercise: state and prove the rule (the "theorem")
of "no contradiction:" first in English and then in the
predicate logic of Lean. Or if you prefer, work it out
in Lean and the write it in English. The formal statement
of the proposition is in the partially completed theorem
below.
-/

/-
English. Prove ¬(X ∧ ¬X), where X is any proposition.
This theorem states that it cannot be the case that
both X and ¬X are true.

Proof by negation: Assume that (X ∧ ¬X) is true. By
use of and elimination deduce X and ¬X separately.
But this is a contradiction, so the assumption must
have been false. Therefore ¬(X ∧ ¬X) is proved. QED.
-/

theorem no_contradiction : ¬(X ∧ ¬X) :=
begin
assume h,           -- where h proves (X ∧ ¬X)
cases h with x nx,  -- applies and elimination
exact (nx x),       -- (nx x) is a proof of false
end

/- PROOF BY CONTRADICTION

First, recall that in proof by negation, we prove ¬P by
assuming that P is true, deriving an impossibility, and
then concluding ¬P.

Proof by contradiction is just a tad more complicated. In
this proof strategy we prove P (rather than ¬P) by assuming
¬P (rather than P) and showing that *this* assumption leads
to an impossibility, a contradiction. What that proves is
that ¬P must be false, which is to say, ¬¬P. Finally, from
there, we conclude P using *negation elimination*. This rule
is simply this (recall that we introduced X as an arbitrary
propostion above):
-/

def neg_elim          := ¬¬X → X

/-
As a silly but simple example, let's prove that 0 = 0 using
the strategy of proof by contradiction.

Goal: Prove 0 = 0.
Proof (by contradiction). Assume h: ¬(0 = 0). Recall that
this means h is a proof of (0 = 0) → false. But 0 = 0 is
true, so there is a proof of it, let's call it pf. Now we
simply apply h to pf (arrow elimination) to derive a proof
of false. By ¬ introduction, this proves ¬¬(0 = 1). Finally
we apply negation elimination to deduce that (0 = 1) is true.
-/

/-
In Lean, "by_contradiction" is the name of the negation
elimination rule. Because it relies on a non-constructive
assumption, it's tucked away in a module called classical.
We can use it by referring to classical.by_contradiction.
The @ sign here is a detail you can ignore for now. It
just tells Lean to report the rule as its' written where
it's defined.

-/
#check @classical.by_contradiction
-- ∀ {p : Prop}, (¬p → false) → p
-- in other words, ∀ (P : Prop), ¬(¬P) → P
-- Proof by contradiction is application of ¬ elimination!

-- Here's a formal proof
example : 0 = 0 :=
begin
apply classical.by_contradiction,
assume h,               -- assume ¬ 0 = 0
let k := eq.refl 0,     -- but we can have k a proof of 0 = 0
let f := h k,           -- that's an impossibility (here a proof of false)
apply false.elim f,     -- ex falso quodlibet! QED.
end

-- We can't prove negation elimination to be valid in constructive logic!
example : ∀ (P : Prop), ¬¬P → P :=
begin
assume P,
assume nnp,
-- stuck!!!
end

/-
But as a real wonder, it turns out that if you assume
that the law of the excluded middle is valid, then that
is sufficient to make negation elimination valid again.
-/

/-
The axiom of the excluded middle says that any and
every proposition has a Boolean truth value: it is
either true, or false, and there's nothing else it
could be.

In constructive logic, by contrast, if you don't
have either a proof of P or of ¬P, then you can't
build a proof of P ∨ ¬P. By contrast, in "classical"
logic for any proposition, P, you have have a proof
of P ∨ ¬P "for free," just by applying em to P.
-/

-- In Lean, classical.em is a proof of ∀ P, P ∨ ¬P.
#check @classical.em
-- em : ∀ (p : Prop), p ∨ ¬p

/-
The crucial point about the law of the excluded
middle is that (because it's a universal generalization)
you can *apply* it to any proposition, P, to get a "free"
proof of P ∨ ¬P; *and on that you can do case analysis,*
with just two cases: in one case P is true because you
have a proof of it; and in the other case you have a
proof of ¬P. As long as you can show that your goal
follows "in either case", you've proved your goal.
-/

/-
So let's see exactly how accepting the law of the
excluded middle (em) suffices to prove the validity
of negation elimination, ¬¬P → P. Remember that proof
by contradiction is used to prove P by assuming ¬P
and showing that that yeilds an impossibility, thus
proving ¬(¬P), from which, by negation elimination
you can deduce P, which was the original goal.

Here's the final secret. Read negation elimination
rule backwards. What is says is that if you want
to prove P, it will *suffice* to prove ¬¬P, for if
you do that, you just apply negation elimination
to prove P.

In other words. if your goal is P, and you apply
negation elimination, your new goal is to prove
¬¬P. Now recall that ¬¬P just means (¬P) → false.
To prove this, assume ¬P! And then show that this
assumption leads to a situation that can't happen,
and where therefore there is nothing else to be
considered. False elimination really means that
you can ignore the consequences of situations
that can never even happen in the first place.
-/

-- If we assume em, then negation elimination is valid
example :
  ∀ (P : Prop),   -- for any proposition P
    (P ∨ ¬P) →    -- ***if we assume em is valid**
    (¬¬P → P)     -- ***then neg elim is valid***
  :=
begin
assume P,
assume em_P,
assume nnp,
cases em_P with p np,
-- case P
exact p,
-- "assumption" also works heew
-- case ¬P
apply false.elim (nnp np)
-- "contradiction" also works here
end

/-
Exercises: Prove that the following propositions are theorems
(that they have proofs). Express your proofs in English. For
extra credit, provide formal proofs in Lean. Hint: Working out
the proofs in Lean can be a big help to expressing them in
English.
-/

-- prove that these propositions are
def contrapostitive   := (X → Y) → (¬Y → ¬X)
def demorgan1         := ¬(X ∨ Y) ↔ ¬X ∧ ¬Y
def demorgan2         := ¬(X ∧ Y) ↔ ¬X ∨ ¬Y

/- EXTRA MATERIAL/CREDIT

It also turns out that if you assume that negation
elimination, (¬¬P → P) is valid, then you can prove
that excluded middle is, too: (∀ (P : Prop), P ∨ ¬P).

Indeed, in our logic, the two axioms are equivalent.
Here's a formal statement of that proposition, with
an extra credit opportunity for you to prove it in
both directions.
-/

theorem em_equiv_pbc :
  ∀ (P : Prop), (P ∨ ¬P) ↔ (¬¬P → P) :=
begin
_         -- challenge problem, on your own
end

/-
Assume P is a proposition then see that you can
"apply iff.intro _ _") to construct a proof for
your overall goal. You're done, with you nidge:
you "borrowed" proofsfrom the future and now you
have to pay them back. You're thus left with two
remaining sub-goals. In this way, you provide a
complete proof but with some "blanks" that still
need to be filled in. Lean typechecks such proofs
with holes and knows the types of proofs/values
needed for each one. These are the subgoals that
remain.

This is the vitally important computer science
"strategy" of top-down, structured, type-guided
decomposition of a problem. You apply to a hard
problem by producing a complete solution pending
completion of remaining holes; then you apply
the same strategy to fill each hole; until you
fill holes with values that themselfes have no
remaining holes! Then you're done.

What's saddening, always a little at least, is
when you've expanded a whole tree of holes and
then filled in many only to find that you're
stuck. Yeah, that can make it hard to *find*
proofs. You must back up, undo some assumptions,
and then move forward ahead. This is called a
back-tracking search strategy. Mathematicians
*search* for proofs. Those who are especially
goodhave uncanny senses for unpromising paths
to avoid.

Even so, the complete formalization of a proof
of the Four-Color Theorem took G.Gonthier six
years to complete at Microsoft Research. Along
the way he had to build a significant formal
theory of a lot of the underlying mathematics,
e.g., in such areas as topology.

Main take-away message: when a proof of Q is
needed, we can often apply an inference rule
or theorem, to assumed arguments, to constrct
a proof of Q *even if we don't have values for
the arguments yet*. In this way, we build a
complete solution "modulo" remaining "proof
obligations," or "subgoals." This approach
is top-down, structured (read hierarchical),
type-guided decomposition. It reduces a hard
problem to a complete solution in one step,
pending the satisfaction of zero or more
remaining subproblems. If it's zero, QED; if
not, keep going, consider backtracking, etc.
-/

end pred_logic


/-

-/

#check @or.elim

example : ∀ (P Q R: Prop), P ∨ Q → R :=
begin
  assume P Q R,     -- forall introduction
  assume h : P ∨ Q,
  apply or.elim h _ _,
  assume P,
   -- end of example,
end

example : ∀ (P Q R: Prop), P ∨ Q → ((P → R) → (Q → R) → R) :=
begin
assume P Q R,     -- forall introduction, assume PQR, show rest
assume (h : P ∨ Q),         -- arrow introduction
apply or.elim h,  -- or elimination (cases)

-- First case: assume P
assume (p : P),   -- arrow intro
assume pr,        -- arrow intro
assume qr,        -- arrow intro
exact (pr p),     -- arrow elimination

-- Second case: assuming Q is true
assume q pr qr,
exact (qr q),
end

#check @or.inl
#check @or.inr

-- What does unfold do

def x := 0 = 1

def m := ∀ P, P ∨ ¬P

theorem foo : m  :=
begin
unfold m,
-- quit
end

-- What about iff

example : ∀ (P Q : Prop), P ↔ Q :=
begin
assume P Q,
apply iff.intro,
end

variables (P Q : Prop)
variables (pq : P → Q) (qp : Q → P)

-- what I want is a proof that P ↔ Q

/-
We prove P ↔ Q from P → Q and Q → P by iff introduction
-/
example : P ↔ Q := (iff.intro pq qp)

variable piffq : P ↔ Q

example : P → Q := iff.mp piffq   -- weird name for elim_left (modus ponens)
example : Q → P := iff.mpr piffq   -- weird name for elim_right (modus ponens reverse)
-- don't worry about these details

theorem my_and_elim : ∀ (P Q), P ∧ Q → P :=
begin
  assume P Q,
  assume (pq : P ∧ Q),
  apply and.elim_left pq,
end


import tactic
import data.real.basic
variables (P Q R S : Prop)
variables (A B C D : Type)
variables (a b c d k m n x: ℕ)
open function set
/-
# Logic

In Lean a `Prop` is any true/false statement.

For example: `3 = 2`  or `x = 7 → x is prime` or
`∀ (n:ℕ), 2 ∣ n` or `∃ (k:ℕ), even k ∧ ¬ prime k` -/

--#check 3 = 2
--#check x = 7 → prime x
--#check ∀ (n:ℕ), 2 ∣ n
--#check ∃ (k:ℕ), even k ∧ ¬ prime k

/-
If we have `(P : Prop)` then `P` is a proposition, so it is
a statement that is either true or false.

So what is `(hp : P)`? It is simply a proof that P is true.
Or equivalently `hp` is the hypothesis that P is true.

# Tactics

We will use the three basic tactics from last time: `exact`, `intro`, `apply`

# exact
If our goal is `⊢ P` and we have a term `hp : P` then
we can close it with `exact hp`

# intro(s)
If our goal is `⊢ P → Q` then `intro hp` introduces a term `(hp : P)`
into our local context and our goal changes to `⊢ Q`.

# apply
If our goal is `⊢ Q` and we have a term `(hpq : P → Q)` then
`apply hpq` changes our goal to `⊢ P`

(We think of this as : we know `P implies Q`, so if our goal is `Q` it
suffices to prove `P` and then `Q` follows.)

# New tactic: refl

# refl
If our goal can be proved by `reflexivity` then `refl` will close it.
For example  `P = P` or `P ↔ P` -/

-- 01 `if and only if` `↔` is reflexive so refl works here
example : P ↔ P :=
begin
  refl,
end

-- 02 Equality is also reflexive so again `refl` will work
example : P = P :=
begin
  sorry,
end

/- Unless told otherwise, Lean assumes numerals refer to natural
numbers i.e. ℕ = {0, 1, 2,...} also known as `nats`.

If we do operations such as ` + - / * ^ % ` with nats then the result is
also a nat. -/

-- 03
example : 1 + 1 = 2 :=
begin
  sorry,
end

-- 04
example : 12 * 25 = 300 :=
begin
  sorry,
end

-- 05
example : 7 - 3 = 2 ^ 2 :=
begin
  sorry,
end

-- 06
example : 2 - 3 = 0 := -- yes 2 - 3 = 0 in Lean
begin
  sorry,
end

-- 07  `a % b` is the remainder of `a` after division by `b`.
example : 18 % 7 = 4:=
begin
  sorry,
end

-- 08  Remember everything here is a natural number
example (n : ℕ): (12 / 5)^4  = 4^(5 / 2) * n^ (3 - 4) :=
begin
  sorry,
end

-- 09 `refl` can also see through definitions
example  (f : A → B) : injective f ↔ ∀ (x y : A), f x = f y → x = y :=
begin
  refl,
end

-- 10
example (f : A → B) : surjective f ↔ ∀ (b:B), ∃ (a:A), f a = b:=
begin
  sorry,
end

/- We give the next example a name because it captures one of the fundmental
   properties of `Prop` in Lean:
           `Any two proofs of the same Prop are equal` -/
-- 11
lemma proof_irrelevance (P : Prop) (h1 : P) (h2 : P) : h1 = h2:=
begin
  sorry,
end

/- The same isn't true for most Types.
   [Qu: what can you say about types for which this is true?] -/
-- 12
example (A : Type) (a1 : A) (a2 : A) : a1 = a2:=
begin
  sorry -- don't try to prove this it isn't true without further assumptions about A!
end

-- 13 Any proposition implies itself
example  : P → P :=
begin
  intro hp, -- introduce the hypothesis `hp : P` in the local context
            -- our goal is now `⊢ P` so we can accomplish this with
  exact hp,
end

-- 14 If P is true and P → Q is true then Q is true
example (hp : P) (hpq : P → Q) : Q :=
begin
  sorry,
end

/-  # There is no special `implies` symbol in Lean

As we have just seen we don't have a different symbol for `implies` we just reuse `→`
that was introduced earlier for functions.

So if `(A B : Type)` and `(P Q : Prop)` what is the difference between
 `f : A → B` and `hpq : P → Q` ?

`f` is a function mapping terms of type `A` to terms of type `B`, while `hpq` is a
function mapping terms of type `P` to terms of type `Q`.

The crucial difference is that `A` and `B` have type `Type` while `P` and `Q` have
type `Prop`

Interpreting a term of type `P` as a proof of `P` then we can think of `hpq : P → Q` as
a function mapping proofs of P to proofs of Q. -/

-- 15
example : P → Q → P :=
begin
  sorry
end

-- 16
example : P → (P → Q) → (Q → R) → R :=
begin
  sorry,
end

-- 17
example  : (P → Q → R) → (Q → R → P) → (R → Q → P) :=
begin
  sorry,
end

/-
# New tactic: rw

# rw
rw is short for rewrite, it allows us to rewrite using equations and equivalences.

For example if we have `h : a = b` and our goal is `⊢ a + c = b + c` then `rw h` will replace
`a` by `b` in the goal so it becomes `⊢ b + c = b + c`  (which we can then close with `refl`)

We can tell `rw` to do the rewrite on a term in our local context.
For example if we have `h1 : a = b` and `h2 : a = c` we can use `rw h1 at h2` to convert h2
into `h2 : b = c`

rw works from left to right, so given `h : a = b`, `rw h` will replace each `a` in the goal by `b`.
If we want to instead replace each `b` by `a` we can use `rw ← h` to rewrite from right to left.  -/

-- 18 We can do this be rewriting
example (h1 : a = b) (h2 : b = c) (h3: c = d) : a = d:=
begin
  rw h1,
  sorry,
end

-- 19 We start with a rewrite in the local context
example (h1 : a = b) (h2 : b = c) (h3: c = d) : a = d :=
begin
  rw h2 at h1,
  sorry,
end

-- 20 We can start by rewriting from right to left using `hqr : Q ↔ R`
example  (hpq : P ↔ Q) (hqr : Q ↔ R) : P ↔ R:=
begin
  rw ← hqr,
  sorry,
end

-- 21
example  (f g : A → B) (hfg : injective f ↔ injective g) (hg : ∀ (x y: A), g x = g y → x = y)  : injective f:=
begin
  sorry,
end

-- 22 -- symmetry may be useful here..
example (f: A → ℕ) (x y : A) (hf : f x = f y → x = y)
(hfx: f x = n) (hfy: f y = m) (heq: m = n) : x = y:=
begin
  sorry,
end


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura
-/
prelude
import init.logic

notation `ℕ` := nat

namespace nat

inductive less_than_or_equal (a : ℕ) : ℕ → Prop
| refl : less_than_or_equal a
| step : Π {b}, less_than_or_equal b → less_than_or_equal (succ b)

instance : has_le ℕ :=
⟨nat.less_than_or_equal⟩

@[reducible] protected def le (n m : ℕ) := nat.less_than_or_equal n m
@[reducible] protected def lt (n m : ℕ) := nat.less_than_or_equal (succ n) m

instance : has_lt ℕ :=
⟨nat.lt⟩

def pred : ℕ → ℕ
| 0     := 0
| (a+1) := a

protected def sub : ℕ → ℕ → ℕ
| a 0     := a
| a (b+1) := pred (sub a b)

protected def mul : nat → nat → nat
| a 0     := 0
| a (b+1) := (mul a b) + a

instance : has_sub ℕ :=
⟨nat.sub⟩

instance : has_mul ℕ :=
⟨nat.mul⟩

-- defeq to the instance provided by comm_semiring
instance : has_dvd ℕ :=
has_dvd.mk (λ a b, ∃ c, b = a * c)

instance : decidable_eq ℕ
| zero     zero     := is_true rfl
| (succ x) zero     := is_false (λ h, nat.no_confusion h)
| zero     (succ y) := is_false (λ h, nat.no_confusion h)
| (succ x) (succ y) :=
    match decidable_eq x y with
    | is_true xeqy := is_true (xeqy ▸ eq.refl (succ x))
    | is_false xney := is_false (λ h, nat.no_confusion h (λ xeqy, absurd xeqy xney))
    end

def {u} repeat {α : Type u} (f : ℕ → α → α) : ℕ → α → α
| 0         a := a
| (succ n)  a := f n (repeat n a)

instance : inhabited ℕ :=
⟨nat.zero⟩

@[simp] lemma nat_zero_eq_zero : nat.zero = 0 :=
rfl

/- properties of inequality -/
/-* For any natural number $a$, $a \leq a$. *-/
@[refl] protected lemma le_refl (a : ℕ) : a ≤ a :=
less_than_or_equal.refl

/-* For any natural number $n$, it is lower or equal to its succession. *-/
lemma le_succ (n : ℕ) : n ≤ succ n :=
less_than_or_equal.step (nat.le_refl n)

/-* Let $n, m$ be two natural numbers, then the succession of $n$ is lower or equal to the succession of $m$. *-/
lemma succ_le_succ {n m : ℕ} : n ≤ m → succ n ≤ succ m :=
λ h, less_than_or_equal.rec (nat.le_refl (succ n)) (λ a b, less_than_or_equal.step) h

/-* If $n$ is a natural number, then $0 \leq n$. *-/
protected lemma zero_le : ∀ (n : ℕ), 0 ≤ n
| 0     := nat.le_refl 0
| (n+1) := less_than_or_equal.step (zero_le n)

/-* If $n$ is a natural number, then 0 is lower than the succession of $n$. *-/

lemma succ_pos (n : ℕ) : 0 < succ n := zero_lt_succ n

lemma not_succ_le_zero : ∀ (n : ℕ), succ n ≤ 0 → false
.

protected lemma not_lt_zero (a : ℕ) : ¬ a < 0 := not_succ_le_zero a

lemma pred_le_pred {n m : ℕ} : n ≤ m → pred n ≤ pred m :=
λ h, less_than_or_equal.rec_on h
  (nat.le_refl (pred n))
  (λ n, nat.rec (λ a b, b) (λ a b c, less_than_or_equal.step) n)

/-* Let $n, m$ be natural numbers, then that the succession of $n$ is lower or equal to the succession of $m$ implies $n \leq m$. *-/
lemma le_of_succ_le_succ {n m : ℕ} : succ n ≤ succ m → n ≤ m :=
pred_le_pred

instance decidable_le : ∀ a b : ℕ, decidable (a ≤ b)
| 0     b     := is_true b.zero_le
| (a+1) 0     := is_false (not_succ_le_zero a)
| (a+1) (b+1) :=
  match decidable_le a b with
  | is_true h  := is_true (succ_le_succ h)
  | is_false h := is_false (λ a, h (le_of_succ_le_succ a))
  end

instance decidable_lt : ∀ a b : ℕ, decidable (a < b) :=
λ a b, nat.decidable_le (succ a) b

/-* Let $a, b$ be two natural numbers, and $a \leq b$, then $a = b$ or $a < b$. *-/
protected lemma eq_or_lt_of_le {a b : ℕ} (h : a ≤ b) : a = b ∨ a < b :=
less_than_or_equal.cases_on h (or.inl rfl) (λ n h, or.inr (succ_le_succ h))

/-* Let $a, b$ be two natural numbers, then $a \leq b$ implies $a$ is lower than the succesion of $b$. *-/
lemma lt_succ_of_le {a b : ℕ} : a ≤ b → a < succ b :=
succ_le_succ

/-* Let $a, b$ be two natural numbers, then the subtraction of the successions of $a$ and $b$ equals to $a - b$. *-/
@[simp] lemma succ_sub_succ_eq_sub (a b : ℕ) : succ a - succ b = a - b :=
nat.rec_on b
  (show succ a - succ zero = a - zero, from (eq.refl (succ a - succ zero)))
  (λ b, congr_arg pred)

lemma not_succ_le_self : ∀ n : ℕ, ¬succ n ≤ n :=
λ n, nat.rec (not_succ_le_zero 0) (λ a b c, b (le_of_succ_le_succ c)) n

protected lemma lt_irrefl (n : ℕ) : ¬n < n :=
not_succ_le_self n

/-* Let $n, m, k$ be natural numbers, and $n \leq m$, then $m \leq k$ implies $n \leq k$. *-/
protected lemma le_trans {n m k : ℕ} (h1 : n ≤ m) : m ≤ k → n ≤ k :=
less_than_or_equal.rec h1 (λ p h2, less_than_or_equal.step)

lemma pred_le : ∀ (n : ℕ), pred n ≤ n
| 0        := less_than_or_equal.refl
| (succ a) := less_than_or_equal.step less_than_or_equal.refl

lemma pred_lt : ∀ {n : ℕ}, n ≠ 0 → pred n < n
| 0        h := absurd rfl h
| (succ a) h := lt_succ_of_le less_than_or_equal.refl

/-* Let $a, b$ be natural numbers, then $a - b \leq b$. *-/
protected lemma sub_le (a b : ℕ) : a - b ≤ a :=
nat.rec_on b (nat.le_refl (a - 0)) (λ b₁, nat.le_trans (pred_le (a - b₁)))

/-* Let $a, b$ be natural numbers, then $0 < a$ and $0 < b$ imply $a - b < a$. *-/
protected lemma sub_lt : ∀ {a b : ℕ}, 0 < a → 0 < b → a - b < a
| 0     b     h1 h2 := absurd h1 (nat.lt_irrefl 0)
| (a+1) 0     h1 h2 := absurd h2 (nat.lt_irrefl 0)
| (a+1) (b+1) h1 h2 :=
  eq.symm (succ_sub_succ_eq_sub a b) ▸
    show a - b < succ a, from
    lt_succ_of_le (a.sub_le b)

/-* Let $n, m, k$ be naturla numbers, then $n < m$ and $m \leq k$ imply $n < k$. *-/
protected lemma lt_of_lt_of_le {n m k : ℕ} : n < m → m ≤ k → n < k :=
nat.le_trans

/- Basic nat.add lemmas -/
protected lemma zero_add : ∀ n : ℕ, 0 + n = n
| 0     := rfl
| (n+1) := congr_arg succ (zero_add n)

/-* Let $n, m$ be natural numbers, then the succession of $n$ plus $m$ equals to the succession of $(n + m)$. *-/
lemma succ_add : ∀ n m : ℕ, (succ n) + m = succ (n + m)
| n 0     := rfl
| n (m+1) := congr_arg succ (succ_add n m)

/-* Let $n, m$ be natural numbers, then $n$ plus the succession of $m$ equals to the succession of $(n + m)$. *-/
lemma add_succ (n m : ℕ) : n + succ m = succ (n + m) :=
rfl

protected lemma add_zero (n : ℕ) : n + 0 = n :=
rfl

/-* Let $n$ be a natural number, then $n + 1$ equals to its succession. *-/
lemma add_one (n : ℕ) : n + 1 = succ n :=
rfl

/-* Let $n$ be a natural number, then the succesion of $n$ equals to $n + 1$. *-/
lemma succ_eq_add_one (n : ℕ) : succ n = n + 1 :=
rfl

/- Basic lemmas for comparing numerals -/

protected lemma bit0_succ_eq (n : ℕ) : bit0 (succ n) = succ (succ (bit0 n)) :=
show succ (succ n + n) = succ (succ (n + n)), from
congr_arg succ (succ_add n n)

protected lemma zero_lt_bit0 : ∀ {n : nat}, n ≠ 0 → 0 < bit0 n
| 0        h := absurd rfl h
| (succ n) h :=
  calc 0 < succ (succ (bit0 n)) : zero_lt_succ _
     ... = bit0 (succ n)        : (nat.bit0_succ_eq n).symm

protected lemma zero_lt_bit1 (n : nat) : 0 < bit1 n :=
zero_lt_succ _

protected lemma bit0_ne_zero : ∀ {n : ℕ}, n ≠ 0 → bit0 n ≠ 0
| 0     h := absurd rfl h
| (n+1) h :=
  suffices (n+1) + (n+1) ≠ 0, from this,
  suffices succ ((n+1) + n) ≠ 0, from this,
  λ h, nat.no_confusion h

protected lemma bit1_ne_zero (n : ℕ) : bit1 n ≠ 0 :=
show succ (n + n) ≠ 0, from
λ h, nat.no_confusion h

end nat


import SciLean
import SciLean.Tactic.ConvIf
open SciLean

/-!

==============
Approximations
==============

Scientific computing is full of approximations. SciLean attempts to provide
tools to manage these approximations and easity swap between them.

As a starting example we will look into computing the square root function.
Looking at wikipedia there are two basic methods: Babylonian_  and Bakhshali_.

.. _Babylonian: https://en.wikipedia.org/wiki/Methods_of_computing_square_roots#Babylonian_method
.. _Bakhshali: https://en.wikipedia.org/wiki/Methods_of_computing_square_roots#Bakhshali_method

The Babylonian method computes :math:`\sqrt{y}` from an initial guess :math:`x_0`
with an iterative process

.. math:: x_{n+1} = \frac{x_n + \frac{y}{x_n}}{2}

In code

-/

def sqrtBabylonian (n : Nat) (x₀ : ℝ) (y : ℝ) : ℝ :=
match n with
| 0   => x₀
| n+1 => sqrtBabylonian n ((x₀ + y/x₀)/2) y

/-!

The Bakhshali method computes :math:`\sqrt{y}` from an initial guess :math:`x_0`
with an iterative process

.. raw:: html

  \begin{align}
    a_n &= \frac{y - x_n^2}{2 x_n} \\
    b_n &= x_n + a_n \\
    x_{n+1} &= b_n - \frac{a_n^2}{2b_n}
  \end{align}

In code

-/

def sqrtBakhshali (n : Nat) (x₀ : ℝ) (y : ℝ) : ℝ :=
  match n with
  | 0 => x₀
  | n+1 =>
    let aₙ := (y - x₀*x₀)/(2*x₀)
    let bₙ := x₀ + aₙ
    let x₁ := bₙ - aₙ*aₙ/(2*bₙ)
    sqrtBakhshali n x₁ y

/-!
Let's test it out to compute :math:`\sqrt{2} = 1.41421356237\dots`
-/
#eval sqrtBabylonian 2 1 2 -- 1.416667
#eval sqrtBakhshali 2 1 2  -- 1.414214

/-!

Already at two steps Bakhshali method computes :math:`\sqrt{2}` correctly to
all the digits that are displayed.

Sqrt Specification
------------------

Because Lean is a proof assistant it allows us to define the square root
function precisely. The downside is that such function will be noncomputable.
This might sound completely pointless, how it is useful to define a function
that we can not run? The advantage is that we can disentangle the program
specification from its implementation.

The square root function is defined in mathlib_, we do not provide the
full definition here just

.. _mathlib: https://leanprover-community.github.io/mathlib_docs/data/real/sqrt.html#real.sqrt

 -/
noncomputable
def real.sqrt (x : ℝ) : ℝ := sorry
  --Possible noncomputable definition
  -- if x > 0 then
  --   inf { y // x < y * y }     -- infimum of a set is noncomputable
  -- else
  --   0

/-!

(TODO: Note somewhere that we assume that we have reals with computable + - * / <
  This either opens up a can of worms about consistency or floating point arithmetics.
  And I do not want to get into that right now ...)

The `real.sqrt` function satisfies two main properties. The first one,
called `real.mul_self_sqrt`_, for non-negative :math:`x` we have
:math:`\sqrt{x} \sqrt{x} = x`. The second one, called `real.sqrt_eq_zero_of_nonpos`_,
for negative :math:`x` the :math:`\sqrt{x}` is defined to be zero. In math class
square root of negative number is usually not defined, however in type theory
this does not work so well. This is similar to division by zero, in
Lean we have `1/0 = 0`, you can read about this more on Kevin Buzzard's page_.

.. _page: https://xenaproject.wordpress.com/2020/07/05/division-by-zero-in-type-theory-a-faq/

.. _`real.sqrt_eq_zero_of_nonpos`: https://leanprover-community.github.io/mathlib_docs/data/real/sqrt.html#real.sqrt_eq_zero_of_nonpos

.. _`real.mul_self_sqrt`:  https://leanprover-community.github.io/mathlib_docs/data/real/sqrt.html#real.mul_self_sqrt

 -/

theorem real.mul_self_sqrt {x : ℝ} (h : 0 ≤ x)
  : real.sqrt x * real.sqrt x = x := sorry

@[simp]
theorem real.sqrt_eq_zero_of_nonpos {x : ℝ} (h : ¬(0 ≤ x))
  : real.sqrt x = 0 := sorry

/-!

In particular, we can proof that the Babylonian and Bakhshali method
converge to the square root. Again we omit the proofs here again, but
it is well in the capability of Lean and mathlib to do so.

 -/

theorem sqrtBabylonian.limit {x : ℝ} (y₀ : ℝ) (hy : y₀ ≥ 0) (hx : 0 ≤ x)
  : real.sqrt x = limit λ n => sqrtBabylonian n y₀ x := sorry

theorem sqrtBakhshali.limit {x : ℝ} (y₀ : ℝ) (hy : y₀ ≥ 0) (hx : 0 ≤ x)
  : real.sqrt y = limit λ n => sqrtBakhshali n x₀ y := sorry

/-!

To build an approximation, we state `approx sqrtApprox := real.sqrt` followed
by instructions how to construct such approximation. The type of `sqrtApprox` is
`Approx real.sqrt`, which is an object holding couple of useful informations
about the approximation:

  1. Parameters to controll the accuracy of the approximation.
  2. Options to switch between different approximations.
  3. Under what conditions this approximation is actually valid.

Here is the Lean code to generate the approximation
 -/

approx sqrtApprox := real.sqrt
by
  conv =>
    trace_state
    enter [1] -- Step into `Approx ...`
    enter [x] -- introduce the argument `x`

    if h : 0 ≤ x then
      -- For positive `x` we apply the Babylonian method
      rw [sqrtBabylonian.limit (x/2) (sorry) h]
    else
      -- For negative `x` we know the result is zero
      rw [real.sqrt_eq_zero_of_nonpos h]

  -- We pick 4 steps as default
  approx_limit 4; intro n

/-!

(TODO: Add parameter to switch between Babylonian and Bakhshali.)

To get the value of an approximation we need to call `.val!`

 -/

#eval sqrtApprox.val 2


-- Teorema_de_Cantor.lean
-- Teorema de Cantor.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 6-mayo-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar el teorema de Cantor:
--    ∀ f : α → set α, ¬ surjective f
-- ----------------------------------------------------------------------

import data.set.basic
open function

variables {α : Type}

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

example : ∀ f : α → set α, ¬ surjective f :=
begin
  intros f hf,
  let S := {i | i ∉ f i},
  cases hf S with j hj,
  by_cases jS : j ∈ S,
  { apply jS,
    rwa hj, },
  { apply jS,
    rwa ← hj at jS, },
end

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

example : ∀ f : α → set α, ¬ surjective f :=
cantor_surjective


/- LoVe Exercise 2: Tactical Proofs -/

import .love02_tactical_proofs_demo

namespace LoVe

/- Question 1: Connectives and Quantifiers -/

/- 1.1. Carry out the following proofs using basic tactics. -/

lemma I (a : Prop) :
  a → a :=
begin
  intro ha,
  exact ha
end

lemma K (a b : Prop) :
  a → b → b :=
begin
  intros ha hb,
  exact hb
end

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
begin
  intros hg hb ha,
  apply hg,
  exact ha,
  exact hb
end

lemma proj_1st (a : Prop) :
  a → a → a :=
begin
  intros ha ha',
  exact ha
end

-- please give a different answer than for `proj_1st`
lemma proj_2nd (a : Prop) :
  a → a → a :=
begin
  intros ha ha',
  exact ha'
end

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
begin
  intros hg ha hf hb,
  apply hg,
  exact ha,
  exact hb
end

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

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
begin
  intros hab hnb ha,
  apply hnb,
  apply hab,
  apply ha
end

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

lemma forall_and {α : Type} (p q : α → Prop) :
  (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
begin
  apply iff.intro,
  { intro h,
    apply and.intro,
    { intro x,
      apply and.elim_left,
      apply h },
    { intro x,
      apply and.elim_right,
      apply h } },
  { intros h x,
    apply and.intro,
    { apply and.elim_left h },
    { apply and.elim_right h } }
end

/- Question 2: Natural Numbers -/

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

#check mul

lemma mul_zero (n : ℕ) :
  mul 0 n = 0 :=
begin
  induction n,
  { refl },
  { simp [add, mul, n_ih] }
end

lemma mul_succ (m n : ℕ) :
  mul (nat.succ m) n = add (mul m n) n :=
begin
  induction n,
  { refl },
  { simp [add, add_succ, add_assoc, mul, n_ih] }
end

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

lemma mul_comm (m n : ℕ) :
  mul m n = mul n m :=
begin
  induction m,
  { simp [mul, mul_zero] },
  { simp [mul, mul_succ, m_ih], ac_refl }
end

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
begin
  induction n,
  { refl },
  { simp [mul, mul_add, n_ih] }
end

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

lemma add_mul (l m n : ℕ) :
  mul (add l m) n = add (mul n l) (mul n m) :=
begin
  rw mul_comm _ n,
  rw mul_add
end

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

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

def excluded_middle := ∀a : Prop, a ∨ ¬ a
def peirce := ∀a b : Prop, ((a → b) → a) → a
def double_negation := ∀a : Prop, ¬¬ a → a

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

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

Hint: You will need `or.elim` and `false.elim`. -/

lemma peirce_of_em :
  excluded_middle → peirce :=
begin
  simp [excluded_middle, peirce],
  dunfold not,
  intro hem,
  intros a b haba,
  apply or.elim (hem a),
  { intro,
    assumption },
  { intro hna,
    apply haba,
    intro ha,
    apply false.elim,
    apply hna,
    assumption }
end

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

Hint: Try instantiating `b` with `false` in Peirce's law. -/

lemma dn_of_peirce :
  peirce → double_negation :=
begin
  simp [peirce, double_negation],
  intros hpeirce a hnna,
  apply hpeirce a false,
  intro hna,
  apply false.elim,
  apply hnna,
  exact hna
end

/- We leave the missing implication for the homework: -/

namespace sorry_lemmas

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

end sorry_lemmas

end LoVe


-- ---------------------------------------------------------------------
-- Ejercicio 1. Realizar las siguientes acciones:
-- 1. Importar la teoría Definicion_de_funciones_acotadas
-- 2. Declarar f y g como variables de funciones de ℝ en ℝ.
-- 3. Declarar a y b como variables sobre ℝ.
-- ----------------------------------------------------------------------

import .Definicion_de_funciones_acotadas -- 1

variables {f g : ℝ → ℝ}                  -- 2
variables {a b : ℝ}                      -- 3

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que si a es una cota superior de f y b lo es
-- de g, entonces a + b lo es de f + g.
-- ----------------------------------------------------------------------

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

example
  (hfa : fn_ub f a)
  (hgb : fn_ub g b)
  : fn_ub (f + g) (a + b) :=
begin
  assume x : ℝ,
  have h1 : f x ≤ a := hfa x,
  have h2 : g x ≤ b := hgb x,
  calc (f + g) x
       = f x + g x : rfl
   ... ≤ a + b     : add_le_add h1 h2
end

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

example
  (hfa : fn_ub f a)
  (hgb : fn_ub g b)
  : fn_ub (f + g) (a + b) :=
begin
  intro x,
  change f x + g x ≤ a + b,
  apply add_le_add,
  apply hfa,
  apply hgb
end

-- Su desarrollo es
--
-- f g : ℝ → ℝ,
-- a b : ℝ,
-- hfa : fn_ub f a,
-- hgb : fn_ub g b
-- ⊢ fn_ub (λ (x : ℝ), f x + g x) (a + b)
--    >> intro x,
-- x : ℝ
-- ⊢ (λ (x : ℝ), f x + g x) x ≤ a + b
--    >> change f x + g x ≤ a + b,
-- ⊢ f x + g x ≤ a + b
--    >> apply add_le_add,
-- | ⊢ f x ≤ a
-- |    >> apply hfa,
-- | ⊢ g x ≤ b
-- |    >> apply hgb
-- no goals

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

theorem fn_ub_add
  (hfa : fn_ub f a)
  (hgb : fn_ub g b)
  : fn_ub (f + g) (a + b) :=
λ x, add_le_add (hfa x) (hgb x)

-- ---------------------------------------------------------------------
-- Ejercicio 3. Demostrar que la suma de dos funciones acotadas
-- superiormente también lo está.
-- ----------------------------------------------------------------------

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

example
  (ubf : fn_has_ub f)
  (ubg : fn_has_ub g)
  : fn_has_ub (f + g) :=
begin
  cases ubf with a ha,
  have h1 : ∀ x, f x ≤ a := ha,
  cases ubg with b hb,
  have h2 : ∀ x, g x ≤ b := hb,
  have h3 : ∀ x, (f + g) x ≤ a + b :=
    λ x, add_le_add (h1 x) (h2 x),
  have h4 : ∃ z, ∀ x, (f + g) x ≤ z,
    by exact Exists.intro (a + b) h3,
  show fn_has_ub (f + g),
    by exact h4,
end

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

example
  (ubf : fn_has_ub f)
  (ubg : fn_has_ub g)
  : fn_has_ub (f + g) :=
begin
  cases ubf with a ubfa,
  cases ubg with b ubfb,
  use a + b,
  apply fn_ub_add ubfa ubfb,
end

-- Su desarrollo es
--
-- f g : ℝ → ℝ,
-- ubf : fn_has_ub f,
-- ubg : fn_has_ub g
-- ⊢ fn_has_ub (λ (x : ℝ), f x + g x)
--    >> cases ubf with a ubfa,
-- f g : ℝ → ℝ,
-- ubg : fn_has_ub g,
-- a : ℝ,
-- ubfa : fn_ub f a
-- ⊢ fn_has_ub (λ (x : ℝ), f x + g x)
--    >> cases ubg with b ubfb,
-- f g : ℝ → ℝ,
-- a : ℝ,
-- ubfa : fn_ub f a,
-- b : ℝ,
-- ubfb : fn_ub g b
-- ⊢ fn_has_ub (λ (x : ℝ), f x + g x)
--    >> use a + b,
-- ⊢ fn_ub (λ (x : ℝ), f x + g x) (a + b)
--    >> apply fn_ub_add ubfa ubfb
-- no goals

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

example
  (ubf : fn_has_ub f)
  (ubg : fn_has_ub g)
  : fn_has_ub (f + g) :=
begin
  rcases ubf with ⟨a, ubfa⟩,
  rcases ubg with ⟨b, ubfb⟩,
  exact ⟨a + b, fn_ub_add ubfa ubfb⟩
end

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

example :
  fn_has_ub f → fn_has_ub g → fn_has_ub (f + g) :=
begin
  rintros ⟨a, ubfa⟩ ⟨b, ubfb⟩,
  exact ⟨a + b, fn_ub_add ubfa ubfb⟩,
end

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

example :
  fn_has_ub f → fn_has_ub g → fn_has_ub (f + g) :=
λ ⟨a, ubfa⟩ ⟨b, ubfb⟩, ⟨a + b, fn_ub_add ubfa ubfb⟩


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro hp,
  intro hpn,
  apply hpn,
  assumption,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro hnp,
  by_contra hboom, --como usar o (RAA)
  apply hnp,
  assumption,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  -- separando a conjunção
  intro hnp,
  by_contra hboom,
  apply hnp,
  assumption,
  -- organizando cada uma das demonstrações separadamente
  intro hp,
  intro hpn,
  apply hpn,
  assumption,
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro p_q,
  cases p_q,
  -- Caso P
  right,
  assumption,
  -- Caso Q
  left,
  assumption,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro peq,
  cases peq,
  split,
  -- Demonstre Q
  assumption,
  -- Demonstre P
  assumption,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro Hp_q,
  intro Hp,
  cases Hp_q,
  -- Caso ¬P
  have Hboom : false := Hp_q Hp,
  contradiction,

  -- Caso Q
  assumption,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro Hp_q,
  intro Np,
  cases Hp_q,
  -- Caso P
  have Hp : false := Np Hp_q,
  contradiction,

  -- Caso Q
  assumption,
end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro Hpq,
  intro Nq,
  intro Hp,
  have Hq : Q := Hpq Hp,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro HNqp,
  intro Hp,
  by_contra Hboom,
  have HNp : ¬P := HNqp Hboom,
  contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  -- Demonstrar Right
  intro Hpq,
  intro Nq,
  intro Hp,
  have Hq : Q := Hpq Hp,
  contradiction,

  -- Demonstrar Left
  intro HNqp,
  intro Hp,
  by_contra Hboom,
  have HNp : ¬P := HNqp Hboom,
  contradiction,
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro NT,
  have p_or_p : P ∨ ¬P,
  right,
  intro Hp,
  apply NT,
  left,
  assumption,
  apply NT,
  assumption,
end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro Hpqp,
  intro HNp,
  apply HNp,
  have Hpq: P → Q,
  intro Hp,
  contradiction,
  apply Hpqp,
  assumption,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro Hp_or_q,
  intro Hnot_p_and_q,
  cases Hnot_p_and_q,
  cases Hp_or_q,
  -- Caso P
  have Hp : false := Hnot_p_and_q_left Hp_or_q,
  assumption,
  -- Caso Q
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro Hp_and_q,
  intro HNp_or_q,
  cases Hp_and_q,
  cases HNp_or_q,
  -- Caso ¬P
  contradiction,
  -- Caso ¬Q
  have Hp : false := HNp_or_q Hp_and_q_right,
  assumption,
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro HNp_or_q,
  split,
  -- Demonstre ¬P
  intro Hp,
  have p_or_q : P ∨ Q,
  left,
  assumption,
  have Np_or_q : false := HNp_or_q p_or_q,
  assumption,

  -- Demonstre ¬Q
  intro Hq,
  have p_or_q : P ∨ Q,
  right,
  assumption,
  apply HNp_or_q,
  assumption,

  -- Duas formas diferente de fechar essa demonstração, também poderia ser usado o contradiction
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro Hnp_and_nq,
  intro Hp_or_q,
  cases Hnp_and_nq,
  cases Hp_or_q,
  -- Caso P
  apply Hnp_and_nq_left,
  assumption,
  -- Caso Q
  have Hboom : false := Hnp_and_nq_right Hp_or_q,
  assumption,

  -- Também com duas formas de fechar além do contradiction
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro HNp_and_q,
  by_cases Hp : P,
  -- Caso P
  left, -- Demonstre ¬Q
  intro Hq,
  apply HNp_and_q,
  split,
  -- Demonstre P
  assumption,
  -- Demonstre Q
  assumption,

  -- Caso ¬P
  right,
  assumption,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro Hnq_or_np,
  intro Hp_and_q,
  cases Hp_and_q,
  cases Hnq_or_np,
  -- Caso ¬Q
  apply Hnq_or_np,
  assumption,

  -- Caso ¬P
  have hboom : false := Hnq_or_np Hp_and_q_left,
  assumption,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  intro HNp_and_q,
  by_cases Hp : P,
  -- Caso P
  left, -- Demonstre ¬Q
  intro Hq,
  apply HNp_and_q,
  split,
  -- Demonstre P
  assumption,
  -- Demonstre Q
  assumption,

  -- Caso ¬P
  right,
  assumption,

  intro Hnq_or_np,
  intro Hp_and_q,
  cases Hp_and_q,
  cases Hnq_or_np,
  -- Caso ¬Q
  apply Hnq_or_np,
  assumption,

  -- Caso ¬P
  have hboom : false := Hnq_or_np Hp_and_q_left,
  assumption,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,

  intro HNp_or_q,
  split,
  -- Demonstre ¬P
  intro Hp,
  have p_or_q : P ∨ Q,
  left,
  assumption,
  have Np_or_q : false := HNp_or_q p_or_q,
  assumption,

  -- Demonstre ¬Q
  intro Hq,
  have p_or_q : P ∨ Q,
  right,
  assumption,
  apply HNp_or_q,
  assumption,

  intro Hnp_and_nq,
  intro Hp_or_q,
  cases Hnp_and_nq,
  cases Hp_or_q,
  -- Caso P
  apply Hnp_and_nq_left,
  assumption,
  -- Caso Q
  have Hboom : false := Hnp_and_nq_right Hp_or_q,
  assumption,
end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro Hp_and__q_or_r,
  cases Hp_and__q_or_r,
  cases Hp_and__q_or_r_right,
  -- Caso Q
  left,
  split,
  assumption,
  assumption,
  -- Caso R
  right,
  split,
  assumption,
  assumption,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro Hand_or_and,
  split,
  -- Demonstre P
  cases Hand_or_and,

  -- Caso P ∧ Q
  cases Hand_or_and,
  assumption,

  -- Caso P ∧ R
  cases Hand_or_and,
  assumption,

  -- Demonstre Q ∨ R
  cases Hand_or_and,
  -- Caso P ∧ Q
  cases Hand_or_and,
  left,
  assumption,

  -- Caso P ∧ R
  cases Hand_or_and,
  right,
  assumption,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro HP_or_and,
  split,
  -- Demonstre P ∨ Q
  cases HP_or_and,
  -- Caso P
  left,
  assumption,
  -- Caso Q ∧ R
  cases HP_or_and,
  right,
  assumption,

  -- Demonstre P ∨ R
  cases HP_or_and,
  -- Caso P
  left,
  assumption,
  -- Caso Q ∧ R
  cases HP_or_and,
  right,
  assumption,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro Hor_and_or,
  cases Hor_and_or,
  cases Hor_and_or_left,
  -- Caso P
  left,
  assumption,
  -- Caso Q
  cases Hor_and_or_right,
    -- Caso P
    left,
    assumption,
  right,
  split,
  -- Demonstre Q
  assumption,
  -- Demonstre R
  assumption,
end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro Hp_and_q_imp_r,
  intro Hp,
  intro Hq,
  apply Hp_and_q_imp_r,
  split,
  -- Demonstre P
  assumption,
  -- Demonstre Q
  assumption,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro Hp_imp_q_imp_r,
  intro Hp_and_q,
  cases Hp_and_q,
  apply Hp_imp_q_imp_r,
  assumption,
  assumption,
end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro Hp,
  assumption,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro Hp,
  left,
  assumption,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro Hq,
  right,
  assumption,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro Hp_and_q,
  cases Hp_and_q,
  assumption,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro Hp_and_q,
  cases Hp_and_q,
  assumption,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro p_and_p,
  cases p_and_p,
  assumption,

  intro Hp,
  split,
  assumption,
  assumption,
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro Hp_or_p,
  cases Hp_or_p,
  assumption,
  assumption,

  intro Hp,
  right,
  assumption,
end

end propositional

----------------------------------------------------------------

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intro Hn_exist_P,
  intro x,
  intro Hnp,
  apply Hn_exist_P,
  existsi x,
  assumption,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro H_all_np,
  intro H_exist_P,
  cases H_exist_P with u hu,
  apply H_all_np u,
  assumption,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro Hn_all_p,
  by_contradiction H_exist_nP,
  exfalso,
  apply Hn_all_p,
  intro u,
  by_contradiction HnP,
  apply H_exist_nP,
  existsi u,
  assumption,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro H_exist_nP,
  cases H_exist_nP with u HnP,
  intro H_all_P,
  have Hu := H_all_P u,
  apply HnP,
  assumption,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  intro Hn_all_p,
  by_contradiction H_exist_nP,
  exfalso,
  apply Hn_all_p,
  intro u,
  by_contradiction HnP,
  apply H_exist_nP,
  existsi u,
  assumption,

  intro H_exist_nP,
  cases H_exist_nP with u HnP,
  intro H_all_P,
  have Hu := H_all_P u,
  apply HnP,
  assumption,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  intro Hn_exist_P,
  intro x,
  intro Hnp,
  apply Hn_exist_P,
  existsi x,
  assumption,

  intro H_all_np,
  intro H_exist_P,
  cases H_exist_P with u hu,
  apply H_all_np u,
  assumption,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro H_exist_P,
  cases H_exist_P with u HP,
  intro H_all_nP,
  have Hu := H_all_nP u,
  apply Hu,
  assumption,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro H_all_P,
  intro H_exist_nP,
  cases H_exist_nP with u HP,
  have Hu := H_all_P u,
  contradiction,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro Hn_exist_nP,
  intro u,
  by_contradiction Hboom,
  apply Hn_exist_nP,
  existsi u,
  assumption,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro Hn_forall_nP,
  by_contradiction Hboom,
  apply Hn_forall_nP,
  intro u,
  intro Hu,
  apply Hboom,
  existsi u,
  assumption,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  intro H_all_P,
  intro H_exist_nP,
  cases H_exist_nP with u HP,
  have Hu := H_all_P u,
  contradiction,

   intro Hn_exist_nP,
  intro u,
  by_contradiction Hboom,
  apply Hn_exist_nP,
  existsi u,
  assumption,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  intro H_exist_P,
  cases H_exist_P with u HP,
  intro H_all_nP,
  have Hu := H_all_nP u,
  apply Hu,
  assumption,

  intro Hn_forall_nP,
  by_contradiction Hboom,
  apply Hn_forall_nP,
  intro u,
  intro Hu,
  apply Hboom,
  existsi u,
  assumption,
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro H_exist_p_and_q,

end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  sorry,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  sorry,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  sorry,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  sorry,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  sorry,
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate


/-
Give a natural deduction proof of ¬𝐴∨𝐵 from 𝐴→𝐵.
You may use the law of the excluded middle.
-/

open classical

variables (A B: Prop)

example (h: A → B) : ¬ A ∨ B :=
  or.elim(em(A))(
    λ hA: A,
    have hB: B, from h(hA),
    show ¬ A ∨ B, from or.inr(hB)
  )(
    λ hnA: ¬ A,
    show ¬ A ∨ B, from or.inl(hnA)
  )


#exit -- remove this to runq
namespace xena

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

open xnat

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

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

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

theorem add_assoc (a b c : xnat) : (a + b) + c = a + (b + c) :=
begin
admit
end

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

theorem zero_add (n : xnat) : zero + n = n :=
begin
admit
end

#check zero_add
#check add_zero

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

theorem one_add_eq_succ (n : xnat) : one + n = succ n :=
begin
admit
end

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

theorem add_comm (a b : xnat) : a + b = b + a :=
begin
admit
end

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

notation a * b := mul a b

example : one * one = one :=
begin
refl
end

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

theorem zero_mul (a : xnat) : zero * a = zero := sorry

theorem mul_one (a : xnat) : a * (succ zero) = a := sorry

theorem one_mul (a : xnat) : (succ zero) * a = a := sorry

theorem right_distrib (a b c : xnat) : a * (b + c) = a* b + a * c := sorry

theorem left_distrib (a b c : xnat) : (a + b) * c = a * c + b * c := sorry

theorem mul_assoc (a b c : xnat) : (a * b) * c = a * (b * c) := sorry

theorem mul_comm (a b : xnat) : a * b = b * a := sorry

definition lt : xnat → xnat → Prop -- less than
| zero zero := false
| (succ m) zero := false
| zero (succ p) := true
| (succ m) (succ p) := lt m p

notation a < b := lt a b
notation b > a := lt a b

theorem add_succ_equals_succ (a b : xnat) : a + (succ b) = succ (a + b) := sorry

theorem inequality_A1 (a b t : xnat) : a < b → a + t < b + t := sorry

theorem inequality_A2 (a b c : xnat) : a < b → b < c → a < c := sorry

theorem inequality_A3 (a b : xnat) : (a < b ∨ a = b ∨ b < a)
                                   ∧ (a < b → ¬ (a = b))
                                   ∧ (a < b → ¬ (b < a))
                                   ∧ (a = b → ¬ (b < a)) := sorry

theorem inequality_A4 (a b : xnat) : a > zero → b > zero  → (a*b) > zero := sorry

end xena


import data.real.basic
import tactic.ring

structure complex : Type := (re : ℝ) (im : ℝ)

notation `ℂ` := complex

def z : ℂ := ⟨5,6⟩

namespace complex

theorem ext (z w : ℂ) : z.re = w.re ∧ z.im = w.im → z = w := begin
    cases z,
    cases w,
    intros,
    simp * at *
end

instance : has_coe ℝ ℂ := ⟨λ x, {re := x, im := 0}⟩

def I : ℂ := ⟨0, 1⟩

def add : ℂ → ℂ → ℂ := λ z w, {re := z.re + w.re, im := z.im + w.im}

instance : has_add ℂ := ⟨complex.add⟩

@[simp] theorem add_re : ∀ z w : ℂ, (z + w).re = z.re + w.re := λ z w, rfl
@[simp] theorem add_im : ∀ z w : ℂ, (z + w).im = z.im + w.im := λ z w, rfl

theorem add_comm : ∀ z w : ℂ, z + w = w + z := begin
    intros,
    apply ext,
    split; simp
end

theorem add_assoc : ∀ a b c : ℂ, a + (b + c) = (a + b) + c := begin
    intros,
    apply ext,
    split; simp
end

def neg : ℂ → ℂ := λ z, ⟨-z.re,z.im⟩

instance : has_neg ℂ := ⟨complex.neg⟩

@[simp] theorem neg_re (z : ℂ) : (-z).re = -z.re := _
@[simp] theorem neg_im (z : ℂ) : (-z).im = -z.im := rfl

end complex


/-
Copyright (c) 2022 Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Junyan Xu
-/
import data.multiset.basic
import order.well_founded

/-!
# Termination of a hydra game

This file deals with the following version of the hydra game: each head of the hydra is
labelled by an element in a type `α`, and when you cut off one head with label `a`, it
grows back an arbitrary but finite number of heads, all labelled by elements smaller than
`a` with respect to a well-founded relation `r` on `α`. We show that no matter how (in
what order) you choose cut off the heads, the game always terminates, i.e. all heads will
eventually be cut off (but of course it can last arbitrarily long, i.e. takes an
arbitrary finite number of steps).

This result is stated as the well-foundedness of the `cut_expand` relation defined in
this file: we model the heads of the hydra as a multiset of elements of `α`, and the
valid "moves" of the game are modelled by the relation `cut_expand r` on `multiset α`:
`cut_expand r s' s` is true iff `s'` is obtained by removing one head `a ∈ s` and
adding back an arbitrary multiset `t` of heads such that all `a' ∈ t` satisfy `r a' a`.

To prove this theorem, we follow the proof by Peter LeFanu Lumsdaine at
https://mathoverflow.net/a/229084/3332, and along the way we introduce the notion of `fibration`
of relations, and a new operation `game_add` that combines to relations to form a relation on the
product type, which is used to define addition of games in combinatorial game theory.

TODO: formalize the relations corresponding to more powerful (e.g. Kirby–Paris and Buchholz)
hydras, and prove their well-foundedness.
-/

namespace relation

variables {α β : Type*}

section two_rels
variables (rα : α → α → Prop) (rβ : β → β → Prop) (f : α → β)

/-- A function `f : α → β` is a fibration between the relation `rα` and `rβ` if for all
  `a : α` and `b : β`, whenever `b : β` and `f a` are related by `rβ`, `b` is the image
  of some `a' : α` under `f`, and `a'` and `a` are related by `rα`. -/
def fibration := ∀ ⦃a b⦄, rβ b (f a) → ∃ a', rα a' a ∧ f a' = b

variables {rα rβ}

/-- If `f : α → β` is a fibration between relations `rα` and `rβ`, and `a : α` is
  accessible under `rα`, then `f a` is accessible under `rβ`. -/
lemma _root_.acc.of_fibration (fib : fibration rα rβ f) {a} (ha : acc rα a) : acc rβ (f a) :=
begin
  induction ha with a ha ih,
  refine acc.intro (f a) (λ b hr, _),
  obtain ⟨a', hr', rfl⟩ := fib hr,
  exact ih a' hr',
end

lemma _root_.acc.of_downward_closed (dc : ∀ {a b}, rβ b (f a) → b ∈ set.range f)
  (a : α) (ha : acc (inv_image rβ f) a) : acc rβ (f a) :=
ha.of_fibration f (λ a b h, let ⟨a', he⟩ := dc h in ⟨a', he.substr h, he⟩)

variables (rα rβ)

/-- The "addition of games" relation in combinatorial game theory, on the product type: if
  `rα a' a` means that `a ⟶ a'` is a valid move in game `α`, and `rβ b' b` means that `b ⟶ b'`
  is a valid move in game `β`, then `game_add rα rβ` specifies the valid moves in the juxtaposition
  of `α` and `β`: the player is free to choose one of the games and make a move in it,
  while leaving the other game unchanged. -/
inductive game_add : α × β → α × β → Prop
| fst {a' a b} : rα a' a → game_add (a',b) (a,b)
| snd {a b' b} : rβ b' b → game_add (a,b') (a,b)

/-- `game_add` is a `subrelation` of `prod.lex`. -/
lemma game_add_le_lex : game_add rα rβ ≤ prod.lex rα rβ :=
λ _ _ h, h.rec (λ _ _ b, prod.lex.left b b) (λ a _ _, prod.lex.right a)

/-- `prod.rprod` is a subrelation of the transitive closure of `game_add`. -/
lemma rprod_le_trans_gen_game_add : prod.rprod rα rβ ≤ trans_gen (game_add rα rβ) :=
λ _ _ h, h.rec begin
  intros _ _ _ _ hα hβ,
  exact trans_gen.tail (trans_gen.single $ game_add.fst hα) (game_add.snd hβ),
end

variables {rα rβ}

/-- If `a` is accessible under `rα` and `b` is accessible under `rβ`, then `(a, b)` is
  accessible under `relation.game_add rα rβ`. Notice that `prod.lex_accessible` requires the
  stronger condition `∀ b, acc rβ b`. -/
lemma _root_.acc.game_add {a b} (ha : acc rα a) (hb : acc rβ b) : acc (game_add rα rβ) (a, b) :=
begin
  induction ha with a ha iha generalizing b,
  induction hb with b hb ihb,
  refine acc.intro _ (λ h, _),
  rintro (⟨_,_,_,ra⟩|⟨_,_,_,rb⟩),
  exacts [iha _ ra (acc.intro b hb), ihb _ rb],
end

/-- The sum of two well-founded games is well-founded. -/
lemma _root_.well_founded.game_add (hα : well_founded rα) (hβ : well_founded rβ) :
  well_founded (game_add rα rβ) := ⟨λ ⟨a,b⟩, (hα.apply a).game_add (hβ.apply b)⟩

end two_rels

section hydra
open game_add multiset

/-- The relation that specifies valid moves in our hydra game. `cut_expand r s' s`
  means that `s'` is obtained by removing one head `a ∈ s` and adding back an arbitrary
  multiset `t` of heads such that all `a' ∈ t` satisfy `r a' a`.

  This is most directly translated into `s' = s.erase a + t`, but `multiset.erase` requires
  `decidable_eq α`, so we use the equivalent condition `s' + {a} = s + t` instead, which
  is also easier to verify for explicit multisets `s'`, `s` and `t`.

  We also don't include the condition `a ∈ s` because `s' + {a} = s + t` already
  guarantees `a ∈ s + t`, and if `r` is irreflexive then `a ∉ t`, which is the
  case when `r` is well-founded, the case we are primarily interested in.

  The lemma `relation.cut_expand_iff` below converts between this convenient definition
  and the direct translation when `r` is irreflexive. -/
def cut_expand (r : α → α → Prop) (s' s : multiset α) : Prop :=
∃ (t : multiset α) (a : α), (∀ a' ∈ t, r a' a) ∧ s' + {a} = s + t

variable {r : α → α → Prop}

theorem cut_expand_singleton {s x} (h : ∀ x' ∈ s, r x' x) : cut_expand r s {x} :=
⟨s, x, h, add_comm s _⟩

theorem cut_expand_singleton_singleton {x' x} (h : r x' x) : cut_expand r {x'} {x} :=
cut_expand_singleton (λ a h, by rwa mem_singleton.1 h)

theorem cut_expand_add_left {t u} (s) : cut_expand r (s + t) (s + u) ↔ cut_expand r t u :=
exists₂_congr $ λ _ _, and_congr iff.rfl $ by rw [add_assoc, add_assoc, add_left_cancel_iff]

lemma cut_expand_iff [decidable_eq α] (hr : irreflexive r) {s' s : multiset α} :
  cut_expand r s' s ↔ ∃ (t : multiset α) a, (∀ a' ∈ t, r a' a) ∧ a ∈ s ∧ s' = s.erase a + t :=
begin
  simp_rw [cut_expand, add_singleton_eq_iff],
  refine exists₂_congr (λ t a, ⟨_, _⟩),
  { rintro ⟨ht, ha, rfl⟩,
    obtain (h|h) := mem_add.1 ha,
    exacts [⟨ht, h, t.erase_add_left_pos h⟩, (hr a $ ht a h).elim] },
  { rintro ⟨ht, h, rfl⟩,
    exact ⟨ht, mem_add.2 (or.inl h), (t.erase_add_left_pos h).symm⟩ },
end

theorem not_cut_expand_zero (hr : irreflexive r) (s) : ¬ cut_expand r s 0 :=
by { classical, rw cut_expand_iff hr, rintro ⟨_, _, _, ⟨⟩, _⟩ }

/-- For any relation `r` on `α`, multiset addition `multiset α × multiset α → multiset α` is a
  fibration between the game sum of `cut_expand r` with itself and `cut_expand r` itself. -/
lemma cut_expand_fibration (r : α → α → Prop) :
  fibration (game_add (cut_expand r) (cut_expand r)) (cut_expand r) (λ s, s.1 + s.2) :=
begin
  rintro ⟨s₁, s₂⟩ s ⟨t, a, hr, he⟩, dsimp at he ⊢,
  classical, obtain ⟨ha, rfl⟩ := add_singleton_eq_iff.1 he,
  rw [add_assoc, mem_add] at ha, obtain (h|h) := ha,
  { refine ⟨(s₁.erase a + t, s₂), fst ⟨t, a, hr, _⟩, _⟩,
    { rw [add_comm, ← add_assoc, singleton_add, cons_erase h] },
    { rw [add_assoc s₁, erase_add_left_pos _ h, add_right_comm, add_assoc] } },
  { refine ⟨(s₁, (s₂ + t).erase a), snd ⟨t, a, hr, _⟩, _⟩,
    { rw [add_comm, singleton_add, cons_erase h] },
    { rw [add_assoc, erase_add_right_pos _ h] } },
end

/-- A multiset is accessible under `cut_expand` if all its singleton subsets are,
  assuming `r` is irreflexive. -/
lemma acc_of_singleton (hi : irreflexive r) {s : multiset α} :
  (∀ a ∈ s, acc (cut_expand r) {a}) → acc (cut_expand r) s :=
begin
  refine multiset.induction _ _ s,
  { exact λ _, acc.intro 0 $ λ s h, (not_cut_expand_zero hi s h).elim },
  { intros a s ih hacc, rw ← s.singleton_add a,
    exact ((hacc a $ s.mem_cons_self a).game_add $ ih $ λ a ha,
      hacc a $ mem_cons_of_mem ha).of_fibration _ (cut_expand_fibration r) },
end

/-- A singleton `{a}` is accessible under `cut_expand r` if `a` is accessible under `r`,
  assuming `r` is irreflexive. -/
lemma _root_.acc.cut_expand (hi : irreflexive r)
  {a : α} (hacc : acc r a) : acc (cut_expand r) {a} :=
begin
  induction hacc with a h ih,
  refine acc.intro _ (λ s, _),
  classical, rw cut_expand_iff hi,
  rintro ⟨t, a, hr, rfl|⟨⟨⟩⟩, rfl⟩,
  refine acc_of_singleton hi (λ a', _),
  rw [erase_singleton, zero_add],
  exact ih a' ∘ hr a',
end

/-- `cut_expand r` is well-founded when `r` is. -/
theorem _root_.well_founded.cut_expand (hr : well_founded r) : well_founded (cut_expand r) :=
⟨λ s, acc_of_singleton hr.is_irrefl.1 $ λ a _, (hr.apply a).cut_expand hr.is_irrefl.1⟩

end hydra

end relation


-- ---------------------------------------------------------------------
-- Ejercicio 1. Realizar las siguientes acciones:
-- 1. Importar la teoría de los números reales.
-- 2. Declarar x e y como variables sobre los reales.
-- 3. Iniciar el espacio de nombre my_abs.
-- ----------------------------------------------------------------------

import data.real.basic   -- 1
variables {x y z : ℝ}    -- 2
namespace my_abs         -- 3

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que
--    x < abs y ↔ x < y ∨ x < -y
-- ----------------------------------------------------------------------

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

theorem lt_abs : x < abs y ↔ x < y ∨ x < -y :=
begin
  unfold abs,
  exact lt_max_iff,
end

-- Prueba
-- ======

/-
x y : ℝ
⊢ x < abs y ↔ x < y ∨ x < -y
  >> unfold abs,
⊢ x < max y (-y) ↔ x < y ∨ x < -y
  >> exact lt_max_iff,
no goals
-/

-- Comentarios:
-- 1. La táctica (unfold e) despliega la definición de e.
-- 2. La definición de abs
--    + abs (a : α) : α := max a (-a)
-- 3. Se ha usado el lema
--    + lt_max_iff : x < max y z ↔ x < y ∨ x < z

-- Comprobación
-- #check (@lt_max_iff ℝ _ x y z)

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

example : x < abs y ↔ x < y ∨ x < -y :=
lt_max_iff

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que
--    abs x < y ↔ - y < x ∧ x < y
-- ----------------------------------------------------------------------

theorem abs_lt : abs x < y ↔ -y < x ∧ x < y :=
begin
  unfold abs,
  split,
    { intro h1,
      rw max_lt_iff at h1,
      cases h1 with h2 h3,
      split,
        { exact neg_lt.mp h3 },
        { exact h2 }},
    { intro h4,
      apply max_lt_iff.mpr,
      cases h4 with h5 h6,
      split,
       { exact h6 },
       { exact neg_lt.mp h5 }},
end

-- Prueba
-- ======

/-
x y : ℝ
⊢ abs x < y ↔ -y < x ∧ x < y
  unfold abs,
⊢ max x (-x) < y ↔ -y < x ∧ x < y
  >> split,
| ⊢ max x (-x) < y → -y < x ∧ x < y
|   >>   { intro h1,
| h1 : max x (-x) < y
| ⊢ -y < x ∧ x < y
|   >>     rw max_lt_iff at h1,
| h1 : x < y ∧ -x < y
| ⊢ -y < x ∧ x < y
|   >>     cases h1 with h2 h3,
| h2 : x < y,
| h3 : -x < y
| ⊢ -y < x ∧ x < y
|   >>     split,
| | ⊢ -y < x
|   >>       { exact neg_lt.mp h3 },
| ⊢ x < y
|   >>       { exact h2 }},
⊢ -y < x ∧ x < y → max x (-x) < y
  >>   { intro h4,
h4 : -y < x ∧ x < y
⊢ max x (-x) < y
  >>     apply max_lt_iff.mpr,
⊢ x < y ∧ -x < y
  >>     cases h4 with h5 h6,
h5 : -y < x,
h6 : x < y
⊢ x < y ∧ -x < y
  >>     split,
| ⊢ x < y
  >>      { exact h6 },
⊢ -x < y
  >>      { exact neg_lt.mp h5 }},
no goals
-/

-- Comentarios: Se han usado los siguientes lemas:
-- + max_lt_iff : max x y < z ↔ x < z ∧ y < z
-- + neg_lt : -x < y ↔ -y < x

-- Comprobación:
-- #check (@max_lt_iff ℝ _ x y z)
-- #check (@neg_lt ℝ _ x y)

end my_abs


/- 1a. [10 points]

Implement a function, bool_implies, that takes
two bool values, b1 and b2 (not propositions),
and that returns the the value of b1 → b2.
Here the → operator means implication in Boolean
algebra. To know what your function should do,
write out the truth table for implication. You
may  not use Lean's → operator (which does work
for bool values, by the way) in your answer.
Define the function by cases.
-/

def bool_implies : bool → bool → bool
| _ := _

/- 1b.
Given your implementation of bool_implies,
prove the following proposition. Use induction
rather than the cases tactic to do case
analysis on Boolean values.
-/

example : ∀ b1 b2 : bool,
    (bool_implies b1 b2 = tt) → (b2 = tt ∨ b1 = ff) :=
begin
_
end

/- 2a.

A tree of natural numbers is either empty or
it is constructed from a natural number and
two smaller trees of natural numbers. Give
an inductive definition of the type of such
trees. Call you datatype tree_nat. Your type
will have two constructors. Call the first
one "empty", and call the second "node".
Hint: The second will take three arguments.
-/

inductive tree_nat : Type
| _

/- 2b.

Define aTree to be a node containing the
value 3 and two trees, the first one empty
and the second one a node containing the
value 2 and two empty trees.
-/

def aTree := _

/- 3. Define a polymorphic type, "tree",
just like tree_nat, but where the value stored
in a node can be of any type, T. Hint: make the
type of elements a parameter. You can look at the
myprod type for an example. Then define aTree'
to be the same as aTree except that it's now
of type tree rather than of type tree_nat. Make
the type argument implicit. Finally define a
tree of strings, aTree'', just like aTree'
except that 3 is replaced by "Hi!" and 2 is
replaced by "Jo".
-/

-- Your answer here

/- 4.

Write a recursive function, num_nodes,
that takes a value of type tree T, as an
argument, where T is some type, and that
returns the number of nodes in the tree.
The number of nodes in an empty tree is zero,
while the number of nodes in a non-empty
tree is one (for the "top" node) plus the
number of nodes in each of the subtrees.

The "at sign" before "tree" in the following
function signature tells Lean that even though
tree takes its type argument implicitly, in
this case we want to give it explicitly. We
need to specify T explicitly here because Lean
has no way of knowing that we want the type of
elements to be T.
-/

def num_nodes : ∀ {T : Type}, @tree T → nat
| T tree.empty := _

/-
The following questions use our definition of
mynat to practice proof by induction. Here is
our mynat type and the implementations of addition
and multiplication.
-/

inductive mynat : Type
| zero : mynat
| succ : mynat → mynat

def add_mynat: mynat → mynat → mynat
| mynat.zero m := m
| (mynat.succ n') m :=
    mynat.succ (add_mynat n' m)

def mult_mynat: mynat → mynat → mynat
| mynat.zero m := mynat.zero
| (mynat.succ n') m :=
    add_mynat m (mult_mynat n' m)

/-
Here's a proof that zero is a right identity
for addition. We explain details in comments.
You will want to use some of the same ideas in
your proofs.
-/

theorem zero_right_id_add : ∀ (n : mynat),
    add_mynat n mynat.zero = n :=
begin
-- forall introduction
intro n,
-- induction
induction n with n' ih,

-- base case
exact rfl,

-- recursive case
-- first simplify based on definition of add_mynat
simp [add_mynat],
-- now apply induction hypothesis
exact ih,
end

/- #5

Prove the following by induction on n in Lean.
-/

-- 5b. Prove that succ (n + m) = n + (succ m).

theorem add_succ : ∀ (n m : mynat),
    mynat.succ (add_mynat n m) = add_mynat n (mynat.succ m) :=
begin
_
end

-- 5a. Prove zero is a right identity for mult.

theorem zero_right_absorb_mult : ∀ (n : mynat),
  mult_mynat n mynat.zero = mynat.zero :=
begin
_
end

-- 5b. Prove addition is associative.

theorem addition_assoc :
    ∀ (n m p : mynat),
        add_mynat (add_mynat n m) p =
        add_mynat n (add_mynat m p) :=
begin
intros n m p,
induction n,
exact rfl,
simp [add_mynat],
assumption,
end

-- 5c. Prove addition is commutative.

theorem addition_comm :
    ∀ (n m : mynat), add_mynat n m = add_mynat m n :=
begin
_
end

/- 6a.

Complete then test the following definition of
a function that computes the n'th Fibonacci
number when given n as an argument.
-/
def fib : ℕ → ℕ
| _ := _

/- 6b.

Implement the factorial function. You will need to
define the function for both its base and recursive
cases.
-/

def fac : ℕ → ℕ
| _ := _

/- 7.

Give an *informal proof by induction of the proposition
that forall natural numbers, n, the sum of the natural
numbers from 0 to n is n * (n + 1) / 2.

-/


import data.real.basic

variables {x y : ℝ}

#check le_refl
#check le_refl y
#check @le_abs
#check @abs_le
#check neg_add
#check add_le_add

namespace my_abs

-- BEGIN
theorem le_abs_self : x ≤ abs x :=
begin
  rw le_abs,
  left,
  apply le_refl,
end

theorem neg_le_abs_self : -x ≤ abs x :=
begin
  rw le_abs,
  right,
  apply le_refl,
end

/- with le_abs_self and neg_le_abs_self, now we can proof abs_add
using the split tactic-/
example : abs (x + y) ≤ abs x + abs y :=
begin
  rw abs_eq_max_neg,
  rw max_le_iff,
  split,
  { apply add_le_add,
    exact le_abs_self,
    exact le_abs_self, },
  { rw neg_add,
    apply add_le_add,
    exact neg_le_abs_self,
    exact neg_le_abs_self, },
end

-- END

#check @le_abs_self
#check @neg_le_abs_self
#check @abs_add

end my_abs


import .love12_basic_mathematical_structures_demo

/-! # LoVe Exercise 12: Basic Mathematical Structures -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Type Classes

Recall the inductive type `btree` we introduced earlier: -/

#check btree

/-! The following function takes two trees and attaches copies of the second
tree to each leaf of the first tree. -/

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

#reduce btree.graft (btree.node 1 btree.empty btree.empty)
  (btree.node 2 btree.empty btree.empty)

/-! 1.1. Prove the following two lemmas by structural induction on `t`. -/

lemma btree.graft_assoc {α : Type} (t u v : btree α) :
  btree.graft (btree.graft t u) v = btree.graft t (btree.graft u v) :=
sorry

lemma btree.graft_empty {α : Type} (t : btree α) :
  btree.graft t btree.empty = t :=
sorry

/-! 1.2. Declare btree an instance of `add_monoid` using `graft` as addition
operator. -/

#print add_monoid

@[instance] def btree.add_monid {α : Type} : add_monoid (btree α) :=
sorry

/-! 1.3. Explain why `btree` with `graft` as addition cannot be declared an
instance of `add_group`. -/

#print add_group

/-! 1.4 (**optional**). Prove the following lemma illustrating why `btree` with
`graft` as addition does not constitute an `add_group`. -/

lemma btree.add_left_neg_counterexample :
  ∃x : btree ℕ, ∀y : btree ℕ, btree.graft y x ≠ btree.empty :=
sorry

/-! ## Question 2: Multisets and Finsets

Recall the following definitions from the lecture: -/

#check multiset.elems
#check finset.elems
#check list.elems

/-! 2.1. Prove that the multiset of nodes does not change when mirroring a tree.

Hints:

* Perform structural induction on `t`.

* The `cc` tactic also works with set operations. -/

lemma multiset.elems_mirror (t : btree ℕ) :
  multiset.elems (mirror t) = multiset.elems t :=
sorry

/-! 2.2. Prove that the finite set of nodes does not change when mirroring a
tree. -/

lemma finset.elems_mirror (t : btree ℕ) :
  finset.elems (mirror t) = finset.elems t :=
sorry

/-! 2.3. Show that this does not hold for the list of nodes by providing a
tree `t` for which `nodes_list t ≠ nodes_list (mirror t)`.

If you define a suitable counterexample, the proof below will succeed. -/

def rotten_tree : btree ℕ :=
sorry

#eval list.elems rotten_tree
#eval list.elems (mirror rotten_tree)

lemma list.elems_mirror_counterexample :
  ∃t : btree ℕ, list.elems t ≠ list.elems (mirror t) :=
begin
  apply exists.intro rotten_tree,
  exact dec_trivial
end

end LoVe


import topology.definitions tactic

/-
A topological space (X, 𝒯) consists of a non-empty set X
together with a collection 𝒯 of subsets of X that satisfy
- ∅ ∈ 𝒯, X ∈ 𝒯
- U, V ∈ 𝒯 → U ∩ V ∈ 𝒯
- Uᵢ ∈ 𝒯 → ⋃ᵢ U ∈ 𝒯
Elements of 𝒯 are called open sets in (X, 𝒯) and 𝒯 is
called a topology on X.

In Lean this is represented by:

structure topological_space (α : Type u) :=
(is_open        : set α → Prop)
(is_open_univ   : is_open univ)
(is_open_inter  : ∀s t, is_open s → is_open t → is_open (s ∩ t))
(is_open_sUnion : ∀s, (∀ t ∈ s, is_open t) → is_open (⋃₀ s))
-/

variables {X : Type*} [topological_space X]
variables {Y : Type*} [topological_space Y]
variables {Z : Type*} [topological_space Z]

/- We allow excluded middle since we are not computer scientists -/
local attribute [instance] classical.prop_decidable

open definitions set function

/- We'll prove the axiom left out in Lean's version - ∅ is open -/
theorem empty_is_open : is_open (∅ : set X) :=
begin
  rw ←sUnion_empty, apply is_open_sUnion, intros _ h,
  exfalso, exact h
end

/-
If X is a topological space, then U ⊆ X is open iff for all x ∈ U,
there exists an open set Nₓ with x ∈ Nₓ and Nₓ ⊆ U

This theorem will be useful when we want to prove that a particular
set is open or closed
-/
-- The forward direction is trivial enough
lemma has_smaller_of_open {U : set X} (h : is_open U) :
∀ x ∈ U, ∃ (Nₓ : set X) (h₀ : is_open Nₓ), x ∈ Nₓ ∧ Nₓ ⊆ U := λ x hx,
⟨U, h, hx, subset.refl U⟩

/- The backwards direction is easy once we see that we can make U
  from the suitable union of Nₓ  -/
lemma open_of_has_smaller {U : set X}
(h : ∀ x ∈ U, ∃ (Nₓ : set X) (h₀ : is_open Nₓ), x ∈ Nₓ ∧ Nₓ ⊆ U) :
is_open U :=
begin
  choose f hfo hf using h,
  have : is_open ⋃ (x ∈ U), f x H :=
    is_open_Union (λ x, is_open_Union $ λ h, hfo x h),
  convert this, ext,
  refine ⟨λ h, mem_Union.2 ⟨x, mem_Union.2 ⟨h, (hf x h).1⟩⟩, λ h, _⟩,
    cases mem_Union.1 h with y hy, cases mem_Union.1 hy with hy₀ hy₁,
    exact (hf y hy₀).2 hy₁
end

theorem open_iff_has_smaller {U : set X} : is_open U ↔
∀ x ∈ U, ∃ (Nₓ : set X) (h₀ : is_open Nₓ), x ∈ Nₓ ∧ Nₓ ⊆ U :=
⟨has_smaller_of_open, open_of_has_smaller⟩

namespace mapping

open function equiv

/- The composition of two continuous functions is also continuous -/
theorem comp_contin {f : X → Y} {g : Y → Z}
(hf : is_continuous f) (hg : is_continuous g) :
is_continuous (g ∘ f) := λ U hU, hf _ (hg _ hU)

/- A function is continuous iff. it is continuous at every point -/
lemma contin_at_all_of_contin {f : X → Y} (h : is_continuous f) :
∀ x : X, is_continuous_at f x := λ _ U _ hU, h U hU

lemma contin_of_contin_at_all {f : X → Y}
(h : ∀ x : X, is_continuous_at f x) : is_continuous f := λ U hU,
begin
  cases (classical.em $ f ⁻¹' U = ∅) with hempt hnempt,
    { rw hempt, exact empty_is_open },
    { cases ne_empty_iff_nonempty.1 hnempt with x hx,
      exact h _ _ (mem_preimage.1 hx) hU }
end

theorem contin_iff_contin_at_all (f : X → Y) :
is_continuous f ↔ ∀ x : X, is_continuous_at f x :=
  ⟨contin_at_all_of_contin, contin_of_contin_at_all⟩

/-
A bijection of sets f : X → Y gives a homeomorphism of topological
spaces X → Y iff. it induces a bijection 𝒯(X) → 𝒯(Y) : U → f(U)
-/
theorem topo_contin_biject_of_equiv (hequiv : X ≃* Y) :
∃ (f : X → Y) (h₀ : bijective f) (h₁ : is_continuous f),
∀ U : set X, is_open U → is_open (f '' U) :=
begin
  refine ⟨hequiv.to_fun, _, hequiv.contin, λ U hU, _⟩,
  refine ⟨hequiv.left_inv.injective, hequiv.right_inv.surjective⟩,
  convert hequiv.inv_contin U hU,
  ext, split; intro hx,
    { rcases (mem_image _ _ _).1 hx with ⟨y, hy₀, hy₁⟩,
      rw ←hy₁, simp [hy₀] },
    { refine ⟨(hequiv.to_equiv.symm) x, hx, _⟩, simp }
end

lemma preimage_eq_inv {f : X → Y} {U : set X} (hf : bijective f) :
f '' U = (of_bijective _ hf).inv_fun ⁻¹' U :=
begin
  ext, split; intro hx,
    { rcases (mem_image _ _ _).1 hx with ⟨y, hy₀, hy₁⟩,
      rw [←hy₁, mem_preimage],
      have : left_inverse (of_bijective _ hf).inv_fun f :=
        (of_bijective _ hf).left_inv,
      rwa this y },
    { refine ⟨(of_bijective _ hf).inv_fun x, hx, _⟩,
      have : right_inverse (of_bijective _ hf).inv_fun f :=
        (of_bijective _ hf).right_inv,
      rwa this x
    }
end

noncomputable theorem equiv_of_topo_contin_biject {f : X → Y}
(hf₀ : bijective f) (hf₁ : ∀ U : set X, is_open U → is_open (f '' U))
(hf₂ : is_continuous f) : X ≃* Y :=
{ contin := hf₂,
  inv_contin := λ U hU, by rw ←preimage_eq_inv hf₀; exact hf₁ U hU,
  .. of_bijective _ hf₀ }

end mapping

namespace closed

/- Giving closure the attribute reducible so lean will automatically
unfold the definition instead of us manually telling it do so -/
attribute [reducible] closure

/- The closure of a set is the smallest closed set continaing it -/
theorem closure_is_min {U U' : set X} (hle : U ⊆ U') (hc : is_closed U') :
closure U ⊆ U' :=
begin
  intros x hx, rw mem_sInter at hx,
  exact hx U' ⟨hc, hle⟩
end

/- The closure of a set is the set of limit points -/
lemma limit_points_is_closed {U : set X}:
is_closed $ limit_points U :=
begin
  refine open_iff_has_smaller.2 (λ x hx, _),
  simp at hx, rcases hx with ⟨U', hU'₀, hU'₁, hU'₂⟩,
  exact ⟨U', hU'₀, hU'₁, λ y hy, by simp; exact ⟨U', hU'₀, hy, hU'₂⟩⟩,
end

lemma limit_points_ge {U : set X} : U ⊆ limit_points U :=
λ x hx _ _ hU', ne_empty_iff_nonempty.2 ⟨x, hU', hx⟩

lemma closure_le_limit_points (U : set X) :
closure U ⊆ limit_points U :=
  closure_is_min limit_points_ge limit_points_is_closed

lemma limit_points_le_closure (U : set X) :
limit_points U ⊆ closure U := λ x hx U' hU',
classical.by_contradiction $ λ hf,
  let ⟨y, hy⟩ := ne_empty_iff_nonempty.1 (hx (U'ᶜ) (hU'.1) hf) in
not_subset.2 ⟨y, hy.2, hy.1⟩ hU'.2

theorem closure_eq_limit_points (U : set X) :
closure U = limit_points U :=
le_antisymm (closure_le_limit_points U) (limit_points_le_closure U)

/- A set is smaller than its closure -/
theorem set_le_closure (U : set X) : U ⊆ closure U :=
λ x hx, mem_sInter.1 $ λ U' hU', hU'.2 hx

/- If A ⊆ B then the closure of A is smaller than the closure of B -/
theorem closure_mono' {U V : set X} (hle : U ⊆ V) :
closure U ⊆ closure V := λ x hx A hA, hx _ ⟨hA.1, subset.trans hle hA.2⟩

/- The closure of a closed set is itself-/
theorem closure_of_closed {U : set X} (h : is_closed U) :
closure U = U := ext $ λ x,
  ⟨λ hx, hx U ⟨h, subset.refl U⟩, λ hx, set_le_closure U hx⟩

/- The intersection of closed sets is closed -/
theorem is_closed_Inter {ι} {f : ι → set X} (hf : ∀ i : ι, is_closed (f i)) :
is_closed (⋂ ι, f ι) :=
by unfold is_closed; rw compl_Inter; refine is_open_Union hf

/- The closure of a set is closed -/
theorem closure_is_closed (U : set X) : is_closed $ closure U :=
begin
  unfold is_closed, rw compl_sInter,
  refine is_open_sUnion (λ _ hU', _),
  rcases hU' with ⟨_, ⟨hU'₀, _⟩, hU'₁⟩,
  exact hU'₁ ▸ hU'₀
end

end closed

namespace interior

open closed

/- The interior of a set equals the set of its interior points -/
theorem interior_eq_interior_points {U : set X} :
interior U = interior_points U := ext $ λ x,
  ⟨λ hx, let ⟨U', ⟨hU'₀, hU'₁⟩, hU'₂⟩ := hx in ⟨U', hU'₀, hU'₁, hU'₂⟩,
   λ hx, let ⟨U', hU'₀, hU'₁, hU'₂⟩ := hx in ⟨U', ⟨hU'₀, hU'₁⟩, hU'₂⟩⟩

/- The closure of -U equals the complement of the interior of U -/
theorem closure_compl_eq_compl_interior {U : set X} :
closure Uᶜ = (interior U)ᶜ :=
begin
  ext, split; rw [closure_eq_limit_points, interior_eq_interior_points],
    { intros hx₀ hx₁,
      rcases hx₁ with ⟨U', hU'₀, hU'₁, hU'₂⟩,
      exact hx₀ U' hU'₀ hU'₂ (diff_eq_empty.2 hU'₁) },
    { intros hx U' hU'₀ hU'₁ hU'₂,
      simp at hx, exact hx U' hU'₀ (diff_eq_empty.1 hU'₂) hU'₁ }
end

theorem interior_eq_compl_closure_compl {U : set X} :
interior U = (closure Uᶜ)ᶜ := by simp [closure_compl_eq_compl_interior]

/- With the above theorem in place, we can straightaway analougous theorems
to the ones we've proved for closure -/

/- The interior of a set is smaller than the set -/
theorem interior_le_set (U : set X) : interior U ⊆ U :=
by rw [interior_eq_compl_closure_compl, compl_subset_comm]; exact set_le_closure Uᶜ

/- If A ⊆ B, then the interior of A ⊆ interior of B -/
theorem interior_mono {U V : set X} (hle : U ⊆ V) :
interior U ⊆ interior V :=
begin
  repeat { rw [interior_eq_compl_closure_compl] },
  rw [compl_subset_comm, compl_compl],
  exact closure_mono' (compl_subset_compl.mpr hle)
end

/- The interior of an open set is itself -/
theorem interior_of_open {U : set X} (h : is_open U) :
interior U = U :=
begin
  rw interior_eq_compl_closure_compl,
  suffices : closure Uᶜ = Uᶜ, simp [this],
  exact closure_of_closed (by simp [compl_compl, h])
end

/- The interior of a set is open -/
theorem interior_is_open (U : set X) : is_open $ interior U :=
by rw interior_eq_compl_closure_compl; simp [closure_is_closed]

/- The interior of the interior is the interior -/
theorem interior_of_interior (U : set X) :
(interior $ interior U) = interior U :=
interior_of_open $ interior_is_open U

/- The interior of a set is the larges open set contained in
the set -/
theorem interior_is_max {U U' : set X} (hle : U' ⊆ U) (hc : is_open U') :
U' ⊆ interior U :=
by rw [interior_eq_compl_closure_compl, subset_compl_comm];
  exact closure_is_min (compl_subset_compl.2 hle) (by simp [hc])

end interior

namespace mapping

variables {U : set X} {V : set Y} {f : X → Y}

/- A mapping f : X → Y is continuous iff f⁻¹(U) is closed whenever
U is closed-/
lemma preimage_closed_of_closed (h : is_closed V)
(hcontin : is_continuous f) : is_closed (f ⁻¹' V) :=
by unfold is_closed; rw ←preimage_compl; exact hcontin _ h

lemma contin_of_preimage_closed_of_closed
(h : ∀ V, is_closed V → is_closed (f ⁻¹' V)) : is_continuous f :=
begin
  intros U hU,
  suffices : is_closed (f ⁻¹' U)ᶜ,
    { unfold is_closed at this, rwa compl_compl at this },
  rw ←preimage_compl,
  refine h _ _, unfold is_closed, rwa compl_compl
end

theorem contin_iff_preimage_closed_of_closed : is_continuous f ↔
∀ V, is_closed V → is_closed (f ⁻¹' V) :=
⟨λ h V hV, preimage_closed_of_closed hV h,
  λ h, contin_of_preimage_closed_of_closed h⟩

open closed

/- A mapping f : X → Y is continuous imples f(closure A) ⊆ closure f(A) -/
theorem map_closure_le_closure_map (hcontin : is_continuous f) :
f '' closure U ⊆ closure (f '' U) :=
begin
  rw contin_iff_preimage_closed_of_closed at hcontin,
  suffices : closure U ⊆ f ⁻¹' closure (f '' U),
    intros _ hy,
    rcases (mem_image _ _ _).1 hy with ⟨_, hx₀, hx₁⟩,
    rw ←hx₁, exact mem_preimage.1 (this hx₀),
  exact closure_is_min (λ _ hu, mem_preimage.2 (set_le_closure _ (mem_image_of_mem f hu)))
   (hcontin _ (closure_is_closed $ f '' U)),
end

end mapping

namespace subspaces

open mapping

/- The inclusion map is continuous -/
theorem inclusion_is_continuous (A : set X) : is_continuous 𝒾 A :=
begin
  intros U hU, refine ⟨U, hU, _⟩,
  ext, split; intro hx,
    { rw preimage, use x,
      exact hx.1, refine ⟨hx.2, rfl⟩ },
    { rcases hx with ⟨x', hx'₀, hx'₁⟩,
      rw ←hx'₁, split,
        exact subtype.val_prop x',
        simp at hx'₀, assumption }
end

/- (Universal Property) -/
lemma comp_inclusion_is_contin_of_is_contin {A : set X} {f : Z → A}
(h : is_continuous f) : is_continuous $ (𝒾 A) ∘ f :=
comp_contin h (inclusion_is_continuous A)

-- There has to be a better way to deal with type conversions :/
theorem is_contin_of_comp_inclusion_is_contin {A : set X} {f : Z → A}
(h : is_continuous $ (𝒾 A) ∘ f) : is_continuous f :=
begin
  intros U hU, rcases hU with ⟨V, hV₀, hV₁⟩,
  suffices : f ⁻¹' U = (𝒾 A) ∘ f ⁻¹' V,
    rw this, exact h _ hV₀,
  ext, split; intro hx,
    { show ↑(f x) ∈ V, suffices : ↑U ⊆ V,
        apply this, exact mem_image_of_mem coe hx,
      rw ←hV₁, exact inter_subset_right A V },
    { rw mem_preimage at *,
      replace hx : ↑(f x) ∈ V, exact hx,
      have : ↑(f x) ∈ ↑U,
        rw ←hV₁, exact mem_inter (subtype.coe_prop _) hx,
      cases f x with fx₀ _,
      rcases this with ⟨y, hy₀, hy₁⟩,
      convert hy₀, cases y,
      suffices : fx₀ = y_val, simp only [subtype.mk_eq_mk], assumption,
      simp only [subtype.coe_mk] at hy₁, rw hy₁ }
end

theorem is_contin_iff_comp_inclusion_is_contin {A : set X} {f : Z → A} :
is_continuous f ↔ (is_continuous $ (𝒾 A) ∘ f) :=
⟨ λ h, comp_inclusion_is_contin_of_is_contin h,
  λ h, is_contin_of_comp_inclusion_is_contin h ⟩

end subspaces

namespace Hausdorff_spaces

/- Sequence in a topological space have unique limits if that topological
space is Hausdorff (the inverse is in general not true) -/
theorem unique_limit_of_Hausdorff {x : ℕ → X} {l k : X} (h : is_Hausdorff X)
(hl : converge_to x l) (hk : converge_to x k) : l = k :=
classical.by_contradiction $ λ hne,
  let ⟨U, V, hU, hV, hlU, hkV, hdisj⟩ := h l k hne in
  let ⟨N₁, hN₁⟩ := hl _ hU hlU in let ⟨N₂, hN₂⟩ := hk _ hV hkV in
not_mem_empty (x (max N₁ N₂))
  (hdisj ▸ ⟨hN₁ _ (le_max_left N₁ N₂), hN₂ _ (le_max_right N₁ N₂)⟩)

/- If Y is Hausdorff and there exists a continuous injective map from
X to Y then X is also Hausdorff -/
theorem Hausdorff_of_continuous_inj (f : X → Y) (h : is_Hausdorff Y)
(hcontin : is_continuous f) (hinj : injective f) : is_Hausdorff X :=
begin
  intros x y hxy,
  rcases h _ _ (λ hf, hxy (hinj hf)) with ⟨U, V, hU₀, hV₀, hU₁, hV₁, hdisj⟩,
  refine ⟨f ⁻¹' U, f ⁻¹' V, hcontin U hU₀, hcontin V hV₀, hU₁, hV₁, _⟩,
  ext z, split; intro hz,
    { cases hz with hz₀ hz₁,
      rw mem_preimage at *,
      exfalso, refine @not_mem_empty Y (f z) _,
      rw ←hdisj, exact ⟨hz₀, hz₁⟩ },
    { exfalso, exact (not_mem_empty z) hz },
end

/- A subspace of a Hausdorff space is Hausdorff -/
theorem subspace_Hausdorff {A : set X} (h : is_Hausdorff X) : is_Hausdorff A :=
Hausdorff_of_continuous_inj (𝒾 A) h (subspaces.inclusion_is_continuous A)
  (λ _ _ hxy, subtype.eq hxy)

/- If X ≃* Y, then X is Hausdorff ⇔ Y is Hausdorff -/
lemma Hausdorff_of_equiv (h : is_Hausdorff Y) (hequiv : X ≃* Y) :
is_Hausdorff X :=
Hausdorff_of_continuous_inj hequiv.to_fun h hequiv.contin (equiv.injective hequiv.1)

lemma equiv_symm (hequiv : X ≃* Y) : Y ≃* X :=
{ contin := hequiv.inv_contin,
  inv_contin := hequiv.contin,
  .. equiv.symm hequiv.1 }

theorem Hausdorff_equiv (hequiv : X ≃* Y) :
is_Hausdorff X ↔ is_Hausdorff Y :=
iff.intro (λ h, Hausdorff_of_equiv h (equiv_symm hequiv))
  (λ h, Hausdorff_of_equiv h hequiv)

end Hausdorff_spaces