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

variables {A:Type} [group A]

lemma inv_lcoset_lcoset (a:A) (S:set A) : lcoset (A) (a⁻¹) (lcoset (A) (a) (S)) = S :=
begin
ext x,
unfold lcoset,
split,
{intro hx,
 simp at hx,
 exact hx, },
{intro hx,
 simp,
 exact hx,}
-- because the a⁻¹*a = 1 proof is part of the simp tactic for a Type that is an instance of a group the simp tactic is really all you need here. It makes sense.
end

lemma lcoset_inv_lcoset (a:A) (S:set A) : lcoset (A) (a) (lcoset (A) (a⁻¹) (S)) = S :=
begin
ext x,
unfold lcoset,
split,
{intro hx, simp at hx, exact hx,},
{intro hx, simp, exact hx,}
end

lemma inv_rcoset_rcoset (a:A) (S:set A) : rcoset (A) (rcoset (A) (S) (a)) (a⁻¹) = S :=
begin
ext x,
unfold rcoset,
split,
{intro hx, simp at hx, exact hx,},
{intro hx, simp, exact hx,}
end

lemma rcoset_inv_rcoset (a:A) (S:set A) : rcoset (A) (rcoset (A) (S) (a⁻¹)) (a) = S:=
begin
ext x,
unfold rcoset,
split,
{intro hx, simp at hx, exact hx,},
{intro hx, simp, exact hx,}
end

lemma eq_of_lcoset_eq_lcoset (a:A) (S T : set A) (hST : lcoset (A) (a) (S) = (lcoset (A) (a) (T))) : S = T :=
begin
have hS : lcoset (A) (a⁻¹) (lcoset (A) (a) (S)) = S,
exact inv_lcoset_lcoset a S,
rw hST at hS,
have hT : lcoset (A) (a⁻¹) (lcoset (A) (a) (T)) = T,
exact inv_lcoset_lcoset a T,
rw ← hS,
rw hT,
end

lemma eq_of_rcoset_eq_rcoset (a:A) (S T : set A) (hST : rcoset (A) (S) (a) = rcoset (A) (T) (a)) : S = T :=
begin
have hS : rcoset (A) (rcoset (A) (S) (a)) (a⁻¹) = S,
exact inv_rcoset_rcoset a S,
rw hST at hS,
have hT : rcoset (A) (rcoset (A) (T) (a)) (a⁻¹) = T,
exact inv_rcoset_rcoset a T,
rw hS at hT,
exact hT,
end

lemma mem_of_mul_mem_lcoset (a b : A) (S : set A) (Hab : a*b ∈ (lcoset (A) (a) (S))) : b ∈ S :=
begin
unfold lcoset at Hab,
--the simp takes care of the fact that a*b = a*c → b = c if  a b c : G and G is an instance of a group. Try proving this for a monoid if there is skepticism.
simp at Hab,
exact Hab,
end

lemma mul_mem_lcoset_iff (a b : A) (S: set A) : (a*b ∈ (lcoset (A) (a) (S)) ↔ b ∈ S) :=
begin
unfold lcoset,
split,
{intro ha, exact mem_of_mul_mem_lcoset a b S ha,},
{intro ha, simp, exact ha,} -- could use definition of appling a function over an input that is known to be in the set that is being mapped over. Instead the group instance is used to rewrite the goal.
end

lemma mem_of_mul_mem_rcoset (a b : A) (S : set A) (Hab : a * b ∈ rcoset (A) (S) (b)) : a ∈ S :=
begin
unfold rcoset at Hab,
simp at Hab,
exact Hab,
end

lemma mul_mem_rcoset_iff (a b : A) (S : set A) : (a * b ∈ rcoset (A) (S) (b) ↔ a ∈ S) :=
begin
unfold rcoset,
split,
{intro ha, exact mem_of_mul_mem_rcoset a b S ha,},
{intro ha, simp, exact ha,}
end

lemma mem_lcoset_of_inv_mul_mem {a b : A} {S : set A} (H: a⁻¹*b ∈ S) : b ∈ lcoset (A) (a) (S) :=
begin
unfold lcoset,
use (a⁻¹ * b), split, exact H, dsimp, --notice how this applies the lambda expression
--simp will essentially solve this entire proof for you. I'm just doing this somewhat explicitly to test my understanding.#check
simp,
end

lemma mem_lcoset_iff {a b : A} {S : set A} : a⁻¹*b ∈ S ↔ b ∈ lcoset (A) (a) (S) :=
begin
split,
{intro h1, exact mem_lcoset_of_inv_mul_mem h1,},
{intro h1, unfold lcoset at h1, cases h1 with c hc, cases hc with hc1 hc2, dsimp at hc2,
have h2 : a*a⁻¹*b = b, simp,
rw ← h2 at hc2, rw mul_assoc at hc2,
have h3: c = (a⁻¹*b) := mul_left_cancel hc2, rw h3 at hc1, exact hc1,} -- simp probably would have done a lot of the heavy lifting but I wanted to be explicit once.
end

lemma mem_rcoset_of_inv_mul_mem {a b : A} {S : set A} (H: b*a⁻¹ ∈ S) : b ∈ rcoset (A) (S) (a) :=
begin
unfold rcoset, simp, exact H, --here I did not do it explicitly. Damn lean is powerful...
end

lemma mem_rcoset_iff {a b : A} {S : set A} : b*a⁻¹ ∈ S ↔ b ∈ rcoset (A) (S) (a) :=
begin
split,
{intro h1, exact mem_rcoset_of_inv_mul_mem h1,},
{intro h1, unfold rcoset at h1, simp at h1, exact h1,} --like I said, simp will do a lot of heavy lifting!
end

lemma lcoset_eq_iff_eq_inv_lcoset {a:A} {S T : set A} : lcoset A a S = T ↔ lcoset A a⁻¹ T = S :=
begin
unfold lcoset, split,
{intro h1, rw ← h1, ext x, simp,}, --if it is not clear do dsimp first. The group structure simplifies a⁻¹*a*x = x for x, thereofore any x is in S,
{intro h1, rw ← h1, ext x, simp,}
end

lemma rcoset_eq_iff_eq_inv_rcoset {a:A} {S T : set A} : rcoset A S a = T ↔ rcoset A T a⁻¹ = S :=
begin
unfold rcoset, split,
{intro h1, rw ← h1, ext x, simp,},
{intro h1, rw ← h1, ext x, simp,}
end

lemma lcoset_inter (a:A) (S T : subgroup A) : lcoset (A) (a) (S ∩ T) = lcoset (A) (a) (S) ∩ lcoset (A) (a) (T) :=
begin
unfold lcoset,
ext x, split,
{intro hx, simp at hx, simp, exact hx,},
{intro hx, simp at hx ⊢, exact hx,} -- the definition of intersection gets us pretty far here.
end

--also convenient that lcoset can take subgroup as an input because it is ultimately a set with additionally properties
lemma rcoset_inter (a:A) (S T : subgroup A) : rcoset (A) (S ∩ T) (a) = rcoset (A) (S) (a) ∩ rcoset (A) (T) (a) :=
begin
unfold rcoset, ext x, split,
{intro hx, simp at hx ⊢, exact hx,},
{intro hx, simp at hx ⊢, exact hx,}
end


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

import tactic
import data.real.basic

/-
# Límites de secuencias en Lean
Escribimos la definicón `ε` - `N` del límite de una secuencia de
números reales y demostramos resultados sobre límites.

NOTA: adaptado de los cursos de formalización de Kevin Buzzard.
-/

/- ### Notación lambda (λ) para funciones
Recordatorio: para representar una función `f` en Lean, utilizamos notación lambda:
`λ x, f x` es la función que asigna a `x` el valor `f (x)`. -/

def f : ℕ → ℝ := λ n, n^2 + 3 -- `f(n) = n^2 + 3`

example : f 3 = 12 :=
begin
  rw f,
  dsimp only, -- Para simplificar la aplicación de funciones
  norm_num, -- Normaliza expresiones numéricas
end

/-
## Límite de una secuencia
-/

/-- Si `a(n)` es una secuencia de números reales y `L` es un real,
 `tends_to a L` dice que el límite de `a(n)` cuando `n → ∞` es `L`. -/
def tends_to (a : ℕ → ℝ) (L : ℝ) : Prop :=
∀ ε > 0, ∃ N : ℕ, ∀ n, N ≤ n → |a n - L| < ε

/-- Este lema nos permite reescribir la definición de `tends_to` en nuestras pruebas. -/
theorem tends_to_def {a : ℕ → ℝ} {t : ℝ} :
  tends_to a t ↔ ∀ ε, 0 < ε → ∃ B : ℕ, ∀ n, B ≤ n → |a n - t| < ε :=
begin
  refl
end

/-
## Ejercicios
-/

/-- El límite de la secuencia constante con valor `c` es `c`. -/
theorem tends_to_const (c : ℝ) : tends_to (λ n, c) c :=
begin
  rw tends_to_def,
  intros ε hε,
  use 0,
  intros n hn,
  simp only [sub_self, abs_zero],
  exact hε,
end

/-- Si `a(n)` tiende a `L` entonces `a(n) + c` tiende a `t + c` -/
theorem tends_to_add_const {a : ℕ → ℝ} {L : ℝ} (c : ℝ)
  (h : tends_to a L) :
  tends_to (λ n, a n + c) (L + c) :=
begin
  intros ε hε,
  specialize h ε hε,
  cases h with N hN,
  use N,
  intros n hn,
  dsimp only,
  convert hN n hn using 1,
  simp only [add_sub_add_right_eq_sub],
end

/-- Si `a(n)` tiende a `L`, entonces `-a(n)` tiende a `-L`.
Si simplificar la expresión dentro del valor absoluto te está
dando problemas, ve a la hoja `reales.lean`.
-/
theorem tends_to_neg {a : ℕ → ℝ} {L : ℝ} (ha : tends_to a L) :
  tends_to (λ n, - a n) (-L) :=
begin
  intros ε hε,
  obtain ⟨N, hN⟩ := ha ε hε,
  use N,
  intros n hn,
  dsimp only,
  rw [neg_sub_neg, abs_sub_comm],
  exact hN n hn,
end

/-- Si `a(n)` tiende a `La` y `b(n)` tiende a `Lb` entonces `a(n) + b(n)`
tiende a `La + Lb`.
Esta demostración es más complicada que las anteriores.
-/
theorem tends_to_add {a b : ℕ → ℝ} {La Lb : ℝ}
  (ha : tends_to a La) (hb : tends_to b Lb) :
  tends_to (λ n, a n + b n) (La + Lb) :=
begin
  intros ε hε,
  obtain ⟨Na, hNa⟩ := ha (ε/2) (by linarith),
  obtain ⟨Nb, hNb⟩ := hb (ε/2) (by linarith),
  use max Na Nb,
  intros n hn,
  dsimp only,
  rw max_le_iff at hn,
  specialize hNa n hn.1,
  specialize hNb n hn.2,
  rw abs_lt at hNa hNb ⊢,
  split; -- El `;` en lugar de `,` hace que la siguiente instrucción se aplique a todas las metas.
  linarith,
end

/-- Si `a(n)` tiende a `La` y `b(n)` tiende a `Lb` entonces `a(n) - b(n)`
tiende a `La - Lb`. -/
theorem tends_to_sub {a b : ℕ → ℝ} {La Lb : ℝ}
  (ha : tends_to a La) (hb : tends_to b Lb) :
  tends_to (λ n, a n - b n) (La - Lb) :=
begin
  exact tends_to_add ha (tends_to_neg hb),
end

/-- Si `a(n)` tiende a `L`, entonces `c*a(n)` tiende a `c*L`.
Pista: tratad el caso `c = 0` por separado, utilizando `by_cases hc : c = 0`.
-/
lemma tends_to_mul_const_left {a : ℕ → ℝ} {L c : ℝ} (h : tends_to a L) :
  tends_to (λ n, c * (a n)) (c * L) :=
begin
  intros ε hε,
  by_cases hc : c = 0,
  { use 0,
    intros n hn,
    simp only [hc, zero_mul, tsub_zero, abs_zero],
    exact hε },
  { have hε' : 0 < ε/|c|,
    { apply div_pos hε (abs_pos.mpr hc) },
    obtain ⟨N, hN⟩ := h (ε/|c|) hε',
    use N,
    intros n hn,
    dsimp only,
    rw [← mul_sub, abs_mul, ← lt_div_iff' (abs_pos.mpr hc)],
    exact hN n hn,
  }
end

/- Lema del sandwich. -/
theorem sandwich (a b c : ℕ → ℝ) (L : ℝ) (ha : tends_to a L) (hc : tends_to c L)
  (hab : ∀ n, a n ≤ b n) (hbc : ∀ n, b n ≤ c n) :
  tends_to b L :=
begin
  intros ε hε,
  obtain ⟨Na, hNa⟩ := ha ε hε,
  obtain ⟨Nc, hNc⟩ := hc ε hε,
  use max Na Nc,
  intros n hn,
  rw max_le_iff at hn,
  specialize hNa n hn.1,
  specialize hNc n hn.2,
  rw abs_lt at hNa hNc ⊢,
  specialize hab n,
  specialize hbc n,
  split;
  linarith,
end


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

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

/-!

# The order (≤) on filters

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

In the `filter` namespace there's a lemma

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

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

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

-/

variable {α : Type}

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

open_locale filter -- for 𝓟 notation

example (S T : set α) : 𝓟 S ≤ 𝓟 T ↔ S ⊆ T :=
begin
  split,
  { intro h,
    rw le_def at h,
    have hT : T ∈ 𝓟 T := mem_principal_self T,
    specialize h T hT,
    rwa mem_principal at h },
  { intro hST,
    rw le_def,
    intros X hX,
    rw mem_principal at hX ⊢,
    exact subset.trans hST hX }
end

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

example (F : filter α) (S : set α) : F ≤ 𝓟 S ↔ S ∈ F :=
begin
  rw le_def,
  split,
  { intro h,
    apply h,
    exact mem_principal_self S },
  { intros hSF X hX,
    rw mem_principal at hX,
    exact mem_of_superset hSF hX },
end

/-

## Filters are a complete lattice

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

-/

def LUB {I : Type} (F : I → filter α) : filter α :=
{ sets := {X | ∀ i, X ∈ F i},
  univ_sets := begin
    intro i,
    apply univ_mem,
  end,
  sets_of_superset := begin
    intros S T hS hST i,
    apply mem_of_superset _ hST,
    apply hS,
  end,
  inter_sets := begin
    intros S T hS hT i,
    exact inter_mem (hS i) (hT i),
  end }

/-

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

-/

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

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

/-

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

-/

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

-- it's a lower bound
example (I : Type) (F : I → filter α) (i : I) : GLB F ≤ F i :=
begin
  rintros S hS ⟨G, hG⟩,
  dsimp,
  apply hG _ hS,
end

-- it's ≥ all other lower bounds
example (I : Type) (F : I → filter α) (G : filter α) (hG : ∀ i, G ≤ F i) : G ≤ GLB F :=
begin
  intros S hS,
  unfold GLB at hS,
  dsimp at hS,
  unfold LUB at hS,
  dsimp at hS,
  specialize hS ⟨G, _⟩,
  { exact hG },
  { exact hS },
end


import kb_real_defs

/-
# Chapter 1 : Sets

## Level 9
-/

/-
This is a little more complicated example asking you to work with intervals of reals.
The result will be of help in the sup-inf world.
-/

notation `[` a `,` b `]`  := set.Icc a b

def mem_prod_sets (A : set ℝ) (B : set ℝ) := { x : ℝ | ∃ y ∈ A, ∃ z ∈ B, x = y * z}

/- Lemma
If $x = 0$, then `x ∈ mem_prod_sets [(-2:ℝ),-1] [(0:ℝ), 3]`
-/
lemma zero_in_prod : (0:ℝ) ∈ mem_prod_sets [(-2:ℝ), -1] [(0:ℝ), 3] :=
begin
  rw mem_prod_sets,
  dsimp,
  use -2,
  split,
  norm_num,
  use 0,
  split,
  norm_num,
  norm_num,
end

/-
rw mem_prod_sets,
  dsimp,
  use -2,
  split,
  { rw mem_Icc_iff,
    split; linarith
  },
  use 0,
  split,
  { rw mem_Icc_iff,
    split; linarith
  },
  norm_num
-/


-- We import all of Lean's standard tactics
import tactic

/-
 Since it's the easiest thing to start with, we first develop basic logic.

 # The logical symbols that Lean understands :

 * `→` ("implies" -- type with `\l`)
 * `¬` ("not" -- type with `\not` or `\n`)
 * `∧` ("and" -- type with `\and` or `\an`)
 * `↔` ("iff" -- type with `\iff` or `\lr`)
 * `∨` ("or" -- type with `\or` or `\v`)

 # Useful tactics :

 * `intro`
 * `exact`
 * `apply`
 * `rw`
 * `cases`
 * `split`
 * `left`
 * `right`

-/

namespace mbl

variables (P Q R : Prop)
--We define three variables, each is a ' term of type `Prop` '

-- ### Introductory examples with implies (→)

theorem id : P → P :=
begin
  -- let hP be a proof of P
  intro hP,
  -- then hP is a proof of P!
  exact hP
end

--This one is immediate from definition.
-- in Lean, `P → Q → R` is _defined_ to mean `P → (Q → R)`
example : (P → Q → R) ↔ (P → (Q → R)) :=
begin
  -- look at the goal!
  refl -- true because ↔ is reflexive
end

theorem imp_intro : P → Q → P :=
begin
  -- remember that by definition the goal is P → (Q → P),
  -- so it's P implies something, so let's assume
  -- that P is true and call this hypothesis hP.
  intro hP,
  -- Now we have to prove that Q implies P, so let's
  -- assume that Q is true, and let's call this hypothesis hQ
  intro hQ,
  -- We now have to prove that P is true.
  -- But this is exactly our hypothesis hP.
  exact hP,
end

lemma modus_ponens : P → (P → Q) → Q :=
begin
  -- remember this means "P implies that ((P implies Q) implies Q)"
  -- so let's assume P is true
  intro hP,
  -- and let's assume hypothesis hPQ, that P implies Q
  intro hPQ,
  -- now `hPQ` says `P → Q` and we're trying to prove `Q`!
  -- So by applying the hypothesis `hPQ`, we can reduce
  -- this puzzle to proving `P`.
  apply hPQ,
  -- Now we have to prove `P`. But this is just an assumption
  exact hP, -- or `assumption`
end

-- ### First independent steps

lemma imp_trans : (P → Q) → (Q → R) → (P → R) :=
begin
  -- The tactics you know should be enough
  sorry,
end

lemma forall_imp : (P → Q → R) → (P → Q) → (P → R) :=
begin
  -- `intros hPQR hPQ hP,` would be a fast way to start.
  sorry,
end

/-
### not

`not P`, with notation `¬ P`, is *defined* to mean `P → false` in Lean,
i.e., the proposition that P implies false. You can easily check with
a truth table that P → false and ¬ P are equivalent.

-/

theorem not_iff_imp_false : ¬ P ↔ (P → false) :=
begin
  -- true by definition
  refl
end

theorem not_not_intro : P → ¬ (¬ P) :=
begin
  --You can do it in a few ways. One of them is particularly short and slick
  sorry,
end

-- This is "modus tollens". Some mathematicians think of it as
-- "proof by contradiction".
theorem modus_tollens : (P → Q) → (¬ Q → ¬ P) :=
begin
  sorry,
end

-- This one cannot be proved using constructive mathematics!
-- You _have_ to use a tactic like `by_contra` (or, if you're happy
-- to cheat, the full "truth table" tactic `tauto!`.
-- Try it without using these, and you'll get stuck!
theorem double_negation_elimination : ¬ (¬ P) → P :=
begin
  sorry,
end

/-

### and

The hypothesis `hPaQ : P ∧ Q` in Lean, is equivalent to
hypotheses `hP : P` and `hQ : Q`.

If you have `hPaQ` as a hypothesis, and you want to get to
`hP` and `hQ`, you can use the `cases` tactic.

If you have `⊢ P ∧ Q` as a goal, and want to turn the goal
into two goals `⊢ P` and `⊢ Q`, then use the `split` tactic.

Note that after `split` it's good etiquette to use braces
e.g.

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

-/

theorem and.elim_left : P ∧ Q → P :=
begin
  -- if `h : P ∧ Q` then `h.1 : P` and `h.2 : Q`
  sorry,
end

theorem and.elim_right : P ∧ Q → Q :=
begin
  sorry,
end

theorem and.intro : P → Q → P ∧ Q :=
begin
  -- remember the `split` tactic.
  sorry,
end

/-- the eliminator for `∧` -/
theorem and.elim : P ∧ Q → (P → Q → R) → R :=
begin
  sorry,
end

/-- The recursor for `∧` -/
theorem and.rec : (P → Q → R) → P ∧ Q → R :=
begin
  sorry,
end

/-- `∧` is symmetric -/
theorem and.symm : P ∧ Q → Q ∧ P :=
begin
  --Useful fact:
  -- `intro hPQ`
  -- `cases hPQ with hP hQ`
  --can be replaced with
  -- `rintro ⟨hP, hQ⟩`
  sorry,
end

/-- `∧` is transitive -/
theorem and.trans : (P ∧ Q) → (Q ∧ R) → (P ∧ R) :=
begin
  -- The `rintro` tactic will do `intro` and `cases` all in one go.
  -- If you like, try starting this proof with `rintro ⟨hP, hQ⟩` if you want
  -- to experiment with it. Get the pointy brackets with `\<` and `\>`,
  -- or both at once with `\<>`.

  sorry,

end

/-
Recall that the convention for the implies sign →
is that it is _right associative_, by which
I mean that `P → Q → R` means `P → (Q → R)` by definition.
Now note that if `P` implies `Q → R`
then this means that `P` and `Q` together, imply `R`,
so `P → Q → R` is logically equivalent to `(P ∧ Q) → R`.

We proved that `P → Q → R` implied `(P ∧ Q) → R`; this was `and.rec`.
Let's go the other way.
-/

lemma imp_imp_of_and_imp : ((P ∧ Q) → R) → (P → Q → R) :=
begin
  sorry,
end

/-!

### iff

The basic theory of `iff`.

In Lean, to prove `P ∧ Q` you have to prove `P` and `Q`.
Similarly, to prove `P ↔ Q` in Lean, you have to prove `P → Q`
and `Q → P`. Just like `∧`, you can uses `cases h` if you have
a hypothesis `h : P ↔ Q`, and `split` if you have a goal `⊢ P ↔ Q`.
-/

/-- `P ↔ P` is true for all propositions `P`, i.e. `↔` is reflexive. -/
theorem iff.refl : P ↔ P :=
begin
  split,
  apply id,
  apply id,
  /- or tauto, tauto-/
end

-- If you get stuck, there is always the "truth table" tactic `tauto!`
-- This literally solves everything above. It's a cool thing
-- but overrelying on it today would be pointless
example : P ↔ P :=
begin
  tauto!, -- the "truth table" tactic.
end

-- refl tactic also works
example : P ↔ P :=
begin
  refl -- `refl` knows that `=` and `↔` are reflexive.
end

/-- `↔` is symmetric -/
theorem iff.symm : (P ↔ Q) → (Q ↔ P) :=
begin
  sorry,
end

/-- `↔` is commutative -/
theorem iff.comm : (P ↔ Q) ↔ (Q ↔ P) :=
begin
  sorry,

end

-- without rw or cc this is painful!
/-- `↔` is transitive -/
theorem iff.trans :  (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  sorry,

end

-- This can be done constructively, but it's hard. You'll need to know
-- about the `have` tactic to do it. Alternatively the truth table
-- tactic `tauto!` will do it.
theorem iff.boss : ¬ (P ↔ ¬ P) :=
begin
  sorry,
end

-- Now we have iff we can go back to and.

/-!
### ↔ and ∧
-/

/-- `∧` is commutative -/
theorem and.comm : P ∧ Q ↔ Q ∧ P :=
begin
  sorry,
end

-- Note that ∧ is "right associative" in Lean, which means
-- that `P ∧ Q ∧ R` is _defined to mean_ `P ∧ (Q ∧ R)`.
-- Associativity can hence be written like this:
/-- `∧` is associative -/
theorem and_assoc : ((P ∧ Q) ∧ R) ↔ (P ∧ Q ∧ R) :=
begin
  sorry,
end

/-!

## Or

`P ∨ Q` is true when at least one of `P` and `Q` are true.
Here is how to work with `∨` in Lean.

If you have a hypothesis `hPoQ : P ∨ Q` then you
can break into the two cases `hP : P` and `hQ : Q` using
`cases hPoQ with hP hQ`

If you have a _goal_ of the form `⊢ P ∨ Q` then you
need to decide whether you're going to prove `P` or `Q`.
If you want to prove `P` then use the `left` tactic,
and if you want to prove `Q` then use the `right` tactic.

-/

-- recall that P, Q, R are Propositions. We'll need S for this one.
variable (S : Prop)

-- You will need to use the `left` tactic for this one.
theorem or.intro_left : P → P ∨ Q :=
begin
  intro hP,
  left,
  exact hP,
end

theorem or.intro_right : Q → P ∨ Q :=
begin
  sorry,
end

/-- the eliminator for `∨`. -/
theorem or.elim : P ∨ Q → (P → R) → (Q → R) → R :=
begin
  sorry,
end

/-- `∨` is symmetric -/
theorem or.symm : P ∨ Q → Q ∨ P :=
begin
  sorry
end

/-- `∨` is commutative -/
theorem or.comm : P ∨ Q ↔ Q ∨ P :=
begin
  sorry,
end

/-- `∨` is associative -/
theorem or.assoc : (P ∨ Q) ∨ R ↔ P ∨ Q ∨ R :=
begin
  sorry,
end

/-!
### More about → and ∨
-/

theorem or.imp : (P → R) → (Q → S) → P ∨ Q → R ∨ S :=
begin
  sorry,
end

theorem or.imp_left : (P → Q) → P ∨ R → Q ∨ R :=
begin
  sorry,
end

theorem or.imp_right : (P → Q) → R ∨ P → R ∨ Q :=
begin
  sorry,
end

theorem or.left_comm : P ∨ Q ∨ R ↔ Q ∨ P ∨ R :=
begin
  -- Try rewriting `or.comm` and `or.assoc` to do this one quickly.
  sorry,
end

/-- the recursor for `∨` -/
theorem or.rec : (P → R) → (Q → R) → P ∨ Q → R :=
begin
  sorry,
end

theorem or_congr : (P ↔ R) → (Q ↔ S) → (P ∨ Q ↔ R ∨ S) :=
begin
  sorry,
end

/-!

### true and false

`true` is a true-false statement, which can be proved with the `trivial` tactic.

`false` is a true-false statment which can only be proved if you manage
to find a contradiction within your assumptions.

If you manage to end up with a hypothesis `h : false` then there's quite
a funny way to proceed, which we now explain.

If you have `h : P ∧ Q` then you can uses `cases h with hP hQ` to split
into two cases.

If you have `h : false` then what do you think happens if we do `cases h`?
Hint: how many cases are there?
-/

/-- eliminator for `false` -/
theorem false.elim : false → P :=
begin
  intro h,
  cases h,

end

theorem and_true_iff : P ∧ true ↔ P :=
begin
  sorry,

end

theorem or_false_iff : P ∨ false ↔ P :=
begin
  sorry,
end

-- false.elim is handy for this one
theorem or.resolve_left : P ∨ Q → ¬P → Q :=
begin
  sorry,
end

-- this one you can't do constructively
theorem or_iff_not_imp_left : P ∨ Q ↔ ¬P → Q :=
begin

    sorry,

end

end mbl


/-
If you understand the introduction and elimination
rules for ∀, then you understand these rules for
proving, and using proofs of implications. Consider
an implication, P → Q. To construct a proof, pq, of
P → Q, you simply *assume* you're given an arbitrary
but specific value/proof of P and in this context you
must show that you can construct and return a proof of
Q. What this shows is that *if* P is true (because
there is a proof of it) then so is Q.

In other words, prove P → Q by showing that you can
define a total function of type P → Q!

For an example, see the second step (after the ∀
introduction) in our proof of the commutativity of
∨. What's left to prove there is an implication,
P ∨ Q → Q ∨ P. The way it is proved is just the
way that the overall ∀ proposition is proved: by
assuming that we're given a proof/value, but now
of type P ∨ Q, and showing that in this context
we can construct and return a value of Q ∨ P.

In fact, P ∨ Q is really just a shorthand in Lean
for ∀ (p : P), Q! You can see it clearly in the
following code, where we first assume that P and
Q are arbitrary propositions, and then check the
type of ∀ (p : P), Q. It's Prop, of course, as
∀ (p : P), Q is a proposition; but what is key
here is that Lean uses → notation to print out
this proposition! We can even prove that they're
exactly the same proposition.
-/

axioms P Q : Prop
#check ∀ (p : P), Q
example : (P → Q) = ∀ (p : P), Q := rfl

/-
Of course it's now obvious that the elimination
rule for → is the same as it is for ∀: *apply* a
proof of P → Q to a proof of P to obtain a proof
of Q.
-/

theorem modus_ponens:
    (P → Q) →
    P →
    Q :=
λ (pq : P → Q), -- suppose you have a proof of P → Q
λ (p : P),      -- and that you have a proof of P
pq p            -- *apply* former to latter; QED.


-- Suma_de_potencias_de_dos.lean
-- Suma de potencias de dos
-- José A. Alonso Jiménez
-- Sevilla, 25 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que
--    1 + 2 + 2² + 2³ + ... + 2⁽ⁿ⁻¹⁾ = 2ⁿ - 1
-- ---------------------------------------------------------------------

import algebra.big_operators
import tactic
open finset nat

open_locale big_operators
set_option pp.structure_projections false

variable (n : ℕ)

example :
  ∑ k in range n, 2^k = 2^n - 1 :=
begin
  induction n with n HI,
  { simp, },
  { calc ∑ k in range (succ n), 2^k
         = ∑ k in range n, 2^k + 2^n
             : sum_range_succ (λ x, 2 ^ x) n
     ... = (2^n - 1) + 2^n
             : congr_arg2 (+) HI rfl
     ... = (2^n + 2^n) - 1
             : by omega
     ... = 2^n * 2 - 1
             : by {congr; simp}
     ... = 2^(succ n) - 1
             : by {congr' 1; ring_nf}, },
end

-- Referencia: "El método de la inducción matemática" de I.S. Sominski
-- p. 20.


theorem demorgans_law (p q : Prop) : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
begin
  split,
  { intro hnpq,
    -- superficial
    change (p ∨ q) → false at hnpq,
    split,
    { intro hp,
      apply hnpq,
      left,
      assumption
    },
    { intro hq,
      apply hnpq,
      right,
      assumption
    }
  },
  intro hnpnq,
  intro hpq,
  cases hnpnq with hnp hnq,
  cases hpq,
    contradiction,
  contradiction
end

theorem demorgans_law' (p q : Prop): ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  iff.intro
    (assume h,
      and.intro (assume hp, h (or.inl hp)) (assume hq, h (or.inr hq)))
    (assume h : ¬p ∧ ¬q,
      not_or h.left h.right)

theorem demorgans_law'' (p q : Prop) : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
⟨λ h, ⟨λ hp, h $ or.inl hp, λ hq, h $ or.inr hq⟩,
  λ ⟨hnp, hnq⟩ hn, or.elim hn hnp hnq⟩


import data.real.basic
variables (x y : ℝ)

theorem add_law (a b x y : ℝ) (h₁: x<y) (h₂:a<b): x+a < y + b :=
begin
have h₃: x + a < y + a,
exact add_lt_add_right h₁ a,
have h₄: y + a < y + b,
exact add_lt_add_left h₂ y,
exact lt_trans h₃ h₄,
end

lemma real_le_mul (a b c d :ℝ) (h₁:0<a) (h₂:0<b) (h₃:0<c) (h₄:0<d)
(h₅: a<b) (h₆:c<d): a * c < b * d:=
begin
have h₇: a * c < b * c, --We prove an auxiliary statement
exact (mul_lt_mul_right h₃).mpr h₅, --We use monotonicity of multiplication
have h₈: b*c < b*d, --We prove another auxiliary statement
rw mul_comm b c, --We use commutativity of multiplication so our goal is in the required form to use monotonicity
rw mul_comm b d, --We use commutativity again
exact (mul_lt_mul_right h₂).mpr h₆, --Monotonicity shows our auxiliary statement
apply lt_trans h₇ h₈, --We use transitivity to close the goal
end

example (n: nat)  (h:x>0) : (1+x)^n ≥ 1 + x*n :=
begin
  induction n with d hd,
  norm_num,
  have h₁:d.succ = ↑d+1,
  norm_num,
  rw h₁,
  norm_num,
  rw mul_add,
  rw pow_succ,
  rw add_mul,
  rw ← add_assoc,
  rw one_mul,
  rw mul_one,
  norm_num at hd,
  apply add_le_add hd,
  nth_rewrite 0 ← mul_one x,
  apply mul_le_mul,
  refl,
  clear hd,
  induction d with d hd,
  rw pow_zero,
  nth_rewrite 0 ← mul_one (1:ℝ),
  apply mul_le_mul,
  linarith,
  finish,
  repeat{linarith},
end

example {x : ℝ} {n : ℕ} (h : 0 < x) : 1 + x * n ≤ (1 + x) ^ n :=
begin
  induction n with n hn,
  { norm_num },
  { change n.succ with n + 1, norm_num,
    simp [pow_succ, mul_add, ←add_assoc, add_mul],
    apply add_le_add hn, clear hn, nth_rewrite 0 ←mul_one x,
    apply mul_le_mul; try {linarith},
    induction n with n hn; simp [pow_zero, pow_succ],
    nth_rewrite 0 ←mul_one (1 : ℝ), apply mul_le_mul; linarith },
end


/-*** def ***-/

/-
The def keyword in Lean establishes a new definition: a binding
of a variable to a value of a specified type. First, let's look
at binding names to values of a few data types.
-/

def five : ℕ := 5

/-
This definition declares five to be a variable name, to be bound
to a value of type ℕ, and in particular now bound to the value, 5.
We can now use #check to see that we've got what we expect here.
-/

#check five

/-
#check tells us that five is a correct expression and that it is
an expression of type ℕ.
-/

/-
Note that when Lean can infer the type of a variable from the
value bound to it, you can elide the explicit "type judgment"
-/

def six := 6      -- type inference
#check 6
#check six

/-
Ok, now let's look at the case where we're working now with
data values but with proofs of propositions. We'll start with
the proposition, true.
-/

def proof_of_true : true := true.intro

/-
Here we define proof_of_true to be a variable, meant to be
bound to a "proof" (or proof value, or proof object) because
"true" is a proposition not a data type. We then bind it to
the proof value, true.intro, which, as you will recall, is the
one and only proof of true in our logic. Proofs are mathematical
objects/values, just like data values.
-/

/-
It's worthwhile at this point to think hard again about types.
The type of proof_of_true in our logic is *true*. That's what
the "type judgement", (proof_of_true : true), expresses. And
of course the type of true is Prop.
-/

/-
When assigning proof values to variables, it's often beneficial
to work out the proof value a bit at a time. That's what proof
"scripts" are for. We could have written the previous example
using a proof script just as well.
-/

def proof_of_true2        : true := true.intro
def another_proof_of_true : true := begin exact true.intro end

/-
The script, :begin exact true.intro end", results in exactly the
proof value, true.intro, which is then bound to the variable,
another_proof_of_true.
-/

#check proof_of_true
#check another_proof_of_true
#check true

/-
There's a deep parallel in our higher-order logic between data
values and proof values, and between data types and propositions.
Let's make this clear by examples.

- The type of "five" is ℕ, and the type of ℕ is Type
- The type of "Hi" is string, and the type of string is Type
- The type of tt is bool (in Lean), and the type of bool is Type.

- The type of true.intro is true, and the type of true is Prop
- The type of proof_of_true is true, and the type of true is Prop
- The type of another_proof_of_true is true, and its type is Prop
-/

/-
Here's another example
-/

def a_fact : ∀ (P Q : Prop), P ∧ Q → P :=
begin
  assume P Q h,
  exact (and.elim_left h),
end

def a_fact' : ∀ (P Q : Prop), P ∧ Q → P :=
  λ P Q h, and.elim_left h

/-
Here we declare a_fact to be a variable that is meant to be bound
(to have as its value) of proof of ∀ (P Q : Prop), P ∧ Q → P. The
proof script produces such a "proof" value, which is then bound to
the variable a_fact. The #check command reports that the "type" of
a_fact is ∀ (P Q : Prop), P ∧ Q → P. Propositions are types in our
higher-order logic, and just as Lean type checks the values you try
to bind to variables, giving errors if the types don't match, so in
the same way Lean checks the types of proof values to be sure they
match the propositions they're intended to be proofs of!
-/

def oops : ℕ := "Hi"       -- type error (read the error message)
def argh : ∀ (P Q : Prop), P ∧ Q → P := true.intro -- type error!

/-
Please read the error messages: in both cases we have a type error.
In the first example, we try to bind a string value, "Hi,"  to a
variable declared to be of type ℕ, and that produces a type error.
Similarly, when we try to bind a proof value, true.intro (a proof
of true) to the variable, argh, we get a type error, because argh
is meant to be bound to a proof of ∀ (P Q : Prop), P ∧ Q → P.
-/

/-
We can clearly distinguish the use of the #check command to check
the syntax and type of an expression you provide, from the use of
*type checking* in Lean (as in Java), which checks whether the type
of a value being bound to a variable is the same as the type that
the variable expects.
-/

/-
Whereas "def" binds a variable to a value in the "global
environment", the let keyword supports binding of values
to local variables, followed by evaluation of an expression
that uses that local variable.
-/

def x := 1
#eval x

#eval let a := 1 in a   --evaluates to 1

#check a                -- not defined in global environment

-- You can "nest" let expressions
#reduce  let a := 3 in
          let b := 4 in
            let c := 5 in
              a*a + b*b = c*c

-- Within tactic scripts you leave off the "in" part
theorem pythag_25 : 3*3 + 4*4 = 5*5 :=
begin
  let a := 3,
  let b := 4,
  let c := 5,
  show a * a + b * b = c * c,
  exact rfl,
end


import data.real.basic

example : ∀ P Q : Prop, P → Q → P :=

/- In Lean, the implication arrow → is right-associative.
  P → Q → P in fact refers to P → (Q → P). -/

/- A paper-pencil proof of P → (Q → P) would be the following:
  - let P and Q be propositions;
  - assume that the hypothesis of P (hp) and the hypothesis of Q (hq)are true;
  - to prove P, we use hypothesis hp. -/

/- A Lean proof-/
begin
  intros P Q,
  /- The 'intros P Q' tactic introduces two free variables P and Q in the local
  context. The tactic mimics how mathematicians work on paper: To prove a
  universally quantified proposition, it suffices to prove it for some arbitrary
  but fixed value of the bound variable. -/

  intros hp hq,
  /- The 'intros hp hq' tactic introduces the proof of P called hp and
  the proof of Q called hq to the local context. In other words, we assume that
  P is true and Q is true, and we want to prove P is true. Indeed, to prove an
  implication, it suffices to take its left-hand side as the hypothesis and prove
  its right-hand side true. -/

  exact hp,
  /- hp suffices to prove P because hp is the proof of P. The 'exact hp' tactic
  tells Lean that hp is exactly needed to achieve and close the goal. -/
end


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import data.finset.card
import data.multiset.nat_antidiagonal

/-!
# Antidiagonals in ℕ × ℕ as finsets

This file defines the antidiagonals of ℕ × ℕ as finsets: the `n`-th antidiagonal is the finset of
pairs `(i, j)` such that `i + j = n`. This is useful for polynomial multiplication and more
generally for sums going from `0` to `n`.

## Notes

This refines files `data.list.nat_antidiagonal` and `data.multiset.nat_antidiagonal`.
-/

namespace finset
namespace nat

/-- The antidiagonal of a natural number `n` is
    the finset of pairs `(i, j)` such that `i + j = n`. -/
def antidiagonal (n : ℕ) : finset (ℕ × ℕ) :=
⟨multiset.nat.antidiagonal n, multiset.nat.nodup_antidiagonal n⟩

/-- A pair (i, j) is contained in the antidiagonal of `n` if and only if `i + j = n`. -/
@[simp] lemma mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} :
  x ∈ antidiagonal n ↔ x.1 + x.2 = n :=
by rw [antidiagonal, mem_def, multiset.nat.mem_antidiagonal]

/-- The cardinality of the antidiagonal of `n` is `n + 1`. -/
@[simp] lemma card_antidiagonal (n : ℕ) : (antidiagonal n).card = n+1 :=
by simp [antidiagonal]

/-- The antidiagonal of `0` is the list `[(0, 0)]` -/
@[simp] lemma antidiagonal_zero : antidiagonal 0 = {(0, 0)} :=
rfl

lemma antidiagonal_succ {n : ℕ} :
  antidiagonal (n + 1) = insert (0, n + 1) ((antidiagonal n).map
  (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ (function.embedding.refl _))) :=
begin
  apply eq_of_veq,
  rw [insert_val_of_not_mem, map_val],
  {apply multiset.nat.antidiagonal_succ},
  { intro con, rcases mem_map.1 con with ⟨⟨a,b⟩, ⟨h1, h2⟩⟩,
    simp only [prod.mk.inj_iff, function.embedding.coe_prod_map, prod.map_mk] at h2,
    apply nat.succ_ne_zero a h2.1, }
end

lemma map_swap_antidiagonal {n : ℕ} :
  (antidiagonal n).map ⟨prod.swap, prod.swap_right_inverse.injective⟩ = antidiagonal n :=
begin
  ext,
  simp only [exists_prop, mem_map, mem_antidiagonal, prod.exists],
  rw add_comm,
  split,
  { rintro ⟨b, c, ⟨rfl, rfl⟩⟩,
    simp },
  { rintro rfl,
    use [a.snd, a.fst],
    simp }
end

/-- A point in the antidiagonal is determined by its first co-ordinate. -/
lemma antidiagonal_congr {n : ℕ} {p q : ℕ × ℕ} (hp : p ∈ antidiagonal n)
  (hq : q ∈ antidiagonal n) : p = q ↔ p.fst = q.fst :=
begin
  refine ⟨congr_arg prod.fst, (λ h, prod.ext h ((add_right_inj q.fst).mp _))⟩,
  rw mem_antidiagonal at hp hq,
  rw [hq, ← h, hp],
end

lemma antidiagonal.fst_le {n : ℕ} {kl : ℕ × ℕ} (hlk : kl ∈ antidiagonal n) :
  kl.1 ≤ n :=
begin
  rw le_iff_exists_add,
  use kl.2,
  rwa [mem_antidiagonal, eq_comm] at hlk
end

lemma antidiagonal.snd_le {n : ℕ} {kl : ℕ × ℕ} (hlk : kl ∈ antidiagonal n) :
  kl.2 ≤ n :=
begin
  rw le_iff_exists_add,
  use kl.1,
  rwa [mem_antidiagonal, eq_comm, add_comm] at hlk
end

lemma filter_fst_eq_antidiagonal (n m : ℕ) :
  filter (λ x : ℕ × ℕ, x.fst = m) (antidiagonal n) = if m ≤ n then {(m, n - m)} else ∅ :=
begin
  ext ⟨x, y⟩,
  simp only [mem_filter, nat.mem_antidiagonal],
  split_ifs with h h,
  { simp [and_comm, eq_tsub_iff_add_eq_of_le h, add_comm] {contextual := tt} },
  { rw not_le at h,
    simp only [not_mem_empty, iff_false, not_and],
    exact λ hn, ne_of_lt (lt_of_le_of_lt (le_self_add.trans hn.le) h) }
end

lemma filter_snd_eq_antidiagonal (n m : ℕ) :
  filter (λ x : ℕ × ℕ, x.snd = m) (antidiagonal n) = if m ≤ n then {(n - m, m)} else ∅ :=
begin
  have : (λ (x : ℕ × ℕ), x.snd = m) ∘ prod.swap = (λ (x : ℕ × ℕ), x.fst = m),
  { ext, simp },
  rw ←map_swap_antidiagonal,
  simp [map_filter, this, filter_fst_eq_antidiagonal, apply_ite (finset.map _)]
end

section equiv_prod

/-- The disjoint union of antidiagonals `Σ (n : ℕ), antidiagonal n` is equivalent to the product
    `ℕ × ℕ`. This is such an equivalence, obtained by mapping `(n, (k, l))` to `(k, l)`. -/
@[simps] def sigma_antidiagonal_equiv_prod : (Σ (n : ℕ), antidiagonal n) ≃ ℕ × ℕ :=
{ to_fun := λ x, x.2,
  inv_fun := λ x, ⟨x.1 + x.2, x, mem_antidiagonal.mpr rfl⟩,
  left_inv :=
    begin
      rintros ⟨n, ⟨k, l⟩, h⟩,
      rw mem_antidiagonal at h,
      exact sigma.subtype_ext h rfl,
    end,
  right_inv := λ x, rfl }

end equiv_prod

end nat

end finset


import MyNat
import MyNat.addition_world

open MyNat

lemma mul_zero (a : ℕ) : a * zero = zero := by rfl
lemma mul_succ (a b : ℕ) : a * succ b = a + (a * b) := by rfl

lemma zero_mul (m : ℕ) : zero * m = zero :=
  by induction m with
  | zero => rewrite [mul_zero] rfl
  | succ m' ih => rewrite [mul_succ, ih, zero_add] rfl

lemma mul_one (m : ℕ) : m * 1 = m :=
  by rewrite [one_eq_succ_zero, mul_succ, mul_zero, add_zero] rfl

lemma one_mul (m : ℕ) : 1 * m = m :=
  by induction m with
  | zero => rewrite [mul_zero] rfl
  | succ m' ih => rewrite [mul_succ, ih, add_comm, succ_eq_add_one] rfl

lemma mul_add (t a b : ℕ) : t * (a + b) = t * a + t * b :=
  by induction b with
  | zero => rewrite [mul_zero, add_zero, add_zero] rfl
  | succ b' ih => rewrite [add_comm, succ_add, mul_succ, add_comm b' a, ih, ←add_assoc, add_right_comm, ← mul_succ, add_comm] rfl

lemma mul_assoc (a b c : ℕ) : (a * b) * c = a * (b * c) :=
  by induction c with
  | zero => rewrite [mul_zero, mul_zero, mul_zero] rfl
  | succ c' ih => rewrite [mul_succ, mul_succ, mul_add, ih] rfl

lemma succ_mul (a b : ℕ) : (succ a) * b = a * b + b :=
  by induction b with
  | zero => rewrite [mul_zero, mul_zero, add_zero] rfl
  | succ b' ih => rewrite [mul_succ, mul_succ, ih, ←add_assoc, add_right_comm, succ_add, add_comm a b', ←succ_add, add_comm (succ b') a, add_right_comm] rfl

lemma add_mul (a b t : ℕ) : (a + b) * t = a * t + b * t :=
  by induction t with
  | zero => rewrite [mul_zero, mul_zero, mul_zero, add_zero] rfl
  | succ t' ih => rewrite [mul_succ, ih, add_right_comm, ←add_assoc, ←mul_succ, add_right_comm, add_assoc, ←mul_succ] rfl

lemma add_same (m : ℕ) : m + m = 2 * m :=
  by rewrite [←one_mul m, ←add_mul, one_eq_succ_zero, succ_add, zero_add, ←one_eq_succ_zero, ←two_eq_succ_one, one_mul] rfl

lemma mul_comm (a b : ℕ) : a * b = b * a :=
  by induction b with
  | zero => rewrite [mul_zero, zero_mul] rfl
  | succ b' ih => rewrite [mul_succ, succ_mul, ih, add_comm] rfl

lemma mul_left_comm (a b c : ℕ) : a * (b * c) = b * (a * c) :=
  by rewrite [mul_comm, mul_assoc, mul_comm c a] rfl


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

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
    iff.intro
        (
            assume h: ∀ x, (p x ∧ q x),
            have ∀ x, p x, from (
                assume x: α,
                show p x, from (h x).left
            ),
            have ∀ x, q x, from (
                assume x: α ,
                show q x, from (h x).right
            ),
            and.intro ‹ ∀ x, p x › ‹ ∀ x, q x ›
        )
        (
            assume h: (∀ x, p x) ∧ (∀ x, q x),
            assume y: α,
            have p y, from h.left y,
            have q y, from h.right y,
            show p y ∧ q y, from and.intro ‹ p y › ‹ q y ›
        )

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
    assume h: (∀ x, p x → q x),
    assume hp: (∀ x, p x),
    assume y: α,
    show q y, from (h y) (hp y)

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
    assume h: (∀ x, p x) ∨ (∀ x, q x),
    or.elim
        h
        (
            assume hl: ∀ x, p x,
            assume y: α,
            have p y, from hl y,
            or.intro_left (q y) this
        )
        (
            assume hr: ∀ x, q x,
            assume y: α,
            have q y, from hr y,
            or.intro_right (p y) this
        )


/-
HOMEWORK #9

There is no need to import our previous definitions.
For this homework you will just use Lean's built-in
notations and definitions.
-/

/-
Prove the following. Note that you can read each of
the propositions to be proved as either a logical
statement or as simply a function definition. Use
what you already know about the latter to arrive
at a proof, and then understand the proof as one
that shows that the logical statement is true.
-/

theorem t1 {P Q : Prop} (p2q : P → Q) (p : P) : Q :=
  p2q p

theorem t2 {P Q R : Prop} (p2q : P → Q) (q2r : Q → R): P → R :=
  λ (p : P), q2r (p2q p)

/-
Use "example" to state and prove the preceding two
theorems but using "cases" style notation rather
than C-style. Remember, "example" is a way to state
a proposition/type and give an example of a value.
Here's an example of the use of "example". Give
your answers following this example.
-/

-- example
example : ℕ := 5

-- Your two answers here

-- HINT: use ∀ {P Q : Prop}, ... for the first one

example : ∀ {P Q : Prop}, (P → Q) → P → Q
|  P Q p2q p := p2q p

example : ∀ {P Q R : Prop}, (P → Q) → (Q → R) → (P → R)
|  P Q R p2q q2r := λ (p : P), q2r (p2q p)

  -- HINT: YOU JUST PROVED THAT → is *transitive* !!!

/-
Now give English-language versions of your two proofs.
-/

/-
1. Suppose P and Q are arbitrary propositions and that
we know that P → Q and also P are true. To show that
Q is true, it suffices to apply → elimination rule of
natural deduction: apply the assumed proof of P → Q
to the assumed proof of P to obtain a proof of Q. QED.
-/

/-
2. Suppose P and Q are arbitrary propositions and that
we know that P → Q and also Q → R are true. To show
that P → R in this context, suppose P is true. Apply
P → Q to deduce the truth of Q, then apply Q → R to
deduce the truth of R. QED.
-/

/-
Prove the following using case analysis on one
of the arguments (i.e., use match...with...end
at a key point in your proof). Use "cases" style
notation.
-/

theorem t3 : ∀ (P : Prop), false → P
| P f := false.elim f

/-
Prove false → true by applying t3 to a proposition.
You have to figure out which one.
-/
theorem t4 : false → true := t3 true

/-
Define t5 to be the same as t3 but with P taken as
an implicit argument.
-/

theorem t5 : ∀ {P : Prop}, false → P
| P f := false.elim f

/-
Define t6 to be a proof of false → true by
applying t5 to the right argument(s).
-/

theorem t6 : false → true := t5

/-
That is almost magic. In English, t3 proves
that false implies *any* proposition, so just
*apply* t3 to *true* in particular, but use t5
instead of t3.

What you see here is really important: Once
we've proved a general theorem (a ∀ proposition)
we can *apply the proof* to any *particular* case
to yield a proof for that specific case. This is
the elimination rule for ∀. It is also known as
universal instantiation (UI).
-/

/-
Next we see the idea that test cases are really
just equality propositions to be proved. Here,
for example, is a definition of the factorial
function.
-/

def fac : ℕ → ℕ
| 0 := 1
| (n' + 1) := (n' + 1) * fac n'

/-
Use "example" to write test cases for the
first ten natural number arguments to this
function.
-/

example : fac 0 = 1 := eq.refl 1
example : fac 1 = 1 := eq.refl _  -- Inferred
example : fac 2 = 2 := rfl        -- Shorthand
example : fac 3 = 6 := rfl
example : fac 4 = 24 := rfl
example : fac 5 = 125 := rfl
#check @rfl           -- infers type and value

-- The rest of your answers here

/-
Insight: A test case is an equality proposition.
It is proved by "running" the program under test
to reduce the application of the function to input
arguments to produce an output that is then asserted
to be equal to an expected output.

In many cases, all we have to do is to simplify
the expressions on each side of the eq to see if
they reduce to exactly the same value. If so, we
can *apply* eq.refl (a universal generalization!)
to that value. Using rfl we can avoid even having
to type that value in cases where Lean can infer
it.
-/

/-
The next problem requires thave you give a proof of
a bi-implication, a proposition whose connective is
↔. To prove a bi-implication requires that one prove
an implication in each direction.

Here you are asked to prove P ∧ Q ↔ Q ∧ P. What this
formula asserts is that ∧ is commutative. To construct
a proof of this proposition you will have to apply
iff.intro to two smaller proofs, one of P → Q and
and of Q → P.

Start by "assuming" that P and Q are arbitary but
specific propositions (∀ introduction), then apply
iff.intro to two "stubbed out" arguments (underscores).
We suggest that you put the underscores in parentheses
on different lines. Then recursively fill in each of
these stubs with the required types of proofs. Study
the context that Lean shows you in its Messages panel
to see what you have to work with at each point in
your proof constructions.
-/
theorem t7 : ∀ {P Q : Prop}, P ∧ Q ↔ Q ∧ P :=
λ P Q,
    iff.intro
    (λ pq, and.intro pq.right pq.left)
    (λ qp, and.intro qp.right qp.left)

/-
In English, when asked to prove P ↔ Q, one says, "it
will suffice to show P → Q and then to show Q → P." One
then goes on to give a proof of each implication. It
then follows from iff.intro that a proof of P ↔ Q can
be constructed, proving the bi-implication.
-/

/-
The trick here is to do case analysis on porq
(use match ... with ... end) and to show that
a proof of R can be constructed *in either case*.
-/
theorem t8 {P Q R : Prop} (p2r : P → R) (q2r : Q → R) (porq : P ∨ Q) : R :=
match porq with
| or.inl p := p2r p
| or.inr q := q2r q
end

/-
We suggest that you use  "let ... in" to give
names to intermediate results that you then combine
in a final expression to finish the proof.
-/
theorem t9 : ∀ (P Q: Prop), (P → Q) → ¬ (P ∧ ¬ Q) :=
λ P Q p2q pandnotq,
let p := pandnotq.left in
let q := p2q p in
let notq := pandnotq.right in
false.elim (notq q)

theorem neg_elim' : ∀ (P : Prop), ¬ ¬ P → P :=
λ P,
λ nnp,
_           -- STUCK!!

theorem neg_elim : ∀ (P : Prop), (P ∨ ¬ P) → (¬ ¬ P → P):=
λ P,
    λ h,
        λ nnp,
            match h with
            | or.inl p := p
            | or.inr np := false.elim (nnp np)  -- false elimination
            end

-- nnp : (¬ P) → false
-- np : ¬ P
-- nnp np = false!

-- Let's use H to mean There is a sub-exponential time algorithm for Boolean sat.
-- ¬ H means that there's not one.
-- H ∨ ¬H

-- make Lean into a classical logic
-- axiom em : ∀ (P : Prop), P ∨ ¬ P
#check classical.em

theorem t10 : ∀ (P : Prop), P ∨ ¬ P :=
classical.em

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

theorem t11 : ∀ (P Q : Prop), ¬ (P ∨ Q) ↔ ¬ P ∧ ¬ Q :=
λ P Q,
    iff.intro
        (λ not_porq,
            match (classical.em P) with
            | or.inl p := false.elim (not_porq (or.inl p))
            | or.inr np := match (classical.em Q) with
                           | or.inl q := false.elim (not_porq (or.inr q))
                           | or.inr nq := and.intro np nq
                           end
            end
        )
        -- ANSWER
        (λ notpandnotq,
            λ porq,
                match porq with
                | or.inl p := false.elim (notpandnotq.left p)
                | or.inr q := false.elim (notpandnotq.right q)
                end
        )

theorem t12 : ∀ (P Q : Prop), ¬ (P ∧ Q) ↔ ¬ P ∨ ¬ Q :=
λ P Q,
    iff.intro
    (λ not_pandq,
        match (classical.em P) with
        | or.inl p := match (classical.em Q) with
                        | or.inl q := false.elim (not_pandq (and.intro p q))
                        | or.inr nq := or.inr nq
                      end
        | or.inr np := or.inl np
        end
    )
    (λ b,
      λ c,
        match b with
        |or.inl np := np c.1
        |or.inr nq := nq c.2
        end
    )

/-
For the following exercises, we assume that there is
a type called Person and a binary relation, Likes, on
pairs of people.
-/
axiom Person : Type
axiom Likes : Person → Person → Prop

/-
Prove the following
-/
theorem t13 :
  (∃ (p : Person), ∀ (q : Person), Likes q p) →
  (∀ (p : Person), ∃ (q : Person), Likes p q) :=
λ h,
    match h with
    | exists.intro p pf :=
        λ q,
            (exists.intro p (pf q))
    end


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

import data.complex.basic
import data.real.cardinality

/-!
# The cardinality of the complex numbers

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

open cardinal set

open_locale cardinal

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

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

/-- The complex numbers are not countable. -/
lemma not_countable_complex : ¬ (set.univ : set ℂ).countable :=
by { rw [← mk_set_le_aleph_0, not_le, mk_univ_complex], apply cantor }


section propositional

variables P Q R : Prop

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end

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

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

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

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

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

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

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

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

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

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

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

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

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

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro pRp,
  cases pRp with p1 p2,
  exact p1,
  exact p2,
  intro p,
  left,
  exact p,
end

end propositional

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

section predicate

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

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

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intro nEpx,
  intro x,
  intro px,
  have cont : (∃x, P x),
    existsi x,
    exact px,
  contradiction,

end

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

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

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

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

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

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

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

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

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

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

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

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  have k := exists_as_neg_forall U P,
  exact k,
  have k := exists_as_neg_forall_converse U P,
  exact k,
end

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

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro Expxqx,
  cases Expxqx with x pxqx,
  cases pxqx with px qx,
  split,
  existsi x,
  exact px,
  existsi x,
  exact qx,
end

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

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

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

end

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

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro FxpxRFxqx,
  intro x,
  cases FxpxRFxqx with Fxpx Fxqx,
  have px := Fxpx x,
  left,
  exact px,
  have qx := Fxqx x,
  right,
  exact qx,
end

/- NOT THEOREMS --------------------------------
theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end
theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end
---------------------------------------------- -/

end predicate


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

! This file was ported from Lean 3 source module measure_theory.group.prod
! leanprover-community/mathlib commit ec247d43814751ffceb33b758e8820df2372bf6f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Constructions.Prod
import Mathbin.MeasureTheory.Group.Measure

/-!
# Measure theory in the product of groups
In this file we show properties about measure theory in products of measurable groups
and properties of iterated integrals in measurable groups.

These lemmas show the uniqueness of left invariant measures on measurable groups, up to
scaling. In this file we follow the proof and refer to the book *Measure Theory* by Paul Halmos.

The idea of the proof is to use the translation invariance of measures to prove `μ(t) = c * μ(s)`
for two sets `s` and `t`, where `c` is a constant that does not depend on `μ`. Let `e` and `f` be
the characteristic functions of `s` and `t`.
Assume that `μ` and `ν` are left-invariant measures. Then the map `(x, y) ↦ (y * x, x⁻¹)`
preserves the measure `μ × ν`, which means that
```
  ∫ x, ∫ y, h x y ∂ν ∂μ = ∫ x, ∫ y, h (y * x) x⁻¹ ∂ν ∂μ
```
If we apply this to `h x y := e x * f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' s)`, we can rewrite the RHS to
`μ(t)`, and the LHS to `c * μ(s)`, where `c = c(ν)` does not depend on `μ`.
Applying this to `μ` and to `ν` gives `μ (t) / μ (s) = ν (t) / ν (s)`, which is the uniqueness up to
scalar multiplication.

The proof in [Halmos] seems to contain an omission in §60 Th. A, see
`measure_theory.measure_lintegral_div_measure`.

-/

noncomputable section

open Set hiding prod_eq

open Function MeasureTheory

open Filter hiding map

open Classical ENNReal Pointwise MeasureTheory

variable (G : Type _) [MeasurableSpace G]

variable [Group G] [HasMeasurableMul₂ G]

variable (μ ν : Measure G) [SigmaFinite ν] [SigmaFinite μ] {s : Set G}

/-- The map `(x, y) ↦ (x, xy)` as a `measurable_equiv`. -/
@[to_additive "The map `(x, y) ↦ (x, x + y)` as a `measurable_equiv`."]
protected def MeasurableEquiv.shearMulRight [HasMeasurableInv G] : G × G ≃ᵐ G × G :=
  {
    Equiv.prodShear (Equiv.refl _)
      Equiv.mulLeft with
    measurable_to_fun := measurable_fst.prod_mk measurable_mul
    measurable_inv_fun := measurable_fst.prod_mk <| measurable_fst.inv.mul measurable_snd }
#align measurable_equiv.shear_mul_right MeasurableEquiv.shearMulRight
#align measurable_equiv.shear_add_right MeasurableEquiv.shearAddRight

/-- The map `(x, y) ↦ (x, y / x)` as a `measurable_equiv` with as inverse `(x, y) ↦ (x, yx)` -/
@[to_additive
      "The map `(x, y) ↦ (x, y - x)` as a `measurable_equiv` with as inverse `(x, y) ↦ (x, y + x)`."]
protected def MeasurableEquiv.shearDivRight [HasMeasurableInv G] : G × G ≃ᵐ G × G :=
  {
    Equiv.prodShear (Equiv.refl _)
      Equiv.divRight with
    measurable_to_fun := measurable_fst.prod_mk <| measurable_snd.div measurable_fst
    measurable_inv_fun := measurable_fst.prod_mk <| measurable_snd.mul measurable_fst }
#align measurable_equiv.shear_div_right MeasurableEquiv.shearDivRight
#align measurable_equiv.shear_sub_right MeasurableEquiv.shearSubRight

variable {G}

namespace MeasureTheory

open Measure

section LeftInvariant

/-- The multiplicative shear mapping `(x, y) ↦ (x, xy)` preserves the measure `μ × ν`.
This condition is part of the definition of a measurable group in [Halmos, §59].
There, the map in this lemma is called `S`. -/
@[to_additive measure_preserving_prod_add
      " The shear mapping `(x, y) ↦ (x, x + y)` preserves the measure `μ × ν`. "]
theorem measurePreservingProdMul [IsMulLeftInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.1, z.1 * z.2)) (μ.Prod ν) (μ.Prod ν) :=
  (MeasurePreserving.id μ).skewProduct measurable_mul <|
    Filter.eventually_of_forall <| map_mul_left_eq_self ν
#align measure_theory.measure_preserving_prod_mul MeasureTheory.measurePreservingProdMul
#align measure_theory.measure_preserving_prod_add MeasureTheory.measure_preserving_prod_add

/-- The map `(x, y) ↦ (y, yx)` sends the measure `μ × ν` to `ν × μ`.
This is the map `SR` in [Halmos, §59].
`S` is the map `(x, y) ↦ (x, xy)` and `R` is `prod.swap`. -/
@[to_additive measure_preserving_prod_add_swap
      " The map `(x, y) ↦ (y, y + x)` sends the measure `μ × ν` to `ν × μ`. "]
theorem measurePreservingProdMulSwap [IsMulLeftInvariant μ] :
    MeasurePreserving (fun z : G × G => (z.2, z.2 * z.1)) (μ.Prod ν) (ν.Prod μ) :=
  (measurePreservingProdMul ν μ).comp measurePreservingSwap
#align measure_theory.measure_preserving_prod_mul_swap MeasureTheory.measurePreservingProdMulSwap
#align measure_theory.measure_preserving_prod_add_swap MeasureTheory.measure_preserving_prod_add_swap

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[to_additive]
theorem measurable_measure_mul_right (hs : MeasurableSet s) :
    Measurable fun x => μ ((fun y => y * x) ⁻¹' s) :=
  by
  suffices
    Measurable fun y =>
      μ ((fun x => (x, y)) ⁻¹' ((fun z : G × G => ((1 : G), z.1 * z.2)) ⁻¹' univ ×ˢ s))
    by
    convert this
    ext1 x
    congr 1 with y : 1
    simp
  apply measurable_measure_prod_mk_right
  exact measurable_const.prod_mk measurable_mul (measurable_set.univ.prod hs)
#align measure_theory.measurable_measure_mul_right MeasureTheory.measurable_measure_mul_right
#align measure_theory.measurable_measure_add_right MeasureTheory.measurable_measure_add_right

variable [HasMeasurableInv G]

/-- The map `(x, y) ↦ (x, x⁻¹y)` is measure-preserving.
This is the function `S⁻¹` in [Halmos, §59],
where `S` is the map `(x, y) ↦ (x, xy)`. -/
@[to_additive measure_preserving_prod_neg_add
      "The map `(x, y) ↦ (x, - x + y)` is measure-preserving."]
theorem measurePreservingProdInvMul [IsMulLeftInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.1, z.1⁻¹ * z.2)) (μ.Prod ν) (μ.Prod ν) :=
  (measurePreservingProdMul μ ν).symm <| MeasurableEquiv.shearMulRight G
#align measure_theory.measure_preserving_prod_inv_mul MeasureTheory.measurePreservingProdInvMul
#align measure_theory.measure_preserving_prod_neg_add MeasureTheory.measure_preserving_prod_neg_add

variable [IsMulLeftInvariant μ]

/-- The map `(x, y) ↦ (y, y⁻¹x)` sends `μ × ν` to `ν × μ`.
This is the function `S⁻¹R` in [Halmos, §59],
where `S` is the map `(x, y) ↦ (x, xy)` and `R` is `prod.swap`. -/
@[to_additive measure_preserving_prod_neg_add_swap
      "The map `(x, y) ↦ (y, - y + x)` sends `μ × ν` to `ν × μ`."]
theorem measurePreservingProdInvMulSwap :
    MeasurePreserving (fun z : G × G => (z.2, z.2⁻¹ * z.1)) (μ.Prod ν) (ν.Prod μ) :=
  (measurePreservingProdInvMul ν μ).comp measurePreservingSwap
#align measure_theory.measure_preserving_prod_inv_mul_swap MeasureTheory.measurePreservingProdInvMulSwap
#align measure_theory.measure_preserving_prod_neg_add_swap MeasureTheory.measure_preserving_prod_neg_add_swap

/-- The map `(x, y) ↦ (yx, x⁻¹)` is measure-preserving.
This is the function `S⁻¹RSR` in [Halmos, §59],
where `S` is the map `(x, y) ↦ (x, xy)` and `R` is `prod.swap`. -/
@[to_additive measure_preserving_add_prod_neg
      "The map `(x, y) ↦ (y + x, - x)` is measure-preserving."]
theorem measurePreservingMulProdInv [IsMulLeftInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.2 * z.1, z.1⁻¹)) (μ.Prod ν) (μ.Prod ν) :=
  by
  convert(measure_preserving_prod_inv_mul_swap ν μ).comp (measure_preserving_prod_mul_swap μ ν)
  ext1 ⟨x, y⟩
  simp_rw [Function.comp_apply, mul_inv_rev, inv_mul_cancel_right]
#align measure_theory.measure_preserving_mul_prod_inv MeasureTheory.measurePreservingMulProdInv
#align measure_theory.measure_preserving_add_prod_neg MeasureTheory.measure_preserving_add_prod_neg

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[to_additive]
theorem quasiMeasurePreservingInv : QuasiMeasurePreserving (Inv.inv : G → G) μ μ :=
  by
  refine' ⟨measurable_inv, absolutely_continuous.mk fun s hsm hμs => _⟩
  rw [map_apply measurable_inv hsm, inv_preimage]
  have hf : Measurable fun z : G × G => (z.2 * z.1, z.1⁻¹) :=
    (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv
  suffices map (fun z : G × G => (z.2 * z.1, z.1⁻¹)) (μ.prod μ) (s⁻¹ ×ˢ s⁻¹) = 0 by
    simpa only [(measure_preserving_mul_prod_inv μ μ).map_eq, prod_prod, mul_eq_zero,
      or_self_iff] using this
  have hsm' : MeasurableSet (s⁻¹ ×ˢ s⁻¹) := hsm.inv.prod hsm.inv
  simp_rw [map_apply hf hsm', prod_apply_symm (hf hsm'), preimage_preimage, mk_preimage_prod,
    inv_preimage, inv_inv, measure_mono_null (inter_subset_right _ _) hμs, lintegral_zero]
#align measure_theory.quasi_measure_preserving_inv MeasureTheory.quasiMeasurePreservingInv
#align measure_theory.quasi_measure_preserving_neg MeasureTheory.quasi_measure_preserving_neg

@[to_additive]
theorem measure_inv_null : μ s⁻¹ = 0 ↔ μ s = 0 :=
  by
  refine' ⟨fun hs => _, (quasi_measure_preserving_inv μ).preimage_null⟩
  rw [← inv_inv s]
  exact (quasi_measure_preserving_inv μ).preimage_null hs
#align measure_theory.measure_inv_null MeasureTheory.measure_inv_null
#align measure_theory.measure_neg_null MeasureTheory.measure_neg_null

@[to_additive]
theorem invAbsolutelyContinuous : μ.inv ≪ μ :=
  (quasiMeasurePreservingInv μ).AbsolutelyContinuous
#align measure_theory.inv_absolutely_continuous MeasureTheory.invAbsolutelyContinuous
#align measure_theory.neg_absolutely_continuous MeasureTheory.neg_absolutely_continuous

@[to_additive]
theorem absolutelyContinuousInv : μ ≪ μ.inv :=
  by
  refine' absolutely_continuous.mk fun s hs => _
  simp_rw [inv_apply μ s, measure_inv_null, imp_self]
#align measure_theory.absolutely_continuous_inv MeasureTheory.absolutelyContinuousInv
#align measure_theory.absolutely_continuous_neg MeasureTheory.absolutely_continuous_neg

@[to_additive]
theorem lintegral_lintegral_mul_inv [IsMulLeftInvariant ν] (f : G → G → ℝ≥0∞)
    (hf : AeMeasurable (uncurry f) (μ.Prod ν)) :
    (∫⁻ x, ∫⁻ y, f (y * x) x⁻¹ ∂ν ∂μ) = ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ :=
  by
  have h : Measurable fun z : G × G => (z.2 * z.1, z.1⁻¹) :=
    (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv
  have h2f : AeMeasurable (uncurry fun x y => f (y * x) x⁻¹) (μ.prod ν) :=
    hf.comp_quasi_measure_preserving (measure_preserving_mul_prod_inv μ ν).QuasiMeasurePreserving
  simp_rw [lintegral_lintegral h2f, lintegral_lintegral hf]
  conv_rhs => rw [← (measure_preserving_mul_prod_inv μ ν).map_eq]
  symm
  exact
    lintegral_map' (hf.mono' (measure_preserving_mul_prod_inv μ ν).map_eq.AbsolutelyContinuous)
      h.ae_measurable
#align measure_theory.lintegral_lintegral_mul_inv MeasureTheory.lintegral_lintegral_mul_inv
#align measure_theory.lintegral_lintegral_add_neg MeasureTheory.lintegral_lintegral_add_neg

@[to_additive]
theorem measure_mul_right_null (y : G) : μ ((fun x => x * y) ⁻¹' s) = 0 ↔ μ s = 0 :=
  calc
    μ ((fun x => x * y) ⁻¹' s) = 0 ↔ μ ((fun x => y⁻¹ * x) ⁻¹' s⁻¹)⁻¹ = 0 := by
      simp_rw [← inv_preimage, preimage_preimage, mul_inv_rev, inv_inv]
    _ ↔ μ s = 0 := by simp only [measure_inv_null μ, measure_preimage_mul]

#align measure_theory.measure_mul_right_null MeasureTheory.measure_mul_right_null
#align measure_theory.measure_add_right_null MeasureTheory.measure_add_right_null

@[to_additive]
theorem measure_mul_right_ne_zero (h2s : μ s ≠ 0) (y : G) : μ ((fun x => x * y) ⁻¹' s) ≠ 0 :=
  (not_congr (measure_mul_right_null μ y)).mpr h2s
#align measure_theory.measure_mul_right_ne_zero MeasureTheory.measure_mul_right_ne_zero
#align measure_theory.measure_add_right_ne_zero MeasureTheory.measure_add_right_ne_zero

@[to_additive]
theorem absolutelyContinuousMapMulRight (g : G) : μ ≪ map (· * g) μ :=
  by
  refine' absolutely_continuous.mk fun s hs => _
  rw [map_apply (measurable_mul_const g) hs, measure_mul_right_null]; exact id
#align measure_theory.absolutely_continuous_map_mul_right MeasureTheory.absolutelyContinuousMapMulRight
#align measure_theory.absolutely_continuous_map_add_right MeasureTheory.absolutely_continuous_map_add_right

@[to_additive]
theorem absolutelyContinuousMapDivLeft (g : G) : μ ≪ map (fun h => g / h) μ :=
  by
  simp_rw [div_eq_mul_inv]
  rw [← map_map (measurable_const_mul g) measurable_inv]
  conv_lhs => rw [← map_mul_left_eq_self μ g]
  exact (absolutely_continuous_inv μ).map (measurable_const_mul g)
#align measure_theory.absolutely_continuous_map_div_left MeasureTheory.absolutelyContinuousMapDivLeft
#align measure_theory.absolutely_continuous_map_sub_left MeasureTheory.absolutely_continuous_map_sub_left

/-- This is the computation performed in the proof of [Halmos, §60 Th. A]. -/
@[to_additive "This is the computation performed in the proof of [Halmos, §60 Th. A]."]
theorem measure_mul_lintegral_eq [IsMulLeftInvariant ν] (sm : MeasurableSet s) (f : G → ℝ≥0∞)
    (hf : Measurable f) : (μ s * ∫⁻ y, f y ∂ν) = ∫⁻ x, ν ((fun z => z * x) ⁻¹' s) * f x⁻¹ ∂μ :=
  by
  rw [← set_lintegral_one, ← lintegral_indicator _ sm, ←
    lintegral_lintegral_mul (measurable_const.indicator sm).AeMeasurable hf.ae_measurable, ←
    lintegral_lintegral_mul_inv μ ν]
  swap
  ·
    exact
      (((measurable_const.indicator sm).comp measurable_fst).mul
          (hf.comp measurable_snd)).AeMeasurable
  have ms :
    ∀ x : G, Measurable fun y => ((fun z => z * x) ⁻¹' s).indicator (fun z => (1 : ℝ≥0∞)) y :=
    fun x => measurable_const.indicator (measurable_mul_const _ sm)
  have :
    ∀ x y,
      s.indicator (fun z : G => (1 : ℝ≥0∞)) (y * x) =
        ((fun z => z * x) ⁻¹' s).indicator (fun b : G => 1) y :=
    by
    intro x y
    symm
    convert indicator_comp_right fun y => y * x
    ext1 z
    rfl
  simp_rw [this, lintegral_mul_const _ (ms _), lintegral_indicator _ (measurable_mul_const _ sm),
    set_lintegral_one]
#align measure_theory.measure_mul_lintegral_eq MeasureTheory.measure_mul_lintegral_eq
#align measure_theory.measure_add_lintegral_eq MeasureTheory.measure_add_lintegral_eq

/-- Any two nonzero left-invariant measures are absolutely continuous w.r.t. each other. -/
@[to_additive
      " Any two nonzero left-invariant measures are absolutely continuous w.r.t. each\nother. "]
theorem absolutelyContinuousOfIsMulLeftInvariant [IsMulLeftInvariant ν] (hν : ν ≠ 0) : μ ≪ ν :=
  by
  refine' absolutely_continuous.mk fun s sm hνs => _
  have h1 := measure_mul_lintegral_eq μ ν sm 1 measurable_one
  simp_rw [Pi.one_apply, lintegral_one, mul_one, (measure_mul_right_null ν _).mpr hνs,
    lintegral_zero, mul_eq_zero, measure_univ_eq_zero.not.mpr hν, or_false_iff] at h1
  exact h1
#align measure_theory.absolutely_continuous_of_is_mul_left_invariant MeasureTheory.absolutelyContinuousOfIsMulLeftInvariant
#align measure_theory.absolutely_continuous_of_is_add_left_invariant MeasureTheory.absolutely_continuous_of_is_add_left_invariant

@[to_additive]
theorem ae_measure_preimage_mul_right_lt_top [IsMulLeftInvariant ν] (sm : MeasurableSet s)
    (hμs : μ s ≠ ∞) : ∀ᵐ x ∂μ, ν ((fun y => y * x) ⁻¹' s) < ∞ :=
  by
  refine' ae_of_forall_measure_lt_top_ae_restrict' ν.inv _ _
  intro A hA h2A h3A
  simp only [ν.inv_apply] at h3A
  apply ae_lt_top (measurable_measure_mul_right ν sm)
  have h1 := measure_mul_lintegral_eq μ ν sm (A⁻¹.indicator 1) (measurable_one.indicator hA.inv)
  rw [lintegral_indicator _ hA.inv] at h1
  simp_rw [Pi.one_apply, set_lintegral_one, ← image_inv, indicator_image inv_injective, image_inv, ←
    indicator_mul_right _ fun x => ν ((fun y => y * x) ⁻¹' s), Function.comp, Pi.one_apply,
    mul_one] at h1
  rw [← lintegral_indicator _ hA, ← h1]
  exact ENNReal.mul_ne_top hμs h3A.ne
#align measure_theory.ae_measure_preimage_mul_right_lt_top MeasureTheory.ae_measure_preimage_mul_right_lt_top
#align measure_theory.ae_measure_preimage_add_right_lt_top MeasureTheory.ae_measure_preimage_add_right_lt_top

@[to_additive]
theorem ae_measure_preimage_mul_right_lt_top_of_ne_zero [IsMulLeftInvariant ν]
    (sm : MeasurableSet s) (h2s : ν s ≠ 0) (h3s : ν s ≠ ∞) :
    ∀ᵐ x ∂μ, ν ((fun y => y * x) ⁻¹' s) < ∞ :=
  by
  refine' (ae_measure_preimage_mul_right_lt_top ν ν sm h3s).filter_mono _
  refine' (absolutely_continuous_of_is_mul_left_invariant μ ν _).ae_le
  refine' mt _ h2s
  intro hν
  rw [hν, measure.coe_zero, Pi.zero_apply]
#align measure_theory.ae_measure_preimage_mul_right_lt_top_of_ne_zero MeasureTheory.ae_measure_preimage_mul_right_lt_top_of_ne_zero
#align measure_theory.ae_measure_preimage_add_right_lt_top_of_ne_zero MeasureTheory.ae_measure_preimage_add_right_lt_top_of_ne_zero

/-- A technical lemma relating two different measures. This is basically [Halmos, §60 Th. A].
  Note that if `f` is the characteristic function of a measurable set `t` this states that
  `μ t = c * μ s` for a constant `c` that does not depend on `μ`.

  Note: There is a gap in the last step of the proof in [Halmos].
  In the last line, the equality `g(x⁻¹)ν(sx⁻¹) = f(x)` holds if we can prove that
  `0 < ν(sx⁻¹) < ∞`. The first inequality follows from §59, Th. D, but the second inequality is
  not justified. We prove this inequality for almost all `x` in
  `measure_theory.ae_measure_preimage_mul_right_lt_top_of_ne_zero`. -/
@[to_additive
      "A technical lemma relating two different measures. This is basically\n[Halmos, §60 Th. A]. Note that if `f` is the characteristic function of a measurable set `t` this\nstates that `μ t = c * μ s` for a constant `c` that does not depend on `μ`.\n\nNote: There is a gap in the last step of the proof in [Halmos]. In the last line, the equality\n`g(-x) + ν(s - x) = f(x)` holds if we can prove that `0 < ν(s - x) < ∞`. The first inequality\nfollows from §59, Th. D, but the second inequality is not justified. We prove this inequality for\nalmost all `x` in `measure_theory.ae_measure_preimage_add_right_lt_top_of_ne_zero`."]
theorem measure_lintegral_div_measure [IsMulLeftInvariant ν] (sm : MeasurableSet s) (h2s : ν s ≠ 0)
    (h3s : ν s ≠ ∞) (f : G → ℝ≥0∞) (hf : Measurable f) :
    (μ s * ∫⁻ y, f y⁻¹ / ν ((fun x => x * y⁻¹) ⁻¹' s) ∂ν) = ∫⁻ x, f x ∂μ :=
  by
  set g := fun y => f y⁻¹ / ν ((fun x => x * y⁻¹) ⁻¹' s)
  have hg : Measurable g :=
    (hf.comp measurable_inv).div ((measurable_measure_mul_right ν sm).comp measurable_inv)
  simp_rw [measure_mul_lintegral_eq μ ν sm g hg, g, inv_inv]
  refine' lintegral_congr_ae _
  refine' (ae_measure_preimage_mul_right_lt_top_of_ne_zero μ ν sm h2s h3s).mono fun x hx => _
  simp_rw [ENNReal.mul_div_cancel' (measure_mul_right_ne_zero ν h2s _) hx.ne]
#align measure_theory.measure_lintegral_div_measure MeasureTheory.measure_lintegral_div_measure
#align measure_theory.measure_lintegral_sub_measure MeasureTheory.measure_lintegral_sub_measure

@[to_additive]
theorem measure_mul_measure_eq [IsMulLeftInvariant ν] {s t : Set G} (hs : MeasurableSet s)
    (ht : MeasurableSet t) (h2s : ν s ≠ 0) (h3s : ν s ≠ ∞) : μ s * ν t = ν s * μ t :=
  by
  have h1 :=
    measure_lintegral_div_measure ν ν hs h2s h3s (t.indicator fun x => 1)
      (measurable_const.indicator ht)
  have h2 :=
    measure_lintegral_div_measure μ ν hs h2s h3s (t.indicator fun x => 1)
      (measurable_const.indicator ht)
  rw [lintegral_indicator _ ht, set_lintegral_one] at h1 h2
  rw [← h1, mul_left_comm, h2]
#align measure_theory.measure_mul_measure_eq MeasureTheory.measure_mul_measure_eq
#align measure_theory.measure_add_measure_eq MeasureTheory.measure_add_measure_eq

/-- Left invariant Borel measures on a measurable group are unique (up to a scalar). -/
@[to_additive
      " Left invariant Borel measures on an additive measurable group are unique\n  (up to a scalar). "]
theorem measure_eq_div_smul [IsMulLeftInvariant ν] (hs : MeasurableSet s) (h2s : ν s ≠ 0)
    (h3s : ν s ≠ ∞) : μ = (μ s / ν s) • ν := by
  ext1 t ht
  rw [smul_apply, smul_eq_mul, mul_comm, ← mul_div_assoc, mul_comm,
    measure_mul_measure_eq μ ν hs ht h2s h3s, mul_div_assoc, ENNReal.mul_div_cancel' h2s h3s]
#align measure_theory.measure_eq_div_smul MeasureTheory.measure_eq_div_smul
#align measure_theory.measure_eq_sub_vadd MeasureTheory.measure_eq_sub_vadd

end LeftInvariant

section RightInvariant

@[to_additive measure_preserving_prod_add_right]
theorem measurePreservingProdMulRight [IsMulRightInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.1, z.2 * z.1)) (μ.Prod ν) (μ.Prod ν) :=
  (MeasurePreserving.id μ).skewProduct (measurable_snd.mul measurable_fst) <|
    Filter.eventually_of_forall <| map_mul_right_eq_self ν
#align measure_theory.measure_preserving_prod_mul_right MeasureTheory.measurePreservingProdMulRight
#align measure_theory.measure_preserving_prod_add_right MeasureTheory.measure_preserving_prod_add_right

/-- The map `(x, y) ↦ (y, xy)` sends the measure `μ × ν` to `ν × μ`. -/
@[to_additive measure_preserving_prod_add_swap_right
      " The map `(x, y) ↦ (y, x + y)` sends the measure `μ × ν` to `ν × μ`. "]
theorem measurePreservingProdMulSwapRight [IsMulRightInvariant μ] :
    MeasurePreserving (fun z : G × G => (z.2, z.1 * z.2)) (μ.Prod ν) (ν.Prod μ) :=
  (measurePreservingProdMulRight ν μ).comp measurePreservingSwap
#align measure_theory.measure_preserving_prod_mul_swap_right MeasureTheory.measurePreservingProdMulSwapRight
#align measure_theory.measure_preserving_prod_add_swap_right MeasureTheory.measure_preserving_prod_add_swap_right

/-- The map `(x, y) ↦ (xy, y)` preserves the measure `μ × ν`. -/
@[to_additive measure_preserving_add_prod
      " The map `(x, y) ↦ (x + y, y)` preserves the measure `μ × ν`. "]
theorem measurePreservingMulProd [IsMulRightInvariant μ] :
    MeasurePreserving (fun z : G × G => (z.1 * z.2, z.2)) (μ.Prod ν) (μ.Prod ν) :=
  measurePreservingSwap.comp <| by apply measure_preserving_prod_mul_swap_right μ ν
#align measure_theory.measure_preserving_mul_prod MeasureTheory.measurePreservingMulProd
#align measure_theory.measure_preserving_add_prod MeasureTheory.measure_preserving_add_prod

variable [HasMeasurableInv G]

/-- The map `(x, y) ↦ (x, y / x)` is measure-preserving. -/
@[to_additive measure_preserving_prod_sub "The map `(x, y) ↦ (x, y - x)` is measure-preserving."]
theorem measurePreservingProdDiv [IsMulRightInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.1, z.2 / z.1)) (μ.Prod ν) (μ.Prod ν) :=
  (measurePreservingProdMulRight μ ν).symm (MeasurableEquiv.shearDivRight G).symm
#align measure_theory.measure_preserving_prod_div MeasureTheory.measurePreservingProdDiv
#align measure_theory.measure_preserving_prod_sub MeasureTheory.measure_preserving_prod_sub

/-- The map `(x, y) ↦ (y, x / y)` sends `μ × ν` to `ν × μ`. -/
@[to_additive measure_preserving_prod_sub_swap
      "The map `(x, y) ↦ (y, x - y)` sends `μ × ν` to `ν × μ`."]
theorem measurePreservingProdDivSwap [IsMulRightInvariant μ] :
    MeasurePreserving (fun z : G × G => (z.2, z.1 / z.2)) (μ.Prod ν) (ν.Prod μ) :=
  (measurePreservingProdDiv ν μ).comp measurePreservingSwap
#align measure_theory.measure_preserving_prod_div_swap MeasureTheory.measurePreservingProdDivSwap
#align measure_theory.measure_preserving_prod_sub_swap MeasureTheory.measure_preserving_prod_sub_swap

/-- The map `(x, y) ↦ (x / y, y)` preserves the measure `μ × ν`. -/
@[to_additive measure_preserving_sub_prod
      " The map `(x, y) ↦ (x - y, y)` preserves the measure `μ × ν`. "]
theorem measurePreservingDivProd [IsMulRightInvariant μ] :
    MeasurePreserving (fun z : G × G => (z.1 / z.2, z.2)) (μ.Prod ν) (μ.Prod ν) :=
  measurePreservingSwap.comp <| by apply measure_preserving_prod_div_swap μ ν
#align measure_theory.measure_preserving_div_prod MeasureTheory.measurePreservingDivProd
#align measure_theory.measure_preserving_sub_prod MeasureTheory.measure_preserving_sub_prod

/-- The map `(x, y) ↦ (xy, x⁻¹)` is measure-preserving. -/
@[to_additive measure_preserving_add_prod_neg_right
      "The map `(x, y) ↦ (x + y, - x)` is measure-preserving."]
theorem measurePreservingMulProdInvRight [IsMulRightInvariant μ] [IsMulRightInvariant ν] :
    MeasurePreserving (fun z : G × G => (z.1 * z.2, z.1⁻¹)) (μ.Prod ν) (μ.Prod ν) :=
  by
  convert(measure_preserving_prod_div_swap ν μ).comp (measure_preserving_prod_mul_swap_right μ ν)
  ext1 ⟨x, y⟩
  simp_rw [Function.comp_apply, div_mul_eq_div_div_swap, div_self', one_div]
#align measure_theory.measure_preserving_mul_prod_inv_right MeasureTheory.measurePreservingMulProdInvRight
#align measure_theory.measure_preserving_add_prod_neg_right MeasureTheory.measure_preserving_add_prod_neg_right

end RightInvariant

section QuasiMeasurePreserving

variable [HasMeasurableInv G]

@[to_additive]
theorem quasiMeasurePreservingInvOfRightInvariant [IsMulRightInvariant μ] :
    QuasiMeasurePreserving (Inv.inv : G → G) μ μ :=
  by
  rw [← μ.inv_inv]
  exact
    (quasi_measure_preserving_inv μ.inv).mono (inv_absolutely_continuous μ.inv)
      (absolutely_continuous_inv μ.inv)
#align measure_theory.quasi_measure_preserving_inv_of_right_invariant MeasureTheory.quasiMeasurePreservingInvOfRightInvariant
#align measure_theory.quasi_measure_preserving_neg_of_right_invariant MeasureTheory.quasi_measure_preserving_neg_of_right_invariant

@[to_additive]
theorem quasiMeasurePreservingDivLeft [IsMulLeftInvariant μ] (g : G) :
    QuasiMeasurePreserving (fun h : G => g / h) μ μ :=
  by
  simp_rw [div_eq_mul_inv]
  exact
    (measure_preserving_mul_left μ g).QuasiMeasurePreserving.comp (quasi_measure_preserving_inv μ)
#align measure_theory.quasi_measure_preserving_div_left MeasureTheory.quasiMeasurePreservingDivLeft
#align measure_theory.quasi_measure_preserving_sub_left MeasureTheory.quasi_measure_preserving_sub_left

@[to_additive]
theorem quasiMeasurePreservingDivLeftOfRightInvariant [IsMulRightInvariant μ] (g : G) :
    QuasiMeasurePreserving (fun h : G => g / h) μ μ :=
  by
  rw [← μ.inv_inv]
  exact
    (quasi_measure_preserving_div_left μ.inv g).mono (inv_absolutely_continuous μ.inv)
      (absolutely_continuous_inv μ.inv)
#align measure_theory.quasi_measure_preserving_div_left_of_right_invariant MeasureTheory.quasiMeasurePreservingDivLeftOfRightInvariant
#align measure_theory.quasi_measure_preserving_sub_left_of_right_invariant MeasureTheory.quasi_measure_preserving_sub_left_of_right_invariant

@[to_additive]
theorem quasiMeasurePreservingDivOfRightInvariant [IsMulRightInvariant μ] :
    QuasiMeasurePreserving (fun p : G × G => p.1 / p.2) (μ.Prod ν) μ :=
  by
  refine' quasi_measure_preserving.prod_of_left measurable_div (eventually_of_forall fun y => _)
  exact (measure_preserving_div_right μ y).QuasiMeasurePreserving
#align measure_theory.quasi_measure_preserving_div_of_right_invariant MeasureTheory.quasiMeasurePreservingDivOfRightInvariant
#align measure_theory.quasi_measure_preserving_sub_of_right_invariant MeasureTheory.quasi_measure_preserving_sub_of_right_invariant

@[to_additive]
theorem quasiMeasurePreservingDiv [IsMulLeftInvariant μ] :
    QuasiMeasurePreserving (fun p : G × G => p.1 / p.2) (μ.Prod ν) μ :=
  (quasiMeasurePreservingDivOfRightInvariant μ.inv ν).mono
    ((absolutelyContinuousInv μ).Prod AbsolutelyContinuous.rfl) (invAbsolutelyContinuous μ)
#align measure_theory.quasi_measure_preserving_div MeasureTheory.quasiMeasurePreservingDiv
#align measure_theory.quasi_measure_preserving_sub MeasureTheory.quasi_measure_preserving_sub

/-- A *left*-invariant measure is quasi-preserved by *right*-multiplication.
This should not be confused with `(measure_preserving_mul_right μ g).quasi_measure_preserving`. -/
@[to_additive
      "A *left*-invariant measure is quasi-preserved by *right*-addition.\nThis should not be confused with `(measure_preserving_add_right μ g).quasi_measure_preserving`. "]
theorem quasiMeasurePreservingMulRight [IsMulLeftInvariant μ] (g : G) :
    QuasiMeasurePreserving (fun h : G => h * g) μ μ :=
  by
  refine' ⟨measurable_mul_const g, absolutely_continuous.mk fun s hs => _⟩
  rw [map_apply (measurable_mul_const g) hs, measure_mul_right_null]; exact id
#align measure_theory.quasi_measure_preserving_mul_right MeasureTheory.quasiMeasurePreservingMulRight
#align measure_theory.quasi_measure_preserving_add_right MeasureTheory.quasi_measure_preserving_add_right

/-- A *right*-invariant measure is quasi-preserved by *left*-multiplication.
This should not be confused with `(measure_preserving_mul_left μ g).quasi_measure_preserving`. -/
@[to_additive
      "A *right*-invariant measure is quasi-preserved by *left*-addition.\nThis should not be confused with `(measure_preserving_add_left μ g).quasi_measure_preserving`. "]
theorem quasiMeasurePreservingMulLeft [IsMulRightInvariant μ] (g : G) :
    QuasiMeasurePreserving (fun h : G => g * h) μ μ :=
  by
  have :=
    (quasi_measure_preserving_mul_right μ.inv g⁻¹).mono (inv_absolutely_continuous μ.inv)
      (absolutely_continuous_inv μ.inv)
  rw [μ.inv_inv] at this
  have :=
    (quasi_measure_preserving_inv_of_right_invariant μ).comp
      (this.comp (quasi_measure_preserving_inv_of_right_invariant μ))
  simp_rw [Function.comp, mul_inv_rev, inv_inv] at this
  exact this
#align measure_theory.quasi_measure_preserving_mul_left MeasureTheory.quasiMeasurePreservingMulLeft
#align measure_theory.quasi_measure_preserving_add_left MeasureTheory.quasi_measure_preserving_add_left

end QuasiMeasurePreserving

end MeasureTheory


import data.real.basic

variables a b c d : ℝ

#check mul_comm d c
#check mul_assoc d c a
#check two_mul d
#check two_mul (a + d)

-- BEGIN
/- The rewrite tactic affects only the goal. The notation rw t at h
applies the rewrite t at hypothesis h. -/

example (a b c d : ℝ) (h : c = d * a + b) (h' : b = a * d) :
  c = 2 * a * d :=
begin
  rw h' at h,
  rw mul_comm d a at h,
  rw ← two_mul (a * d) at h,
  rw ← mul_assoc 2 a d at h,
  exact h,
end
-- END