import analysis.special_functions.exp
import data.real.basic
import tactic

open real

variables a b : ℝ

#check pow_two_nonneg
#check pow_two_nonneg b
#check @exp_le_exp
#check exp_le_exp.mpr

-- BEGIN
example (a : ℝ) : 0 ≤ a^2 :=
begin
  exact pow_two_nonneg a,
end

example (a b : ℝ) (h : a ≤ b) : exp a ≤ exp b :=
begin
  rw exp_le_exp,
  exact h,
end
-- END


theorem ex1 (n m : Nat) : 0 + (n, m).1 = n := by
  simp only
  rw [Nat.zero_add]

theorem ex2 (n m : Nat) : 0 + (n, m).1 = n := by
  simp

theorem ex3 (n m : Nat) : 0 + (n, m).1 + 0 = n := by
  simp only [Nat.add_zero]
  rw [Nat.zero_add]

theorem ex4 (n m : Nat) : 0 + (n, m).1 + 0 = n := by
  simp

theorem ex5 (m n : Nat) : m + n = n + m := by
  induction n with
  | zero      => rw [Nat.zero_add, Nat.add_zero]
  | succ n ih => simp only [Nat.add_succ, Nat.succ_add, ih]


-- Diversion from LTL_Diff. What if we prove that the standard smooth maximum
-- actually approximates the maximum.

-- Second attempt using fin n → ℝ.

import data.real.basic
import data.complex.exponential
import analysis.complex.basic
import analysis.special_functions.pow
import analysis.special_functions.exp_log
import analysis.calculus.times_cont_diff
import algebra.big_operators

noncomputable theory

open real classical topological_space
open_locale big_operators

-- Definition of soft_max.
section soft_max

variables (n : ℕ)

def soft_max.num (α : ℝ) : (fin (n + 1) → ℝ) → ℝ :=
λ v, ∑ i, (v i) * exp (α * (v i))

@[simp] lemma soft_max.num_zero (α : ℝ) : soft_max.num 0 α = λ v, (v 0) * exp (α * (v 0)) :=
begin
  ext v,
  unfold soft_max.num, -- How do I get rid of this ?
  rw [fin.sum_univ_succ, fin.sum_univ_zero, add_zero],
end

lemma soft_max.num_succ_aux (α : ℝ) (v : fin (n + 1).succ → ℝ) :
soft_max.num n.succ α v = (soft_max.num n α (λ i, v i)) + (v (n + 1)) * exp (α * (v (n + 1))) :=
begin
  unfold soft_max.num,
  rw fin.sum_univ_cast_succ,
  congr,
  { simp, },
  { rw ←fin.coe_nat_eq_last; refl, },
  { rw ←fin.coe_nat_eq_last; refl, }
end

@[simp] lemma soft_max.num_succ (α : ℝ) :
soft_max.num n.succ α = λ (v : fin (n + 1).succ → ℝ),
  (soft_max.num n α (λ i, v i)) + (v (n + 1)) * exp (α * (v (n + 1))) :=
by ext v; exact soft_max.num_succ_aux n α v

def soft_max.den (α : ℝ) : (fin (n + 1) → ℝ) → ℝ :=
λ v, ∑ i, exp (α * (v i))

@[simp] lemma soft_max.den_zero (α : ℝ) : soft_max.den 0 α = λ v, exp (α * (v 0)) :=
begin
  ext v,
  unfold soft_max.den, -- How do I get rid of this ?
  rw [fin.sum_univ_succ, fin.sum_univ_zero, add_zero],
end

def soft_max (α : ℝ) : (fin (n + 1) → ℝ) → ℝ :=
λ v, (soft_max.num n α v) / (soft_max.den n α v)

namespace soft_max

-- Lemma 1.a: soft_max.num is continuous everywhere.
lemma num.continuity_at : ∀ α v, continuous_at (soft_max.num n α) v :=
begin
  intros α v,
  induction n with m hm,
  { rw soft_max.num_zero,
    apply continuous_at.mul,
    { apply continuous_iff_continuous_at.1,
      apply continuous_apply, },
    { have hexp : (λ (x : fin 1 → ℝ), exp (α * x 0)) = (λ (x : fin 1 → ℝ), (exp (x 0)) ^ α),
        ext x,
        rw [mul_comm α (x 0), exp_mul],
      rw hexp,
      apply continuous_iff_continuous_at.1,
      apply continuous_rpow,
      { intros v',
        left,
        exact exp_ne_zero (v' 0), },
      { show continuous (exp ∘ (λ (a : fin 1 → ℝ), a 0)),
        refine continuous.comp continuous_exp _,
        apply continuous_apply, },
      { apply continuous_const, }, }, },
  { rw soft_max.num_succ m,
    apply continuous_at.add,
    { show continuous_at ((num m α) ∘ (λ (x : fin (m.succ + 1) → ℝ), (λ (i : fin (m + 1)), x ↑i))) v,
      apply continuous_at.comp,
      { apply hm, },
      { -- Some rearranging.
        suffices hsuff : continuous_at (λ (x : fin (m.succ + 1) → ℝ) (i : fin m.succ), x (fin.cast_succ i)) v,
        { suffices hsuff2 :
            (λ (x : fin (m.succ + 1) → ℝ) (i : fin m.succ), x (fin.cast_succ i)) =
            (λ (x : fin (m.succ + 1) → ℝ) (i : fin (m + 1)), x ↑i),
            { rw ←hsuff2,
              exact hsuff, },
          ext x i,
          simp, },
        -- Continue.
        show continuous_at (flip ((λ (i : fin (m.succ + 1)) (x : fin (m.succ + 1) → ℝ), x i) ∘ fin.cast_succ)) v,
        -- Continuous flip lemma? To mathlib?
        sorry,
        } },
    { -- This we have already proved, so factor that out and re-use.
      sorry,}, },
end

-- Lemma 1.b: soft_max.den is continuous everywhere.
lemma den.continuity_at : ∀ α v, continuous_at (soft_max.den n α) v := sorry

-- Lemma 1.b: soft_max.den is non-zero.
lemma den.nonzero : ∀ α v, soft_max.den n α v ≠ 0 := sorry

-- Lemma 1: soft_max is continuous.
lemma continuity : ∀ α, continuous (soft_max n α) :=
begin
  intro α,
  rw continuous_iff_continuous_at,
  intro v,
  apply continuous_at.div,
  { exact num.continuity_at n α v, },
  { exact den.continuity_at n α v, },
  { exact den.nonzero n α v, },
end

-- Lemma 2: soft_max is smooth.
lemma smoothness : ∀ α, times_cont_diff ℝ ⊤ (soft_max n α) :=
begin
    intro α,
    rw times_cont_diff_top,
    intro m,
    induction m,
    { erw times_cont_diff_zero,
      exact continuity n α, },
    { sorry }
end

end soft_max

end soft_max


import data.real.basic

variables (f g : ℝ → ℝ)

#check mul_le_mul_of_nonneg_left

-- BEGIN
example {c : ℝ} (mf : monotone f) (nnc : 0 ≤ c) :
  monotone (λ x, c * f x) :=
begin
  intros a b aleb,
  dsimp,
  have : f a ≤ f b,
    from mf aleb,
  exact mul_le_mul_of_nonneg_left this nnc,
end

example (mf : monotone f) (mg : monotone g) :
  monotone (λ x, f x + g x) :=
begin
  intros a b aleb,
  apply add_le_add,
  apply mf aleb,
  apply mg aleb,
end

example (mf : monotone f) (mg : monotone g) :
  monotone (λ x, f (g x)) :=
begin
  intros a b aleb,
  dsimp,
  apply mf,
  apply mg,
  apply aleb,
end
-- END


import data.nat.basic
import tactic.ring
import tactic
noncomputable theory
open_locale classical
open nat

-- "a mod b = c"
def mod (a b c : ℕ) := c < b ∧ ∃ (d : ℕ), d * b + c = a

/-
  Main theorem of this file. Used in the prime number file in order to check for primes faster
-/
theorem mod_neq_0_not_div (a b : ℕ) : (∃ (c : ℕ), c ≠ 0 ∧ mod a b c) → ¬ b ∣ a :=
begin
  intros h div,
  cases h with c hc,
  have hl := hc.left,
  cases hc.right.right with d hd,
  have hf := hc.right.left,
  cases div with e he,
  rw he at hd,
  have hg : c = b * (e - d), {
    calc c = b * e - d * b      : (norm_num.sub_nat_pos (b * e) (d * b) c hd).symm
      ...  = b * e - b * d      : by ring_nf
      ...  = b * (e - d)        : (nat.mul_sub_left_distrib b e d).symm,
  },
  have hee : (e-d) = 0 ∨ (e-d) ≥ 1, {exact (e - d).eq_zero_or_pos,},
  cases hee with zero one,
  rw [zero,mul_zero] at hg,
  exact hl hg,
  have hee : c ≥ b, {
    calc c = b * (e - d) : hg
      ...  ≥ b * 1       : mul_le_mul_left' one b
      ...  = b           : by rw mul_one,
  },
  linarith,
end


import GMLInit.Data.Nat.Basic

namespace Nat
variable {α} (f : α → α)

/-- `iter (f : α → α) (n : Nat)` calculates the `n`th iterate of the function `f` -/
@[specialize, inline] def iter : (n : Nat) → α → α
| 0, r => r
| n+1, r => iter n (f r)

theorem iter_zero (a : α) : iter f 0 a = a := rfl

theorem iter_one (a : α) : iter f 1 a = f a := rfl

theorem iter_succ (n : Nat) (a : α) : iter f (n + 1) a = iter f n (f a) := rfl

theorem iter_add (m n : Nat) (a : α) : iter f (m + n) a = iter f m (iter f n a) := by
  induction n generalizing a with
  | zero => rfl
  | succ n ih =>
    calc
    _ = iter f (m + n + 1) a := rfl
    _ = iter f (m + n) (f a) := by rw [iter_succ]
    _ = iter f m (iter f n (f a)) := by rw [ih]
    _ = iter f m (iter f (n + 1) a) := by rw [iter_succ]

theorem iter_mul (m n : Nat) (a : α) : iter f (m * n) a = iter (iter f m) n a := by
  induction n generalizing a with
  | zero => rfl
  | succ n ih =>
    calc
    _ = iter f (m * n + m) a := rfl
    _ = iter f (m * n) (iter f m a) := by rw [iter_add]
    _ = iter (iter f m) n (iter f m a) := by rw [ih]
    _ = iter (iter f m) (n + 1) a := by rw [iter_succ]

theorem iter_zero_eq_id : iter f 0 = id := rfl

theorem iter_one_eq_self : iter f 1 = f := rfl

theorem iter_succ_eq_iter_comp_self (n : Nat) : iter f (n + 1) = iter f n ∘ f := rfl

theorem iter_add_eq_iter_comp_iter (m n : Nat) : iter f (m + n) = iter f m ∘ iter f n := funext (iter_add f m n)

theorem iter_mul_eq_iter_iter (m n : Nat) : iter f (m * n) = iter (iter f m) n := funext (iter_mul f m n)

end Nat


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

import tactic -- imports all the Lean tactics

/-!

# Functions in Lean, example sheet 1 : injectivity and surjectivity

In this sheet we'll learn how to manipulate the concepts of
injectivity and surjectivity in Lean.

The notation for functions is the usual one in matheamtics:
if `X` and `Y` are types, then `f : X → Y` denotes a function
from `X` to `Y`. In fact what is going on here is that `X → Y`
denotes the type of all functions from `X` to `Y`, and `f : X → Y`
means that `f` is a term of type `X → Y`, i.e., a function
from `X` to `Y`.

One thing worth mentioning is that the simplest kind of function
evaluation, where you have `x : X` and `f : X → Y`, doesn't need
brackets: you can just write `f x` instead of `f(x)`. You only
need it when evaluating a function at a more complex object;
for example if we also had `g : Y → Z` then we can't write
`g f x` for `g(f(x))`, we have to write `g(f x)` otherwise
`g` would eat `f` and get confused. Without brackets,
a function just eats the next term greedily.

## Tactics

### More on `rcases` and `rintro` -- the `rfl` hack.

You don't need to know the below trick but it can make your
proofs shorter.

There is a clever hack in Lean which sometimes enables you to
do `cases` and `rw` all in one go. It works like this. Say
your tactic state is

```
h1 : ∃ a, b = f a
h2 : g b = d
⊢ b = c
```

If you do `cases h1 with a ha` or `rcases h1 with ⟨a, ha⟩` (the same thing)
then you'll end up with
```
a : X
ha : b = f a
h2 : g b = d
⊢ b = c
```

Now `ha`, our new hypothesis, is a "formula for b" and probably what you're
going to want to do next is "substitute in for b", i.e. `rw ha,`
or maybe even `rw ha at h2 ⊢,`or `rw ha at *` to replace `b` by `f a`
everywhere. Then there are no `b`s left other than in `ha` itself and
`ha` is now basically redundant.

Instead of the rewrites, you can use the `subst` tactic to do them for you;
`subst ha,` will remove `b` completely, replacing it with `f a` everywhere
and will then delete `ha` for you.

But even better, there is an approach where `ha` is never even created.
The tactic `rcases h1 with ⟨a, rfl⟩`, means "let `b` be `f a` by definition",
i.e. "replace all `b`s with `f a` and delete `b`". It is a bit of a hack
(because it means you can't have a variable called `rfl`) but it's very
convenient for making proofs shorter.

### More on `rw` -- syntactic equality.

The definition of `function.comp`, known to mathematicians via its `∘`
notation, is that `(f ∘ g) x = f (g x)` by definition. So if your
goal mentions `(f ∘ g) x` and you want it to mention `f (g x)` instead,
you can either use the `change` tactic, or you can define `comp_eval`
as I do below, and then `rw comp_eval f g x,`. Or you can just do nothing,
confident in the fact that because `(f ∘ g) x` and `f (g x)` are equal
by definition, we don't have to worry.

Except here's a case where you have to do something. Say your
tactic state looks like this:

```
h : g x = 37
⊢ (f ∘ g) x = b
```

Then, because `(f ∘ g) x` and `f (g x)` are equal *by definition*,
`rw h,` should work and change the goal to `f 37 = b`, right? Wrong :-(
The `rw` tactic works up to *syntactic equality*. Syntactic equality
is the strongest version of equality -- two terms are syntactically equal
if they are literally the same string of characters. In particular,
`(f ∘ g) x` and `f (g x)` are definitionally equal, but not syntactically
equal, so `rw h,` will fail.

This is why we define `comp_eval` below. It is a proof of `(f ∘ g) x = f (g x)`.
The proof is `refl`, because `refl` works up to definitional equality.
But because we have given the proof a name, you can `rw comp_eval,`
to change `(f ∘ g) x` to `f (g x)`. This means that with the tactic
state above, you can make progress with `rw [comp_eval, h],`.

-/

open function

 -- Our functions will go between these sets, or Types as Lean calls them
variables (X Y Z : Type)

-- Let's prove some theorems, each of which are true by definition.

theorem injective_def (f : X → Y) :
  injective f ↔ ∀ (a b : X), f a = f b → a = b :=
begin
  refl -- this proof works, because `injective f`
       -- means ∀ a b, f a = f b → a = b *by definition*
       -- so the proof is "it's reflexivity of `↔`"
end

-- similarly this is the *definition* of `surjective f`
theorem surjective_def (f : X → Y) :
  surjective f ↔ ∀ y : Y, ∃ x : X, f x = y :=
begin
  refl
end

-- similarly the *definition* of `id x` is `x`
theorem id_eval (x : X) :
  id x = x :=
begin
  refl
end

-- the *definition* of (g ∘ f) (x) is g(f(x)).
theorem comp_eval (f : X → Y) (g : Y → Z) (x : X) :
  (g ∘ f) x = g (f x) :=
begin
  refl
end

-- Why did we just prove all those theorems with a proof
-- saying "it's true by definition"? Because now, if we want,
-- we can `rw` the theorems to replace things by their definitions.

example : injective (id : X → X) :=
begin
  -- you can start with `rw injective_def` if you like
  -- but because `injective_def` is true by definition
  -- you can delete it later :-)
  sorry
end

example : surjective (id : X → X) :=
begin
  sorry
end

example (f : X → Y) (g : Y → Z) (hf : injective f) (hg : injective g) :
  injective (g ∘ f) :=
begin
  sorry
end

example (f : X → Y) (g : Y → Z) (hf : surjective f) (hg : surjective g) :
  surjective (g ∘ f) :=
begin
  sorry
end

-- This is a question on the IUM function problem sheet
example (f : X → Y) (g : Y → Z) :
  injective (g ∘ f) → injective f :=
begin
  sorry
end

-- This is another one
example (f : X → Y) (g : Y → Z) :
  surjective (g ∘ f) → surjective g :=
begin
  sorry
end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Kenny Lau
-/

import algebra.geom_sum
import ring_theory.ideal.quotient

/-!
# Basic results in number theory

This file should contain basic results in number theory. So far, it only contains the essential
lemma in the construction of the ring of Witt vectors.

## Main statement

`dvd_sub_pow_of_dvd_sub` proves that for elements `a` and `b` in a commutative ring `R` and for
all natural numbers `p` and `k` if `p` divides `a-b` in `R`, then `p ^ (k + 1)` divides
`a ^ (p ^ k) - b ^ (p ^ k)`.
-/

section

open ideal ideal.quotient

lemma dvd_sub_pow_of_dvd_sub {R : Type*} [comm_ring R] {p : ℕ}
  {a b : R} (h : (p : R) ∣ a - b) (k : ℕ) :
  (p^(k+1) : R) ∣ a^(p^k) - b^(p^k) :=
begin
  induction k with k ih,
  { rwa [pow_one, pow_zero, pow_one, pow_one] },
  rw [pow_succ' p k, pow_mul, pow_mul, ← geom_sum₂_mul, pow_succ],
  refine mul_dvd_mul _ ih,
  let I : ideal R := span {p},
  let f : R →+* R ⧸ I := mk I,
  have hp : (p : R ⧸ I) = 0,
  { rw [← f.map_nat_cast, eq_zero_iff_mem, mem_span_singleton] },
  rw [← mem_span_singleton, ← ideal.quotient.eq] at h,
  rw [← mem_span_singleton, ← eq_zero_iff_mem, ring_hom.map_geom_sum₂,
      ring_hom.map_pow, ring_hom.map_pow, h, geom_sum₂_self, hp, zero_mul],
end

end


import tactic

-- BEGIN
variables {α : Type*} [partial_order α]
variables a b : α

example : a < b ↔ a ≤ b ∧ a ≠ b :=
begin
  rw lt_iff_le_not_le,
  split,
    intro hl,
    split,
    cases hl with hl1 hl2,
    exact hl1,
    contrapose! hl,
    intro h',
    rw hl,

    intro hr,
    cases hr with hr1 hr2,
    split,
    exact hr1,
    contrapose! hr2,
    exact le_antisymm hr1 hr2,
end
-- END


/-
COMP2009 Tutorial 2
-/

variables P Q R : Prop

/-
What is a logic?
A particular system or codification of the principles of proof and inference.
* Propositional logic - a formal system where formulae are built by joining
  propositions using logical connectives.
* Classical logic - logic based on truth value (uses truth tables).
* Intuitionistic logic - logic based on evidence.
* Predicate logic - extends propositional logic and will be covered next week.

Classical Logic = Intuitionistic Logic + Excluded Middle (em P : P ∨ ¬ P)

It turns out that excluded middle is equivalent to another law, double
negation elimination/reductio ad absurdum (raa P : ¬ ¬ P → P).

The basic tactics seen so far in Lean have all been intuitionistic. In order
to prove classical logic formulae, we have to tell Lean we want to work in
classical logic and access EM by doing the following.
-/

open classical

-- This makes the following available.

-- #check (em P)

--------------------------------------------------------------------------------
-- PART I : EM & RAA

-- Proof that EM (P ∨ ¬ P) implies RAA (¬ ¬ P → P)

theorem raa : ¬ ¬ P → P :=
begin
    assume nnp,
    /-
        nnp : ¬ ¬ P
        ⊢ P
    -/
    cases (em P) with p np,
    /-
        (Case 1)
        nnp : ¬ ¬ P
        p : P
        ⊢ P

        (Case 2)
        nnp : ¬ ¬ P
        p : ¬ P
        ⊢ P
    -/
    exact p,
    /-
        Gets rid of Case 1
    -/
    have f : false,
    /-
        (Case 2.1)
        nnp : ¬ ¬ P
        p : ¬ P
        ⊢ false

        (Case 2.2)
        nnp : ¬ ¬ P
        p : ¬ P
        f : false
        ⊢ P
    -/
    apply nnp,
    /-
        (Case 2.1)
        nnp : ¬ ¬ P
        p : ¬ P
        ⊢ ¬ P

        (Case 2.2)
        nnp : ¬ ¬ P
        p : ¬ P
        f : false
        ⊢ P
    -/
    exact np,
    /-
        Gets rid of Case 2.1
    -/
    cases f,
    /-
        No goals (Gets rid of Case 2.2)
    -/
end

-- #check raa

-- Proof that RAA (¬ ¬ P → P) implies EM (P ∨ ¬ P)
-- (requires an auxiliary proof)

theorem nn_em : ¬ ¬ (P ∨ ¬ P) :=
begin
    assume npnp,
    /-
        npnp : ¬ (P ∨ ¬ P)
        ⊢ false
    -/
    apply npnp,
    /-
        npnp : ¬ (P ∨ ¬ P)
        ⊢ P ∨ ¬ P
    -/
    right,
    /-
        npnp : ¬ (P ∨ ¬ P)
        ⊢ ¬ P
    -/
    assume p,
    /-
        npnp : ¬ (P ∨ ¬ P)
        p : P
        ⊢ false
    -/
    apply npnp,
    /-
        npnp : ¬ (P ∨ ¬ P)
        p : P
        ⊢ P ∨ ¬ P
    -/
    left,
    /-
        npnp : ¬ (P ∨ ¬ P)
        p : P
        ⊢ P
    -/
    exact p,
    /-
        No goals
    -/
end

theorem my_em : P ∨ ¬ P :=
begin
  apply raa (P ∨ ¬ P),
  apply nn_em,
end

-- Any classical logic formula can be proved by assuming either one
-- of EM or RAA.

------------------------------------------------------------------------------
-- PART II: Examples

/-
3 possible cases:
* A) provable intuitionistically
* B) provable classically
* C) not provable
-/

-- A) Intuitionistic
theorem example_1 : ((P ∨ Q) ∧ ¬ P) → Q :=
begin
    assume hyp,
    /-
        hyp : P ∨ Q ∧ ¬ P
        ⊢ Q
    -/
    cases hyp with pq np,
    /-
        pq : P ∨ Q
        np : ¬ P
        ⊢ Q
    -/
    cases pq with p q,
    /-
        (Case P)
        p : P
        np : ¬ P
        ⊢ Q

       (Case Q)
        q : Q
        np : ¬ P
        ⊢ Q
    -/
    have f : false,
    /-
        (Case P.1)
        p : P
        np : ¬ P
        ⊢ false

        (Case P.2)
        p : P
        np : ¬ P
        f : false
        ⊢ Q

       (Case Q)
        q : Q
        np : ¬ P
        ⊢ Q
    -/
    apply np,
    /-
        (Case P.1)
        p : P
        np : ¬ P
        ⊢ P

        (Case P.2)
        p : P
        np : ¬ P
        f : false
        ⊢ Q

       (Case Q)
        q : Q
        np : ¬ P
        ⊢ Q
    -/
    exact p,
    /-
        Gets rid of Case P.1
    -/
    cases f,
    /-
        Gets rid of Case P.2
    -/
    exact q,
    /-
        No goals (Gets is of Case Q)
    -/
end
-- B) Classical
theorem example_2_em : (¬ P → Q) → (¬ Q → P) :=
-- contrapositive: (P → Q) → (¬ Q → ¬ P)
begin
    assume np2q,
    assume nq,
    /-
        np2q : ¬ P → Q
        nq : ¬ Q
        ⊢ P
    -/
    cases (em P) with p np,
    /-
        (Case p)
        np2q : ¬ P → Q
        nq : ¬ Q
        p : P
        ⊢ P

        (Case np)
        np2q : ¬ P → Q
        nq : ¬ Q
        np : ¬ P
        ⊢ P
    -/
    exact p,
    /-
        Gets rid of Case p
    -/
    have f : false,
    /-
        (Case np, f.1)
        np2q : ¬ P → Q
        nq : ¬ Q
        np : ¬ P
        ⊢ false

        (Case np, f.2)
        np2q : ¬ P → Q
        nq : ¬ Q
        np : ¬ P
        f : false
        ⊢ P
    -/
    apply nq,
    /-
        (Case np, f.1)
        np2q : ¬ P → Q
        nq : ¬ Q
        np : ¬ P
        ⊢ Q

        (Case np, f.2)
        np2q : ¬ P → Q
        nq : ¬ Q
        np : ¬ P
        f : false
        ⊢ P
    -/
    apply np2q,
    /-
        (Case np, f.1)
        np2q : ¬ P → Q
        nq : ¬ Q
        np : ¬ P
        ⊢ ¬ P

        (Case np, f.2)
        np2q : ¬ P → Q
        nq : ¬ Q
        np : ¬ P
        f : false
        ⊢ P
    -/
    exact np,
    /-
        Gets rid of Case np
    -/
    cases f,
    /-
        No goals (Gets rid of Case np, f.2)
    -/
end

theorem example_2_raa : (¬ P → Q) → (¬ Q → P) :=
begin
    assume np2q,
    assume nq,
    /-
        np2q : ¬ P → Q
        nq : ¬ Q
        ⊢ P
    -/
    apply raa,
    /-
        np2q : ¬ P → Q
        nq : ¬ Q
        ⊢ ¬¬ P
    -/
    assume np,
    /-
        np2q : ¬ P → Q
        nq : ¬ Q
        np : ¬ P
        ⊢ false
    -/
    apply nq,
    /-
        np2q : ¬ P → Q
        nq : ¬ Q
        np : ¬ P
        ⊢ Q
    -/
    apply np2q,
    /-
        np2q : ¬ P → Q
        nq : ¬ Q
        np : ¬ P
        ⊢ ¬ P
    -/
    exact np,
    /-
        No goals
    -/
end

/-
P | ¬ P | P ∨ ¬ P | ¬ (P ∨ ¬ P)
T |  F  |   T     |    F
F |  T  |   T     |    F
-/

-- C) Not provable
theorem example_3 : ¬ (P ∨ ¬ P) :=
begin
  sorry,
end

-- B) Classical
theorem example_4_em : (¬ P → P) → P :=
begin
    assume np2p,
    /-
        np2p : ¬ P → P
        ⊢ P
    -/
    cases (em P) with p np,
    /-
        (Case p)
        np2p : ¬ P → P
        p : P
        ⊢ P

        (Case np)
        np2p : ¬ P → P
        np : ¬P
        ⊢ P
    -/
    exact p,
    /-
        Gets rid of Case p
    -/
    apply np2p,
    /-
        (Case np)
        np2p : ¬ P → P
        np : ¬P
        ⊢ ¬P
    -/
    exact np,
    /-
        No goals (Gets rid of Case np)
    -/
end

theorem example_4_raa : (¬ P → P) → P :=
begin
    assume np2p,
    /-
        np2p : ¬ P → P
        ⊢ P
    -/
    apply raa,
    /-
        np2p : ¬ P → P
        ⊢ ¬¬ P
    -/
    assume np,
    /-
        np2p : ¬ P → P
        np : ¬ P
        ⊢ false
    -/
    apply np,
    /-
        np2p : ¬ P → P
        np : ¬ P
        ⊢ P
    -/
    apply np2p,
    /-
        np2p : ¬ P → P
        np : ¬ P
        ⊢ ¬ P
    -/
    exact np,
    /-
        No goals
    -/
end

/-
Tips:
* using truth tables tells us whether something is provable or not, but does
  not tell us whether it is provable intuitionistically or classically
* when trying to prove something intuitionistically, think of witnesses/evidence
  e.g. ¬ (P ∧ Q) → (¬ P ∨ ¬ Q) vs (¬ P ∨ ¬ Q) → ¬ (P ∧ Q)
  have f : P ∧ Q → false
  want either g : P → false or h : Q → false
  not provable intuitionistically
  --
  have either f : P → false or g : Q → false
  want h : P ∧ Q → false
  provable intuitionistically
-/


/-
Copyright (c) 2020 Gihan Marasingha. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gihan Marasingha
-/
import tactic.linarith

/-!
# An MIU Decision Procedure in Lean

The [MIU formal system](https://en.wikipedia.org/wiki/MU_puzzle) was introduced by Douglas
Hofstadter in the first chapter of his 1979 book,
[Gödel, Escher, Bach](https://en.wikipedia.org/wiki/G%C3%B6del,_Escher,_Bach).
The system is defined by four rules of inference, one axiom, and an alphabet of three symbols:
`M`, `I`, and `U`.

Hofstadter's central question is: can the string `"MU"` be derived?

It transpires that there is a simple decision procedure for this system. A string is derivable if
and only if it starts with `M`, contains no other `M`s, and the number of `I`s in the string is
congruent to 1 or 2 modulo 3.

The principal aim of this project is to give a Lean proof that the derivability of a string is a
decidable predicate.

## The MIU System

In Hofstadter's description, an _atom_ is any one of `M`, `I` or `U`. A _string_ is a finite
sequence of zero or more symbols. To simplify notation, we write a sequence `[I,U,U,M]`,
for example, as `IUUM`.

The four rules of inference are:

1. xI → xIU,
2. Mx → Mxx,
3. xIIIy → xUy,
4. xUUy → xy,

where the notation α → β is to be interpreted as 'if α is derivable, then β is derivable'.

Additionally, he has an axiom:

* `MI` is derivable.

In Lean, it is natural to treat the rules of inference and the axiom on an equal footing via an
inductive data type `derivable` designed so that `derviable x` represents the notion that the string
`x` can be derived from the axiom by the rules of inference. The axiom is represented as a
nonrecursive constructor for `derivable`. This mirrors the translation of Peano's axiom '0 is a
natural number' into the nonrecursive constructor `zero` of the inductive type `nat`.

## References

* [Jeremy Avigad, Leonardo de Moura and Soonho Kong, _Theorem Proving in Lean_][avigad_moura_kong-2017]
* [Douglas R Hofstadter, _Gödel, Escher, Bach_][Hofstadter-1979]

## Tags

miu, derivable strings

-/

namespace miu

/-!
### Declarations and instance derivations for `miu_atom` and `miustr`
-/

/--
The atoms of MIU can be represented as an enumerated type in Lean.
-/
@[derive decidable_eq]
inductive miu_atom : Type
| M : miu_atom
| I : miu_atom
| U : miu_atom

/-!
The annotation `@[derive decidable_eq]` above assigns the attribute `derive` to `miu_atom`, through
which Lean automatically derives that `miu_atom` is an instance of `decidable_eq`. The use of
`derive` is crucial in this project and will lead to the automatic derivation of decidability.
-/

open miu_atom

/--
We show that the type `miu_atom` is inhabited, giving `M` (for no particular reason) as the default
element.
-/
instance miu_atom_inhabited : inhabited miu_atom :=
inhabited.mk M

/--
`miu_atom.repr` is the 'natural' function from `miu_atom` to `string`.
-/
def miu_atom.repr : miu_atom → string
| M := "M"
| I := "I"
| U := "U"

/--
Using `miu_atom.repr`, we prove that ``miu_atom` is an instance of `has_repr`.
-/
instance : has_repr miu_atom :=
⟨λ u, u.repr⟩

/--
For simplicity, an `miustr` is just a list of elements of type `miu_atom`.
-/
@[derive [has_append, has_mem miu_atom]]
def miustr := list miu_atom

/--
For display purposes, an `miustr` can be represented as a `string`.
-/
def miustr.mrepr : miustr → string
| [] := ""
| (c::cs) := c.repr ++ (miustr.mrepr cs)

instance miurepr : has_repr miustr :=
⟨λ u, u.mrepr⟩

/--
In the other direction, we set up a coercion from `string` to `miustr`.
-/
def lchar_to_miustr : (list char) → miustr
| [] := []
| (c::cs) :=
  let ms := lchar_to_miustr cs in
  match c with
  | 'M' := M::ms
  | 'I' := I::ms
  | 'U' := U::ms
  |  _  := []
  end

instance string_coe_miustr : has_coe string miustr :=
⟨λ st, lchar_to_miustr st.data ⟩

/-!
### Derivability
-/

/--
The inductive type `derivable` has five constructors. The nonrecursive constructor `mk` corresponds
to Hofstadter's axiom that `"MI"` is derivable. Each of the constructors `r1`, `r2`, `r3`, `r4`
corresponds to the one of Hofstadter's rules of inference.
-/
inductive derivable : miustr → Prop
| mk : derivable "MI"
| r1 {x} : derivable (x ++ [I]) → derivable (x ++ [I, U])
| r2 {x} : derivable (M :: x) → derivable (M :: x ++ x)
| r3 {x y} : derivable (x ++ [I, I, I] ++ y) → derivable (x ++ U :: y)
| r4 {x y} : derivable (x ++ [U, U] ++ y) → derivable (x ++ y)

/-!
### Rule usage examples
-/

example (h : derivable "UMI") : derivable "UMIU" :=
begin
  change ("UMIU" : miustr) with [U,M] ++ [I,U],
  exact derivable.r1 h, -- Rule 1
end

example (h : derivable "MIIU") : derivable "MIIUIIU" :=
begin
  change ("MIIUIIU" : miustr) with M :: [I,I,U] ++ [I,I,U],
  exact derivable.r2 h, -- Rule 2
end

example (h : derivable "UIUMIIIMMM") : derivable "UIUMUMMM" :=
begin
  change ("UIUMUMMM" : miustr) with [U,I,U,M] ++ U :: [M,M,M],
  exact derivable.r3 h, -- Rule 3
end

example (h : derivable "MIMIMUUIIM") : derivable "MIMIMIIM" :=
begin
  change ("MIMIMIIM" : miustr) with [M,I,M,I,M] ++ [I,I,M],
  exact derivable.r4 h, -- Rule 4
end

/-!
### Derivability examples
-/

private lemma MIU_der : derivable "MIU":=
begin
  change ("MIU" :miustr) with [M] ++ [I,U],
  apply derivable.r1, -- reduce to deriving "MI",
  constructor, -- which is the base of the inductive construction.
end

example : derivable "MIUIU" :=
begin
  change ("MIUIU" : miustr) with M :: [I,U] ++ [I,U],
  exact derivable.r2 MIU_der, -- `"MIUIU"` can be derived as `"MIU"` can.
end

example : derivable "MUI" :=
begin
  have h₂ : derivable "MII",
  { change ("MII" : miustr) with M :: [I] ++ [I],
    exact derivable.r2 derivable.mk, },
  have h₃ : derivable "MIIII",
  { change ("MIIII" : miustr) with M :: [I,I] ++ [I,I],
    exact derivable.r2 h₂, },
  change ("MUI" : miustr) with [M] ++ U :: [I],
  exact derivable.r3 h₃, -- We prove our main goal using rule 3
end

end miu


import .Funcion_inversa

universes u v
variables {α : Type u} [inhabited α]
variables {β : Type v}
variable  f : α → β
variable  g : β → α
variable  x : α

open set function

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que g es la inversa por la izquierda de f syss
--    ∀ x, g (f x) = x
-- ----------------------------------------------------------------------

example : left_inverse g f ↔ ∀ x, g (f x) = x :=
by rw left_inverse

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que las siguientes condiciones son equivalentes:
-- 1. f es inyectiva
-- 2. left_inverse (inverse f) f
-- ----------------------------------------------------------------------

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

example : injective f ↔ left_inverse (inverse f) f  :=
begin
  split,
  { intros h y,
    apply h,
    apply inverse_spec,
    use y },
  { intros h x1 x2 e,
    rw ←h x1,
    rw ←h x2,
    rw e },
end

-- Prueba
-- ======

/-
α : Type u,
_inst_1 : inhabited α,
β : Type v,
f : α → β
⊢ injective f ↔ left_inverse (inverse f) f
  >> split,
| ⊢ injective f → left_inverse (inverse f) f
|   >> { intros h y,
| h : injective f,
| y : α
| ⊢ inverse f (f y) = y
|   >>   apply h,
| ⊢ f (inverse f (f y)) = f y
|   >>   apply inverse_spec,
| ⊢ ∃ (x : α), f x = f y
|   >>   use y },
⊢ left_inverse (inverse f) f → injective f
  >> { intros h x1 x2 e,
h : left_inverse (inverse f) f,
x1 x2 : α,
e : f x1 = f x2
⊢ x1 = x2
  >>   rw ←h x1,
⊢ inverse f (f x1) = x2
  >>   rw ←h x2,
⊢ inverse f (f x1) = inverse f (f x2)
  >>   rw e },
no goals
-/

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

example : injective f ↔ left_inverse (inverse f) f  :=
⟨λ h y, h (inverse_spec _ ⟨y, rfl⟩),
 λ h x1 x2 e, by rw [←h x1, ←h x2, e]⟩


/-
Copyright (c) 2022 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser

! This file was ported from Lean 3 source module data.set.pointwise.list_of_fn
! leanprover-community/mathlib commit f694c7dead66f5d4c80f446c796a5aad14707f0e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Pointwise.Basic
import Mathlib.Data.List.OfFn

/-!
# Pointwise operations with lists of sets

This file proves some lemmas about pointwise algebraic operations with lists of sets.
-/

namespace Set

variable {F α β γ : Type _}

variable [Monoid α] {s t : Set α} {a : α} {m n : ℕ}

open Pointwise

@[to_additive]
theorem mem_prod_list_ofFn {a : α} {s : Fin n → Set α} :
    a ∈ (List.ofFn s).prod ↔ ∃ f : ∀ i : Fin n, s i, (List.ofFn fun i ↦ (f i : α)).prod = a :=
  by
  induction' n with n ih generalizing a
  · simp_rw [List.ofFn_zero, List.prod_nil, Fin.exists_fin_zero_pi, eq_comm, Set.mem_one]
  ·
    simp_rw [List.ofFn_succ, List.prod_cons, Fin.exists_fin_succ_pi, Fin.cons_zero, Fin.cons_succ,
      mem_mul, @ih, exists_and_left, exists_exists_eq_and, SetCoe.exists, Subtype.coe_mk,
      exists_prop]
#align set.mem_prod_list_of_fn Set.mem_prod_list_ofFn
#align set.mem_sum_list_of_fn Set.mem_sum_list_ofFn

@[to_additive]
theorem mem_list_prod {l : List (Set α)} {a : α} :
    a ∈ l.prod ↔
      ∃ l' : List (Σs : Set α, ↥s),
        List.prod (l'.map fun x ↦ (Sigma.snd x : α)) = a ∧ l'.map Sigma.fst = l :=
  by
  induction' l using List.ofFnRec with n f
  simp only [mem_prod_list_ofFn, List.exists_iff_exists_tuple, List.map_ofFn, Function.comp,
    List.ofFn_inj', Sigma.mk.inj_iff, and_left_comm, exists_and_left, exists_eq_left, heq_eq_eq]
  constructor
  · rintro ⟨fi, rfl⟩
    exact ⟨fun i ↦ ⟨_, fi i⟩, rfl, rfl⟩
  · rintro ⟨fi, rfl, rfl⟩
    exact ⟨fun i ↦ _, rfl⟩
#align set.mem_list_prod Set.mem_list_prod
#align set.mem_list_sum Set.mem_list_sum

@[to_additive]
theorem mem_pow {a : α} {n : ℕ} :
    a ∈ s ^ n ↔ ∃ f : Fin n → s, (List.ofFn fun i ↦ (f i : α)).prod = a := by
  rw [← mem_prod_list_ofFn, List.ofFn_const, List.prod_replicate]
#align set.mem_pow Set.mem_pow
#align set.mem_nsmul Set.mem_nsmul

end Set


import data.real.basic
--- sub_nonneg {x y : ℝ} : 0 ≤ y - x ↔ x ≤ y

example {a b c : ℝ} (hab : a ≤ b) : c + a ≤ c + b :=
begin
  rw ← sub_nonneg,
  have key : (c + b) - (c + a) = b - a, by {ring},
  rw key,
  rw sub_nonneg,
  exact hab,
end

example {a b c : ℝ} (hab : a ≤ b) : c + a ≤ c + b :=
begin
  apply add_le_add_left hab,
end

example {a b : ℝ} (ha : 0 ≤ a) : b ≤ a + b :=
begin
  calc
    b   = 0 + b : by {ring}
    ... ≤ a + b : by {exact add_le_add_right ha b},
end

example {a b : ℝ} (hb: 0 ≤ b) : a ≤ a + b :=
begin
  calc
    a   = a + 0 : by {ring}
    ... ≤ a + b : by {exact add_le_add_left hb a},
end

-- le_add_of_nonneg_left  {a b : ℝ} (ha : 0 ≤ a) : b ≤ a + b
-- le_add_of_nonneg_right {a b : ℝ} (hb : 0 ≤ b) : a ≤ a + b
example {a b : ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a + b :=
begin
  calc
    0   ≤ a     : ha
    ... ≤ a + b : le_add_of_nonneg_right hb,
end

example {a b c d : ℝ} (hab : a ≤ b) (hcd : c ≤ d) : a + c ≤ b + d :=
begin
  calc
    a + c ≤ b + c : by {exact add_le_add_right hab c}
    ...   ≤ b + d : by {exact add_le_add_left hcd b},
end

example {a b c : ℝ} (hc : 0 ≤ c) (hab : a ≤ b) : a*c ≤ b*c :=
begin
  rw ← sub_nonneg,
  have key : b * c - a * c = (b - a) * c := by ring,
  rw key,
  apply mul_nonneg, -- {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) : 0 ≤ x*y
  {
    rw sub_nonneg,
    exact hab,
  },
  {
    exact hc
  }
end

example {a b c : ℝ} (hc : 0 ≤ c) (hab : a ≤ b) : a*c ≤ b*c :=
begin
  have hab' : 0 ≤ b - a, {rwa ← sub_nonneg at hab}, -- `rw ← sub_nonneg at hab; exact hab`
  have h₁ : 0 ≤ (b-a)*c, {exact mul_nonneg hab' hc},
  have h₂ : (b-a)*c = b*c - a*c, by ring,
  have h₃ : 0 ≤ b*c - a*c, by rwa h₂ at h₁,
  rwa sub_nonneg at h₃,
end

example {a b c : ℝ} (hc : 0 ≤ c) (hab : a ≤ b) : a*c ≤ b*c :=
begin
  rw ← sub_nonneg,
  calc
    0   ≤ (b-a)*c   : mul_nonneg (by rwa sub_nonneg) hc
    ... = b*c - a*c : by ring,
end

example {a b c : ℝ} (hc : c ≤ 0) (hab : a ≤ b) : b*c ≤ a*c :=
begin
  rw ← sub_nonpos at hab,
  rw ← sub_nonneg,
  have key : a * c - b * c = (a - b) * c := by ring,
  rw key,
  exact (mul_nonneg_of_nonpos_of_nonpos hab hc),
end

-- le_add_of_nonneg_left (a b : ℝ) : 0 ≤ a → b ≤ a + b
example {a b : ℝ} : 0 ≤ a → b ≤ a + b := le_add_of_nonneg_left

example {a b : ℝ} : 0 ≤ b → a ≤ a + b :=
begin
  intros h,
  calc
    a   = a + 0 : by {ring}
    ... ≤ a + b : by {exact add_le_add_left h a},
end

example {a b : ℝ} : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b :=
begin
  intros h,
  cases h with ha hb,
  exact add_nonneg ha hb,
end

example {a b : ℝ} : 0 ≤ a → 0 ≤ b → (0 ≤ a + b) := add_nonneg

example {a b : ℝ} (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b) : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intros ha hb,
  apply H,
  split,
  exact ha,
  exact hb,
end

example (P Q R : Prop) : P ∧ Q → Q ∧ P :=
begin
  intro h,
  cases h with hp hq,
  split,
  exact hq,
  exact hp,
end

example {a b : ℝ} (H : (0 ≤ a ∧ 0 ≤ b) → 0 ≤ a + b) : 0 ≤ a → (0 ≤ b → 0 ≤ a + b) :=
begin
  intros ha hb,
  exact H ⟨ ha, hb ⟩,
end

example (P Q R : Prop): P ∧ Q → Q ∧ P :=
begin
  rintros ⟨h₁, h₂⟩,
  exact ⟨h₂, h₁⟩,
end

example {P Q R : Prop} : (P ∧ Q → R) ↔ (P → Q → R) :=
begin
  split,
  intros h,
  intros hp hq,
  apply h,
  split,
  exact hp,
  exact hq,

  intros h,
  intros hpq,
  cases hpq with hp hq,
  apply h,
  exact hp,
  exact hq,
end

example (a b : ℝ) (hb : 0 ≤ b) : a ≤ a + b :=
begin
  linarith,
end


import algebra.group.basic
import data.bracket

/- # The simplifier
Up till now we have been using `rewrite` to manually instruct Lean which steps to take one at a time.
This is a very useful tool, but after a while you will notice that there are some rewrites that
will always make things easier when substituted.
For example we almost always want to use the fact that multiplying by 1 or adding 0 doesn't
change things.
-/

/- Tactic : simp

## Summary

The `simp` tactic is a high-level tactic which tries
to prove equalities using facts in its database.

## Details

The `simp` tactic does basic automation.
For example, some proofs involve a tedious number of rewrites of `add_assoc` and `add_comm`,
the same is true of `mul_assoc` and `mul_comm` in the case of multiplication.
We can use `simp` to do this automatically.
To tell `simp` to use some lemma `h` when simplifying, write `simp[h]`. More generally,
for `simp` to include additional lemmas `h1`, `h2`, ..., `hn` when simplifying, write
`simp[h1, h2, ..., hn]`.

### Example:
If our goal is this:
```
⊢ a + b + c + d + e = a + (b + (c + d) + e)
```

we can solve this with `simp` using `simp[add_assoc]`.

### Example:
If our goal is this:
```
⊢ a * b * c = c * b * a
```
-/
/-

# Commutator identities

In these exercises we will write the proofs of the identities in
<https://en.wikipedia.org/wiki/Commutator#Identities_(group_theory)>
in Lean.

First we will set up the basic definitions, in World 1, we didn't make any new mathematical
definitions, we just made use of the natural numbers, propositions, and some lemmas Lean
already knew about.

-/
notation `[`x`, `y`]` := has_bracket.bracket x y -- hide
definition commutator {G : Type*} [group G] (x y : G) : G := x⁻¹ * y⁻¹ * x * y
instance group.has_bracket {G : Type*} [group G] : has_bracket G G := ⟨commutator⟩ -- hide
definition conjugate {G : Type*} [group G] (x y : G) : G := y⁻¹ * x * y
instance group.has_pow {G : Type*} [group G] : has_pow G G := ⟨conjugate⟩ -- hide
/- Axiom : The definition of commutator
commutator_def : [x, y] = x⁻¹ * y⁻¹ * x * y
-/
lemma commutator_def {G : Type*} [group G] {x y : G} : [x, y] = x⁻¹ * y⁻¹ * x * y := rfl
/- Axiom : The definition of conjugate
conjugate_def : y^x = x⁻¹ * y * x := rfl
-/
lemma conjugate_def {G : Type*} [group G] {x y : G} : y^x = x⁻¹ * y * x := rfl

/- Axiom : cancelling inverses on the right
inv_mul_cancel_right : ∀ {G : Type} [_inst_1 : group G] (a b : G), a * b⁻¹ * b = a
-/

/- Axiom : cancelling an element with its own inverse
inv_mul_self : ∀ {G : Type} [_inst_1 : group G] (a : G), a⁻¹ * a = 1
-/

/-
Remember to check out the panel on the left for some useful lemmas
-/

/- Lemma :
-/
@[simp]
lemma commutator_self {G : Type} [group G] {x : G} : [x, x] = 1 :=
begin
  rw commutator_def,
  rw inv_mul_cancel_right,
  rw inv_mul_self,

end


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Alena Gusakov, Yaël Dillies

! This file was ported from Lean 3 source module combinatorics.set_family.shadow
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Slice
import Mathlib.Logic.Function.Iterate

/-!
# Shadows

This file defines shadows of a set family. The shadow of a set family is the set family of sets we
get by removing any element from any set of the original family. If one pictures `finset α` as a big
hypercube (each dimension being membership of a given element), then taking the shadow corresponds
to projecting each finset down once in all available directions.

## Main definitions

* `Finset.shadow`: The shadow of a set family. Everything we can get by removing a new element from
  some set.
* `Finset.up_shadow`: The upper shadow of a set family. Everything we can get by adding an element
  to some set.

## Notation

We define notation in locale `FinsetFamily`:
* `∂ 𝒜`: Shadow of `𝒜`.
* `∂⁺ 𝒜`: Upper shadow of `𝒜`.

We also maintain the convention that `a, b : α` are elements of the ground type, `s, t : finset α`
are finsets, and `𝒜, ℬ : finset (finset α)` are finset families.

## References

* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf
* http://discretemath.imp.fu-berlin.de/DMII-2015-16/kruskal.pdf

## Tags

shadow, set family
-/

open Finset Nat

variable {α : Type _}

namespace Finset

section Shadow

variable [DecidableEq α] {𝒜 : Finset (Finset α)} {s t : Finset α} {a : α} {k r : ℕ}

/-- The shadow of a set family `𝒜` is all sets we can get by removing one element from any set in
`𝒜`, and the (`k` times) iterated shadow (`shadow^[k]`) is all sets we can get by removing `k`
elements from any set in `𝒜`. -/
def shadow (𝒜 : Finset (Finset α)) : Finset (Finset α) :=
  𝒜.sup fun s => s.image (erase s)
#align finset.shadow Finset.shadow

-- mathport name: finset.shadow
-- Porting note: added `inherit_doc` to calm linter
@[inherit_doc] scoped[FinsetFamily] notation:90 "∂ " => Finset.shadow
-- Porting note: had to open FinsetFamily
open FinsetFamily

/-- The shadow of the empty set is empty. -/
@[simp]
theorem shadow_empty : (∂ ) (∅ : Finset (Finset α)) = ∅ :=
  rfl
#align finset.shadow_empty Finset.shadow_empty

@[simp]
theorem shadow_singleton_empty : (∂ ) ({∅} : Finset (Finset α)) = ∅ :=
  rfl
#align finset.shadow_singleton_empty Finset.shadow_singleton_empty

--TODO: Prove `∂ {{a}} = {∅}` quickly using `covers` and `grade_order`
/-- The shadow is monotone. -/
@[mono]
theorem shadow_monotone : Monotone (shadow : Finset (Finset α) → Finset (Finset α)) := fun _ _ =>
  sup_mono
#align finset.shadow_monotone Finset.shadow_monotone

/-- `s` is in the shadow of `𝒜` iff there is an `t ∈ 𝒜` from which we can remove one element to
get `s`. -/
theorem mem_shadow_iff : s ∈ (∂ ) 𝒜 ↔ ∃ t ∈ 𝒜, ∃ a ∈ t, erase t a = s := by
  simp only [shadow, mem_sup, mem_image]
#align finset.mem_shadow_iff Finset.mem_shadow_iff

theorem erase_mem_shadow (hs : s ∈ 𝒜) (ha : a ∈ s) : erase s a ∈ (∂ ) 𝒜 :=
  mem_shadow_iff.2 ⟨s, hs, a, ha, rfl⟩
#align finset.erase_mem_shadow Finset.erase_mem_shadow

/-- `t` is in the shadow of `𝒜` iff we can add an element to it so that the resulting finset is in
`𝒜`. -/
theorem mem_shadow_iff_insert_mem : s ∈ (∂ ) 𝒜 ↔ ∃ (a : _)(_ : a ∉ s), insert a s ∈ 𝒜 := by
  refine' mem_shadow_iff.trans ⟨_, _⟩
  · rintro ⟨s, hs, a, ha, rfl⟩
    refine' ⟨a, not_mem_erase a s, _⟩
    rwa [insert_erase ha]
  · rintro ⟨a, ha, hs⟩
    exact ⟨insert a s, hs, a, mem_insert_self _ _, erase_insert ha⟩
#align finset.mem_shadow_iff_insert_mem Finset.mem_shadow_iff_insert_mem

/-- The shadow of a family of `r`-sets is a family of `r - 1`-sets. -/
protected theorem Set.Sized.shadow (h𝒜 : (𝒜 : Set (Finset α)).Sized r) :
    ((∂ ) 𝒜 : Set (Finset α)).Sized (r - 1) := by
  intro A h
  obtain ⟨A, hA, i, hi, rfl⟩ := mem_shadow_iff.1 h
  rw [card_erase_of_mem hi, h𝒜 hA]
#align finset.set.sized.shadow Finset.Set.Sized.shadow

theorem sized_shadow_iff (h : ∅ ∉ 𝒜) :
    ((∂ ) 𝒜 : Set (Finset α)).Sized r ↔ (𝒜 : Set (Finset α)).Sized (r + 1) := by
  refine' ⟨fun h𝒜 s hs => _, Set.Sized.shadow⟩
  obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 (ne_of_mem_of_not_mem hs h)
  rw [← h𝒜 (erase_mem_shadow hs ha), card_erase_add_one ha]
#align finset.sized_shadow_iff Finset.sized_shadow_iff

/-- `s ∈ ∂ 𝒜` iff `s` is exactly one element less than something from `𝒜` -/
theorem mem_shadow_iff_exists_mem_card_add_one :
    s ∈ (∂ ) 𝒜 ↔ ∃ t ∈ 𝒜, s ⊆ t ∧ t.card = s.card + 1 := by
  refine' mem_shadow_iff_insert_mem.trans ⟨_, _⟩
  · rintro ⟨a, ha, hs⟩
    exact ⟨insert a s, hs, subset_insert _ _, card_insert_of_not_mem ha⟩
  · rintro ⟨t, ht, hst, h⟩
    obtain ⟨a, ha⟩ : ∃ a, t \ s = {a} :=
      card_eq_one.1 (by rw [card_sdiff hst, h, add_tsub_cancel_left])
    exact
      ⟨a, fun hat => not_mem_sdiff_of_mem_right hat ((ha.ge : _ ⊆ _) <| mem_singleton_self a), by
        rwa [insert_eq a s, ← ha, sdiff_union_of_subset hst]⟩
#align finset.mem_shadow_iff_exists_mem_card_add_one Finset.mem_shadow_iff_exists_mem_card_add_one

/-- Being in the shadow of `𝒜` means we have a superset in `𝒜`. -/
theorem exists_subset_of_mem_shadow (hs : s ∈ (∂ ) 𝒜) : ∃ t ∈ 𝒜, s ⊆ t :=
  let ⟨t, ht, hst⟩ := mem_shadow_iff_exists_mem_card_add_one.1 hs
  ⟨t, ht, hst.1⟩
#align finset.exists_subset_of_mem_shadow Finset.exists_subset_of_mem_shadow

/-- `t ∈ ∂^k 𝒜` iff `t` is exactly `k` elements less than something in `𝒜`. -/
theorem mem_shadow_iff_exists_mem_card_add :
    s ∈ (∂ ^[k]) 𝒜 ↔ ∃ t ∈ 𝒜, s ⊆ t ∧ t.card = s.card + k := by
  induction' k with k ih generalizing 𝒜 s
  · refine' ⟨fun hs => ⟨s, hs, Subset.refl _, rfl⟩, _⟩
    rintro ⟨t, ht, hst, hcard⟩
    rwa [eq_of_subset_of_card_le hst hcard.le]
  simp only [exists_prop, Function.comp_apply, Function.iterate_succ]
  refine' ih.trans _
  clear ih
  constructor
  · rintro ⟨t, ht, hst, hcardst⟩
    obtain ⟨u, hu, htu, hcardtu⟩ := mem_shadow_iff_exists_mem_card_add_one.1 ht
    refine' ⟨u, hu, hst.trans htu, _⟩
    rw [hcardtu, hcardst]
    rfl
  · rintro ⟨t, ht, hst, hcard⟩
    obtain ⟨u, hsu, hut, hu⟩ :=
      Finset.exists_intermediate_set k
        (by
          rw [add_comm, hcard]
          exact le_succ _)
        hst
    rw [add_comm] at hu
    refine' ⟨u, mem_shadow_iff_exists_mem_card_add_one.2 ⟨t, ht, hut, _⟩, hsu, hu⟩
    rw [hcard, hu]
    rfl
#align finset.mem_shadow_iff_exists_mem_card_add Finset.mem_shadow_iff_exists_mem_card_add

end Shadow

open FinsetFamily

section UpShadow

variable [DecidableEq α] [Fintype α] {𝒜 : Finset (Finset α)} {s t : Finset α} {a : α} {k r : ℕ}

/-- The upper shadow of a set family `𝒜` is all sets we can get by adding one element to any set in
`𝒜`, and the (`k` times) iterated upper shadow (`up_shadow^[k]`) is all sets we can get by adding
`k` elements from any set in `𝒜`. -/
def upShadow (𝒜 : Finset (Finset α)) : Finset (Finset α) :=
  𝒜.sup fun s => sᶜ.image fun a => insert a s
#align finset.up_shadow Finset.upShadow

-- mathport name: finset.up_shadow
-- Porting note: added `inheric_doc` to calm linter
@[inherit_doc] scoped[FinsetFamily] notation:90 "∂⁺ " => Finset.upShadow

/-- The upper shadow of the empty set is empty. -/
@[simp]
theorem upShadow_empty : (∂⁺ ) (∅ : Finset (Finset α)) = ∅ :=
  rfl
#align finset.up_shadow_empty Finset.upShadow_empty

/-- The upper shadow is monotone. -/
@[mono]
theorem upShadow_monotone : Monotone (upShadow : Finset (Finset α) → Finset (Finset α)) :=
  fun _ _ => sup_mono
#align finset.up_shadow_monotone Finset.upShadow_monotone

/-- `s` is in the upper shadow of `𝒜` iff there is an `t ∈ 𝒜` from which we can remove one element
to get `s`. -/
theorem mem_upShadow_iff : s ∈ (∂⁺ ) 𝒜 ↔ ∃ t ∈ 𝒜, ∃ (a : _)(_ : a ∉ t), insert a t = s := by
  simp_rw [upShadow, mem_sup, mem_image, exists_prop, mem_compl]
#align finset.mem_up_shadow_iff Finset.mem_upShadow_iff

theorem insert_mem_upShadow (hs : s ∈ 𝒜) (ha : a ∉ s) : insert a s ∈ (∂⁺ ) 𝒜 :=
  mem_upShadow_iff.2 ⟨s, hs, a, ha, rfl⟩
#align finset.insert_mem_up_shadow Finset.insert_mem_upShadow

/-- The upper shadow of a family of `r`-sets is a family of `r + 1`-sets. -/
protected theorem Set.Sized.upShadow (h𝒜 : (𝒜 : Set (Finset α)).Sized r) :
    ((∂⁺ ) 𝒜 : Set (Finset α)).Sized (r + 1) := by
  intro A h
  obtain ⟨A, hA, i, hi, rfl⟩ := mem_upShadow_iff.1 h
  rw [card_insert_of_not_mem hi, h𝒜 hA]
#align finset.set.sized.up_shadow Finset.Set.Sized.upShadow

/-- `t` is in the upper shadow of `𝒜` iff we can remove an element from it so that the resulting
finset is in `𝒜`. -/
theorem mem_upShadow_iff_erase_mem : s ∈ (∂⁺ ) 𝒜 ↔ ∃ a ∈ s, s.erase a ∈ 𝒜 := by
  refine' mem_upShadow_iff.trans ⟨_, _⟩
  · rintro ⟨s, hs, a, ha, rfl⟩
    refine' ⟨a, mem_insert_self a s, _⟩
    rwa [erase_insert ha]
  · rintro ⟨a, ha, hs⟩
    exact ⟨s.erase a, hs, a, not_mem_erase _ _, insert_erase ha⟩
#align finset.mem_up_shadow_iff_erase_mem Finset.mem_upShadow_iff_erase_mem

/-- `s ∈ ∂⁺ 𝒜` iff `s` is exactly one element less than something from `𝒜`. -/
theorem mem_upShadow_iff_exists_mem_card_add_one :
    s ∈ (∂⁺ ) 𝒜 ↔ ∃ t ∈ 𝒜, t ⊆ s ∧ t.card + 1 = s.card := by
  refine' mem_upShadow_iff_erase_mem.trans ⟨_, _⟩
  · rintro ⟨a, ha, hs⟩
    exact ⟨s.erase a, hs, erase_subset _ _, card_erase_add_one ha⟩
  · rintro ⟨t, ht, hts, h⟩
    obtain ⟨a, ha⟩ : ∃ a, s \ t = {a} :=
      card_eq_one.1 (by rw [card_sdiff hts, ← h, add_tsub_cancel_left])
    refine' ⟨a, sdiff_subset _ _ ((ha.ge : _ ⊆ _) <| mem_singleton_self a), _⟩
    rwa [← sdiff_singleton_eq_erase, ← ha, sdiff_sdiff_eq_self hts]
#align finset.mem_up_shadow_iff_exists_mem_card_add_one Finset.mem_upShadow_iff_exists_mem_card_add_one

/-- Being in the upper shadow of `𝒜` means we have a superset in `𝒜`. -/
theorem exists_subset_of_mem_upShadow (hs : s ∈ (∂⁺ ) 𝒜) : ∃ t ∈ 𝒜, t ⊆ s :=
  let ⟨t, ht, hts, _⟩ := mem_upShadow_iff_exists_mem_card_add_one.1 hs
  ⟨t, ht, hts⟩
#align finset.exists_subset_of_mem_up_shadow Finset.exists_subset_of_mem_upShadow

/-- `t ∈ ∂^k 𝒜` iff `t` is exactly `k` elements more than something in `𝒜`. -/
theorem mem_upShadow_iff_exists_mem_card_add :
    s ∈ (∂⁺ ^[k]) 𝒜 ↔ ∃ t ∈ 𝒜, t ⊆ s ∧ t.card + k = s.card := by
  induction' k with k ih generalizing 𝒜 s
  · refine' ⟨fun hs => ⟨s, hs, Subset.refl _, rfl⟩, _⟩
    rintro ⟨t, ht, hst, hcard⟩
    rwa [← eq_of_subset_of_card_le hst hcard.ge]
  simp only [exists_prop, Function.comp_apply, Function.iterate_succ]
  refine' ih.trans _
  clear ih
  constructor
  · rintro ⟨t, ht, hts, hcardst⟩
    obtain ⟨u, hu, hut, hcardtu⟩ := mem_upShadow_iff_exists_mem_card_add_one.1 ht
    refine' ⟨u, hu, hut.trans hts, _⟩
    rw [← hcardst, ← hcardtu, add_right_comm]
    rfl
  · rintro ⟨t, ht, hts, hcard⟩
    obtain ⟨u, htu, hus, hu⟩ :=
      Finset.exists_intermediate_set 1
        (by
          rw [add_comm, ← hcard]
          exact add_le_add_left (succ_le_of_lt (zero_lt_succ _)) _)
        hts
    rw [add_comm] at hu
    refine' ⟨u, mem_upShadow_iff_exists_mem_card_add_one.2 ⟨t, ht, htu, hu.symm⟩, hus, _⟩
    rw [hu, ← hcard, add_right_comm]
    rfl
#align finset.mem_up_shadow_iff_exists_mem_card_add Finset.mem_upShadow_iff_exists_mem_card_add

@[simp]
theorem shadow_image_compl : ((∂ ) 𝒜).image compl = (∂⁺ ) (𝒜.image compl) := by
  ext s
  simp only [mem_image, exists_prop, mem_shadow_iff, mem_upShadow_iff]
  constructor
  · rintro ⟨_, ⟨s, hs, a, ha, rfl⟩, rfl⟩
    exact ⟨sᶜ, ⟨s, hs, rfl⟩, a, not_mem_compl.2 ha, compl_erase.symm⟩
  · rintro ⟨_, ⟨s, hs, rfl⟩, a, ha, rfl⟩
    exact ⟨s.erase a, ⟨s, hs, a, not_mem_compl.1 ha, rfl⟩, compl_erase⟩
#align finset.shadow_image_compl Finset.shadow_image_compl

@[simp]
theorem upShadow_image_compl : ((∂⁺ ) 𝒜).image compl = (∂ ) (𝒜.image compl) := by
  ext s
  simp only [mem_image, exists_prop, mem_shadow_iff, mem_upShadow_iff]
  constructor
  · rintro ⟨_, ⟨s, hs, a, ha, rfl⟩, rfl⟩
    exact ⟨sᶜ, ⟨s, hs, rfl⟩, a, mem_compl.2 ha, compl_insert.symm⟩
  · rintro ⟨_, ⟨s, hs, rfl⟩, a, ha, rfl⟩
    exact ⟨insert a s, ⟨s, hs, a, mem_compl.1 ha, rfl⟩, compl_insert⟩
#align finset.up_shadow_image_compl Finset.upShadow_image_compl

end UpShadow

end Finset


/-
Copyright (c) 2021 Gabriel Moise. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Moise, Yaël Dillies, Kyle Miller
-/
import combinatorics.simple_graph.basic
import data.matrix.basic

/-!
# Incidence matrix of a simple graph

This file defines the unoriented incidence matrix of a simple graph.

## Main definitions

* `simple_graph.inc_matrix`: `G.inc_matrix R` is the incidence matrix of `G` over the ring `R`.

## Main results

* `simple_graph.inc_matrix_mul_transpose_diag`: The diagonal entries of the product of
  `G.inc_matrix R` and its transpose are the degrees of the vertices.
* `simple_graph.inc_matrix_mul_transpose`: Gives a complete description of the product of
  `G.inc_matrix R` and its transpose; the diagonal is the degrees of each vertex, and the
  off-diagonals are 1 or 0 depending on whether or not the vertices are adjacent.
* `simple_graph.inc_matrix_transpose_mul_diag`: The diagonal entries of the product of the
  transpose of `G.inc_matrix R` and `G.inc_matrix R` are `2` or `0` depending on whether or
  not the unordered pair is an edge of `G`.

## Implementation notes

The usual definition of an incidence matrix has one row per vertex and one column per edge.
However, this definition has columns indexed by all of `sym2 α`, where `α` is the vertex type.
This appears not to change the theory, and for simple graphs it has the nice effect that every
incidence matrix for each `simple_graph α` has the same type.

## TODO

* Define the oriented incidence matrices for oriented graphs.
* Define the graph Laplacian of a simple graph using the oriented incidence matrix from an
  arbitrary orientation of a simple graph.
-/

open finset matrix simple_graph sym2
open_locale big_operators matrix

namespace simple_graph
variables (R : Type*) {α : Type*} (G : simple_graph α)

/-- `G.inc_matrix R` is the `α × sym2 α` matrix whose `(a, e)`-entry is `1` if `e` is incident to
`a` and `0` otherwise. -/
noncomputable def inc_matrix [has_zero R] [has_one R] : matrix α (sym2 α) R :=
λ a, (G.incidence_set a).indicator 1

variables {R}

lemma inc_matrix_apply [has_zero R] [has_one R] {a : α} {e : sym2 α} :
  G.inc_matrix R a e = (G.incidence_set a).indicator 1 e := rfl

/-- Entries of the incidence matrix can be computed given additional decidable instances. -/
lemma inc_matrix_apply' [has_zero R] [has_one R] [decidable_eq α] [decidable_rel G.adj]
  {a : α} {e : sym2 α} :
  G.inc_matrix R a e = if e ∈ G.incidence_set a then 1 else 0 :=
by convert rfl

section mul_zero_one_class
variables [mul_zero_one_class R] {a b : α} {e : sym2 α}

lemma inc_matrix_apply_mul_inc_matrix_apply :
  G.inc_matrix R a e * G.inc_matrix R b e = (G.incidence_set a ∩ G.incidence_set b).indicator 1 e :=
begin
  classical,
  simp only [inc_matrix, set.indicator_apply, ←ite_and_mul_zero,
    pi.one_apply, mul_one, set.mem_inter_iff],
end

lemma inc_matrix_apply_mul_inc_matrix_apply_of_not_adj (hab : a ≠ b) (h : ¬ G.adj a b) :
  G.inc_matrix R a e * G.inc_matrix R b e = 0 :=
begin
  rw [inc_matrix_apply_mul_inc_matrix_apply, set.indicator_of_not_mem],
  rw [G.incidence_set_inter_incidence_set_of_not_adj h hab],
  exact set.not_mem_empty e,
end

lemma inc_matrix_of_not_mem_incidence_set (h : e ∉ G.incidence_set a) :
  G.inc_matrix R a e = 0 :=
by rw [inc_matrix_apply, set.indicator_of_not_mem h]

lemma inc_matrix_of_mem_incidence_set (h : e ∈ G.incidence_set a) : G.inc_matrix R a e = 1 :=
by rw [inc_matrix_apply, set.indicator_of_mem h, pi.one_apply]

variables [nontrivial R]

lemma inc_matrix_apply_eq_zero_iff : G.inc_matrix R a e = 0 ↔ e ∉ G.incidence_set a :=
begin
  simp only [inc_matrix_apply, set.indicator_apply_eq_zero, pi.one_apply, one_ne_zero],
  exact iff.rfl,
end

lemma inc_matrix_apply_eq_one_iff : G.inc_matrix R a e = 1 ↔ e ∈ G.incidence_set a :=
by { convert one_ne_zero.ite_eq_left_iff, apply_instance }

end mul_zero_one_class

section non_assoc_semiring
variables [fintype α] [non_assoc_semiring R] {a b : α} {e : sym2 α}

lemma sum_inc_matrix_apply [decidable_eq α] [decidable_rel G.adj] :
  ∑ e, G.inc_matrix R a e = G.degree a :=
by simp [inc_matrix_apply', sum_boole, set.filter_mem_univ_eq_to_finset]

lemma inc_matrix_mul_transpose_diag [decidable_eq α] [decidable_rel G.adj] :
  (G.inc_matrix R ⬝ (G.inc_matrix R)ᵀ) a a = G.degree a :=
begin
  rw ←sum_inc_matrix_apply,
  simp [matrix.mul_apply, inc_matrix_apply', ←ite_and_mul_zero],
end

lemma sum_inc_matrix_apply_of_mem_edge_set : e ∈ G.edge_set → ∑ a, G.inc_matrix R a e = 2 :=
begin
  classical,
  refine e.ind _,
  intros a b h,
  rw mem_edge_set at h,
  rw [←nat.cast_two, ←card_doubleton h.ne],
  simp only [inc_matrix_apply', sum_boole, mk_mem_incidence_set_iff, h, true_and],
  congr' 2,
  ext e,
  simp only [mem_filter, mem_univ, true_and, mem_insert, mem_singleton],
end

lemma sum_inc_matrix_apply_of_not_mem_edge_set (h : e ∉ G.edge_set) : ∑ a, G.inc_matrix R a e = 0 :=
sum_eq_zero $ λ a _, G.inc_matrix_of_not_mem_incidence_set $ λ he, h he.1

lemma inc_matrix_transpose_mul_diag [decidable_rel G.adj] :
  ((G.inc_matrix R)ᵀ ⬝ G.inc_matrix R) e e = if e ∈ G.edge_set then 2 else 0 :=
begin
  classical,
  simp only [matrix.mul_apply, inc_matrix_apply', transpose_apply, ←ite_and_mul_zero,
    one_mul, sum_boole, and_self],
  split_ifs with h,
  { revert h,
    refine e.ind _,
    intros v w h,
    rw [←nat.cast_two, ←card_doubleton (G.ne_of_adj h)],
    simp [mk_mem_incidence_set_iff, G.mem_edge_set.mp h],
    congr' 2,
    ext u,
    simp, },
  { revert h,
    refine e.ind _,
    intros v w h,
    simp [mk_mem_incidence_set_iff, G.mem_edge_set.not.mp h], },
end

end non_assoc_semiring

section semiring
variables [fintype (sym2 α)] [semiring R] {a b : α} {e : sym2 α}

lemma inc_matrix_mul_transpose_apply_of_adj (h : G.adj a b) :
  (G.inc_matrix R ⬝ (G.inc_matrix R)ᵀ) a b = (1 : R) :=
begin
  classical,
  simp_rw [matrix.mul_apply, matrix.transpose_apply, inc_matrix_apply_mul_inc_matrix_apply,
    set.indicator_apply, pi.one_apply, sum_boole],
  convert nat.cast_one,
  convert card_singleton ⟦(a, b)⟧,
  rw [←coe_eq_singleton, coe_filter_univ],
  exact G.incidence_set_inter_incidence_set_of_adj h,
end

lemma inc_matrix_mul_transpose [fintype α] [decidable_eq α] [decidable_rel G.adj] :
  G.inc_matrix R ⬝ (G.inc_matrix R)ᵀ = λ a b,
    if a = b then G.degree a else if G.adj a b then 1 else 0 :=
begin
  ext a b,
  split_ifs with h h',
  { subst b,
    convert G.inc_matrix_mul_transpose_diag },
  { exact G.inc_matrix_mul_transpose_apply_of_adj h' },
  { simp only [matrix.mul_apply, matrix.transpose_apply,
    G.inc_matrix_apply_mul_inc_matrix_apply_of_not_adj h h', sum_const_zero] }
end

end semiring
end simple_graph


import MyNat.Definition
import MyNat.Addition -- add_zero
import AdvancedAdditionWorld.Level1 -- succ_inj
namespace MyNat
open MyNat

/-!

# Advanced Addition World

## Level 5: `add_right_cancel`

The theorem `add_right_cancel` is the theorem that you can cancel on the right
when you're doing addition -- if `a + t = b + t` then `a = b`. After `intro h`
I'd recommend induction on `t`. Don't forget that `rw [add_zero] at h` can be used
to do rewriting of hypotheses rather than the goal.

## Theorem
On the set of natural numbers, addition has the right cancellation property.
In other words, if there are natural numbers `a, b` and `c` such that
` a + t = b + t ` then we have `a = b`.
-/
theorem add_right_cancel (a t b : MyNat) : a + t = b + t → a = b := by
  intro h
  induction t with
  | zero =>
    rw [zero_is_0] at h
    rw [add_zero] at h
    rw [add_zero] at h
    exact h
  | succ d ih =>
    apply ih
    rw [add_succ] at h
    rw [add_succ] at h
    exact succ_inj h

/-!
Next up [Level 6](./Level6.lean.md)
-/


-- some definitions before Q3a

theorem three_not_zero : (3:ℕ) ≠ 0 := by norm_num
theorem two_not_zero : (2:ℕ) ≠ 0 := by norm_num

theorem pow_pos_of_pos (x : fake_reals) (n : ℕ) : (0 < x) → (0 < n) → 0 < x^n :=
begin
intros Hx_pos Hn_pos,
cases n with m,
  revert Hn_pos,norm_num,
clear Hn_pos,
induction m with p Hp,
  simp [Hx_pos,monoid.pow],
exact A4 Hx_pos Hp,
end

theorem pow_lt_of_lt (x y : fake_reals) (n : ℕ) : (0 < x) → (x < y) → (0 < n) → x ^ n < y^n :=
begin
intros Hx_pos Hx_lt_y Hn_pos,
cases n with m,
  exfalso, revert Hn_pos,norm_num,
induction m with p Hp,
  simp [Hx_lt_y,monoid.pow],
have H : x^ nat.succ p < y^nat.succ p := Hp (nat.zero_lt_succ p),
clear Hp Hn_pos,
change x ^ nat.succ (nat.succ p) with x * (x^nat.succ p),
change y ^ nat.succ (nat.succ p) with y * (y^nat.succ p),

have H1: x * (x ^ nat.succ p) < y * (x ^ nat.succ p) := calc
x * (x ^ nat.succ p) = (x ^ nat.succ p) * x : by rw [mul_comm]
... < (x ^ nat.succ p) * y : mul_pos_lt_of_lt Hx_lt_y (pow_pos_of_pos x (nat.succ p) Hx_pos (nat.zero_lt_succ p))
... = y * (x ^ nat.succ p) : by rw [mul_comm],

have H2 : y * (x ^ nat.succ p) < y * (y ^ nat.succ p) := mul_pos_lt_of_lt H (A2 Hx_pos Hx_lt_y),

exact A2 H1 H2
end

def n:ℕ := 1000000000000

def t3_stuff := A6 3000000000000 (by norm_num) ↑3 (n_pos 3 (three_not_zero))
def t2_stuff := A6 2000000000000 (by norm_num) ↑2 (n_pos 2 (two_not_zero))
noncomputable def t2 := classical.some t2_stuff
noncomputable def t3 := classical.some t3_stuff
def t2_facts := classical.some_spec t2_stuff
def t3_facts := classical.some_spec t3_stuff

theorem Q3a : t3 > t2 := sorry

-- I've done the next two parts with integers, on the basis that
-- inequality on the reals extends inequality on the integers.

-- ambiguous overload for power ^ symbol :-(
-- Could mean nat.pow or pow_nat.

-- Here's something that's in core lean for nat.pow
-- and we need for pow_nat.

theorem pow_lt_pow_of_lt {x i j : ℕ} : x > 1 → i < j → x^i < x^j :=
begin
rw [←nat.pow_eq_pow,←nat.pow_eq_pow],
intro H,
exact nat.pow_lt_pow_of_lt_right H,
end

theorem Q3b : 10000^100 < 100^10000 := sorry

theorem Q3ci : (2^11)^2 = 2^22 := sorry

theorem Q3cii : (2^(2^21))^2 = 2^(2^22) := sorry


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import set_theory.cardinal.basic

/-!
# Denumerability of ℚ

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file proves that ℚ is infinite, denumerable, and deduces that it has cardinality `omega`.
-/

namespace rat
open denumerable

instance : infinite ℚ :=
infinite.of_injective (coe : ℕ → ℚ) nat.cast_injective

private def denumerable_aux : ℚ ≃ { x : ℤ × ℕ // 0 < x.2 ∧ x.1.nat_abs.coprime x.2 } :=
{ to_fun := λ x, ⟨⟨x.1, x.2⟩, x.3, x.4⟩,
  inv_fun := λ x, ⟨x.1.1, x.1.2, x.2.1, x.2.2⟩,
  left_inv := λ ⟨_, _, _, _⟩, rfl,
  right_inv := λ ⟨⟨_, _⟩, _, _⟩, rfl }

/-- **Denumerability of the Rational Numbers** -/
instance : denumerable ℚ :=
begin
  let T := { x : ℤ × ℕ // 0 < x.2 ∧ x.1.nat_abs.coprime x.2 },
  letI : infinite T := infinite.of_injective _ denumerable_aux.injective,
  letI : encodable T := subtype.encodable,
  letI : denumerable T := of_encodable_of_infinite T,
  exact denumerable.of_equiv T denumerable_aux
end

end rat

open_locale cardinal

lemma cardinal.mk_rat : #ℚ = ℵ₀ := by simp


/-
Copyright (c) 2022 Matthias Uschold. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Matthias Uschold.
-/
import topology.continuous_function.bounded

/-!
# Some Lemma on boundedness

In this file, we prove that two notions of boundedness of functions (to ℝ)
are equivalent.

## Tags

boundedness, bounded function

-/

lemma function_bounded_classical
  {X: Type*}
  {f: X → ℝ}
  : (∃ (C:ℝ), ∀ (x y: X), dist (f x) (f y) ≤ C )  -- The Lean definition
  ↔ (∃ (C:ℝ), ∀ (x:X), abs (f x) ≤ C )           --classical
:= begin
  split,
  {
    assume hC,
    by_cases (is_empty X),
    {
      use 0,
      assume x,
      exfalso,
      exact is_empty_iff.mp h x,
    },
    --choose an element
    let x0 : X := classical.choice (not_is_empty_iff.mp h),
    rcases hC with ⟨C, hC⟩,
    use C + |f x0|,
    assume x :X,
    calc |f x| = |(f x - f x0) + f x0|
                  : by simp
           ... ≤  |f x - f x0| + |f x0|
                  : abs_add (f x - f x0) (f x0)
           ... = dist (f x) (f x0) + |f x0|
                  : by congr'; exact real.dist_eq (f x) (f x0)
           ... ≤ C + |f x0|
                  : by linarith only [hC x x0],
  },
  {
    assume h,
    rcases h with ⟨C, hC⟩,
    use 2*C,
    assume x y :X,
    calc  dist (f x) (f y)
         = |f x - f y|
          : by exact real.dist_eq _ _
    ... ≤ |f x| + |f y|
          : abs_sub (f x) (f y)
    ... ≤ C + C
          : by linarith only [hC x, hC y]
    ... = 2 * C
          : by ring,
  }
end

lemma function_bounded_classical'
  {X: Type*}
  [topological_space X]
  (f: bounded_continuous_function X ℝ)
  : ∃ (C:ℝ), ∀ (x:X), abs (f x) ≤ C
:= function_bounded_classical.mp f.bounded


import game.sup_inf.rat_complete

namespace xena --hide

/-
# Chapter 3 : Sup and Inf

## Level 14
-/

/-
The Least Upper Bound property implies
Greatest Lower bound Property
-/

-- begin hide
--NOTE: We have a form of the completeness axiom at Sup/Inf World
--level 13.
--Here I'll assume LUB property as an axiom, and prove it implies
--GLB property. But perhaps `axiom` should be avoided. -- GT
-- end hide

def is_bdd_above (S : set ℝ) := ∃ x : ℝ, is_upper_bound S x

def is_lower_bound (S : set ℝ) (x : ℝ) := ∀ s ∈ S, x ≤ s
def is_bdd_below (S : set ℝ) := ∃ x : ℝ, is_lower_bound S x
def is_glb (S : set ℝ) (x : ℝ) := is_lower_bound S x ∧
∀ y : ℝ, is_lower_bound S y → y ≤ x
def has_glb (S : set ℝ) := ∃ x : ℝ, is_glb S x

/-
Completeness Axiom
-/

axiom lub_property_reals (S : set ℝ) :
(S.nonempty ∧ is_bdd_above S) → (has_lub S)

/- Lemma
LUB property implies GLB property
-/

theorem glb_property_reals (S: set ℝ) :
(S.nonempty ∧ is_bdd_below S) → has_glb S :=

begin
intro hyp,

--define set L of lower bounds of S
let L := { x : ℝ | is_lower_bound S x},

--anything in S is an upper bound of L
have fact1: ∀ x ∈ S, is_upper_bound L x,
intros x hypx b hypb,
exact hypb x hypx,            -- `suggest` provided this line

--hyp.left is the claim that S is nonempty. use this to show
--that L is bounded above
cases hyp.left with y hypy,
have fact2: is_bdd_above L, use y, exact fact1 y hypy,

-- can now show that L has supremum `a`. Note direct use of hyp.right
-- (S is bounded below) as proof that L is nonempty
have fact3:= lub_property_reals L (and.intro hyp.right fact2),
cases fact3 with a hypa,

-- we now show that a is the infimum of S

use a,
split,
    -- first prove that a is a lower bound for S,
    {
    assume z hypz,
    -- given z ∈ S, we prove by contradiction that a ≤ z,
    by_contradiction claim,
    push_neg at claim,
    unfold is_lub at hypa,
    -- hypa.right says that for any upper bound y of L, a ≤ y
    let for_contra := hypa.right z (fact1 z hypz),
    -- linarith solves our goal - claim and for_contra are contradictory.
    linarith,
    },

    -- now prove that for any lower bound x of S, x ≤ a
    {
    intros x hypx,
    have fact: x ∈ L, exact hypx,
    -- hypa.left says that a is an upper bound of L
    exact hypa.left x hypx,
    }

end

end xena -- hide


import algebra.group.basic
import tactic
import group_theory.subgroup.basic
import data.set_like.basic
import chapter2.set_theory_cosets

variables {A:Type} [semigroup A]
--if I try to use these proofs on something that is not a semigroup, what would happen?
lemma lcoset_lcoset (S: set A) (a b : A) : lcoset (A) (b) (lcoset (A) (a) (S)) = lcoset (A) (b*a) (S) :=
begin
unfold lcoset,
ext x,
simp,
split,
{intro hx, cases hx with s hs_1, cases hs_1 with hs_1 hs_2,
use s, split, exact hs_1, rw mul_assoc, exact hs_2,},
{intro hx, cases hx with s hs_1, cases hs_1 with hs_1 hs_2,
use s, split, exact hs_1, rw mul_assoc at hs_2, exact hs_2,},
end

lemma rcoset_rcoset (S: set A) (a b : A) : rcoset (A) (rcoset (A) (S) (a)) (b) = rcoset (A) (S) (a*b) :=
begin
unfold rcoset,
ext x,
simp,
split,
{intro hx, cases hx with s hs_1, cases hs_1 with hs_1 hs_2,
use s, split, exact hs_1, rw mul_assoc at hs_2, exact hs_2,},
{intro hx, cases hx with s hs_1, cases hs_1 with hs_1 hs_2,
use s, split, exact hs_1, rw mul_assoc, exact hs_2,},
end

--#print rcoset_rcoset here is my answer to the above question! It knows variable A better be an instance of a semigroup

lemma lcoset_rcoset (S:set A) (a b : A) : rcoset (A) (lcoset (A) (a) (S)) (b) = lcoset (A) (a) (rcoset (A) (S) (b)) :=
begin
unfold lcoset,
unfold rcoset,
ext x, simp,
split,
{intro hx, cases hx with s hs_1, cases hs_1 with hs_1 hs_2,
use s, split, exact hs_1, rw mul_assoc at hs_2, exact hs_2,},
{intro hx, cases hx with s hs_1, cases hs_1 with hs_1 hs_2,
use s, split, exact hs_1, rw mul_assoc, exact hs_2,},
end


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/

import data.polynomial.hasse_deriv

/-!
# Taylor expansions of polynomials

## Main declarations

* `polynomial.taylor`: the Taylor expansion of the polynomial `f` at `r`
* `polynomial.taylor_coeff`: the `k`th coefficient of `taylor r f` is
  `(polynomial.hasse_deriv k f).eval r`
* `polynomial.eq_zero_of_hasse_deriv_eq_zero`:
  the identity principle: a polynomial is 0 iff all its Hasse derivatives are zero

-/

noncomputable theory

namespace polynomial

variables {R : Type*} [semiring R] (r : R) (f : polynomial R)

/-- The Taylor expansion of a polynomial `f` at `r`. -/
def taylor (r : R) : polynomial R →ₗ[R] polynomial R :=
{ to_fun := λ f, f.comp (X + C r),
  map_add' := λ f g, add_comp,
  map_smul' := λ c f, by simp only [smul_eq_C_mul, C_mul_comp, ring_hom.id_apply] }

lemma taylor_apply : taylor r f = f.comp (X + C r) := rfl

@[simp] lemma taylor_X : taylor r X = X + C r :=
by simp only [taylor_apply, X_comp]

@[simp] lemma taylor_C (x : R) : taylor r (C x) = C x :=
by simp only [taylor_apply, C_comp]

@[simp] lemma taylor_zero' : taylor (0 : R) = linear_map.id :=
begin
  ext,
  simp only [taylor_apply, add_zero, comp_X, _root_.map_zero, linear_map.id_comp, function.comp_app,
             linear_map.coe_comp]
end

lemma taylor_zero (f : polynomial R) : taylor 0 f = f :=
by rw [taylor_zero', linear_map.id_apply]

@[simp] lemma taylor_one : taylor r (1 : polynomial R) = C 1 :=
by rw [← C_1, taylor_C]

@[simp] lemma taylor_monomial (i : ℕ) (k : R) : taylor r (monomial i k) = C k * (X + C r) ^ i :=
by simp [taylor_apply]

/-- The `k`th coefficient of `polynomial.taylor r f` is `(polynomial.hasse_deriv k f).eval r`. -/
lemma taylor_coeff (n : ℕ) : (taylor r f).coeff n = (hasse_deriv n f).eval r :=
show (lcoeff R n).comp (taylor r) f = (leval r).comp (hasse_deriv n) f,
begin
  congr' 1, clear f, ext i,
  simp only [leval_apply, mul_one, one_mul, eval_monomial, linear_map.comp_apply, coeff_C_mul,
    hasse_deriv_monomial, taylor_apply, monomial_comp, C_1,
    (commute_X (C r)).add_pow i, linear_map.map_sum],
  simp only [lcoeff_apply, ← C_eq_nat_cast, mul_assoc, ← C_pow, ← C_mul, coeff_mul_C,
    (nat.cast_commute _ _).eq, coeff_X_pow, boole_mul, finset.sum_ite_eq, finset.mem_range],
  split_ifs with h, { refl },
  push_neg at h, rw [nat.choose_eq_zero_of_lt h, nat.cast_zero, mul_zero],
end

@[simp] lemma taylor_coeff_zero : (taylor r f).coeff 0 = f.eval r :=
by rw [taylor_coeff, hasse_deriv_zero, linear_map.id_apply]

@[simp] lemma taylor_coeff_one : (taylor r f).coeff 1 = f.derivative.eval r :=
by rw [taylor_coeff, hasse_deriv_one]

@[simp] lemma nat_degree_taylor (p : polynomial R) (r : R) :
  nat_degree (taylor r p) = nat_degree p :=
begin
  refine map_nat_degree_eq_nat_degree _ _,
  nontriviality R,
  intros n c c0,
  simp [taylor_monomial, nat_degree_C_mul_eq_of_mul_ne_zero, nat_degree_pow_X_add_C, c0]
end

@[simp] lemma taylor_mul {R} [comm_semiring R] (r : R) (p q : polynomial R) :
  taylor r (p * q) = taylor r p * taylor r q :=
by simp only [taylor_apply, mul_comp]

lemma taylor_taylor {R} [comm_semiring R] (f : polynomial R) (r s : R) :
  taylor r (taylor s f) = taylor (r + s) f :=
by simp only [taylor_apply, comp_assoc, map_add, add_comp, X_comp, C_comp, C_add, add_assoc]

lemma taylor_eval {R} [comm_semiring R] (r : R) (f : polynomial R) (s : R) :
  (taylor r f).eval s = f.eval (s + r) :=
by simp only [taylor_apply, eval_comp, eval_C, eval_X, eval_add]

lemma taylor_eval_sub {R} [comm_ring R] (r : R) (f : polynomial R) (s : R) :
  (taylor r f).eval (s - r) = f.eval s :=
by rw [taylor_eval, sub_add_cancel]

lemma taylor_injective {R} [comm_ring R] (r : R) : function.injective (taylor r) :=
begin
  intros f g h,
  apply_fun taylor (-r) at h,
  simpa only [taylor_apply, comp_assoc, add_comp, X_comp, C_comp, C_neg,
    neg_add_cancel_right, comp_X] using h,
end

/-- Taylor's formula. -/
lemma sum_taylor_eq {R} [comm_ring R] (f : polynomial R) (r : R) :
  (taylor r f).sum (λ i a, C a * (X - C r) ^ i) = f :=
by rw [←comp_eq_sum_left, sub_eq_add_neg, ←C_neg, ←taylor_apply, taylor_taylor, neg_add_self,
       taylor_zero]

end polynomial


/-
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 linear_algebra.finite_dimensional -- finite-dimensional vector spaces

/-!

# Finite-dimensional vector spaces

Here's how you say "let `k` be a field and let `V` be a finite-dimensional `k`-vector space"

-/

-- let k be a field and let V be a k-vector space
variables (k : Type) [field k] (V : Type) [add_comm_group V] [module k V] [finite_dimensional k V]

/-

There are two concepts of "dimension" in Lean. There's a general `module.rank k V`, which
returns a `cardinal` (so in particular the answer could be one of many kinds of infinity)
and, in the finite-dimensional case, there is `finite_dimensional.finrank k V`, which returns
a natural number. Note that, as is idiomatic in Lean, the latter function will accept
an infinite-dimensional space as input (garbage in) and will return 0 for the answer
(garbage out). All our spaces will be finite-dimensional, so we can use
`finite_dimensional.finrank`. Note that if we `open finite_dimensional` then we can
just call it `finrank`.

# An example sheet question

A 2019 University of Edinburgh example sheet question: prove that if `V` is a 9-dimensional
vector space and `A, B` are two subspaces of dimension 5, then `A ∩ B` cannot be
the zero vector space. See below the question for the API you'll need.

-/

open finite_dimensional

example (A B : subspace k V) (hV : finrank k V = 9) (hA : finrank k A = 5) (hB : finrank k B = 5) :
  A ⊓ B ≠ ⊥ :=
begin
  sorry,
end

/-

Here's some API which you will need for this question. Note that if `A : subspace k V` then
`A` is a term, not a type, and in particular it's not a vector space (it's a vector subspace).
However `↥A`, a "coercion to type", is a type, and hence has a dimension.

## Some API for finite-dimensional vector spaces

This should be all you need.

`submodule.dim_sup_add_dim_inf_eq A B : finrank k ↥(A ⊔ B) + finrank k ↥(A ⊓ B) = finrank k ↥A + finrank k ↥B`
`submodule.finrank_le A : finrank k ↥A ≤ finrank k V`
`finrank_bot k V : finrank K ↥⊥ = 0`

-/


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa

! This file was ported from Lean 3 source module algebra.hom.embedding
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Defs
import Mathlib.Logic.Embedding.Basic

/-!
# The embedding of a cancellative semigroup into itself by multiplication by a fixed element.
-/

variable {R : Type _}

section LeftOrRightCancelSemigroup

/-- The embedding of a left cancellative semigroup into itself
by left multiplication by a fixed element.
 -/
@[to_additive (attr := simps)
      "The embedding of a left cancellative additive semigroup into itself
         by left translation by a fixed element." ]
def mulLeftEmbedding {G : Type _} [LeftCancelSemigroup G] (g : G) : G ↪ G where
  toFun h := g * h
  inj' := mul_right_injective g
#align mul_left_embedding mulLeftEmbedding
#align add_left_embedding addLeftEmbedding
#align add_left_embedding_apply addLeftEmbedding_apply
#align mul_left_embedding_apply mulLeftEmbedding_apply

/-- The embedding of a right cancellative semigroup into itself
by right multiplication by a fixed element.
 -/
@[to_additive (attr := simps)
      "The embedding of a right cancellative additive semigroup into itself
         by right translation by a fixed element."]
def mulRightEmbedding {G : Type _} [RightCancelSemigroup G] (g : G) : G ↪ G where
  toFun h := h * g
  inj' := mul_left_injective g
#align mul_right_embedding mulRightEmbedding
#align add_right_embedding addRightEmbedding
#align mul_right_embedding_apply mulRightEmbedding_apply
#align add_right_embedding_apply addRightEmbedding_apply

@[to_additive]
theorem mul_left_embedding_eq_mul_right_embedding {G : Type _} [CancelCommMonoid G] (g : G) :
    mulLeftEmbedding g = mulRightEmbedding g := by
  ext
  exact mul_comm _ _
#align mul_left_embedding_eq_mul_right_embedding mul_left_embedding_eq_mul_right_embedding
#align add_left_embedding_eq_add_right_embedding add_left_embedding_eq_add_right_embedding

end LeftOrRightCancelSemigroup


import .love05_inductive_predicates_demo
import .love13_rational_and_real_numbers_demo

/- # LoVe Exercise 13: Rational and Real Numbers -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: Rationals

1.1. Prove the following lemma.

Hint: The lemma `fraction.mk.inj_eq` might be useful. -/

#check fraction.mk.inj_eq

lemma fraction.ext (a b : fraction) (hnum : fraction.num a = fraction.num b)
    (hdenom : fraction.denom a = fraction.denom b) :
  a = b :=
sorry

/- 1.2. Extending the `fraction.has_mul` instance from the lecture, declare
`fraction` as an instance of `semigroup`.

Hint: Use the lemma `fraction.ext` above, and possibly `fraction.mul_num`, and
`fraction.mul_denom`. -/

#check fraction.ext
#check fraction.mul_num
#check fraction.mul_denom

@[instance] def fraction.semigroup : semigroup fraction :=
{ mul_assoc :=
    sorry,
  ..fraction.has_mul }

/- 1.3. Extending the `rat.has_mul` instance from the lecture, declare `rat` as
an instance of `semigroup`. -/

@[instance] def rat.semigroup : semigroup rat :=
{ mul_assoc :=
    sorry,
  ..rat.has_mul }

end LoVe


import tactic

-- injective and surjective functions are already in Lean.
-- They are called `function.injective` and `function.surjective`.
-- It gets a bit boring typing `function.` a lot so we start
-- by opening the `function` namespace

open function

-- We now move into the `xena` namespace

namespace xena

-- let X, Y, Z be "types", i.e. sets, and let `f : X → Y` and `g : Y → Z`
-- be functions

variables {X Y Z : Type} {f : X → Y} {g : Y → Z}

-- let a,b,x be elements of X, let y be an element of Y and let z be an
-- element of Z

variables (a b x : X) (y : Y) (z : Z)

/-!
# Injective functions
-/

-- let's start by checking the definition of injective is
-- what we think it is.

lemma injective_def : injective f ↔ ∀ a b : X, f a = f b → a = b :=
begin
  -- true by definition
  refl
end

-- You can now `rw injective_def` to change `injective f` into its definition.

-- The identity function id : X → X is defined by id(x) = x. Let's check this

lemma id_def : id x = x :=
begin
  -- true by definition
  refl
end

-- you can now `rw id_def` to change `id x` into `x`

/-- The identity function is injective -/
lemma injective_id : injective (id : X → X) :=
begin
  intros a b h,
  exact h,
end

-- function composition g ∘ f is satisfies (g ∘ f) (x) = g(f(x)). This
-- is true by definition. Let's check this

lemma comp_def : (g ∘ f) x = g (f x) :=
begin
  -- true by definition
  refl
end

/-- Composite of two injective functions is injective -/
lemma injective_comp (hf : injective f) (hg : injective g) : injective (g ∘ f) :=
begin
  -- you could start with `rw injective_def at *` if you like.
  -- In some sense it doesn't do anything, but it might make you happier.
  intros a b h,
  apply hf,
  apply hg,
  exact h,
end

/-!

### Surjective functions

-/

-- Let's start by checking the definition of surjectivity is what we think it is

lemma surjective_def : surjective f ↔ ∀ y : Y, ∃ x : X, f x = y :=
begin
  -- true by definition
  refl
end

/-- The identity function is surjective -/
lemma surjective_id : surjective (id : X → X) :=
begin
  -- you can start with `rw surjective_def` if you like.
  intro b,
  use b,
  refl,
end

-- If you started with `rw surjective_def` -- try deleting it.
-- Probably your proof still works! This is because
-- `surjective_def` is true *by definition*. The proof is `refl`.

-- For this next one, the `have` tactic is helpful.

/-- Composite of two surjective functions is surjective -/
lemma surjective_comp (hf : surjective f) (hg : surjective g) : surjective (g ∘ f) :=
begin
  intro c,
  obtain ⟨b,h⟩ := hg c,
  obtain ⟨a,h'⟩ := hf b,
  use a,
  dsimp,
  rwa [h'],
end

/-!

### Bijective functions

In Lean a function is defined to be bijective if it is injective and surjective.
Let's check this.

-/

lemma bijective_def : bijective f ↔ injective f ∧ surjective f :=
begin
  -- true by definition
  refl
end

-- You can now use the lemmas you've proved already to make these
-- proofs very short.

/-- The identity function is bijective. -/
lemma bijective_id : bijective (id : X → X) :=
begin
  exact ⟨injective_id, surjective_id⟩,
end

/-- A composite of bijective functions is bijective. -/
lemma bijective_comp (hf : bijective f) (hg : bijective g) : bijective (g ∘ f) :=
begin
  refine ⟨injective_comp _ _, surjective_comp _ _⟩,
  exact hf.left,
  exact hg.left,
  exact hf.right,
  exact hg.right,
end

end xena


import Sets.Basic

open Set

variable (α β : Type)
variable (X Y Z : Set α)
variable (W : Set β)

theorem problem1 : ∅ ∈ 𝒫  X := sorry

theorem problem2 (U : β → Set α) : ∀ b, U b ⊆ BigUnion U := sorry

theorem problem3 (h : X ⊆ Y) : (X ×ˢ W) ⊆ (Y ×ˢ W) := sorry

theorem problem4 (h : Y ∩ Z = ∅) : Yᶜ ∪ Zᶜ = Univ := sorry

theorem problem5 : (X \ Y) ∪ (Y \ X) = (X ∪ Y) \ (X ∩ Y) := sorry


import MyNat.Definition
import MyNat.Addition -- add_zero
import MyNat.Inequality -- le_iff_exists_add
import Mathlib.Tactic.Use -- use tactic
import InequalityWorld.Level15 -- lt_aux₁
import InequalityWorld.Level16 -- lt_aux₂
import AdvancedAdditionWorld.Level13 -- ne_succ_self
namespace MyNat
open MyNat
/-!

# Inequality world.

## Level 17: definition of `<`

OK so we are going to *define* `a < b` by `a ≤ b ∧ ¬ (b ≤ a)`,
and given `lt_aux_one a b` and `lt_aux_two a b` it should now just
be a few lines to prove `a < b ↔ succ a ≤ b`.

## Lemma : lt_iff_succ_le
For all naturals `a` and `b`, `a<b ↔ succ a ≤ b.`
-/
lemma lt_iff_succ_le (a b : MyNat) : a < b ↔ succ a ≤ b := by
  constructor
  exact lt_aux₁ a b
  exact lt_aux₂ a b

/-!
Sadly that is the end of all our nicely documented levels in this tutorial!

Interested in playing levels involving other kinds of mathematics?
Look here for more ideas about what to do next.

Interested in learning more? Join us on the
Zulip Lean chat
and ask questions in the `#new members` stream. Real names preferred. Be nice.
-/

/-!
If you want to see a whole bunch of great examples see [Level 18](./Level18.lean.md)
-/


import data.nat
open nat

theorem mul_mod_eq_mod_mul_mod (m n k : nat) : (m * n) mod k = ((m mod k) * n) mod k :=
by_cases_zero_pos k
  (by rewrite [*mod_zero])
  (take k, assume H : k > 0,
    (calc
      (m * n) mod k = (((m div k) * k + m mod k) * n) mod k : eq_div_mul_add_mod
            ... = ((m mod k) * n) mod k                     :
                    by rewrite [mul.right_distrib, mul.right_comm, add.comm, add_mul_mod_self H]))

theorem eq_zero_or_eq_one_of_lt_two : ∀ {n : nat}, n < 2 → n = 0 ∨ n = 1 := dec_trivial

definition even (n : nat) : Prop := n mod 2 = 0

definition odd (n : nat) : Prop := n mod 2 = 1

theorem even_or_odd (n : nat) : even n ∨ odd n := eq_zero_or_eq_one_of_lt_two (mod_lt dec_trivial)

theorem even_of_exists_eq_two_mul {n : nat} (H : ∃ m, n = 2 * m) : even n :=
obtain m (H1 : n = 2 * m), from H,
calc
  n mod 2 = 2*m mod 2 : H1
      ... = 0         : mul_mod_right

theorem exists_eq_two_mul_of_even {n : nat} (H : even n) : ∃ m, n = 2 * m :=
exists.intro (n div 2)
  (calc
    n     = (n div 2) * 2 + n mod 2 : eq_div_mul_add_mod
      ... = 2*(n div 2)             : by rewrite [↑even at H, H, add_zero, mul.comm])

theorem even_of_even_square {n : nat} (H : even (n * n)) : even n :=
or.elim (even_or_odd n) (assume H, H)
  (assume H1 : n mod 2 = 1,
    have H2 : 0 = 1, from calc
      0     = n * n mod 2           : H
        ... = ((n mod 2) * n) mod 2 : mul_mod_eq_mod_mul_mod
        ... = 1                     : by rewrite [H1, one_mul, H1],
    absurd H2 dec_trivial)

theorem sqrt2_irrational (m : nat) : ∀ n : nat, n * n = 2 * m * m → m = 0 :=
nat.strong_induction_on m
  (take m,
    by_cases_zero_pos m (λ IH n H, rfl)
      (take m,
        assume (mpos : m > 0),
        assume IH : ∀ {m'}, m' < m → (∀ {n}, n * n = 2 * m' * m' → m' = 0),
        take n,
        assume H : n * n = 2 * m * m,
        have H1 : even (n * n),
          from even_of_exists_eq_two_mul (exists.intro _ (eq.subst !mul.assoc H)),
        have H2 : even n, from even_of_even_square H1,
        obtain k (H3 : n = 2 * k), from exists_eq_two_mul_of_even H2,
        have H4 : 2 * (m * m) = 2 * (2 * k * k),
          by rewrite [-mul.assoc, -H, H3, *mul.assoc, mul.left_comm k],
        assert H5 : m * m = 2 * k * k, from !eq_of_mul_eq_mul_left dec_trivial H4,
        have H6 : k < m, from
          lt_of_not_le
            (assume H' : k ≥ m,
              have H1' : k > 0, from lt_of_lt_of_le mpos H',
              have H2' : k * k ≥ m * m, from mul_le_mul H' H',
              assert H3' : 2 * (k * k) > 1 * (m * m),
                from mul_lt_mul_of_lt_of_le (mul_pos H1' H1') dec_trivial H2',
              have H4' : 2 * k * k > 2 * k * k,
                by revert H3'; rewrite [H5, one_mul, mul.assoc]; intros; assumption,
              absurd H4' !lt.irrefl),
        assert H7 : k = 0, from IH H6 H5,
        have H8 : m * m = 0, by rewrite [H5, H7, mul_zero],
        show m = 0, from iff.mp !or_self (eq_zero_or_eq_zero_of_mul_eq_zero H8)))


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
-/
import algebra.abs
import algebra.order.group.order_iso
import order.min_max

/-!
# Absolute values in ordered groups.

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
-/

variables {α : Type*}
open function

section covariant_add_le

section has_neg

/-- `abs a` is the absolute value of `a`. -/
@[to_additive "`abs a` is the absolute value of `a`",
  priority 100] -- see Note [lower instance priority]
instance has_inv.to_has_abs [has_inv α] [has_sup α] : has_abs α := ⟨λ a, a ⊔ a⁻¹⟩

@[to_additive] lemma abs_eq_sup_inv [has_inv α] [has_sup α] (a : α) : |a| = a ⊔ a⁻¹ := rfl

variables [has_neg α] [linear_order α] {a b: α}

lemma abs_eq_max_neg : abs a = max a (-a) :=
rfl

lemma abs_choice (x : α) : |x| = x ∨ |x| = -x := max_choice _ _

lemma abs_le' : |a| ≤ b ↔ a ≤ b ∧ -a ≤ b := max_le_iff

lemma le_abs : a ≤ |b| ↔ a ≤ b ∨ a ≤ -b := le_max_iff

lemma le_abs_self (a : α) : a ≤ |a| := le_max_left _ _

lemma neg_le_abs_self (a : α) : -a ≤ |a| := le_max_right _ _

lemma lt_abs : a < |b| ↔ a < b ∨ a < -b := lt_max_iff

theorem abs_le_abs (h₀ : a ≤ b) (h₁ : -a ≤ b) : |a| ≤ |b| :=
(abs_le'.2 ⟨h₀, h₁⟩).trans (le_abs_self b)

lemma abs_by_cases (P : α → Prop) {a : α} (h1 : P a) (h2 : P (-a)) : P (|a|) :=
sup_ind _ _ h1 h2

end has_neg

section add_group
variables [add_group α] [linear_order α]

@[simp] lemma abs_neg (a : α) : | -a| = |a| :=
begin
  rw [abs_eq_max_neg, max_comm, neg_neg, abs_eq_max_neg]
end

lemma eq_or_eq_neg_of_abs_eq {a b : α} (h : |a| = b) : a = b ∨ a = -b :=
by simpa only [← h, eq_comm, neg_eq_iff_eq_neg] using abs_choice a

lemma abs_eq_abs {a b : α} : |a| = |b| ↔ a = b ∨ a = -b :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { obtain rfl | rfl := eq_or_eq_neg_of_abs_eq h;
    simpa only [neg_eq_iff_eq_neg, neg_inj, or.comm] using abs_choice b },
  { cases h; simp only [h, abs_neg] },
end

lemma abs_sub_comm (a b : α) : |a - b| = |b - a| :=
calc  |a - b| = | - (b - a)| : congr_arg _ (neg_sub b a).symm
          ... = |b - a|      : abs_neg (b - a)

variables [covariant_class α α (+) (≤)] {a b c : α}

lemma abs_of_nonneg (h : 0 ≤ a) : |a| = a :=
max_eq_left $ (neg_nonpos.2 h).trans h

lemma abs_of_pos (h : 0 < a) : |a| = a :=
abs_of_nonneg h.le

lemma abs_of_nonpos (h : a ≤ 0) : |a| = -a :=
max_eq_right $ h.trans (neg_nonneg.2 h)

lemma abs_of_neg (h : a < 0) : |a| = -a :=
abs_of_nonpos h.le

lemma abs_le_abs_of_nonneg (ha : 0 ≤ a) (hab : a ≤ b) : |a| ≤ |b| :=
by rwa [abs_of_nonneg ha, abs_of_nonneg (ha.trans hab)]

@[simp] lemma abs_zero : |0| = (0:α) :=
abs_of_nonneg le_rfl

@[simp] lemma abs_pos : 0 < |a| ↔ a ≠ 0 :=
begin
  rcases lt_trichotomy a 0 with (ha|rfl|ha),
  { simp [abs_of_neg ha, neg_pos, ha.ne, ha] },
  { simp },
  { simp [abs_of_pos ha, ha, ha.ne.symm] }
end

lemma abs_pos_of_pos (h : 0 < a) : 0 < |a| := abs_pos.2 h.ne.symm

lemma abs_pos_of_neg (h : a < 0) : 0 < |a| := abs_pos.2 h.ne

lemma neg_abs_le_self (a : α) : -|a| ≤ a :=
begin
  cases le_total 0 a with h h,
  { calc -|a| = - a   : congr_arg (has_neg.neg) (abs_of_nonneg h)
            ... ≤ 0     : neg_nonpos.mpr h
            ... ≤ a     : h },
  { calc -|a| = - - a : congr_arg (has_neg.neg) (abs_of_nonpos h)
            ... ≤ a     : (neg_neg a).le }
end

lemma add_abs_nonneg (a : α) : 0 ≤ a + |a| :=
begin
  rw ←add_right_neg a,
  apply add_le_add_left,
  exact (neg_le_abs_self a),
end

lemma neg_abs_le_neg (a : α) : -|a| ≤ -a :=
by simpa using neg_abs_le_self (-a)

@[simp] lemma abs_nonneg (a : α) : 0 ≤ |a| :=
(le_total 0 a).elim (λ h, h.trans (le_abs_self a)) (λ h, (neg_nonneg.2 h).trans $ neg_le_abs_self a)

@[simp] lemma abs_abs (a : α) : | |a| | = |a| :=
abs_of_nonneg $ abs_nonneg a

@[simp] lemma abs_eq_zero : |a| = 0 ↔ a = 0 :=
decidable.not_iff_not.1 $ ne_comm.trans $ (abs_nonneg a).lt_iff_ne.symm.trans abs_pos

@[simp] lemma abs_nonpos_iff {a : α} : |a| ≤ 0 ↔ a = 0 :=
(abs_nonneg a).le_iff_eq.trans abs_eq_zero

variable [covariant_class α α (swap (+)) (≤)]

lemma abs_le_abs_of_nonpos (ha : a ≤ 0) (hab : b ≤ a) : |a| ≤ |b| :=
by { rw [abs_of_nonpos ha, abs_of_nonpos (hab.trans ha)], exact neg_le_neg_iff.mpr hab }

lemma abs_lt : |a| < b ↔ - b < a ∧ a < b :=
max_lt_iff.trans $ and.comm.trans $ by rw [neg_lt]

lemma neg_lt_of_abs_lt (h : |a| < b) : -b < a := (abs_lt.mp h).1

lemma lt_of_abs_lt (h : |a| < b) : a < b := (abs_lt.mp h).2

lemma max_sub_min_eq_abs' (a b : α) : max a b - min a b = |a - b| :=
begin
  cases le_total a b with ab ba,
  { rw [max_eq_right ab, min_eq_left ab, abs_of_nonpos, neg_sub], rwa sub_nonpos },
  { rw [max_eq_left ba, min_eq_right ba, abs_of_nonneg], rwa sub_nonneg }
end

lemma max_sub_min_eq_abs (a b : α) : max a b - min a b = |b - a| :=
by { rw abs_sub_comm, exact max_sub_min_eq_abs' _ _ }

end add_group

end covariant_add_le

section linear_ordered_add_comm_group

variables [linear_ordered_add_comm_group α] {a b c d : α}

lemma abs_le : |a| ≤ b ↔ - b ≤ a ∧ a ≤ b := by rw [abs_le', and.comm, neg_le]

lemma le_abs' : a ≤ |b| ↔ b ≤ -a ∨ a ≤ b := by rw [le_abs, or.comm, le_neg]

lemma neg_le_of_abs_le (h : |a| ≤ b) : -b ≤ a := (abs_le.mp h).1

lemma le_of_abs_le (h : |a| ≤ b) : a ≤ b := (abs_le.mp h).2

@[to_additive] lemma apply_abs_le_mul_of_one_le' {β : Type*} [mul_one_class β] [preorder β]
  [covariant_class β β (*) (≤)] [covariant_class β β (swap (*)) (≤)] {f : α → β} {a : α}
  (h₁ : 1 ≤ f a) (h₂ : 1 ≤ f (-a)) :
  f (|a|) ≤ f a * f (-a) :=
(le_total a 0).by_cases (λ ha, (abs_of_nonpos ha).symm ▸ le_mul_of_one_le_left' h₁)
  (λ ha, (abs_of_nonneg ha).symm ▸ le_mul_of_one_le_right' h₂)

@[to_additive] lemma apply_abs_le_mul_of_one_le {β : Type*} [mul_one_class β] [preorder β]
  [covariant_class β β (*) (≤)] [covariant_class β β (swap (*)) (≤)] {f : α → β}
  (h : ∀ x, 1 ≤ f x) (a : α) :
  f (|a|) ≤ f a * f (-a) :=
apply_abs_le_mul_of_one_le' (h _) (h _)

/--
The **triangle inequality** in `linear_ordered_add_comm_group`s.
-/
lemma abs_add (a b : α) : |a + b| ≤ |a| + |b| :=
abs_le.2 ⟨(neg_add (|a|) (|b|)).symm ▸
  add_le_add (neg_le.2 $ neg_le_abs_self _) (neg_le.2 $ neg_le_abs_self _),
  add_le_add (le_abs_self _) (le_abs_self _)⟩

lemma abs_add' (a b : α) : |a| ≤ |b| + |b + a| :=
by simpa using abs_add (-b) (b + a)

theorem abs_sub (a b : α) :
  |a - b| ≤ |a| + |b| :=
by { rw [sub_eq_add_neg, ←abs_neg b], exact abs_add a _ }

lemma abs_sub_le_iff : |a - b| ≤ c ↔ a - b ≤ c ∧ b - a ≤ c :=
by rw [abs_le, neg_le_sub_iff_le_add, sub_le_iff_le_add', and_comm, sub_le_iff_le_add']

lemma abs_sub_lt_iff : |a - b| < c ↔ a - b < c ∧ b - a < c :=
by rw [abs_lt, neg_lt_sub_iff_lt_add', sub_lt_iff_lt_add', and_comm, sub_lt_iff_lt_add']

lemma sub_le_of_abs_sub_le_left (h : |a - b| ≤ c) : b - c ≤ a :=
sub_le_comm.1 $ (abs_sub_le_iff.1 h).2

lemma sub_le_of_abs_sub_le_right (h : |a - b| ≤ c) : a - c ≤ b :=
sub_le_of_abs_sub_le_left (abs_sub_comm a b ▸ h)

lemma sub_lt_of_abs_sub_lt_left (h : |a - b| < c) : b - c < a :=
sub_lt_comm.1 $ (abs_sub_lt_iff.1 h).2

lemma sub_lt_of_abs_sub_lt_right (h : |a - b| < c) : a - c < b :=
sub_lt_of_abs_sub_lt_left (abs_sub_comm a b ▸ h)

lemma abs_sub_abs_le_abs_sub (a b : α) : |a| - |b| ≤ |a - b| :=
sub_le_iff_le_add.2 $
calc |a| = |a - b + b|     : by rw [sub_add_cancel]
       ... ≤ |a - b| + |b| : abs_add _ _

lemma abs_abs_sub_abs_le_abs_sub (a b : α) : | |a| - |b| | ≤ |a - b| :=
abs_sub_le_iff.2 ⟨abs_sub_abs_le_abs_sub _ _, by rw abs_sub_comm; apply abs_sub_abs_le_abs_sub⟩

lemma abs_eq (hb : 0 ≤ b) : |a| = b ↔ a = b ∨ a = -b :=
begin
  refine ⟨eq_or_eq_neg_of_abs_eq, _⟩,
  rintro (rfl|rfl); simp only [abs_neg, abs_of_nonneg hb]
end

lemma abs_le_max_abs_abs (hab : a ≤ b) (hbc : b ≤ c) : |b| ≤ max (|a|) (|c|) :=
abs_le'.2
  ⟨by simp [hbc.trans (le_abs_self c)],
   by simp [(neg_le_neg_iff.mpr hab).trans (neg_le_abs_self a)]⟩

lemma min_abs_abs_le_abs_max : min (|a|) (|b|) ≤ |max a b| :=
(le_total a b).elim
  (λ h, (min_le_right _ _).trans_eq $ congr_arg _ (max_eq_right h).symm)
  (λ h, (min_le_left _ _).trans_eq $ congr_arg _ (max_eq_left h).symm)

lemma min_abs_abs_le_abs_min : min (|a|) (|b|) ≤ |min a b| :=
(le_total a b).elim
  (λ h, (min_le_left _ _).trans_eq $ congr_arg _ (min_eq_left h).symm)
  (λ h, (min_le_right _ _).trans_eq $ congr_arg _ (min_eq_right h).symm)

lemma abs_max_le_max_abs_abs : |max a b| ≤ max (|a|) (|b|) :=
(le_total a b).elim
  (λ h, (congr_arg _ $ max_eq_right h).trans_le $ le_max_right _ _)
  (λ h, (congr_arg _ $ max_eq_left h).trans_le $ le_max_left _ _)

lemma abs_min_le_max_abs_abs : |min a b| ≤ max (|a|) (|b|) :=
(le_total a b).elim
  (λ h, (congr_arg _ $ min_eq_left h).trans_le $ le_max_left _ _)
  (λ h, (congr_arg _ $ min_eq_right h).trans_le $ le_max_right _ _)

lemma eq_of_abs_sub_eq_zero {a b : α} (h : |a - b| = 0) : a = b :=
sub_eq_zero.1 $ abs_eq_zero.1 h

lemma abs_sub_le (a b c : α) : |a - c| ≤ |a - b| + |b - c| :=
calc
    |a - c| = |a - b + (b - c)|     : by rw [sub_add_sub_cancel]
            ... ≤ |a - b| + |b - c| : abs_add _ _

lemma abs_add_three (a b c : α) : |a + b + c| ≤ |a| + |b| + |c| :=
(abs_add _ _).trans (add_le_add_right (abs_add _ _) _)

lemma dist_bdd_within_interval {a b lb ub : α} (hal : lb ≤ a) (hau : a ≤ ub)
      (hbl : lb ≤ b) (hbu : b ≤ ub) : |a - b| ≤ ub - lb :=
abs_sub_le_iff.2 ⟨sub_le_sub hau hbl, sub_le_sub hbu hal⟩

lemma eq_of_abs_sub_nonpos (h : |a - b| ≤ 0) : a = b :=
eq_of_abs_sub_eq_zero (le_antisymm h (abs_nonneg (a - b)))

end linear_ordered_add_comm_group