import data.list data.subtype data.sigma
open subtype list prod prod.ops sigma.ops

definition edge (V : Type) := V × V
definition graph (V : Type) := edge V → Prop

definition undirected {V : Type} (g : graph V) := ∀ (u v : V), g (u,v) → g (v,u)

namespace path

variables {V : Type} [V_decidable_eq : decidable_eq V]
include V_decidable_eq

definition path : graph V → V → V → Prop := sorry
definition repeated_edges {g : graph V} {u v : V} (p : path g u v) : Prop := sorry

definition simple_path (g : graph V) (u v : V) := { p : path g u v | ¬ repeated_edges p }

definition path_contains_edge {g : graph V} {u v : V} : path g u v → edge V → Prop := sorry

lemma simple_path_nonempty (g : graph V) (u v : V) (spath : simple_path g u v) : ∃ e, g e ∧ path_contains_edge (spath.1) e

definition cycle (g : graph V) (u : V) := path g u u

definition simple_cycle (g : graph V) := Σ (u : V) (p : cycle g u), ¬ repeated_edges p

variables {g : graph V}

theorem path_refl (g : graph V) : ∀ (v : V), path g v v := sorry
theorem path_symm (g : graph V) : ∀ {u v : V}, path g u v → path g v u := sorry
theorem path_trans (g : graph V) : ∀ {u v w : V}, path g u v → path g v w → path g u w := sorry

definition graph_connected (g : graph V) := ∀ (u v : V), path g u v

definition remove_edge (g : graph V) (e : edge V) : graph V := λ (f : edge V), if f.1 = e.1 ∧ f.2 = e.2 ∨ f.1 = e.2 ∧ f.2 = e.1 then false else g f

-- An undirected graph G is called k-edge-connected iff G is connected, and there is no set of k – 1 edges that can be removed from G that disconnects it
definition two_edge_connected (g : graph V) := graph_connected g ∧ ¬ ∃ (e1 e2 : edge V), g e1 ∧ g e2 ∧ ¬ graph_connected (remove_edge (remove_edge g e1) e2)

-- A bridge in a connected, undirected graph G is an edge in G that, if removed, disconnects G.
definition has_bridge (g : graph V) : Prop := graph_connected g ∧ ∃ (e : edge V), g e ∧ ¬ graph_connected (remove_edge g e)

-- Theorem: An undirected graph G is 2-edge-connected iff it is connected and has no bridges.
theorem two_edge_connected_iff (g : graph V) : two_edge_connected g ↔ graph_connected g ∧ ¬ has_bridge g := sorry

/- [KS]
Theorem: Let G = (V, E) be any graph containing a simple cycle C. Let u, v ∈ V be nodes in G. If
u ↔ v, then after deleting any single edge in C from graph G, it is still the case that u ↔ v.

Proof: Consider any graph G = (V, E) with a simple cycle C = (x1, x2, …, xn, x1). Consider any u, v ∈
V such that u ↔ v. This means that there must be some simple path (u, y1, y2, …, ym, v) from u to v.

Now, suppose that we remove the edge {xi, xi+1} from G.  We need to show that u ↔ v in this modified
graph. We consider two cases. First, it might be the case that the edge {xi, xi+1} does not appear
on the path (u, y1, …, ym, v). In that case, the path (u, y1, …, ym, v) is a valid path from u to v in the
new graph, so u ↔ v still holds.

Second, it might be the case that the edge {xi, xi+1} appears somewhere in our original path (u, y1, …,
ym, v). Since the graph is undirected, the edge might appear as {xi, xi+1} or as {xi+1, xi} when it occurs
in the path. Assume without loss of generality that it appears as {xi, xi+1} (otherwise, we can just reverse
the ordering of the nodes in the original cycle so as to relabel the edges). This means that we
can split the original path into three smaller paths – a path from u to xi, then the edge {xi, xi+1}, and finally
a path from xi+1 to v. Thus u ↔ xi and xi+1 ↔ v. Now, since the edge {xi, xi+1} lies on the cycle
C, after deleting the edge from the cycle, there is still a path from xi to xi+1. Specifically, we can follow
the edges of the cycle in reverse from xi until we reach xi+1. In other words, in this new graph, we
must have that xi ↔ xi+1.

Since in this new graph u ↔ xi, xi ↔ xi+1, and xi+1 ↔ v, we thus have that u ↔ v in the new graph, as
required.
-/

lemma path_imp_simple_path (g : graph V) : ∀ (u v : V), path g u v → simple_path g u v := sorry

theorem remove_edge_from_simple_cycle (g : graph V) (scycle : simple_cycle g) : ∀ (u v : V), path g u v → ∀ (e : edge V), g e → path (remove_edge g e) u v :=
  -- Proof: Consider any graph G = (V, E) with a simple cycle C = (x1, x2, …, xn, x1).
  -- Consider any u, v ∈ V such that u ↔ v.
  take (u v : V) (u_conn_v : path g u v),
  -- This means that there must be some simple path (u, y1, y2, …, ym, v) from u to v.
  have u_sconn_v : simple_path g u v, from path_imp_simple_path u_conn_v,
  -- Now, suppose that we remove the edge {xi, xi+1} from G.
  let G' := remove_edge g in

/-We need to show that u ↔ v in this modified
graph. We consider two cases. First, it might be the case that the edge {xi, xi+1} does not appear
on the path (u, y1, …, ym, v). In that case, the path (u, y1, …, ym, v) is a valid path from u to v in the
new graph, so u ↔ v still holds.
-/

end path


import data.real.basic
import data.real.sqrt

open set real

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    sqrt '' { x | x ≥ 0 } = {y | y ≥ 0}
-- ----------------------------------------------------------------------

example : sqrt '' { x | x ≥ 0 } = {y | y ≥ 0} :=
begin
  ext,
  split,
  { intro h,
    rcases h with ⟨y,hy,eq⟩,
    simp at *,
    rw ← eq,
    exact sqrt_nonneg y },
  { intro h,
    use x ^ 2,
    simp at *,
    split,
    { exact pow_nonneg h 2 },
    { finish }},
end

-- Prueba
-- ======

/-
⊢ sqrt '' {x : ℝ | x ≥ 0} = {y : ℝ | y ≥ 0}
  >> ext,
x : ℝ
⊢ x ∈ sqrt '' {x : ℝ | x ≥ 0} ↔ x ∈ {y : ℝ | y ≥ 0}
  >> split,
| x : ℝ
| ⊢ x ∈ sqrt '' {x : ℝ | x ≥ 0} → x ∈ {y : ℝ | y ≥ 0}
|   >> { intro h,
| h : x ∈ sqrt '' {x : ℝ | x ≥ 0}
| ⊢ x ∈ {y : ℝ | y ≥ 0}
|   >>   rcases h with ⟨y,hy,eq⟩,
| x y : ℝ,
| hy : y ∈ {x : ℝ | x ≥ 0},
| eq : y.sqrt = x
| ⊢ x ∈ {y : ℝ | y ≥ 0}
|   >>   simp at *,
| hy : 0 ≤ y
| ⊢ 0 ≤ x
|   >>   rw ← eq,
| ⊢ 0 ≤ y.sqrt
|   >>   exact sqrt_nonneg y },
x : ℝ
⊢ x ∈ {y : ℝ | y ≥ 0} → x ∈ sqrt '' {x : ℝ | x ≥ 0}
  >> { intro h,
h : x ∈ {y : ℝ | y ≥ 0}
⊢ x ∈ sqrt '' {x : ℝ | x ≥ 0}
  >>   use x ^ 2,
⊢ x ^ 2 ∈ {x : ℝ | x ≥ 0} ∧ (x ^ 2).sqrt = x
  >>   simp at *,
h : 0 ≤ x
⊢ 0 ≤ x ^ 2 ∧ (x ^ 2).sqrt = x
  >>   split,
| ⊢ 0 ≤ x ^ 2
|   >>   { exact pow_nonneg h 2 },
⊢ (x ^ 2).sqrt = x
  >>   { exact sqrt_sqr h }},
no goals
-/

-- Comentario: Se han usado los lemas
-- + x.sqrt_nonneg : 0 ≤ x.sqrt
-- + pow_nonneg : 0 ≤ x → ∀ (n : ℕ), 0 ≤ x ^ n

-- Comprobación:
-- variable (x : ℝ)
-- #check @sqrt_nonneg x
-- #check @pow_nonneg _ _ x

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    range (λ (x : ℝ), x^2) = {y | y ≥ 0} :=
-- ----------------------------------------------------------------------

example : range (λ (x : ℝ), x^2) = {y | y ≥ 0} :=
begin
  ext,
  split,
  { intro h,
    simp at *,
    rcases h with ⟨y,hy⟩,
    rw ← hy,
    exact pow_two_nonneg y },
  { intro h,
    use sqrt x,
    simp at *,
    by finish, },
end

-- Prueba
-- ======

/-
⊢ range (λ (x : ℝ), x ^ 2) = {y : ℝ | y ≥ 0}
  >> ext,
x : ℝ
⊢ x ∈ range (λ (x : ℝ), x ^ 2) ↔ x ∈ {y : ℝ | y ≥ 0}
  >> split,
| ⊢ x ∈ range (λ (x : ℝ), x ^ 2) → x ∈ {y : ℝ | y ≥ 0}
|   >> { intro h,
| h : x ∈ range (λ (x : ℝ), x ^ 2)
| ⊢ x ∈ {y : ℝ | y ≥ 0}
|   >>   simp at *,
| h : ∃ (y : ℝ), y ^ 2 = x
| ⊢ 0 ≤ x
|   >>   rcases h with ⟨y,hy⟩,
| x y : ℝ,
| hy : y ^ 2 = x
| ⊢ 0 ≤ x
|   >>   rw ← hy,
| ⊢ 0 ≤ y ^ 2
|   >>   exact pow_two_nonneg y },
x : ℝ
⊢ x ∈ {y : ℝ | y ≥ 0} → x ∈ range (λ (x : ℝ), x ^ 2)
  >> { intro h,
h : x ∈ {y : ℝ | y ≥ 0}
⊢ x ∈ range (λ (x : ℝ), x ^ 2)
  >>   use sqrt x,
⊢ (λ (x : ℝ), x ^ 2) x.sqrt = x
  >>   simp at *,
h : 0 ≤ x
⊢ x.sqrt ^ 2 = x
  >>   exact sqr_sqrt h },
no goals
-/

-- Comentario: Se han usado los lemas
-- + pow_two_nonneg x : 0 ≤ x ^ 2
-- + sqr_sqrt : 0 ≤ x → (sqrt x) ^ 2 = x

-- Comprobación:
-- #check @pow_two_nonneg _ _ x
-- #check @sqr_sqrt x


-- propositions
-- proofs
-- predicates
    -- sets
    -- relations
    -- equality
-- connectives
    -- not
    -- and
    -- or

-- proposition
inductive nifty_was_a_cat : Prop
-- proofs
| there_are_pictures_of_nifty
| we_remember_nifty_fondly
open nifty_was_a_cat

theorem nwac : nifty_was_a_cat := there_are_pictures_of_nifty
theorem there_is_a_natural_number : ℕ := 1

/-
-/

inductive pet : Type
| nifty -- a cat
| fido -- a dog
| cheese -- a rat
| tom -- a cat

open pet

-- predicate
inductive was_a_cat : pet → Prop
| nifty_proof : was_a_cat nifty
| tom_proof : was_a_cat tom

open was_a_cat

#check was_a_cat
#check (was_a_cat nifty)
#check (was_a_cat fido)
#check (was_a_cat cheese)
#check (was_a_cat tom)

theorem nwac' : was_a_cat nifty :=
    nifty_proof

#check nifty_proof
#check tom_proof

theorem cwac : was_a_cat cheese := _

/-
Property of a pet: that of having
been a cat. Some have it. Some don't
-/

/-
Set of pets: { nifty, tom }.
-/

/-
How might we assert that "nifty was
a cat AND cheese was a cat"? Each of
these claims is a proposition, in turn
an object of type Prop, and what we want
to build is a bigger proposition. Rather
than a one-off solution specific to the
given propositions, we'll create a way
to conjoin any two propositions into a
larger one, a conjunction. To build
one it is necessary and sufficient
to have proofs of each component
proposition.

We want a way to to build an AND
proposition based on any two smaller
component propositions. The type of
our proposition is Prop, and of the
smaller propositions, also Prop. So
we really need somthing of type
Prop → Prop → Prop. This is just a
Prop parameterized by two Props,
which we might call α and β. We
need a polymorphic type.

nifty YES
fido NO
cheese NO
tom YES
-/

#print and

namespace our_logic

/-
INTRODUCTION
Suppose α and β are propositions.
Given proofs, (a : α) and (b : β), we
can build a proof, (and.intro a b), of
α ∧ β.

Here are three ways to write exactly
the same inductive definition.
-/

inductive and'' (α β : Prop) : Prop
| intro : α → β → and''

-- Here we build a big prop out of two small ones
def nwac_and_cwac : Prop :=
    and'' (was_a_cat nifty) (was_a_cat cheese)

-- Here we try to construct a proof of the big prop
def pf : nwac_and_cwac :=
    and''.intro nifty_proof _

-- Here we succeed in constructing a proof of it
def pf2 :
    and'' (was_a_cat nifty) (was_a_cat tom) :=
        and''.intro nifty_proof tom_proof

-- The proposition is a (logical) type (of type Prop)
#check and'' (was_a_cat nifty) (was_a_cat tom)
-- The proof of it is a *value* of its logical type
#check  and''.intro nifty_proof tom_proof
-- Be sure you see exactly what's going on here!
-- It's analogous to the following
#check nat -- nat is a computational (of type, Type)
#check 5 -- 5 is a value of type nat
-- The proposition is analogous to ℕ: it's a type
-- The proof is analogous to 5: a value of this type

/-
We formalize the and left elimination rule
(P ∧ Q) → P, as a function that takes a proof
of (P ∧ Q) and that returns a proof of P. The
key ideas are that a proof of (P ∧ Q) is of
the form (and.intro p q), where (p : P) is a
proof of P and (q : Q) is a proof of Q. We
use destructuring/pattern-matching to "get
our hands on" the component proof, p, that
is one part of a larger proof of P ∧ Q.
-/
def and''_elim_left { α β : Prop} : (and'' α β) →  α
| (and''.intro a _) := a

#reduce and''_elim_left pf2

/-
We put two tick marks on the name and''_elim_left
because we're going to present exactly the same
function using some slightly varying approaches
to syntax. The last of our three versions is the
one we'd prefer to see. And please be aware that
Lean already provides the left and right elim
functions through its libraries. They are called
and.elim_left and and.elim_right. What you are
seeing here is exactly how these functions work.
-/

-- The corresponding right elim rule, (P ∧ Q → P)
def and''_elim_right { α β : Prop} : (and'' α β) →  β
| (and''.intro _ b) := b

#reduce and''_elim_right pf2

/-
We define a polymorphic "and proposition builder"
with explicitly named arguments.
-/

inductive and' (α β : Prop) : Prop
| intro (left : α) (right : β) : and'

/-
And now, for the first time, you see the use
of "structure" in Lean to (1) define a type with
one constructor, again called intro here, and with
two arguments, with names left and right, of types
a and b. The benefit of using "structure" is that
given a value, p, of this type, the names of the
fields (left and right) can be used to obtain the
field values without having to write explicit
"projection functions", such as elim_left and
elim_right.
-/
structure and (a b : Prop) : Prop :=
intro :: (left : a) (right : b)

open and

lemma cats : and (was_a_cat nifty) (was_a_cat tom) :=
    and.intro nifty_proof tom_proof

#reduce cats.left
#reduce cats.right

/-
The Lean libraries define ∧ as an infix notation
for (and _ _). We illustrate how this is done by
"overloading" the similar looking ^ (caret) operator.
We don't try to overload ∧ here because it leads to
an ambiguous interpretation of ∧, as ∧ is already
defined by Lean.
-/
notation P ^ Q := and P Q   -- we don't overload ∧

theorem were_cats_nifty_and_cheese :
    was_a_cat nifty ^ was_a_cat cheese :=
begin
    apply and.intro _ _,
    exact nifty_proof,
    sorry -- Stuck: no theorem obtained.
end

theorem were_cats_nifty_and_tom :
    was_a_cat nifty ^ was_a_cat tom :=
begin
    apply and.intro,
    exact nifty_proof,
    exact tom_proof,    -- Yay, it's a theorem!
end

/-
For our nicely written "and" type (without ticks)
we rewrite the elimination rules. If we have a
proof of P ^ Q, we can obtain individual proofs
of P and Q, respectively. We define them in the
"and" namespace. This is basically just as it is
the Lean libraries.
-/

def and.elim_left {α β : Prop} : and α β → α
| (and.intro a b) := a

def and.elim_right {α β : Prop} : and α β → β
| (and.intro a b) := b

end our_logic

/-
Now we're using Lean's libraries!
-/

-- PROPOSITIONS!!!
#check and
def P1 : Prop := 0 = 0
def P2 : Prop := 1 = 1
def P12' : Prop := eq 1 1
#check and P1 P2

-- PROOFS!!!
#check 0 = 0
#check eq 0 0

def p1 : P1 := eq.refl 0
def p2 : P2 := eq.refl 1

example : 1 = 1 + 0 := eq.refl 1

/-
Prove 0 = 0.

Proof: Equality is reflexive. This means that
for any value, a, of any type α, a = a.

∀ {T : Type}, ∀ (t : T), t = t.

We apply this axiom to (ℕ and) 0, in
particular, to obtain a proof that 0 = 0.
-/

def P1_and_P2' : Prop := and P1 P2
def P1_and_P2 : Prop := P1 ∧ P2     -- infix notation for and

def p1_and_p2' : P1_and_P2 := and.intro
    p1
    p2

def p1_and_p2 : P1_and_P2 :=
begin
    unfold P1_and_P2,
    exact and.intro p1 p2,
end

#reduce p1_and_p2
#reduce p1_and_p2'

#check @and.elim_left

#check and.elim_left p1_and_p2
#check p1_and_p2.left

#check and.elim_right p1_and_p2
#check p1_and_p2.right

#check @and.elim_left

theorem my_elim_left : ∀ (P1 P2 : Prop), P1 ∧ P2 → P1 :=
λ P1 P2 h,
    match h with
    | and.intro a b := a
    end

/-
English language.

We are to prove P1 ∧ P2. The and introduction rule of
natural deduction tells us that it will suffice to
apply this rule to a proof of P1 and a proof of P2.
So what remains to be proved are P1 and P2. To prove
P1, that 0 = 0, the reflexive property of equality
tells us that *every* object is equal to itself. By
applying this rule to the particular value, 0, we
obtain a proof that 0 = 0. Now all that remains to be
proved is 1 = 1. This is easily proved in the same way.
We apply the and introduction rule to the proofs of
these two lemmas, and thereby obtain a proof that
0 = 0 ∧ 1 = 1.
-/

#check and.intro
#check @and.intro

/-
Universal generalizations (∀ propositions)
-/

theorem th_and : ∀ {a b : Prop}, a → b → a ∧ b :=
λ a b,
    λ pf_a pf_b,
        and.intro pf_a pf_b

#check th_and p1 p2     -- P1 and P2 are implicit args

/-
In English!
-/

/-
IMPLICATION -- 2019.11.07.Lean
-/

/-
If we have a proof that nifty was a cat ∧
cheese was a cat, then we can deduce a proof
that cheese was a cat. Such a proof must be a
part of the assumed proof of the conjunction.
-/
theorem conj_impl_left :
    was_a_cat nifty ∧
    was_a_cat cheese →
    was_a_cat cheese
| pf_n_and_c := and.elim_right pf_n_and_c

/-
There what we just did is kind of amazing.
We formalized a proof of a proposition,
"if nifty was a cat and cheese was a cat,
then cheese was a cat, as a function. That
there is such a function proves the truth
of the logical implication (proposition).
-/

/-
Note: We have not proved that cheese was a
cat. If fact cheese wasn't a cat; he was a
rat. All we have shown is that *if* we can
come up with a proof of the conjunction then
we can "extract" its right component proof.
It does not show that we could actually ever
build a proof of the conjunction in the
first place.
-/

/-
We see again that a proof of a conjunction
in our logic is really just a pair of proofs,
with fst and snd (left and right) projection
functions. The and.intro constructor takes a
pair of proofs and packages them up into pair
that is accepted as a proof of a conjunction.
-/

/-
Lean provides exactly such this polymorphic
logical and connective. It's called "and" has
∧ as a conventional infix notation. Here's an
example. We also take this moment to introduce
the "example" construct in Lean. It's just
like def or theorem, in that it calls for a
value of a particular type. The difference is
that it doesn't bind the value to a name. It
is a way to prove something without storing
the proof as a named object.
-/

example : was_a_cat tom ∧ 0 = 0 :=
    and.intro tom_proof (eq.refl 0)

example : was_a_cat tom ∧ 0 = 0 :=
begin
    apply and.intro tom_proof (eq.refl 0),
end

example : was_a_cat tom ∧ 0 = 0 :=
begin
    apply and.intro tom_proof, -- arg as subgoal
    exact (eq.refl 0)
end

example : was_a_cat tom ∧ 0 = 0 :=
begin
    apply and.intro,    -- two args as subgoals
    exact tom_proof,
    exact (eq.refl 0)
end

/-
Let's write some English language proofs.
-/

/-
IMPLIES
-/

/-
What we've seen now is that a proof that an
implication is true is a proof that *if* one
has a proof of its premise, then from that
one can obtain a proof of its conclusion.

Again, as an example, consider that from a
proof of a conjunction one can obtain (you
can also say "deduce") a proof of either of
its conjuncts. If one has a proof of P ∧ Q,
for example, then by applying one of the two
"and elimination" axioms (rules of natural
deduction) to the proof of P ∧ Q, one can
obtain either a proof of P, or a proof of Q.

To prove an implication we thus prove that
there is a way to transform any proof of
its premise into a proof of its conclusion.

In natural language, we'd say that we first
*assume* that the premise is true, and then
we'd show that in the context in which we've
made that assumption, we can show that the
conclusion must be true.

Theorem: For all propositions, P and Q,
(P ∧ Q) → P.

Proof. Suppose that P and Q are arbitrary
but specific propositions. What remains to
prove is that (P ∧ Q) → P. To prove this,
assume we have a proof of P ∧ Q. Applying
the natural deduction principle of and
elimination (left) yields of proof of P.
QED.

To formalize this idea, we prove such an
implication by showing that there is a
function that, *if* given a proof of the
premise as an argument is able to create
and return a proof of the conclusion. If
there is such a function in Lean (in which
case it is a total function, and so can
take *any* proof of the premise as an
argument), then from any proof of the
premise it is always possible to derive
a proof of the conclusion, so the truth
of the premise implies the truth of the
conclusion.
-/

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

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

-- Note that names bound by lambda do
-- not have to be P and Q. You can call
-- arguments whatever you want, as long
-- as their names are already in use.

/-
Let's take that bit by bit. We bind a name,
pf1, to a proof of ∀ (P Q : Prop), P ∧ Q → P.

We use ∀ (P Q : Prop) to give names to two
*parameters* -- any two propositions, P and
Q -- so that we can use these names in the
rest of the proposition: P ∧ Q → P.

We thus have the overall proposition: for
*any* propositions, P and Q, if P ∧ Q (is
true, has a proof) then P (is true, has a
proof), i.e., P ∧ Q → P. In curt English:
"If P ∧ Q then P."

The lambda expressions take argument values
that, in the rest of the function definition,
are *assumed* to be of the specified types.
So in the "body" of the function, P and Q are
*assumed* to be propositions (types, of type
Prop), and h is *assumed* to be a proof (value)
of (type) P ∧ Q.

What the expression, (and.elim_left h), then
shows is that, in the context of *the given
assumptions*, one can construct and return
a proof of *P*. From the assumption of the
premise follows the truth of the conclusion.
-/

/-
A proof of an implication in constructive
logic is a function: one that if given an
argument of the premise type returns a value
of the conclusion type. Recall: propositions
are types, proofs are values of such types.

We wrote the formal proof of ∀ (P Q : Prop),
P ∧ Q → P, to make explicit the overall
proposition being proved, but we could just
as well have written it in C style. In fact,
we could have written it in any of the ways
available to define functions.

Here are various forms in which exactly the
same proof can be expressed. In the first C
style proof, we see even more clearly that
we can think of argument to functions as
*assumptions* that we can then use in the
function body to construct a return result.
-/

def pf2 (P Q : Prop) (h : P ∧ Q) : P :=
    and.elim_left h -- from h deduce P

#check pf2      -- that's pretty cool

-- script, assume and name args in script
-- here X and Y refer to P, Q
-- better in general to keep names P, Q
def pf3 : ∀ (P Q : Prop), P ∧ Q → P :=
begin
    assume (X Y : Prop),
    assume (h : X ∧ Y),
    exact and.elim_left h,
end

-- proof script, args already assumed
def pf4 (P Q : Prop) (h : P ∧ Q) : P :=
begin -- look: arguments are assumptions
    exact and.elim_left h,
end

-- using cases notation
def pf5 : ∀ (P Q : Prop), P ∧ Q → P
| P Q h := and.elim_left h

/-
False Elimination: ∀ (P : Prop), false → P.
-/

/-
It doesn't matter whether or not one can
ever produce a proof of a premise, because
all that a proof of an implications says
is that *if* you can give a proof of the
premise as an argument to a function, then
it can return a proof of the conclusion.

A clear example involves the proof that
"false implies (the truth of) anything".
Formally: ∀ (P : Prop), false → P. Take
a moment to make sure you understand what
this proposition says!
-/

/-
The proposition (false : Prop) is one with
no proofs at all.
-/

inductive false' : Prop
-- no constructors!

/-
For example, it's true that (false → 0 = 1)
even though one can never produce a proof
of false. The truth of (false → 0 = 1) is
demonstrated by the existence of a function
that, *if* it could be given a proof of false,
would return a proof of 0 = 1 by applying the
false elimination inference rule to the
*assumed* proof of false to derive a proof
of 0 = 1.
-/

theorem false_elim_example : false → 0 = 1 :=
    λ h, false.elim h

theorem false_elim_example' (h : false) : 0 = 1 :=
    false.elim h

example : false → 0 = 1 := λ h, false.elim h


/-
Copyright (c) 2020 Alexander Bentkamp, Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Sébastien Gouëzel, Eric Wieser
-/
import algebra.order.smul
import data.complex.basic
import data.fin.vec_notation
import field_theory.tower

/-!
# Complex number as a vector space over `ℝ`

This file contains the following instances:
* Any `•`-structure (`has_scalar`, `mul_action`, `distrib_mul_action`, `module`, `algebra`) on
  `ℝ` imbues a corresponding structure on `ℂ`. This includes the statement that `ℂ` is an `ℝ`
  algebra.
* any complex vector space is a real vector space;
* any finite dimensional complex vector space is a finite dimensional real vector space;
* the space of `ℝ`-linear maps from a real vector space to a complex vector space is a complex
  vector space.

It also defines bundled versions of four standard maps (respectively, the real part, the imaginary
part, the embedding of `ℝ` in `ℂ`, and the complex conjugate):

* `complex.re_lm` (`ℝ`-linear map);
* `complex.im_lm` (`ℝ`-linear map);
* `complex.of_real_am` (`ℝ`-algebra (homo)morphism);
* `complex.conj_ae` (`ℝ`-algebra equivalence).

It also provides a universal property of the complex numbers `complex.lift`, which constructs a
`ℂ →ₐ[ℝ] A` into any `ℝ`-algebra `A` given a square root of `-1`.

-/

namespace complex

open_locale complex_conjugate

variables {R : Type*} {S : Type*}

section

variables [has_scalar R ℝ]

/- The useless `0` multiplication in `smul` is to make sure that
`restrict_scalars.module ℝ ℂ ℂ = complex.module` definitionally. -/
instance : has_scalar R ℂ :=
{ smul := λ r x, ⟨r • x.re - 0 * x.im, r • x.im + 0 * x.re⟩ }

lemma smul_re (r : R) (z : ℂ) : (r • z).re = r • z.re := by simp [(•)]
lemma smul_im (r : R) (z : ℂ) : (r • z).im = r • z.im := by simp [(•)]

@[simp] lemma real_smul {x : ℝ} {z : ℂ} : x • z = x * z := rfl

end

instance [has_scalar R ℝ] [has_scalar S ℝ] [smul_comm_class R S ℝ] : smul_comm_class R S ℂ :=
{ smul_comm := λ r s x, by ext; simp [smul_re, smul_im, smul_comm] }

instance [has_scalar R S] [has_scalar R ℝ] [has_scalar S ℝ] [is_scalar_tower R S ℝ] :
  is_scalar_tower R S ℂ :=
{ smul_assoc := λ r s x, by ext; simp [smul_re, smul_im, smul_assoc] }

instance [monoid R] [mul_action R ℝ] : mul_action R ℂ :=
{ one_smul := λ x, by ext; simp [smul_re, smul_im, one_smul],
  mul_smul := λ r s x, by ext; simp [smul_re, smul_im, mul_smul] }

instance [semiring R] [distrib_mul_action R ℝ] : distrib_mul_action R ℂ :=
{ smul_add := λ r x y, by ext; simp [smul_re, smul_im, smul_add],
  smul_zero := λ r, by ext; simp [smul_re, smul_im, smul_zero] }

instance [semiring R] [module R ℝ] : module R ℂ :=
{ add_smul := λ r s x, by ext; simp [smul_re, smul_im, add_smul],
  zero_smul := λ r, by ext; simp [smul_re, smul_im, zero_smul] }

instance [comm_semiring R] [algebra R ℝ] : algebra R ℂ :=
{ smul := (•),
  smul_def' := λ r x, by ext; simp [smul_re, smul_im, algebra.smul_def],
  commutes' := λ r ⟨xr, xi⟩, by ext; simp [smul_re, smul_im, algebra.commutes],
  ..complex.of_real.comp (algebra_map R ℝ) }

@[simp] lemma coe_algebra_map : (algebra_map ℝ ℂ : ℝ → ℂ) = coe := rfl

section
variables {A : Type*} [semiring A] [algebra ℝ A]

/-- We need this lemma since `complex.coe_algebra_map` diverts the simp-normal form away from
`alg_hom.commutes`. -/
@[simp] lemma _root_.alg_hom.map_coe_real_complex (f : ℂ →ₐ[ℝ] A) (x : ℝ) :
  f x = algebra_map ℝ A x :=
f.commutes x

/-- Two `ℝ`-algebra homomorphisms from ℂ are equal if they agree on `complex.I`. -/
@[ext]
lemma alg_hom_ext ⦃f g : ℂ →ₐ[ℝ] A⦄ (h : f I = g I) : f = g :=
begin
  ext ⟨x, y⟩,
  simp only [mk_eq_add_mul_I, alg_hom.map_add, alg_hom.map_coe_real_complex, alg_hom.map_mul, h]
end

end

section
open_locale complex_order

protected lemma ordered_smul : ordered_smul ℝ ℂ :=
ordered_smul.mk' $ λ a b r hab hr, ⟨by simp [hr, hab.1.le], by simp [hab.2]⟩

localized "attribute [instance] complex.ordered_smul" in complex_order

end

open submodule finite_dimensional

/-- `ℂ` has a basis over `ℝ` given by `1` and `I`. -/
noncomputable def basis_one_I : basis (fin 2) ℝ ℂ :=
basis.of_equiv_fun
{ to_fun := λ z, ![z.re, z.im],
  inv_fun := λ c, c 0 + c 1 • I,
  left_inv := λ z, by simp,
  right_inv := λ c, by { ext i, fin_cases i; simp },
  map_add' := λ z z', by simp,
  map_smul' := λ c z, by simp }

@[simp] lemma coe_basis_one_I_repr (z : ℂ) : ⇑(basis_one_I.repr z) = ![z.re, z.im] := rfl

@[simp] lemma coe_basis_one_I : ⇑basis_one_I = ![1, I] :=
funext $ λ i, basis.apply_eq_iff.mpr $ finsupp.ext $ λ j,
by fin_cases i; fin_cases j;
    simp only [coe_basis_one_I_repr, finsupp.single_eq_same, finsupp.single_eq_of_ne,
              matrix.cons_val_zero, matrix.cons_val_one, matrix.head_cons,
              nat.one_ne_zero, fin.one_eq_zero_iff, fin.zero_eq_one_iff, ne.def, not_false_iff,
              one_re, one_im, I_re, I_im]

instance : finite_dimensional ℝ ℂ := of_fintype_basis basis_one_I

@[simp] lemma finrank_real_complex : finite_dimensional.finrank ℝ ℂ = 2 :=
by rw [finrank_eq_card_basis basis_one_I, fintype.card_fin]

@[simp] lemma dim_real_complex : module.rank ℝ ℂ = 2 :=
by simp [← finrank_eq_dim, finrank_real_complex]

lemma {u} dim_real_complex' : cardinal.lift.{u} (module.rank ℝ ℂ) = 2 :=
by simp [← finrank_eq_dim, finrank_real_complex, bit0]

/-- `fact` version of the dimension of `ℂ` over `ℝ`, locally useful in the definition of the
circle. -/
lemma finrank_real_complex_fact : fact (finrank ℝ ℂ = 2) := ⟨finrank_real_complex⟩

end complex

/- Register as an instance (with low priority) the fact that a complex vector space is also a real
vector space. -/
@[priority 900]
instance module.complex_to_real (E : Type*) [add_comm_group E] [module ℂ E] : module ℝ E :=
restrict_scalars.module ℝ ℂ E

instance module.real_complex_tower (E : Type*) [add_comm_group E] [module ℂ E] :
  is_scalar_tower ℝ ℂ E :=
restrict_scalars.is_scalar_tower ℝ ℂ E

@[simp, norm_cast] lemma complex.coe_smul {E : Type*} [add_comm_group E] [module ℂ E]
  (x : ℝ) (y : E) :
  (x : ℂ) • y = x • y :=
rfl

@[priority 100]
instance finite_dimensional.complex_to_real (E : Type*) [add_comm_group E] [module ℂ E]
  [finite_dimensional ℂ E] : finite_dimensional ℝ E :=
finite_dimensional.trans ℝ ℂ E

lemma dim_real_of_complex (E : Type*) [add_comm_group E] [module ℂ E] :
  module.rank ℝ E = 2 * module.rank ℂ E :=
cardinal.lift_inj.1 $
  by { rw [← dim_mul_dim' ℝ ℂ E, complex.dim_real_complex], simp [bit0] }

lemma finrank_real_of_complex (E : Type*) [add_comm_group E] [module ℂ E] :
  finite_dimensional.finrank ℝ E = 2 * finite_dimensional.finrank ℂ E :=
by rw [← finite_dimensional.finrank_mul_finrank ℝ ℂ E, complex.finrank_real_complex]

namespace complex

open_locale complex_conjugate

/-- Linear map version of the real part function, from `ℂ` to `ℝ`. -/
def re_lm : ℂ →ₗ[ℝ] ℝ :=
{ to_fun := λx, x.re,
  map_add' := add_re,
  map_smul' := by simp, }

@[simp] lemma re_lm_coe : ⇑re_lm = re := rfl

/-- Linear map version of the imaginary part function, from `ℂ` to `ℝ`. -/
def im_lm : ℂ →ₗ[ℝ] ℝ :=
{ to_fun := λx, x.im,
  map_add' := add_im,
  map_smul' := by simp, }

@[simp] lemma im_lm_coe : ⇑im_lm = im := rfl

/-- `ℝ`-algebra morphism version of the canonical embedding of `ℝ` in `ℂ`. -/
def of_real_am : ℝ →ₐ[ℝ] ℂ := algebra.of_id ℝ ℂ

@[simp] lemma of_real_am_coe : ⇑of_real_am = coe := rfl

/-- `ℝ`-algebra isomorphism version of the complex conjugation function from `ℂ` to `ℂ` -/
def conj_ae : ℂ ≃ₐ[ℝ] ℂ :=
{ inv_fun := conj,
  left_inv := star_star,
  right_inv := star_star,
  commutes' := conj_of_real,
  .. conj }

@[simp] lemma conj_ae_coe : ⇑conj_ae = conj := rfl

section lift

variables {A : Type*} [ring A] [algebra ℝ A]

/-- There is an alg_hom from `ℂ` to any `ℝ`-algebra with an element that squares to `-1`.

See `complex.lift` for this as an equiv. -/
def lift_aux (I' : A) (hf : I' * I' = -1) : ℂ →ₐ[ℝ] A :=
alg_hom.of_linear_map
  ((algebra.of_id ℝ A).to_linear_map.comp re_lm + (linear_map.to_span_singleton _ _ I').comp im_lm)
  (show algebra_map ℝ A 1 + (0 : ℝ) • I' = 1,
    by rw [ring_hom.map_one, zero_smul, add_zero])
  (λ ⟨x₁, y₁⟩ ⟨x₂, y₂⟩, show algebra_map ℝ A (x₁ * x₂ - y₁ * y₂) + (x₁ * y₂ + y₁ * x₂) • I'
                          = (algebra_map ℝ A x₁ + y₁ • I') * (algebra_map ℝ A x₂ + y₂ • I'),
    begin
      rw [add_mul, mul_add, mul_add, add_comm _ (y₁ • I' * y₂ • I'), add_add_add_comm],
      congr' 1, -- equate "real" and "imaginary" parts
      { rw [smul_mul_smul, hf, smul_neg, ←algebra.algebra_map_eq_smul_one, ←sub_eq_add_neg,
          ←ring_hom.map_mul, ←ring_hom.map_sub], },
      { rw [algebra.smul_def, algebra.smul_def, algebra.smul_def, ←algebra.right_comm _ x₂,
          ←mul_assoc, ←add_mul, ←ring_hom.map_mul, ←ring_hom.map_mul, ←ring_hom.map_add] }
    end)

@[simp]
lemma lift_aux_apply (I' : A) (hI') (z : ℂ) :
 lift_aux I' hI' z = algebra_map ℝ A z.re + z.im • I' := rfl

lemma lift_aux_apply_I (I' : A) (hI') : lift_aux I' hI' I = I' := by simp

/-- A universal property of the complex numbers, providing a unique `ℂ →ₐ[ℝ] A` for every element
of `A` which squares to `-1`.

This can be used to embed the complex numbers in the `quaternion`s.

This isomorphism is named to match the very similar `zsqrtd.lift`. -/
@[simps {simp_rhs := tt}]
def lift : {I' : A // I' * I' = -1} ≃ (ℂ →ₐ[ℝ] A) :=
{ to_fun := λ I', lift_aux I' I'.prop,
  inv_fun := λ F, ⟨F I, by rw [←F.map_mul, I_mul_I, alg_hom.map_neg, alg_hom.map_one]⟩,
  left_inv := λ I', subtype.ext $ lift_aux_apply_I I' I'.prop,
  right_inv := λ F, alg_hom_ext $ lift_aux_apply_I _ _, }

/- When applied to `complex.I` itself, `lift` is the identity. -/
@[simp]
lemma lift_aux_I : lift_aux I I_mul_I = alg_hom.id ℝ ℂ :=
alg_hom_ext $ lift_aux_apply_I _ _

/- When applied to `-complex.I`, `lift` is conjugation, `conj`. -/
@[simp]

end lift

end complex


/-
Copyright (c) 2021 Henry Swanson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henry Swanson, Patrick Massot

! This file was ported from Lean 3 source module combinatorics.derangements.exponential
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Exponential
import Mathbin.Combinatorics.Derangements.Finite
import Mathbin.Order.Filter.Basic

/-!
# Derangement exponential series

This file proves that the probability of a permutation on n elements being a derangement is 1/e.
The specific lemma is `num_derangements_tendsto_inv_e`.
-/

open Filter

open BigOperators

open Topology

theorem numDerangements_tendsto_inv_e :
    Tendsto (fun n => (numDerangements n : ℝ) / n.factorial) atTop (𝓝 (Real.exp (-1))) :=
  by
  -- we show that d(n)/n! is the partial sum of exp(-1), but offset by 1.
  -- this isn't entirely obvious, since we have to ensure that asc_factorial and
  -- factorial interact in the right way, e.g., that k ≤ n always
  let s : ℕ → ℝ := fun n => ∑ k in Finset.range n, (-1 : ℝ) ^ k / k.factorial
  suffices ∀ n : ℕ, (numDerangements n : ℝ) / n.factorial = s (n + 1)
    by
    simp_rw [this]
    -- shift the function by 1, and then use the fact that the partial sums
    -- converge to the infinite sum
    rw [tendsto_add_at_top_iff_nat 1]
    apply HasSum.tendsto_sum_nat
    -- there's no specific lemma for ℝ that ∑ x^k/k! sums to exp(x), but it's
    -- true in more general fields, so use that lemma
    rw [Real.exp_eq_exp_ℝ]
    exact exp_series_div_hasSum_exp ℝ (-1 : ℝ)
  intro n
  rw [← Int.cast_ofNat, numDerangements_sum]
  push_cast
  rw [Finset.sum_div]
  -- get down to individual terms
  refine' Finset.sum_congr (refl _) _
  intro k hk
  have h_le : k ≤ n := finset.mem_range_succ_iff.mp hk
  rw [Nat.ascFactorial_eq_div, add_tsub_cancel_of_le h_le]
  push_cast [Nat.factorial_dvd_factorial h_le]
  field_simp [Nat.factorial_ne_zero]
  ring
#align num_derangements_tendsto_inv_e numDerangements_tendsto_inv_e


/-
Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pierre-Alexandre Bazin
-/
import algebra.module.pid
import data.zmod.quotient

/-!
# Structure of finite(ly generated) abelian groups

* `add_comm_group.equiv_free_prod_direct_sum_zmod` : Any finitely generated abelian group is the
  product of a power of `ℤ` and a direct sum of some `zmod (p i ^ e i)` for some prime powers
  `p i ^ e i`.
* `add_comm_group.equiv_direct_sum_zmod_of_fintype` : Any finite abelian group is a direct sum of
  some `zmod (p i ^ e i)` for some prime powers `p i ^ e i`.

-/

open_locale direct_sum

universe u

namespace module

variables (M : Type u)

lemma finite_of_fg_torsion [add_comm_group M] [module ℤ M] [module.finite ℤ M]
  (hM : module.is_torsion ℤ M) : _root_.finite M :=
begin
  rcases module.equiv_direct_sum_of_is_torsion hM with ⟨ι, _, p, h, e, ⟨l⟩⟩,
  haveI : ∀ i : ι, ne_zero (p i ^ e i).nat_abs :=
  λ i, ⟨int.nat_abs_ne_zero_of_ne_zero $ pow_ne_zero (e i) (h i).ne_zero⟩,
  haveI : ∀ i : ι, _root_.finite $ ℤ ⧸ submodule.span ℤ {p i ^ e i} :=
  λ i, finite.of_equiv _ (p i ^ e i).quotient_span_equiv_zmod.symm.to_equiv,
  haveI : _root_.finite ⨁ i, ℤ ⧸ (submodule.span ℤ {p i ^ e i} : submodule ℤ ℤ) :=
  finite.of_equiv _ dfinsupp.equiv_fun_on_fintype.symm,
  exact finite.of_equiv _ l.symm.to_equiv
end

end module

variables (G : Type u)

namespace add_comm_group

variable [add_comm_group G]

/-- **Structure theorem of finitely generated abelian groups** : Any finitely generated abelian
group is the product of a power of `ℤ` and a direct sum of some `zmod (p i ^ e i)` for some
prime powers `p i ^ e i`. -/
theorem equiv_free_prod_direct_sum_zmod [hG : add_group.fg G] :
  ∃ (n : ℕ) (ι : Type) [fintype ι] (p : ι → ℕ) [∀ i, nat.prime $ p i] (e : ι → ℕ),
  nonempty $ G ≃+ (fin n →₀ ℤ) × ⨁ (i : ι), zmod (p i ^ e i) :=
begin
  obtain ⟨n, ι, fι, p, hp, e, ⟨f⟩⟩ :=
    @module.equiv_free_prod_direct_sum _ _ _ _ _ _ _ (module.finite.iff_add_group_fg.mpr hG),
  refine ⟨n, ι, fι, λ i, (p i).nat_abs, λ i, _, e, ⟨_⟩⟩,
  { rw [← int.prime_iff_nat_abs_prime, ← gcd_monoid.irreducible_iff_prime], exact hp i },
  exact f.to_add_equiv.trans ((add_equiv.refl _).prod_congr $ dfinsupp.map_range.add_equiv $
    λ i, ((int.quotient_span_equiv_zmod _).trans $
      zmod.ring_equiv_congr $ (p i).nat_abs_pow _).to_add_equiv)
end

/-- **Structure theorem of finite abelian groups** : Any finite abelian group is a direct sum of
some `zmod (p i ^ e i)` for some prime powers `p i ^ e i`. -/
theorem equiv_direct_sum_zmod_of_fintype [finite G] :
  ∃ (ι : Type) [fintype ι] (p : ι → ℕ) [∀ i, nat.prime $ p i] (e : ι → ℕ),
  nonempty $ G ≃+ ⨁ (i : ι), zmod (p i ^ e i) :=
begin
  casesI nonempty_fintype G,
  obtain ⟨n, ι, fι, p, hp, e, ⟨f⟩⟩ := equiv_free_prod_direct_sum_zmod G,
  cases n,
  { exact ⟨ι, fι, p, hp, e, ⟨f.trans add_equiv.unique_prod⟩⟩ },
  { haveI := @fintype.prod_left _ _ _ (fintype.of_equiv G f.to_equiv) _,
    exact (fintype.of_surjective (λ f : fin n.succ →₀ ℤ, f 0) $
      λ a, ⟨finsupp.single 0 a, finsupp.single_eq_same⟩).false.elim }
end

lemma finite_of_fg_torsion [hG' : add_group.fg G] (hG : add_monoid.is_torsion G) : finite G :=
@module.finite_of_fg_torsion _ _ _ (module.finite.iff_add_group_fg.mpr hG') $
  add_monoid.is_torsion_iff_is_torsion_int.mp hG

end add_comm_group

namespace comm_group

lemma finite_of_fg_torsion [comm_group G] [group.fg G] (hG : monoid.is_torsion G) : finite G :=
@finite.of_equiv _ _ (add_comm_group.finite_of_fg_torsion (additive G) hG) multiplicative.of_add

end comm_group


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll
-/
import number_theory.cyclotomic.primitive_roots
import field_theory.finite.trace

/-!
# Additive characters of finite rings and fields

Let `R` be a finite commutative ring. An *additive character* of `R` with values
in another commutative ring `R'` is simply a morphism from the additive group
of `R` into the multiplicative monoid of `R'`.

The additive characters on `R` with values in `R'` form a commutative group.

We use the namespace `add_char`.

## Main definitions and results

We define `mul_shift ψ a`, where `ψ : add_char R R'` and `a : R`, to be the
character defined by `x ↦ ψ (a * x)`. An additive character `ψ` is *primitive*
if `mul_shift ψ a` is trivial only when `a = 0`.

We show that when `ψ` is primitive, then the map `a ↦ mul_shift ψ a` is injective
(`add_char.to_mul_shift_inj_of_is_primitive`) and that `ψ` is primitive when `R` is a field
and `ψ` is nontrivial (`add_char.is_nontrivial.is_primitive`).

We also show that there are primitive additive characters on `R` (with suitable
target `R'`) when `R` is a field or `R = zmod n` (`add_char.primitive_char_finite_field`
and `add_char.primitive_zmod_char`).

Finally, we show that the sum of all character values is zero when the character
is nontrivial (and the target is a domain); see `add_char.sum_eq_zero_of_is_nontrivial`.

## Tags

additive character
-/

universes u v

/-!
### Definitions related to and results on additive characters
-/

section add_char_def

-- The domain of our additive characters
variables (R : Type u) [add_monoid R]
-- The target
variables (R' : Type v) [comm_monoid R']

/-- Define `add_char R R'` as `(multiplicative R) →* R'`.
The definition works for an additive monoid `R` and a monoid `R'`,
but we will restrict to the case that both are commutative rings below.
We assume right away that `R'` is commutative, so that `add_char R R'` carries
a structure of commutative monoid.
The trivial additive character (sending everything to `1`) is `(1 : add_char R R').` -/
@[derive [comm_monoid, inhabited]]
def add_char : Type (max u v) := (multiplicative R) →* R'

end add_char_def

namespace add_char

section coe_to_fun

variables {R : Type u} [add_monoid R] {R' : Type v} [comm_monoid R']

/-- Interpret an additive character as a monoid homomorphism. -/
def to_monoid_hom : (add_char R R') → (multiplicative R →* R') := id

open multiplicative

/-- Define coercion to a function so that it includes the move from `R` to `multiplicative R`.
After we have proved the API lemmas below, we don't need to worry about writing `of_add a`
when we want to apply an additive character. -/
instance has_coe_to_fun : has_coe_to_fun (add_char R R') (λ x, R → R') :=
{ coe := λ ψ x, ψ.to_monoid_hom (of_add x) }

lemma coe_to_fun_apply (ψ : add_char R R') (a : R) : ψ a = ψ.to_monoid_hom (of_add a) := rfl

instance monoid_hom_class : monoid_hom_class (add_char R R') (multiplicative R) R' :=
monoid_hom.monoid_hom_class

/-- An additive character maps `0` to `1`. -/
@[simp]
lemma map_zero_one (ψ : add_char R R') : ψ 0 = 1 :=
by rw [coe_to_fun_apply, of_add_zero, map_one]

/-- An additive character maps sums to products. -/
@[simp]
lemma map_add_mul (ψ : add_char R R') (x y : R) : ψ (x + y) = ψ x * ψ y :=
by rw [coe_to_fun_apply, coe_to_fun_apply _ x, coe_to_fun_apply _ y, of_add_add, map_mul]

/-- An additive character maps multiples by natural numbers to powers. -/
@[simp]
lemma map_nsmul_pow (ψ : add_char R R') (n : ℕ) (x : R) : ψ (n • x) = (ψ x) ^ n :=
by rw [coe_to_fun_apply, coe_to_fun_apply _ x, of_add_nsmul, map_pow]

end coe_to_fun

section group_structure

open multiplicative

variables {R : Type u} [add_comm_group R] {R' : Type v} [comm_monoid R']

/-- An additive character on a commutative additive group has an inverse.

Note that this is a different inverse to the one provided by `monoid_hom.has_inv`,
as it acts on the domain instead of the codomain. -/
instance has_inv : has_inv (add_char R R') := ⟨λ ψ, ψ.comp inv_monoid_hom⟩

lemma inv_apply (ψ : add_char R R') (x : R) : ψ⁻¹ x = ψ (-x) := rfl

/-- An additive character maps multiples by integers to powers. -/
@[simp]
lemma map_zsmul_zpow {R' : Type v} [comm_group R'] (ψ : add_char R R') (n : ℤ) (x : R) :
  ψ (n • x) = (ψ x) ^ n :=
by rw [coe_to_fun_apply, coe_to_fun_apply _ x, of_add_zsmul, map_zpow]

/-- The additive characters on a commutative additive group form a commutative group. -/
instance comm_group : comm_group (add_char R R') :=
{ inv := has_inv.inv,
  mul_left_inv :=
  λ ψ, by { ext, rw [monoid_hom.mul_apply, monoid_hom.one_apply, inv_apply, ← map_add_mul,
                     add_left_neg, map_zero_one], },
  ..monoid_hom.comm_monoid }

end group_structure

section additive

-- The domain and target of our additive characters. Now we restrict to rings on both sides.
variables {R : Type u} [comm_ring R] {R' : Type v} [comm_ring R']

/-- An additive character is *nontrivial* if it takes a value `≠ 1`. -/
def is_nontrivial (ψ : add_char R R') : Prop := ∃ (a : R), ψ a ≠ 1

/-- An additive character is nontrivial iff it is not the trivial character. -/
lemma is_nontrivial_iff_ne_trivial (ψ : add_char R R') : is_nontrivial ψ ↔ ψ ≠ 1 :=
begin
  refine not_forall.symm.trans (iff.not _),
  rw fun_like.ext_iff,
  refl,
end

/-- Define the multiplicative shift of an additive character.
This satisfies `mul_shift ψ a x = ψ (a * x)`. -/
def mul_shift (ψ : add_char R R') (a : R) : add_char R R' :=
ψ.comp (add_monoid_hom.mul_left a).to_multiplicative

@[simp] lemma mul_shift_apply {ψ : add_char R R'} {a : R} {x : R} : mul_shift ψ a x = ψ (a * x) :=
rfl

/-- `ψ⁻¹ = mul_shift ψ (-1))`. -/
lemma inv_mul_shift (ψ : add_char R R') : ψ⁻¹ = mul_shift ψ (-1) :=
begin
  ext,
  rw [inv_apply, mul_shift_apply, neg_mul, one_mul],
end

/-- If `n` is a natural number, then `mul_shift ψ n x = (ψ x) ^ n`. -/
lemma mul_shift_spec' (ψ : add_char R R') (n : ℕ) (x : R) : mul_shift ψ n x = (ψ x) ^ n :=
by rw [mul_shift_apply, ← nsmul_eq_mul, map_nsmul_pow]

/-- If `n` is a natural number, then `ψ ^ n = mul_shift ψ n`. -/
lemma pow_mul_shift (ψ : add_char R R') (n : ℕ) : ψ ^ n = mul_shift ψ n :=
begin
  ext x,
  rw [show (ψ ^ n) x = (ψ x) ^ n, from rfl, ← mul_shift_spec'],
end

/-- The product of `mul_shift ψ a` and `mul_shift ψ b` is `mul_shift ψ (a + b)`. -/
lemma mul_shift_mul (ψ : add_char R R') (a b : R) :
  mul_shift ψ a * mul_shift ψ b = mul_shift ψ (a + b) :=
begin
  ext,
  simp only [right_distrib, monoid_hom.mul_apply, mul_shift_apply, map_add_mul],
end

/-- `mul_shift ψ 0` is the trivial character. -/
@[simp]
lemma mul_shift_zero (ψ : add_char R R') : mul_shift ψ 0 = 1 :=
begin
  ext,
  simp only [mul_shift_apply, zero_mul, map_zero_one, monoid_hom.one_apply],
end

/-- An additive character is *primitive* iff all its multiplicative shifts by nonzero
elements are nontrivial. -/
def is_primitive (ψ : add_char R R') : Prop :=
∀ (a : R), a ≠ 0 → is_nontrivial (mul_shift ψ a)

/-- The map associating to `a : R` the multiplicative shift of `ψ` by `a`
is injective when `ψ` is primitive. -/
lemma to_mul_shift_inj_of_is_primitive {ψ : add_char R R'} (hψ : is_primitive ψ) :
  function.injective ψ.mul_shift :=
begin
  intros a b h,
  apply_fun (λ x, x * mul_shift ψ (-b)) at h,
  simp only [mul_shift_mul, mul_shift_zero, add_right_neg] at h,
  have h₂ := hψ (a + (-b)),
  rw [h, is_nontrivial_iff_ne_trivial, ← sub_eq_add_neg, sub_ne_zero] at h₂,
  exact not_not.mp (λ h, h₂ h rfl),
end

-- `add_comm_group.equiv_direct_sum_zmod_of_fintype`
-- gives the structure theorem for finite abelian groups.
-- This could be used to show that the map above is a bijection.
-- We leave this for a later occasion.

/-- When `R` is a field `F`, then a nontrivial additive character is primitive -/
lemma is_nontrivial.is_primitive {F : Type u} [field F] {ψ : add_char F R'}
  (hψ : is_nontrivial ψ) :
  is_primitive ψ :=
begin
  intros a ha,
  cases hψ with x h,
  use (a⁻¹ * x),
  rwa [mul_shift_apply, mul_inv_cancel_left₀ ha],
end

/-- Structure for a primitive additive character on a finite ring `R` into a cyclotomic extension
of a field `R'`. It records which cyclotomic extension it is, the character, and the
fact that the character is primitive. -/
@[nolint has_nonempty_instance] -- can't prove that they always exist
structure primitive_add_char (R : Type u) [comm_ring R] [fintype R] (R' : Type v) [field R'] :=
(n : ℕ+)
(char : add_char R (cyclotomic_field n R'))
(prim : is_primitive char)

/-!
### Additive characters on `zmod n`
-/

variables {C : Type v} [comm_ring C]

section zmod_char_def

open multiplicative -- so we can write simply `to_add`, which we need here again

/-- We can define an additive character on `zmod n` when we have an `n`th root of unity `ζ : C`. -/
def zmod_char (n : ℕ+) {ζ : C} (hζ : ζ ^ ↑n = 1) : add_char (zmod n) C :=
{ to_fun := λ (a : multiplicative (zmod n)), ζ ^ a.to_add.val,
  map_one' := by simp only [to_add_one, zmod.val_zero, pow_zero],
  map_mul' := λ x y, by rw [to_add_mul, ← pow_add, zmod.val_add (to_add x) (to_add y),
                            ← pow_eq_pow_mod _ hζ] }

/-- The additive character on `zmod n` defined using `ζ` sends `a` to `ζ^a`. -/
lemma zmod_char_apply {n : ℕ+} {ζ : C} (hζ : ζ ^ ↑n = 1) (a : zmod n) :
  zmod_char n hζ a = ζ ^ a.val := rfl

lemma zmod_char_apply' {n : ℕ+} {ζ : C} (hζ : ζ ^ ↑n = 1) (a : ℕ) : zmod_char n hζ a = ζ ^ a :=
by rw [pow_eq_pow_mod a hζ, zmod_char_apply, zmod.val_nat_cast a]

end zmod_char_def

/-- An additive character on `zmod n` is nontrivial iff it takes a value `≠ 1` on `1`. -/
lemma zmod_char_is_nontrivial_iff (n : ℕ+) (ψ : add_char (zmod n) C) : is_nontrivial ψ ↔ ψ 1 ≠ 1 :=
begin
  refine ⟨_, λ h, ⟨1, h⟩⟩,
  contrapose!,
  rintros h₁ ⟨a, ha⟩,
  have ha₁ : a = a.val • 1,
  { rw [nsmul_eq_mul, mul_one], exact (zmod.nat_cast_zmod_val a).symm },
  rw [ha₁, map_nsmul_pow, h₁, one_pow] at ha,
  exact ha rfl,
end

/-- A primitive additive character on `zmod n` takes the value `1` only at `0`. -/
lemma is_primitive.zmod_char_eq_one_iff (n : ℕ+) {ψ : add_char (zmod n) C} (hψ : is_primitive ψ)
  (a : zmod n) :
  ψ a = 1 ↔ a = 0 :=
begin
  refine ⟨λ h, not_imp_comm.mp (hψ a) _, λ ha, (by rw [ha, map_zero_one])⟩,
  rw [zmod_char_is_nontrivial_iff n (mul_shift ψ a), mul_shift_apply, mul_one, h, not_not],
end

/-- The converse: if the additive character takes the value `1` only at `0`,
then it is primitive. -/
lemma zmod_char_primitive_of_eq_one_only_at_zero (n : ℕ) (ψ : add_char (zmod n) C)
  (hψ : ∀ a, ψ a = 1 → a = 0) :
  is_primitive ψ :=
begin
  refine λ a ha, (is_nontrivial_iff_ne_trivial _).mpr (λ hf, _),
  have h : mul_shift ψ a 1 = (1 : add_char (zmod n) C) (1 : zmod n) :=
    congr_fun (congr_arg coe_fn hf) 1,
  rw [mul_shift_apply, mul_one, monoid_hom.one_apply] at h,
  exact ha (hψ a h),
end

/-- The additive character on `zmod n` associated to a primitive `n`th root of unity
is primitive -/
lemma zmod_char_primitive_of_primitive_root (n : ℕ+) {ζ : C} (h : is_primitive_root ζ n) :
  is_primitive (zmod_char n ((is_primitive_root.iff_def ζ n).mp h).left) :=
begin
  apply zmod_char_primitive_of_eq_one_only_at_zero,
  intros a ha,
  rw [zmod_char_apply, ← pow_zero ζ] at ha,
  exact (zmod.val_eq_zero a).mp (is_primitive_root.pow_inj h (zmod.val_lt a) n.pos ha),
end

/-- There is a primitive additive character on `zmod n` if the characteristic of the target
does not divide `n` -/
noncomputable
def primitive_zmod_char (n : ℕ+) (F' : Type v) [field F'] (h : (n : F') ≠ 0) :
  primitive_add_char (zmod n) F' :=
begin
  haveI : ne_zero ((n : ℕ) : F') := ⟨h⟩,
  exact
{ n := n,
  char := zmod_char n (is_cyclotomic_extension.zeta_pow n F' _),
  prim := zmod_char_primitive_of_primitive_root n (is_cyclotomic_extension.zeta_spec n F' _) }
end

/-!
### Existence of a primitive additive character on a finite field
-/

/-- There is a primitive additive character on the finite field `F` if the characteristic
of the target is different from that of `F`.
We obtain it as the composition of the trace from `F` to `zmod p` with a primitive
additive character on `zmod p`, where `p` is the characteristic of `F`. -/
noncomputable
def primitive_char_finite_field (F F': Type*) [field F] [fintype F] [field F']
  (h : ring_char F' ≠ ring_char F) :
  primitive_add_char F F' :=
begin
  let p := ring_char F,
  haveI hp : fact p.prime := ⟨char_p.char_is_prime F _⟩,
  let pp := p.to_pnat hp.1.pos,
  have hp₂ : ¬ ring_char F' ∣ p :=
  begin
    cases char_p.char_is_prime_or_zero F' (ring_char F') with hq hq,
    { exact mt (nat.prime.dvd_iff_eq hp.1 (nat.prime.ne_one hq)).mp h.symm, },
    { rw [hq],
      exact λ hf, nat.prime.ne_zero hp.1 (zero_dvd_iff.mp hf), },
  end,
  let ψ := primitive_zmod_char pp F' (ne_zero_iff.mp (ne_zero.of_not_dvd F' hp₂)),
  let ψ' := ψ.char.comp (algebra.trace (zmod p) F).to_add_monoid_hom.to_multiplicative,
  have hψ' : is_nontrivial ψ' :=
  begin
    obtain ⟨a, ha⟩ := finite_field.trace_to_zmod_nondegenerate F one_ne_zero,
    rw one_mul at ha,
    exact ⟨a, λ hf, ha $ (ψ.prim.zmod_char_eq_one_iff pp $ algebra.trace (zmod p) F a).mp hf⟩,
  end,
  exact
{ n := ψ.n,
  char := ψ',
  prim := hψ'.is_primitive },
end

/-!
### The sum of all character values
-/

open_locale big_operators

variables [fintype R]

/-- The sum over the values of a nontrivial additive character vanishes if the target ring
is a domain. -/
lemma sum_eq_zero_of_is_nontrivial [is_domain R'] {ψ : add_char R R'} (hψ : is_nontrivial ψ) :
  ∑ a, ψ a = 0 :=
begin
  rcases hψ with ⟨b, hb⟩,
  have h₁ : ∑ (a : R), ψ (b + a) = ∑ (a : R), ψ a :=
    fintype.sum_bijective _ (add_group.add_left_bijective b) _ _ (λ x, rfl),
  simp_rw [map_add_mul] at h₁,
  have h₂ : ∑ (a : R), ψ a = finset.univ.sum ⇑ψ := rfl,
  rw [← finset.mul_sum, h₂] at h₁,
  exact eq_zero_of_mul_eq_self_left hb h₁,
end

/-- The sum over the values of the trivial additive character is the cardinality of the source. -/
lemma sum_eq_card_of_is_trivial {ψ : add_char R R'} (hψ : ¬ is_nontrivial ψ) :
  ∑ a, ψ a = fintype.card R :=
begin
  simp only [is_nontrivial] at hψ,
  push_neg at hψ,
  simp only [hψ, finset.sum_const, nat.smul_one_eq_coe],
  refl,
end

/-- The sum over the values of `mul_shift ψ b` for `ψ` primitive is zero when `b ≠ 0`
and `#R` otherwise. -/
lemma sum_mul_shift [decidable_eq R] [is_domain R'] {ψ : add_char R R'} (b : R)
  (hψ : is_primitive ψ) :
  ∑ (x : R), ψ (x * b) = if b = 0 then fintype.card R else 0 :=
begin
  split_ifs with h,
  { -- case `b = 0`
    simp only [h, mul_zero, map_zero_one, finset.sum_const, nat.smul_one_eq_coe],
    refl, },
  { -- case `b ≠ 0`
    simp_rw mul_comm,
    exact sum_eq_zero_of_is_nontrivial (hψ b h), },
end

end additive

end add_char


namespace hidden        -- you can ignore this

/-
1a. Define a polymorphic tree type. A tree of objects of type α
is either empty or it is a value of type α along with two
smaller trees of the same kind. You can call them left and right
respectively.
-/

/-
1b.
Define a polymorphic function, is_empty, that takes a value of
type, tree α, and that returns Boolean tt if it is empty and ff
otherwise.
-/

/-
1b. Define a polymorphic function, num_nodes, that takes a value
of type, tree α, and that returns the number of nodes in the
tree.
-/

/-
2. A bit has one of two values. Imagine a type, let's call it
trit, with three values (e.g., true, false, and dont-know). How
many binary functions are there, taking two values of tihs type
and returning a value of the same type?
-/

/-
3. Define a function, sum_squares, that takes a natural number,
n, as an argument, and that returns the sum of the squaress of
all of the natural numbers from 0 to n, inclusive.
-/

/-
4a. We represent a binary relation, R, on a set of  values of
some  type, α, as a predicate with two arguments. In Lean such a
predicate is of type α → α → Prop. A property of such a relation
is a predicate on a relation, and so is of type (α → α → Prop) →
Prop.

Here is the definition of a property of binary relations called
asymmetry. A relation is said to be asymmetric if whenever (x, y)
is in the relation, (y, x) is not. For example, the less-than
relation on natural numbers is asymmetric.
-/

def asymmetric {α : Type} (R : α → α → Prop) : Prop :=
    ∀ (x y : α), R x y → ¬ R y x

/-
Similarly, a relation is said to be irreflexive if for all x,
(x, x) is not in the relation. For example, an "is-unequal-to"
relation on the natural numbers would include (3, 4) because
3 is unequal to 4, but it would not include (3, 3) because
3 is not unqual to 3. Write a formal definition of irreflexive
in the style of the definition of asymmetric above. Start the
actual definition (after the :=) with ∀ (x : α).
-/

def irreflexive {α : Type} (R : α → α → Prop) : Prop :=
    ∀ (x : α), ¬ R x x

/-
4b. Prove that if a relation is asymmetric then it is
irreflexive by completing the following proof.
-/

theorem asy_imp_irr :
    ∀ (α : Type) (F : α → α → Prop),
        asymmetric F → irreflexive F :=
begin
unfold asymmetric irreflexive,  -- expand defs
_
end

/-
5. Prove the following. You may use a tactic script,
as indicated here, or switch to another format for your
proof. Whatever you are most comfortable with is fine.
-/

example :
    ∀ (P Q R : Prop),
        (∀ (p : P), Q) → (∀ (q :Q), R) → (P ∨ Q) → R :=
begin
_
end

/-
6. Prove that every natural number, n, has a successor.
Formalize this statement using universal and existential
quantifiers: for every natural number n there exists a
natural number m such that m is the successor of n. Then
complete the proof. Finish what we've started for you.
-/

example : ∀ (n : ℕ), _ := _

/-
7. Consider a binary relation, squares, on the natural
numbers. A pair, (x, y), is in this relation if and only
if y=x^2. Formalize this relation in Lean as a predicate,
squares, with two natural number arguments and one proof
constructor called intro. Then state and prove the simple
proposition that the pair, (7, 49), is in this relation.
-/

-- Answer here

/-
8. This question asks you to model a little world.
The world has people in it (a type) and there is a
binary relation, parent_of, on people. What is means
for a pair (x, y) to be in this relation is that x
is a parent of y.
-/

axiom Person : Type
axiom ParentOf : Person → Person → Prop

/-
Define a GrandParentOf relation, such that (x, y) is
in this relation if and only if x is a grand parent of
y. What this means, of course, is that there is some z
such that x is the parent of z and z is the parent of y.
Define the GrandParentOf relation using an inductive
type definition in the usual way. It needs only one
constructor, which must enforce the condition that
defines what it means "to be a grandparent of".
-/

/-
9. In simple English explain what it means for a binary
relation on a set to be

* reflexive:
* transitive:
* symmetric:

Give an example of an everyday mathematical relation
other than equality that is transitive.

Is the greater-than relation reflexive? Explain.

Is it symmetric? Explain.
-/

/-
10. Give a natural language proof, in your own words,
showing that the square root of two is irrational. You
may find the details of this proof easily by searching
online.
-/

/-
11. Prove formally that 0 ≠ 1, then translate your
formal proof, step by step, into an English language
proof, citing the reasoning principles that you use.
What fundamental proof strategy is centrally involved
in this proof?
-/

/-
12. Lean includes the law of the excluded middle in a
closed namespace called classical. The axiom goes
by the name, classical.em. You may apply it to any
proposition, P, to obtain a proof of P ∨ ¬ P. Use
the law of the excluded middle to show that proof
by contradiction is valid, as long as you accept
em as an axiom. Hint: We covered this in class.
-/

/-
13. Let's define a natural number to be cool if it's
either 2 or 5 or the sum or the product of two
cool numbers. Formalize this definition in Lean
and then state and prove the proposition that 35
is cool.
-/

end hidden


namespace hidden

constant and: Prop -> Prop -> Prop
constant or: Prop -> Prop -> Prop
constant not: Prop -> Prop
constant implies: Prop -> Prop -> Prop

constant Proof: Prop -> Type

variables p q r: Prop

constant and_comm: ∀ p q: Prop,
  Proof (implies (and p q) (and q p))
#check and_comm p q

constant modus_ponens: ∀ p q: Prop, Proof (implies p q) -> Proof p -> Proof q
constant implies_intro: ∀ p q: Prop, (Proof p -> Proof q) -> Proof (implies p q)

end hidden

namespace hidden
constants p q: Prop

theorem t1: p -> q -> p := λ (hp: p) (hq: q), hp

theorem t1': p -> q -> p :=
  assume hp: p,
  assume hq: q,
  hp

theorem t1'': p -> q -> p :=
  assume hp: p,
  assume hq: q,
  show p, from hp

axiom ap : p

theorem t2: q -> p := t1 ap

theorem t1''': ∀ {p q: Prop}, p -> q -> p :=
  assume p q,
  assume hp: p,
  assume hq: q,
  hp
end hidden

theorem t1: ∀ (p q: Prop), p -> q -> p :=
  assume p q,
  assume hp: p,
  assume hq: q,
  hp

variables p q r s: Prop
#check t1
#check t1 p q
#check t1 r s
#check t1 (r -> s) (s -> r)

theorem t2 (h₁: q -> r) (h₂: p -> q): p -> r :=
  assume h₃: p,
  show r, from h₁ (h₂ h₃)

#check t2


import algebra.group
import group_theory.subgroup

variables {G: Type*} {H: set G} {a: G}

theorem Q_04a [hG: group G] [hH: is_subgroup H]:
  is_subgroup ((λ h, a * h * a⁻¹) '' H) := {

  inv_mem := λ g ⟨h, ⟨hH, ha⟩⟩, begin

    -- inverse of aha⁻¹ is ah⁻¹a⁻¹ ...
    have inv_g: g⁻¹ = a * h⁻¹ * a⁻¹,
    from ha ▸ calc (a * h * a⁻¹)⁻¹
    = (a⁻¹)⁻¹ * h⁻¹ * a⁻¹ : by rw [mul_inv_rev, mul_inv_rev, ←mul_assoc]
... = a * h⁻¹ * a⁻¹       : by rw inv_inv,

    -- ... and ah⁻¹a⁻¹ is in aHa⁻¹.
    have t: a * h⁻¹ * a⁻¹ ∈ ((λ h, a * h * a⁻¹) '' H),
    from ⟨h⁻¹, ⟨is_subgroup.inv_mem hH, rfl⟩⟩,

    exact inv_g.symm ▸ t,
  end,

  -- the identity is in aHa⁻¹: 1 = a1a⁻¹.
  one_mem := ⟨1, ⟨
    hH.one_mem,
    calc a * 1 * a⁻¹ = 1: by rw [mul_one, mul_right_inv a] ⟩⟩,

  -- multiplication in aHa⁻¹ is closed because ah₁a⁻¹ * ah₂a⁻¹ = ah₁h₂a⁻¹.
  mul_mem := λ g₁ g₂ ⟨h₁, ⟨hh₁, hg₁⟩⟩ ⟨h₂, ⟨hh₂, hg₂⟩⟩, ⟨h₁ * h₂, ⟨

  is_submonoid.mul_mem hh₁ hh₂,

  hg₁ ▸ hg₂ ▸ calc a * (h₁ * h₂) * a⁻¹
    = a * h₁ * 1 * (h₂ * a⁻¹)         : by rw [←mul_assoc, mul_assoc, mul_one]
... = a * h₁ * (a⁻¹ * a) * (h₂ * a⁻¹) : by rw mul_left_inv
... = (a * h₁ * a⁻¹) * a * (h₂ * a⁻¹) : by rw ←(mul_assoc (a * h₁) a⁻¹ a)
... = (a * h₁ * a⁻¹) * (a * h₂ * a⁻¹) : by rw [mul_assoc, mul_assoc a h₂ a⁻¹],
  ⟩⟩,
}


import data.finset algebra.big_operators tactic.ring

namespace maths_challenges

-- the n'th odd number (we start counting at zero)
def odd (n : ℕ) := 2 * n + 1

#check @finset.sum

-- finset.range n is the finite set {0,1,2,...,n-1}
theorem challenge05 (n : ℕ) : (finset.range n).sum (odd) = n ^ 2 :=
begin
  induction n with n ih,
  { refl },
  { rw finset.sum_range_succ
  , rw ih
  , unfold odd
  , rw nat.succ_eq_add_one
  , ring }
end

end maths_challenges


import data.nat.basic tactic.induction

/-!
# Sheet 1: Primes and induction.
-/

/-!
## Question 1.

In each of the following cases, determine which integers `n` satisfy the stated
condition. Justify your answers.
-/

section question_1

variables m n a : ℕ

open nat

/-
We'll use the following results:
`le_antisymm`,
`le_of_dvd`,
`pos_of_dvd_of_pos`.
-/

example (h₁ : m ≤ n) (h₂ : n ≤ m) : m = n := le_antisymm h₁ h₂

example (h₁ : 0 < n) (h₂ : m ∣ n) : m ≤ n := le_of_dvd h₁ h₂

example (h₁ : m ∣ n) (h₂ : 0 < n) : 0 < m := pos_of_dvd_of_pos h₁ h₂

lemma q1_i : n ∣ 1 ↔ n = 1 :=
begin
  split, -- Split into proving `n ∣ 1 → n = 1` and `n = 1 → n ∣ 1`.
  -- First task it to prove `n ∣ 1 → n = 1`.
  { intro h, -- Assume `h : n ∣  1`. It suffices to prove `n = 1`.
    apply le_antisymm, -- It suffices to prove `n ≤ 1` and `1 ≤ n`.
    { -- Start by proving `n ≤ 1`.
      apply le_of_dvd, -- it suffices to prove `0 < 1` and `n ∣ 1`.
      { simp, },
      { exact h }, },
    { -- Now prove `1 ≤ n`.
      apply pos_of_dvd_of_pos h,
      simp, }, },
  -- Second task is to prove `n = 1 → n ∣ 1`.
  { intro h, rw h, },
end

/-
The `use` and `simp` and `trivial` tactics may help here.
It's more typical to write the following result as `1 ∣ n` rather than `1 ∣ n ↔ true`.
We've written the result this way so that we can `sorry` similar results in this question.
-/
lemma q1_ii : 1 ∣ n ↔ true :=
begin
  split,
  { intro h, sorry, },
  { intro h,
    dsimp [nat.has_dvd], -- By definition, we must show `∃ c, n = 1 * c`.
    sorry, },
end

-- `simp at ...` might be helpful below (replacing `...` with an appropriate hypothesis).
lemma q1_iii : 0 ∣ n ↔ n = 0 :=
begin
  split,
  { intro h, dsimp [nat.has_dvd] at h, -- By definition `h : ∃ c, n = 0 * c`.
    cases h with c h, -- Destructing, we have `c : ℕ` and `h : n = 0 * c`.
    sorry, },
  { sorry, },
end

lemma q1_iv : n ∣ 0 ↔ sorry :=
begin
  sorry,
end

lemma q1_v : n ∣ n ↔ sorry :=
begin
  sorry
end

-- The `specialize` tactic may be helpful here.
lemma q1_vi : (∀ a, a ∣ n) ↔ sorry :=
begin
  sorry
end

end question_1

-- add another comment


/-
Copyright (c) 2018 Mitchell Rowett. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mitchell Rowett, Scott Morrison
-/

import algebra.quotient
import group_theory.group_action.basic
import tactic.group

/-!
# Cosets

This file develops the basic theory of left and right cosets.

## Main definitions

* `left_coset a s`: the left coset `a * s` for an element `a : α` and a subset `s ⊆ α`, for an
  `add_group` this is `left_add_coset a s`.
* `right_coset s a`: the right coset `s * a` for an element `a : α` and a subset `s ⊆ α`, for an
  `add_group` this is `right_add_coset s a`.
* `quotient_group.quotient s`: the quotient type representing the left cosets with respect to a
  subgroup `s`, for an `add_group` this is `quotient_add_group.quotient s`.
* `quotient_group.mk`: the canonical map from `α` to `α/s` for a subgroup `s` of `α`, for an
  `add_group` this is `quotient_add_group.mk`.
* `subgroup.left_coset_equiv_subgroup`: the natural bijection between a left coset and the subgroup,
  for an `add_group` this is `add_subgroup.left_coset_equiv_add_subgroup`.

## Notation

* `a *l s`: for `left_coset a s`.
* `a +l s`: for `left_add_coset a s`.
* `s *r a`: for `right_coset s a`.
* `s +r a`: for `right_add_coset s a`.

* `G ⧸ H` is the quotient of the (additive) group `G` by the (additive) subgroup `H`

## TODO

Add `to_additive` to `preimage_mk_equiv_subgroup_times_set`.
-/

open set function

variable {α : Type*}

/-- The left coset `a * s` for an element `a : α` and a subset `s : set α` -/
@[to_additive left_add_coset "The left coset `a+s` for an element `a : α`
and a subset `s : set α`"]
def left_coset [has_mul α] (a : α) (s : set α) : set α := (λ x, a * x) '' s

/-- The right coset `s * a` for an element `a : α` and a subset `s : set α` -/
@[to_additive right_add_coset "The right coset `s+a` for an element `a : α`
and a subset `s : set α`"]
def right_coset [has_mul α] (s : set α) (a : α) : set α := (λ x, x * a) '' s

localized "infix ` *l `:70 := left_coset" in coset
localized "infix ` +l `:70 := left_add_coset" in coset
localized "infix ` *r `:70 := right_coset" in coset
localized "infix ` +r `:70 := right_add_coset" in coset

section coset_mul
variable [has_mul α]

@[to_additive mem_left_add_coset]
lemma mem_left_coset {s : set α} {x : α} (a : α) (hxS : x ∈ s) : a * x ∈ a *l s :=
mem_image_of_mem (λ b : α, a * b) hxS

@[to_additive mem_right_add_coset]
lemma mem_right_coset {s : set α} {x : α} (a : α) (hxS : x ∈ s) : x * a ∈ s *r a :=
mem_image_of_mem (λ b : α, b * a) hxS

/-- Equality of two left cosets `a * s` and `b * s`. -/
@[to_additive left_add_coset_equivalence "Equality of two left cosets `a + s` and `b + s`."]
def left_coset_equivalence (s : set α) (a b : α) := a *l s = b *l s

@[to_additive left_add_coset_equivalence_rel]
lemma left_coset_equivalence_rel (s : set α) : equivalence (left_coset_equivalence s) :=
mk_equivalence (left_coset_equivalence s) (λ a, rfl) (λ a b, eq.symm) (λ a b c, eq.trans)

/-- Equality of two right cosets `s * a` and `s * b`. -/
@[to_additive right_add_coset_equivalence "Equality of two right cosets `s + a` and `s + b`."]
def right_coset_equivalence (s : set α) (a b : α) := s *r a = s *r b

@[to_additive right_add_coset_equivalence_rel]
lemma right_coset_equivalence_rel (s : set α) : equivalence (right_coset_equivalence s) :=
mk_equivalence (right_coset_equivalence s) (λ a, rfl) (λ a b, eq.symm) (λ a b c, eq.trans)

end coset_mul

section coset_semigroup
variable [semigroup α]

@[simp, to_additive left_add_coset_assoc] lemma left_coset_assoc (s : set α) (a b : α) :
  a *l (b *l s) = (a * b) *l s :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]

@[simp, to_additive right_add_coset_assoc] lemma right_coset_assoc (s : set α) (a b : α) :
  s *r a *r b = s *r (a * b) :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]

@[to_additive left_add_coset_right_add_coset]
lemma left_coset_right_coset (s : set α) (a b : α) : a *l s *r b = a *l (s *r b) :=
by simp [left_coset, right_coset, (image_comp _ _ _).symm, function.comp, mul_assoc]

end coset_semigroup

section coset_monoid
variables [monoid α] (s : set α)

@[simp, to_additive zero_left_add_coset] lemma one_left_coset : 1 *l s = s :=
set.ext $ by simp [left_coset]

@[simp, to_additive right_add_coset_zero] lemma right_coset_one : s *r 1 = s :=
set.ext $ by simp [right_coset]

end coset_monoid

section coset_submonoid
open submonoid
variables [monoid α] (s : submonoid α)

@[to_additive mem_own_left_add_coset]
lemma mem_own_left_coset (a : α) : a ∈ a *l s :=
suffices a * 1 ∈ a *l s, by simpa,
mem_left_coset a (one_mem s : 1 ∈ s)

@[to_additive mem_own_right_add_coset]
lemma mem_own_right_coset (a : α) : a ∈ (s : set α) *r a :=
suffices 1 * a ∈ (s : set α) *r a, by simpa,
mem_right_coset a (one_mem s : 1 ∈ s)

@[to_additive mem_left_add_coset_left_add_coset]
lemma mem_left_coset_left_coset {a : α} (ha : a *l s = s) : a ∈ s :=
by rw [←set_like.mem_coe, ←ha]; exact mem_own_left_coset s a

@[to_additive mem_right_add_coset_right_add_coset]
lemma mem_right_coset_right_coset {a : α} (ha : (s : set α) *r a = s) : a ∈ s :=
by rw [←set_like.mem_coe, ←ha]; exact mem_own_right_coset s a

end coset_submonoid

section coset_group
variables [group α] {s : set α} {x : α}

@[to_additive mem_left_add_coset_iff]
lemma mem_left_coset_iff (a : α) : x ∈ a *l s ↔ a⁻¹ * x ∈ s :=
iff.intro
  (assume ⟨b, hb, eq⟩, by simp [eq.symm, hb])
  (assume h, ⟨a⁻¹ * x, h, by simp⟩)

@[to_additive mem_right_add_coset_iff]
lemma mem_right_coset_iff (a : α) : x ∈ s *r a ↔ x * a⁻¹ ∈ s :=
iff.intro
  (assume ⟨b, hb, eq⟩, by simp [eq.symm, hb])
  (assume h, ⟨x * a⁻¹, h, by simp⟩)

end coset_group

section coset_subgroup
open subgroup

variables [group α] (s : subgroup α)

@[to_additive left_add_coset_mem_left_add_coset]
lemma left_coset_mem_left_coset {a : α} (ha : a ∈ s) : a *l s = s :=
set.ext $ by simp [mem_left_coset_iff, mul_mem_cancel_left (s.inv_mem ha)]

@[to_additive right_add_coset_mem_right_add_coset]
lemma right_coset_mem_right_coset {a : α} (ha : a ∈ s) : (s : set α) *r a = s :=
set.ext $ assume b, by simp [mem_right_coset_iff, mul_mem_cancel_right (s.inv_mem ha)]

@[to_additive eq_add_cosets_of_normal]
theorem eq_cosets_of_normal (N : s.normal) (g : α) : g *l s = s *r g :=
set.ext $ assume a, by simp [mem_left_coset_iff, mem_right_coset_iff]; rw [N.mem_comm_iff]

@[to_additive normal_of_eq_add_cosets]
theorem normal_of_eq_cosets (h : ∀ g : α, g *l s = s *r g) : s.normal :=
⟨assume a ha g, show g * a * g⁻¹ ∈ (s : set α),
  by rw [← mem_right_coset_iff, ← h]; exact mem_left_coset g ha⟩

@[to_additive normal_iff_eq_add_cosets]
theorem normal_iff_eq_cosets : s.normal ↔ ∀ g : α, g *l s = s *r g :=
⟨@eq_cosets_of_normal _ _ s, normal_of_eq_cosets s⟩

@[to_additive left_add_coset_eq_iff]
lemma left_coset_eq_iff {x y : α} : left_coset x s = left_coset y s ↔ x⁻¹ * y ∈ s :=
begin
  rw set.ext_iff,
  simp_rw [mem_left_coset_iff, set_like.mem_coe],
  split,
  { intro h, apply (h y).mpr, rw mul_left_inv, exact s.one_mem },
  { intros h z, rw ←mul_inv_cancel_right x⁻¹ y, rw mul_assoc, exact s.mul_mem_cancel_left h },
end

@[to_additive right_add_coset_eq_iff]
lemma right_coset_eq_iff {x y : α} : right_coset ↑s x = right_coset s y ↔ y * x⁻¹ ∈ s :=
begin
  rw set.ext_iff,
  simp_rw [mem_right_coset_iff, set_like.mem_coe],
  split,
  { intro h, apply (h y).mpr, rw mul_right_inv, exact s.one_mem },
  { intros h z, rw ←inv_mul_cancel_left y x⁻¹, rw ←mul_assoc, exact s.mul_mem_cancel_right h },
end

end coset_subgroup

run_cmd to_additive.map_namespace `quotient_group `quotient_add_group

namespace quotient_group

variables [group α] (s : subgroup α)

/-- The equivalence relation corresponding to the partition of a group by left cosets
of a subgroup.-/
@[to_additive "The equivalence relation corresponding to the partition of a group by left cosets
of a subgroup."]
def left_rel : setoid α := mul_action.orbit_rel s.opposite α

variables {s}

@[to_additive]
lemma left_rel_apply {x y : α} : @setoid.r _ (left_rel s) x y ↔ (x⁻¹ * y ∈ s) :=
calc (∃ a : s.opposite, y * mul_opposite.unop a = x)
    ↔ ∃ a : s, y * a = x : s.opposite_equiv.symm.exists_congr_left
... ↔ ∃ a : s, x⁻¹ * y = a⁻¹ : by simp only [inv_mul_eq_iff_eq_mul, eq_mul_inv_iff_mul_eq]
... ↔ x⁻¹ * y ∈ s : by simp [set_like.exists]

variables (s)

@[to_additive]
lemma left_rel_eq : @setoid.r _ (left_rel s) = λ x y, x⁻¹ * y ∈ s :=
funext₂ $ by { simp only [eq_iff_iff], apply left_rel_apply }

lemma left_rel_r_eq_left_coset_equivalence :
  @setoid.r _ (quotient_group.left_rel s) = left_coset_equivalence s :=
by { ext, rw left_rel_eq, exact (left_coset_eq_iff s).symm }

@[to_additive]
instance left_rel_decidable [decidable_pred (∈ s)] :
  decidable_rel (left_rel s).r :=
λ x y, by { rw left_rel_eq, exact ‹decidable_pred (∈ s)› _ }

/-- `α ⧸ s` is the quotient type representing the left cosets of `s`.
  If `s` is a normal subgroup, `α ⧸ s` is a group -/
@[to_additive "`α ⧸ s` is the quotient type representing the left cosets of `s`.  If `s` is a
normal subgroup, `α ⧸ s` is a group"]
instance : has_quotient α (subgroup α) := ⟨λ s, quotient (left_rel s)⟩

/-- The equivalence relation corresponding to the partition of a group by right cosets of a
subgroup. -/
@[to_additive "The equivalence relation corresponding to the partition of a group by right cosets of
a subgroup."]
def right_rel : setoid α := mul_action.orbit_rel s α

variables {s}

@[to_additive]
lemma right_rel_apply {x y : α} : @setoid.r _ (right_rel s) x y ↔ (y * x⁻¹ ∈ s) :=
calc (∃ a : s, (a:α) * y = x)
    ↔ ∃ a : s, y * x⁻¹ = a⁻¹ : by simp only [mul_inv_eq_iff_eq_mul, eq_inv_mul_iff_mul_eq]
... ↔ y * x⁻¹ ∈ s : by simp [set_like.exists]

variables (s)

@[to_additive]
lemma right_rel_eq : @setoid.r _ (right_rel s) = λ x y, y * x⁻¹ ∈ s :=
funext₂ $ by { simp only [eq_iff_iff], apply right_rel_apply }

lemma right_rel_r_eq_right_coset_equivalence :
  @setoid.r _ (quotient_group.right_rel s) = right_coset_equivalence s :=
by { ext, rw right_rel_eq, exact (right_coset_eq_iff s).symm }

@[to_additive]
instance right_rel_decidable [decidable_pred (∈ s)] :
  decidable_rel (right_rel s).r :=
λ x y, by { rw right_rel_eq, exact ‹decidable_pred (∈ s)› _ }

/-- Right cosets are in bijection with left cosets. -/
@[to_additive "Right cosets are in bijection with left cosets."]
def quotient_right_rel_equiv_quotient_left_rel : quotient (quotient_group.right_rel s) ≃ α ⧸ s :=
{ to_fun := quotient.map' (λ g, g⁻¹) (λ a b, by { rw [left_rel_apply, right_rel_apply],
      exact λ h, (congr_arg (∈ s) (by group)).mp (s.inv_mem h) }),
  inv_fun := quotient.map' (λ g, g⁻¹) (λ a b, by { rw [left_rel_apply, right_rel_apply],
      exact λ h, (congr_arg (∈ s) (by group)).mp (s.inv_mem h) }),
  left_inv := λ g, quotient.induction_on' g (λ g, quotient.sound' (by
  { simp only [inv_inv],
    exact quotient.exact' rfl })),
  right_inv := λ g, quotient.induction_on' g (λ g, quotient.sound' (by
  { simp only [inv_inv],
    exact quotient.exact' rfl })) }

@[to_additive] instance fintype_quotient_right_rel [fintype (α ⧸ s)] :
  fintype (quotient (quotient_group.right_rel s)) :=
fintype.of_equiv (α ⧸ s) (quotient_group.quotient_right_rel_equiv_quotient_left_rel s).symm

@[to_additive] lemma card_quotient_right_rel [fintype (α ⧸ s)] :
  fintype.card (quotient (quotient_group.right_rel s)) = fintype.card (α ⧸ s) :=
fintype.of_equiv_card (quotient_group.quotient_right_rel_equiv_quotient_left_rel s).symm

end quotient_group

namespace quotient_group

variables [group α] {s : subgroup α}

@[to_additive]
instance fintype [fintype α] (s : subgroup α) [decidable_rel (left_rel s).r] :
  fintype (α ⧸ s) :=
quotient.fintype (left_rel s)

/-- The canonical map from a group `α` to the quotient `α ⧸ s`. -/
@[to_additive "The canonical map from an `add_group` `α` to the quotient `α ⧸ s`."]
abbreviation mk (a : α) : α ⧸ s :=
quotient.mk' a

@[to_additive]
lemma mk_surjective : function.surjective $ @mk _ _ s := quotient.surjective_quotient_mk'

@[elab_as_eliminator, to_additive]
lemma induction_on {C : α ⧸ s → Prop} (x : α ⧸ s)
  (H : ∀ z, C (quotient_group.mk z)) : C x :=
quotient.induction_on' x H

@[to_additive]
instance : has_coe_t α (α ⧸ s) := ⟨mk⟩ -- note [use has_coe_t]

@[elab_as_eliminator, to_additive]
lemma induction_on' {C : α ⧸ s → Prop} (x : α ⧸ s)
  (H : ∀ z : α, C z) : C x :=
quotient.induction_on' x H

@[simp, to_additive]
lemma quotient_lift_on_coe {β} (f : α → β) (h) (x : α) :
  quotient.lift_on' (x : α ⧸ s) f h = f x := rfl

@[to_additive]
lemma forall_coe {C : α ⧸ s → Prop} :
  (∀ x : α ⧸ s, C x) ↔ ∀ x : α, C x :=
⟨λ hx x, hx _, quot.ind⟩

@[to_additive]
instance (s : subgroup α) : inhabited (α ⧸ s) :=
⟨((1 : α) : α ⧸ s)⟩

@[to_additive quotient_add_group.eq]
protected lemma eq {a b : α} : (a : α ⧸ s) = b ↔ a⁻¹ * b ∈ s :=
calc _ ↔ @setoid.r _ (left_rel s) a b : quotient.eq'
... ↔ _ : by rw left_rel_apply

@[to_additive quotient_add_group.eq']
lemma eq' {a b : α} : (mk a : α ⧸ s) = mk b ↔ a⁻¹ * b ∈ s :=
quotient_group.eq

@[to_additive quotient_add_group.out_eq']
lemma out_eq' (a : α ⧸ s) : mk a.out' = a :=
quotient.out_eq' a

variables (s)

/- It can be useful to write `obtain ⟨h, H⟩ := mk_out'_eq_mul ...`, and then `rw [H]` or
  `simp_rw [H]` or `simp only [H]`. In order for `simp_rw` and `simp only` to work, this lemma is
  stated in terms of an arbitrary `h : s`, rathern that the specific `h = g⁻¹ * (mk g).out'`. -/
@[to_additive quotient_add_group.mk_out'_eq_mul]
lemma mk_out'_eq_mul (g : α) : ∃ h : s, (mk g : α ⧸ s).out' = g * h :=
⟨⟨g⁻¹ * (mk g).out', eq'.mp (mk g).out_eq'.symm⟩, by rw [set_like.coe_mk, mul_inv_cancel_left]⟩

variables {s}

@[to_additive quotient_add_group.mk_mul_of_mem]
lemma mk_mul_of_mem (g₁ g₂ : α) (hg₂ : g₂ ∈ s) : (mk (g₁ * g₂) : α ⧸ s) = mk g₁ :=
by rwa [eq', mul_inv_rev, inv_mul_cancel_right, s.inv_mem_iff]

@[to_additive]
lemma eq_class_eq_left_coset (s : subgroup α) (g : α) :
  {x : α | (x : α ⧸ s) = g} = left_coset g s :=
set.ext $ λ z,
  by rw [mem_left_coset_iff, set.mem_set_of_eq, eq_comm, quotient_group.eq, set_like.mem_coe]

@[to_additive]
lemma preimage_image_coe (N : subgroup α) (s : set α) :
  coe ⁻¹' ((coe : α → α ⧸ N) '' s) = ⋃ x : N, (λ y : α, y * x) ⁻¹' s :=
begin
  ext x,
  simp only [quotient_group.eq, set_like.exists, exists_prop, set.mem_preimage, set.mem_Union,
    set.mem_image, set_like.coe_mk, ← eq_inv_mul_iff_mul_eq],
  exact ⟨λ ⟨y, hs, hN⟩, ⟨_, N.inv_mem hN, by simpa using hs⟩,
         λ ⟨z, hz, hxz⟩, ⟨x*z, hxz, by simpa using hz⟩⟩,
end

end quotient_group

namespace subgroup
open quotient_group
variables [group α] {s : subgroup α}

/-- The natural bijection between a left coset `g * s` and `s`. -/
@[to_additive "The natural bijection between the cosets `g + s` and `s`."]
def left_coset_equiv_subgroup (g : α) : left_coset g s ≃ s :=
⟨λ x, ⟨g⁻¹ * x.1, (mem_left_coset_iff _).1 x.2⟩,
 λ x, ⟨g * x.1, x.1, x.2, rfl⟩,
 λ ⟨x, hx⟩, subtype.eq $ by simp,
 λ ⟨g, hg⟩, subtype.eq $ by simp⟩

/-- The natural bijection between a right coset `s * g` and `s`. -/
@[to_additive "The natural bijection between the cosets `s + g` and `s`."]
def right_coset_equiv_subgroup (g : α) : right_coset ↑s g ≃ s :=
⟨λ x, ⟨x.1 * g⁻¹, (mem_right_coset_iff _).1 x.2⟩,
 λ x, ⟨x.1 * g, x.1, x.2, rfl⟩,
 λ ⟨x, hx⟩, subtype.eq $ by simp,
 λ ⟨g, hg⟩, subtype.eq $ by simp⟩

/-- A (non-canonical) bijection between a group `α` and the product `(α/s) × s` -/
@[to_additive "A (non-canonical) bijection between an add_group `α` and the product `(α/s) × s`"]
noncomputable def group_equiv_quotient_times_subgroup :
  α ≃ (α ⧸ s) × s :=
calc α ≃ Σ L : α ⧸ s, {x : α // (x : α ⧸ s) = L} :
  (equiv.sigma_fiber_equiv quotient_group.mk).symm
    ... ≃ Σ L : α ⧸ s, left_coset (quotient.out' L) s :
  equiv.sigma_congr_right (λ L,
    begin
      rw ← eq_class_eq_left_coset,
      show _root_.subtype (λ x : α, quotient.mk' x = L) ≃
        _root_.subtype (λ x : α, quotient.mk' x = quotient.mk' _),
      simp [-quotient.eq'],
    end)
    ... ≃ Σ L : α ⧸ s, s :
  equiv.sigma_congr_right (λ L, left_coset_equiv_subgroup _)
    ... ≃ (α ⧸ s) × s :
  equiv.sigma_equiv_prod _ _

variables {t : subgroup α}

/-- If `H ≤ K`, then `G/H ≃ G/K × K/H` constructively, using the provided right inverse
of the quotient map `G → G/K`. The classical version is `quotient_equiv_prod_of_le`. -/
@[to_additive "If `H ≤ K`, then `G/H ≃ G/K × K/H` constructively, using the provided right inverse
of the quotient map `G → G/K`. The classical version is `quotient_equiv_prod_of_le`.", simps]
def quotient_equiv_prod_of_le' (h_le : s ≤ t)
  (f : α ⧸ t → α) (hf : function.right_inverse f quotient_group.mk) :
  α ⧸ s ≃ (α ⧸ t) × (t ⧸ s.subgroup_of t) :=
{ to_fun := λ a, ⟨a.map' id (λ b c h, left_rel_apply.mpr (h_le (left_rel_apply.mp h))),
    a.map' (λ g : α, ⟨(f (quotient.mk' g))⁻¹ * g, left_rel_apply.mp (quotient.exact' (hf g))⟩)
    (λ b c h, by
    { rw left_rel_apply,
      change ((f b)⁻¹ * b)⁻¹ * ((f c)⁻¹ * c) ∈ s,
      have key : f b = f c :=
        congr_arg f (quotient.sound' (left_rel_apply.mpr (h_le (left_rel_apply.mp h)))),
      rwa [key, mul_inv_rev, inv_inv, mul_assoc, mul_inv_cancel_left, ← left_rel_apply] })⟩,
  inv_fun := λ a, a.2.map' (λ b, f a.1 * b) (λ b c h, by
  { rw left_rel_apply at ⊢ h,
    change (f a.1 * b)⁻¹ * (f a.1 * c) ∈ s,
    rwa [mul_inv_rev, mul_assoc, inv_mul_cancel_left] }),
  left_inv := by
  { refine quotient.ind' (λ a, _),
    simp_rw [quotient.map'_mk', id.def, set_like.coe_mk, mul_inv_cancel_left] },
  right_inv := by
  { refine prod.rec _,
    refine quotient.ind' (λ a, _),
    refine quotient.ind' (λ b, _),
    have key : quotient.mk' (f (quotient.mk' a) * b) = quotient.mk' a :=
      (quotient_group.mk_mul_of_mem (f a) ↑b b.2).trans (hf a),
    simp_rw [quotient.map'_mk', id.def, key, inv_mul_cancel_left, subtype.coe_eta] } }

/-- If `H ≤ K`, then `G/H ≃ G/K × K/H` nonconstructively.
The constructive version is `quotient_equiv_prod_of_le'`. -/
@[to_additive "If `H ≤ K`, then `G/H ≃ G/K × K/H` nonconstructively.
The constructive version is `quotient_equiv_prod_of_le'`.", simps]
noncomputable def quotient_equiv_prod_of_le (h_le : s ≤ t) :
  α ⧸ s ≃ (α ⧸ t) × (t ⧸ s.subgroup_of t) :=
quotient_equiv_prod_of_le' h_le quotient.out' quotient.out_eq'

/-- If `K ≤ L`, then there is an embedding `K ⧸ (H.subgroup_of K) ↪ L ⧸ (H.subgroup_of L)`. -/
@[to_additive "If `K ≤ L`, then there is an embedding
  `K ⧸ (H.add_subgroup_of K) ↪ L ⧸ (H.add_subgroup_of L)`."]
def quotient_subgroup_of_embedding_of_le (H : subgroup α) {K L : subgroup α} (h : K ≤ L) :
  K ⧸ (H.subgroup_of K) ↪ L ⧸ (H.subgroup_of L) :=
{ to_fun := quotient.map' (set.inclusion h) (λ a b, by { simp [left_rel_apply], exact id }),
  inj' := begin
    refine quotient.ind₂' (λ a b, _),
    refine λ h, (quotient.eq'.mpr ∘ left_rel_apply.mpr) _,
    have := left_rel_apply.mp (quotient.eq'.mp h),
    exact this,
  end }

@[to_additive] lemma card_eq_card_quotient_mul_card_subgroup
  [fintype α] (s : subgroup α) [fintype s] [decidable_pred (λ a, a ∈ s)] :
  fintype.card α = fintype.card (α ⧸ s) * fintype.card s :=
by rw ← fintype.card_prod;
  exact fintype.card_congr (subgroup.group_equiv_quotient_times_subgroup)

/-- **Lagrange's Theorem**: The order of a subgroup divides the order of its ambient group. -/
@[to_additive] lemma card_subgroup_dvd_card [fintype α] (s : subgroup α) [fintype s] :
  fintype.card s ∣ fintype.card α :=
by classical; simp [card_eq_card_quotient_mul_card_subgroup s, @dvd_mul_left ℕ]

@[to_additive] lemma card_quotient_dvd_card [fintype α] (s : subgroup α)
  [decidable_pred (λ a, a ∈ s)] [fintype s] : fintype.card (α ⧸ s) ∣ fintype.card α :=
by simp [card_eq_card_quotient_mul_card_subgroup s, @dvd_mul_right ℕ]

open fintype

variables {H : Type*} [group H]

@[to_additive] lemma card_dvd_of_injective [fintype α] [fintype H] (f : α →* H)
  (hf : function.injective f) : card α ∣ card H :=
by classical;
calc card α = card (f.range : subgroup H) : card_congr (equiv.of_injective f hf)
...∣ card H : card_subgroup_dvd_card _

@[to_additive] lemma card_dvd_of_le {H K : subgroup α} [fintype H] [fintype K] (hHK : H ≤ K) :
  card H ∣ card K :=
card_dvd_of_injective (inclusion hHK) (inclusion_injective hHK)

@[to_additive] lemma card_comap_dvd_of_injective (K : subgroup H) [fintype K]
  (f : α →* H) [fintype (K.comap f)] (hf : function.injective f) :
  fintype.card (K.comap f) ∣ fintype.card K :=
by haveI : fintype ((K.comap f).map f) :=
  fintype.of_equiv _ (equiv_map_of_injective _ _ hf).to_equiv;
calc fintype.card (K.comap f) = fintype.card ((K.comap f).map f) :
       fintype.card_congr (equiv_map_of_injective _ _ hf).to_equiv
... ∣ fintype.card K : card_dvd_of_le (map_comap_le _ _)

end subgroup

namespace quotient_group

variables [group α]

-- FIXME -- why is there no `to_additive`?

/-- If `s` is a subgroup of the group `α`, and `t` is a subset of `α/s`, then
there is a (typically non-canonical) bijection between the preimage of `t` in
`α` and the product `s × t`. -/
noncomputable def preimage_mk_equiv_subgroup_times_set
  (s : subgroup α) (t : set (α ⧸ s)) : quotient_group.mk ⁻¹' t ≃ s × t :=
have h : ∀ {x : α ⧸ s} {a : α}, x ∈ t → a ∈ s →
  (quotient.mk' (quotient.out' x * a) : α ⧸ s) = quotient.mk' (quotient.out' x) :=
    λ x a hx ha, quotient.sound' $ by rwa [left_rel_apply, ← s.inv_mem_iff, mul_inv_rev, inv_inv,
        ← mul_assoc, inv_mul_self, one_mul],
{ to_fun := λ ⟨a, ha⟩, ⟨⟨(quotient.out' (quotient.mk' a))⁻¹ * a,
    left_rel_apply.mp (@quotient.exact' _ (left_rel s) _ _ $ (quotient.out_eq' _))⟩,
      ⟨quotient.mk' a, ha⟩⟩,
  inv_fun := λ ⟨⟨a, ha⟩, ⟨x, hx⟩⟩, ⟨quotient.out' x * a, show quotient.mk' _ ∈ t,
    by simp [h hx ha, hx]⟩,
  left_inv := λ ⟨a, ha⟩, subtype.eq $ show _ * _ = a, by simp,
  right_inv := λ ⟨⟨a, ha⟩, ⟨x, hx⟩⟩, show (_, _) = _, by simp [h hx ha] }

end quotient_group

/--
We use the class `has_coe_t` instead of `has_coe` if the first argument is a variable,
or if the second argument is a variable not occurring in the first.
Using `has_coe` would cause looping of type-class inference. See
<https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/remove.20all.20instances.20with.20variable.20domain>
-/
library_note "use has_coe_t"


-- we want to use tactics
import tactic
-- we want to use the real numbers
import data.real.basic

/-

# Limits of sequences in Lean

We give the standard `ε`, `N` definition of the limit of a sequence
and prove some theorems about them. The boss level: limit of
products is product of limits.

-/

/-

## lambda (λ) notation for functions

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

-/

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

/-

Mathematicians might write `n ↦ n^2+3` for this functions; indeed `λ` is
just prefix notation for the infix notation `↦` (i.e. you write it at the
front, not in the middle).

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

## Limit of a sequence.

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

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

-- the basic API for `tendsto`

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

/-

## The questions

Here are some basic results about limits of sequences.
See if you can fill in the `sorry`s with Lean proofs.
The HINTS.md file in this directory contains some mathematical
sketch proofs and some hints about which tactics might be helpful
in this situation.

-/

/-- The limit of the constant sequence with value 37 is 37. -/
theorem tendsto_thirtyseven (c : ℝ) : tendsto (λ n, 37) 37 :=
begin
  rw tendsto_def, -- you can just comment this out and the pf still works
  intros ε hε,
  use 1234567, -- any natural will do, but we have to choose one
  intros n hn,
  simp, -- because the goal mentions `|37 - 37|` which can
  -- be solved by "simplifying rewrites" like `c - c = 0`
  exact hε, -- you can combine the last two tactics with `simp [hε]`
end

/-- The limit of the constant sequence with value `c` is `c`. -/
theorem tendsto_const (c : ℝ) : tendsto (λ n, c) c :=
begin
  rw tendsto_def,
  intros ε hε,
  use 42,
  intros, -- something I promise I will never use just got a weird name
  -- because I couldn't be bothered to name it
  simp [hε],
end

/-- If `a(n)` tends to `t` then `a(n) + c` tends to `t + c` -/
theorem tendsto_add_const {a : ℕ → ℝ} {t : ℝ} (c : ℝ)
  (h : tendsto a t) :
  tendsto (λ n, a n + c) (t + c) :=
begin
  rw tendsto_def at *,
  intros ε hε,
  specialize h ε hε,
  cases h with B hB,
  use B,
  intros n hn,
  specialize hB n hn,
  convert hB using 2, -- could have done `convert hB n hn using 2` and saved a line,
  ring,
end

-- alternative proof
theorem tendsto_add_const' {a : ℕ → ℝ} {t : ℝ} (c : ℝ)
  (h : tendsto a t) :
  tendsto (λ n, a n + c) (t + c) :=
begin
  rw tendsto_def at *,
  simpa using h, -- if you have a hypothesis `h` and
  -- a goal `⊢ P`, and if after running the simplifier on
  -- both `h` and `P` the terms become definitionally equal,
  -- then `simpa using h` closes the goal. Try `simp *`
  -- before the `simpa` to see what happens. `simp, assumption`
  -- also closes the goal.
end

/-- If `a(n)` tends to `t` then `-a(n)` tends to `-t`.  -/
theorem tendsto_neg {a : ℕ → ℝ} {t : ℝ} (ha : tendsto a t) :
  tendsto (λ n, - a n) (-t) :=
begin
  rw tendsto_def at *,
  simpa [abs_sub_comm] using ha,
end

/-- If `a(n)` tends to `t` and `b(n)` tends to `u` then `a(n) + b(n)`
tends to `t + u`. -/
theorem tendsto_add {a b : ℕ → ℝ} {t u : ℝ}
  (ha : tendsto a t) (hb : tendsto b u) :
  tendsto (λ n, a n + b n) (t + u) :=
begin
  intros ε hε,
  specialize ha (ε/2) (by linarith),
  specialize hb (ε/2) (by linarith),
  cases ha with B₁ hB₁,
  cases hb with B₂ hB₂,
  use max B₁ B₂, -- Application of the `use` tactic often indicates an "idea" in a proof.
  intros n hn,
  rw max_le_iff at hn,
  cases hn with hn₁ hn₂,
  dsimp only, -- git rid of stupid lambda
  specialize hB₁ n hn₁,
  specialize hB₂ n hn₂,
  rw abs_lt at *,
  cases hB₁,
  cases hB₂,
  split; -- semicolon means "do both goals with next tactic"
  linarith,
end

/-- If `a(n)` tends to t and `b(n)` tends to `u` then `a(n) - b(n)`
tends to `t - u`. -/
theorem tendsto_sub {a b : ℕ → ℝ} {t u : ℝ}
  (ha : tendsto a t) (hb : tendsto b u) :
  tendsto (λ n, a n - b n) (t - u) :=
tendsto_add ha (tendsto_neg hb) -- you could put `begin exact tendsto_add ... end` but this is quicker
-- note also we are using the fact that `t - u` is *defined* to mean `t + -u`.

/-- If `a(n)` tends to `t` then `37 * a(n)` tends to `37 * t`-/
theorem tendsto_thirtyseven_mul (a : ℕ → ℝ) (t : ℝ) (h : tendsto a t) :
  tendsto (λ n, 37 * a n) (37 * t) :=
begin
  intros ε hε,
  specialize h (ε/37) (by linarith),
  cases h with B hB,
  use B,
  intros n hn,
  specialize hB n hn,
  -- now we have a tricky little inequality problem
  rw [← mul_sub, abs_mul, abs_of_nonneg (show (0 : ℝ) ≤ 37, by norm_num)], -- now can treat |a n - t| as a constant
  -- I found a lot of those rewrites by experimenting with `library_search`.
  linarith,
end

/-- If `a(n)` tends to `t` and `c` is a positive constant then
`c * a(n)` tends to `c * t`. -/
theorem tendsto_pos_const_mul {a : ℕ → ℝ} {t : ℝ} (h : tendsto a t)
  {c : ℝ} (hc : 0 < c) : tendsto (λ n, c * a n) (c * t) :=
begin
  intros ε hε,
  specialize h (ε/c) (div_pos hε hc),
  cases h with B hB,
  use B,
  intros n hn,
  specialize hB n hn,
  rw [← mul_sub, abs_mul, abs_of_nonneg (show c ≥ 0, by linarith)],
  exact (lt_div_iff' hc).mp hB, -- thanks library_search
end

/-- If `a(n)` tends to `t` and `c` is a negative constant then
`c * a(n)` tends to `c * t`. -/
theorem tendsto_neg_const_mul {a : ℕ → ℝ} {t : ℝ} (h : tendsto a t)
  {c : ℝ} (hc : c < 0) : tendsto (λ n, c * a n) (c * t) :=
begin
  -- handy hypothesis
  have hc' : 0 < -c := neg_pos.mpr hc, -- thanks `library_search`
  intros ε hε,
  specialize h ((ε/(-c))) (div_pos hε hc'),
  cases h with B hB,
  use B,
  intros n hn,
  specialize hB n hn,
  dsimp only, -- get rid of λ
  rw [← mul_sub, abs_mul, abs_of_neg hc],
  exact (lt_div_iff' hc').mp hB,
end

/-- If `a(n)` tends to `t` and `c` is a constant then `c * a(n)` tends
to `c * t`. -/
theorem tendsto_const_mul {a : ℕ → ℝ} {t : ℝ} (c : ℝ) (h : tendsto a t) :
  tendsto (λ n, c * a n) (c * t) :=
begin
  -- split into 3 cases 0 < c, c = 0 and c < 0
  rcases lt_trichotomy 0 c with (hc | rfl | hc),
  -- c > 0
  { apply tendsto_pos_const_mul h hc },
  -- c = 0 easy
  { convert tendsto_const 0,
    { ext,
      simp },
    { simp } },
  -- c < 0
  { apply tendsto_neg_const_mul h hc },
end

/-- If `a(n)` tends to `t` and `c` is a constant then `a(n) * c` tends
to `t * c`. -/
theorem tendsto_mul_const {a : ℕ → ℝ} {t : ℝ} (c : ℝ) (h : tendsto a t) :
  tendsto (λ n, a n * c) (t * c) :=
by simpa [mul_comm t, mul_comm _ c] using tendsto_const_mul c h
-- `by tac` is the same as `begin tac end`, i.e. tactic blocks of length 1

-- another proof of this
theorem tendsto_neg' {a : ℕ → ℝ} {t : ℝ} (ha : tendsto a t) :
  tendsto (λ n, - a n) (-t) :=
begin
  convert tendsto_const_mul (-1) ha, -- nearly right but not *exactly* right; new goals are the differences
  { ext, simp },
  { simp },
end

/-- If `a(n)-b(n)` tends to `t` and `b(n)` tends to `u` then
`a(n)` tends to `t + u`. -/
theorem tendsto_of_tendsto_sub {a b : ℕ → ℝ} {t u : ℝ}
  (h1 : tendsto (λ n, a n - b n) t) (h2 : tendsto b u) :
  tendsto a (t+u) :=
begin
  convert tendsto_add h1 h2, -- reduces to an equality of functions
  ext, -- apply functional extensionality
  simp, -- `ring` would work too
end

/-- If `a(n)` tends to `t` then `a(n)-t` tends to `0`. -/
theorem tendsto_sub_lim {a : ℕ → ℝ} {t : ℝ}
  (h : tendsto a t) : tendsto (λ n, a n - t) 0 :=
begin
  convert tendsto_add_const (-t) h, -- nearly right
  simp, -- last bit easy from simplifying rewrites.
end

/-- If `a(n)` and `b(n)` both tend to zero, then their product tends
to zero. -/
theorem tendsto_zero_mul_tendsto_zero
  {a b : ℕ → ℝ} (ha : tendsto a 0) (hb : tendsto b 0) :
  tendsto (λ n, a n * b n) 0 :=
begin
  intros ε hε,
  specialize ha ε hε,
  specialize hb 1 (by linarith),
  cases ha with Ba hBa,
  cases hb with Bb hBb,
  use (max Ba Bb),
  intros n hn,
  rw max_le_iff at hn,
  cases hn with ha hb,
  specialize hBa n ha,
  specialize hBb n hb,
  simp only [gt_iff_lt, sub_zero] at *, -- non-terminal simp was removed via `squeeze_simp`.
  rw abs_mul,
  have h0 : 0 ≤ |a n| := abs_nonneg (a n),
  have h1 : 0 ≤ |b n| := abs_nonneg (b n),
  nlinarith, -- general purpose non-linear inequality solver.
end

/-- If `a(n)` tends to `t` and `b(n)` tends to `u` then
`a(n)*b(n)` tends to `t*u`. -/
theorem tendsto_mul (a b : ℕ → ℝ) (t u : ℝ) (ha : tendsto a t)
  (hb : tendsto b u) : tendsto (λ n, a n * b n) (t * u) :=
begin
  -- this method was harder than I thought because the algebra
  -- under the binders was fiddly. I abstracted out random lemmas.
  -- maybe if you went a different way you would have needed other
  -- random lemmas instead of `tendsto_of_tendsto_sub`
  have h1 : tendsto (λ n, a n - t) 0 := tendsto_sub_lim ha,
  have h2 : tendsto (λ n, b n - u) 0 := tendsto_sub_lim hb,
  have h3 := tendsto_zero_mul_tendsto_zero h1 h2,
  clear h1 h2, -- these are no longer needed
  simp only [sub_mul, mul_sub] at h3,
  replace ha := tendsto_mul_const u ha,
  replace ha := tendsto_sub_lim ha,
  simp only at ha,
  replace hb := tendsto_const_mul t hb,
  have h6 := tendsto_of_tendsto_sub h3 ha,
  clear h3 ha,
  simp only [zero_add] at h6,
  have h8 := tendsto_of_tendsto_sub h6 hb,
  clear h6 hb, -- tidying up after ourselves for no apparent reason
  simpa [zero_add] using h8,
end

-- something we never used!
/-- A sequence has at most one limit. -/
theorem tendsto_unique (a : ℕ → ℝ) (s t : ℝ)
  (hs : tendsto a s) (ht : tendsto a t) : s = t :=
begin
  by_contra hne,
  wlog h : s < t,
  { rcases lt_trichotomy s t with (hst | rfl | hts),
    { left, assumption },
    { exact false.elim (hne rfl) },
    { right, assumption } },
  clear hne, -- have h now
  let ε := (t - s) / 2,
  have hεts : ε * 2 = t - s := by simp,
  have hε : 0 < ε := div_pos (by linarith) zero_lt_two,
  rcases hs ε hε with ⟨Bs, hs⟩,
  rcases ht ε hε with ⟨Bt, ht⟩,
  specialize hs (max Bs Bt) (le_max_left _ _),
  specialize ht (max Bs Bt) (le_max_right _ _),
  rw abs_lt at hs ht,
  cases ht, cases hs, linarith,
end