import incidence_world.level06 --hide
open IncidencePlane --hide

/- Axiom :
collinear_of_between : (A * B * C) → ∃ ℓ : Line Ω, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ
-/

/- Axiom :
between_of_collinear (h: ∃ (ℓ : Line Ω), A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ) : xor3 (A * B * C) ( B * A * C ) (A * C * B)
-/

/-
# Betweenness World

## Level 1: The axioms of order

Also called the axioms of betweenness, the axioms of order were formalized by David Hilbert (1862-1943 AD) on the occasion of studying the Euclid's `Elements`.
When it comes to them, there are up to four axioms of order. Their learning involves the definition of **segment**, **betweenness**, **line separation** and
**plane separation**, among others. In written mathematics, the notion of **betweenness** is represented by the **`*`** symbol. Now, let's take a look at the axioms of order.

**B.1)** If A ∗ B ∗ C, then A, B, C are three distinct points all lying on the same line, and C ∗ B ∗ A.

**B.2)** Given two distinct collinear points A and B, there is a third point C such that A * B * C.

**B.3)** Given 3 distinct collinear points A B C, exactly one of them is between the other two.

**B.4)** [This axiom will be learned in the following world.]

In Level 5 of Betweenness World, we will learn the definition of **segment**, which can be inferred from the first three axioms of order.

## The axioms of order in Lean

To solve the levels of this world, we may need to use the first three axioms of order. Because of this reason, they are presented right below in Lean format.

The first axiom of order is divided into three statements:

* `between_symmetric {A B C : Ω} : (A * B * C) ↔ (C * B * A)`

* `different_of_between {A B C : Ω} : (A * B * C) → (A ≠ B ∧ A ≠ C ∧ B ≠ C)`

* `collinear_of_between {A B C : Ω} : (A * B * C) → ∃ ℓ : Line Ω, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ`

The second axiom of order is represented as follows:

* `point_on_ray {A B : Ω} (h: A ≠ B) : ∃ (C : Ω), A * B * C`

To finish with, here it comes the third axiom of order in Lean:

* `between_of_collinear {A B C : Ω} (h: ∃(ℓ : Line Ω), A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ) : xor3 (A * B * C) ( B * A * C ) (A * C * B)`

Regarding this last axiom of order, you may be wondering what **xor3** means. This is a logic proposition that is defined as follows:

* `xor3 (p q r : Prop) : Prop := (p ∧ ¬ q ∧ ¬ r) ∨ (¬ p ∧ q ∧ ¬ r) ∨ (¬ p ∧ ¬ q ∧ r)`

[**Rule of thumb:** Whenever you see `xor3` in Lean, use the `unfold` tactic. In this way, it will be easier to understand what it means. If it is
located at the hypothesis `h2`, for example, then `unfold xor3 at h2,` will make progress. If it is located at the goal, then `unfold xor3,` will be enough
to rewrite the goal.]

## Let's solve this level!

To solve this level, you will need to use two axioms of order. Because of this reason, two theorem statements have been added to the list. Display the
box called "Betweenness World" to take a look at them. Try to think of a mathematical proof in paper before typing your solution in Lean. In case you
get stuck, click right below for a hint.

-/

/- Hint : Click here for a hint, in case you get stuck.
You can assume that exactly one point is between the other two by typing `have h2 : xor3 (A * B * C) ( B * A * C ) (A * C * B),`. Then, use the theorem
statements commented above to prove that `h2` is true. After that, remember the **rule of thumb** of this level. To finish with, the `tauto` tactic may
finish the proof. In case you want to see how to avoid the `tauto` tactic, click on "View source" (located on the top right
corner of the game screen).
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B C P Q R : Ω} --hide
variables {ℓ r s t : Line Ω} --hide

/- Lemma :
Given three distinct collinear points A, B and C, if B lies between A and C, then A does not lie between B and C.
-/
lemma not_between_of_between : (A * B * C) → ¬ (B * A * C) :=
begin

  intro h,
  have h2 : xor3 (A * B * C) ( B * A * C ) (A * C * B),
  {
    apply between_of_collinear,
    exact collinear_of_between h,
  },
  unfold xor3 at h2,
  cases h2 with hA hB,
  {
    exact hA.2.1,
  },
  cases hB with hB1 hB2,
  {
  exfalso,
  exact hB1.1 h,
  },
  exact hB2.2.1,

end


import .square_root

-- Checked over by:
-- Dan
-- Hans

/-
The goal of this file is to show that (T† T), the Gram operator of T, has a square root:
-/

variables {n : ℕ} (T : Lℂ^n)

open_locale big_operators complex_conjugate matrix

localized "postfix `†`:1000 := linear_map.adjoint" in src
namespace inner_product_space

/-
The Gram operator is self-adjoint
-/
lemma gram_sa :
  inner_product_space.is_self_adjoint (T† * T) :=
begin
  intros x y,
  rw [← linear_map.adjoint_inner_right, mul_adjoint, linear_map.adjoint_adjoint],
end

/-
The Gram operator is positive
-/
lemma gram_pos :
  is_positive (T† * T) :=
begin
  intro x,
  rw [linear_map.mul_apply, linear_map.adjoint_inner_left, inner_self_eq_norm_sq_to_K],
  norm_cast,
  exact ⟨ sq_nonneg (∥ T x ∥), rfl ⟩,
end

/-
The Gram operator has a square root
-/
lemma sqrt_gram_exists :
  ∃ (R : Lℂ^n), (R^2 = T† * T) ∧ (inner_product_space.is_self_adjoint R) ∧ (is_positive R) :=
    sqrt_exists (gram_sa _) (gram_pos _)

end inner_product_space


import kb_real_defs --hide

/-
# Chapter 1 : Sets

## Level 8
-/

/-
This is a very basic example of working with intervals of real numbers in Lean.
An interval `[a, b]` that is closed at both endpoints $a$ and $b$ can be
constructed using `set.Icc a b`. For an open-closed interval `(a, b]`,
the notation
is `set.Ioc a b`, etc. The usual closed-interval notation, using square
brackets, is used here as a wrapper around these definitions. We have
the following lemma:

```
mem_Icc_iff : x ∈ Icc a b ↔ a ≤ x ∧ x ≤ b
```
-/

/- Axiom : mem_Icc_iff :
x ∈ Icc a b ↔ a ≤ x ∧ x ≤ b
-/

/-
After rewriting it, the `split` tactic will isolate the two conditions for
membership. Each inequality goals can be solved with the `norm_num` tactic,
which closes goals which are equalities or inequalities between explicit
real numbers.
-/

/- Pro tip : semicolons
If instead of a comma, you end a line with a semicolon, then
Lean will apply the next tactic to all the goals created by the
previous tactic, rather than just the top one.
-/

/- Pro tip : definitional equality
`mem_Icc_iff` is true by definition, so you don't actually
have to even rewrite it.
-/

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

/- Lemma : no-side-bar
$2 ∈ [0,5]$
-/
example : (2 : ℝ) ∈ [(0 : ℝ), 5] :=
begin
    rw mem_Icc_iff,
    split;
    norm_num,
end

/-
rw mem_Icc_iff,
    split;
    norm_num,
-/


import mynat.definition -- hide
import mynat.add -- hide
import game.world2.level6 -- hide
namespace mynat -- hide

/- Axiom : succ_inj {a b : mynat} :
  succ(a) = succ(b) → a = b
-/

/-

# Advanced Addition World

## Level 1: `succ_inj`. A function.

Peano's original collection of axioms for the natural numbers contained two further
assumptions, which have not yet been mentioned in the game:

```
succ_inj {a b : mynat} :
  succ(a) = succ(b) → a = b

zero_ne_succ (a : mynat) :
  zero ≠ succ(a)
 ```

The reason they have not been used yet is that they are both implications,
that is,
of the form $P\implies Q$. This is clear for `succ_inj a b`, which
says that for all $a$ and $b$ we have $succ(a)=succ(b)\implies a=b$.
For `zero_ne_succ` the trick is that $X\ne Y$ is *defined to mean*
$X = Y\implies{\tt false}$. If you have played through Proposition world,
you now have the required Lean skills (i.e., you know the required
tactics) to work with these implications.
Let's finally learn how to use `succ_inj`. You should know a couple
of ways to prove the below -- one directly using an `exact`,
and one which uses an `apply` first. But either way you'll need to use `succ_inj`.
-/

/- Theorem : no-side-bar
For all naturals $a$ and $b$, if we assume $succ(a)=succ(b)$, then we can
deduce $a=b$.
-/
theorem succ_inj' {a b : mynat} (hs : succ(a) = succ(b)) :  a = b :=
begin [nat_num_game]
    exact succ_inj(hs),

end

/-
## Important thing.

You can rewrite proofs of *equalities*. If `h : A = B` then `rw h` changes `A`s to `B`s.
But you *cannot rewrite proofs of implications*. `rw succ_inj` will *never work*
because `succ_inj` isn't of the form $A = B$, it's of the form $A\implies B$. This is one
of the most common mistakes I see from beginners. $\implies$ and $=$ are *two different things*
and you need to be clear about which one you are using.
-/
end mynat -- hide


/-
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

/-!
# Conjuntos
-/

/- Definimos un tipo `Ω` y tres conjuntos `X`, `Y`, `Z` cuyos elementos son de tipo `Ω`.
  Para nuestro modelo mental, podemos pensar que estamos definiendo un conjunto `Ω` y tres
  subconjuntos `X`, `Y`, `Z` del mismo.
  Definimos también elementos `a, b, c, x, y, z` de `Ω`.
 -/
variables (Ω : Type) (X Y Z : set Ω) (a b c x y z : Ω)

-- Abrimos un `namespace` para evitar conflictos con los nombres.
namespace conjuntos

/-!

# Subconjuntos

El símbolo `⊆` se escribe mediante `\sub` o `\ss`
-/

-- `X ⊆ Y` significa `∀ a, a ∈ X → a ∈ Y`, por definición.

lemma subset_def : X ⊆ Y ↔ ∀ a, a ∈ X → a ∈ Y :=
begin
  refl -- por definición
end

lemma subset_refl : X ⊆ X :=
begin
  refl,
end

/- En este lema, tras empezar con `rw subset_def at *`, la hipótesis `hYZ` se transforma en
`hYZ : ∀ (a : Ω), a ∈ Y → a ∈ Z` (y similarmente para `hXY`).
Como `hYZ` es una implicación, una vez reducimos la meta a `a ∈ Z`, podemos avanzar en la
demostración utilizando `apply hYZ`.
Frecuentemente, también es útil pensar en `hYZ` como una función, que dados un término `a` de
tipo `Ω` y una demostración `haY` de que `a ∈ Y`, devuelve una demostración `haZ` de `a ∈ Z`.
-/
lemma subset_trans (hXY : X ⊆ Y) (hYZ : Y ⊆ Z) : X ⊆ Z :=
begin
  rw subset_def at *,
  intros a ha,
  apply hYZ,
  exact hXY a ha,
end

/-!
# Igualdad de conjuntos
Dos conjuntos son iguales si y sólo si tienen los mismos elementos.
En Lean, el nombre de este lema es `set.ext_iff`.
-/

example : X = Y ↔ (∀ a, a ∈ X ↔ a ∈ Y) :=
begin
  exact set.ext_iff
end

/- Cuando queremos reducir la meta `⊢ X = Y` a demostrar `a ∈ X ↔ a ∈ Y` para `a : Ω`
  arbitrario, utilizamos la táctica `ext`. -/

lemma subset.antisymm (hXY : X ⊆ Y) (hYX : Y ⊆ X) : X = Y :=
begin
  ext a,
  split,
  { apply hXY },
  { apply hYX }
end

/-!

### Uniones e intersecciones

Notación: `\cup` o `\un` para obtener `∪`, y `\cap` o `\i` para `∩`

-/

lemma union_def : a ∈ X ∪ Y ↔ a ∈ X ∨ a ∈ Y :=
begin
  refl,
end

lemma inter_def : a ∈ X ∩ Y ↔ a ∈ X ∧ a ∈ Y :=
begin
  refl,
end

/- Uniones. -/

lemma union_self : X ∪ X = X :=
begin
  ext x,
  rw union_def,
  /- Podríamos terminar con `rw or_self`, pero para practicar con otras prácticas, hagamos : -/
  split; -- Al terminar con `;`, la siguiente táctica se aplica a todas las metas.
  intro hX,
  { cases hX with hX hX;
    exact hX, },
  { left,
    exact hX }
end

lemma subset_union_left : X ⊆ X ∪ Y :=
begin
  intros x hx,
  rw union_def,
  left,
  exact hx,
end

lemma subset_union_right : Y ⊆ X ∪ Y :=
begin
  intros y hy,
  right,
  assumption,
end

lemma union_subset_iff : X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
begin
  split,
  { intro h,
    split,
    { intros x hx,
      apply h,
      exact subset_union_left Ω X Y hx },
    { intros y hy,
      apply h,
      right,
      assumption }},
  { rintros ⟨hXZ, hYZ⟩ a (haX | haY),
    { exact hXZ haX },
    { exact hYZ haY }}
end

variable (W : set Ω)

lemma union_subset_union (hWX : W ⊆ X) (hYZ : Y ⊆ Z) : W ∪ Y ⊆ X ∪ Z :=
begin
  rintros a (haW | haY),
  { left,
    exact hWX haW },
  { right,
    exact hYZ haY }
end

lemma union_subset_union_left (hXY : X ⊆ Y) : X ∪ Z ⊆ Y ∪ Z :=
begin
  apply union_subset_union,
  { exact hXY },
  { exact subset_refl Ω Z },
end

/- Intersecciones -/

lemma inter_subset_left : X ∩ Y ⊆ X :=
begin
  rintros x ⟨hxX, hxY⟩,
  exact hxX,
end

lemma inter_self : X ∩ X = X :=
begin
  ext x,
  split,
  { rintro ⟨hx, -⟩,
    exact hx, },
  { intro hx,
    exact ⟨hx, hx⟩ }
end

lemma inter_comm : X ∩ Y = Y ∩ X :=
begin
  ext,
  split,
  { rintro ⟨hX, hY⟩,
    exact ⟨hY, hX⟩, },
  { rintro ⟨hY, hX⟩,
    exact ⟨hX, hY⟩ }
end

lemma inter_assoc : X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z :=
begin
  ext,
  split,
  { rintro ⟨hX, ⟨hY, hZ⟩⟩,
    exact ⟨⟨hX, hY⟩, hZ⟩ },
  { rintro ⟨⟨hX, hY⟩, hZ⟩,
    exact ⟨hX, ⟨hY, hZ⟩⟩ },
end

/-!

### Para todo y existe

-/

lemma not_exists_iff_forall_not : ¬ (∃ a, a ∈ X) ↔ ∀ b, ¬ (b ∈ X) :=
begin
  split,
  { intros hX b hb,
    apply hX,
    use [b, hb], },
  { intros h1 h2,
    cases h2 with b hb,
    exact h1 b hb },
end

example : ¬ (∀ a, a ∈ X) ↔ ∃ b, ¬ (b ∈ X) :=
begin
  split,
  { intro hX,
    by_contra hnX,
    apply hX,
    intro a,
    by_contra ha,
    apply hnX,
    use a, },
  { rintro ⟨b, hb⟩ hX,
    exact hb (hX b), }
end

end conjuntos


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

import easy_mode.sheet07

/-

# A general way to produce equivalence relations

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

-/

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

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

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

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

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

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

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

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

/-

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

-/

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

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

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

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

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

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

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

/-

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

-/

def prod_rel {X Y : Type} (R : X → X → Prop) (S : Y → Y → Prop)
  (u v : X × Y) : Prop :=
R u.1 v.1 ∧ S u.2 v.2

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

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

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

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

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


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.multiset.basic
import data.list.range

/-! # `multiset.range n` gives `{0, 1, ..., n-1}` as a multiset. -/

open list nat

namespace multiset

/- range -/

/-- `range n` is the multiset lifted from the list `range n`,
  that is, the set `{0, 1, ..., n-1}`. -/
def range (n : ℕ) : multiset ℕ := range n

@[simp] theorem range_zero : range 0 = 0 := rfl

@[simp] theorem range_succ (n : ℕ) : range (succ n) = n ::ₘ range n :=
by rw [range, range_succ, ← coe_add, add_comm]; refl

@[simp] theorem card_range (n : ℕ) : card (range n) = n := length_range _

theorem range_subset {m n : ℕ} : range m ⊆ range n ↔ m ≤ n := range_subset

@[simp] theorem mem_range {m n : ℕ} : m ∈ range n ↔ m < n := mem_range

@[simp] theorem not_mem_range_self {n : ℕ} : n ∉ range n := not_mem_range_self

theorem self_mem_range_succ (n : ℕ) : n ∈ range (n + 1) := list.self_mem_range_succ n

end multiset


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

! This file was ported from Lean 3 source module algebra.char_p.algebra
! leanprover-community/mathlib commit 96782a2d6dcded92116d8ac9ae48efb41d46a27c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.CharP.Basic
import Mathlib.RingTheory.Localization.FractionRing
import Mathlib.Algebra.FreeAlgebra

/-!
# Characteristics of algebras

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

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

## Main results

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

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

-/

/-- If the algebra map `R →+* A` is injective then `A` has the same characteristic as `R`. -/
theorem charP_of_injective_algebraMap {R A : Type _} [CommSemiring R] [Semiring A] [Algebra R A]
    (h : Function.Injective (algebraMap R A)) (p : ℕ) [CharP R p] : CharP A p :=
  { cast_eq_zero_iff' := fun x => by
      rw [← CharP.cast_eq_zero_iff R p x]
      change algebraMap ℕ A x = 0 ↔ algebraMap ℕ R x = 0
      rw [IsScalarTower.algebraMap_apply ℕ R A x]
      refine' Iff.trans _ h.eq_iff
      rw [RingHom.map_zero] }
#align char_p_of_injective_algebra_map charP_of_injective_algebraMap

theorem charP_of_injective_algebraMap' (R A : Type _) [Field R] [Semiring A] [Algebra R A]
    [Nontrivial A] (p : ℕ) [CharP R p] : CharP A p :=
  charP_of_injective_algebraMap (algebraMap R A).injective p
#align char_p_of_injective_algebra_map' charP_of_injective_algebraMap'

/-- If the algebra map `R →+* A` is injective and `R` has characteristic zero then so does `A`. -/
theorem charZero_of_injective_algebraMap {R A : Type _} [CommSemiring R] [Semiring A] [Algebra R A]
    (h : Function.Injective (algebraMap R A)) [CharZero R] : CharZero A :=
  { cast_injective := fun x y hxy => by
      change algebraMap ℕ A x = algebraMap ℕ A y at hxy
      rw [IsScalarTower.algebraMap_apply ℕ R A x] at hxy
      rw [IsScalarTower.algebraMap_apply ℕ R A y] at hxy
      exact CharZero.cast_injective (h hxy) }
#align char_zero_of_injective_algebra_map charZero_of_injective_algebraMap

/-!
As an application, a `ℚ`-algebra has characteristic zero.
-/

-- `CharP.charP_to_charZero A _ (charP_of_injective_algebraMap h 0)` does not work
-- here as it would require `ring A`.
section QAlgebra

variable (R : Type _) [Nontrivial R]

/-- A nontrivial `ℚ`-algebra has `CharP` equal to zero.

This cannot be a (local) instance because it would immediately form a loop with the
instance `algebraRat`. It's probably easier to go the other way: prove `CharZero R` and
automatically receive an `Algebra ℚ R` instance.
-/
theorem algebraRat.charP_zero [Semiring R] [Algebra ℚ R] : CharP R 0 :=
  charP_of_injective_algebraMap (algebraMap ℚ R).injective 0
#align algebra_rat.char_p_zero algebraRat.charP_zero

/-- A nontrivial `ℚ`-algebra has characteristic zero.

This cannot be a (local) instance because it would immediately form a loop with the
instance `algebraRat`. It's probably easier to go the other way: prove `CharZero R` and
automatically receive an `Algebra ℚ R` instance.
-/
theorem algebraRat.charZero [Ring R] [Algebra ℚ R] : CharZero R :=
  @CharP.charP_to_charZero R _ (algebraRat.charP_zero R)
#align algebra_rat.char_zero algebraRat.charZero

end QAlgebra

/-!
An algebra over a field has the same characteristic as the field.
-/

section

variable (K L : Type _) [Field K] [CommSemiring L] [Nontrivial L] [Algebra K L]

theorem Algebra.charP_iff (p : ℕ) : CharP K p ↔ CharP L p :=
  (algebraMap K L).charP_iff_charP p
#align algebra.char_p_iff Algebra.charP_iff

theorem Algebra.ringChar_eq : ringChar K = ringChar L := by
  rw [ringChar.eq_iff, Algebra.charP_iff K L]
  apply ringChar.charP
#align algebra.ring_char_eq Algebra.ringChar_eq

end

namespace FreeAlgebra

variable {R X : Type _} [CommSemiring R] (p : ℕ)

/-- If `R` has characteristic `p`, then so does `FreeAlgebra R X`. -/
instance charP [CharP R p] : CharP (FreeAlgebra R X) p :=
  charP_of_injective_algebraMap FreeAlgebra.algebraMap_leftInverse.injective p
#align free_algebra.char_p FreeAlgebra.charP

/-- If `R` has characteristic `0`, then so does `FreeAlgebra R X`. -/
instance charZero [CharZero R] : CharZero (FreeAlgebra R X) :=
  charZero_of_injective_algebraMap FreeAlgebra.algebraMap_leftInverse.injective
#align free_algebra.char_zero FreeAlgebra.charZero

end FreeAlgebra

namespace IsFractionRing

variable (R : Type _) {K : Type _} [CommRing R] [Field K] [Algebra R K] [IsFractionRing R K]

variable (p : ℕ)

/-- If `R` has characteristic `p`, then so does Frac(R). -/
theorem charP_of_isFractionRing [CharP R p] : CharP K p :=
  charP_of_injective_algebraMap (IsFractionRing.injective R K) p
#align is_fraction_ring.char_p_of_is_fraction_ring IsFractionRing.charP_of_isFractionRing

/-- If `R` has characteristic `0`, then so does Frac(R). -/
theorem charZero_of_isFractionRing [CharZero R] : CharZero K :=
  @CharP.charP_to_charZero K _ (charP_of_isFractionRing R 0)
#align is_fraction_ring.char_zero_of_is_fraction_ring IsFractionRing.charZero_of_isFractionRing

variable [IsDomain R]

/-- If `R` has characteristic `p`, then so does `FractionRing R`. -/
instance charP [CharP R p] : CharP (FractionRing R) p :=
  charP_of_isFractionRing R p
#align is_fraction_ring.char_p IsFractionRing.charP

/-- If `R` has characteristic `0`, then so does `FractionRing R`. -/
instance charZero [CharZero R] : CharZero (FractionRing R) :=
  charZero_of_isFractionRing R
#align is_fraction_ring.char_zero IsFractionRing.charZero

end IsFractionRing


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

! This file was ported from Lean 3 source module algebra.category.Module.kernels
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Category.Module.EpiMono
import Mathbin.CategoryTheory.ConcreteCategory.Elementwise

/-!
# The concrete (co)kernels in the category of modules are (co)kernels in the categorical sense.
-/

open CategoryTheory

open CategoryTheory.Limits

universe u v

namespace ModuleCat

variable {R : Type u} [Ring R]

section

variable {M N : ModuleCat.{v} R} (f : M ⟶ N)

/-- The kernel cone induced by the concrete kernel. -/
def kernelCone : KernelFork f :=
  KernelFork.ofι (asHom f.ker.Subtype) <| by tidy
#align Module.kernel_cone ModuleCat.kernelCone

/-- The kernel of a linear map is a kernel in the categorical sense. -/
def kernelIsLimit : IsLimit (kernelCone f) :=
  Fork.IsLimit.mk _
    (fun s =>
      LinearMap.codRestrict f.ker (Fork.ι s) fun c =>
        LinearMap.mem_ker.2 <|
          by
          rw [← @Function.comp_apply _ _ _ f (fork.ι s) c, ← coe_comp, fork.condition,
            has_zero_morphisms.comp_zero (fork.ι s) N]
          rfl)
    (fun s => LinearMap.subtype_comp_codRestrict _ _ _) fun s m h =>
    LinearMap.ext fun x => Subtype.ext_iff_val.2 (by simpa [← h] )
#align Module.kernel_is_limit ModuleCat.kernelIsLimit

/-- The cokernel cocone induced by the projection onto the quotient. -/
def cokernelCocone : CokernelCofork f :=
  CokernelCofork.ofπ (asHom f.range.mkQ) <| LinearMap.range_mkQ_comp _
#align Module.cokernel_cocone ModuleCat.cokernelCocone

/-- The projection onto the quotient is a cokernel in the categorical sense. -/
def cokernelIsColimit : IsColimit (cokernelCocone f) :=
  Cofork.IsColimit.mk _
    (fun s =>
      f.range.liftQ (Cofork.π s) <| LinearMap.range_le_ker_iff.2 <| CokernelCofork.condition s)
    (fun s => f.range.liftQ_mkQ (Cofork.π s) _) fun s m h =>
    by
    haveI : epi (as_hom f.range.mkq) := (epi_iff_range_eq_top _).mpr (Submodule.range_mkQ _)
    apply (cancel_epi (as_hom f.range.mkq)).1
    convert h
    exact Submodule.liftQ_mkQ _ _ _
#align Module.cokernel_is_colimit ModuleCat.cokernelIsColimit

end

/-- The category of R-modules has kernels, given by the inclusion of the kernel submodule. -/
theorem hasKernels_moduleCat : HasKernels (ModuleCat R) :=
  ⟨fun X Y f => HasLimit.mk ⟨_, kernelIsLimit f⟩⟩
#align Module.has_kernels_Module ModuleCat.hasKernels_moduleCat

/-- The category or R-modules has cokernels, given by the projection onto the quotient. -/
theorem hasCokernels_moduleCat : HasCokernels (ModuleCat R) :=
  ⟨fun X Y f => HasColimit.mk ⟨_, cokernelIsColimit f⟩⟩
#align Module.has_cokernels_Module ModuleCat.hasCokernels_moduleCat

open ModuleCat

attribute [local instance] has_kernels_Module

attribute [local instance] has_cokernels_Module

variable {G H : ModuleCat.{v} R} (f : G ⟶ H)

/-- The categorical kernel of a morphism in `Module`
agrees with the usual module-theoretical kernel.
-/
noncomputable def kernelIsoKer {G H : ModuleCat.{v} R} (f : G ⟶ H) :
    kernel f ≅ ModuleCat.of R f.ker :=
  limit.isoLimitCone ⟨_, kernelIsLimit f⟩
#align Module.kernel_iso_ker ModuleCat.kernelIsoKer

-- We now show this isomorphism commutes with the inclusion of the kernel into the source.
@[simp, elementwise]
theorem kernelIsoKer_inv_kernel_ι : (kernelIsoKer f).inv ≫ kernel.ι f = f.ker.Subtype :=
  limit.isoLimitCone_inv_π _ _
#align Module.kernel_iso_ker_inv_kernel_ι ModuleCat.kernelIsoKer_inv_kernel_ι

@[simp, elementwise]
theorem kernelIsoKer_hom_ker_subtype : (kernelIsoKer f).hom ≫ f.ker.Subtype = kernel.ι f :=
  IsLimit.conePointUniqueUpToIso_inv_comp _ (limit.isLimit _) WalkingParallelPair.zero
#align Module.kernel_iso_ker_hom_ker_subtype ModuleCat.kernelIsoKer_hom_ker_subtype

/-- The categorical cokernel of a morphism in `Module`
agrees with the usual module-theoretical quotient.
-/
noncomputable def cokernelIsoRangeQuotient {G H : ModuleCat.{v} R} (f : G ⟶ H) :
    cokernel f ≅ ModuleCat.of R (H ⧸ f.range) :=
  colimit.isoColimitCocone ⟨_, cokernelIsColimit f⟩
#align Module.cokernel_iso_range_quotient ModuleCat.cokernelIsoRangeQuotient

-- We now show this isomorphism commutes with the projection of target to the cokernel.
@[simp, elementwise]
theorem cokernel_π_cokernelIsoRangeQuotient_hom :
    cokernel.π f ≫ (cokernelIsoRangeQuotient f).hom = f.range.mkQ := by
  convert colimit.iso_colimit_cocone_ι_hom _ _ <;> rfl
#align Module.cokernel_π_cokernel_iso_range_quotient_hom ModuleCat.cokernel_π_cokernelIsoRangeQuotient_hom

@[simp, elementwise]
theorem range_mkQ_cokernelIsoRangeQuotient_inv :
    ↿f.range.mkQ ≫ (cokernelIsoRangeQuotient f).inv = cokernel.π f := by
  convert colimit.iso_colimit_cocone_ι_inv ⟨_, cokernel_is_colimit f⟩ _ <;> rfl
#align Module.range_mkq_cokernel_iso_range_quotient_inv ModuleCat.range_mkQ_cokernelIsoRangeQuotient_inv

theorem cokernel_π_ext {M N : ModuleCat.{u} R} (f : M ⟶ N) {x y : N} (m : M) (w : x = y + f m) :
    cokernel.π f x = cokernel.π f y := by
  subst w
  simp
#align Module.cokernel_π_ext ModuleCat.cokernel_π_ext

end ModuleCat


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

! This file was ported from Lean 3 source module linear_algebra.clifford_algebra.star
! leanprover-community/mathlib commit 4d66277cfec381260ba05c68f9ae6ce2a118031d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.CliffordAlgebra.Conjugation

/-!
# Star structure on `clifford_algebra`

This file defines the "clifford conjugation", equal to `reverse (involute x)`, and assigns it the
`star` notation.

This choice is somewhat non-canonical; a star structure is also possible under `reverse` alone.
However, defining it gives us access to constructions like `unitary`.

Most results about `star` can be obtained by unfolding it via `clifford_algebra.star_def`.

## Main definitions

* `clifford_algebra.star_ring`

-/

variable {R : Type _} [CommRing R]

variable {M : Type _} [AddCommGroup M] [Module R M]

variable {Q : QuadraticForm R M}

namespace CliffordAlgebra

instance : StarRing (CliffordAlgebra Q)
    where
  unit x := reverse (involute x)
  star_involutive x := by
    simp only [reverse_involute_commute.eq, reverse_reverse, involute_involute]
  star_mul x y := by simp only [map_mul, reverse.map_mul]
  star_add x y := by simp only [map_add]

theorem star_def (x : CliffordAlgebra Q) : star x = reverse (involute x) :=
  rfl
#align clifford_algebra.star_def CliffordAlgebra.star_def

theorem star_def' (x : CliffordAlgebra Q) : star x = involute (reverse x) :=
  reverse_involute _
#align clifford_algebra.star_def' CliffordAlgebra.star_def'

@[simp]
theorem star_ι (m : M) : star (ι Q m) = -ι Q m := by rw [star_def, involute_ι, map_neg, reverse_ι]
#align clifford_algebra.star_ι CliffordAlgebra.star_ι

/-- Note that this not match the `star_smul` implied by `star_module`; it certainly could if we
also conjugated all the scalars, but there appears to be nothing in the literature that advocates
doing this. -/
@[simp]
theorem star_smul (r : R) (x : CliffordAlgebra Q) : star (r • x) = r • star x := by
  rw [star_def, star_def, map_smul, map_smul]
#align clifford_algebra.star_smul CliffordAlgebra.star_smul

@[simp]
theorem star_algebraMap (r : R) :
    star (algebraMap R (CliffordAlgebra Q) r) = algebraMap R (CliffordAlgebra Q) r := by
  rw [star_def, involute.commutes, reverse.commutes]
#align clifford_algebra.star_algebra_map CliffordAlgebra.star_algebraMap

end CliffordAlgebra


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

! This file was ported from Lean 3 source module category_theory.functor.reflects_isomorphisms
! leanprover-community/mathlib commit 32253a1a1071173b33dc7d6a218cf722c6feb514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Balanced
import Mathlib.CategoryTheory.Functor.EpiMono
import Mathlib.CategoryTheory.Functor.FullyFaithful

/-!
# Functors which reflect isomorphisms

A functor `F` reflects isomorphisms if whenever `F.map f` is an isomorphism, `f` was too.

It is formalized as a `Prop` valued typeclass `ReflectsIsomorphisms F`.

Any fully faithful functor reflects isomorphisms.
-/

open CategoryTheory CategoryTheory.Functor

namespace CategoryTheory

universe v₁ v₂ v₃ u₁ u₂ u₃

variable {C : Type u₁} [Category.{v₁} C]

section ReflectsIso

variable {D : Type u₂} [Category.{v₂} D]

variable {E : Type u₃} [Category.{v₃} E]

/-- Define what it means for a functor `F : C ⥤ D` to reflect isomorphisms: for any
morphism `f : A ⟶ B`, if `F.map f` is an isomorphism then `f` is as well.
Note that we do not assume or require that `F` is faithful.
-/
class ReflectsIsomorphisms (F : C ⥤ D) : Prop where
  /-- For any `f`, if `F.map f` is an iso, then so was `f`-/
  reflects : ∀ {A B : C} (f : A ⟶ B) [IsIso (F.map f)], IsIso f
#align category_theory.reflects_isomorphisms CategoryTheory.ReflectsIsomorphisms

/-- If `F` reflects isos and `F.map f` is an iso, then `f` is an iso. -/
theorem isIso_of_reflects_iso {A B : C} (f : A ⟶ B) (F : C ⥤ D) [IsIso (F.map f)]
    [ReflectsIsomorphisms F] : IsIso f :=
  ReflectsIsomorphisms.reflects F f
#align category_theory.is_iso_of_reflects_iso CategoryTheory.isIso_of_reflects_iso

instance (priority := 100) of_full_and_faithful (F : C ⥤ D) [Full F] [Faithful F] :
    ReflectsIsomorphisms F
    where reflects f i :=
    ⟨⟨F.preimage (inv (F.map f)), ⟨F.map_injective (by simp), F.map_injective (by simp)⟩⟩⟩
#align category_theory.of_full_and_faithful CategoryTheory.of_full_and_faithful

instance (F : C ⥤ D) (G : D ⥤ E) [ReflectsIsomorphisms F] [ReflectsIsomorphisms G] :
    ReflectsIsomorphisms (F ⋙ G) :=
  ⟨fun f (hf : IsIso (G.map _)) => by
    skip
    haveI := isIso_of_reflects_iso (F.map f) G
    exact isIso_of_reflects_iso f F⟩

instance (priority := 100) reflectsIsomorphisms_of_reflectsMonomorphisms_of_reflectsEpimorphisms
    [Balanced C] (F : C ⥤ D) [ReflectsMonomorphisms F] [ReflectsEpimorphisms F] :
    ReflectsIsomorphisms F where
  reflects f hf := by
    skip
    haveI : Epi f := epi_of_epi_map F inferInstance
    haveI : Mono f := mono_of_mono_map F inferInstance
    exact isIso_of_mono_of_epi f
#align category_theory.reflects_isomorphisms_of_reflects_monomorphisms_of_reflects_epimorphisms CategoryTheory.reflectsIsomorphisms_of_reflectsMonomorphisms_of_reflectsEpimorphisms

end ReflectsIso

end CategoryTheory


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark
-/
import algebra.order.with_zero
import data.polynomial.monic
/-!
# Lemmas for the interaction between polynomials and `∑` and `∏`.

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

Recall that `∑` and `∏` are notation for `finset.sum` and `finset.prod` respectively.

## Main results

- `polynomial.nat_degree_prod_of_monic` : the degree of a product of monic polynomials is the
  product of degrees. We prove this only for `[comm_semiring R]`,
  but it ought to be true for `[semiring R]` and `list.prod`.
- `polynomial.nat_degree_prod` : for polynomials over an integral domain,
  the degree of the product is the sum of degrees.
- `polynomial.leading_coeff_prod` : for polynomials over an integral domain,
  the leading coefficient is the product of leading coefficients.
- `polynomial.prod_X_sub_C_coeff_card_pred` carries most of the content for computing
  the second coefficient of the characteristic polynomial.
-/

open finset
open multiset

open_locale big_operators polynomial

universes u w

variables {R : Type u} {ι : Type w}

namespace polynomial

variables (s : finset ι)

section semiring

variables {S : Type*} [semiring S]

lemma nat_degree_list_sum_le (l : list S[X]) :
  nat_degree l.sum ≤ (l.map nat_degree).foldr max 0 :=
list.sum_le_foldr_max nat_degree (by simp) nat_degree_add_le _

lemma nat_degree_multiset_sum_le (l : multiset S[X]) :
  nat_degree l.sum ≤ (l.map nat_degree).foldr max max_left_comm 0 :=
quotient.induction_on l (by simpa using nat_degree_list_sum_le)

lemma nat_degree_sum_le (f : ι → S[X]) :
  nat_degree (∑ i in s, f i) ≤ s.fold max 0 (nat_degree ∘ f) :=
by simpa using nat_degree_multiset_sum_le (s.val.map f)

lemma degree_list_sum_le (l : list S[X]) :
  degree l.sum ≤ (l.map nat_degree).maximum :=
begin
  by_cases h : l.sum = 0,
  { simp [h] },
  { rw degree_eq_nat_degree h,
    suffices : (l.map nat_degree).maximum = ((l.map nat_degree).foldr max 0 : ℕ),
    { rw this,
      simpa [this] using nat_degree_list_sum_le l },
    rw ← list.foldr_max_of_ne_nil,
    { congr },
    contrapose! h,
    rw [list.map_eq_nil] at h,
    simp [h] }
end

lemma degree_list_prod_le (l : list S[X]) :
  degree l.prod ≤ (l.map degree).sum :=
begin
  induction l with hd tl IH,
  { simp },
  { simpa using (degree_mul_le _ _).trans (add_le_add_left IH _) }
end

lemma coeff_list_prod_of_nat_degree_le (l : list S[X]) (n : ℕ)
  (hl : ∀ p ∈ l, nat_degree p ≤ n) :
  coeff (list.prod l) (l.length * n) = (l.map (λ p, coeff p n)).prod :=
begin
  induction l with hd tl IH,
  { simp },
  { have hl' : ∀ (p ∈ tl), nat_degree p ≤ n := λ p hp, hl p (list.mem_cons_of_mem _ hp),
    simp only [list.prod_cons, list.map, list.length],
    rw [add_mul, one_mul, add_comm, ←IH hl', mul_comm tl.length],
    have h : nat_degree tl.prod ≤ n * tl.length,
    { refine (nat_degree_list_prod_le _).trans _,
      rw [←tl.length_map nat_degree, mul_comm],
      refine list.sum_le_card_nsmul _ _ _,
      simpa using hl' },
    have hdn : nat_degree hd ≤ n := hl _ (list.mem_cons_self _ _),
    rcases hdn.eq_or_lt with rfl|hdn',
    { cases h.eq_or_lt with h' h',
      { rw [←h', coeff_mul_degree_add_degree, leading_coeff, leading_coeff] },
      { rw [coeff_eq_zero_of_nat_degree_lt, coeff_eq_zero_of_nat_degree_lt h', mul_zero],
        exact nat_degree_mul_le.trans_lt (add_lt_add_left h' _) } },
    { rw [coeff_eq_zero_of_nat_degree_lt hdn', coeff_eq_zero_of_nat_degree_lt, zero_mul],
      exact nat_degree_mul_le.trans_lt (add_lt_add_of_lt_of_le hdn' h) } }
end

end semiring

section comm_semiring
variables [comm_semiring R] (f : ι → R[X]) (t : multiset R[X])

lemma nat_degree_multiset_prod_le :
  t.prod.nat_degree ≤ (t.map nat_degree).sum :=
quotient.induction_on t (by simpa using nat_degree_list_prod_le)

lemma nat_degree_prod_le : (∏ i in s, f i).nat_degree ≤ ∑ i in s, (f i).nat_degree :=
by simpa using nat_degree_multiset_prod_le (s.1.map f)

/--
The degree of a product of polynomials is at most the sum of the degrees,
where the degree of the zero polynomial is ⊥.
-/
lemma degree_multiset_prod_le :
  t.prod.degree ≤ (t.map polynomial.degree).sum :=
quotient.induction_on t (by simpa using degree_list_prod_le)

lemma degree_prod_le : (∏ i in s, f i).degree ≤ ∑ i in s, (f i).degree :=
by simpa only [multiset.map_map] using degree_multiset_prod_le (s.1.map f)

/--
The leading coefficient of a product of polynomials is equal to
the product of the leading coefficients, provided that this product is nonzero.

See `polynomial.leading_coeff_multiset_prod` (without the `'`) for a version for integral domains,
where this condition is automatically satisfied.
-/
lemma leading_coeff_multiset_prod' (h : (t.map leading_coeff).prod ≠ 0) :
  t.prod.leading_coeff = (t.map leading_coeff).prod :=
begin
  induction t using multiset.induction_on with a t ih, { simp },
  simp only [multiset.map_cons, multiset.prod_cons] at h ⊢,
  rw polynomial.leading_coeff_mul'; { rwa ih, apply right_ne_zero_of_mul h }
end

/--
The leading coefficient of a product of polynomials is equal to
the product of the leading coefficients, provided that this product is nonzero.

See `polynomial.leading_coeff_prod` (without the `'`) for a version for integral domains,
where this condition is automatically satisfied.
-/
lemma leading_coeff_prod' (h : ∏ i in s, (f i).leading_coeff ≠ 0) :
  (∏ i in s, f i).leading_coeff = ∏ i in s, (f i).leading_coeff :=
by simpa using leading_coeff_multiset_prod' (s.1.map f) (by simpa using h)

/--
The degree of a product of polynomials is equal to
the sum of the degrees, provided that the product of leading coefficients is nonzero.

See `polynomial.nat_degree_multiset_prod` (without the `'`) for a version for integral domains,
where this condition is automatically satisfied.
-/
lemma nat_degree_multiset_prod' (h : (t.map (λ f, leading_coeff f)).prod ≠ 0) :
  t.prod.nat_degree = (t.map (λ f, nat_degree f)).sum :=
begin
  revert h,
  refine multiset.induction_on t _ (λ a t ih ht, _), { simp },
  rw [multiset.map_cons, multiset.prod_cons] at ht ⊢,
  rw [multiset.sum_cons, polynomial.nat_degree_mul', ih],
  { apply right_ne_zero_of_mul ht },
  { rwa polynomial.leading_coeff_multiset_prod', apply right_ne_zero_of_mul ht },
end

/--
The degree of a product of polynomials is equal to
the sum of the degrees, provided that the product of leading coefficients is nonzero.

See `polynomial.nat_degree_prod` (without the `'`) for a version for integral domains,
where this condition is automatically satisfied.
-/
lemma nat_degree_prod' (h : ∏ i in s, (f i).leading_coeff ≠ 0) :
  (∏ i in s, f i).nat_degree = ∑ i in s, (f i).nat_degree :=
by simpa using nat_degree_multiset_prod' (s.1.map f) (by simpa using h)

lemma nat_degree_multiset_prod_of_monic (h : ∀ f ∈ t, monic f) :
  t.prod.nat_degree = (t.map nat_degree).sum :=
begin
  nontriviality R,
  apply nat_degree_multiset_prod',
  suffices : (t.map (λ f, leading_coeff f)).prod = 1, { rw this, simp },
  convert prod_replicate t.card (1 : R),
  { simp only [eq_replicate, multiset.card_map, eq_self_iff_true, true_and],
    rintros i hi,
    obtain ⟨i, hi, rfl⟩ := multiset.mem_map.mp hi,
    apply h, assumption },
  { simp }
end

lemma nat_degree_prod_of_monic (h : ∀ i ∈ s, (f i).monic) :
  (∏ i in s, f i).nat_degree = ∑ i in s, (f i).nat_degree :=
by simpa using nat_degree_multiset_prod_of_monic (s.1.map f) (by simpa using h)

lemma coeff_multiset_prod_of_nat_degree_le (n : ℕ)
  (hl : ∀ p ∈ t, nat_degree p ≤ n) :
  coeff t.prod (t.card * n) = (t.map (λ p, coeff p n)).prod :=
begin
  induction t using quotient.induction_on,
  simpa using coeff_list_prod_of_nat_degree_le _ _ hl
end

lemma coeff_prod_of_nat_degree_le (f : ι → R[X]) (n : ℕ)
  (h : ∀ p ∈ s, nat_degree (f p) ≤ n) :
  coeff (∏ i in s, f i) (s.card * n) = ∏ i in s, coeff (f i) n :=
begin
  cases s with l hl,
  convert coeff_multiset_prod_of_nat_degree_le (l.map f) _ _,
  { simp },
  { simp },
  { simpa using h }
end

lemma coeff_zero_multiset_prod :
  t.prod.coeff 0 = (t.map (λ f, coeff f 0)).prod :=
begin
  refine multiset.induction_on t _ (λ a t ht, _), { simp },
  rw [multiset.prod_cons, multiset.map_cons, multiset.prod_cons, polynomial.mul_coeff_zero, ht]
end

lemma coeff_zero_prod :
  (∏ i in s, f i).coeff 0 = ∏ i in s, (f i).coeff 0 :=
by simpa using coeff_zero_multiset_prod (s.1.map f)

end comm_semiring

section comm_ring
variables [comm_ring R]

open monic
-- Eventually this can be generalized with Vieta's formulas
-- plus the connection between roots and factorization.
lemma multiset_prod_X_sub_C_next_coeff (t : multiset R) :
  next_coeff (t.map (λ x, X - C x)).prod = -t.sum :=
begin
  rw next_coeff_multiset_prod,
  { simp only [next_coeff_X_sub_C],
    exact t.sum_hom (-add_monoid_hom.id R) },
  { intros, apply monic_X_sub_C }
end

lemma prod_X_sub_C_next_coeff {s : finset ι} (f : ι → R) :
  next_coeff ∏ i in s, (X - C (f i)) = -∑ i in s, f i :=
by simpa using multiset_prod_X_sub_C_next_coeff (s.1.map f)

lemma multiset_prod_X_sub_C_coeff_card_pred (t : multiset R) (ht : 0 < t.card) :
  (t.map (λ x, (X - C x))).prod.coeff (t.card - 1) = -t.sum :=
begin
  nontriviality R,
  convert multiset_prod_X_sub_C_next_coeff (by assumption),
  rw next_coeff, split_ifs,
  { rw nat_degree_multiset_prod_of_monic at h; simp only [multiset.mem_map] at *,
    swap, { rintros _ ⟨_, _, rfl⟩, apply monic_X_sub_C },
    simp_rw [multiset.sum_eq_zero_iff, multiset.mem_map] at h,
    contrapose! h,
    obtain ⟨x, hx⟩ := card_pos_iff_exists_mem.mp ht,
    exact ⟨_, ⟨_, ⟨x, hx, rfl⟩, nat_degree_X_sub_C _⟩, one_ne_zero⟩ },
  congr, rw nat_degree_multiset_prod_of_monic; { simp [nat_degree_X_sub_C, monic_X_sub_C] },
end

lemma prod_X_sub_C_coeff_card_pred (s : finset ι) (f : ι → R) (hs : 0 < s.card) :
  (∏ i in s, (X - C (f i))).coeff (s.card - 1) = - ∑ i in s, f i :=
by simpa using multiset_prod_X_sub_C_coeff_card_pred (s.1.map f) (by simpa using hs)

end comm_ring

section no_zero_divisors

section semiring
variables [semiring R] [no_zero_divisors R]

/--
The degree of a product of polynomials is equal to
the sum of the degrees, where the degree of the zero polynomial is ⊥.
`[nontrivial R]` is needed, otherwise for `l = []` we have `⊥` in the LHS and `0` in the RHS.
-/
lemma degree_list_prod [nontrivial R] (l : list R[X]) :
  l.prod.degree = (l.map degree).sum :=
map_list_prod (@degree_monoid_hom R _ _ _) l

end semiring

section comm_semiring
variables [comm_semiring R] [no_zero_divisors R] (f : ι → R[X]) (t : multiset R[X])

/--
The degree of a product of polynomials is equal to
the sum of the degrees.

See `polynomial.nat_degree_prod'` (with a `'`) for a version for commutative semirings,
where additionally, the product of the leading coefficients must be nonzero.
-/
lemma nat_degree_prod (h : ∀ i ∈ s, f i ≠ 0) :
  (∏ i in s, f i).nat_degree = ∑ i in s, (f i).nat_degree :=
begin
  nontriviality R,
  apply nat_degree_prod',
  rw prod_ne_zero_iff,
  intros x hx, simp [h x hx]
end

lemma nat_degree_multiset_prod (h : (0 : R[X]) ∉ t) :
  nat_degree t.prod = (t.map nat_degree).sum :=
begin
  nontriviality R,
  rw nat_degree_multiset_prod',
  simp_rw [ne.def, multiset.prod_eq_zero_iff, multiset.mem_map, leading_coeff_eq_zero],
  rintro ⟨_, h, rfl⟩,
  contradiction
end

/--
The degree of a product of polynomials is equal to
the sum of the degrees, where the degree of the zero polynomial is ⊥.
-/
lemma degree_multiset_prod [nontrivial R] :
  t.prod.degree = (t.map (λ f, degree f)).sum :=
map_multiset_prod (@degree_monoid_hom R _ _ _) _

/--
The degree of a product of polynomials is equal to
the sum of the degrees, where the degree of the zero polynomial is ⊥.
-/
lemma degree_prod [nontrivial R] : (∏ i in s, f i).degree = ∑ i in s, (f i).degree :=
map_prod (@degree_monoid_hom R _ _ _) _ _

/--
The leading coefficient of a product of polynomials is equal to
the product of the leading coefficients.

See `polynomial.leading_coeff_multiset_prod'` (with a `'`) for a version for commutative semirings,
where additionally, the product of the leading coefficients must be nonzero.
-/
lemma leading_coeff_multiset_prod :
  t.prod.leading_coeff = (t.map (λ f, leading_coeff f)).prod :=
by { rw [← leading_coeff_hom_apply, monoid_hom.map_multiset_prod], refl }

/--
The leading coefficient of a product of polynomials is equal to
the product of the leading coefficients.

See `polynomial.leading_coeff_prod'` (with a `'`) for a version for commutative semirings,
where additionally, the product of the leading coefficients must be nonzero.
-/
lemma leading_coeff_prod :
  (∏ i in s, f i).leading_coeff = ∏ i in s, (f i).leading_coeff :=
by simpa using leading_coeff_multiset_prod (s.1.map f)

end comm_semiring

end no_zero_divisors
end polynomial


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.convex.star
import analysis.normed_space.pointwise
import analysis.seminorm

/-!
# The Minkowksi functional

This file defines the Minkowski functional, aka gauge.

The Minkowski functional of a set `s` is the function which associates each point to how much you
need to scale `s` for `x` to be inside it. When `s` is symmetric, convex and absorbent, its gauge is
a seminorm. Reciprocally, any seminorm arises as the gauge of some set, namely its unit ball. This
induces the equivalence of seminorms and locally convex topological vector spaces.

## Main declarations

For a real vector space,
* `gauge`: Aka Minkowksi functional. `gauge s x` is the least (actually, an infimum) `r` such
  that `x ∈ r • s`.
* `gauge_seminorm`: The Minkowski functional as a seminorm, when `s` is symmetric, convex and
  absorbent.

## References

* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]

## Tags

Minkowski functional, gauge
-/

open normed_field set
open_locale pointwise

noncomputable theory

variables {E : Type*}

section add_comm_group
variables [add_comm_group E] [module ℝ E]

/--The Minkowski functional. Given a set `s` in a real vector space, `gauge s` is the functional
which sends `x : E` to the smallest `r : ℝ` such that `x` is in `s` scaled by `r`. -/
def gauge (s : set E) (x : E) : ℝ := Inf {r : ℝ | 0 < r ∧ x ∈ r • s}

variables {s t : set E} {a : ℝ} {x : E}

lemma gauge_def : gauge s x = Inf {r ∈ set.Ioi 0 | x ∈ r • s} := rfl

/-- An alternative definition of the gauge using scalar multiplication on the element rather than on
the set. -/
lemma gauge_def' : gauge s x = Inf {r ∈ set.Ioi 0 | r⁻¹ • x ∈ s} :=
begin
  unfold gauge,
  congr' 1,
  ext r,
  exact and_congr_right (λ hr, mem_smul_set_iff_inv_smul_mem₀ hr.ne' _ _),
end

private lemma gauge_set_bdd_below : bdd_below {r : ℝ | 0 < r ∧ x ∈ r • s} := ⟨0, λ r hr, hr.1.le⟩

/-- If the given subset is `absorbent` then the set we take an infimum over in `gauge` is nonempty,
which is useful for proving many properties about the gauge.  -/
lemma absorbent.gauge_set_nonempty (absorbs : absorbent ℝ s) :
  {r : ℝ | 0 < r ∧ x ∈ r • s}.nonempty :=
let ⟨r, hr₁, hr₂⟩ := absorbs x in ⟨r, hr₁, hr₂ r (real.norm_of_nonneg hr₁.le).ge⟩

lemma gauge_mono (hs : absorbent ℝ s) (h : s ⊆ t) : gauge t ≤ gauge s :=
λ x, cInf_le_cInf gauge_set_bdd_below hs.gauge_set_nonempty $ λ r hr, ⟨hr.1, smul_set_mono h hr.2⟩

lemma exists_lt_of_gauge_lt (absorbs : absorbent ℝ s) (h : gauge s x < a) :
  ∃ b, 0 < b ∧ b < a ∧ x ∈ b • s :=
begin
  obtain ⟨b, ⟨hb, hx⟩, hba⟩ := exists_lt_of_cInf_lt absorbs.gauge_set_nonempty h,
  exact ⟨b, hb, hba, hx⟩,
end

/-- The gauge evaluated at `0` is always zero (mathematically this requires `0` to be in the set `s`
but, the real infimum of the empty set in Lean being defined as `0`, it holds unconditionally). -/
@[simp] lemma gauge_zero : gauge s 0 = 0 :=
begin
  rw gauge_def',
  by_cases (0 : E) ∈ s,
  { simp only [smul_zero, sep_true, h, cInf_Ioi] },
  { simp only [smul_zero, sep_false, h, real.Inf_empty] }
end

@[simp] lemma gauge_zero' : gauge (0 : set E) = 0 :=
begin
  ext,
  rw gauge_def',
  obtain rfl | hx := eq_or_ne x 0,
  { simp only [cInf_Ioi, mem_zero, pi.zero_apply, eq_self_iff_true, sep_true, smul_zero] },
  { simp only [mem_zero, pi.zero_apply, inv_eq_zero, smul_eq_zero],
    convert real.Inf_empty,
    exact eq_empty_iff_forall_not_mem.2 (λ r hr, hr.2.elim (ne_of_gt hr.1) hx) }
end

@[simp] lemma gauge_empty : gauge (∅ : set E) = 0 :=
by { ext, simp only [gauge_def', real.Inf_empty, mem_empty_eq, pi.zero_apply, sep_false] }

lemma gauge_of_subset_zero (h : s ⊆ 0) : gauge s = 0 :=
by { obtain rfl | rfl := subset_singleton_iff_eq.1 h, exacts [gauge_empty, gauge_zero'] }

/-- The gauge is always nonnegative. -/
lemma gauge_nonneg (x : E) : 0 ≤ gauge s x := real.Inf_nonneg _ $ λ x hx, hx.1.le

lemma gauge_neg (symmetric : ∀ x ∈ s, -x ∈ s) (x : E) : gauge s (-x) = gauge s x :=
begin
  have : ∀ x, -x ∈ s ↔ x ∈ s := λ x, ⟨λ h, by simpa using symmetric _ h, symmetric x⟩,
  rw [gauge_def', gauge_def'],
  simp_rw [smul_neg, this],
end

lemma gauge_le_of_mem (ha : 0 ≤ a) (hx : x ∈ a • s) : gauge s x ≤ a :=
begin
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [mem_singleton_iff.1 (zero_smul_subset _ hx), gauge_zero] },
  { exact cInf_le gauge_set_bdd_below ⟨ha', hx⟩ }
end

lemma gauge_le_eq (hs₁ : convex ℝ s) (hs₀ : (0 : E) ∈ s) (hs₂ : absorbent ℝ s) (ha : 0 ≤ a) :
  {x | gauge s x ≤ a} = ⋂ (r : ℝ) (H : a < r), r • s :=
begin
  ext,
  simp_rw [set.mem_Inter, set.mem_set_of_eq],
  refine ⟨λ h r hr, _, λ h, le_of_forall_pos_lt_add (λ ε hε, _)⟩,
  { have hr' := ha.trans_lt hr,
    rw mem_smul_set_iff_inv_smul_mem₀ hr'.ne',
    obtain ⟨δ, δ_pos, hδr, hδ⟩ := exists_lt_of_gauge_lt hs₂ (h.trans_lt hr),
    suffices : (r⁻¹ * δ) • δ⁻¹ • x ∈ s,
    { rwa [smul_smul, mul_inv_cancel_right₀ δ_pos.ne'] at this },
    rw mem_smul_set_iff_inv_smul_mem₀ δ_pos.ne' at hδ,
    refine hs₁.smul_mem_of_zero_mem hs₀ hδ
      ⟨mul_nonneg (inv_nonneg.2 hr'.le) δ_pos.le, _⟩,
    rw [inv_mul_le_iff hr', mul_one],
    exact hδr.le },
  { have hε' := (lt_add_iff_pos_right a).2 (half_pos hε),
    exact (gauge_le_of_mem (ha.trans hε'.le) $ h _ hε').trans_lt
      (add_lt_add_left (half_lt_self hε) _) }
end

lemma gauge_lt_eq' (absorbs : absorbent ℝ s) (a : ℝ) :
  {x | gauge s x < a} = ⋃ (r : ℝ) (H : 0 < r) (H : r < a), r • s :=
begin
  ext,
  simp_rw [mem_set_of_eq, mem_Union, exists_prop],
  exact ⟨exists_lt_of_gauge_lt absorbs,
    λ ⟨r, hr₀, hr₁, hx⟩, (gauge_le_of_mem hr₀.le hx).trans_lt hr₁⟩,
end

lemma gauge_lt_eq (absorbs : absorbent ℝ s) (a : ℝ) :
  {x | gauge s x < a} = ⋃ (r ∈ set.Ioo 0 (a : ℝ)), r • s :=
begin
  ext,
  simp_rw [mem_set_of_eq, mem_Union, exists_prop, mem_Ioo, and_assoc],
  exact ⟨exists_lt_of_gauge_lt absorbs,
    λ ⟨r, hr₀, hr₁, hx⟩, (gauge_le_of_mem hr₀.le hx).trans_lt hr₁⟩,
end

lemma gauge_lt_one_subset_self (hs : convex ℝ s) (h₀ : (0 : E) ∈ s) (absorbs : absorbent ℝ s) :
  {x | gauge s x < 1} ⊆ s :=
begin
  rw gauge_lt_eq absorbs,
  refine set.Union₂_subset (λ r hr _, _),
  rintro ⟨y, hy, rfl⟩,
  exact hs.smul_mem_of_zero_mem h₀ hy (Ioo_subset_Icc_self hr),
end

lemma gauge_le_one_of_mem {x : E} (hx : x ∈ s) : gauge s x ≤ 1 :=
gauge_le_of_mem zero_le_one $ by rwa one_smul

lemma self_subset_gauge_le_one : s ⊆ {x | gauge s x ≤ 1} := λ x, gauge_le_one_of_mem

lemma convex.gauge_le (hs : convex ℝ s) (h₀ : (0 : E) ∈ s) (absorbs : absorbent ℝ s) (a : ℝ) :
  convex ℝ {x | gauge s x ≤ a} :=
begin
  by_cases ha : 0 ≤ a,
  { rw gauge_le_eq hs h₀ absorbs ha,
    exact convex_Inter (λ i, convex_Inter (λ hi, hs.smul _)) },
  { convert convex_empty,
    exact eq_empty_iff_forall_not_mem.2 (λ x hx, ha $ (gauge_nonneg _).trans hx) }
end

lemma balanced.star_convex (hs : balanced ℝ s) : star_convex ℝ 0 s :=
star_convex_zero_iff.2 $ λ x hx a ha₀ ha₁,
  hs _ (by rwa real.norm_of_nonneg ha₀) (smul_mem_smul_set hx)

lemma le_gauge_of_not_mem (hs₀ : star_convex ℝ 0 s) (hs₂ : absorbs ℝ s {x}) (hx : x ∉ a • s) :
  a ≤ gauge s x :=
begin
  rw star_convex_zero_iff at hs₀,
  obtain ⟨r, hr, h⟩ := hs₂,
  refine le_cInf ⟨r, hr, singleton_subset_iff.1 $ h _ (real.norm_of_nonneg hr.le).ge⟩ _,
  rintro b ⟨hb, x, hx', rfl⟩,
  refine not_lt.1 (λ hba, hx _),
  have ha := hb.trans hba,
  refine ⟨(a⁻¹ * b) • x, hs₀ hx' (mul_nonneg (inv_nonneg.2 ha.le) hb.le) _, _⟩,
  { rw ←div_eq_inv_mul,
    exact div_le_one_of_le hba.le ha.le },
  { rw [←mul_smul, mul_inv_cancel_left₀ ha.ne'] }
end

lemma one_le_gauge_of_not_mem (hs₁ : star_convex ℝ 0 s) (hs₂ : absorbs ℝ s {x}) (hx : x ∉ s) :
  1 ≤ gauge s x :=
le_gauge_of_not_mem hs₁ hs₂ $ by rwa one_smul

section linear_ordered_field
variables {α : Type*} [linear_ordered_field α] [mul_action_with_zero α ℝ] [ordered_smul α ℝ]

lemma gauge_smul_of_nonneg [mul_action_with_zero α E] [is_scalar_tower α ℝ (set E)] {s : set E}
  {a : α} (ha : 0 ≤ a) (x : E) :
  gauge s (a • x) = a • gauge s x :=
begin
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul, gauge_zero, zero_smul] },
  rw [gauge_def', gauge_def', ←real.Inf_smul_of_nonneg ha],
  congr' 1,
  ext r,
  simp_rw [set.mem_smul_set, set.mem_sep_eq],
  split,
  { rintro ⟨hr, hx⟩,
    simp_rw mem_Ioi at ⊢ hr,
    rw ←mem_smul_set_iff_inv_smul_mem₀ hr.ne' at hx,
    have := smul_pos (inv_pos.2 ha') hr,
    refine ⟨a⁻¹ • r, ⟨this, _⟩, smul_inv_smul₀ ha'.ne' _⟩,
    rwa [←mem_smul_set_iff_inv_smul_mem₀ this.ne', smul_assoc,
      mem_smul_set_iff_inv_smul_mem₀ (inv_ne_zero ha'.ne'), inv_inv] },
  { rintro ⟨r, ⟨hr, hx⟩, rfl⟩,
    rw mem_Ioi at ⊢ hr,
    rw ←mem_smul_set_iff_inv_smul_mem₀ hr.ne' at hx,
    have := smul_pos ha' hr,
    refine ⟨this, _⟩,
    rw [←mem_smul_set_iff_inv_smul_mem₀ this.ne', smul_assoc],
    exact smul_mem_smul_set hx }
end

/-- In textbooks, this is the homogeneity of the Minkowksi functional. -/
lemma gauge_smul [module α E] [is_scalar_tower α ℝ (set E)] {s : set E}
  (symmetric : ∀ x ∈ s, -x ∈ s) (r : α) (x : E) :
  gauge s (r • x) = abs r • gauge s x :=
begin
  rw ←gauge_smul_of_nonneg (abs_nonneg r),
  obtain h | h := abs_choice r,
  { rw h },
  { rw [h, neg_smul, gauge_neg symmetric] },
  { apply_instance }
end

lemma gauge_smul_left_of_nonneg [mul_action_with_zero α E] [smul_comm_class α ℝ ℝ]
  [is_scalar_tower α ℝ ℝ] [is_scalar_tower α ℝ E] {s : set E} {a : α} (ha : 0 ≤ a) :
  gauge (a • s) = a⁻¹ • gauge s :=
begin
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [inv_zero, zero_smul, gauge_of_subset_zero (zero_smul_subset _)] },
  ext,
  rw [gauge_def', pi.smul_apply, gauge_def', ←real.Inf_smul_of_nonneg (inv_nonneg.2 ha)],
  congr' 1,
  ext r,
  simp_rw [set.mem_smul_set, set.mem_sep_eq],
  split,
  { rintro ⟨hr, y, hy, h⟩,
    simp_rw [mem_Ioi] at ⊢ hr,
    refine ⟨a • r, ⟨smul_pos ha' hr, _⟩, inv_smul_smul₀ ha'.ne' _⟩,
    rwa [smul_inv₀, smul_assoc, ←h, inv_smul_smul₀ ha'.ne'] },
  { rintro ⟨r, ⟨hr, hx⟩, rfl⟩,
    rw mem_Ioi at ⊢ hr,
    have := smul_pos ha' hr,
    refine ⟨smul_pos (inv_pos.2 ha') hr, r⁻¹ • x, hx, _⟩,
    rw [smul_inv₀, smul_assoc, inv_inv] }
end

lemma gauge_smul_left [module α E] [smul_comm_class α ℝ ℝ] [is_scalar_tower α ℝ ℝ]
  [is_scalar_tower α ℝ E] {s : set E} (symmetric : ∀ x ∈ s, -x ∈ s) (a : α) :
  gauge (a • s) = |a|⁻¹ • gauge s :=
begin
  rw ←gauge_smul_left_of_nonneg (abs_nonneg a),
  obtain h | h := abs_choice a,
  { rw h },
  { rw [h, set.neg_smul_set, ←set.smul_set_neg],
    congr,
    ext y,
    refine ⟨symmetric _, λ hy, _⟩,
    rw ←neg_neg y,
    exact symmetric _ hy },
  { apply_instance }
end

end linear_ordered_field

section topological_space
variables [topological_space E] [has_continuous_smul ℝ E]

lemma interior_subset_gauge_lt_one (s : set E) : interior s ⊆ {x | gauge s x < 1} :=
begin
  intros x hx,
  let f : ℝ → E := λ t, t • x,
  have hf : continuous f,
  { continuity },
  let s' := f ⁻¹' (interior s),
  have hs' : is_open s' := hf.is_open_preimage _ is_open_interior,
  have one_mem : (1 : ℝ) ∈ s',
  { simpa only [s', f, set.mem_preimage, one_smul] },
  obtain ⟨ε, hε₀, hε⟩ := (metric.nhds_basis_closed_ball.1 _).1
    (is_open_iff_mem_nhds.1 hs' 1 one_mem),
  rw real.closed_ball_eq_Icc at hε,
  have hε₁ : 0 < 1 + ε := hε₀.trans (lt_one_add ε),
  have : (1 + ε)⁻¹ < 1,
  { rw inv_lt_one_iff,
    right,
    linarith },
  refine (gauge_le_of_mem (inv_nonneg.2 hε₁.le) _).trans_lt this,
  rw mem_inv_smul_set_iff₀ hε₁.ne',
  exact interior_subset
    (hε ⟨(sub_le_self _ hε₀.le).trans ((le_add_iff_nonneg_right _).2 hε₀.le), le_rfl⟩),
end

lemma gauge_lt_one_eq_self_of_open (hs₁ : convex ℝ s) (hs₀ : (0 : E) ∈ s) (hs₂ : is_open s) :
  {x | gauge s x < 1} = s :=
begin
  refine (gauge_lt_one_subset_self hs₁ ‹_› $ absorbent_nhds_zero $ hs₂.mem_nhds hs₀).antisymm _,
  convert interior_subset_gauge_lt_one s,
  exact hs₂.interior_eq.symm,
end

lemma gauge_lt_one_of_mem_of_open (hs₁ : convex ℝ s) (hs₀ : (0 : E) ∈ s) (hs₂ : is_open s)
  {x : E} (hx : x ∈ s) :
  gauge s x < 1 :=
by rwa ←gauge_lt_one_eq_self_of_open hs₁ hs₀ hs₂ at hx

lemma gauge_lt_of_mem_smul (x : E) (ε : ℝ) (hε : 0 < ε) (hs₀ : (0 : E) ∈ s)
  (hs₁ : convex ℝ s) (hs₂ : is_open s) (hx : x ∈ ε • s) :
  gauge s x < ε :=
begin
  have : ε⁻¹ • x ∈ s,
  { rwa ←mem_smul_set_iff_inv_smul_mem₀ hε.ne' },
  have h_gauge_lt := gauge_lt_one_of_mem_of_open hs₁ hs₀ hs₂ this,
  rwa [gauge_smul_of_nonneg (inv_nonneg.2 hε.le), smul_eq_mul, inv_mul_lt_iff hε, mul_one]
    at h_gauge_lt,
  apply_instance
end

end topological_space

lemma gauge_add_le (hs : convex ℝ s) (absorbs : absorbent ℝ s) (x y : E) :
  gauge s (x + y) ≤ gauge s x + gauge s y :=
begin
  refine le_of_forall_pos_lt_add (λ ε hε, _),
  obtain ⟨a, ha, ha', hx⟩ := exists_lt_of_gauge_lt absorbs
    (lt_add_of_pos_right (gauge s x) (half_pos hε)),
  obtain ⟨b, hb, hb', hy⟩ := exists_lt_of_gauge_lt absorbs
    (lt_add_of_pos_right (gauge s y) (half_pos hε)),
  rw mem_smul_set_iff_inv_smul_mem₀ ha.ne' at hx,
  rw mem_smul_set_iff_inv_smul_mem₀ hb.ne' at hy,
  suffices : gauge s (x + y) ≤ a + b,
  { linarith },
  have hab : 0 < a + b := add_pos ha hb,
  apply gauge_le_of_mem hab.le,
  have := convex_iff_div.1 hs hx hy ha.le hb.le hab,
  rwa [smul_smul, smul_smul, mul_comm_div', mul_comm_div', ←mul_div_assoc, ←mul_div_assoc,
    mul_inv_cancel ha.ne', mul_inv_cancel hb.ne', ←smul_add, one_div,
    ←mem_smul_set_iff_inv_smul_mem₀ hab.ne'] at this,
end

/-- `gauge s` as a seminorm when `s` is symmetric, convex and absorbent. -/
@[simps] def gauge_seminorm (hs₀ : ∀ x ∈ s, -x ∈ s) (hs₁ : convex ℝ s) (hs₂ : absorbent ℝ s) :
  seminorm ℝ E :=
{ to_fun := gauge s,
  smul' := λ r x, by rw [gauge_smul hs₀, real.norm_eq_abs, smul_eq_mul]; apply_instance,
  triangle' := gauge_add_le hs₁ hs₂ }

section gauge_seminorm
variables {hs₀ : ∀ x ∈ s, -x ∈ s} {hs₁ : convex ℝ s} {hs₂ : absorbent ℝ s}

section topological_space
variables [topological_space E] [has_continuous_smul ℝ E]

lemma gauge_seminorm_lt_one_of_open (hs : is_open s) {x : E} (hx : x ∈ s) :
  gauge_seminorm hs₀ hs₁ hs₂ x < 1 :=
gauge_lt_one_of_mem_of_open hs₁ hs₂.zero_mem hs hx

end topological_space
end gauge_seminorm

/-- Any seminorm arises as the gauge of its unit ball. -/
@[simp] protected lemma seminorm.gauge_ball (p : seminorm ℝ E) : gauge (p.ball 0 1) = p :=
begin
  ext,
  obtain hp | hp := {r : ℝ | 0 < r ∧ x ∈ r • p.ball 0 1}.eq_empty_or_nonempty,
  { rw [gauge, hp, real.Inf_empty],
    by_contra,
    have hpx : 0 < p x := (p.nonneg x).lt_of_ne h,
    have hpx₂ : 0 < 2 * p x := mul_pos zero_lt_two hpx,
    refine hp.subset ⟨hpx₂, (2 * p x)⁻¹ • x, _, smul_inv_smul₀ hpx₂.ne' _⟩,
    rw [p.mem_ball_zero, p.smul, real.norm_eq_abs, abs_of_pos (inv_pos.2 hpx₂), inv_mul_lt_iff hpx₂,
      mul_one],
    exact lt_mul_of_one_lt_left hpx one_lt_two },
  refine is_glb.cInf_eq ⟨λ r, _, λ r hr, le_of_forall_pos_le_add $ λ ε hε, _⟩ hp,
  { rintro ⟨hr, y, hy, rfl⟩,
    rw p.mem_ball_zero at hy,
    rw [p.smul, real.norm_eq_abs, abs_of_pos hr],
    exact mul_le_of_le_one_right hr.le hy.le },
  { have hpε : 0 < p x + ε := add_pos_of_nonneg_of_pos (p.nonneg _) hε,
    refine hr ⟨hpε, (p x + ε)⁻¹ • x, _, smul_inv_smul₀ hpε.ne' _⟩,
    rw [p.mem_ball_zero, p.smul, real.norm_eq_abs, abs_of_pos (inv_pos.2 hpε), inv_mul_lt_iff hpε,
      mul_one],
    exact lt_add_of_pos_right _ hε }
end

lemma seminorm.gauge_seminorm_ball (p : seminorm ℝ E) :
  gauge_seminorm (λ x, p.symmetric_ball_zero 1) (p.convex_ball 0 1)
    (p.absorbent_ball_zero zero_lt_one) = p := fun_like.coe_injective p.gauge_ball

end add_comm_group

section norm
variables [semi_normed_group E] [normed_space ℝ E] {s : set E} {r : ℝ} {x : E}

lemma gauge_unit_ball (x : E) : gauge (metric.ball (0 : E) 1) x = ∥x∥ :=
begin
  obtain rfl | hx := eq_or_ne x 0,
  { rw [norm_zero, gauge_zero] },
  refine (le_of_forall_pos_le_add $ λ ε hε, _).antisymm _,
  { have := add_pos_of_nonneg_of_pos (norm_nonneg x) hε,
    refine gauge_le_of_mem this.le _,
    rw [smul_ball this.ne', smul_zero, real.norm_of_nonneg this.le, mul_one, mem_ball_zero_iff],
    exact lt_add_of_pos_right _ hε },
  refine le_gauge_of_not_mem balanced_ball_zero.star_convex
    (absorbent_ball_zero zero_lt_one).absorbs (λ h, _),
  obtain hx' | hx' := eq_or_ne (∥x∥) 0,
  { rw hx' at h,
    exact hx (zero_smul_subset _ h) },
  { rw [mem_smul_set_iff_inv_smul_mem₀ hx', mem_ball_zero_iff, norm_smul, norm_inv, norm_norm,
      inv_mul_cancel hx'] at h,
    exact lt_irrefl _ h }
end

lemma gauge_ball (hr : 0 < r) (x : E) : gauge (metric.ball (0 : E) r) x = ∥x∥ / r :=
begin
  rw [←smul_unit_ball_of_pos hr, gauge_smul_left, pi.smul_apply, gauge_unit_ball, smul_eq_mul,
    abs_of_nonneg hr.le, div_eq_inv_mul],
  simp_rw [mem_ball_zero_iff, norm_neg],
  exact λ _, id,
end

lemma mul_gauge_le_norm (hs : metric.ball (0 : E) r ⊆ s) : r * gauge s x ≤ ∥x∥ :=
begin
  obtain hr | hr := le_or_lt r 0,
  { exact (mul_nonpos_of_nonpos_of_nonneg hr $ gauge_nonneg _).trans (norm_nonneg _) },
  rw [mul_comm, ←le_div_iff hr, ←gauge_ball hr],
  exact gauge_mono (absorbent_ball_zero hr) hs x,
end

end norm


-- use hints --hide
/-
## The setup
Welcome to Lean! You should see a different windows on this page, they will contain part of using Lean,
lets go through them one-by-one.

The middle one is where you tell Lean what steps you want to make in your proof.
By typing statements here in precise language we instruct Lean how we want the proof to go.
Right now this text is frozen, but at the bottom you will be able to type your first Lean
proof.

**Scroll down now and delete the word sorry from the box at the very bottom** this will
activate Lean for you so we can introduce the different components.
**Then scroll back up and carry on reading from here**.

On the right hand side you can see a window with `goal` at the top.
This panel represents what Lean thinks the current state of your proof is, most importantly
the facts and hypothesis you already know, and the statement (or statements) you are trying to show, these come after
the `⊢` symbol to make it clear which is which.
For example a valid state might look like
```
n : ℕ
h : is_even n
⊢ is_odd (n + 1)
```
which means that we have assumed `n` is a natural number and that `n` is even, and we are trying to show that `n + 1` is
odd.
In order to prove this we will need to use more than what is written here however, we might need the definition of
an even and an odd number, so in addition to the current hypotheses we also will make use of a library of lemmas that
we have proved so far.

Below this there will be more information about the word your cursor is currently on, and feedback about any errors
in your current proof.
As you move your cursor around by clicking different parts of the proof the goal will update, we can
always step backwards and forwards through the proof using the arrow keys to check what we were
proving before.
If you write some syntax Lean doesn't understand, or a proof step that doesn't make sense, Lean will
return an error in the bottom right, the most common error being `tactic failed, there are unsolved goals`
which just means that you aren't finished with the proof yet!

On the left of the screen you will find a list of *theorems* and *tactics* you can use to prove
results, this is here to remind you the things we've talked about so far.

Let's now discuss the language Lean uses to represent statements.

## The language

A lemma in Lean is written using a specific syntax, that is designed to look similar to written
mathematics, but is more restricted in how statements can be constructed.
Here is an example of a lemma statement in Lean:
-/

namespace boop --hide
lemma add_comm : ∀ (x : ℕ) (y : ℕ), x + y = y + x
:= nat.add_comm --hide

/-
This lemma states that for all natural numbers `x` and `y` that addition of `x` and `y` commutes,
hopefully you agree that this is a straightforward, but very useful fact!
Note the first word `lemma` is a keyword (highlighted in blue) and means we are stating a new
lemma.
The second word is simply a name we give to the lemma so we can refer to it later, naming lemmas
works much better than numbering lemmas when you need to refer back to many things.
This is especially helpful if you give the lemmas sensible names, so that you can remember them
later, and so that when you use them you can tell what the lemma does from its name.
In this case `add_comm` says that addition is commutative, so it seems like a pretty good choice.

The symbol `:` is used to say that `x` and `y` are natural numbers, this is similar to how we
normally write `x ∈ ℕ`, and you should think of `:` as meaning `∈`.
The symbol `:` is also used after the name of the lemma, and it has the same meaning!
Here within the lemma `x : ℕ` gives a name to a natural number and
`add_comm : ∀ x y, x + y = y + x` gives a name to the statement that addition is commutative.

The lemma `add_comm` is a "for all" statement, so in order to get the statement that addition
commutes for a _specific_ pair of natural numbers rather than variables `x` and `y`,
we place the naturals we want to refer to after the name,
for instance `add_comm 2 3` means `2 + 3 = 3 + 2`.
Here we used 2 and 3, but we could apply this lemma with variables too by using their names
instead of 2 and 3.

### Rewriting
Rewriting is one of the most basic methods of proof, we substitute one object we know equals another
inside what we want to prove, by doing this we can get closer to something that we already know to
be true,
or get to a point where things cancel out or simplify.

For example if `h` is a name for the fact that `X = Y`, then `rewrite h,` will change
all `X`s in the goal to `Y`s (the comma at the end is important, it tells Lean you are done
with one step of your proof).
On the left hand side in the tactics panel there is a dropdown with a lot more details about
`rewrite`, you don't need to read it now, but it's there if you ever want to check the syntax
again.

Now try to use a sequence of `rewrite` steps to prove the lemma below by typing them into the box
underneath, between the `begin` and `end` lines that tell Lean you are starting and finishing a
proof.

-/

/- Tactic : rewrite
## Summary

If `h` is a proof of `X = Y`, then `rewrite h,` will change
all `X`s in the goal to `Y`s.

As this is such a common proof step we also have a short name, `rw` instead of `rewrite` for this
step, to save us from too much typing.

Variants: `rw ← h` (type `←` using `\l` for left) changes
`Y` to `X` and
`rw h at h2` changes `X` to `Y` in hypothesis `h2` instead
of the goal.

## Details

The `rw` tactic is a way to do "substituting in". There
are two distinct situations where use this tactics.

1) If `h : A = B` is a hypothesis (i.e., a proof of `A = B`)
in your local context (the box in the top right)
and if your goal contains one or more `A`s, then `rw h`
will change them all to `B`'s.

2) The `rw` tactic will also work with proofs of theorems
which are equalities (look for them in the drop down
menu on the left, within Theorem Statements).

Important note: if `h` is not a proof of the form `A = B`
or `A ↔ B` (for example if `h` is a function, an implication,
or perhaps even a proposition itself rather than its proof),
then `rw` is not the tactic you want to use. For example,
`rw (P = Q)` is never correct: `P = Q` is the true-false
statement itself, not the proof.
If `h : P = Q` is its proof, then `rw h` will work.

Pro tip 1: If `h : A = B` and you want to change
`B`s to `A`s instead, try `rw ←h` (get the arrow with `\l`,
note that this is a small letter L, not a number 1).

### Example:
If it looks like this in the top right hand box:
```
A B C : set X
h : A = B ∪ C
⊢ A ∪ B = B ∪ C
```

then

`rw h,`

will change the goal into `⊢ B ∪ C ∪ B = B ∪ C`.

### Example:
You can use `rw` to change a hypothesis as well.
For example, if your local context looks like this:
```
A B C D : set X
h1 : A = B ∩ C
h2 : B ∪ A = D
⊢ D = B
```
then `rw h1 at h2` will turn `h2` into `h2 : B ∪ B ∩ C = D` (remember operator precedence).-/

/- Axiom : The commutativity of addition
add_comm : ∀ x y, x + y = y + x
-/

/- Hint : Click here for a hint, in case you get stuck.
Delete `sorry` and type `rewrite add_comm x y,` (don't forget the comma!).
That is the first step of the proof, after typing the comma you should see the goal (on the right)
change so the sides of the equation look closer to each other.
The next two steps of the proof go on the next lines, and are similar to the first, can you work
them out?
-/

/- Lemma : no-side-bar
-/
lemma level1 (x y z w : ℕ) : x + y + (z + w) = (w + z) + (y + x) :=
begin
  rw add_comm x y,
  rw add_comm w z,
  rw add_comm,

end
end boop --hide


theorem add_le_add_right {a b : mynat} : a ≤ b → ∀ t, (a + t) ≤ (b + t) :=
begin
intro h,
intro t,
induction t with d hd,
rw add_zero,
rw add_zero,
exact h,
rw add_succ,
rw add_succ,
apply succ_le_succ,
exact hd,
end


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

variables {A:Type} [has_mul A]

definition normalizes (a:A) (S:set A) : Prop := lcoset (A) (a) (S) = rcoset (A) (S) (a)

definition is_normal (S: set A) : Prop := ∀a, normalizes a S

definition normalizer (S : set A) : set A := { a : A | normalizes a S} --this definition will also work for subgroups!

definition is_normal_in (S T : set A) : Prop := T ⊆ normalizer S

lemma lcoset_eq_rcoset (a : A) (S : set A) (H : is_normal S) : lcoset (A) (a) (S) = rcoset (A) (S) (a) :=
begin
unfold is_normal at H, specialize H a, exact H,
end --this helps get a feel for these new definitions.

lemma lcoset_eq_rcoset_of_mem {a:A} (S:set A) {T:set A} (H : is_normal_in S T) (amemT : a ∈ T) : lcoset (A) (a) (S) = rcoset (A) (S) (a) :=
begin
unfold is_normal_in at H, specialize H amemT, exact H, --was curious if lean would understand this.
end


-- Razonamiento_sobre_arboles_binarios_Aplanamiento_e_imagen_especular.lean
-- Razonamiento sobre árboles binarios: Aplanamiento e imagen especular
-- José A. Alonso Jiménez
-- Sevilla, 13 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- El árbol correspondiente a
--        3
--       / \
--      2   4
--     / \
--    1   5
-- se puede representar por el término
--    nodo 3 (nodo 2 (hoja 1) (hoja 5)) (hoja 4)
-- usando el tipo de dato arbol definido por
--    inductive arbol (α : Type) : Type
--    | hoja : α → arbol
--    | nodo : α → arbol → arbol → arbol
--
-- La imagen especular del árbol anterior es
--      3
--     / \
--    4   2
--       / \
--      5   1
-- y la lista obtenida aplanándolo (recorriéndolo en orden infijo) es
--    [4, 3, 5, 2, 1]
--
-- La definición de la función que calcula la imagen especular es
--    def espejo : arbol α → arbol α
--    | (hoja x)     := hoja x
--    | (nodo x i d) := nodo x (espejo d) (espejo i)
-- y la que aplana el árbol es
--    def aplana : arbol α → list α
--    | (hoja x)     := [x]
--    | (nodo x i d) := (aplana i) ++ [x] ++ (aplana d)
--
-- Demostrar que
--    aplana (espejo a) = rev (aplana a)
-- ---------------------------------------------------------------------

import tactic
open list

variable {α : Type}

-- Para que no use la notación con puntos
set_option pp.structure_projections false

inductive arbol (α : Type) : Type
| hoja : α → arbol
| nodo : α → arbol → arbol → arbol

namespace arbol

variables (a i d : arbol α)
variable  (x : α)

def espejo : arbol α → arbol α
| (hoja x)     := hoja x
| (nodo x i d) := nodo x (espejo d) (espejo i)

@[simp]
lemma espejo_1 :
  espejo (hoja x) = hoja x :=
rfl

@[simp]
lemma espejo_2 :
  espejo (nodo x i d) = nodo x (espejo d) (espejo i) :=
rfl

def aplana : arbol α → list α
| (hoja x)     := [x]
| (nodo x i d) := (aplana i) ++ [x] ++ (aplana d)

@[simp]
lemma aplana_1 :
  aplana (hoja x) = [x] :=
rfl

@[simp]
lemma aplana_2 :
  aplana (nodo x i d) = (aplana i) ++ [x] ++ (aplana d) :=
rfl

-- 1ª demostración
example :
  aplana (espejo a) = reverse (aplana a) :=
begin
  induction a with x x i d Hi Hd,
  { rw espejo_1,
    rw aplana_1,
    rw reverse_singleton, },
  { rw espejo_2,
    rw aplana_2,
    rw [Hi, Hd],
    rw aplana_2,
    rw reverse_append,
    rw reverse_append,
    rw reverse_singleton,
    rw append_assoc, },
end

-- 2ª demostración
example :
  aplana (espejo a) = reverse (aplana a) :=
begin
  induction a with x x i d Hi Hd,
  { calc aplana (espejo (hoja x))
         = aplana (hoja x)
             : congr_arg aplana (espejo_1 x)
     ... = [x]
             : aplana_1 x
     ... = reverse [x]
             : reverse_singleton x
     ... = reverse (aplana (hoja x))
             : congr_arg reverse (aplana_1 x).symm, },
  { calc aplana (espejo (nodo x i d))
         = aplana (nodo x (espejo d) (espejo i))
             : congr_arg aplana (espejo_2 i d x)
     ... = (aplana (espejo d) ++ [x]) ++ aplana (espejo i)
             : aplana_2 (espejo d) (espejo i) x
     ... = (reverse (aplana d) ++ [x]) ++ aplana (espejo i)
             : congr_arg2 (++) (congr_arg2 (++) Hd rfl) rfl
     ... = (reverse (aplana d) ++ [x]) ++ reverse (aplana i)
             : congr_arg2 (++) rfl Hi
     ... = (reverse (aplana d) ++ reverse [x]) ++ reverse (aplana i)
             : congr_arg2 (++) (congr_arg2 (++) rfl (reverse_singleton x).symm) rfl
     ... = reverse ([x] ++ aplana d) ++ reverse (aplana i)
             : congr_arg2 (++) (reverse_append [x] (aplana d)).symm rfl
     ... = reverse (aplana i ++ ([x] ++ aplana d))
             : (reverse_append (aplana i) ([x] ++ aplana d)).symm
     ... = reverse ((aplana i ++ [x]) ++ aplana d)
             : congr_arg reverse (append_assoc (aplana i) [x] (aplana d)).symm
     ... = reverse (aplana (nodo x i d))
             : congr_arg reverse (aplana_2 i d x), },
end

-- 3ª demostración
example :
  aplana (espejo a) = reverse (aplana a) :=
begin
  induction a with x x i d Hi Hd,
  { calc aplana (espejo (hoja x))
         = aplana (hoja x)
             : by simp only [espejo_1]
     ... = [x]
             : by rw aplana_1
     ... = reverse [x]
             : by rw reverse_singleton
     ... = reverse (aplana (hoja x))
             : by simp only [aplana_1], },
  { calc aplana (espejo (nodo x i d))
         = aplana (nodo x (espejo d) (espejo i))
             : by simp only [espejo_2]
     ... = aplana (espejo d) ++ [x] ++ aplana (espejo i)
             : by rw aplana_2
     ... = reverse (aplana d) ++ [x] ++ reverse (aplana i)
             : by rw [Hi, Hd]
     ... = reverse (aplana d) ++ reverse [x] ++ reverse (aplana i)
             : by simp only [reverse_singleton]
     ... = reverse ([x] ++ aplana d) ++ reverse (aplana i)
             : by simp only [reverse_append]
     ... = reverse (aplana i ++ ([x] ++ aplana d))
             : by simp only [reverse_append]
     ... = reverse (aplana i ++ [x] ++ aplana d)
             : by simp only [append_assoc]
     ... = reverse (aplana (nodo x i d))
             : by simp only [aplana_2], },
end

-- 3ª demostración
example :
  aplana (espejo a) = reverse (aplana a) :=
begin
  induction a with x x i d Hi Hd,
  { calc aplana (espejo (hoja x))
         = aplana (hoja x)           : by simp
     ... = [x]                       : by simp
     ... = reverse [x]               : by simp
     ... = reverse (aplana (hoja x)) : by simp, },
  { calc aplana (espejo (nodo x i d))
         = aplana (nodo x (espejo d) (espejo i))
             : by simp
     ... = aplana (espejo d) ++ [x] ++ aplana (espejo i)
             : by simp
     ... = reverse (aplana d) ++ [x] ++ reverse (aplana i)
             : by simp [Hi, Hd]
     ... = reverse (aplana d) ++ reverse [x] ++ reverse (aplana i)
             : by simp
     ... = reverse ([x] ++ aplana d) ++ reverse (aplana i)
             : by simp
     ... = reverse (aplana i ++ ([x] ++ aplana d))
             : by simp
     ... = reverse (aplana i ++ [x] ++ aplana d)
             : by simp
     ... = reverse (aplana (nodo x i d))
             : by simp },
end

-- 5ª demostración
example :
  aplana (espejo a) = reverse (aplana a) :=
begin
  induction a with x x i d Hi Hd,
  { simp, },
  { calc aplana (espejo (nodo x i d))
         = reverse (aplana d) ++ [x] ++ reverse (aplana i)
             : by simp [Hi, Hd]
     ... = reverse (aplana (nodo x i d))
             : by simp },
end

-- 6ª demostración
example :
  aplana (espejo a) = reverse (aplana a) :=
begin
  induction a with x x i d Hi Hd,
  { simp, },
  { simp [Hi, Hd], },
end

-- 7ª demostración
example :
  aplana (espejo a) = reverse (aplana a) :=
by induction a ; simp [*]

-- 8ª demostración
example :
  aplana (espejo a) = reverse (aplana a) :=
arbol.rec_on a
  ( assume x,
    calc aplana (espejo (hoja x))
         = aplana (hoja x)
             : by simp only [espejo_1]
     ... = [x]
             : by rw aplana_1
     ... = reverse [x]
             : by rw reverse_singleton
     ... = reverse (aplana (hoja x))
             : by simp only [aplana_1])
  ( assume x i d,
    assume Hi : aplana (espejo i) = reverse (aplana i),
    assume Hd : aplana (espejo d) = reverse (aplana d),
    calc aplana (espejo (nodo x i d))
         = aplana (nodo x (espejo d) (espejo i))
             : by simp only [espejo_2]
     ... = aplana (espejo d) ++ [x] ++ aplana (espejo i)
             : by rw aplana_2
     ... = reverse (aplana d) ++ [x] ++ reverse (aplana i)
             : by rw [Hi, Hd]
     ... = reverse (aplana d) ++ reverse [x] ++ reverse (aplana i)
             : by simp only [reverse_singleton]
     ... = reverse ([x] ++ aplana d) ++ reverse (aplana i)
             : by simp only [reverse_append]
     ... = reverse (aplana i ++ ([x] ++ aplana d))
             : by simp only [reverse_append]
     ... = reverse (aplana i ++ [x] ++ aplana d)
             : by simp only [append_assoc]
     ... = reverse (aplana (nodo x i d))
             : by simp only [aplana_2])

-- 9ª demostración
example :
  aplana (espejo a) = reverse (aplana a) :=
arbol.rec_on a
  (λ x, by simp)
  (λ x i d Hi Hd, by simp [Hi, Hd])

-- 10ª demostración
lemma aplana_espejo :
  ∀ a : arbol α, aplana (espejo a) = reverse (aplana a)
| (hoja x)     := by simp
| (nodo x i d) := by simp [aplana_espejo i,
                           aplana_espejo d]

end arbol


namespace prop_logic

/-
This assignment has five problems. The first
is to extend our propositional logic syntax
and semantics to support the three additional
connectives, exclusive or (⊕), implies (which
we will write as ⇒), and if and only iff (↔).
We first give you the definitions developed
in class. You are to extend/modify them to
support expressions with the new connectives.
The remaining problems use this definition of
our language of expressions in propositional
logic.
-/

/-
1. Extend our syntax and semantics
for propositional logic to support
the xor, implies, and iff and only
iff connectives/operators.

A. Add support for the exclusive or
connective/operator. Define the symbol,
⊕, as an infix notation.

Here are specific steps to take for the
exclusive or connective, as an example.

1. Add new binary connective, xorOp
2. Add pXor as shorthand for binOpExp xorOp
3. Add ⊕ as an infix notation for pXor
4. Specify the interpretation of ⊕ to be bxor
5. Extend interpBinOp to handle the new case

Then add support for the implies connective,
using the symbol, ⇒, as an infix operator.
We can't use → because it's reserved by Lean
and cannot be overloaded. Lean does not have
a Boolean implies operator (analogous to bor),
so you will have to define one. Call it bimpl.

Finally add support for if and only iff. Use
the symbol ↔ as an infix notation. You will
have to define a Boolean function as Lean
does not provide one for iff. Call it biff.

Here is the code as developed in class.
Now review the step-by-step instructions,
and proceed to read and midify this logic
as required. We've bracketed areas where
new material will have to be added.
-/

/-    *** SYNTAX ***    -/

inductive var : Type
| mkVar : ℕ → var

inductive unOp : Type
| notOp

inductive binOp : Type
| andOp
| orOp

/-HW-/
-- add new binOps here
| xorOp
| impOp
| iffOp
/-HW-/

inductive pExp : Type
| litExp : bool → pExp
| varExp : var → pExp
| unOpExp : unOp → pExp → pExp
| binOpExp : binOp → pExp → pExp → pExp

open var
open pExp
open unOp
open binOp

-- Shorthand notations
def pTrue := litExp tt
def pFalse := litExp ff
def pNot := unOpExp notOp
def pAnd := binOpExp andOp
def pOr := binOpExp orOp

/-HW-/
-- Add new operator application
-- shorthands here.
-- Add pXor as shorthand for binOpExp xorOp
def pXor := binOpExp xorOp
def pImple := binOpExp impOp
def pIff := binOpExp iffOp
/-HW-/

-- conventional notation

notation e1 ∧ e2 :=  pAnd e1 e2
notation e1 ∨ e2 :=  pOr e1 e2
notation ¬ e := pNot e

/-HW-/
-- Add new notations here
-- Add ⊕ as an infix notation for pXor
notation e1 ⊕ e2 := pXor e1 e2
notation e1 ⇒ e2 := pImple e1 e2
notation e1 ↔ e2 := pIff e1 e2
/-HW-/

/-
    *****************
    *** SEMANTICS ***
    *****************
-/

def interpUnOp : unOp → (bool → bool)
| notOp := bnot

/-HW-/
-- Add Boolean function definitions here
-- Specify the interpretation of ⊕ to be bxor

def bimpl : bool → bool → bool
| tt tt := tt
| tt ff := ff
| ff tt := tt
| ff ff := tt

def biff : bool → bool → bool
| tt tt := tt
| tt ff := ff
| ff tt := ff
| ff ff := tt
/-HW-/

def interpBinOp : binOp → (bool → bool → bool)
| andOp := band
| orOp := bor
| xorOp := bxor
| impOp := bimpl
| iffOp := biff
/-HW-/
-- Add cases for new binOps here
-- Extend interpBinOp to handle the new case
/-HW-/

/-  *** SEMANTICS ***   -/

/-
Given a pExp and an interpretation
for the variables, compute and return
the Boolean value of the expression.
-/
def pEval : pExp → (var → bool) → bool
| (litExp b) i := b
| (varExp v) i := i v
| (unOpExp op e) i :=
    (interpUnOp op) (pEval e i)
| (binOpExp op e1 e2) i :=
     (interpBinOp op)
        (pEval e1 i)
        (pEval e2 i)

/-
Note: You are free to use pEval, if you
wish to, to check answers to some of the
questions below. It is not mandatory and
you will not be marked down for not doing
this.
-/

/-
#2. Define X, Y, and Z to be variable
expressions bound to a different variable
expression terms. Hint: Look at the
prop_logic_test.lean file to remind
yourself how we did this in class.
-/
def varX := mkVar 0
def varY := mkVar 1
def varZ := mkVar 2

def X : pExp:= varExp varX
def Y : pExp := varExp varY
def Z : pExp := varExp varZ

/-
#3. Here are some English language
sentences that you are to re-express
in propositional logic. Here's one
example.
-/

/-
EXAMPLE:

Formalize the following proposition,
as a formula in propositional logic:
If it's raining then it's raining.
-/

-- Use R to represent "it's raining"
def R : pExp := varExp (mkVar 4)

-- Solution here
def ex1 := R ⇒ R

/-
Explanation: We first choose to represent
the smaller proposition, "it's raining",
by the variable expression, R. We then
formalize the overall natural language
expression, if R then R, as the formula,
R ⇒ R.

Note: R ⇒ R can be pronounced as any of:
- if R is true then R is true
- if R then R
- the truth of R implies the truth of R
- R implies R

The second and fourth pronounciations
are the two that we prefer to use.
-/

/-
For the remaining problems, use the
variables expressions, X, Y, and Z,
as already defined. Use parentheses
if needed to group sub-expressions.
-/

/-
A.

If it's raining and the streets are
wet then it's raining.
-/

def p2 : pExp := (X ∧ Y) ⇒ X

/-
B. If it's raining and the streets
are wet, then the streets are wet
and it's raining.
-/

def p3 := (X ∧ Y) ⇒ (Y ∧ X)

/-
C. If it's raining then if the
streets are wet then it's raining
and the streets are wet.
-/
def p4 := X ⇒ (Y ⇒  (X ∧ Y))

/-
D. If it's raining then it's
raining or the moon is made of
green cheese.
-/
def p5 := X ⇒ (X ∨ Z)

/-
E. If it's raining, then if it's
raining implies that the streets
are wet, then the streets are wet.
-/
def p6 := X ⇒ (X ⇒ Y) ⇒ Y

/-
#4. For each of the propositional
logic expressions below, write a truth
table and based on your result, state
whether the expression is unsatisfiable,
satisfiable but not valid, or valid.

Here's an example solution for the
expression, (X ∧ Y) ⇒ Y.

X   Y   X ∧ Y   (X ∧ Y) ⇒ Y
-   -   -----   -----------
T   T   T       T
T   F   F       T
F   T   F       T
F   F   F       T
The proposition is valid.
-/

/-
A. After each "#check" give your
answer for the specified proposition.
That is, write a truth table in a
comment and then say whether given the
proposition is valid, satisfiable but
not valid, or unsatisifiable.

Note: This expression reqires that
you  have properly specified ¬ and
⇒ as notations in our pExp language.
The errors indicated in many of the
following lines will go away once
you have these notations properly
defined.
-/

#check (X ⇒ Y) ⇒ (¬ X ⇒ ¬ Y)

/-
-- Answer here
X   Y   X ⇒ Y ¬ X   ¬ Y       (¬ X ⇒ ¬ Y)  (X ⇒ Y) ⇒ (¬ X ⇒ ¬ Y)
-   -   -----   -     -        -----------   ----------------------
T   T   T       F     F        T                T
T   F   F       F     T        T                T
F   T   T       T     F        F                F
F   F   T       T     T        T                T
Satifiable
-/

/-
B.
-/
#check ((X ⇒ Y) ∧ (Y ⇒ X)) ⇒ (X ⇒ Z)

/-
-- Answer here

X   Y   X ⇒ Y  Y ⇒ X    (X ⇒ Y) ∧ (Y ⇒ X) Z    (X ⇒ Z) ((X ⇒ Y) ∧ (Y ⇒ X)) ⇒ (X ⇒ Z)
-   -   -----   -----    -----------------  -     -----   ----------------------------
T   T   T       T        T                  T      T          T
T   F   F       T        F                  F      F          T
F   T   T       F        F                  T      T          T
F   F   T       T        T                  F      T          T

Valid
-/

/-
C.
-/
#check pFalse ⇒ (X ∧ ¬ X)

/-
-- Answer here

pFalse   X   ¬ X    (X ∧ ¬ X)    pFalse ⇒(X ∧ ¬ X)
------   -   ---     -------     -----------------
F        T     F        F                T
F        F     T        F                T

Valid
-/

/-
D.≠
-/

#check pTrue ⇒(X ∧ ¬ X)

-- Answer here
/-
pTrue    X   ¬ X    (X ∧ ¬ X)    pFalse ⇒(X ∧ ¬ X)
------   -   ---     -------     -----------------
T        T     F        F                F
T        F     T        F                F

Unsatisfiable
-/

/-
E.
-/

#check (X ∨ Y) ∧ X ⇒ ¬ Y

-- Answer here
/-
X    Y   X ∨ Y    (X ∨ Y) ∧ X   ¬ Y    (X ∨ Y) ∧ X ⇒ ¬ Y
-    -   ------    ----------    --     ----------------
T    T    T         T             F      F
T    F    T         T             T      T
F    T    T         F             F      T
F    F    F         F             T      T

Satisfiable but not valid
-/

/-
#5.

A. Find and present an interpretation
that causes the following proposition
to be satisfied (to evaluate to true).

(X ∨ Y) ∧ (¬ Y ∨ Z)

Answer:

X   Y   X ∨ Y   ¬ Y   Z    ¬ Y ∨ Z    (X ∨ Y) ∧ (¬ Y ∨ Z)
-   -   -----   ---   -    -------     ------------------
T   T   T       F     T    T            T
T   F   T       T     T    T            T
F   T   T       F     F    F            F
F   F   F       T     F    T            F

The proposition will be true when X=T, Y=T, Z=T
B. Count and state how many of the
possible interpretations satisfy the
formula.

Answer;  2
-/

theorem prove_false_elim {pFalse : Prop}: false → pFalse :=
begin
    assume a,
    apply false.elim a,
end

end prop_logic


import .quantum_state
import data.complex.exponential

namespace quantum

variables {n m p q : ℕ}

-- measurement operators in are hermitian
def hermitian (U : matrix (fin n) (fin n) ℂ) : Prop :=
 U = U†

-- time evolution operators are usually unitary
def unitary (U : matrix (fin n) (fin n) ℂ) : Prop :=
 U† ⬝ U = 1

-- a weaker condition than unitary that may be useful
def normal (U : matrix (fin n) (fin n) ℂ) : Prop :=
 (U† ⬝ U) = (U ⬝ U†)

def Id : matrix (fin 2) (fin 2) ℂ :=
  ![![1, 0],
    ![0, 1]]

-- The pauli spin matrix in the x direction
def σ_x : matrix (fin 2) (fin 2) ℂ :=
 ![![0,  1],
   ![1, 0]]

-- The pauli spin matrix in the y direction
def σ_y : matrix (fin 2) (fin 2) ℂ :=
 ![![0,  -im],
   ![im, 0]]

-- The pauli spin matrix in the z direction
def σ_z : matrix (fin 2) (fin 2) ℂ :=
 ![![1,  0],
   ![0, -1]]

-- corresponds to measurement in z direction
lemma z_plus_eigenval_σ_z : σ_z ⬝ |z₊⟩ = |z₊⟩ :=
begin
  rw [σ_z, quantum.z_plus, matrix.mul],
  funext i j,
  simp,
end

lemma z_minus_eigenval_σ_z : σ_z ⬝ |z₋⟩ = -|z₋⟩ :=
begin
  rw [σ_z, quantum.z_minus, matrix.mul],
  funext i j,
  simp,
end

end quantum


def fun.im {A B : Type _} (f : A → B) := { b : B | ∃ a, f a = b }
def set.finite {T : Type _} (S : set T) := ∃ n (f : fin n → T), function.injective f ∧ (S = fun.im f)

def LEM := ∀ P : Prop, P ∨ ¬ P
def finite_subsets := ∀ {T : Type} {S S' : set T}, S ⊆ S' → set.finite S' → set.finite S

lemma zero_only_elem_fin_1 : ∀ x : fin 1, x = ⟨0,nat.zero_lt_one⟩
| ⟨0,   h⟩ := rfl
| ⟨n+1, h⟩ :=
  have 1 + n < 1 + 0,
  from nat.add_comm n 1 ▸ h,
  have n < 0,
  from nat.lt_of_add_lt_add_left this,
  absurd this (nat.not_lt_zero n)

theorem finite_subsets_are_finite_imp_LEM (fin_sub : finite_subsets) : LEM :=
λ P,
  let f1 : fin 1 → nat := λ _, 0 in
  have f1_i : ∀ x y, f1 x = f1 y → x = y,
  from λ x y _, eq.trans (zero_only_elem_fin_1 x)
              $ eq.symm $ zero_only_elem_fin_1 y,
  have f1_s.helper : ∀ x, (x = 0) ↔ (∃ k, f1 k = x),
  from λ x, iff.intro (λ h, eq.symm h ▸ ⟨⟨0, zero_lt_one⟩, rfl⟩)
                      (λ h, exists.elim h (λ _ h', eq.symm h')),
  have f1_s : { y : nat | y = 0 } = { b : ℕ | ∃ k, f1 k = b },
  from funext (λ x, propext $ f1_s.helper x),
  have h1 : set.finite { y : nat | y = 0 },
  from ⟨1, f1, f1_i, f1_s⟩,
  have h2 : {y : nat | y = 0 ∧ P} ⊆ { y : nat | y = 0 },
  from λ x h, h.left,
  have h3 : set.finite {y : nat | y = 0 ∧ P },
  from fin_sub h2 h1,
  have im_empty : ∀ (f : fin 0 → nat) x, fun.im f x → false,
  from λ f x h, exists.elim h $ λ a, fin.elim0 a,
  have neg_case : (∃ (f : fin 0 → nat), function.injective f ∧ {y : nat | y = 0 ∧ P} = fun.im f) → ¬P,
  from λ e, exists.elim e (λ f ⟨_, h⟩ hp, im_empty f 0 $ h ▸ ⟨rfl, hp⟩),
  have pos_case : ∀ k, 0 < k → (∃ (f : fin k → nat), function.injective f ∧ {y : nat | y = 0 ∧ P} = fun.im f) → P,
  from λ k hk e, exists.elim e $ λ f ⟨_, h⟩,
          have h' : fun.im f (f ⟨0, hk⟩),
          from ⟨⟨0, hk⟩, rfl⟩,
          have h'' : { y : nat | y = 0 ∧ P } (f ⟨0, hk⟩),
          from eq.symm h ▸ h',
          and.right h'',
  exists.elim h3 $
    λ k, match nat.decidable_eq 0 k with
         | is_true h := h ▸ λ x, or.inr $ neg_case x
         | is_false h :=
          have k_pos : 0 < k,
          from nat.pos_of_ne_zero (ne.symm h),
          λ x, or.inl $ pos_case k k_pos x
         end


import mynat.definition -- hide
import mynat.add -- hide
import game.world2.level4 -- hide
namespace mynat -- hide

/- Axiom : one_eq_succ_zero
1 = succ(0)
-/

/-

# Addition World

## Level 5: `succ_eq_add_one`

I've just added `one_eq_succ_zero` (a proof of `1 = succ(0)`) to your list of theorems; this is true
by definition of $1$, but we didn't need it until now.

Levels 5 and 6 are the two last levels in Addition World.
Level 5 involves the number $1$. When you see a $1$ in your goal,
you can write `rw one_eq_succ_zero` to get back
to something which only mentions `0`. This is a good move because $0$ is easier for us to
manipulate than $1$ right now, because we have
some theorems about $0$ (`zero_add`, `add_zero`), but, other than `1 = succ(0)`,
no theorems at all which mention $1$. Let's prove one now.
-/

/- Theorem
For any natural number $n$, we have
$$ \operatorname{succ}(n) = n+1. $$
-/
theorem succ_eq_add_one (n : mynat) : succ n = n + 1 :=
begin [nat_num_game]
  rw one_eq_succ_zero,
  rw add_succ,
  rw add_zero,
  refl,
end

end mynat -- hide


import data.real.basic

variables {x y : ℝ}

#check le_or_lt
#check @abs_of_neg
#check @abs_of_nonneg

-- BEGIN
example : x < abs y → x < y ∨ x < -y :=
begin
  cases le_or_gt 0 y with h1 h2,
  { rw abs_of_nonneg h1,
    intro h,
    left,
    exact h },
  rw abs_of_neg h2,
  intro h,
  right,
  exact h,
end
-- END


-- 5.8 Exercises
-- #1
-- Go back to the exercises in Chapter 3 and Chapter 4 and redo as many as you can now with tactic proofs,
-- using also rw and simp as appropriate.

-- 4.6 Exercises
-- #6
-- Give a calculational proof of the theorem log_mul below.

import data.real.basic

variables log exp     : real → real
variable  log_exp_eq : ∀ x, log (exp x) = x
variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
variable  exp_pos    : ∀ x, exp x > 0
variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

-- this ensures the assumptions are available in tactic proofs
include log_exp_eq exp_log_eq exp_pos exp_add

example (x y z : real) :
  exp (x + y + z) = exp x * exp y * exp z :=
by rw [exp_add, exp_add]

example (y : real) (h : y > 0)  : exp (log y) = y :=
exp_log_eq h

theorem log_mul {x y : real} (hx : x > 0) (hy : y > 0) :
  log (x * y) = log x + log y :=
calc
  log (x * y) = log ((exp (log x)) * y)             : by rw (exp_log_eq hx)
  ...         = log ((exp (log x)) * (exp (log y))) : by rw (exp_log_eq hy)
  ...         = log (exp ((log x) + (log y)))       : by rw exp_add
  ...         = (log x) + (log y)                   : by rw log_exp_eq