import data.set.basic tactic.interactive

/-
Here's Kevin's problem:

  Let’s say I tell two of my tutees secret non-negative integers, and then I wrote
  two distinct non-negative integers on my whiteboard; one is the sum of the two
  secret integers, and the other one is not. I then take it in turns asking my
  tutees whether they know the other tutee’s number! Prove that eventually one of
  them will (truthfully) say “yes”.

To model this problem, we use a modal framework. A frame is a set of possible
worlds. Each world represents the way things could be. In this case, we
will allow evolution of the set of possible worlds by using a changing predicate
of "live" worlds that represents all the worlds that have not yet been excluded
by some reasoning from a declaration of ignorance.
-/

section
parameters (X Y : nat)

/-- In this model, we will store the things that are not public information
  in the set of possible worlds. So the numbers X,Y on the blackboard are
  parameters because there is no "possibility" about it, everyone knows what
  they are. -/
structure world :=
(A : nat) -- the number given to Alice
(B : nat) -- the number given to Bob
(consistent : A + B = X ∨ A + B = Y) -- the numbers can't contradict the whiteboard

instance world.inhabited : inhabited world := ⟨⟨X, 0, or.inl rfl⟩⟩

/-- Given a set of "live" worlds, we can figure out which numbers
  A thinks are possible for B to have -/
def A_thinks (w : world) (live : set world) : set nat :=
{B' | ∃ w':world, w' ∈ live ∧ w'.A = w.A ∧ w'.B = B'}

/-- Given a set of "live" worlds, we can figure out which numbers
  B thinks are possible for A to have -/
def B_thinks (w : world) (live : set world) : set nat :=
{A' | ∃ w':world, w' ∈ live ∧ w'.B = w.B ∧ w'.A = A'}

/-- A knows the answer if the possible values she has for B's number is a singleton -/
def A_knows (w : world) (live) := ∃ n, A_thinks w live = {n}

/-- B knows the answer if the possible values he has for A's number is a singleton -/
def B_knows (w : world) (live) := ∃ n, B_thinks w live = {n}

/-- This is where the action happens. The set of "live" worlds is a
  representation of the possible worlds that are eliminated in each stage
  assuming that A and B keep saying they don't know the answer. The game
  ends when one says they know the answer, so we only have to worry about
  this path; we're going to show that it can't continue forever. -/
def live : ℕ → set world
| 0     := set.univ -- initially no one knows anything, all possibilities are live
| (n+1) :=
  -- At stage n+1, if we assume that A and B both pass, then neither knows the answer
  -- so all worlds where they figured it out are excluded
  {w ∈ live n | ¬ A_knows w (live n) ∧ ¬ B_knows w (live n)}

/- because we're mathematicians: -/
local attribute [instance] classical.prop_decidable

/- At this point, the main theorem we want to prove is that there is some stage where
  either A or B solves the problem -/
theorem A_or_B_knows (w : world) : ∃ n, w ∈ live n ∧ (A_knows w (live n) ∨ B_knows w (live n)) :=
begin
  /- We'll prove that at each stage, the worlds at the "ends" are lost, sweeping from
    both sides (we only need one side to know that eventually all worlds are excluded). -/
  suffices : ∀ (n) (w':world), w' ∈ live n → w'.A + n ≤ max X Y + w'.B,
  { by_contra H,
    replace H : ∀ n, w ∈ live n,
    { simp [not_exists, not_or_distrib] at H,
      intro n,
      induction n with n; simp [live, *] },
    have : w.A + (max X Y + w.B) < max X Y + w.B := this _ w (H (max X Y + w.B + 1)),
    exact not_le_of_gt this (nat.le_add_left _ _) },
  clear w, intros n w wl,
  induction n with n IH generalizing w,
  { refine add_le_add _ (nat.zero_le _),
    refine le_trans (nat.le_add_right w.A w.B) _,
    cases w.consistent; simp [h, le_max_left, le_max_right] },
  { rcases wl with ⟨wl, HA, HB⟩,
    refine lt_of_le_of_ne (IH _ wl) _,
    intro he,
    have A_thinks_other : ¬ ∀ k ∈ A_thinks w (live n), k = w.B,
    { have A_thinks_B : w.B ∈ A_thinks w (live n) := ⟨_, wl, rfl, rfl⟩,
      refine λ h, HA ⟨w.B, _⟩,
      simp [set.set_eq_def],
      exact λ k, ⟨h k, λ e, e.symm ▸ A_thinks_B⟩ },
    have B_thinks_other : ¬ ∀ k ∈ B_thinks w (live n), k = w.A,
    { have B_thinks_A : w.A ∈ B_thinks w (live n) := ⟨_, wl, rfl, rfl⟩,
      refine λ h, HB ⟨w.A, _⟩,
      simp [set.set_eq_def],
      exact λ k, ⟨h k, λ e, e.symm ▸ B_thinks_A⟩ },
    rcases not_ball.1 A_thinks_other with ⟨B', A_thinks_B', hB'⟩,
    rcases A_thinks_B' with ⟨w₁, w₁l, w₁A, rfl⟩,
    rcases not_ball.1 B_thinks_other with ⟨A', B_thinks_A', hA'⟩,
    rcases B_thinks_A' with ⟨w₂, w₂l, w₂B, rfl⟩,
    have := IH _ w₁l,
    rw [w₁A, he] at this,
    have w₁B := lt_of_le_of_ne (le_of_add_le_add_left this) (ne.symm hB'),
    have := IH _ w₂l,
    rw [w₂B, ← he] at this,
    have w₂A := lt_of_le_of_ne (le_of_add_le_add_right this) hA',
    have lt₁ := add_lt_add_of_le_of_lt (le_of_eq w₁A.symm) w₁B,
    have lt₂ := add_lt_add_of_lt_of_le w₂A (le_of_eq w₂B),
    /- at this point, the contradiction is clear, since A+B of w₁ is
      less than A+B at w, which is less than A+B at w₂, while A+B is
      in the set {X,Y} for any world. But proving this requires a
      lot of case analysis -/
    cases w₁.consistent with w₁h w₁h; rw w₁h at lt₁;
    cases w.consistent with wh wh; rw wh at lt₁ lt₂;
    try { apply lt_irrefl _ lt₁ };
    cases w₂.consistent with w₂h w₂h; rw w₂h at lt₂;
    try { apply lt_irrefl _ lt₂ };
    exact lt_asymm lt₁ lt₂ }
end

end


import MyNat.Addition
import MyNat.Multiplication
namespace MyNat
open MyNat

/-!
# Function world.

## Level 2: the `intro` tactic.

Let's make a function. Let's define the function on the natural
numbers which sends a natural number `n` to `3n+2`. In the example
below you will see that our goal is `⊢ MyNat → MyNat`. A mathematician
might denote this set with some exotic name such as `Hom(ℕ,ℕ)`,
but computer scientists use notation `X → Y` to denote the set of
functions from `X` to `Y` and this name definitely has its merits.
In type theory, `X → Y` is a type (the type of all functions from `X` to `Y`),
and `f : X → Y` means that `f` is a term
of this type, i.e., `f` is a function from `X` to `Y`.

To define a function `X → Y` we need to choose an arbitrary
element `x ∈ X` and then, perhaps using `x`, make an element of `Y`.
The Lean tactic for "let `x ∈ X` be arbitrary" is `intro x`.

## Rule of thumb:

If your goal is `P → Q` then `intro p` will make progress.

To solve the goal below, you have to come up with a function from `MyNat`
to `MyNat`. We can start with `intro n`

(i.e. "let `n ∈ ℕ` be arbitrary") and note that our
local context now looks like this:

```
n : MyNat
⊢ MyNat
```

Our job now is to construct a natural number, which is
allowed to depend on `n`. We can do this using `exact` and
writing a formula for the function we want to define. For example
we imported addition and multiplication at the top of this file,
so `exact 3*n+2`
will close the goal, ultimately defining the function `f(n)=3n+2`.

## Definition

We define a function from MyNat to MyNat.
-/
example : MyNat → MyNat := by
  intro n
  exact 3*n+2

/-!
You can hover your mouse over the tactics `intro` and `exact`
to the documentation on these tactics in case you need a
reminder later on.
See also [intro tactic](../Tactics/intro.lean.md)

Next up [Level 3](./Level3.lean.md)
-/


import MyNat.Power
import MultiplicationWorld.Level2 -- mul_one
import MultiplicationWorld.Level9 -- simp additions
namespace MyNat
open MyNat

/-!

# Power World

## Level 6: `mul_pow`

Here we use the `attribute [simp]` additions we made in
[level 9 of Multiplication World](../MultiplicationWorld/Level9.lean.md)
so that the `simp` tactic can simplify expressions involving `*`.

## Lemma
For all naturals `a`, `b`, `n`, we have `(ab) ^ n = a ^ nb ^ n`.
-/
lemma mul_pow (a b n : MyNat) : (a * b) ^ n = a ^ n * b ^ n := by
  induction n with
  | zero =>
    rw [zero_is_0]
    repeat rw [pow_zero]
    rw [mul_one]
  | succ n ih =>
    repeat rw [pow_succ]
    rw [ih]
    simp

/-!
Next up [Level 7](./Level7.lean.md)
-/


import Mathlib.Tactic.Basic

/-!
## The Curry–Howard Correspondence

You will likely have noticed that the same symbol `→` is used both for implication
(e.g., `false → true`) and as the type constructor of functions (e.g., `ℤ → ℕ`).
Similarly, ∀ is used both as a quantifier and to specify dependent types. Without
context, we cannot tell whether `a → b` refers to the type of a function with domain
`a` and codomain `b` or to the proposition “`a` implies `b`,” and similarly,
`∀x : a, b[x]` can denote a proposition or a dependent type.

It turns out that not only the two pairs of concepts look the same, they are the
same. This is called the _Curry–Howard correspondence_. It is also called the
_PAT principle_, where PAT is a double mnemonic:

> PAT = propositions as types     PAT = proofs as terms

Furthermore, because types are also terms, we also have that propositions are
terms. However, PAT is not a quadruple mnemonic (PAT = proofs as types).

Haskell Curry and William Alvin Howard noticed that for some logics, propositions are isomorphic to
types, and proofs are isomorphic to terms. Hence, in dependent type theory, we _identify_ proofs with
terms as well as propositions with types, a considerable economy of concepts. The question “Is `H` a
proof of `P`?” becomes equivalent to “Does the term `H` have type `P`?” As a result, inside of Lean, there
is no proof checker, only a type checker.

Let us go through the dramatis personae one by one. We use the metavariables `σ`, `τ` for types;
`P`, `Q` for propositions; `t`, `u`, `x` for terms; and `h`, `G`, `H`, for proofs. Starting with
“propositions as types,” for types, we have the following:

1. `σ → τ` is the type of (total) functions from `σ` to `τ`.
2. `∀x : σ, τ[x]` is the dependent function type from `x : σ` to `τ[x]`.

In contrast, for propositions, we have the following:
1. `P → Q` can be read as “`P` implies `Q`,” or as the type of functions mapping proofs
of `P` to proofs of `Q`.
2. `∀x : σ, Q[x]` can be read as “for all `x, Q[x]`,” or as the type of functions
mapping values `x` of type `σ` to proofs of `Q[x]`.

Continuing with “proofs as terms,” for terms, we have the following:

1. A constant is a term.
2. A variable is a term.
3. `t u` is the application of function `t` to argument `u`.
4. `λ x => t[x]` is a function mapping `x` to `t[x]`.

In contrast, for proofs (i.e., proof terms), we have the following:

1. The name of a lemma or hypothesis is a proof.
2. `H t`, which instantiates the leading parameter or quantifier of proof `H`’s statement with term
   `t`, is a proof.
3. `H G`, which discharges the leading assumption of `H`’s statement with proof `G`, is a proof.
   This operation is called modus ponens.
4. `λ h : P => H[h]` is a proof of `P → Q`, assuming `H[h]` is a proof of `Q` for `h : P`.
5. `λ x : σ => H[x]` is a proof of `∀x : σ, Q[x]`, assuming `H[x]` is a proof of `Q[x]` for `x : σ`.

The last two cases are justified by the LAM' rule. In a structured proof, as opposed to a raw proof
term, we would write assume or fix instead of λ, and we would probably want to repeat the conclusion
using show for readability, as follows:

```lean
lemma case_4 (H : P → Q):
  P → Q :=
λ h : P =>
  show Q from
  H h

lemma case_5 :
∀ x : σ, Q x :=
λ x =>
  show Q x from
  H x
```
Some commands are provided in Lean under two different names but are really
the same as per the Curry–Howard correspondence. This is the case for
`axiom`.

There are also pairs with slightly different behavior, such as `def` and `lemma` or
`let` and `have`. The fundamental difference is this: When we define some function
or data, we care not only about the type but also about the body—the behavior. On
the other hand, once we have proved a lemma, the proof becomes _irrelevant_. All
that matters is that there is a proof. We will return to the topic of proof irrelevance
in Chapter 11.

The following correspondence table summarizes the differences between tactical proofs, structured
proofs, and raw proof terms:

| Tactical proofs | Structured proofs | Raw proof terms |
|-----------------|-------------------|-----------------|
| `intro x`         | `λ x =>`          | `λ x =>`          |
| `intro h`         | `λ h =>`            | `λ h =>`          |
| `have k := H`     | `have k := H`       | `(λ k => . . .) H`|
| `let x := t`      | `let x := t`        | `let x := t`      |
| `exact (H : P)`   | `show P from H`     | `H : P`          |
| `calc . . .`      | `calc . . .`        | `calc . . .`      |

-- BUGBUG: I made some changes to this table, it needs close review.

The terminology of dependent type theory can be quite confusing, because some words have a narrow
and a broad sense. The following diagram captures the various meanings of important words:

-- BUGBUG nice latex chart goes here...

According to the broad senses, any expression is a term, any expression that may occur on the
right-hand side of a typing judgment is a type, and any expression that may occur on the right-hand
side of a typing judgment with a type on its left-hand side is a universe. This is consistent with the
reading of `t : u` as “`t` has type `u`” and the notion that universes are types of types.

-/


import data.real.basic

local attribute [instance, priority 0] classical.prop_decidable

noncomputable theory

-- Lean's definition of abs is: abs (x) = max x (-x)

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

definition is_limit (f : ℕ → ℝ) (l : ℝ) : Prop := ∀ ε > 0, ∃ N, ∀ n ≥ N, | f n - l | < ε

definition has_limit (f : ℕ → ℝ) : Prop := ∃ l : ℝ, is_limit f l

definition limit (f : ℕ → ℝ) : ℝ := dite (has_limit f) classical.some (λ _, 0)

example : is_limit (λ x, 1/x) 0 :=
begin
  unfold is_limit,
  intros ε Hε,
  let N0 := ceil (1 / ε), -- seems to me we want nat.ceil
  let N := int.nat_abs N0,
  use N,
  intro n,
  intro Hn,
  rw sub_zero,
  have H1 : 1 / ε > 0 := div_pos zero_lt_one Hε,
  have H2 : N0 > 0 := lt_ceil.2 H1,
  have H3 : 0 < N := int.nat_abs_pos_of_ne_zero (ne_of_gt H2),
  have H4 : 0 < n := lt_of_lt_of_le H3 Hn,
  have H5 : 0 < (n : ℝ) := by simp [H4],
  have H6 : 0 < 1 / (n : ℝ) := div_pos zero_lt_one H5,
  rw abs_of_nonneg (le_of_lt H6),
  rw div_lt_iff H5,
  rw int.div_lt_iff_lt_mul
end


import .simplify_eq .simplify_le .div_lemmas .lemmas

namespace nat

lemma pow_add' (b m n : ℕ): b^(m+n) = b^m * b^n :=
begin
  induction n,
  case zero {
    simp,
  },
  case succ n ind {
    simp [add_succ, pow_succ, ind],
  }
end

theorem add_mod_self : ∀ m n : ℕ, (m + n) % n = m % n :=
begin
  intros m n,
  cases n,
  case nat.zero { trivial, },
  case nat.succ n { simp, },
end

/-- Congruence rule for `le` and `add`. -/
def add_le_add_both {a b x y : ℕ} (p : a ≤ b) (q : x ≤ y) : a + x ≤ b + y :=
begin
  transitivity,
  apply nat.add_le_add_right p,
  apply nat.add_le_add_left q
end

/-- Congruence rule for `le` and `mul`. -/
def mul_le_mul_both {a b x y : ℕ} (p : a ≤ b) (q : x ≤ y) : a * x ≤ b * y :=
begin
  transitivity,
  apply nat.mul_le_mul_right x p,
  apply nat.mul_le_mul_left b q
end

end nat


/-
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 tactic
import data.nat.parity
import data.real.basic
import data.finset.basic
import data.real.basic

/-!
# Nuevas tácticas
* `rwa`
* `rintro` (truco con `rfl`)
-/

/- ## rwa
  Combina las tácticas `rw` y `assumption`. Es decir, si una de nuestras
  hipótesis locales (digamos `h`) es igual a la meta después de aplicar
  el rewrite, `rwa` cierra la meta, ahorrándonos la instrucción `exact h`. -/

example {P Q R : Prop} (h1 : P ↔ Q) (h2 : Q ↔ R) :
  P ↔ R :=
begin
  rwa h1
  -- equivalente a
  -- rw h1, exact h2,
end

/- ## rintro

Una forma alternative de utilizar `rintro` es sustituyendo uno de los argumentos,
que necesariamente debe ser de la forma `h : a = b`, por la palabra clave `rfl`.
El efecto es que `rintro` reemplazará b por a ó viceversa en todo lugar posible.

Este truco también funciona con otras tácticas como `rcases` y `obtain`.
-/

-- Versión sin rfl
example {X Y : Type} (f : X → Y) {y : Y} (T : set Y) :
  (∃ x : X, x ∈ f ⁻¹' T ∧ f x = y) → y ∈ T :=
begin
  rintro ⟨x, hx, hxy⟩,
  rw ← hxy,
  exact hx,
end

-- Versión con rfl
example {X Y : Type} (f : X → Y) {y : Y} (T : set Y) :
  (∃ x : X, x ∈ f ⁻¹' T ∧ f x = y) → y ∈ T :=
begin
  rintro ⟨x, hx, rfl⟩,
  exact hx,
end


import .love03_forward_proofs_demo

/-! # LoVe Exercise 4: Functional Programming -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Reverse of a List

We define a new accumulator-based version of `reverse`. The first argument,
`as`, serves as the accumulator. This definition is __tail-recursive__, meaning
that compilers and interpreters can easily optimize the recursion away,
resulting in more efficient code. -/

def accurev {α : Type} : list α → list α → list α
| as []        := as
| as (x :: xs) := accurev (x :: as) xs

/-! 1.1. Our intention is that `accurev [] xs` should be equal to `reverse xs`.
But if we start an induction, we quickly see that the induction hypothesis is
not strong enough. Start by proving the following generalization (using the
`induction'` tactic or pattern matching): -/

lemma accurev_eq_reverse_append {α : Type} :
  ∀as xs : list α, accurev as xs = reverse xs ++ as
| as []        := by refl
| as (x :: xs) := by simp [reverse, accurev, accurev_eq_reverse_append _ xs]

/-! 1.2. Derive the desired equation. -/

lemma accurev_eq_reverse {α : Type} (xs : list α) :
  accurev [] xs = reverse xs :=
by simp [accurev_eq_reverse_append]

/-! 1.3. Prove the following property.

Hint: A one-line inductionless proof is possible. -/

lemma accurev_accurev {α : Type} (xs : list α) :
  accurev [] (accurev [] xs) = xs :=
by simp [accurev_eq_reverse, reverse_reverse]

/-! 1.4. Prove the following lemma by structural induction, as a "paper" proof.
This is a good exercise to develop a deeper understanding of how structural
induction works (and is good practice for the final exam).

    lemma accurev_eq_reverse_append {α : Type} :
      ∀as xs : list α, accurev as xs = reverse xs ++ as

Guidelines for paper proofs:

We expect detailed, rigorous, mathematical proofs. You are welcome to use
standard mathematical notation or Lean structured commands (e.g., `assume`,
`have`, `show`, `calc`). You can also use tactical proofs (e.g., `intro`,
`apply`), but then please indicate some of the intermediate goals, so that we
can follow the chain of reasoning.

Major proof steps, including applications of induction and invocation of the
induction hypothesis, must be stated explicitly. For each case of a proof by
induction, you must list the inductive hypotheses assumed (if any) and the goal
to be proved. Minor proof steps corresponding to `refl`, `simp`, or `cc` need
not be justified if you think they are obvious (to humans), but you should say
which key lemmas they depend on. You should be explicit whenever you use a
function definition or an introduction rule for an inductive predicate. -/

/-! We perform the proof by structural induction on `xs` (generalizing `as`).

Case `[]`: The goal is `accurev as [] = reverse [] ++ as`. The left-hand side
is `as` by definition of `accurev`. The right-hand side is `as` by definition
of `reverse` and `++`.

Case `x :: xs`: The goal is `accurev as (x :: xs) = reverse (x :: xs) ++ as`.
The induction hypothesis is `∀as, accurev as xs = reverse xs ++ as`.

Let us simplify the goal's left-hand side:

      accurev as (x :: xs)
    = accurev (x :: as) xs        -- by definition of `accurev`
    = reverse xs ++ (x :: as)     -- by the induction hypothesis

Now let us massage the right-hand side so that it matches the simplified
left-hand side:

      reverse (x :: xs) ++ as
    = (reverse xs ++ [x]) ++ as   -- by definition of `reverse`
    = reverse xs ++ ([x] ++ as)   -- by associativity of `++`
    = reverse xs ++ (x :: as)     -- by definition of `++`

The two sides are equal. QED -/

/-! ## Question 2: Drop and Take

The `drop` function removes the first `n` elements from the front of a list. -/

def drop {α : Type} : ℕ → list α → list α
| 0       xs        := xs
| (_ + 1) []        := []
| (m + 1) (x :: xs) := drop m xs

/-! 2.1. Define the `take` function, which returns a list consisting of the the
first `n` elements at the front of a list.

To avoid unpleasant surprises in the proofs, we recommend that you follow the
same recursion pattern as for `drop` above. -/

def take {α : Type} : ℕ → list α → list α
| 0       _         := []
| (_ + 1) []        := []
| (m + 1) (x :: xs) := x :: take m xs

#eval take 0 [3, 7, 11]   -- expected: []
#eval take 1 [3, 7, 11]   -- expected: [3]
#eval take 2 [3, 7, 11]   -- expected: [3, 7]
#eval take 3 [3, 7, 11]   -- expected: [3, 7, 11]
#eval take 4 [3, 7, 11]   -- expected: [3, 7, 11]

#eval take 2 ["a", "b", "c"]   -- expected: ["a", "b"]

/-! 2.2. Prove the following lemmas, using `induction'` or pattern matching.
Notice that they are registered as simplification rules thanks to the `@[simp]`
attribute. -/

@[simp] lemma drop_nil {α : Type} :
  ∀n : ℕ, drop n ([] : list α) = []
| 0       := by refl
| (_ + 1) := by refl

@[simp] lemma take_nil {α : Type} :
  ∀n : ℕ, take n ([] : list α) = []
| 0       := by refl
| (_ + 1) := by refl

/-! 2.3. Follow the recursion pattern of `drop` and `take` to prove the
following lemmas. In other words, for each lemma, there should be three cases,
and the third case will need to invoke the induction hypothesis.

Hint: Note that there are three variables in the `drop_drop` lemma (but only two
arguments to `drop`). For the third case, `←add_assoc` might be useful. -/

lemma drop_drop {α : Type} :
  ∀(m n : ℕ) (xs : list α), drop n (drop m xs) = drop (n + m) xs
| 0       n xs        := by refl
| (_ + 1) _ []        := by simp [drop]
| (m + 1) n (x :: xs) :=
  by simp [drop, drop_drop m n xs, ←add_assoc]

lemma take_take {α : Type} :
  ∀(m : ℕ) (xs : list α), take m (take m xs) = take m xs
| 0       _         := by refl
| (_ + 1) []        := by refl
| (m + 1) (x :: xs) := by simp [take, take_take m xs]

lemma take_drop {α : Type} :
  ∀(n : ℕ) (xs : list α), take n xs ++ drop n xs = xs
| 0       _         := by refl
| (_ + 1) []        := by refl
| (m + 1) (x :: xs) := by simp [take, drop, take_drop m]

/-! ## Question 3: A Type of λ-Terms

3.1. Define an inductive type corresponding to the untyped λ-terms, as given
by the following context-free grammar:

    term ::= 'var' string        -- variable (e.g., `x`)
           | 'lam' string term   -- λ-expression (e.g., `λx, t`)
           | 'app' term term     -- application (e.g., `t u`) -/

inductive term : Type
| var : string → term
| lam : string → term → term
| app : term → term → term

/-! 3.2. Register a textual representation of the type `term` as an instance of
the `has_repr` type class. Make sure to supply enough parentheses to guarantee
that the output is unambiguous. -/

def term.repr : term → string
| (term.var s)   := s
| (term.lam s t) := "(λ" ++ s ++ ", " ++ term.repr t ++ ")"
| (term.app t u) := "(" ++ term.repr t ++ " " ++ term.repr u ++ ")"

@[instance] def term.has_repr : has_repr term :=
{ repr := term.repr }

/-! 3.3. Test your textual representation. The following command should print
something like `(λx, ((y x) x))`. -/

#eval (term.lam "x" (term.app (term.app (term.var "y") (term.var "x"))
    (term.var "x")))

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

/-!

# Logic in Lean, example sheet 1 : "implies" (`→`)

We learn about propositions, and implications `P → Q` between them. You can get
this arrow by typing `\to` or `\r`. Mathematicians usually write the
implication arrow as `P ⇒ Q` but Lean prefers a single arrow.

## The absolute basics

`P : Prop` means that `P` is a true-false statement. `h : P` means
that `h` is a proof that `P` is true, or you can regard `h` as an
assumption that `P` is true; logically these are the same. Stuff above
the `⊢` symbol is your assumptions. The statement to the right of it is
the goal. Your job is to prove the goal from the assumptions.

## Tactics you will need

To solve the levels on this sheet you will need to know how to use the
following tactics:

* `intro`
* `exact`
* `apply`

You can read the descriptions of these tactics in Part C of the course
notes.

## Worked examples

Click around in the proofs to see the tactic state (on the right) change.
The tactic is implemented and the state changes just before the comma.
I will use the following conventions: variables with capital
letters like `P`, `Q`, `R` denote propositions
(i.e. true/false statements) and variables whose names begin
with `h` like `h1` or `hP` are proofs or hypotheses.

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.
variable (P Q R : Prop)

-- Here are some examples of `intro`, `exact` and `apply` being used.

-- Assume that `P` and `Q` and `R` are all true. Deduce that `P` is true.
example (hP : P) (hQ : Q) (hR : R) : P := by
  -- note that `exact P` does *not* work. `P` is the proposition, `hP` is the proof.
  exact hP

-- Assume `Q` is true. Prove that `P → Q`.
example (hQ : Q) : P → Q := by
  -- The goal is of the form `X → Y` so we can use `intro`
  intro h
  -- now `h` is the hypothesis that `P` is true.
  -- Our goal is now the same as a hypothesis so we can use `exact`
  exact hQ
  -- note `exact Q` doesn't work: `exact` takes the *term*, not the type.

-- Assume `P → Q` and `P` is true. Deduce `Q`.
example (h : P → Q) (hP : P) : Q := by
  -- our goal is `⊢ Q` which matches with the conclusion of `h` so `apply` works
  apply h
  -- now our goal has changed to `P` which is an assumption
  exact hP

/-

## Examples for you to try

Delete the `sorry`s and replace them with comma-separated tactic proofs
using `intro`, `exact` and `apply`.

-/

/-- Every proposition implies itself. -/
example : P → P := by
  sorry

/-

Note that `→` is not associative: in general `P → (Q → R)` and `(P → Q) → R`
might not be equivalent. This is like subtraction on numbers -- in general
`a - (b - c)` and `(a - b) - c` might not be equal.

So if we write `P → Q → R` then we'd better know what this means.
The convention in Lean is that it means `P → (Q → R)`. If you think
about it, this means that to deduce `R` you will need to prove both `P`
and `Q`. In general to prove `P1 → P2 → P3 → ... Pn` you can assume
`P1`, `P2`,...,`P(n-1)` and then you have to prove `Pn`.

So the next level is asking you prove that `P → (Q → P)`.

-/
example : P → Q → P := by
  sorry

/-- If we know `P`, and we also know `P → Q`, we can deduce `Q`.
This is called "Modus Ponens" by logicians. -/
example : P → (P → Q) → Q := by
  sorry

/-- `→` is transitive. That is, if `P → Q` and `Q → R` are true, then
  so is `P → R`. -/
example : (P → Q) → (Q → R) → (P → R) := by
  sorry

-- If `h : P → Q → R` with goal `⊢ R` and you `apply h`, you'll get
-- two goals! Note that tactics operate on only the first goal.
example : (P → Q → R) → (P → Q) → (P → R) := by
  sorry

/-

Here are some harder puzzles. If you're not into logic puzzles
and you feel like you understand `intro`, `exact` and `apply`
then you can just skip these and move onto the next sheet
in this section, where you'll learn some more tactics.

-/

variable (S T : Prop)

example : (P → R) → (S → Q) → (R → T) → (Q → R) → S → T := by
  sorry

example : (P → Q) → ((P → Q) → P) → Q := by
  sorry

example : ((P → Q) → R) → ((Q → R) → P) → ((R → P) → Q) → P := by
  sorry

example : ((Q → P) → P) → (Q → R) → (R → P) → P := by
  sorry

example : (((P → Q) → Q) → Q) → (P → Q) := by
  sorry

example :
  (((P → Q → Q) → ((P → Q) → Q)) → R) →
  ((((P → P) → Q) → (P → P → Q)) → R) →
  (((P → P → Q) → ((P → P) → Q)) → R) → R := by
  sorry


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si a y b son números reales, entonces
--    (a + b) * (a + b) = a * a + 2 * (a * b) + b * b
-- ---------------------------------------------------------------------

import data.real.basic

variables a b : ℝ

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

example :
  (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
calc
  (a + b) * (a + b)
      = (a + b) * a + (a + b) * b       : by rw mul_add
  ... = a * a + b * a + (a + b) * b     : by rw add_mul
  ... = a * a + b * a + (a * b + b * b) : by rw add_mul
  ... = a * a + b * a + a * b + b * b   : by rw ← add_assoc
  ... = a * a + (b * a + a * b) + b * b : by rw add_assoc (a * a)
  ... = a * a + (a * b + a * b) + b * b : by rw mul_comm b a
  ... = a * a + 2 * (a * b) + b * b     : by rw ← two_mul

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

example :
  (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
calc
  (a + b) * (a + b)
      = a * a + b * a + (a * b + b * b) : by rw [mul_add, add_mul, add_mul]
  ... = a * a + (b * a + a * b) + b * b : by rw [←add_assoc, add_assoc (a * a)]
  ... = a * a + 2 * (a * b) + b * b     : by rw [mul_comm b a, ←two_mul]

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

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

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

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

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

example :
  (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
begin
  rw mul_add,
  rw add_mul,
  rw add_mul,
  rw ← add_assoc,
  rw add_assoc (a * a),
  rw mul_comm b a,
  rw ← two_mul,
end

-- El desarrollo de la prueba es
--
--    a b : ℝ
--    ⊢ (a + b) * (a + b) = a * a + 2 * (a * b) + b * b
-- rw mul_add,
--    ⊢ (a + b) * a + (a + b) * b = a * a + 2 * (a * b) + b * b
-- rw add_mul,
--    ⊢ a * a + b * a + (a + b) * b = a * a + 2 * (a * b) + b * b
-- rw add_mul,
--    ⊢ a * a + b * a + (a * b + b * b) = a * a + 2 * (a * b) + b * b
-- rw ← add_assoc,
--    ⊢ a * a + b * a + a * b + b * b = a * a + 2 * (a * b) + b * b
-- rw add_assoc (a * a),
--    ⊢ a * a + (b * a + a * b) + b * b = a * a + 2 * (a * b) + b * b
-- rw mul_comm b a,
--    ⊢ a * a + (a * b + a * b) + b * b = a * a + 2 * (a * b) + b * b
-- rw ← two_mul,
--    no goals

-- 6ª demostración
-- ===============

example :
  (a + b) * (a + b) = a * a + 2 * (a * b) + b * b :=
begin
  rw [mul_add, add_mul, add_mul],
  rw [←add_assoc, add_assoc (a * a)],
  rw [mul_comm b a, ←two_mul],
end

-- El desarrollo de la prueba es
--
--    a b : ℝ
--    ⊢ a * a + (a * b + a * b) + b * b = a * a + 2 * (a * b) + b * b
-- rw [mul_add, add_mul, add_mul],
--    ⊢ a * a + b * a + (a * b + b * b) = a * a + 2 * (a * b) + b * b
-- rw [←add_assoc, add_assoc (a * a)],
--    ⊢ a * a + (b * a + a * b) + b * b = a * a + 2 * (a * b) + b * b
-- rw [mul_comm b a, ←two_mul]
--    no goals


/-
Copyright (c) 2021 Jon Eugster. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jon Eugster, Eric Wieser
-/
import algebra.char_p.basic
import ring_theory.localization.fraction_ring
import algebra.free_algebra

/-!
# Characteristics of algebras

In this file we describe the characteristic of `R`-algebras.

In particular we are interested in the characteristic of free algebras over `R`
and the fraction field `fraction_ring R`.

## Main results

- `char_p_of_injective_algebra_map` If `R →+* A` is an injective algebra map
  then `A` has the same characteristic as `R`.

Instances constructed from this result:
- Any `free_algebra R X` has the same characteristic as `R`.
- The `fraction_ring R` of an integral domain `R` has the same characteristic as `R`.

-/

/-- If the algebra map `R →+* A` is injective then `A` has the same characteristic as `R`. -/
lemma char_p_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  (h : function.injective (algebra_map R A)) (p : ℕ) [char_p R p] : char_p A p :=
{ cast_eq_zero_iff := λx,
  begin
    rw ←char_p.cast_eq_zero_iff R p x,
    change algebra_map ℕ A x = 0 ↔ algebra_map ℕ R x = 0,
    rw is_scalar_tower.algebra_map_apply ℕ R A x,
    refine iff.trans _ h.eq_iff,
    rw ring_hom.map_zero,
  end }

/-- If the algebra map `R →+* A` is injective and `R` has characteristic zero then so does `A`. -/
lemma char_zero_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  (h : function.injective (algebra_map R A)) [char_zero R] : char_zero A :=
{ cast_injective := λ x y hxy,
  begin
    change algebra_map ℕ A x = algebra_map ℕ A y at hxy,
    rw is_scalar_tower.algebra_map_apply ℕ R A x at hxy,
    rw is_scalar_tower.algebra_map_apply ℕ R A y at hxy,
    exact char_zero.cast_injective (h hxy),
  end }
-- `char_p.char_p_to_char_zero A _ (char_p_of_injective_algebra_map h 0)` does not work
-- here as it would require `ring A`.

section

variables (K L : Type*) [field K] [comm_semiring L] [nontrivial L] [algebra K L]

lemma algebra.char_p_iff (p : ℕ) : char_p K p ↔ char_p L p :=
(algebra_map K L).char_p_iff_char_p p

end

namespace free_algebra

variables {R X : Type*} [comm_semiring R] (p : ℕ)

/-- If `R` has characteristic `p`, then so does `free_algebra R X`. -/
instance char_p [char_p R p] : char_p (free_algebra R X) p :=
char_p_of_injective_algebra_map free_algebra.algebra_map_left_inverse.injective p

/-- If `R` has characteristic `0`, then so does `free_algebra R X`. -/
instance char_zero [char_zero R] : char_zero (free_algebra R X) :=
char_zero_of_injective_algebra_map free_algebra.algebra_map_left_inverse.injective

end free_algebra

namespace is_fraction_ring

variables (R : Type*) {K : Type*} [comm_ring R]
  [field K] [algebra R K] [is_fraction_ring R K]
variables (p : ℕ)

/-- If `R` has characteristic `p`, then so does Frac(R). -/

/-- If `R` has characteristic `0`, then so does Frac(R). -/
lemma char_zero_of_is_fraction_ring [char_zero R] : char_zero K :=
@char_p.char_p_to_char_zero K _ _ (char_p_of_is_fraction_ring R 0)

variables [is_domain R]

/-- If `R` has characteristic `p`, then so does `fraction_ring R`. -/
instance char_p [char_p R p] : char_p (fraction_ring R) p :=
char_p_of_is_fraction_ring R p

/-- If `R` has characteristic `0`, then so does `fraction_ring R`. -/
instance char_zero [char_zero R] : char_zero (fraction_ring R) :=
char_zero_of_is_fraction_ring R

end is_fraction_ring


import data.int.basic data.nat.basic data.nat.prime tactic algebra.floor

open int nat

section prime_numbers_and_divisibility
  /-
  ## Definition 1.1
  A prime number is a natural number p > 1, which is divisible only
  by the natural numbers 1 and p.
  -/

  /-
  ## Definition 1.2
  Let m, n ∈ ℤ.
  Then n is divisible by m (m ∣ n) if there exists a ∈ ℤ such that n = ma.
  -/
  example : 7 ∣ 91 := by {use 13, tauto}

  example : (-5 : ℤ) ∣ 45 := by {use -9, tauto}

  example : ¬ (11 ∣ 87) := begin
    have h₁ : 11 ≠ 3 := by norm_num, --
    have h₂ : 11 ≠ 29 := by norm_num,
    have h₃ : 87 = 3 * 29 := by norm_num,

    intro h,

    rw [← coprime_primes, prime.coprime_iff_not_dvd (show prime 11, by norm_num)] at h₁ h₂, repeat {norm_num},
    rw [h₃, prime.dvd_mul] at h,

    cases h with k₁ k₂,
    repeat {contradiction},
    norm_num,
  end

  example : ∀ x : ℤ, 1 ∣ x := begin -- Every number is dvisible by 1.
    intro x,
    use x,
    simp,
  end

  example (x : ℤ) : 2 ∣ x ↔ even x := begin -- A number is divisible by 2 iff it is even.
    split,
    repeat {intro h,
            cases h with k hk,
            use k,
            exact hk},
  end

  /-
  ## Theorem 1.4
  Let n : ℕ with n > 1.
  Then n has a prime factor p.
  -/
  theorem prime_fact' : ∀ n : ℕ, 2 ≤ n → ∃ p, prime p → p ∣ n + 1 := begin
    intros n hn,
    use 0,
    intro hp,
    cases hp with k hk,
    linarith,
  end

  theorem prime_fact : ∀ n : ℕ, 2 ≤ n → ∃ p, prime p ∧ p ∣ n := begin
    intro n,
    apply nat.strong_induction_on n,

    intros a h₁ ha,
    by_cases prime a,
      {use a, tauto},

      {unfold prime at h, push_neg at h,
      specialize h ha,
      rcases h with ⟨m, hm, h₁, h₂⟩,
      use m, sorry}
  end

  /-
  ## Theorem 1.5 - Euclid
  There are infinitely many primes.
  -/
  theorem Euclid : ∀ N, ∃ p ≥ N, prime p := begin
    intro N,

    let M := factorial N + 1,
    let p := min_fac M,

    have hp : prime p :=
      begin
        refine min_fac_prime _,
        have : factorial N > 0 := factorial_pos N,
        linarith,
    end,

    use p,
    split,
    {by_contradiction H,
      have h₁ : p ∣ factorial N + 1 := min_fac_dvd M,
      have h₂ : p ∣ factorial N :=
        begin
          refine hp.dvd_factorial.mpr _,
          exact le_of_not_ge H,
      end,
      have h : p ∣ 1 := (nat.dvd_add_right h₂).mp h₁,

      exact prime.not_dvd_one hp h},
    {exact hp},
  end

  /-
  ## Theorem 1.7
  If n : ℕ, with n > 1, then either n is prime, or is a product of a
  (finite) sequence of primes.
  -/
  theorem prime_or_product_1 (n : ℕ) (H : 2 ≤ n) : prime n ∨ ∃ m a: ℕ, 2 ≤ m ∧ m < n ∧ m * a = n := begin
    -- Either prime n or n is product of 2 different naturals
    by_cases prime n,
      {left, exact h},
      {right, unfold prime at h, push_neg at h,
        specialize h H,
        cases h with m hm,

        use m,
        use n/m,
        rcases hm with ⟨h₂, h₃, h₄⟩,
        split,
          { sorry,},
          sorry,
      }
  end

  def list_prod : list ℕ → ℕ
    | [] := 1
    | (h :: t) := h * list_prod t

  #eval list_prod [2, 5, 7, 10]

  def list_prime : list ℕ → Prop
    | [] := true
    | (h :: t) := prime h ∧ list_prime t

  lemma list_prime_2_3_5 : list_prime [2, 3, 5] := begin
    split, norm_num,
    split, norm_num,
    split, norm_num,
    triv,
  end

  def list_prod_prime_eq (n : ℕ) (P : list ℕ): Prop :=
    list_prime P ∧ n = list_prod P

  example : list_prod_prime_eq 30 [2,3,5] := begin
    split, exact list_prime_2_3_5,
    dsimp [list_prod],
    norm_num,
  end

  theorem list_prime_append (P Q : list ℕ) (H : list_prime P) (G : list_prime Q) : list_prime (P ++ Q) := begin
    sorry,
  end

  theorem list_prod_append (P Q : list ℕ) : list_prod P * list_prod Q = list_prod (P ++ Q) := begin
    sorry,
  end

  theorem prime_or_product_2 (n : ℕ): 2 ≤ n → ∃ P : list ℕ, list_prod_prime_eq n P := begin
    -- n is a product of a list of primes
    apply nat.strong_induction_on n,
    intros a ha ha₂,
    have h := prime_or_product_1 a ha₂,

    cases h with h₁ h₂,
    { use ([a]),
      split,
      { dsimp [list_prime],
        tauto},
      { dsimp [list_prod],
        norm_num}
    },
    { rcases h₂ with ⟨b, c, hb⟩,
      rcases hb with ⟨kb₁, kb₂, kabc⟩,

      have Hb := ha b kb₂ kb₁,
      have Hc := ha c,
      have kc₁ : 1 < c, begin
        rw [← kabc, ← mul_one b, mul_assoc, one_mul, mul_lt_mul_left (show 0 < b, by linarith)] at kb₂,
          exact kb₂,
      end,
      have kc₂ : c < a, begin
        by_contra kca,
          push_neg at kca,
          rw [← kabc, mul_le_iff_le_one_left] at kca;
            linarith,
      end,

      specialize Hc kc₂ kc₁,
      rcases Hb with ⟨Q, primeQ, prodQb⟩,
      rcases Hc with ⟨R, primeR, prodRc⟩,

      use Q ++ R,
      split,
      { exact list_prime_append Q R primeQ primeR,},
      { rw [← kabc, prodQb, prodRc],
        exact list_prod_append Q R}
    }

  end

  theorem prime_or_product_3 (n : ℕ): 2 ≤ n → ∃ P : list ℕ, list_prod_prime_eq n P := begin
    apply nat.strong_induction_on n,
    intros k hk h2k,

    by_cases prime k,
    { use ([k]),
      dsimp [list_prod_prime_eq],
      split,
        { split,
            exact h,
            triv,},
        { dsimp [list_prod],
          norm_num,}},
    { have h := prime_fact k h2k,
      rcases h with ⟨p, hp₁, hp₂⟩,
      cases hp₂ with c hc,

      specialize hk c,

      have c_le_k : c < k := begin
        by_contra kc,
          push_neg at kc,
          rw [hc, mul_le_iff_le_one_left] at kc,
            { cases hp₁ with hp₂ hp₃,
              linarith,},
            { linarith,}
      end,
      have c_ge_2 : 2 ≤ c := begin
        sorry,
      end,

      specialize hk c_le_k c_ge_2,
      cases hk with Q hcQ,

      dsimp [list_prod_prime_eq] at hcQ,
      cases hcQ with Qprime Qprodc,

      use ([p] ++ Q),
      dsimp [list_prod_prime_eq],
      split,
      { split,
        { exact hp₁},
        { exact Qprime}},
      { rw [hc, Qprodc],
        dsimp [list_prod],
        refl,}
      }

  end

  #check le_mul_of_pos_right
  #check mul_lt_mul_left

  /-
  ## Theorem 1.8
  Let n have the prime factorisations
        n = p₁ × ... × p_r = q₁ × ... × q_s
  Then every prime occurs equally often in both factorisations (and so r = s)

  This is what we are working up to proving, but we will first need modular arithmetic
  -/

end prime_numbers_and_divisibility

section modular_arithmetic
  /-
  ## Definition 1.9
  For an integer n ≥ 1, we say that integers a and b are congruent modulo n,
  whenever (a − b)/n is an integer.
  -/

  def congModN (a b : ℤ) (n : ℕ) := ∃ m : ℤ, (a - b) = m * n
  def congModNInt (a b n : ℤ) := ∃ m : ℤ, (a - b) = m * n

  /-
  ## Theorem 1.10
  Congruence behaves like an equivalence relation, i.e. it satisfies
    Reflexivity
    Symmetry
    Transitivity
  -/

  theorem cong_refl (a : ℤ) (n : ℕ): congModN a a n := begin
    dsimp [congModN],
    use 0,
    simp,
  end

  theorem cong_symm (a b : ℤ) (n : ℕ): congModN a b n ↔ congModN b a n := begin
    split;
      { intro h,
        cases h with m hm,
        use (-m),
        linarith},
  end

  theorem cong_trans (a b c : ℤ) (n : ℕ) (H₁ : congModN a b n) (H₂ : congModN b c n): congModN a c n := begin
      cases H₁ with m hm,
      cases H₂ with p hp,

      use (m + p),
      rw [add_mul, ← hm, ← hp],
      linarith,
  end

  /-
  ## Theorem 1.11
  Congruence preserves addition, subtraction and multiplication
  -/

  theorem cong_add (a b c d : ℤ) (n : ℕ) (H₁ : congModN a b n) (H₂ : congModN c d n): congModN (a + c) (b + d) n := begin
    cases H₁ with m hm,
    cases H₂ with p hp,

    use (m + p),
    rw [add_mul, ← hm, ← hp],
    linarith,
  end

  theorem cong_sub (a b c d : ℤ) (n : ℕ) (H₁ : congModN a b n) (H₂ : congModN c d n): congModN (a - c) (b - d) n := begin
    cases H₁ with m hm,
    cases H₂ with p hp,

    use (m - p),
    rw [sub_mul, ← hm, ← hp],
    linarith,
  end

  theorem cong_mul (a b c d : ℤ) (n : ℕ) (H₁ : congModN a b n) (H₂ : congModN c d n): congModN (a * c) (b * d) n := begin
    cases H₁ with m hm,
    cases H₂ with p hp,

    use (b*p + c*m),
    rw add_mul,
    rw [mul_assoc b p n, ← hp, mul_assoc c m n, ← hm, mul_sub, mul_sub],
    linarith,
  end

  /-
  ## Remark 1.12
  We must be careful with division, i.e.
  a/c is not always congruent to b/d (mod n)
  -/

  /-
  ## Theorem 1.13
  Let n ≥ 1 and a ∈ Z. There are unique q ∈ Z and r ∈ {0, 1, . . . , n − 1},
  with a = qn + r.
  (We call q the quotient and r the remainder obtained by dividing a by n.)
  -/

  theorem quot_rem (a: ℤ) (n : ℕ) (H₁ : 1 ≤ n) : ∃ q r : ℤ, 0 ≤ r → r ≤ n - 1 → a = q*n + r := begin
    let q := floor (a/n),
    use q,
    use (a - q*n),
    intros h₁ h₂,
    linarith,
  end

  theorem quot_rem_unique (a : ℤ) (n : ℕ) (H₁ : 1 ≤ n) : ∃! q r : ℤ, 0 ≤ r → r ≤ n - 1 → a = q*n + r := begin
    rw exists_unique,
    let q := floor (a/n),
    have hqa₁ : q ≤ a/n := begin
      dsimp [q],
      tauto,
    end,
    have hqa₂ : (a/n) ≤ ceil (a/n) := begin
      sorry,
    end,
    have hqa₃ : ceil (a/n) ≤ q + 1 := begin
      dsimp [q],
      exact ceil_le_floor_add_one (a/n),
    end,
    have hqa₄ : a/n ≤ q + 1 := begin
      exact le_trans hqa₂ hqa₃,
    end,
    clear hqa₃ hqa₄,
    use q,
    split,
      { rw exists_unique,
        use (a - q * n),
        split,
          { intros h₁ h₂,
            linarith,},
          { intros r hr₁,
            sorry},
      },
      {sorry}
  end
  #check nat.mod_add_div

  lemma mod_le_n (a n : ℕ) (H₁ : 1 ≤ n) : a % n ≤ n := begin
    induction a with k hk,
      { rw nat.zero_mod,
        linarith,},
      { rw succ_eq_add_one,
        rw nat.add_mod,
        by_cases n = 1,
          { -- For n = 1
            rw h,
            simp,},
          { -- For n ≠ 1, i.e. 1 < n
            have h₂ : 1 < n := by sorry,}}
  end

  theorem quot_rem_nat (a n : ℕ) (H₁ : 1 ≤ n) : ∃ q r : ℕ, 0 ≤ r ∧ r ≤ n - 1 ∧ a = q*n + r := begin
    use a/n,
    use a % n,
    split,
      { exact nat.zero_le (a % n)},
      { split,
        { sorry},
        { sorry}}
  end

  theorem quot_rem_nat' (a n : ℕ) : ∃ q r : ℕ, 0 ≤ r ∧ r ≤ n ∧ a = q * (n + 1) - q + r := begin
    use a/n,
    use a % n,
    split,
      { exact nat.zero_le (a % n),},
      { split,
        { exact mod_le_n a n},
        { rw mul_add,
          rw mul_one,
          simp,
          have h₁ : a / n * n ≥ a - n := begin
            sorry,
          end,
          have h₂ := mod_le_n a n,
          sorry,}}
  end
-- a ≤ a < a - n

  theorem quot_rem_unique' (a n q₁ q₂ r₁ r₂ : ℤ) (H₁ : 1 ≤ n)
    (H1r₁ : 0 ≤ r₁) (H2r₁ : r₁ < n)
    (H1r₂ : 0 ≤ r₂) (H2r₂ : r₂ < n)
    (Ha₁ : a = q₁ * n + r₁) (Ha₂ : a = q₂ * n + r₂): r₁ = r₂ ∧ q₁ = q₂ := begin
      split,
        { have h₁ : congModNInt r₁ r₂ n := begin
            use (q₂ - q₁),
            rw ← sub_eq_iff_eq_add' at Ha₁ Ha₂,
            rw [← Ha₁, ← Ha₂],
            rw sub_mul,
            simp,
          end,

          have hr₁ : (- n : ℤ) < r₁ - r₂ := begin
            sorry,
          end,
          have hr₂ : r₁ - r₂ < n := begin
            sorry,
          end,

          have hr₃ : -1 < (r₁ - r₂) / n := begin
            sorry,
          end,
          have hr₄ : (r₁ - r₂) / n < 1 := begin
            sorry,
          end,

          have hr₅ : (r₁ - r₂) / n = 0 := by sorry,

          have hr₆ : r₁ - r₂ = 0 * n := by sorry,

          rw [zero_mul, sub_eq_zero] at hr₆,
          exact hr₆,
          },
        { sorry,}
  end

  #check nat.mod_le

end modular_arithmetic


/-
# Orders

Groups, rings, fields, modules etc are in the "algebra hierarchy".

Metric and topological spaces are in the "topology hierarchy".

The other important hierarchy is the "order hierarchy".

It starts with partially ordered sets, and then goes on to lattices.

Because I like algebra, let's demonstrate the order hierarchy by
making an algebraic type, namely the type of subgroups of a group G,
and then working up the order hierarchy with it. Subgroups of a group
are ordered by inclusion, and this is where we shall start. We will
then define infs and sups, and bot and top, and go on from there.

-/
import tactic

-- We will be using all of the theory of subsets of a type
-- without further comment (e.g. `inter_subset_left A B : A ∩ B ⊆ A`)
-- so let's open the `set` namespace.

open set

-- The type of subgroups of a group G is called `subgroup G` in Lean.
-- It already has a lattice structure in Lean.

-- So let's just redo the entire theory and call it `subgp G`.

/-- The type of subgroups of a group `G`. -/
structure subgp (G : Type) [group G] :=
-- A subgroup of G is a sub*set* of G, called `carrier`
(carrier : set G)
-- and then axioms saying it's closed under the group structure (i.e. *, 1, ⁻¹)
(mul_mem {a b : G} : a ∈ carrier → b ∈ carrier → a * b ∈ carrier)
(one_mem : (1 : G) ∈ carrier)
(inv_mem {a : G} : a ∈ carrier → a⁻¹ ∈ carrier)

namespace subgp

/-
Note in particular that we have a function `subgp.carrier : subgp G → set G`,
sending a subgroup of `G` to the underlying subset (`set G` is the type
of subsets of G).
-/

-- Let G be a group, let H,J,K be subgroups of G, and let a,b,c be elements of G.
variables {G : Type} [group G] (H J K : subgp G) (a b c : G)

/- # Extensionality

One of the first things you should consider proving about a newly-defined
type is an extensionality lemma: a sensible criterion to check that
two terms are equal. When are two subgroups of `G` equal? A subgroup
is defined by four things: a subset, and three proofs. But two proofs
of a proposition `P` are equal by definition in Lean, so two subgroups
of `G` are equal iff their underlying subsets are equal, which is
true iff their underlying subsets have the same elements. Let's give
names to these basic results because they'll show up everywhere.

Let's start by showing that two subgroups are equal if their
underlying subsets are equal. This is precisely the statement that
`∀ H J : subgp G, H.carrier = J.carrier → H = J`, and a good name
for this would be `carrier_injective`. We adopt the Lean tradition
of putting as many things to the left of the `:` as we can; it
doesn't change the statement of the theorem.
-/

lemma carrier_injective (H J : subgp G) (h : H.carrier = J.carrier) : H = J :=
begin
  -- take H and J apart
  cases H, cases J,
  -- and note that they are the same set, and then a bunch of proofs
  -- which are equal by definition, so it's obvious
  simp * at *,
end

-- Now let's prove that two subgroups are equal iff they have the same elements.
-- This is the most useful "extensionality lemma" so we tag it `@[ext]`.
@[ext] theorem ext {H J : subgp G} (h : ∀ (x : G), x ∈ H.carrier ↔ x ∈ J.carrier) :
  H = J :=
begin
  -- it suffices to prove the subsets are equal
  apply carrier_injective,
  -- Now let's use extensionality for subsets
  ext x,
  exact h x,
end

-- We also want the `iff` version of this.
theorem ext_iff {H J : subgp G} : H = J ↔ ∀ (x : G), x ∈ H.carrier ↔ x ∈ J.carrier :=
begin
  sorry
end

/-

## Partial orders

-/

-- These are familiar to most mathematicians. We will put a partial order
-- structure on `subgp G`. In other words, we will create a term of
-- type `partial_order (subgp G)`.

-- Let's define `H ≤ J` to mean `H.carrier ⊆ J.carrier`, using the `has_le` notation typeclass
instance : has_le (subgp G) := ⟨λ H J, H.carrier ⊆ J.carrier⟩

-- "tidy" is a one-size-fits-all tactic which solves certain kinds of "follow your nose" goals.
instance : partial_order (subgp G) :=
{ le := (≤),
  le_refl := by tidy,
  le_trans := by tidy,
  le_antisymm := by tidy }

/- Here is a second proof. If X → Y is injective, and Y is partially ordered,
then X inherits a partial order. This construction (it's not a theorem, because
it involves data) is called `partial_order.lift`. Applying it to the injection
`subgp.carrier` and the fact that Lean already knows that `set G` is partially
ordered, turns into this second construction,  (which I won't call an `instance`
because if I did then I would have committed the sin of making two terms of
type `partial_order (subgp G)`, and `partial_order (subgp G)` is a class so
should have at most one instance):
-/

-- partial_order.lift is the function which pulls a partial order back along an injection.
example : partial_order (subgp G) := partial_order.lift subgp.carrier carrier_injective

/- Note that we magically just inherited `<` notatation, because
   `#check partial_order` tells you that `partial_order` extends `preorder`,
   which extends `has_lt`, which is a notation typeclass. In other words,
   `#check (H < J)` makes sense, and is a `Prop`. In fact `H < J` is
  defined to mean `H ≤ J ∧ ¬ (J ≤ H)`.

# From partial orders to lattices.

Let's now prove that `subgp G` is a `semilattice_inf` . This is a class
which extends `partial_order` -- it is a partial order equipped with
a function `inf : subgp G → subgp G → subgp G` (called "inf" or "meet"
or "greatest lower bound", satisfying some axioms. In our case, `inf` will
just be intersection. The work we need to do is to check that these are
subgroups, and to prove the axioms for a `semilattice_inf`, which
we'll come to later.

We will also show that it is an `order_top`, i.e., it has a largest element.

First let's define `top` -- the biggest subgroup. The underlying carrier
is `univ : set G`, i.e. the subset `G` of `G`. I'll leave it to you to prove
that the subgroup axioms hold!

The useful piece of interface for `univ` you'll need is `mem_univ g : g ∈ univ`.

-/
def top : subgp G :=
{ carrier := set.univ,
  mul_mem := begin
    sorry
  end,
  one_mem := begin
    sorry
  end,
  inv_mem := begin
    sorry
  end }

-- Add the `⊤` notation (typed with `\top`) for this subgroup:
instance : has_top (subgp G) := ⟨top⟩

-- Now `#check (⊤ : subgp G)` works

/-
  We'll now prove the theorem that the intersection of
  two subgroups is a subgroup. This is a *definition* in Lean,
  indeed it is a construction which given two subgroups `H` and `K` of `G`
  produces a third subgroup `H ⊓ K` (Lean's notation for `inf H K`).

  The part of the interface for `∩` you'll need is that `a ∈ B ∩ C` is
  definitionally equal to `a ∈ B ∧ a ∈ C`, so you can use `split`
  if you have a goal `⊢ a ∈ B ∩ C`, and you can use `cases h` if you
  have a hypothesis `h : a ∈ B ∩ C`. Don't forget `mul_mem H`, `one_mem H`
  and `inv_mem H`, the axioms for `H` if `H : subgp G`.
-/

/-- "Theorem" : intersection of two subgps is a subgp -/
definition inf (H K : subgp G) : subgp G :=
{ carrier := H.carrier ∩ K.carrier,
  mul_mem := begin
    sorry
  end,
  one_mem := begin
    sorry
  end,
  inv_mem := begin
    sorry
  end }

-- Add the `⊓` notation (type with `\inf`) for the intersection (inf) of two subgroups:
instance : has_inf (subgp G) := ⟨inf⟩

-- We now check the four axioms for a semilattice_inf_top.
-- They are called `le_top`, `inf_le_left`, `inf_le_right` and `le_inf`.
-- You might be able to guess the statementss of the axioms
-- from their names.

lemma le_top (H : subgp G) : H ≤ ⊤ :=
begin
  sorry
end

lemma inf_le_left (H K : subgp G) : H ⊓ K ≤ H :=
begin
  -- by definition this says `H.carrier ∩ K.carrier ⊆ H.carrier`
  change H.carrier ∩ K.carrier ⊆ H.carrier,
  -- now try `library_search`, to find that this is called `inter_subset_left
  apply inter_subset_left,
end

lemma inf_le_right (H K : subgp G) : H ⊓ K ≤ K :=
sorry

-- Can you use `library_search`, or other methods, to find the name of the
-- statement that if `A B C : set G` then `A ⊆ B → A ⊆ C → A ⊆ (B ∩ C)`?
lemma le_inf (H J K : subgp G) (h1 : H ≤ J) (h2 : H ≤ K) : H ≤ J ⊓ K :=
sorry

-- Now we're ready to make the two instances.
instance : semilattice_inf (subgp G) :=
{ inf := inf,
  inf_le_left := inf_le_left,
  inf_le_right := inf_le_right,
  le_inf := le_inf,
  .. subgp.partial_order } -- don't forget to inlude the partial order

instance : order_top (subgp G) :=
{ top := top,
  le_top := le_top }

/- The logic behind `semilattice_inf` and `order_top` is that this is the simplest class
which is closed under all finite "meet"s. The meet of 0 subgroups
is `top`, the meet of one subgroup is the subgroup, the meet of two
subgroups is their inf, and for three or more you proceed by induction.

We could now go on to make a `semilattice_sup` structure, and then
a lattice structure. But let's jump straight to the strongest type
in the order hierarchy -- a `complete_lattice`. This has arbitrary `Inf` and `Sup`s.

So let's first note that we can do better than finite intersections -- we can take
arbitrary intersections! Let's now define the `Inf` of an arbitrary
set of subgroups of `G`.

The part of the interface for sets you'll need to know here is that if `S` is a
set of subsets of `G`, then `⋂₀ S` is notation for their intersection, and
to work with it you'll need to know
`set.mem_sInter : g ∈ ⋂₀ S ↔ ∀ (U : set G), U ∈ S → g ∈ U`.
-/

def Inf (S : set (subgp G)) : subgp G :=
{ carrier := ⋂₀ (subgp.carrier '' S),
  mul_mem :=  begin
    sorry
  end,
  one_mem := begin
    sorry
  end,
  inv_mem := begin
    sorry
  end }

-- We now equip `subgp G` with an Inf. I think the notation is `⨅`, or `\Inf`,
-- but I find it hard to use, and `#print notation ⨅` returns garbage.
instance : has_Inf (subgp G) := ⟨Inf⟩

/- # Complete lattices

Let's jump straight from `semilattice_inf` to `complete_lattice`.
A complete lattice has arbitrary Infs and arbitrary Sups, and satisfies
some other axioms which you can probably imagine. Our next goal
is to make `subgp G` into a complete lattice. We will do it in two ways.
The first way is to show that if our `Inf` satisfies
`(∀ (S : set (subgp G)), is_glb S (Inf S))` then we can build a complete
lattice from this, using `complete_lattice_of_Inf`.
-/

instance : complete_lattice (subgp G) := complete_lattice_of_Inf _ begin
-- ⊢ ∀ (s : set (subgp G)), is_glb s (has_Inf.Inf s)
--  See if you can figure out what this says, and how to prove it.
-- You might find the function `is_glb.of_image` useful.
  sorry
end

/- Now let me show you another way to do this.

# Galois connections

A Galois conection is a pair of adjoint functors between two
partially ordered sets, considered as categories whose hom sets Hom(H,J) have
size 1 if H ≤ J and size 0 otherwise. In other words, a Galois
connection between two partial orders α and β is a pair of monotone functions
`l : α → β` and `u : β → α` such that `∀ (a : α) (b : β), l a ≤ b ↔ a ≤ u b`.

There is an example coming from Galois theory (between subfields and subgroups),
and an example coming from classical algebraic geometry (between affine
varieties and ideals); note that in both cases you have to use the opposite
partial order on one side to make everything covariant.

The examples we want to keep in mind here are:
1) α = subsets of G, β = subgroups of G, l = "subgroup generated by", u = `carrier`
2) X : Type, α := set (set X), β := topologies on X,
  l = topology generated by a collection of open sets, u = the open sets regarded as subsets.

As you can imagine, there are a bunch of abstract theorems with simple proofs
proved for Galois connections. You can see them by `#check galois_connection`,
jumping to the definition, and reading the next 150 lines of the mathlib file
after the definition. Examples of theorems you might recognise from contexts
where you have seen this before:

lemma le_u_l (a : α) : a ≤ u (l a) := ...

lemma l_u_le (b : β) : l (u b) ≤ b := ...

lemma u_l_u_eq_u : u ∘ l ∘ u = u := ...

lemma l_u_l_eq_l : l ∘ u ∘ l = l := ...

# Galois insertions

A particularly cool kind of Galois connection is a Galois insertion, which
is a Galois connection such that `l ∘ u = id`. This is true for both
the examples we're keeping in mind (the subgroup of `G` generated
by a subgroup is the same subgroup; the topology on `X` generated by a
topology is the same topology).

Our new goal: let's make subgroups of a group into a complete lattice,
using the fact that `carrier` is part of a Galois insertion.

-/

-- The adjoint functor to the `carrier` functor is the `span` functor
-- from subsets to subgps. Here we will CHEAT by using `Inf` to
-- define `span`. We could have built `span` directly with
-- an inductive definition.
def span (S : set G) : subgp G := Inf {H : subgp G | S ⊆ H.carrier}

-- Here are some theorems about it.
lemma monotone_carrier : monotone (subgp.carrier : subgp G → set G) :=
sorry

lemma monotone_span : monotone (span : set G → subgp G) :=
sorry

lemma subset_span (S : set G) : S ≤ (span S).carrier :=
begin
  sorry
end

lemma span_subgp (H : subgp G) : span H.carrier = H :=
begin
  sorry
end

-- We have proved all the things we need to show that `span` and `carrier`
-- form a Galois insertion, using `galois_insertion.monotone_intro`.
def gi_subgp : galois_insertion (span : set G → subgp G) (subgp.carrier : subgp G → set G) :=
galois_insertion.monotone_intro monotone_carrier monotone_span subset_span span_subgp

-- Note that `set G` is already a complete lattice:
example : complete_lattice (set G) := by apply_instance

-- and now `subgp G` can also be made into a complete lattice, by
-- a theorem about Galois insertions. Again, I don't use `instance`
-- because we already made the instance above.

example : complete_lattice (subgp G) := galois_insertion.lift_complete_lattice gi_subgp

end subgp

-- Because Alex defined the topology generated by a collection of subsets
-- yesterday, I'll show you how you can use Galois insertions to prove
-- that if `X : Type` then the type of topological space structures on `X`
-- is a complete lattice. We use the topology generated by a collection
-- of subsets, which is a functor adjoint to the forgetful functor.

-- We start by literally copying some stuff from Alex' talk.

open set

@[ext]
class topological_space (X : Type) :=
  (is_open : set X → Prop) -- why set X → Prop not set (set X)? former plays
                           -- nicer with typeclasses later
  (univ_mem : is_open univ)
  (union : ∀ (B : set (set X)) (h : ∀ b ∈ B, is_open b), is_open (⋃₀ B))
  (inter : ∀ (A B : set X) (hA : is_open A) (hB : is_open B), is_open (A ∩ B))

namespace topological_space

def forget {X : Type} : topological_space X → set (set X) := @is_open X

/-- The open sets of the least topology containing a collection of basic sets. -/
inductive generated_open (X : Type) (g : set (set X)) : set X → Prop
| basic  : ∀ s ∈ g, generated_open s
| univ   : generated_open univ
| inter  : ∀s t, generated_open s → generated_open t → generated_open (s ∩ t)
| sUnion : ∀k, (∀ s ∈  k, generated_open s) → generated_open (⋃₀ k)

/-- The smallest topological space containing the collection `g` of basic sets -/
def generate_from {X : Type} (g : set (set X)) : topological_space X :=
{ is_open   := generated_open X g,
  univ_mem  := sorry,
  inter     := sorry,
  union     := sorry }

-- Recall that `topological_space X` is the type of topological space structures
-- on `X`. Our Galois insertion will use the adjoint functors
-- `generate_from` and `is_open`.

-- We'd better start by giving the collection of topological space structures on X
-- a partial order:

instance (X : Type) : partial_order (topological_space X) :=
partial_order.lift (forget)
begin
  -- need to show that a top space is determined by its open sets
  intros τ₁ τ₂ h,
  cases τ₁, cases τ₂,
  simp [forget, *] at *,
end

-- Exercise (LONG): First, show that we have a Galois insertion.

lemma monotone_is_open {X : Type} :
  monotone (forget : topological_space X → set (set X)) :=
begin
  sorry
end

lemma monotone_span {X : Type} :
  monotone (generate_from : set (set X) → topological_space X) :=
begin
  sorry
end

lemma subset_forget {X : Type} (Us : set (set X)) :
  Us ≤ forget (generate_from Us) :=
begin
  sorry
end

lemma generate_forget {X : Type} (τ : topological_space X) :
  generate_from (forget τ) = τ :=
begin
  sorry
end

def gi_top (X : Type) :
  galois_insertion (generate_from : set (set X) → topological_space X)
    (forget : topological_space X → set (set X)) :=
galois_insertion.monotone_intro monotone_is_open monotone_span subset_forget generate_forget

/-
Then deduce that the type of topological space structures on X
is a complete lattice, i.e. that there is a good definition of
arbitrary Infs and Sups of topological space structures on a type, and
they satisfy all the correct properties of Infs and Sups. In
other words,
-/

example (X : Type) : complete_lattice (topological_space X) :=
  galois_insertion.lift_complete_lattice (gi_top X)

end topological_space


import .love10_denotational_semantics_demo

/-! # LoVe Homework 10: Denotational Semantics

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (7 points): Denotational Semantics of DOWHILE -/

namespace do_while

/-! Consider the following DOWHILE language: -/

inductive stmt : Type
| skip     : stmt
| assign   : string → (state → ℕ) → stmt
| seq      : stmt → stmt → stmt
| unless   : stmt → (state → Prop) → stmt
| while    : (state → Prop) → stmt → stmt
| do_while : stmt → (state → Prop) → stmt

infixr ` ;; ` : 90 := stmt.seq

/-! The `skip`, `assign`, `seq`, and `while` constructs are as for the WHILE
language.

`unless S b` executes `S` if `b` is false in the current state; otherwise, it
does nothing. This statement is inspired by Perl's `unless` conditional.

`do_while S b` first executes `S`. Then, if `b` is true in the resulting state,
it re-enters the loop and executes `S` again, and continues executing `S` until
`b` becomes `false`. The semantics is almost the same as `while b S`, except
that `p` is always executed at least once, even if the condition is not true
initially. This statement is inspired by C's and Java's `do { … } while (…)`
loop.

1.1 (2 points). Give a denotational semantics of DOWHILE.

Hint: Your definition should make it easy to prove lemma `do_while_while` in
question 1.2. -/

def denote : stmt → set (state × state)
| stmt.skip           := Id
| (stmt.assign x a)   :=
  {st | prod.snd st = (prod.fst st){x ↦ a (prod.fst st)}}
| (stmt.seq S₁ S₂)    := denote S₁ ◯ denote S₂
| (stmt.unless S b)   := (Id ⇃ b) ∪ (denote S ⇃ λs, ¬ b s)
| (stmt.while b S)    := lfp (λX, ((denote S ◯ X) ⇃ b) ∪ (Id ⇃ λs, ¬ b s))
| (stmt.do_while S b) :=
  denote S ◯ lfp (λX, ((denote S ◯ X) ⇃ b) ∪ (Id ⇃ λs, ¬ b s))

notation `⟦` S `⟧`:= denote S

/-! 1.2 (1 point). Prove the following correspondence between `do_while` and
`while`. -/

lemma do_while_while (S : stmt) (b : state → Prop) :
  ⟦stmt.do_while S b⟧ = ⟦S⟧ ◯ ⟦stmt.while b S⟧ :=
by refl

/-! 1.3 (4 points). Prove the following lemmas.

Hint: For all of these, short proofs are possible. It may help, however, to
know what basic expressions such as `p ⇃ (λx, false)` and `p ⇃ (λx, true)` mean.
Make sure to simplify the expressions involving `⇃` before trying to figure out
what to do about `lfp`. -/

lemma lfp_const {α : Type} [complete_lattice α] (a : α) :
  lfp (λX, a) = a :=
begin
  rw lfp_eq,
  apply monotone_const
end

lemma while_false (S : stmt) :
  ⟦stmt.while (λ_, false) S⟧ = Id :=
by simp [denote, restrict, lfp_const]

lemma comp_Id {α : Type} (r : set (α × α)) :
  r ◯ Id = r :=
by simp [comp, Id]

lemma do_while_false (S : stmt) :
  ⟦stmt.do_while S (λ_, false)⟧ = ⟦S⟧ :=
by simp [denote, restrict, lfp_const, comp_Id]

end do_while

/-! ## Question 2 (2 points + 2 bonus points): Kleene's Theorem

We can compute the fixpoint by iteration by taking the union of all finite
iterations of `f`:

    `lfp f = ⋃i, (f ^^ i) ∅`

where

    `f ^^ i = f ∘ ⋯ ∘ f`

iterates the function `f` `i` times. However, the above characterization of
`lfp` only holds for continuous functions, a concept we will introduce below. -/

def iterate {α : Type} (f : α → α) : ℕ → α → α
| 0       a := a
| (n + 1) a := f (iterate n a)

notation f`^^`n := iterate f n

/-! 2.1 (2 points). Fill in the missing proofs below.

Hint: Bear in mind that `≤` works on lattices in general, including sets. On
sets, it can be unfolded to `⊆` using `simp [(≤)]`. Moreover, when you see
`h : A ⊆ B` in a goal, you can imagine that you have `?a ∈ A → ?a ∈ B` by
definition, or unfold the definition using `simp [(⊆), set.subset]`. -/

def Union {α : Type} (s : ℕ → set α) : set α :=
{a | ∃n, a ∈ s n}

lemma Union_le {α : Type} {s : ℕ → set α} (A : set α) (h : ∀i, s i ≤ A) :
  Union s ≤ A :=
begin
  simp [(≤)],
  simp [(⊆), set.subset],
  intros x hx,
  simp [Union] at hx,
  cases' hx with i hi,
  exact h i hi
end

/-! A continuous function `f` is a function that commutes with the union of any
monotone sequence `s`: -/

def continuous {α : Type} (f : set α → set α) : Prop :=
∀s : ℕ → set α, monotone s → f (Union s) = Union (λi, f (s i))

/-! We need to prove that each continuous function is monotone. To achieve this,
we will need the following sequence: -/

def bi_seq {α : Type} (A B : set α) : ℕ → set α
| 0       := A
| (n + 1) := B

/-! For example, `bi_seq A B` is the sequence A, B, B, B, …. -/

lemma monotone_bi_seq {α : Type} (A B : set α) (h : A ≤ B) :
  monotone (bi_seq A B)
| 0       0       _ := le_refl _
| 0       (n + 1) _ := h
| (n + 1) (m + 1) _ := le_refl _

lemma Union_bi_seq {α : Type} (A B : set α) (ha : A ≤ B) :
  Union (bi_seq A B) = B :=
begin
  apply le_antisymm,
  { apply Union_le,
    intros n a h,
    cases' n,
    { exact ha h },
    { exact h } },
  { intros a h,
    simp [Union],
    apply exists.intro 1,
    exact h }
end

lemma monotone_of_continuous {α : Type} (f : set α → set α)
    (hf : continuous f) :
  monotone f :=
begin
  intros A B ha,
  rw ←Union_bi_seq A B ha,
  rw hf _ (monotone_bi_seq A B ha),
  intros a ha,
  rw Union,
  simp,
  apply exists.intro 0,
  exact ha
end

/-! 2.2 (1 bonus point). Provide the following proof, using a similar case
distinction as for `monotone_bi_seq` above. -/

lemma monotone_iterate {α : Type} (f : set α → set α) (hf : monotone f) :
  monotone (λi, (f ^^ i) ∅)
| 0       0       _   := le_refl _
| 0       (m + 1) hle :=
  begin
    intros y hin,
    simp [iterate] at hin,
    cases' hin
  end
| (n + 1) (m + 1) hle :=
  begin
    apply hf,
    simp,
    apply monotone_iterate,
    linarith
  end

/-! 2.3 (1 bonus point). Prove the main theorem. A proof sketch is given below.

We break the proof into two proofs of inclusion.

Case 1. `lfp f ≤ Union (λi, (f ^^ i) ∅)`: The key is to use the lemma `lfp_le`
together with continuity of `f`.

Case 2. `Union (λi, (f ^^ i) ∅) ≤ lfp f`: The lemma `Union_le` gives us a
natural number `i`, on which you can perform induction. We also need the lemma
`lfp_eq` to unfold one iteration of `lfp f`. -/

lemma lfp_Kleene {α : Type} (f : set α → set α) (hf : continuous f) :
  lfp f = Union (λi, (f ^^ i) ∅) :=
begin
  apply le_antisymm,
  { apply lfp_le _ _ _,
    rw hf,
    { apply Union_le,
      intros n a hn,
      apply exists.intro (n + 1),
      exact hn },
    { exact monotone_iterate f (monotone_of_continuous f hf) } },
  { apply Union_le (lfp f),
    intro i,
    induction' i,
    { intros a,
      exact false.elim },
    { rw nat.succ_eq_add_one,
      rw lfp_eq f (monotone_of_continuous f hf),
      exact (monotone_of_continuous f hf) _ _ (ih f hf) } }
end

end LoVe


import tactic
import data.nat.lattice       -- for well-ordering for naturals
import data.set.basic         -- for creating sets

-- Define a set for the remainder of a/b :
-- remainder_set takes a and b and returns set of all possible nonnegative remainders of a/b

def remainder_set : ℤ → ℤ → set ℕ := λ a, λ b, { y | ∃ x : ℤ, (y : ℤ) = a - b * x}

-- lemma using the definition of remainder_set (to make it easier to work with)

lemma mem_remainder_set_iff {a b : ℤ} {k : ℕ}  : (k ∈ remainder_set a b) ↔
  ∃ x : ℤ, (k : ℤ) = a - b * x :=
  begin
    split, {
      intro h,
      rw set.mem_def at h,
      exact h,
    }, {
      intro h,
      rw set.mem_def,
      exact h,
    }
  end

/-       PROOF SKETCH

  (1) Define remainder set, S
      -- let S = {a - bx : x ∈ ℤ ∧ a - bx ≥ 0}

  (2) Show S is nonempty
      -- use x = -|a|, and a + b |a| ≥ 0 to show S nonempty

  (3) Apply Well-ordering of naturals to show that S contains a minimum, r

  (4) Show r satisfies conditions of division algorithm
      -- show r < b, by contradiction if r - b ≥ 0

  (5) Show uniqueness

-/

lemma division_algorithm (a b : ℤ) (ha : a > 0) (hb : b > 0) :
(∃ q r : ℤ, ((a = b * q + r) ∧ (0 ≤ r) ∧ (r < b))) :=
begin

  have hr : has_Inf.Inf (remainder_set a b) ∈ (remainder_set a b),
    {
      have hns : (remainder_set a b).nonempty,
        {
          have h1 : a + b * |a| ≥ 0,
            {
              have h2 : |a| = a := abs_of_pos ha,
              rw h2,
              have h3 : b * a > 0 := mul_pos hb ha,
              have h4 : a + b * a > 0,
              {exact add_pos ha h3,},

              exact le_of_lt h4,
            },

          obtain ⟨k, hk⟩ := int.eq_coe_of_zero_le (h1),
          have hk_mem : k ∈ (remainder_set a b),
            {
              rw mem_remainder_set_iff,
              use (-|a|),
              linarith,
            },

          exact set.nonempty_of_mem hk_mem,
        },
      exact Inf_mem hns,
    },
  rw mem_remainder_set_iff at hr,
  cases hr with x hx,
  use x,
  use has_Inf.Inf (remainder_set a b),
  split, {
    finish,
  }, {
    split, {
      exact int.of_nat_nonneg (Inf (remainder_set a b)),
    }, {
      by_contra,
      simp only [not_lt, int.of_nat_eq_coe] at h,
      have j : ((has_Inf.Inf (remainder_set a b) ) - int.to_nat(b)) ∈ (remainder_set a b),
      {
        rw mem_remainder_set_iff,
        use (x+1),
        have k : ↑(Inf (remainder_set a b)) - b = a - b * (x + 1) := by linarith,
        rw ← k,
        have hb2 : 0 ≤ b := le_of_lt hb,
        have hb3 := int.to_nat_of_nonneg hb2,
        nth_rewrite 3 ← hb3,
        have h2 : b.to_nat ≤ Inf (remainder_set a b) := by finish,
        rw int.coe_nat_sub h2,
      },
      have hle := nat.Inf_le j,
      have hg : Inf (remainder_set a b) - b.to_nat < Inf (remainder_set a b),
      {
        have hb_nat : 0 < b.to_nat := by finish,
        have h_inf_le_b : b.to_nat ≤ Inf (remainder_set a b),
        {
          have hb2 : 0 ≤ b := le_of_lt hb,
          have hb3 := int.to_nat_of_nonneg hb2,
          have h2 : b.to_nat ≤ Inf (remainder_set a b) := by finish,
          exact h2,
        },
        exact nat.sub_lt_of_pos_le b.to_nat (Inf (remainder_set a b)) hb_nat h_inf_le_b,
      },
      exact nat.lt_le_antisymm hg hle,
    },
  },
end

#print division_algorithm

lemma division_algorithm_uniqueness (a b q1 q2 r1 r2 : ℤ) (hr1 : (0 ≤ r1) ∧ (r1 < b)) (hr2 : (0 ≤ r2) ∧ (r2 < b))
(ha : a > 0) (hb : b > 0) (hd1 : a = b * q1 + r1) (hd2 : a = b * q2 + r2) : (q1 = q2 ∧ r1 = r2) :=
begin
    have hq : q1 = q2,
    {
      rw hd2 at hd1,
      have j : b * (q2 - q1) = r1 - r2 := by linarith,

      have k : -b < -r2 ∧ -r2 ≤ 0,
      { split, { linarith, }, { linarith, },},

      have l : -b < r1 - r2 ∧ r1 - r2 < b,
      { split, { linarith,}, { linarith,},},

      have m : -b < b*(q2 - q1) ∧ b*(q2 - q1) < b,
      { split, {linarith,}, {linarith,},},

      have i : -1 < q2 - q1 ∧ q2 - q1 < 1,
      {split, {
        cases m,
        --have hm2 : -b ≤ b * (q2 - q1) := le_of_lt m_left,
        rw (show -b = b*(-1), by linarith) at m_left,
        exact (mul_lt_mul_left hb).mp m_left,
      }, {
        cases m,
        -- ?a < ?c → ?d ≤ ?b → 0 ≤ ?c → 0 < ?d → ?a / ?b < ?c / ?d
        nth_rewrite 1 ← (mul_one b) at m_right,
        exact (mul_lt_mul_left hb).mp m_right,
      },},
      linarith,

    },
    split, {
      assumption,
    }, {
      rw hq at hd1,
      linarith,
    },

end

theorem division_algorithm' (a b : ℤ) (ha : a > 0) (hb : b > 0) :
(∃ q r : ℤ, ((a = b * q + r) ∧ (0 ≤ r) ∧ (r < b))) :=
begin
  have h := euclidean_domain.quotient_mul_add_remainder_eq a b,
  use euclidean_domain.quotient a b,
  use euclidean_domain.remainder a b,
  sorry,
end


-- ---------------------------------------------------------------------
-- Ejercicio 1. Demostrar el teorema facil que afirma que 2 + 3 = 5.
-- ---------------------------------------------------------------------

theorem facil : 2 + 3 = 5 := rfl

-- Comentarios:
-- 1. Para activar la ventana de objetivos (*Lean Goal*) se escribe
--    C-c C-g
-- 2. Se desactiva volviendo a escribir C-c C-g
-- 3. La táctica rfl (ver https://bit.ly/2BYbiBH) comprueba que 2+3 y 5
--    son iguales por definición.

-- ---------------------------------------------------------------------
-- Ejercicio 2. Calcular el tipo de facil
-- ---------------------------------------------------------------------

-- #check facil

-- Comentario: Colocando el cursor sobre check se obtiene
--    facil : 2 + 3 = 5

-- ---------------------------------------------------------------------
-- Ejercicio 3. Enunciar el teorema dificil que afirma que se verifica
-- el último teorema de Fermat, omitiendo la demostración.
-- ---------------------------------------------------------------------

/-
def ultimo_teorema_de_Fermat :=
  ∀ x y z n : ℕ, n > 2 → x * y * z ≠ 0 → x^n + y^n ≠ z^n

theorem dificil : ultimo_teorema_de_Fermat :=
sorry
-/

-- Comentarios:
-- 1. La palabra sorry se usa para omitir la demostración.
-- 2. Se puede verificar la teoría pulsando
--       C-x ! l
--    Se obtiene
--       31   1 warning         declaration 'dificil' uses sorry

-- ---------------------------------------------------------------------
-- Ejercicio 3. Calcular el tipo de dificil.
-- ---------------------------------------------------------------------

-- #check dificil

-- Comentario: Colocando el cursor sobre check se obtiene
--    dificil : ultimo_teorema_de_Fermat


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios

! This file was ported from Lean 3 source module data.complex.cardinality
! leanprover-community/mathlib commit 1c4e18434eeb5546b212e830b2b39de6a83c473c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Complex.Basic
import Mathbin.Data.Real.Cardinality

/-!
# The cardinality of the complex numbers

This file shows that the complex numbers have cardinality continuum, i.e. `#ℂ = 𝔠`.
-/

open Cardinal Set

open Cardinal

/-- The cardinality of the complex numbers, as a type. -/
@[simp]
theorem mk_complex : (#ℂ) = 𝔠 := by
  rw [mk_congr Complex.equivRealProd, mk_prod, lift_id, mk_real, continuum_mul_self]
#align mk_complex mk_complex

/-- The cardinality of the complex numbers, as a set. -/
@[simp]
theorem mk_univ_complex : (#(Set.univ : Set ℂ)) = 𝔠 := by rw [mk_univ, mk_complex]
#align mk_univ_complex mk_univ_complex

/-- The complex numbers are not countable. -/
theorem not_countable_complex : ¬(Set.univ : Set ℂ).Countable :=
  by
  rw [← le_aleph_0_iff_set_countable, not_le, mk_univ_complex]
  apply cantor
#align not_countable_complex not_countable_complex


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

import tactic -- imports all the Lean tactics
import order.filter.basic

/-!

# The order (≤) on filters

We think of filters as generalised subsets, and just as subsets are partially ordered
by `⊆`, filters are partially ordered too, by `≤`. Recall that a subset `X : set α`
of `α` gives rise to a principal filter `𝓟 X : filter α`, and we definitely
want `X ⊆ Y ↔ 𝓟 X ≤ 𝓟 Y` so let's think about how this should work. If `F` and `G`
are filters, then `F ≤ G` should mean "the generalised subset `F` is contained
in the generalised subset `G`", so it should mean "if a normal subset of α contains
`G` then it contains `F`", so it should mean `G.sets ⊆ F.sets`, which is in fact
the definition. Note that the smaller the filter `F`, the bigger the collection
`F.sets`, because `F` is contained in more sets!

In the `filter` namespace there's a lemma

Let's formalise this. Show that 𝓟 S ≤ 𝓟 T ↔ S ⊆ T.
Note that this is called `principal_mono` in mathlib but
there's no harm in proving it yourself.

Some helpful lemmas (all in the `filter` namespace):

`mem_principal : T ∈ 𝓟 S ↔ S ⊆ T`
`mem_principal_self S : S ∈ 𝓟 S`
`le_def : F ≤ G ↔ ∀ (S : set α), S ∈ G → S ∈ F`

-/

variable {α : Type}

open filter set -- so we don't keep having to type `filter.le_def` and `set.subset.trans` etc

open_locale filter -- for 𝓟 notation

example (S T : set α) : 𝓟 S ≤ 𝓟 T ↔ S ⊆ T :=
begin
  sorry,
end

-- Here's another useful lemma about principal filters.
-- It's called `le_principal_iff` in mathlib but why
-- not try proving it yourself?

example (F : filter α) (S : set α) : F ≤ 𝓟 S ↔ S ∈ F :=
begin
  sorry,
end

/-

## Filters are a complete lattice

First I claim that if Fᵢ are a bunch of filters, indexed by `i : I`, then
the intersection of `Fᵢ.sets` is also a filter. Let's check this.

-/

def LUB {I : Type} (F : I → filter α) : filter α :=
{ sets := {X | ∀ i, X ∈ F i},
  univ_sets := begin
    sorry,
  end,
  sets_of_superset := begin
    sorry,
  end,
  inter_sets := begin
    sorry,
  end }

/-

Now let's check that this is a least upper bound for the Fᵢ! We check the
two axioms.

-/

-- it's an upper bound
example (I : Type) (F : I → filter α) (i : I) : F i ≤ LUB F :=
begin
  sorry,
end

-- it's ≤ all other upper bounds
example (I : Type) (F : I → filter α) (G : filter α) (hG : ∀ i, F i ≤ G) : LUB F ≤ G :=
begin
  sorry,
end

/-

Just like it's possible to talk about the topological space generated
by a collection of subsets of `α` -- this is the smallest topology
for which the given subsets are all open -- it's also possible to talk
about the filter generated by a collection of subsets of `α`. One
can define it as the intersection of all the filters that contain your
given collection of subsets (we just proved above that this is a filter).
This gives us a definition of greatest lower bound for filters too.

-/

-- greatest lower bound of filters Fᵢ is the least upper bound of the filters G whose `sets`
-- contain all of the `Fᵢ.sets`
def GLB {I : Type} (F : I → filter α) : filter α := LUB (λ (G : {G : filter α | ∀ i, (F i).sets ⊆ G.sets}), G.1)

-- it's a lower bound
example (I : Type) (F : I → filter α) (i : I) : GLB F ≤ F i :=
begin
  sorry,
end

-- it's ≥ all other lower bounds
example (I : Type) (F : I → filter α) (G : filter α) (hG : ∀ i, G ≤ F i) : G ≤ GLB F :=
begin
  sorry,
end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import data.matrix.basic

/-!
# Trace of a matrix

This file defines the trace of a matrix, the linear map
sending a matrix to the sum of its diagonal entries.

See also `linear_algebra.trace` for the trace of an endomorphism.

## Tags

matrix, trace, diagonal

-/

open_locale big_operators
open_locale matrix

namespace matrix

section trace

universes u v w

variables {m : Type*} (n : Type*) {p : Type*}
variables (R : Type*) (M : Type*) [semiring R] [add_comm_monoid M] [module R M]

/--
The diagonal of a square matrix.
-/
def diag : (matrix n n M) →ₗ[R] n → M :=
{ to_fun    := λ A i, A i i,
  map_add'  := by { intros, ext, refl, },
  map_smul' := by { intros, ext, refl, } }

variables {n} {R} {M}

@[simp] lemma diag_apply (A : matrix n n M) (i : n) : diag n R M A i = A i i := rfl

@[simp] lemma diag_one [decidable_eq n] :
  diag n R R 1 = λ i, 1 := by { dunfold diag, ext, simp [one_apply_eq] }

@[simp] lemma diag_transpose (A : matrix n n M) : diag n R M Aᵀ = diag n R M A := rfl

@[simp] lemma diag_col_mul_row (a b : n → R) : diag n R R (col a ⬝ row b) = a * b :=
by { ext, simp [matrix.mul_apply] }

variables (n) (R) (M)

/--
The trace of a square matrix.
-/
def trace [fintype n] : (matrix n n M) →ₗ[R] M :=
{ to_fun    := λ A, ∑ i, diag n R M A i,
  map_add'  := by { intros, apply finset.sum_add_distrib, },
  map_smul' := by { intros, simp [finset.smul_sum], } }

variables {n} {R} {M} [fintype n] [fintype m] [fintype p]

@[simp] lemma trace_diag (A : matrix n n M) : trace n R M A = ∑ i, diag n R M A i := rfl

lemma trace_apply (A : matrix n n M) : trace n R M A = ∑ i, A i i := rfl

@[simp] lemma trace_one [decidable_eq n] :
  trace n R R 1 = fintype.card n :=
have h : trace n R R 1 = ∑ i, diag n R R 1 i := rfl,
by simp_rw [h, diag_one, finset.sum_const, nsmul_one]; refl

@[simp] lemma trace_transpose (A : matrix n n M) : trace n R M Aᵀ = trace n R M A := rfl

@[simp] lemma trace_transpose_mul (A : matrix m n R) (B : matrix n m R) :
  trace n R R (Aᵀ ⬝ Bᵀ) = trace m R R (A ⬝ B) := finset.sum_comm

lemma trace_mul_comm {S : Type v} [comm_semiring S] (A : matrix m n S) (B : matrix n m S) :
  trace m S S (A ⬝ B) = trace n S S (B ⬝ A) :=
by rw [←trace_transpose, ←trace_transpose_mul, transpose_mul]

lemma trace_mul_cycle {S : Type v} [comm_semiring S]
  (A : matrix m n S) (B : matrix n p S) (C : matrix p m S) :
  trace _ S S (A ⬝ B ⬝ C) = trace p S S (C ⬝ A ⬝ B) :=
by rw [trace_mul_comm, matrix.mul_assoc]

lemma trace_mul_cycle' {S : Type v} [comm_semiring S]
  (A : matrix m n S) (B : matrix n p S) (C : matrix p m S) :
  trace _ S S (A ⬝ (B ⬝ C)) = trace p S S (C ⬝ (A ⬝ B)) :=
by rw [←matrix.mul_assoc, trace_mul_comm]

@[simp] lemma trace_col_mul_row (a b : n → R) : trace n R R (col a ⬝ row b) = dot_product a b :=
by simp [dot_product]

/-! ### Special cases for `fin n`

While `simp [fin.sum_univ_succ]` can prove these, we include them for convenience and consistency
with `matrix.det_fin_two` etc.
-/

@[simp] lemma trace_fin_zero (A : matrix (fin 0) (fin 0) R) : trace _ R R A = 0 :=
rfl

lemma trace_fin_one (A : matrix (fin 1) (fin 1) R) : trace _ R R A = A 0 0 :=
add_zero _

lemma trace_fin_two (A : matrix (fin 2) (fin 2) R) : trace _ R R A = A 0 0 + A 1 1 :=
congr_arg ((+) _) (add_zero (A 1 1))

lemma trace_fin_three (A : matrix (fin 3) (fin 3) R) : trace _ R R A = A 0 0 + A 1 1 + A 2 2 :=
by { rw [← add_zero (A 2 2), add_assoc], refl }

end trace

end matrix


import tactic
import data.set.basic
import data.real.basic
import algebra.order.floor

-- proof based on
-- https://math.stackexchange.com/questions/233670/nested-division-in-the-ceiling-function

theorem nested_ceil (m n : ℤ ) (hmpos : m > 0) (hnpos : n > 0) (x : ℝ) : ⌈x / (m * n)⌉ = ⌈(⌈x/m⌉ : ℝ) /(n : ℝ)⌉ :=
begin
  set k := ⌈x/↑m⌉,
  have h_le : ⌈x / ((m : ℝ)  * (n : ℝ)⌉  ≤ ⌈(k : ℝ) / (n : ℝ)⌉,
  {
    suffices h0 : x/(↑m * ↑n) ≤ k/↑n,
    {
      exact int.ceil_mono h0,
    },
    suffices h1 : x / ↑m ≤ ↑k,
    {
      rw ← div_div,
      have hnpos' : 0 < (n : ℝ ) := int.cast_pos.mpr hnpos,
      rwa div_le_div_right hnpos',
    },
    exact int.le_ceil (x / ↑m),

  },

  have h_ge : ⌈x / ((m : ℝ)  * (n : ℝ))⌉  ≥ ⌈(k : ℝ) / (n : ℝ)⌉,
  {
    by_contra hc, push_neg at hc,
    have h1 := int.lt.dest hc,
    cases h1 with l hl,
    rw nat.succ_eq_add_one at hl, push_cast at hl,

    have hl2 : ↑l ≥ 0 := zero_le ↑l,
    have hq1 :  ⌈x / (↑m * ↑n)⌉ ≤ ⌈x / (↑m * ↑n)⌉ + ↑l  := by linarith,
    have hq2 :  ⌈x / (↑m * ↑n)⌉ + ↑l <  ⌈(k : ℝ)  / (n : ℝ)  ⌉ := by linarith,
    set q := ⌈x / (↑m * ↑n)⌉ + ↑l,
    have hq1' : x / (↑m * ↑n) ≤ q := int.ceil_le.mp hq1,
    have hq2' : (q : ℝ)  < (k : ℝ)  / (n : ℝ)  := int.lt_ceil.mp hq2,
    have hnpos' : 0 ≤ n := le_of_lt hnpos,
    have hnpos'' : 0 ≤ (n : ℝ)  := int.cast_nonneg.mpr hnpos',
    have hq'' : (x / (↑m * ↑n)) * ↑n  ≤ q * ↑n  := mul_le_mul_of_nonneg_right hq1' hnpos'',
    rw div_mul at hq'',
    have h_n_neq_zero : n  ≠ 0 := ne_of_gt hnpos,
    have h_n_neq_zero' : ( n : ℝ )  ≠ 0 := int.cast_ne_zero.mpr h_n_neq_zero,
    rw ← mul_div at hq'',
    rw div_self h_n_neq_zero' at hq'',
    rw mul_one at hq'',
    have hqn : (q : ℝ) * (n : ℝ) = ↑(q * n) := (int.cast_mul q n).symm,
    have hk : ⌈(x / ↑m)⌉ ≤ (q * n),
    {
      refine int.ceil_le.mpr _,
      rw hqn at hq'',
      exact hq'',
    },

    have hq2'' := mul_lt_mul_of_pos_right hq2' (int.cast_pos.mpr hnpos),
    rw div_mul at hq2'',
    rw div_self h_n_neq_zero' at hq2'',
    rw div_one at hq2'',
    rw hqn at hq2'',
    have hk' : (⌈x / ↑m⌉ : ℝ)  ≤ ↑(q * n) := int.cast_le.mpr hk,
    linarith,
  },
  exact le_antisymm h_le h_ge,

end


/-
2. It is often possible to bring a component of a formula outside a universal quantifier, when it does not depend on the quantified variable. Try proving these (one direction of the second of these requires classical logic):
-/

open classical

variables (α : Type) (p q : α → Prop)
variable r : Prop

example : α → ((∀ x : α, r) ↔ r) :=
    assume a : α,
    show (∀ x : α, r) ↔ r, from
        iff.intro
        (
            assume h : (∀ x : α, r),
            show r, from h a
        )
        (
            assume h : r,
            show ∀ x : α, r, from
                assume hx : α,
                show r, from h
        )
-- short version
example : α → ((∀ x : α, r) ↔ r) :=
    λ a, iff.intro (λ h, h a) (λ h, λ hx, h)

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
    iff.intro
    (
        assume h : ∀ x, p x ∨ r,
        or.elim (em r)
        (
            assume hr : r,
            show (∀ x, p x) ∨ r, from or.inr hr
        )
        (
            assume hnr : ¬r,
            show (∀ x, p x) ∨ r, from
                or.inl
                (
                    assume xx,
                    or.elim (h xx)
                    (
                        assume hpxx : p xx,
                        show p xx, from hpxx
                    )
                    (
                        assume hr : r,
                        false.elim (hnr hr)
                    )
                )
        )
    )
    (
        assume h : (∀ x, p x) ∨ r,
        or.elim h
        (
            assume h1 : ∀ x, p x,
            show ∀ x, p x ∨ r, from
                assume x,
                or.inl (h1 x)
        )
        (
            assume h2 : r,
            show ∀ x, p x ∨ r, from
                assume x : α,
                or.inr h2
        )
    )
-- shor version
example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
    iff.intro
    (
        λ h,
        (em r).elim
        (
            λ hr : r,
            or.inr hr
        )
        (
            λ hnr : ¬r,
            or.inl (λ xx, (h xx).elim id (λ hr, absurd hr hnr) )
        )
    )
    (
        λ h, or.elim h (λ h1, λ x, or.inl (h1 x)) (λ h2, λ x, or.inr h2)
    )

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
    iff.intro
    (
        assume h : ∀ x, r → p x,
        show r → ∀ x, p x, from
            assume hr : r,
            show ∀ x, p x, from
                assume xx : α,
                (h xx) hr
    )
    (
        assume h : r → ∀ x, p x,
        show ∀ x, r → p x, from
            assume xx : α,
            assume hr : r,
            (h hr) xx
    )
-- short version
example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
    ⟨(λ h, λ hr, λ xx, (h xx) hr), (λ h, λ xx, λ hr, (h hr) xx)⟩


import topology.metric_space.basic

/-!

# Pseudometric spaces

A pseudometric on a set (or type) X is a distance function obeying
all the axioms of a metric except possible d(x,y)=0 ↔ x = y.

-/

/-- A function d : X^2 → ℝ is a *pseudometric* if it satisfies the axioms
  for a metric space apart from possibly the axiom saying d(x,y)=0 -> x=y -/
class is_pseudometric {X : Type} (d : X → X → ℝ) :=
(d_self : ∀ x : X, d x x = 0)
(d_comm : ∀ x y : X, d x y = d y x)
(d_triangle : ∀ x y z : X, d x z ≤ d x y + d y z)

-- ignore this boilerplate code: it's restating the lemmas to make them easier to use

variable {X : Type}

lemma d_self (d : X → X → ℝ) [is_pseudometric d] :
  ∀ x : X, d x x = 0 := @is_pseudometric.d_self X d _

lemma d_comm (d : X → X → ℝ) [is_pseudometric d] :
  ∀ x y : X, d x y = d y x := @is_pseudometric.d_comm X d _

lemma d_triangle (d : X → X → ℝ) [is_pseudometric d] :
  ∀ x y z : X, d x z ≤ d x y + d y z := @is_pseudometric.d_triangle X d _

-- fun fact: we never included the axiom that d x y ≥ 0, because it follows
-- from the other axioms!

variables (d : X → X → ℝ) [is_pseudometric d]

theorem d_nonneg {x y : X} : 0 ≤ d x y :=
begin

  -- First note 0 = d(x,x) ≤ d(x,y)+d(y,x) = 2d(x,y)

  have h2 : 0 ≤ 2 * d x y,
    calc 0 = d x x : by rw d_self d
    ...    ≤ d x y + d y x : by refine d_triangle d _ _ _
    ...    = d x y + d x y : by rw d_comm d
    ...    = 2 * d x y : by ring,

  -- and now the result is obvious

  linarith
end


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

import hard_mode.sheet07

/-

# A general way to produce equivalence relations

There is some general way to produce an equivalence relation from a function: Given a
function `f : X → Y`, one can define `x_1 ≈ x_2` iff `f (x_1) = f(x_2)`. One can even
assume the function `f` to be surjective, i.e. there exists a `Z` and a surjective
function `g : X → Z` such that `x_1 ≈ x_2` iff `g (x_1) = g(x_2)`. Let's try to prove
this in Lean.

-/

def function.to_rel {X Y : Type} (f : X → Y) (x_1 x_2 : X) : Prop :=
f x_1 = f x_2

lemma function.to_rel_equiv {X Y : Type} (f : X → Y) : equivalence (function.to_rel f) :=
begin
  sorry
end

instance function.to_setoid {X Y : Type} (f : X → Y) : setoid X :=
{ r := function.to_rel f,
  iseqv := function.to_rel_equiv f }

lemma exists_surjective {X Y : Type} (f : X → Y) : ∃ (Z : Type) (g : X → Z),
function.surjective g ∧ ∀ x x' : X, f x = f x' ↔ g x = g x' :=
begin
  sorry
end

/-

If you need a bit more practice, here is a slightly more general situation. Given an
equivalence relation on a type Y and a function f : X → Y, there is an equivalence relation
on X, pulled back from Y, given by two elements of X being related iff there images under
f are related. What we did up until now on this sheet is a special case where the equivalence
relation on Y is given by equality.

-/

def fun_rel.to_rel {X Y : Type} (S : Y → Y → Prop) (f : X → Y)
  (x1 x2 : X) : Prop :=
sorry

lemma fun_rel.to_rel_def {X Y : Type} (S : Y → Y → Prop) (f : X → Y)
(x_1 x_2 : X) : (fun_rel.to_rel S f) x_1 x_2 ↔ S (f x_1) (f x_2) :=
begin
  sorry
end

lemma fun_rel.to_rel_refl {X Y : Type} {S : Y → Y → Prop} (hS : reflexive S) (f : X → Y) :
  reflexive (fun_rel.to_rel S f) :=
begin
  sorry
end

lemma fun_rel.to_rel_symm {X Y : Type} {S : Y → Y → Prop} (hS : symmetric S) (f : X → Y) :
  symmetric (fun_rel.to_rel S f) :=
begin
  sorry
end

lemma fun_rel.to_rel_trans {X Y : Type} {S : Y → Y → Prop} (hS : transitive S) (f : X → Y) :
  transitive (fun_rel.to_rel S f) :=
begin
  sorry
end

lemma fun_rel.to_rel_equiv {X Y : Type} {S : Y → Y → Prop} (hS : equivalence S) (f : X → Y) :
  equivalence (fun_rel.to_rel S f) :=
begin
  sorry
end

instance fun_rel.to_setoid {X Y : Type} {S : Y → Y → Prop} (hS : equivalence S) (f : X → Y) :
  setoid X :=
{ r := fun_rel.to_rel S f,
  iseqv := fun_rel.to_rel_equiv hS f }

/-

And here is another situation which we will encounter soon. Given an equivalence relation R on
X and an equivalence relation S on Y, there is an equivalence relation on X × Y in which
two pairs are related if and only if there first and second entry are related.

-/

def prod_rel {X Y : Type} (R : X → X → Prop) (S : Y → Y → Prop)
  (u v : X × Y) : Prop :=
sorry

lemma prod_rel_def {X Y : Type} {R : X → X → Prop} {S : Y → Y → Prop} (u v : X × Y) :
  prod_rel R S u v ↔ R u.1 v.1 ∧ S u.2 v.2 :=
begin
  sorry
end

lemma prod_rel_refl {X Y : Type} {R : X → X → Prop} {S : Y → Y → Prop} (hR : reflexive R)
  (hS : reflexive S) : reflexive (prod_rel R S) :=
begin
  sorry
end

lemma prod_rel_symm {X Y : Type} {R : X → X → Prop} {S : Y → Y → Prop} (hR : symmetric R)
  (hS : symmetric S) : symmetric (prod_rel R S) :=
begin
  sorry
end

lemma prod_rel_trans {X Y : Type} {R : X → X → Prop} {S : Y → Y → Prop} (hR : transitive R)
  (hS : transitive S) : transitive (prod_rel R S) :=
begin
  sorry
end

lemma prod_rel_equiv {X Y : Type} {R : X → X → Prop} {S : Y → Y → Prop} (hR : equivalence R)
  (hS : equivalence S) : equivalence (prod_rel R S) :=
begin
  sorry
end


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

import ring_theory.polynomial.cyclotomic.eval

/-!
# Primes congruent to one

We prove that, for any positive `k : ℕ`, there are infinitely many primes `p` such that
`p ≡ 1 [MOD k]`.
-/

namespace nat

open polynomial nat filter

/-- For any positive `k : ℕ` there are infinitely many primes `p` such that `p ≡ 1 [MOD k]`. -/
lemma exists_prime_ge_modeq_one {k : ℕ} (n : ℕ) (hpos : 0 < k) :
  ∃ (p : ℕ), nat.prime p ∧ n ≤ p ∧ p ≡ 1 [MOD k] :=
begin
  let b := 3 * (k * n.factorial),
  have hgt : 1 < (eval ↑b (cyclotomic k ℤ)).nat_abs,
  { have hkey : ∀ l : ℕ, 2 < 3 * (l.succ * n.factorial) := λ l, lt_mul_of_lt_of_one_le
          (2 : ℕ).lt_succ_self (le_mul_of_le_of_one_le (nat.succ_pos _) n.factorial_pos),
    rcases k with _ | _ | k,
    { simpa using hpos, },
    { simp only [one_mul, int.coe_nat_mul, int.coe_nat_succ, int.coe_nat_zero, zero_add,
        cyclotomic_one, eval_sub, eval_X, eval_one],
      convert int.nat_abs_lt_nat_abs_of_nonneg_of_lt int.one_nonneg _,
      rw lt_sub_iff_add_lt,
      specialize hkey 0,
      norm_cast,
      rwa one_mul at hkey, },
    calc 1 ≤ _ : by { rw le_tsub_iff_left (one_le_two.trans (hkey _).le), exact (hkey _).le, }
       ... < _ : sub_one_lt_nat_abs_cyclotomic_eval (one_lt_succ_succ k)
                   (one_lt_two.trans (hkey k.succ)).ne.symm, },
  let p := min_fac (eval ↑b (cyclotomic k ℤ)).nat_abs,
  haveI hprime : fact p.prime := ⟨min_fac_prime (ne_of_lt hgt).symm⟩,
  have hroot : is_root (cyclotomic k (zmod p)) (cast_ring_hom (zmod p) b),
  { rw [is_root.def, ← map_cyclotomic_int k (zmod p), eval_map, coe_cast_ring_hom,
    ← int.cast_coe_nat, ← int.coe_cast_ring_hom, eval₂_hom, int.coe_cast_ring_hom,
      zmod.int_coe_zmod_eq_zero_iff_dvd _ _],
    apply int.dvd_nat_abs.1,
    exact_mod_cast min_fac_dvd (eval ↑b (cyclotomic k ℤ)).nat_abs },
  refine ⟨p, hprime.1, _, _⟩,
  { by_contra habs,
    exact (prime.dvd_iff_not_coprime hprime.1).1
      (dvd_factorial (min_fac_pos _) (le_of_not_ge habs))
      (coprime_of_root_cyclotomic hpos hroot).symm.coprime_mul_left_right.coprime_mul_left_right },
  { have hdiv := order_of_dvd_of_pow_eq_one (zmod.units_pow_card_sub_one_eq_one p
      (zmod.unit_of_coprime b (coprime_of_root_cyclotomic hpos hroot))),
    have : ¬p ∣ k := hprime.1.coprime_iff_not_dvd.1
      (coprime_of_root_cyclotomic hpos hroot).symm.coprime_mul_left_right.coprime_mul_right_right,
    haveI := ne_zero.of_not_dvd (zmod p) this,
    have : k = order_of (b : zmod p) := (is_root_cyclotomic_iff.mp hroot).eq_order_of,
    rw [←order_of_units, zmod.coe_unit_of_coprime, ←this] at hdiv,
    exact ((modeq_iff_dvd' hprime.1.pos).2 hdiv).symm }
end

lemma frequently_at_top_modeq_one {k : ℕ} (hpos : 0 < k) :
  ∃ᶠ p in at_top, nat.prime p ∧ p ≡ 1 [MOD k] :=
begin
  refine frequently_at_top.2 (λ n, _),
  obtain ⟨p, hp⟩ := exists_prime_ge_modeq_one n hpos,
  exact ⟨p, ⟨hp.2.1, hp.1, hp.2.2⟩⟩
end

lemma infinite_set_of_prime_modeq_one {k : ℕ} (hpos : 0 < k) :
  set.infinite {p : ℕ | nat.prime p ∧ p ≡ 1 [MOD k]} :=
frequently_at_top_iff_infinite.1 (frequently_at_top_modeq_one hpos)

end nat