/-

* proposition built using ¬
* the formal meaning of ¬
* proofs of inequalities, ¬a=b
* disjointness of constructors
* strategy: proof by negation
* inference rule: modus tollens
* principle: non-contradiction
* rule: negation elimination
* axiom: excluded middle
* classical vs constructive logic
* double-negation elimination
* proof by contradiction
* proof by contrapositive
-/

/-   **********************
     *** ¬ Introduction ***
     **********************
-/

/-
In constructive logic, if we can
construct a proof of a proposition,
P, then we can judge it to be true.

What does it mean in constructive
logic for a proposition, P, to be
false?

It means that there is a proof that
there can be no proof of P. The way
we express this is that from a proof
of P we could derive a contradiction:
a proof of false. Because there can
be no such thing, there must be no
proof of P. In other words, to show
that ¬ P is true we prove P → false.
Indeed, the proposition ¬ P is just
defined as the proposition P → false.

A proof of P → false, as with any
proof of an implication, will be
given as a function: one that
takes a proof of P as an argument
and derives a proof of false. As
there is no proof of false, such
an argument cannot exist. From
the existence of the function we
conclude the non-existence of any
proof of P: that is, ¬ P.

From now on, when working in
constructive logic, when you see
a proof of a proposition, ¬ P, it
is worthwhile viewing it as a value
of type P → false, which is to say
as a function taking proofs of P
and returning proofs of false.
-/

/-
Check it: ¬ P is the same as P → false
-/
variable P : Prop -- assume P is some Prop
-- now show ¬ P = P → false from (using) rfl.
theorem same : (¬ P) = (P → false) := rfl

/-
In previous chapters we've worked with
many equality propositions. What about
inequality propositions? By x ≠ y, we
mean simply ¬ x = y. As an example,
0 ≠ 1 is just different notation for
¬ 0 = 1. Note that in Lean, = binds
more tightly (has a higher precedence)
than ¬, so ¬ 0 = 1 means ¬ (0 = 1),
rather than (¬ 0) = 1.
-/

/-
Now in turn we understand ¬ 0 = 1 to
mean 0 = 1 → false. How can we prove
such an implication? We already know it
will be with a function that derives a
proof of false from a proof of 0 = 1.
-/

/-
The short, satisfying, but ultimately
unenlightening answer is that Lean
just knows that it's true. We write
the proposition, then write a period,
and Lean does the rest! Here it is.
-/

theorem zneqo : 0 ≠ 1. -- note period
#check zneqo

theorem zneqoeqzneqo : (0 ≠ 1) = ¬(0 = 1) := rfl

/-
Note that the types, 0 ≠ 1, ¬ 0 = 1,
and 0 = 1 → false, look different but
in fact they are just different ways
of expressing the same type.
-/

/-
We' now explain in a little more
detail what's going on. How does
"Lean know" there's a proof and
how to construct it? We present
the following elaborated proof,
and then explain it after the
code. They thing to focus on is
that nat.no_confusion construct.
It in turn is using what we call
"disjointness of constructors" to
construct a proof of false.

Let's start by just looking at
the actual proof of 0 ≠ 1, which
we write here as 0 = 1 → false to
make it clear that 0 ≠ 1 is really
a proposition in the form of an
implication.
-/

#reduce nat.zero
#reduce nat.succ(0)
#reduce nat.succ(nat.succ(0))

theorem zneqo' : 0 = 1 → false :=
    λ h : (0 = 1),
        nat.no_confusion h
#check zneqo'

/-
You can see that the proof, being
a proof of an implication, is in
form of a function, as expected.

The function takes an argument,
h (a proof of 0 = 1). It then
constructs and returns a proof
of false. It constructs this
proof by applying nat.no_confusion
to h.

The nat.no_confusion function, in
turn, was generated by Lean when
the nat type was defined. It was
generated precisely to enable us
to reason about inequalities of
terms of type nat.
-/

/-
So, one major mystery remains here.
What is nat.no_confusion really doing?
The key to understanding is in a
principle we haven't discussed yet.
Let's look ahead just a little to
see what it is.
-/

/-
Values of a type can be built by
different "constructors" of that
type. In particular, 0 and 1 are
built by different constructors
of the nat type. The nat type has
two constructors: 0 is a nat, and
if n is any nat, then succ n is a
nat. In particular, 1 is actually
just succ 0 (which we can read as
"the successor of, one more than,
 0".)

The principle that nat.no_confusion
uses is that values of a type that
are built by different constructors
are, by definition, never equal. We
say that "constructors are disjoint"
as a shorthand for saying that the
sets of values generated by different
constructors are disjoint, which is
to say they have no values in common.

Lean can thus tell immediately
that it's impossible for 0 = 1
because the terms 0 and 1 were
built by different constructors.

The nat.no_confusion function
is defined to return false if
it could ever be given a proof
of such an impossibility. Our
proof of our theorem uses the
no_confusion rule/principle
that Lean provides, following
from the definition of the nat
type. From a proof of 0 = 1 we
use nat.no_confusion to derive
a proof of false, showing that
0 = 1 → false, thus ¬ 0 = 1,
and thus 0 ≠ 1.
-/

/-
The Assume-Show-From proof pattern
-/

/-
Here's a equivalent tactic script
for generating the same proof of
0 ≠ 1.
-/

theorem zneqo'' : ¬ 0 = 1 :=
    begin
        assume h : (0 = 1),
        show false,
        from nat.no_confusion h
    end

/-
This example introduces what we will
call the "assume, show, from" proof
pattern. The assume h corresponds to
h being an argument of the function
we are defining to prove ¬ 0 = 1. The
show false states what is to be proved
(the "return type"). And the from then
provides the function body, the code
that actually constructs the proof,
using what has been assumed. Be sure
to open the Messages View in VSCode,
click through the script line by line,
and watch how the tactic state changes.
-/

/- Translation to an informal proof. -/

/-
An English language rendition of this
proof would go like this. We prove
that 0 ≠ 1 by assuming 0 = 1 and by
showing that this assumption leads to
a contradiction. As that is impossible,
there must be no such proof of 0 = 1.
That proves ¬ 0 = 1, i.e., 0 ≠ 1.
-/

/-
Disjointness of Constructors in General
-/

/-
Proofs of inequalities for values of
types other than nat can be produced
using the no_confusion principles of
the respective other types. Here's a
proof that tt ≠ ff using the principle
for the bool type.
-/

theorem ttneqff' : ¬ tt = ff :=
    begin
        assume h : (tt = ff),
        show false,
        from bool.no_confusion h
    end

/-
We're thankful we can use the period
(dot) notation here as well.
-/

theorem ttneqff : tt ≠ ff.

/-
EXERCISE: Is it true that
"Hello, Lean!" ≠ "Hello Lean!"?
Can you prove it? If so, how?
If not, why not?

EXERCISE: What about 2 ≠ 1?
-/

/-  ***************************
     *** Proof by Negation ***
    ***************************
-/

/-
We've thus got our introduction rule for ¬.
To derive ¬ P, show that from an assumption
of (a proof of P) some kind of contradiction
that cannot occur, and thus a proof of false,
would follow, leading to the conclusion that
there must be no proof of P, that it isn't
true, and that ¬ P therefore is true. This is
called "proof by negation."
-/

/-
What are some of the consequence of the
the understanding of negation that we've
developed so far?

Perhaps of the most important concept
at this point is that we have a strategy
for proving propositions of the form, ¬ P.
Again, we call it "proof by negation." To
use this strategy to prove ¬ P, we first
assume that we P is true (we have a proof)
and we show this leads to a contradiction
(we can build a proof of false). That then
justifies the conclusion that P is cannot
be true, thus ¬ P.

Negation introduction, or proof by negation,
starts by assuming  P, derives a contradiction,
and concludes with ¬ P.

Here's the principle in the form of a simple
theorem that simply restates that from a
proof of P → false we can derive ¬ P. Give
the  lambda expression a careful reading:
it says, if you assume P is a proposition,
and p is a proof of (P → false) then you
can produce a proof of ¬ P, and it's just
p itself. A value (function) of type
P → false *is* a proof of ¬ P. This is the
simple inference rule for ¬ introduction,
and the "strategy" of proof by negation.
-/

theorem proof_by_negation :
    ∀ P : Prop, (P → false) →
        ¬ P :=

        λ (P: Prop) (p: P → false), p

/-
To show ¬ P, show that assuming P leads
to a contradiction. That's just what we
just did. Here's a more concrete example.
-/

lemma zneqo''': ¬ (0 = 1) :=
begin
    apply proof_by_negation,
    assume h: (0 = 1),
    show false,
    from (nat.no_confusion h)
    end

/-
A classic example of a proof by negation
is a proof that the square root of two is
irrational. You have to analyze the English
a little. This is really a proposition, P =
"the square root of two is NOT rational,
or ¬ (rational (sqrt 2)).

To prove it "by negation", assume that the
square root of two IS rational. From that,
derive a contradiction. From that, conclude
that the square root of two is not rational.
And now you have proved it is irrational.
-/

/- *********************
   *** Modus Tollens ***
   *********************
-/

/-
Aristotle's reasoning
principle, modus tollens, allows one
to deduce ¬ Q → ¬ P from P → Q. Here's
an example: if you know that "if it's
raining then the streets are wet" then
you can deduce that "if the streets are
not wet, it is not raining.
-/

/-
We first validate this rule by writing it
as a function that takes a proof of P → Q
and then it takes a proof of ¬ Q, and from
it, it derives a proof of ¬ P. This shows
that (P → Q) → (¬ Q → ¬ P).
-/

theorem  modus_tollens' { P Q : Prop }
    (pfPtoQ : P → Q) (pfnQ : ¬ Q) : ¬ P:=
        λ (pfP : P), pfnQ (pfPtoQ pfP)

/-
EXERCISE: present this same construction using
a lambda expression. This presentation style
makes the proposition, modus tollens, explicit:
for all P and Q : Prop, (P → Q) → (¬ Q → ¬ P).
Fill in the blank.
-/

theorem modus_tollens:
     ∀ P Q: Prop, (P → Q) → (¬ Q → ¬ P) :=
        λ (P Q: Prop) (pfPtoQ: P → Q),
            λ pfnQ : ¬ Q,
                λ pfP : P,
                    pfnQ (pfPtoQ pfP)
/-
theorem wrong : ∀ (P Q : Prop), (P → Q) → (¬ P → ¬ Q) :=
    λ (P Q: Prop),
        λ (p2q : P → Q),
            λ (notP : ¬ P),
                λ (pfQ : Q),
                    _
-/

def inc (n : ℕ) : ℕ := n + 1
def inc' : ℕ → ℕ := λ n : ℕ, n + 1
def inc'' : ∀ n : nat, nat :=
    λ n : nat, n + 1

/-
There are two ways to view the modus
tollens rule.

The first view is that the aim is to
produce a proof of ¬ Q → ¬ P and the
way it is done is to prove P → Q.

The other view is that the aim is to
produce a proof of ¬ P, and the way
to do it is by proving both a proof
of P → Q and a proof of ¬ Q.

In the first case, the goal is
¬ Q → ¬ P, but of course the first
step in proving this implication is
to assume ¬ Q.

So in the first approach, we assume
¬ Q by making (a value of type) ¬ Q
an argument. In the second case, we
assume ¬ Q using a lambda -- and you
guessed it, ¬ Q is an argument.

You should be sure you understand
why these two theorems say the same
things and why the proofs are really
the same, even though they're
presented a bit differently.

-/

/-
Let's use this strategy to prove ...

EXAMPLE
-/

/- ***************************
   **** Non-contradiction ****
   ***************************
-/

/-
The principle of non-contradiction says that
a proof of any proposition, Q, and also of its
negation, ¬ Q, gives rise to a contradiction,
i.e., to a proof of false. Therefore such a
contradiction cannot arise. That is, for any
proposition Q, it's the case that ¬ (Q ∧ ¬ Q).
-/

theorem no_contra :
∀ Q: Prop, ¬ (Q ∧ ¬ Q) :=
    λ (Q : Prop) (pf : Q ∧ ¬ Q),
        (and.elim_right pf) (and.elim_left pf)

#check no_contra

variables a b : nat

theorem ncab : ¬ ((a = b) ∧ (a ≠ b)) :=
begin
  apply no_contra
end

/-
What happens when we apply no_contra here
is that Lean matches up ((a = b) ∧ (a ≠ b))
with Q ∧ ¬ Q by matching up Q with (a = b),
and then deriving false from the result to
polish off the proof (false is a get out of
jail free card).
-/

/-
A longer, less clear version that does
the same thing.
-/
theorem ncab' : ¬ ((a = b) ∧ (a ≠ b)) :=
begin
  assume c : ((a = b) ∧ (a ≠ b)),
  have l := c.1,    -- short for left elim
  have r := c.2,    -- same for right elim
  have f := r l,    -- now a proof of false
  assumption        -- and that proves it
end

/-
The assumption tactic tells lean that the
goal to be proved is already proved by an
assumption in the context, so just go find
it. Watch how the tactic state changes as
you move through the proof script steps.
-/

/-  ********************************
     *** NEGATION ELIMINATION ***
    ********************************
-/

theorem dne : ∀ P : Prop, ¬ ¬ P → P :=
    λ (P : Prop) (pf : ((P → false) → false)),
      sorry

/-
What about negation elimination? Negation
elimination works in a closely related way.
Rather than deriving a contradiction from
a proof of P and concluding ¬ P, you show
that assuming ¬ P leads to a contraction,
thus to the conclusion that ¬ P is false,
there can be no proof it, thus ¬ ¬ P; and
then, by the principle of double negation
elimination one deduces that P must be true.

This is called proving P by contradiction.

Proof by contradiction is not accepted as
a valid principle in constructive logic,
because it relies on ¬ ¬ P → P. This issue
is that this rule is not constructive. To
see the problem, expand the ¬ signs into
their corresponding arrow notations. Then
¬ ¬ P, ¬ (¬ P), is ((P → false) → false).

What this says is that from a function
that converts assumed proofs of P into
proofs of false, one can derive a proof
of false: there can be no function of
this kind. But no where buried in any of
this is an actual proof of P to be found!
There's  no way to convert a function of
type ((P → false) → false) into a proof
of P, so there is no proof of ¬ ¬ P → P.

That is, double negation elimination is
not a valid inference rule in constructive
logic. Because proofs by contradiction
rely on double negation elimination, they
are not valid or available either in a
constructive logic, such as Lean's.

Lean can be extended by a single axiom,
however, to make it classical, rather
than constructive. One simple asserts
the law of the excluded middle.

P : Prop
--------
P ∨ ¬ P

axiom excluded_middle: ∀ P : Prop, P ∨ ¬ P
-/

/-  *******************************
    ** Classical Excluded Middle **
    *******************************
-/

/-
In constructive logic, a proof of ¬ P is
a proof of P → false, which we interpret
as a proof that there can be no proof of P.
A proof of ¬ ¬ P is thus a proof that there
is no proof of ¬ P. In a constructive logic,
however, knowing that there no proof of ¬ P
is not the same as having a proof of P. In
symbolic terms, from the assumption that
(P → false) → false (in one view a proof
that there can be no program that converts
proofs of P into proofs of false), you can't
derive a proof of P.
-/
axiom excluded_middle : ∀ P, P ∨ ¬ P

axiom excluded_middle' (P : Prop) : P ∨ ¬ P

#check excluded_middle

/-
The axiom of the excluded middle is thus
added to the other rules of the constructive
logic of Lean, making the logic classical.
We gain an ability to prove more theorems,
at the cost of a loss of constructiveness.
(We don't need a proof of either P or of
not P to derive a proof of P ∨ ¬ P. Thus
no proof of either P or of ¬ P can be
obtained from a proof of P ∨ ¬ P. In our
constructive logic, as we will see soon,
in our constructive logic a proof of P ∨
¬ P has to contain either a proof of P or
a proof of ¬ P. The elimination rule gets
us back to these proofs in a certain way.
-/

/-  *********************************
    ** Double Negation Elimination **
    *********************************
-/

/-
What the axiom of the excluded middle
lets you assume is that there are only
two possibilities: either P or ¬P, so
because ¬¬P is clearly not ¬P, the
only remaining possibility is that it
is P, so it must be P. Thus ¬¬P is P.
-/

theorem double_neg_elim: ∀ { P : Prop }, ¬¬P → P :=
begin
  assume P : Prop,
  assume pfNotNotP : ¬¬P,
  cases excluded_middle P,
    -- case where P is true
    show P, from h,
    -- case where ¬ P is true
    have f: false := pfNotNotP h,
    exact false.elim f,
end

theorem double_neg_elim': ∀ { P }, (P ∨ ¬P) → ¬¬P → P :=
begin
  assume P : Prop,
  assume PornotP : P ∨ ¬P,
  assume notnotP : ¬¬P,
  cases PornotP,
    show P, from PornotP,

    have f: false := notnotP PornotP,
    exact false.elim f
end

/-
The proof uses a technique that we haven't
discussed yet: by case analysis. For now it
is enough to see that the principle can be
proved, at least if one accepts excluded
middle.
-/

variable notNotP : ¬¬P -- assume ¬ ¬ P
-- derive P by double negation elimination
theorem pfP : P := double_neg_elim notNotP
theorem pfP' : P := double_neg_elim' (excluded_middle P) notNotP

/-
Note: the expression  double_neg_elim notNotP
takes advantage of the type inference that we
asked for by surrounding { P } with the curly
braces in the statement of the theorem.
-/

/-  ******************************
    *** Proof By Contradiction ***
    ******************************
-/

/-
We thus have the fundamental classical
logical "strategy" of proof by contradiction.
Read the proposition. If assuming ¬ P leads
to a contradiction, then P must be true.
The reliance on double elimination is clear.
The term ¬ P → false is the same as ¬ ¬ P.

The natural reasoning is like this: if ¬
P leads to a contraction then it must be
true that ¬ P is not true, so ¬ ¬ P must
be. But this, by classical double negation
elimination, is just P, so P must be true.

This is negation elimination in the sense
that one starts with an assumption of ¬ P
and concludes with P, albeit by way of
¬ ¬ P. A proof by contradiction aims to
prove P.
-/
theorem proof_by_contradiction :
    ∀ P : Prop, (¬ P → false) → P :=
        @double_neg_elim

theorem proof_by_contradiction' : ∀ P : Prop,
    (¬ P → false) → P :=
    begin
      assume P : Prop,
      assume nnP : ¬P → false,
      cases excluded_middle P,
        show P, from h,

        have f: false := nnP h,
        exact false.elim f
    end

/-
The @ here turns off type inferencing for
this one reference to double_neg_elim. It
is a detail here. We'll discuss @ later.
The point is that proof by contradiction
relies on double negation elimination.
-/

/-
Proving in Lean that these laws are valid
might seem unmotivated at first. But once
we have these rules, we can use them as our
own higher-level inference rules. Here's a
proof by contradiction of 0 = 0. The goal
to start is a proof of 0 = 0. By applying
our proof_by_contradiction theorem to effect
backwards (through the theorem) reasoning,
we convert the goal of showing 0 = 0 into
the goal of showing that ¬ 0 = 0 → false.
This is exactly the strategy of a proof by
contradiction. The rest of our script does
the construction of false from the assumed
proof of 0 = 0 → false. We just use eq.refl
0 to produce a proof of 0 = 0, to which we
then apply this function, yielding a false.
-/

theorem zeqz : 0 = 0 :=
begin
    apply proof_by_contradiction,
    assume pf: 0 = 0 → false,
    show false,
    from pf (eq.refl 0)
end

/-
The standard method for introducing
the law of the excluded middle, so as
to enable classical reasoning, in Lean,
is to use the "open classical" command
to make various classical axioms and
derived theorems available for use.
-/
open classical

/-
The example keyword lets us write a
theorem without giving it a name. It
is useful for giving examples!
-/
example
    { P Q : Prop }
    (pf: ¬ P → (Q ∧ ¬ Q))
    : P :=
    begin
        apply proof_by_contradiction,
        assume notP: ¬ P,
        have contra := (pf notP),
        show false,
        from
        begin
            have notQ := contra.right,
            have pfQ := contra.left,
            show false,
            from notQ pfQ
        end
    end

/-
Remember: To use proof by contradiction
we have to use the axiom (or the so-called
"law") of the excluded middle. Clearly it's
optional as a "law", as constructive logic
does without it. We thus generally call it
the *axiom* of the excluded middle. Take it
if you're classicist; leave it if you're
constructivist.
-/

/-  *****************************
    ** Proof By Contrapositive **
    *****************************
-/

/-
The aim in a proof by contrapositive
is to show P → Q from an assumption of
¬ P → ¬ Q, i.e., (¬ Q → ¬ P) → (P → Q).

Another way to view this rule is that
it aims to show Q from, first, a proof
of ¬ Q → ¬ P, and, second, a proof of P.

The way to think about this latter view
is that it says, if Q being false implies
that P is false, and if we know that P is
true, then Q must not be false and so (by
the axiom of the excluded middle) Q must
be true.
-/

theorem proof_by_contrapositive:
    ∀ P Q : Prop, (¬ Q → ¬ P) → (P → Q) :=
    begin
        assume P Q: Prop,
        assume nqnp: (¬ Q → ¬ P),
        assume p : P,
        have nqf : ¬ Q → false :=
          λ nq : ¬ Q,
            no_contra P (and.intro p (nqnp nq)),
        have nnq : ¬ ¬ Q := nqf,
        show Q,
        from double_neg_elim nnq
    end

/-
http://zimmer.csufresno.edu/~larryc/proofs/proofs.contrapositive.html
-/

theorem zeqz' : 0 = 0 → true :=
begin
    apply proof_by_contrapositive,
    assume nt : ¬true,
    have pff := nt true.intro,
    show ¬ 0 = 0,
    from false.elim pff
end

/-
Compare what by_contrapositive does to goal
with what by_contradiction does to the goal.
-/

theorem zeqz'' : 0 = 0 → true :=
begin
    apply proof_by_contradiction (0 = 0 → true),
    sorry
end
/-
EXERCISE: Does it appear that one needs
to use proof by contradiction (and thus
classical, non-constructive, reasoning)
to prove that the square root of two is
irrational?
-/


import .love06_monads_demo

/-! # LoVe Homework 6: Monads

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (6 points): Better Exceptions

The __error monad__ is a monad stores either a value of type `α` or an error of
type `ε`. This corresponds to the following type: -/

inductive error (ε α : Type) : Type
| good : α → error
| bad  : ε → error

/-! The error monad generalizes the option monad seen in the lecture. The `good`
constructor, corresponding to `option.some`, stores the current result of the
computation. But instead of having a single bad state `option.none`, the error
monad has many bad states of the form `bad e`, where `e` is an "exception" of
type `ε`.

1.1 (1 point). Implement a variant of `list.nth` that returns an error
message of the form "index _i_ out of range" instead of `option.none` on
failure.

Hint: For this, you will only need pattern matching (no `do` syntax). -/

#check list.nth

def list.nth_error {α : Type} (as : list α) (i : ℕ) : error string α :=
sorry

/-! 1.2 (1 point). Complete the definitions of the `pure` and `bind` operations
on the error monad: -/

def error.pure {ε α : Type} : α → error ε α :=
sorry

def error.bind {ε α β : Type} : error ε α → (α → error ε β) → error ε β :=
sorry

/-! The following type class instance makes it possible to use `>>=` and `do`
notations in conjunction with error monads: -/

@[instance] def error.monad {ε : Type} : monad (error ε) :=
{ pure := @error.pure ε,
  bind := @error.bind ε }

/-! 1.3 (2 point). Prove the three laws for the error monad. -/

lemma error.pure_bind {ε α β : Type} (a : α) (f : α → error ε β) :
  (pure a >>= f) = f a :=
sorry

lemma error.bind_pure {ε α : Type} (ma : error ε α) :
  (ma >>= pure) = ma :=
sorry

lemma error.bind_assoc {ε α β γ : Type} (f : α → error ε β) (g : β → error ε γ)
    (ma : error ε α) :
  ((ma >>= f) >>= g) = (ma >>= (λa, f a >>= g)) :=
sorry

/-! 1.4 (1 point). Define the following two operations on the error monad.

The `throw` operation raises an exception `e`, leaving the monad in a bad state
storing `e`.

The `catch` operation can be used to recover from an earlier exception. If the
monad is currently in a bad state storing `e`, `catch` invokes some
exception-handling code (the second argument to `catch`), passing `e` as
argument; this code might in turn raise a new exception. If `catch` is applied
to a good state, nothing happens—the monad remains in the good state. As a
convenient alternative to `error.catch ma g`, Lean lets us write
`ma.catch g`. -/

def error.throw {ε α : Type} : ε → error ε α :=
sorry

def error.catch {ε α : Type} : error ε α → (ε → error ε α) → error ε α :=
sorry

/-! 1.5 (1 point). Using `list.nth_error`, the monad operations on `error`, and
the special `error.catch` operation, write a `do` program that swaps the values
at indexes `i` and `j` in the input list `as`. If either index is out of range,
return `as` unchanged. -/

def list.swap {α : Type} (as : list α) (i j : ℕ) : error string (list α) :=
sorry

#reduce list.swap [3, 1, 4, 1] 0 2   -- expected: error.good [4, 1, 3, 1]
#reduce list.swap [3, 1, 4, 1] 0 7   -- expected: error.good [3, 1, 4, 1]

/-! ## Question 2 (3 points + 1 bonus point): Properties of `mmap`

We will prove some properties of the `mmap` function introduced in the
lecture's demo. -/

#check mmap

/-! 2.1 (1 point). Prove the following identity law about `mmap` for an
arbitrary monad `m`.

Hint: You will need the lemma `lawful_monad.pure_bind` in the induction step. -/

lemma mmap_pure {m : Type → Type} [lawful_monad m] {α : Type} (as : list α) :
  mmap (@pure m _ _) as = pure as :=
sorry

/-! Commutative monads are monads for which we can reorder actions that do not
depend on each others. Formally: -/

@[class] structure comm_lawful_monad (m : Type → Type)
  extends lawful_monad m : Type 1 :=
(bind_comm {α β γ δ : Type} (ma : m α) (f : α → m β) (g : α → m γ)
     (h : α → β → γ → m δ) :
   (ma >>= (λa, f a >>= (λb, g a >>= (λc, h a b c)))) =
   (ma >>= (λa, g a >>= (λc, f a >>= (λb, h a b c)))))

/-! 2.2 (1 point). Prove that `option` is a commutative monad. -/

lemma option.bind_comm {α β γ δ : Type} (ma : option α) (f : α → option β)
    (g : α → option γ) (h : α → β → γ → option δ) :
  (ma >>= λa, f a >>= λb, g a >>= λc, h a b c) =
  (ma >>= λa, g a >>= λc, f a >>= λb, h a b c) :=
sorry

/-! 2.3 (1 point). Explain why `error` is not a commutative monad. -/

-- enter your answer here

/-! 2.4 (1 bonus point). Prove the following composition law for `mmap`, which
holds for commutative monads.

Hint: You will need structural induction. -/

lemma mmap_mmap {m : Type → Type} [comm_lawful_monad m]
    {α β γ : Type} (f : α → m β) (g : β → m γ) (as : list α) :
  (mmap f as >>= mmap g) = mmap (λa, f a >>= g) as :=
sorry

end LoVe


section propositional

variables P Q R : Prop

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

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro h,
  intro g,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  by_cases h: P,
  {intro g,
  exact h,
  },
  {intro g,
  have q:= g h,
  contradiction,}
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  have k := doubleneg_elim P,
  exact k,
  have k := doubleneg_intro P,
  exact k,
end

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

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro h,
  cases h with hp hq,
  right,
  assumption,
  left,
  assumption,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro h,
  cases h with hp hq,
  split,
  exact hq,
  exact hp,
end

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

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro h,
  intro p,
  cases h with hnp hq,
  contradiction,
  exact hq,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro h,
  intro np,
  cases h with p q,
  contradiction,
  exact q,
end

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

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro h,
  intro nq,
  intro p,
  have q := h p,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro h,
  intro p,
  by_cases lemQ: Q,
  exact lemQ,
  have np := h lemQ,
  contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  have k := impl_as_contrapositive P Q,
  exact k,
  have k := impl_as_contrapositive_converse P Q,
  exact k,
end

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

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro nLEM,
  have LEM : P ∨ ¬P,
    right,
    intro p,
    have re_LEM : P ∨ ¬P,
      left,
      exact p,
      contradiction,
  contradiction,
end

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

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro h,
  intro np,
  have h_contraposer := impl_as_contrapositive (P → Q) P,
  have contrapos_h := h_contraposer h,
  have n_ptoq := contrapos_h np,
  have ptoq : P → Q,
    intro p,
    contradiction,
  contradiction,
end

-------------------
-- Estou ciente de que o jeito acima é mais trabalhoso do que o ideal. Fiz-lhe assim e assim manter-lhe-ei por fins científicos somente.
-------------------

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

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro porq,
  intro npnq,
  cases npnq with np nq,
  cases porq with p q,
  contradiction,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro pq,
  intro npRnq,
  cases pq with p q,
  cases npRnq with np nq,
  contradiction,
  contradiction,
end

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

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro npRq,
  split,
  intro p,
  have pRq : P ∨ Q,
    left,
    exact p,
  contradiction,
  intro q,
  have pRq : P ∨ Q,
    right,
    exact q,
  contradiction,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro npnq,
  intro pRq,
  cases npnq with np nq,
  cases pRq with p q,
    contradiction,
    contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro npq,
  by_cases lemp : P,
  left,
  by_contradiction nnq,
  have cont :P∧Q,
    split,
    exact lemp,
    exact nnq,
  contradiction,
  right,
  exact lemp,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro nqRnp,
  intro pq,
  cases pq with p q,
  cases nqRnp with nq np,
    contradiction,
    contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  have k := demorgan_conj P Q,
  exact k,
  have k := demorgan_conj_converse P Q,
  exact k,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  have k := demorgan_disj P Q,
  exact k,
  have k := demorgan_disj_converse P Q,
  exact k,
end

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

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro pqRr,
  cases pqRr with p qRr,
  cases qRr with q r,
  left,
  have pq : P ∧ Q,
    split,
    exact p,
    exact q,
  exact pq,
  right,
  have pr : P ∧ R,
    split,
    exact p,
    exact r,
  exact pr,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro pqRpr,
  cases pqRpr with pq pr,
    cases pq with p q,
    split,
    exact p,
    left,
    exact q,
    cases pr with p r,
    split,
    exact p,
    right,
    exact r,

end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro pRqr,
  cases pRqr with p qr,
  split,
  left,
  exact p,
  left,
  exact p,
  cases qr with q r,
  split,
  right,
  exact q,
  right,
  exact r,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro pRqpRr,
  cases pRqpRr with pRq pRr,
  cases pRq with p q,
  left,
  exact p,
  cases pRr with p r,
  left,
  exact p,
  right,
  have qr : Q∧R,
    split,
    exact q,
    exact r,
  exact qr,
end

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

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro pqTr,
  intro p,
  intro q,
  have pq : P∧Q,
    split,
    exact p,
    exact q,
  have r := pqTr pq,
  exact r,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro pTqTr,
  intro pq,
  cases pq with p q,
  have qTr := pTqTr p,
  have r := qTr q,
  exact r,
end

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

theorem impl_refl :
  P → P  :=
begin
  intro p,
  exact p,
end

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

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro p,
  left,
  exact p,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro q,
  right,
  exact q,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro pq,
  cases pq with p q,
  exact p,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro pq,
  cases pq with p q,
  exact q,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro pp,
  cases pp with p1 p2,
  exact p1,
  intro p,
  split,
  exact p,
  exact p,
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro pRp,
  cases pRp with p1 p2,
  exact p1,
  exact p2,
  intro p,
  left,
  exact p,
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 nEpx,
  intro x,
  intro px,
  have cont : (∃x, P x),
    existsi x,
    exact px,
  contradiction,

end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro xp,
  intro nxp,
  cases nxp with x,
  have cont := xp x,
  contradiction,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  apply impl_as_contrapositive_converse  (¬(∀x, P x)) (∃x, ¬P x),
  intro nEnpx,
  apply doubleneg_intro (∀x, P x),
  intro x,
  by_contra,
  have Enpx : ∃x, ¬P x,
    existsi x,
    exact h,
  contradiction,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro Exnpx,
  intro Fxpx,
  cases Exnpx with x npx,
  have px := Fxpx x,
  contradiction,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  have k := demorgan_forall U P,
  exact k,
  have k := demorgan_forall_converse U P,
  exact k,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  have k := demorgan_exists U P,
  exact k,
  have k := demorgan_exists_converse U P,
  exact k,
end

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

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro Epx,
  intro nFnpx,
  cases Epx with x px,
  have npx := nFnpx x,
  contradiction,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro Fxpx,
  intro Exnpx,
  cases Exnpx with x npx,
  have px := Fxpx x,
  contradiction,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro nEnpx,
  intro x,
  by_contra npx,
  have Enpx : ∃x, ¬P x,
    existsi x,
    exact npx,
  contradiction,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro nFnpx,
  by_contra nEpx,
  have nFnpx : ∀x, ¬P x,
    intro x,
    intro px,
    have Epx: ∃x, P x,
      existsi x,
      exact px,
    contradiction,
  contradiction,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  have k := forall_as_neg_exists U P,
  exact k,
  have k := forall_as_neg_exists_converse U P,
  exact k,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  have k := exists_as_neg_forall U P,
  exact k,
  have k := exists_as_neg_forall_converse U P,
  exact k,
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 Expxqx,
  cases Expxqx with x pxqx,
  cases pxqx with px qx,
  split,
  existsi x,
  exact px,
  existsi x,
  exact qx,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro ExpxRqx,
  cases ExpxRqx with x pxRqx,
  cases pxRqx with px qx,
  left,
  existsi x,
  exact px,
  right,
  existsi x,
  exact qx,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro ExpxRExqx,
  cases ExpxRExqx with Expx Exqx,
  cases Expx with x px,
  existsi x,
  left,
  exact px,
  cases Exqx with x qx,
  existsi x,
  right,
  exact qx,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro Fpxqx,
  split,
  intro x,
  have pxqx := Fpxqx x,
  cases pxqx with px qx,
  exact px,
  intro x,
  have pxqx := Fpxqx x,
  cases pxqx with px qx,
  exact qx,

end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro FxpxFxqx,
  intro x,
  cases FxpxFxqx with Fxpx Fxqx,
  split,
  have px := Fxpx x,
  exact px,
  have qx := Fxqx x,
  exact qx,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro FxpxRFxqx,
  intro x,
  cases FxpxRFxqx with Fxpx Fxqx,
  have px := Fxpx x,
  left,
  exact px,
  have qx := Fxqx x,
  right,
  exact qx,
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


import algebra.ring
import data.real.basic
import tactic

section
variables (R : Type*) [ring R]

#check (add_assoc : ∀ a b c : R, a + b + c = a + (b + c))
#check (add_comm : ∀ a b : R, a + b = b + a)
#check (zero_add : ∀ a : R, 0 + a = a)
#check (add_left_neg : ∀ a : R, -a + a = 0)
#check (mul_assoc : ∀ a b c : R, a * b * c = a * (b * c))
#check (mul_one : ∀ a : R, a * 1 = a)
#check (one_mul : ∀ a : R, 1 * a = a)
#check (mul_add : ∀ a b c : R, a * (b + c) = a * b + a * c)
#check (add_mul : ∀ a b c : R, (a + b) * c = a * c + b * c)
end

section
variables (R : Type*) [comm_ring R]
variables a b c d : R

example : (c * b) * a = b * (a * c) :=
by ring

example : (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
by ring

example : (a + b) * (a - b) = a^2 - b^2 :=
by ring

example (hyp : c = d * a + b) (hyp' : b = a * d) :
  c = 2 * a * d :=
begin
  rw [hyp, hyp'],
  ring
end
end

namespace my_ring
variables {R : Type*} [ring R]

theorem add_zero (a : R) : a + 0 = a :=
by rw [add_comm, zero_add]

theorem add_right_neg (a : R) : a + -a = 0 :=
by rw [add_comm, add_left_neg]

#check @my_ring.add_zero
#check @add_zero

end my_ring

namespace my_ring
variables {R : Type*} [ring R]

theorem neg_add_cancel_left (a b : R) : -a + (a + b) = b :=
by rw [←add_assoc, add_left_neg, zero_add]

/- Prove these: -/

theorem add_neg_cancel_right (a b : R) : (a + b) + -b = a :=
sorry

theorem add_left_cancel {a b c : R} (h : a + b = a + c) : b = c :=
sorry

theorem add_right_cancel {a b c : R} (h : a + b = c + b) : a = c :=
sorry

theorem mul_zero (a : R) : a * 0 = 0 :=
begin
  have h : a * 0 + a * 0 = a * 0 + 0,
  { rw [←mul_add, add_zero, add_zero] },
  rw add_left_cancel h
end

theorem zero_mul (a : R) : 0 * a = 0 :=
sorry

theorem neg_eq_of_add_eq_zero {a b : R} (h : a + b = 0) : -a = b :=
sorry

theorem eq_neg_of_add_eq_zero {a b : R} (h : a + b = 0) : a = -b :=
sorry

theorem neg_zero : (-0 : R) = 0 :=
begin
  apply neg_eq_of_add_eq_zero,
  rw add_zero
end

theorem neg_neg (a : R) : -(-a) = a :=
sorry

end my_ring

/- Examples. -/

section
variables {R : Type*} [ring R]

example (a b : R) : a - b = a + -b :=
sub_eq_add_neg a b

end

example (a b : ℝ) : a - b = a + -b :=
rfl

example (a b : ℝ) : a - b = a + -b :=
by reflexivity

namespace my_ring

variables {R : Type*} [ring R]

theorem self_sub (a : R) : a - a = 0 :=
begin
  rw [sub_eq_add_neg, add_right_neg],
end

-- Next one works by the definition of subtraction in `ℝ`
theorem self_sub' (a : ℝ) : a - a = 0 := add_right_neg a

lemma one_add_one_eq_two : 1 + 1 = (2 : R) :=
by refl

theorem two_mul (a : R) : 2 * a = a + a :=
sorry

end my_ring

section
variables (A : Type*) [add_group A]

#check (add_assoc : ∀ a b c : A, a + b + c = a + (b + c))
#check (zero_add : ∀ a : A, 0 + a = a)
#check (add_left_neg : ∀ a : A, -a + a = 0)
end

section
variables {G : Type*} [group G]

#check (mul_assoc : ∀ a b c : G, a * b * c = a * (b * c))
#check (one_mul : ∀ a : G, 1 * a = a)
#check (mul_left_inv : ∀ a : G, a⁻¹ * a = 1)

namespace my_group

theorem mul_right_inv (a : G) : a * a⁻¹ = 1 :=
sorry

theorem mul_one (a : G) : a * 1 = a :=
sorry

theorem mul_inv_rev (a b : G) : (a * b)⁻¹ = b⁻¹ * a ⁻¹ :=
sorry

end my_group
end


import data.set -- handy for proofs.

definition A : set ℕ := {1,2,3,4,5}

-- part (a) is true

theorem M1F_Sheet01_Q05a_is_true : 1 ∈ A :=
begin
simp [A]
end

-- part (b) does not even typecheck.

-- part (c) is true

theorem M1F_Sheet01_Q05c_is_true : {1} ⊆ A :=
begin
simp [A]
end

-- part (d) is true

-- set_option pp.notation false
theorem M1F_Sheet01_Q05d_is_true : {1,2} ⊆ A :=
begin
simp [A], -- eew doesn't work!
simp [has_subset.subset,set.subset], -- found using set_option pp.notation false
-- goal is now
-- ∀ ⦃a : ℕ⦄, a = 1 ∨ a = 2 → a = 1 ∨ a = 2 ∨ a = 3 ∨ a = 4 ∨ a = 5
intro a,
intro H,
cases H,
  left,assumption,
  right,left,assumption
  -- more painful than I was expecting.
end

-- part (e) is true. Proof basically same as (d).

theorem M1F_Sheet01_Q05e_is_true : {1,2,1} ⊆ A :=
begin
simp [A],
simp [has_subset.subset,set.subset],
-- goal is again
-- ∀ ⦃a : ℕ⦄, a = 1 ∨ a = 2 → a = 1 ∨ a = 2 ∨ a = 3 ∨ a = 4 ∨ a = 5
intro a,
intro H,
cases H,
  left,assumption,
  right,left,assumption
end

-- part (f) doesn't typecheck

-- part (g) doesn't either

-- part (h) is true

set_option pp.notation false

theorem M1F_Sheet01_Q05h_is_true : A ⊇ A :=
begin
unfold superset,
simp [A],
simp [has_subset.subset,set.subset]
-- wooah that worked!
-- Can use set_option trace.simplify.rewrite true to see why :-)
end

-- Notation (to remind Kevin)
-- \ sub for subset,
-- \ sup for superset
-- \ empty for empty set
-- \ un for union
-- \ i for intersection
-- \ \ for set-theoretic difference.


import tactic

variable A : Type

-- Exercise 4(a): Show that meet and join are unique (if they exist)
def isUpperBound {A} [partial_order A] (M : set A) (a : A) : Prop :=
  ∀ m ∈ M, m ≤ a

def isJoin {A} [partial_order A] (M : set A) (a : A) : Prop :=
  isUpperBound M a ∧ ∀ a' : A, (∀ m ∈ M, m ≤ a') → a ≤ a'

lemma join_is_unique [partial_order A] {M : set A} {a b : A} (aM : isJoin M a) (bM : isJoin M b) : a = b :=
begin
  apply le_antisymm,
  {
    show a ≤ b,
    apply aM.right,
    exact bM.left,
  },
  {
    show b ≤ a,
    apply bM.right,
    exact aM.left,
  },
end

def isLowerBound {A} [partial_order A] (M : set A) (a : A) : Prop :=
  ∀ m ∈ M, m ≥ a

def isMeet {A} [partial_order A] (M : set A) (a : A) : Prop :=
  isLowerBound M a ∧ ∀ a' : A, (∀ m ∈ M, m ≥ a') → a ≥ a'

lemma meet_is_unique [partial_order A] {M : set A} {a b : A} (aM : isMeet M a) (bM : isMeet M b) : a = b :=
begin
  apply le_antisymm,
  {
    apply bM.right,
    exact aM.left,
  },
  {
    apply aM.right,
    exact bM.left,
  },
end

-- Exercise 4(b)
-- Show that for a poset to be a complete lattice it suffices to show that every subset has a join (or every subset has a meet)
def hasAllJoins (A : Type) [partial_order A] : Prop :=
  ∀ M : set A, ∃ a : A, isJoin M a

def hasAllMeets (A : Type) [partial_order A] : Prop :=
  ∀ M : set A, ∃ a : A, isMeet M a

lemma allJoins_iff_allMeets {A} [partial_order A] : (hasAllJoins A) ↔ (hasAllMeets A) :=
begin
  split,
  {
    show hasAllJoins A → hasAllMeets A,
    intro hAllJoins,
    intro M,
    let N := {a : A | ∀ m ∈ M, m ≥ a},
    cases hAllJoins N with joinN hJoinN,
    use joinN,
    split,
    {
      show ∀ m ∈ M, m ≥ joinN,
      intro m,
      intro hmM,
      have h : ∀ n ∈ N, m ≥ n :=
      begin
        intro n,
        intro hnN,
        simp at hnN,
        exact hnN m hmM,
      end,
      exact hJoinN.right m h,
    },
    {
      show ∀ a' : A, (∀ m ∈ M, m ≥ a') → joinN ≥ a',
      intro a',
      intro h,
      exact hJoinN.left a' h,
    },
  },
  {
    -- Note that this direction is exactly the same as (dual of) the first
    -- just with all ≥ replaced by ≤ and all occurences of "join" by "meet"
    show hasAllMeets A → hasAllJoins A,
    intro hAllMeets,
    intro M,
    let N := {a : A | ∀ m ∈ M, m ≤ a},
    cases hAllMeets N with meetN hMeetN,
    use meetN,
    split,
    {
      show ∀ m ∈ M, m ≤ meetN,
      intro m,
      intro hmM,
      have h : ∀ n ∈ N, m ≤ n :=
      begin
        intro n,
        intro hnN,
        simp at hnN,
        exact hnN m hmM,
      end,
      exact hMeetN.right m h,
    },
    {
      show ∀ a' : A, (∀ m ∈ M, m ≤ a') → meetN ≤ a',
      intro a',
      intro h,
      exact hMeetN.left a' h,
    },
  },
end

-- Exercise 4(c)
--


import ..lectures.love11_logical_foundations_of_mathematics_demo

/-! # LoVe Exercise 11: Logical Foundations of Mathematics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Vectors as Subtypes

Recall the definition of vectors from the demo: -/

#check vector

/-! The following function adds two lists of integers elementwise. If one
function is longer than the other, the tail of the longer function is
truncated. -/

def list.add : list ℤ → list ℤ → list ℤ
| []        []        := []
| (x :: xs) (y :: ys) := (x + y) :: list.add xs ys
| []        (y :: ys) := []
| (x :: xs) []        := []

/-! 1.1. Show that if the lists have the same length, the resulting list also
has that length. -/

lemma list.length_add :
  ∀(xs : list ℤ) (ys : list ℤ) (h : list.length xs = list.length ys),
    list.length (list.add xs ys) = list.length xs
| []        []        :=
  sorry
| (x :: xs) (y :: ys) :=
  sorry
| []        (y :: ys) :=
  sorry
| (x :: xs) []        :=
  sorry

/-! 1.2. Define componentwise addition on vectors using `list.add` and
`list.length_add`. -/

def vector.add {n : ℕ} : vector ℤ n → vector ℤ n → vector ℤ n
:= sorry

/-! 1.3. Show that `list.add` and `vector.add` are commutative. -/

lemma list.add.comm :
  ∀(xs : list ℤ) (ys : list ℤ), list.add xs ys = list.add ys xs
:= sorry

lemma vector.add.comm {n : ℕ} (x y : vector ℤ n) :
  vector.add x y = vector.add y x :=
sorry

/-! ## Question 2: Integers as Quotients

Recall the construction of integers from the lecture, not to be confused with
Lean's predefined type `int` (= `ℤ`): -/

#check int.rel
#check int.rel_iff
#check int

/-! 2.1. Define negation on these integers. -/

def int.neg : int → int :=
sorry

/-! 2.2. Prove the following lemmas about negation. -/

lemma int.neg_eq (p n : ℕ) :
  int.neg ⟦(p, n)⟧ = ⟦(n, p)⟧ :=
sorry

lemma int.neg_neg (a : int) :
  int.neg (int.neg a) = a :=
sorry

end LoVe


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

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers

/-

# Limits of sequences in Lean

We give the standard `ε`, `N` definition of the limit of a sequence
and prove some theorems about them.

## lambda (λ) notation for functions

Here's how we define the functions from the naturals to the naturals
sending n to n^2 + 3:

-/

def f : ℕ → ℝ := λ n, n^2 + 3

/-

Mathematicians might write `n ↦ n^2+3` for this functions; indeed `λ` is
just prefix notation for the infix notation `↦` (i.e. you write `λ` at
the front and `↦` in the middle but they mean the same thing). You can
read more about function types in the "three kinds of types" section
of Part B of the course book.

Sometimes you might find yourself with a lambda-defined function
evaluated at a number. For example, you might see something like
`(λ n, n^2 + 3) 37`, which means "take the function sending
`n` to `n^2+3` and then evaluate it at 37". You can use the `dsimp`
(or `dsimp only`) tactic to simplify this to `37^2+3`.

The reason we need to know about function notation for this sheet
is that a sequence `x₀, x₁, x₂, …` of reals on this sheet will
be encoded as a function from `ℕ` to `ℝ` sending `0` to `x₀`, `1` to `x₁`
and so on.

## Limit of a sequence.

Here's the definition of the limit of a sequence.
-/

/-- If `a(n)` is a sequence of reals and `t` is a real, `tends_to a t`
is the assertion that the limit of `a(n)` as `n → ∞` is `t`. -/
def tends_to (a : ℕ → ℝ) (t : ℝ) : Prop :=
∀ ε > 0, ∃ B : ℕ, ∀ n, B ≤ n → |a n - t| < ε

/-

We've made a definition, so it's our job to now make the API
for the definition, i.e. prove some basic theorems about it.
-/

-- If your goal is `tends_to a t` and you want to replace it with
-- `∀ ε > 0, ∃ B, …` then you can do this with `rw tends_to_def`.
theorem tends_to_def {a : ℕ → ℝ} {t : ℝ} :
  tends_to a t ↔ ∀ ε, 0 < ε → ∃ B : ℕ, ∀ n, B ≤ n → |a n - t| < ε :=
begin
  -- true by definition
  refl,
end

-- the eagle-eyed viewers amongst you might have spotted
-- that `∀ ε > 0, ...` and `∀ ε, ε > 0 → ...` and `∀ ε, 0 < ε → ...`
-- are all definitionally equal, so `refl` sees through them.

/-

## The questions

Here are some basic results about limits of sequences.
See if you can fill in the `sorry`s with Lean proofs.
Note that `norm_num` can work with `|x|` if `x` is a numeral like 37,
but it can't do anything with it if it's a variable.
-/

/-- The limit of the constant sequence with value 37 is 37. -/
theorem tends_to_thirtyseven : tends_to (λ n, 37) 37 :=
begin
  rw tends_to_def,
  intros ε hε,
  use 100,
  intros n hn,
  norm_num,
  exact hε,
end

/-- The limit of the constant sequence with value `c` is `c`. -/
theorem tends_to_const (c : ℝ) : tends_to (λ n, c) c :=
begin
  intros ε hε,
  dsimp only,
  use 37,
  intros n hn,
  ring_nf,
  norm_num,
  exact hε,
end

/-- If `a(n)` tends to `t` then `a(n) + c` tends to `t + c` -/
theorem tends_to_add_const {a : ℕ → ℝ} {t : ℝ} (c : ℝ)
  (h : tends_to a t) :
  tends_to (λ n, a n + c) (t + c) :=
begin
  rw tends_to_def at h ⊢,
  ring_nf,
  exact h,
end

/-- If `a(n)` tends to `t` then `-a(n)` tends to `-t`.  -/
example {a : ℕ → ℝ} {t : ℝ} (ha : tends_to a t) :
  tends_to (λ n, - a n) (-t) :=
begin
  rw tends_to_def at ha ⊢,
  intros ε hε,
  specialize ha ε hε,
  cases ha with B hB,
  use B,
  intros n hn,
  specialize hB n hn,
  have h : ∀ (x : ℝ), |(-x)| = |x|,
    sorry, -- how to prove basic results about |.|? See next sheet!
  rw ← h,
  ring_nf at hB ⊢,
  exact hB,
end


import .love11_logical_foundations_of_mathematics_demo

/- # LoVe Exercise 11: Logical Foundations of Mathematics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: Vectors as Subtypes

Recall the definition of vectors from the demo: -/

#check vector

/- The following function adds two lists of integers elementwise. If one
function is longer than the other, the tail of the longer function is
truncated. -/

def list.add : list ℤ → list ℤ → list ℤ
| []        []        := []
| (x :: xs) (y :: ys) := (x + y) :: list.add xs ys
| []        (y :: ys) := []
| (x :: xs) []        := []

/- 1.1. Show that if the lists have the same length, the resulting list also
has that length. -/

lemma list.length_add :
  ∀(xs : list ℤ) (ys : list ℤ) (h : list.length xs = list.length ys),
    list.length (list.add xs ys) = list.length xs
| []        []        :=
  by simp [list.add]
| (x :: xs) (y :: ys) :=
  begin
    simp [list.add, length],
    intro h,
    rw list.length_add xs ys h
  end
| []        (y :: ys) :=
  begin
    intro h,
    cases' h
  end
| (x :: xs) []        :=
  begin
    intro h,
    cases' h
  end

/- 1.2. Define componentwise addition on vectors using `list.add` and
`list.length_add`. -/

def vector.add {n : ℕ} : vector ℤ n → vector ℤ n → vector ℤ n
| u v := subtype.mk (list.add (subtype.val u) (subtype.val v))
  begin
    rw list.length_add,
    { exact subtype.property u },
    { rw subtype.property u, rw subtype.property v }
  end

/- 1.3. Show that `list.add` and `vector.add` are commutative. -/

lemma list.add.comm :
  ∀(xs : list ℤ) (ys : list ℤ), list.add xs ys = list.add ys xs
| []        []        := by refl
| (x :: xs) (y :: ys) := by simp [list.add, add_comm]; exact list.add.comm xs ys
| []        (y :: ys) := by refl
| (x :: xs) []        := by refl

lemma vector.add.comm {n : ℕ} (x y : vector ℤ n) :
  vector.add x y = vector.add y x :=
begin
  apply subtype.eq,
  simp [vector.add],
  apply list.add.comm
end

/- ## Question 2: Integers as Quotients

Recall the construction of integers from the lecture, not to be confused with
Lean's predefined type `int` (= `ℤ`): -/

#check int.rel
#check int.rel_iff
#check int

/- 2.1. Define negation on these integers. -/

def int.neg : int → int :=
quotient.lift (λpn : ℕ × ℕ, ⟦(prod.snd pn, prod.fst pn)⟧)
  begin
    intros a a' ha,
    cases' a with p n,
    cases' a' with p' n',
    apply quotient.sound,
    simp at *,
    rw int.rel_iff at *,
    cc
  end

/- 2.2. Prove the following lemmas about negation. -/

lemma int.neg_eq (p n : ℕ) :
  int.neg ⟦(p, n)⟧ = ⟦(n, p)⟧ :=
by refl

lemma int.neg_neg (a : int) :
  int.neg (int.neg a) = a :=
begin
  apply quotient.induction_on a,
  intro a,
  cases' a,
  simp [int.neg_eq]
end

end LoVe


import .love11_logical_foundations_of_mathematics_demo

/-! # LoVe Exercise 11: Logical Foundations of Mathematics -/

set_option pp.beta true

namespace LoVe

/-! ## Question 1: Vectors as Subtypes

Recall the definition of vectors from the demo: -/

#check vector

/-! The following function adds two lists of integers elementwise. If one
function is longer than the other, the tail of the longer function is
truncated. -/

def list.add : list ℤ → list ℤ → list ℤ
| []        []        := []
| (x :: xs) (y :: ys) := (x + y) :: list.add xs ys
| []        (y :: ys) := []
| (x :: xs) []        := []

/-! 1.1. Show that if the lists have the same length, the resulting list also
has that length. -/

lemma list.length_add :
  ∀(xs : list ℤ) (ys : list ℤ) (h : list.length xs = list.length ys),
    list.length (list.add xs ys) = list.length xs
| []        []        :=
  sorry
| (x :: xs) (y :: ys) :=
  sorry
| []        (y :: ys) :=
  sorry
| (x :: xs) []        :=
  sorry

/-! 1.2. Define componentwise addition on vectors using `list.add` and
`length.length_add`. -/

def vector.add {n : ℕ} : vector ℤ n → vector ℤ n → vector ℤ n :=
sorry

/-! 1.3. Show that `list.add` and `vector.add` are commutative. -/

lemma list.add.comm :
  ∀(xs : list ℤ) (ys : list ℤ), list.add xs ys = list.add ys xs :=
sorry

lemma vector.add.comm {n : ℕ} (x y : vector ℤ n) :
  vector.add x y = vector.add y x :=
sorry

/-! ## Question 2: Integers as Quotients

Recall the construction of integers from the lecture, not to be confused with
Lean's predefined type `int` (= `ℤ`): -/

#check int.rel
#check int.rel_iff
#check int

/-! 2.1. Define negation on these integers. -/

def int.neg : int → int :=
sorry

/-! 2.2. Prove the following lemmas about negation. -/

lemma int.neg_eq (p n : ℕ) :
  int.neg ⟦(p, n)⟧ = ⟦(n, p)⟧ :=
sorry

lemma int.neg_neg (a : int) :
  int.neg (int.neg a) = a :=
sorry

end LoVe


import tactic          -- Imports all the Lean tactics.
import data.real.basic -- Imports the real numbers.

namespace my_analysis

  /-- Sequence of real numbers indexed by natural numbers. -/
  def seq := ℕ → ℝ

  /-- Sequence formed by taking the absolute value of each term. -/
  noncomputable def seq.abs (s : seq) : seq := λ k, |s k|
  @[simp] theorem seq_abs_eq (s : seq) (n : ℕ) : s.abs n = |s n| := rfl

  /-- Set containing all the values taken by terms of the sequence `s`. -/
  def seq.to_set (s : seq) : set ℝ := {x | ∃ n, s n = x}
  /-- Proof that the image set of sequence indexed by ℕ is nonempty. -/
  def seq.nonempty (s : seq) : s.to_set.nonempty :=
    by { use s 0, use 0 }

  /-- Proposition that a sequence converges to a specified limit. -/
  def tendsto (s : seq) (x : ℝ) : Prop := ∀ ⦃ε⦄, 0 < ε → ∃ B : ℕ, ∀ ⦃n⦄, B ≤ n → |s n - x| < ε
  notation s ` ⟶ ` limit := tendsto s limit

  /-- Proposition that there is a limit to which a sequence converges. -/
  def seq.convergent (s : seq) : Prop := ∃ x, s ⟶ x

  section neg

    /-- Sequence formed by taking the additive inverse of each real term of the original sequence `s`. -/
    def seq.neg (s : seq) : seq := λ n, - s n

    instance seq_neg : has_neg seq := ⟨seq.neg⟩
    @[simp] theorem seq.neg_eq (s : seq) (n : ℕ) : (-s) n = -(s n) := rfl

    /-- Sequence negation is an involution, i.e. it is its own inverse. -/
    @[simp] theorem seq.neg_neg (s : seq) : -(-s) = s :=
    begin
      apply funext, intro n,
      rw [seq.neg_eq, seq.neg_eq, neg_neg]
    end

    /-- tendsto is preserved by negating both the sequence and its limit. -/
    theorem neg_tendsto_neg {s : seq} {x : ℝ} : (-s ⟶ -x) ↔ (s ⟶ x) :=
    begin
      split,
      { intros h ε hε, cases h hε with B hB, use B, intros n hn,
        rw [← abs_neg, neg_sub, ← neg_sub_neg, ← s.neg_eq],
        exact hB hn },
      { intros h ε hε, cases h hε with B hB, use B, intros n hn,
        rw [s.neg_eq, ← neg_sub, abs_neg, neg_sub_neg],
        exact hB hn }
    end

    /-- tendsto is preserved by swapping the negation between the sequence and limit. -/
    theorem neg_tendsto {s : seq} {x : ℝ} : (-s ⟶ x) ↔ (s ⟶ -x) :=
    begin
      have : x = - -x, from eq_neg_of_eq_neg rfl,
      conv_lhs { rw [this] },
      exact neg_tendsto_neg
    end

    /-- Negation preserves convergence. -/
    theorem neg_convergent {s : seq} : (-s).convergent ↔ s.convergent :=
    begin
      split,
      { intro h, cases h with x hx,
        exact ⟨-x, neg_tendsto.mp hx⟩ },
      { intro h, cases h with x hx,
        exact ⟨-x, neg_tendsto_neg.mpr hx⟩ }
    end

  end neg

  section bounded

    /-- Proposition that a sequence is bounded above, i.e. all terms lie within `(-∞, M]`. -/
    def seq.bounded_above (s : seq) : Prop := ∃ M, ∀ n, s n ≤ M

    /-- Proposition that a sequence is bounded above, i.e. all terms lie within `[m, ∞)`. -/
    def seq.bounded_below (s : seq) : Prop := ∃ m, ∀ n, m ≤ s n

    /-- Proposition that a sequence is bounded above and below, i.e. all terms lie within `[-M, M]`. -/
    def seq.bounded (s : seq) : Prop := s.abs.bounded_above

    /-- Proof that a sequence is bounded in absolute value if and only if it is bounded both above and below. -/
    theorem bounded_iff_above_below {s : seq} : s.bounded ↔ s.bounded_above ∧ s.bounded_below :=
    begin
      split,
      { intro hb,
        cases hb with M hM,
        split,
        { use M, intro n,
          exact le_of_abs_le (hM n) },
        { use -M, intro n,
          exact neg_le_of_abs_le (hM n) } },
      { rintro ⟨ha, hb⟩,
        cases ha with M hM,
        cases hb with m hm,
        use max M (-m), intro n,
        by_cases h : s n ≤ 0,
        { rw [seq_abs_eq, abs_of_nonpos h],
          exact le_max_of_le_right (neg_le_neg (hm n)) },
        { rw [seq_abs_eq, abs_of_nonneg (le_of_not_ge h)],
          exact le_max_of_le_left (hM n) }}
    end

    /-- Cast from myanalysis.bounded_above to mathlib's bdd_above Prop. -/
    theorem seq.bounded_above.to_bdd_above {s : seq} (hb : s.bounded_above) : bdd_above s.to_set :=
    begin
      cases hb with M hM,
      use M, intros x hx,
      cases hx with n hn,
      rw [← hn], exact hM n
    end

    /-- Negation turn an upper bound into a lower bound. -/
    theorem bounded_above_iff_neg_below {s : seq} : s.bounded_above ↔ (-s).bounded_below :=
    begin
      split,
      { intro h, cases h with M hM,
        use -M, intro n, rw [seq.neg_eq],
        exact neg_le_neg_iff.mpr (hM n) },
      { intro h, cases h with m hm,
        use -m, intro n, rw [←s.neg_neg, (-s).neg_eq],
        exact neg_le_neg_iff.mpr (hm n) }
    end

    /-- Negation turn an lower bound into a upper bound. -/
    theorem bounded_below_iff_neg_above {s : seq} : s.bounded_below ↔ (-s).bounded_above :=
    begin
      conv_lhs { rw [←seq.neg_neg s] },
      exact bounded_above_iff_neg_below.symm
    end

  end bounded

  section order

    /-- Proposition that every term in a sequence is greater than or equal to any term before it. -/
    def seq.increasing (s : seq) : Prop := ∀ ⦃m n⦄, m ≤ n → s m ≤ s n
    /-- Proposition that every term in a sequence is strictly greater than any term before it. -/
    def seq.strictly_increasing (s : seq) : Prop := ∀ ⦃m n⦄, m < n → s m < s n

    /-- Proposition that every term in a sequence is less than or equal to any term before it. -/
    def seq.decreasing (s : seq) : Prop := ∀ ⦃m n⦄, m ≤ n → s n ≤ s m
    /-- Proposition that every term in a sequence is strictly less than any term before it. -/
    def seq.strictly_decreasing (s : seq) : Prop := ∀ ⦃m n⦄, m < n → s n < s m

    /-- Proposition that in a sequence, either every term is greater than or equal to any term before it,
      or every term is less than or equal to any term before it. -/
    def seq.monotone (s : seq) : Prop := s.increasing ∨ s.decreasing
    /-- Proposition that in a sequence, either every term is strictly greater than any term before it,
      or every term is strictly less than any term before it. -/
    def seq.strictly_monotone (s : seq) : Prop := s.strictly_increasing ∨ s.strictly_decreasing

    /-- Weakening of strictly increasing to just increasing. -/
    theorem seq.strictly_increasing.to_increasing {s : seq} (si : s.strictly_increasing) : s.increasing :=
    begin
      intros m n h,
      by_cases h' : m = n,
      { rw [h'] },
      { exact le_of_lt (si (lt_of_le_of_ne h h')) }
    end
    /-- Weakening of strictly increasing to just increasing. -/
    theorem seq.strictly_decreasing.to_decreasing {s : seq} (si : s.strictly_decreasing) : s.decreasing :=
    begin
      intros m n h,
      by_cases h' : m = n,
      { rw [h'] },
      { exact le_of_lt (si (lt_of_le_of_ne h h')) }
    end
    /-- Weakening of strictly increasing to just increasing. -/
    theorem seq.strictly_monotone.to_monotone {s : seq} (si : s.strictly_monotone) : s.monotone :=
    begin
      cases si with h h,
      { exact or.inl h.to_increasing },
      { exact or.inr h.to_decreasing }
    end

    /-- Negation turns an increasing sequence into a decreasing sequence. -/
    theorem increasing_iff_neg_decreasing {s : seq} : s.increasing ↔ (-s).decreasing :=
    begin
      split,
      { intros h a b hab,
        rw [seq.neg_eq, seq.neg_eq],
        exact neg_le_neg (h hab) },
      { intros h a b hab,
        rw [←s.neg_neg, (-s).neg_eq],
        exact neg_le_neg_iff.mpr (h hab) }
    end

    /-- Negation turns an decreasing sequence into a increasing sequence. -/
    theorem decreasing_iff_neg_increasing {s : seq} : s.decreasing ↔ (-s).increasing :=
    begin
      conv_lhs { rw [←seq.neg_neg s] },
      exact increasing_iff_neg_decreasing.symm
    end

    /-- Any increasing bounded-above sequence is convergent. -/
    theorem convergent_of_bounded_above_increasing {s : seq} (hba : s.bounded_above) (hi : s.increasing) :
      s.convergent :=
    begin
      use Sup s.to_set,
      intros ε hε,
      have hlub := real.is_lub_Sup s.to_set s.nonempty hba.to_bdd_above,
      have : ∃ B, s B > Sup s.to_set - ε,
        by_contradiction h,
        simp only [not_exists, not_lt] at h,
        have : Sup s.to_set - ε ∈ upper_bounds s.to_set,
          rintros x ⟨n, rfl⟩,
          exact h n,
        exact absurd hε (not_lt.mpr ((le_sub_self_iff _).mp (hlub.right this))),
      cases this with B hB,
      use B, intros n hn,
      refine abs_lt.mpr ⟨_, _⟩,
      exact lt_tsub_iff_left.mpr (lt_of_lt_of_le hB (hi hn)),
      exact lt_of_le_of_lt (sub_nonpos.mpr (hlub.left (by use n))) hε
    end

    /-- Any decreasing bounded-below sequence is convergent. -/
    theorem convergent_of_bounded_below_decreasing {s : seq} (hbb : s.bounded_below) (hd : s.decreasing) :
      s.convergent :=
        neg_convergent.mp $ convergent_of_bounded_above_increasing
          (bounded_below_iff_neg_above.mp hbb)
          (decreasing_iff_neg_increasing.mp hd)

  end order

  section shift

    /-- Sequence formed by ignoring the first `n` elements, such that `s.shift 0 = s n`. -/
    def seq.shift (s : seq) (n : ℕ) : seq := λ m, s (m + n)

    /-- Shifting by `0` leaves the sequence unchanged. -/
    @[simp] theorem shift_zero (s : seq) : s.shift 0 = s :=
      by simp only [seq.shift, nat.add_zero]

    /-- For any `m` greater than the shift number `n`, `s m` has been moved to `s.shift n (m - n)`. -/
    theorem shift_ge (s : seq) {n m : ℕ} (h : n ≤ m) : s.shift n (m - n) = s m :=
      by simp only [seq.shift, nat.sub_add_cancel h]

    /-- tendsto is preserved by arbitrary finite shifts (including preserving the limit). -/
    theorem tendsto_shift (s : seq) (x : ℝ) : ∀ n, (s ⟶ x) ↔ (s.shift n ⟶ x) :=
    begin
      intro n, split,
      { intros h ε hε,
        cases h hε with B hB,
        use B, intros m hm,
        exact hB (le_add_right hm : B ≤ m + n) },
      { intros h ε hε,
        cases h hε with B hB,
        use B + n, intros m hm,
        rw [← shift_ge s (nat.le_of_add_le_right hm)],
        exact hB (le_tsub_of_add_le_right hm) }
    end

  end shift

  section finite_prefix

    /-- A finite set made up of the values of the first `n` terms of the sequence `s` (from `s 0` to `s (n-1)`). -/
    noncomputable def finite_prefix (s : seq) (n : ℕ) : finset ℝ :=
      (multiset.map s (multiset.range n)).to_finset

    /-- A real number belongs to the finite prefix set if and only if it is the value taken by
      the sequence `s` for some term before the `n`-th term. -/
    @[simp] theorem mem_finite_prefix {s : seq} {n : ℕ} {x : ℝ} : x ∈ finite_prefix s n ↔ ∃ k, k < n ∧ s k = x :=
      by simp only [finite_prefix, multiset.mem_to_finset, multiset.mem_map, multiset.mem_range]

    /-- If the natural number `n` isn't zero, then the finite prefix with `n` elements is nonempty. -/
    theorem finite_prefix_nonempty (s : seq) {n : ℕ} (hn : n ≠ 0) :
      (finite_prefix s n).nonempty :=
        ⟨s 0, mem_finite_prefix.mpr ⟨0, pos_iff_ne_zero.mpr hn, rfl⟩⟩

    /-- For any `n`, the real numbers `|s m|` for `m < n` have a maximal element. -/
    theorem finite_prefix_max (s : seq) {n : ℕ} (hn : n ≠ 0) :
      ∃ m, m < n ∧ ∀ k < n, s k ≤ s m :=
    begin
      let fs := (finite_prefix s n),
      have hM := mem_finite_prefix.mp (fs.max'_mem (finite_prefix_nonempty s hn)),
      cases hM with m hm,
      use m, split, exact hm.left,
      intros k hk, rw [hm.right],
      exact fs.le_max' (s k)(mem_finite_prefix.mpr ⟨k, hk, rfl⟩)
    end

    /-- For any `n`, the real numbers `|s m|` for `m < n` have a minimal element. -/
    theorem finite_prefix_min (s : seq) {n : ℕ} (hn : n ≠ 0) :
      ∃ m, m < n ∧ ∀ k < n, s m ≤ s k :=
    begin
      cases finite_prefix_max (-s) hn with M hM,
      use M, split, exact hM.left,
      intros k hk,
      exact neg_le_neg_iff.mp (hM.right k hk)
    end

    /-- For any `n`, the elements `|s m|` for `m < n` are bounded. -/
    theorem finite_prefix_bounded (s : seq) (n : ℕ) : ∃ M, ∀ m < n, |s m| ≤ M :=
    begin
      by_cases hn : n = 0,
      { use 0,
        intros m hm,
        rw [hn] at hm,
        exact absurd hm (nat.not_lt_zero m) },
      { cases finite_prefix_max s.abs hn with M hM,
        exact ⟨|s M|, hM.right⟩ }
    end

  end finite_prefix

  /-- bounded is preserved by arbitrary finite shifts (although the bound `M` itself might change). -/
  theorem bounded_shift (s : seq) : ∀ n, s.bounded ↔ (s.shift n).bounded :=
  begin
    intro n, split,
    { rintro ⟨M, h⟩,
      use M, intro k,
      exact h (k + n) },
    { rintro ⟨M₁, h₁⟩,
      cases finite_prefix_bounded s n with M₂ h₂,
      use max M₁ M₂,
      intro k,
      by_cases hk : k < n,
      { exact le_max_of_le_right (h₂ k hk) },
      { rw [seq_abs_eq, ← shift_ge s (not_lt.mp hk)],
        exact le_max_of_le_left (h₁ (k - n)) } }
  end

end my_analysis


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

import tactic -- imports all the Lean tactics

/-!

# Behind the scenes at the natural number game

I explain a bit about how inductive types and inductive definitions work.

## How to make the natural numbers?

I present the natural numbers in the natural number game
(TODO add URL) as "something with zero and succ which
satisfies induction" and I present addition as "something
which by definition satisfies `x+0=x` and `x+succ(y)=succ(x+y)`.
Here's how it actually happens.

-/

inductive mynat : Type -- note no `:=` next; this is a different kind of definition
| zero : mynat
| succ (n : mynat) : mynat

/-

This "inductive definition" creates four things automatically:
(1) a new type called `mynat : Type`
(2) a new term `mynat.zero : mynat`
(3) a new function `mynat.succ : mynat → mynat`
(4) a "recursor" -- something I'll tell you about in a minute.

Right now, the `0` in `mynat` is called `mynat.zero`. However if
we `open mynat` or move into the `mynat` namespace with `namespace mynat`,
it will just be called `zero`.
-/

-- #check zero -- doesn't work

namespace mynat

-- now zero works:

-- #check zero -- zero : mynat

-- but `0` still doesn't work:

-- #check (0 : mynat) -- failed to find `⊢ has_zero mynat`

/-

To get `0` working, let's make an instance of `has_zero mynat`.

-/

instance : has_zero mynat :=
{ zero := zero }

-- #check (0 : mynat) -- works

-- We could even make a `simp` lemma which turns `mynat.zero` into `0`.

@[simp] lemma mynat.zero_eq_zero : mynat.zero = 0 :=
begin
  refl
end

-- Now if we ever see a `mynat.zero` we can `simp` it into `0`.

/-

## The recursor

The fourth thing which magically appears after our definition of `mynat`
is a new (quite complicated) function `mynat.rec`, which is at once
the principles of induction and recursion.

The reason `mynat.rec` can be both is that it mentions a term
`motive : mynat → Sort u` and `Sort u` is Lean's way of saying
"any universe -- either `Prop` or `Type` (or even the higher universes)".
Let's see what `mynat.rec` looks like in the special cases of `Prop`
and `Type`:

-/

-- induction: how to prove P(n) for all n, where P(n) is a proposition
-- using mynat.rec directly
example
  -- let P be a family of true-false statements
  (P : mynat → Prop)
  -- Assume P(0) is true
  (h0 : P mynat.zero)
  -- assume P(n) implies P(succ n)
  (hsucc : ∀ n : mynat, P n → P (mynat.succ n))
  -- Then
  :
  -- P(n) is true for all n
  ∀ n, P n :=
begin
  -- apply mynat.rec
  exact mynat.rec h0 hsucc
end

-- recursion: how to define f(n) for all n, given f(0) and
-- a formula for f(n+1) which can depend on f(n) (and on n)

example
  -- let X be a type
  (X : Type)
  -- Say we have x₀ in X (the value of f(0))
  (x₀ : X)
  -- and say we have a function mynat → X → X, for example
  -- if X is the reals and f(n+1)= 1/n + f(n) then this function would
  -- be λ n x, 1/n + x
  (I : mynat → X → X)
  -- then
  :
  -- we can build a function mynat → X
  mynat → X :=
@mynat.rec (λ _, X) x₀ I

/-

This is not now we use the recursor though.
In term mode, we use recursive definitions; in tactic
mode we use the induction tactic.

Let's see these in action, with our first inductive definition,
namely addition.

-/

def add : mynat → mynat → mynat -- again no `:=`
| n 0 := n -- n + 0 defined to be n
| n (succ m) := succ (add n m)

/-

Again we see these weird `|` symbols, but this time what's happening
is not that we are defining a new inductive type, but we are defining
a new function which eats inductive types and is defined on a case
by case basis; it's "defined by recursion". Internally the definition
of `add` uses `mynat.rec` but we don't have to worry about that any more.
This way of working with the recursor is far less painful.

Now `add_zero` and `add_succ` are definitional. Let's see this.
First let's set up notation `+` for addition with the notational
typeclass `has_add`

-/

instance : has_add mynat :=
{ add := add }

lemma add_zero (n : mynat) : n + 0 = n :=
begin
  refl
end

-- dot notation for succ is quite confusing; let's switch it off
attribute [pp_nodot] mynat.succ

lemma add_succ (n m : mynat) : n + succ m = succ (n + m) :=
begin
  refl
end

/-
If you've played the natural number game, you might now be
able to find shorter proofs of things. For example `n + 0 = n`
can be proved by `refl` even though I never explain this.

The `induction` tactic automatically works for `mynat` now
because it knows about `mynat.rec`.
-/

lemma zero_add (n : mynat) : 0 + n = n :=
begin
  induction n with d hd, -- works!
  {
    -- see how we have a mixture of notation now? :-(
    -- see if you can sort out the mess. In the natural number game
    -- I do this behind the scenes.
    sorry }, --
  { sorry }
end

/-

Later on in the natural number game I randomly introduce two new
theorems: `zero_ne_succ` (saying `0 ≠ succ n`) and `succ_inj` (saying
that `succ m = succ n → m = n`). Here's how we prove them. Let's
make a new inductive type with two terms.

-/

/-- The type `yesno` has two terms, `yesno.yes` and `yesno.no`. -/
inductive yesno : Type
| yes : yesno
| no : yesno

open yesno

-- now they're just called `yes` and `no`.

example : yes ≠ no :=
begin
  intro h, -- h : yes = no
  cases h, -- no cases where this is true. Proved using yesno.rec ;-)
end

example : yes ≠ no. -- a complete proof! Proof is "there are no cases"

-- now let's define a function `is_zero`

@[pp_nodot]
def is_zero : mynat → yesno
| 0 := yes
| (succ n) := no

lemma yes_zero_is_zero : is_zero 0 = yes :=
begin
  refl
end

lemma no_succ_isnt_zero (n : mynat) : is_zero (succ n) = no :=
begin
  refl
end

lemma succ_ne_zero (n : mynat) : succ n ≠ 0 :=
begin
  -- see if you can prove it.
  -- Recall the `apply_fun` tactic which can turn a hypothesis
  -- `x = y` into `f x = f y`
  sorry
end

-- Now here's how to prove that `succ` is injective

@[pp_nodot]
def pred : mynat → mynat
| 0 := succ (succ (succ (succ (succ (succ (succ 0)))))) -- junk value
| (succ n) := n -- what we care about

lemma pred_succ (n : mynat) : pred (succ n) = n :=
begin
  sorry
end

lemma succ_inj (a b : mynat) (hab : succ a = succ b) : a = b :=
begin
  sorry,
end

end mynat


/-
Copyright (c) 2020 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/

import data.nat.interval
import data.polynomial.derivative
import tactic.linarith

/-!
# Theory of iterated derivative
We define and prove some lemmas about iterated (formal) derivative for polynomials over a semiring.
-/

noncomputable theory

open finset nat polynomial
open_locale big_operators polynomial

namespace polynomial
universes u
variable {R : Type u}

section semiring

variables [semiring R] (r : R) (f p q : R[X]) (n k : ℕ)

/-- `iterated_deriv f n` is the `n`-th formal derivative of the polynomial `f` -/
def iterated_deriv : R[X] := derivative ^[n] f

@[simp] lemma iterated_deriv_zero_right : iterated_deriv f 0 = f := rfl

lemma iterated_deriv_succ : iterated_deriv f (n + 1) = (iterated_deriv f n).derivative :=
by rw [iterated_deriv, iterated_deriv, function.iterate_succ']

@[simp] lemma iterated_deriv_zero_left : iterated_deriv (0 : R[X]) n = 0 :=
begin
  induction n with n hn,
  { exact iterated_deriv_zero_right _ },
  { rw [iterated_deriv_succ, hn, derivative_zero] },
end

@[simp] lemma iterated_deriv_add :
  iterated_deriv (p + q) n = iterated_deriv p n + iterated_deriv q n :=
begin
  induction n with n ih,
  { simp only [iterated_deriv_zero_right], },
  { simp only [iterated_deriv_succ, ih, derivative_add] }
end

@[simp] lemma iterated_deriv_smul {S : Type*} [monoid S]
  [distrib_mul_action S R] [is_scalar_tower S R R]
  (s : S) : iterated_deriv (s • p) n = s • iterated_deriv p n :=
begin
  induction n with n ih,
  { simp only [iterated_deriv_zero_right] },
  { simp only [iterated_deriv_succ, ih, derivative_smul] }
end

@[simp] lemma iterated_deriv_X_zero : iterated_deriv (X : R[X]) 0 = X :=
by simp only [iterated_deriv_zero_right]

@[simp] lemma iterated_deriv_X_one : iterated_deriv (X : R[X]) 1 = 1 :=
by simp only [iterated_deriv, derivative_X, function.iterate_one]

@[simp] lemma iterated_deriv_X (h : 1 < n) : iterated_deriv (X : R[X]) n = 0 :=
begin
  induction n with n ih,
  { exfalso, exact nat.not_lt_zero 1 h },
  { simp only [iterated_deriv_succ],
    by_cases H : n = 1,
    { rw H, simp only [iterated_deriv_X_one, derivative_one] },
    { replace h : 1 < n := array.push_back_idx h (ne.symm H),
      rw ih h, simp only [derivative_zero] } }
end

@[simp] lemma iterated_deriv_C_zero : iterated_deriv (C r) 0 = C r :=
by simp only [iterated_deriv_zero_right]

@[simp] lemma iterated_deriv_C (h : 0 < n) : iterated_deriv (C r) n = 0 :=
begin
  induction n with n ih,
  { exfalso, exact nat.lt_asymm h h },
  { by_cases H : n = 0,
    { rw [iterated_deriv_succ, H], simp only [iterated_deriv_C_zero, derivative_C] },
    { replace h : 0 < n := nat.pos_of_ne_zero H,
      rw [iterated_deriv_succ, ih h], simp only [derivative_zero] } }
end

@[simp] lemma iterated_deriv_one_zero : iterated_deriv (1 : R[X]) 0 = 1 :=
by simp only [iterated_deriv_zero_right]

@[simp] lemma iterated_deriv_one : 0 < n → iterated_deriv (1 : R[X]) n = 0 := λ h,
begin
  have eq1 : (1 : R[X]) = C 1 := by simp only [ring_hom.map_one],
  rw eq1, exact iterated_deriv_C _ _ h,
end

lemma coeff_iterated_deriv_as_prod_Ico :
  ∀ m : ℕ, (iterated_deriv f k).coeff m = (∏ i in Ico m.succ (m + k.succ), i) • (f.coeff (m+k)) :=
begin
  induction k with k ih,
  { simp only [add_zero, forall_const, one_smul, Ico_self, eq_self_iff_true,
      iterated_deriv_zero_right, prod_empty] },
  { intro m, rw [iterated_deriv_succ, coeff_derivative, ih (m+1), ← nat.cast_add_one,
      ← nsmul_eq_mul', smul_smul, mul_comm],
    apply congr_arg2,
    { have set_eq : (Ico m.succ (m + k.succ.succ)) = (Ico (m + 1).succ (m + 1 + k.succ)) ∪ {m+1},
      { simp_rw [← Ico_succ_singleton, union_comm, succ_eq_add_one, add_comm (k + 1), add_assoc],
        rw [Ico_union_Ico_eq_Ico]; simp_rw [add_le_add_iff_left, le_add_self], },
      rw [set_eq, prod_union, prod_singleton],
      { rw [disjoint_singleton_right, mem_Ico],
        exact λ h, (nat.lt_succ_self _).not_le h.1 } },
    { exact congr_arg _ (succ_add m k) } },
end

lemma coeff_iterated_deriv_as_prod_range :
  ∀ m : ℕ, (iterated_deriv f k).coeff m = (∏ i in range k, (m + k - i)) • f.coeff (m + k) :=
begin
  induction k with k ih,
  { simp },
  intro m,
  calc (f.iterated_deriv k.succ).coeff m
      = (∏ i in range k, (m + k.succ - i)) • f.coeff (m + k.succ) * (m + 1) :
    by rw [iterated_deriv_succ, coeff_derivative, ih m.succ, succ_add, add_succ]
  ... = ((∏ i in range k, (m + k.succ - i)) * (m + 1)) • f.coeff (m + k.succ) :
    by rw [← nat.cast_add_one, ← nsmul_eq_mul', smul_smul, mul_comm]
  ... = (∏ i in range k.succ, (m + k.succ - i)) • f.coeff (m + k.succ) :
    by rw [prod_range_succ, add_tsub_assoc_of_le k.le_succ, succ_sub le_rfl, tsub_self]
end

lemma iterated_deriv_eq_zero_of_nat_degree_lt (h : f.nat_degree < n) : iterated_deriv f n = 0 :=
begin
  ext m,
  rw [coeff_iterated_deriv_as_prod_range, coeff_zero, coeff_eq_zero_of_nat_degree_lt, smul_zero],
  linarith
end

lemma iterated_deriv_mul :
  iterated_deriv (p * q) n =
  ∑ k in range n.succ,
    n.choose k • (iterated_deriv p (n - k) * iterated_deriv q k) :=
begin
  induction n with n IH,
  { simp },

  calc (p * q).iterated_deriv n.succ
      = (∑ (k : ℕ) in range n.succ,
          (n.choose k) • (p.iterated_deriv (n - k) * q.iterated_deriv k)).derivative :
    by rw [iterated_deriv_succ, IH]
  ... = ∑ (k : ℕ) in range n.succ,
          (n.choose k) • (p.iterated_deriv (n - k + 1) * q.iterated_deriv k) +
        ∑ (k : ℕ) in range n.succ,
          (n.choose k) • (p.iterated_deriv (n - k) * q.iterated_deriv (k + 1)) :
    by simp_rw [derivative_sum, derivative_smul, derivative_mul, iterated_deriv_succ, smul_add,
      sum_add_distrib]
  ... = (∑ (k : ℕ) in range n.succ,
            (n.choose k.succ) • (p.iterated_deriv (n - k) * q.iterated_deriv (k + 1)) +
          1 • (p.iterated_deriv n.succ * q.iterated_deriv 0)) +
        ∑ (k : ℕ) in range n.succ,
          (n.choose k) • (p.iterated_deriv (n - k) * q.iterated_deriv (k + 1)) : _
  ... = ∑ (k : ℕ) in range n.succ,
          (n.choose k) • (p.iterated_deriv (n - k) * q.iterated_deriv (k + 1)) +
        ∑ (k : ℕ) in range n.succ,
            (n.choose k.succ) • (p.iterated_deriv (n - k) * q.iterated_deriv (k + 1)) +
        1 • (p.iterated_deriv n.succ * q.iterated_deriv 0) :
    by rw [add_comm, add_assoc]
  ... = ∑ (i : ℕ) in range n.succ,
          ((n+1).choose (i+1)) • (p.iterated_deriv (n + 1 - (i+1)) * q.iterated_deriv (i+1)) +
        1 • (p.iterated_deriv n.succ * q.iterated_deriv 0) :
    by simp_rw [choose_succ_succ, succ_sub_succ, add_smul, sum_add_distrib]
  ... = ∑ (k : ℕ) in range n.succ.succ,
          (n.succ.choose k) • (p.iterated_deriv (n.succ - k) * q.iterated_deriv k) :
    by rw [sum_range_succ' _ n.succ, choose_zero_right, tsub_zero],

  congr,
  refine (sum_range_succ' _ _).trans (congr_arg2 (+) _ _),
  { rw [sum_range_succ, nat.choose_succ_self, zero_smul, add_zero],
    refine sum_congr rfl (λ k hk, _),
    rw mem_range at hk,
    congr,
    rw [tsub_add_eq_add_tsub (nat.succ_le_of_lt hk), nat.succ_sub_succ] },
  { rw [choose_zero_right, tsub_zero] },
end

end semiring

section ring
variables [ring R] (p q : R[X]) (n : ℕ)

@[simp] lemma iterated_deriv_neg : iterated_deriv (-p) n = - iterated_deriv p n :=
begin
  induction n with n ih,
  { simp only [iterated_deriv_zero_right] },
  { simp only [iterated_deriv_succ, ih, derivative_neg] }
end

@[simp] lemma iterated_deriv_sub :
  iterated_deriv (p - q) n = iterated_deriv p n - iterated_deriv q n :=
by rw [sub_eq_add_neg, iterated_deriv_add, iterated_deriv_neg, ←sub_eq_add_neg]

end ring

end polynomial


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : María Inés de Frutos-Fernández
-/

import topology.continuous_function.compact -- funciones continuas, conjuntos compactos

/-!

# Ejercicio
En este fichero el objetivo es demostrar que si `f : X → Y`
es una función continua y `S : set X` es un conjunto compacto,
entonces su imagen `f '' S : set Y` también es compacta.

Un lema útil para esta demostración es

* `continuous.is_open_preimage` : la preimagen de un abierto bajo
una función continua es un abierto.
-/

-- Fijamos espacios topológicos X e Y
variables (X Y : Type) [topological_space X] [topological_space Y]

-- S es un subconjunto de X
variable (S : set X)

-- `f : X → Y` es una función
variables (f : X → Y)

-- Si f es continua y S es compacto,  la imagen f(S) también es un conjunto compacto.
example (hf : continuous f) (hS : is_compact S) : is_compact (f '' S) :=
begin
  rw is_compact_iff_finite_subcover at hS ⊢,
  intros ι U hU hUS,
  rw [set.image_subset_iff, set.preimage_Union] at hUS,
  obtain ⟨t, ht⟩ := hS (λ i, f⁻¹' (U i)) (λ i, hf.is_open_preimage (U i) (hU i)) hUS,
  use t,
  simp only [set.image_subset_iff, set.preimage_Union],
  exact ht,
end


/-
Proof Strategies:
Intro rules for or -
or.inl takes a proof of P and returns a proof of P ∨ Q
or.inr takes a proof of Q  and returns a proof of P ∨ Q
or ⇒ disjuncture
-/

axiom Q : Prop
axiom P : Prop
axiom q: Q

example : P ∨ Q :=
or.inr q -- because no proof of P exists

example : 0 = 1 ∨ 2 = 2 :=
or.inr (eq.refl 2)
--or.intro_right (0 = 1) rfl

-- CONSTRUCTIVE LOGIC
example : P ∨ ¬ P :=
begin
-- yikes...
-- apparently we are stuck
-- no proof either way!
_
end

-- CLASSICAL LOGIC
-- law of the excluded middle
axiom em: ∀ (P : Prop), P ∨ ¬ P
 #check em Q

example : ∀ (P : Prop), ¬ (¬ P) → P :=
begin
assume P,
assume nnp, -- (P → false) → false
cases (em P) with p np ,
exact p,
--exact false.elim (nnp np),  -- constructively this doesn't have a proof.
contradiction,
end

axiom : ∀ (P : Prop), ¬ (¬ P) → P

/-
proof by contradiction
look up and add here the difference between proof by negation and proof by contradiction

- show P, prove ¬ ¬ P (¬ P → false)

proof by negation is used to prove a prop of the form ¬ P. this world whenever you try and use
- show ¬ P, prove P → false

(PBC) if you want to show that P is true, assume it is false and show how that leads to a contradiction.
-/

-- paper pencil proof of square root 2 is irrational

/-
NEGATION                                        CONTRA
want ¬ P                                            want P,
show p → ff                                         show ¬ ¬ P
assume (p: P)                                       then infer P
show contradiction, proof of false                  → ¬ P → false
                                                [¬ ¬ P → P, classically valid]
-/

/-
40% of the exam is actually about the functional programming we have learned.
60% is propositions and proofs. (intro rules and elimination rules)
-/

axioms
    (R : Prop)
    (p : P)
    (pr: P → R)
    (qr: Q → R)

example : (P ∨ Q) → R :=
λ (pq : P ∨ Q),
match pq with
| or.inl pfP := pr p
| or.inr pfQ := qr q
end


/- Natural Numbers -/

namespace hidden

  inductive Nat where
  | zero : Nat
  | succ : Nat → Nat
  deriving Repr

  namespace Nat

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

    notation:65 lhs:65 "+" rhs:66 => add lhs rhs
    notation:max "one" => succ zero

    theorem zero_not_succ (n : Nat) : succ n ≠ zero := by simp [add]

    theorem add_zero (n : Nat) : n + zero = n := by rfl

    theorem add_succ (m n : Nat) : m + succ n = succ (m + n) := by rfl

    theorem succ_eq_add_one (n : Nat) : n + one = succ n := by
      calc
        n + one = succ (n + zero) := by simp only [add_succ]
        _ = succ n := by simp only [add_zero]

    theorem zero_add (n: Nat) : zero + n = n :=
      Nat.recOn (motive := fun x => zero + x = x)
        n
        (show zero + zero = zero from rfl)
        (fun (n : Nat) (ih : zero + n = n) =>
          show zero + succ n = succ n from
            calc
              zero + succ n = succ (zero + n) := rfl
              _ = succ n := by rw [ih])

    theorem add_assoc (m n k : Nat) : (m + n) + k = m + (n + k) :=
      Nat.recOn (motive := fun x => (m + n) + x = m + (n + x)) k
        (show (m + n) + zero = m + (n + zero) by rfl)
        (fun k ih => by
          calc
            (m + n) + succ k = succ ((m + n) + k) := by rfl
            _ = succ (m + (n + k)) := by rw [ih])

    theorem succ_add (m n : Nat) : succ n + m = succ (n + m) :=
      Nat.recOn (motive := fun x => succ n + x = succ (n + x)) m
        (by rfl)
        (fun m ih => by simp only [add_succ, *])

    theorem add_comm (m n : Nat) : m + n = n + m :=
      Nat.recOn (motive := fun x => m + x = x + m) n
        (show m + zero = zero + m by simp [zero_add, add])
        (fun n ih => by calc
          m + succ n = succ (m + n) := by rfl
          _ = succ (n + m) := by rw [ih]
          _ = succ n + m := by simp only [succ_add])

    theorem succ_eq (m n : Nat) : succ m = succ n → m = n := by
      intro h
      match h with
      | rfl => rfl

    theorem left_add_cancel (m n k : Nat) : m + k = n + k → m = n := by
      intro h
      induction k with
      | zero => simp only [add_zero]; assumption
      | succ k ih =>
        have : succ (m + k) = succ (n + k) := by simp only [add]; assumption
        have : m + k = n + k := by apply succ_eq; assumption
        show m = n; simp only [ih, *]

    theorem not_and_iff_or_not (p q : Prop) : ¬ (p ∧ q) ↔ ¬ p ∨ ¬ q := by
      apply Iff.intro
      . intro
        cases (Classical.em p) with
        | inl => cases (Classical.em q) with
          | inl =>
            have : p ∧ q := by constructor <;> assumption
            contradiction
          | inr => apply Or.inr; assumption
        | inr => apply Or.inl; assumption
      . intro h
        intro
        | And.intro _ _ =>
          cases h <;> contradiction

    theorem zero_sum_elim (m n : Nat) : m + n = zero → m = zero ∧ n = zero := by
      intro h
      apply Classical.byContradiction
      intro hn
      have : ¬ (m = zero) ∨ ¬ (n = zero) := Iff.mp (not_and_iff_or_not ..) hn
      have : m ≠ zero ∨ n ≠ zero := by simp [*]
      cases this with
      | inl => match m with
        | zero => contradiction
        | succ m' =>
          have : succ (m' + n) = zero := by simp [succ_add, *] at h
          match (succ (m' + n)) with
          | zero => contradiction
          | succ a => contradiction
      | inr => match n with
        | zero => contradiction
        | succ n' =>
          have : succ (m + n') = zero := by simp [add, *] at h
          cases (succ (m + n')) <;> contradiction

    /- Predecesor -/
    def pred (n : Nat) : Nat :=
      match n with
      | zero => zero
      | succ n' => n'

    theorem succ_pred_self (n : Nat) (h : n ≠ zero) : succ (pred n) = n :=
      match n with
      | zero => by contradiction
      | succ n' => by rfl

    /- Multiplication -/
    def mul (m n : Nat) : Nat :=
      match n with
      | zero => zero
      | succ n' => mul m n' + m

    notation:75 lhs:75 "*" rhs:76 => mul lhs rhs

    theorem mul_zero (n : Nat) : n * zero = zero := by rfl

    theorem mul_succ (m n : Nat) : m * succ n = m * n + m := by rfl

    theorem zero_mul (n : Nat) : zero * n = zero := by
      induction n with
      | zero => rfl
      | succ n ih => calc
        zero * succ n = zero * n + zero := by rw [mul_succ]
        _ = zero + zero := by simp only [ih]
        _ = zero := by simp only [add]

    theorem mul_one (n : Nat) : n * one = n := by
      calc
        n * one = n * zero + n := by simp only [mul]
        _ = n := by simp only [mul_zero, zero_add]

    theorem mul_add (m n k : Nat) : m * (n + k) = m * n + m * k := by
      induction k with
      | zero => rfl
      | succ k ih => calc
        m * (n + succ k) = m * succ (n + k) := by simp only [add]
        _ = m * (n + k) + m := by simp only [mul]
        _ = m * n + m * k + m := by rw [ih]
        _ = m * n + m * succ k := by simp only [mul_succ, add_assoc]

    theorem add_mul (m n k : Nat) : (m + n) * k = m * k + n * k := by
      induction k with
      | zero => rfl
      | succ k ih => calc
        (m + n) * succ k = (m + n) * k + (m + n) := by simp only [mul_succ]
        _ = m * k + n * k + (m + n) := by rw [ih]
        _ = (m * k + m) + (n * k + n) := by simp only [←add_assoc, add_comm]
        _ = m * succ k + n * succ k := by simp only [mul_succ]

    theorem one_mul (n : Nat) : one * n = n := by
      induction n with
      | zero => rfl
      | succ n ih => calc
        one * succ n = one * n + one := by simp only [mul]
        _ = n + one := by rw [ih]
        _ = succ n := by rw [succ_eq_add_one]

    theorem mul_comm (m n : Nat) : m * n = n * m := by
      induction n with
      | zero => simp only [mul_zero, zero_mul]
      | succ n ih => calc
        m * succ n = m * n + m := by simp only [mul]
        _ = n * m + one * m := by simp only [ih, one_mul]
        _ = (n + one) * m := by simp only [add_mul]
        _ = succ n * m := by simp only [succ_eq_add_one]

    theorem mul_assoc (m n k : Nat) : m * (n * k) = (m * n) * k := by
      induction k with
      | zero => simp only [mul]
      | succ k ih => calc
        m * (n * succ k) = m * (n * k + n) := by simp only [mul]
        _ = m * (n * k) + m * n := by simp only [mul_add]
        _ = (m * n) * k + (m * n) * one := by simp only [ih, mul_one]
        _ = (m * n) * (k + one) := by simp only [mul_add]
        _ = (m * n) * succ k := by simp only [succ_eq_add_one]

    theorem not_or_iff_and_not (p q : Prop) : ¬ (p ∨ q) ↔ ¬ p ∧ ¬ q := by
      apply Iff.intro
      . intro
        cases (Classical.em p) with
        | inl =>
          have : p ∨ q := by apply Or.inl; assumption
          contradiction
        | inr => cases (Classical.em q) with
          | inl =>
            have : p ∨ q := by apply Or.inr; assumption
            contradiction
          | inr => constructor <;> assumption
      . intro h
        intro ho
        cases ho with
        | inl => apply h.left; assumption
        | inr => apply h.right; assumption

    theorem zero_mul_elim (m n : Nat) : zero = m * n → m = zero ∨ n = zero := by
      intro h
      apply Classical.byContradiction
      intro
      have : m ≠ zero ∧ n ≠ zero := by
        apply Iff.mp (not_or_iff_and_not ..); assumption
      match this with
      | And.intro _ _ =>
        match n with
        | zero => contradiction
        | succ n => match m with
          | zero => contradiction
          | succ m =>
            have : zero = succ (succ m * n + m) := by calc
              zero = succ m * succ n := by simp only [*]
              _ = succ m * n + succ m := by simp only [mul]
              _ = succ (succ m * n + m) := by simp only [add]
            contradiction

    /-
    Exponentiation of Natural Numbers
    -/

    def pow : Nat → Nat → Nat
      | zero, zero => zero
      | _, zero => one
      | m, succ n => (pow m n) * m

    notation:85 lhs:85 "^" rhs:86 => pow lhs rhs

    theorem pow_zero (n : Nat) : n ≠ zero → n ^ zero = one := by
      intro; cases n; contradiction; rfl

    theorem pow_one (n : Nat) : n ^ one = n := by
      match n with
      | zero => rfl
      | succ n => calc
        (succ n) ^ one = (succ n) ^ zero * (succ n) := by simp only [pow]
        _ = one * (succ n) := by simp only [pow]
        _ = succ n := by simp only [one_mul]

    theorem one_pow (n : Nat) : one ^ n = one := by
      induction n with
      | zero => rfl
      | succ n ih => simp [pow, ih, one_mul]

    theorem zero_pow (n : Nat) : zero ^ n = zero := by
      cases n <;> rfl

    theorem pow_mul_sum (n a b : Nat) : n ^ a * n ^ b = n ^ (a + b) := by
      induction a with
      | zero => match n with
        | zero => calc
          zero ^ zero * zero ^ b = zero * zero ^ b := by simp [pow]
          _ = zero ^ (zero + b) := by simp [zero_mul, zero_pow, zero_add]
        | succ n =>
          have : succ n ≠ zero := by simp [add]
          calc
            succ n ^ zero * succ n ^ b = one * succ n ^ b := by simp [pow_zero (succ n) this]
            _ = succ n ^ b := by simp [one_mul]
            _ = succ n ^ (zero + b) := by simp [zero_add]
      | succ a ha => calc
        n ^ (succ a) * n ^ b = (n ^ a * n) * n ^ b := by simp [pow]
        _ = (n ^ a * n ^ b) * n := by simp [mul_assoc, mul_comm]
        _ = n ^ (a + b) * n := by rw [ha]
        _ = n ^ (succ (a + b)) := by simp [pow]
        _ = n ^ ((a + one) + b) := by simp [succ_eq_add_one (a + b), add_assoc, add_comm]; rfl
        _ = n ^ (succ a + b) := by simp [succ_eq_add_one]

    theorem pow_dist (m n a : Nat) : (m * n) ^ a = m ^ a * n ^ a := by
      induction a with
      | zero => match m, n with
        | zero, _ => simp [zero_mul, pow]
        | _, zero => simp [mul_zero, pow]
        | succ m, succ n => simp [pow]; rfl
      | succ a ih => calc
         (m * n) ^ (succ a) = (m * n) ^ a * (m * n) := by simp [pow]
         _ = (m ^ a * n ^ a) * (m * n) := by rw [ih]
         _ = (m ^ a * m) * (n ^ a * n) := by simp [mul_comm, mul_assoc]
         _ = m ^ succ a * n ^ succ a := by simp [pow]

    theorem pow_of_pow (n a b : Nat) : (n ^ a) ^ b = n ^ (a * b) := by
      induction a with
      | zero => match n with
        | zero => simp [pow, zero_pow]
        | succ n => calc
          (succ n ^ zero) ^ b = one ^ b := by simp [pow_zero]
          _ = one ^ (zero * b) := by simp [one_pow]
          _ = (succ n) ^ (zero * b) := by simp [pow_zero, zero_mul]
      | succ a ih => calc
        (n ^ (succ a)) ^ b = (n ^ a * n) ^ b := by simp [pow]
        _ = (n ^ a) ^ b * n ^ b := by simp [pow_dist]
        _ = n ^ (a * b) * n ^ b := by simp [ih]
        _ = n ^ (a * b + b) := by simp [pow_mul_sum]
        _ = n ^ ((a + one) * b) := by simp [add_mul, one_mul]

    /- Nth root of b eq a -/
    def root (n b a : Nat) : Prop := a ^ n = b

    theorem root_cancel : root n (b ^ n) b := by rfl
  end Nat
end hidden

/- Operation over Vectors -/

namespace hidden2

  inductive Vector (α : Type u) : Nat → Type u where
  | nil : Vector α 0
  | cons : α → {n : Nat} → Vector α n → Vector α (n + 1)
  deriving Repr

  namespace Vector

  def head : {n : Nat} → Vector α (n + 1) → α
    | _, cons a as => a

  def tail : {n : Nat} → Vector α (n + 1) → Vector α n
    | _, cons a as => as

  def appendAux (h : m = n) (vs : Vector α m) : Vector α n := by
    simp [h] at vs; assumption

  def append {m n : Nat} (as : Vector α m) (bs : Vector α n) : Vector α (m + n) := by
    match m, as with
    | 0, nil =>
      have : n = 0 + n := by simp_arith
      exact appendAux this bs
    | Nat.succ m, cons a as =>
      have : (m + (n + 1) = (m + 1) + n) := by simp_arith [←Nat.add_assoc m 1 n]
      exact appendAux this (cons a (append as bs))

  #eval append (cons 1 (cons 2 nil)) (cons 4 (cons 5 nil)) -- 1 2 4 5

  end Vector

end hidden2

/- Arithmetic Operations -/

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

namespace Expr

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

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

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

  #eval eval sampleVal sampleExpr -- 47

  def simpConst : Expr → Expr
    | plus (const a) (const b) => const (a + b)
    | times (const a) (const b) => const (a * b)
    | e => e

  theorem simpConst_eq (v : Nat → Nat)
      : ∀ e : Expr, eval v (simpConst e) = eval v e := by
    intro e
    match e with
    | const n => rfl
    | var n => rfl
    | plus f g => admit
    | times f g => match f, g with
      | const m, const n => rfl
      | f, g => admit

end Expr