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

import algebra.group_power.basic
import logic.function.iterate
import group_theory.perm.basic

/-!
# Iterates of monoid and ring homomorphisms

Iterate of a monoid/ring homomorphism is a monoid/ring homomorphism but it has a wrong type, so Lean
can't apply lemmas like `monoid_hom.map_one` to `f^[n] 1`. Though it is possible to define
a monoid structure on the endomorphisms, quite often we do not want to convert from
`M →* M` to (not yet defined) `monoid.End M` and from `f^[n]` to `f^n` just to apply a simple lemma.

So, we restate standard `*_hom.map_*` lemmas under names `*_hom.iterate_map_*`.

We also prove formulas for iterates of add/mul left/right.

## Tags

homomorphism, iterate
-/

open function

variables {M : Type*} {N : Type*} {G : Type*} {H : Type*}

/-- An auxiliary lemma that can be used to prove `⇑(f ^ n) = (⇑f^[n])`. -/
lemma hom_coe_pow {F : Type*} [monoid F] (c : F → M → M) (h1 : c 1 = id)
  (hmul : ∀ f g, c (f * g) = c f ∘ c g) (f : F) : ∀ n, c (f ^ n) = (c f^[n])
| 0 := by { rw [pow_zero, h1], refl }
| (n + 1) := by rw [pow_succ, iterate_succ', hmul, hom_coe_pow]

namespace monoid_hom

section

variables [mul_one_class M] [mul_one_class N]

@[simp, to_additive]
theorem iterate_map_one (f : M →* M) (n : ℕ) : f^[n] 1 = 1 :=
iterate_fixed f.map_one n

@[simp, to_additive]
theorem iterate_map_mul (f : M →* M) (n : ℕ) (x y) :
  f^[n] (x * y) = (f^[n] x) * (f^[n] y) :=
semiconj₂.iterate f.map_mul n x y

end

variables [monoid M] [monoid N] [group G] [group H]

@[simp, to_additive]
theorem iterate_map_inv (f : G →* G) (n : ℕ) (x) :
  f^[n] (x⁻¹) = (f^[n] x)⁻¹ :=
commute.iterate_left f.map_inv n x

theorem iterate_map_pow (f : M →* M) (a) (n m : ℕ) : f^[n] (a^m) = (f^[n] a)^m :=
commute.iterate_left (λ x, f.map_pow x m) n a

theorem iterate_map_zpow (f : G →* G) (a) (n : ℕ) (m : ℤ) : f^[n] (a^m) = (f^[n] a)^m :=
commute.iterate_left (λ x, f.map_zpow x m) n a

lemma coe_pow {M} [comm_monoid M] (f : monoid.End M) (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) _ _

end monoid_hom

namespace add_monoid_hom

variables [add_monoid M] [add_monoid N] [add_group G] [add_group H]

@[simp]
theorem iterate_map_sub (f : G →+ G) (n : ℕ) (x y) :
  f^[n] (x - y) = (f^[n] x) - (f^[n] y) :=
semiconj₂.iterate f.map_sub n x y

theorem iterate_map_smul (f : M →+ M) (n m : ℕ) (x : M) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_multiplicative.iterate_map_pow x n m

theorem iterate_map_zsmul (f : G →+ G) (n : ℕ) (m : ℤ) (x : G) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_multiplicative.iterate_map_zpow x n m

end add_monoid_hom

namespace ring_hom

section semiring

variables {R : Type*} [semiring R] (f : R →+* R) (n : ℕ) (x y : R)

lemma coe_pow (n : ℕ) : ⇑(f^n) = (f^[n]) :=
hom_coe_pow _ rfl (λ f g, rfl) f n

theorem iterate_map_one : f^[n] 1 = 1 := f.to_monoid_hom.iterate_map_one n

theorem iterate_map_zero : f^[n] 0 = 0 := f.to_add_monoid_hom.iterate_map_zero n

theorem iterate_map_add : f^[n] (x + y) = (f^[n] x) + (f^[n] y) :=
f.to_add_monoid_hom.iterate_map_add n x y

theorem iterate_map_mul : f^[n] (x * y) = (f^[n] x) * (f^[n] y) :=
f.to_monoid_hom.iterate_map_mul n x y

theorem iterate_map_pow (a) (n m : ℕ) : f^[n] (a^m) = (f^[n] a)^m :=
f.to_monoid_hom.iterate_map_pow a n m

theorem iterate_map_smul (n m : ℕ) (x : R) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_add_monoid_hom.iterate_map_smul n m x

end semiring

variables {R : Type*} [ring R] (f : R →+* R) (n : ℕ) (x y : R)

theorem iterate_map_sub : f^[n] (x - y) = (f^[n] x) - (f^[n] y) :=
f.to_add_monoid_hom.iterate_map_sub n x y

theorem iterate_map_neg : f^[n] (-x) = -(f^[n] x) :=
f.to_add_monoid_hom.iterate_map_neg n x

theorem iterate_map_zsmul (n : ℕ) (m : ℤ) (x : R) :
  f^[n] (m • x) = m • (f^[n] x) :=
f.to_add_monoid_hom.iterate_map_zsmul n m x

end ring_hom

lemma equiv.perm.coe_pow {α : Type*} (f : equiv.perm α) (n : ℕ) : ⇑(f ^ n) = (f^[n]) :=
hom_coe_pow _ rfl (λ _ _, rfl) _ _

--what should be the namespace for this section?
section monoid

variables [monoid G] (a : G) (n : ℕ)

@[simp, to_additive] lemma mul_left_iterate : ((*) a)^[n] = (*) (a^n) :=
nat.rec_on n (funext $ λ x, by simp) $ λ n ihn,
funext $ λ x, by simp [iterate_succ, ihn, pow_succ', mul_assoc]

@[simp, to_additive] lemma mul_right_iterate : (* a)^[n] = (* a ^ n) :=
begin
  induction n with d hd,
  { simpa },
  { simp [← pow_succ, hd] }
end

@[to_additive]
lemma mul_right_iterate_apply_one : (* a)^[n] 1 = a ^ n :=
by simp [mul_right_iterate]

end monoid

section semigroup

variables [semigroup G] {a b c : G}

@[to_additive]
lemma semiconj_by.function_semiconj_mul_left (h : semiconj_by a b c) :
  function.semiconj ((*)a) ((*)b) ((*)c) :=
λ j, by rw [← mul_assoc, h.eq, mul_assoc]

@[to_additive]
lemma commute.function_commute_mul_left (h : commute a b) :
  function.commute ((*)a) ((*)b) :=
semiconj_by.function_semiconj_mul_left h

@[to_additive]
lemma semiconj_by.function_semiconj_mul_right_swap (h : semiconj_by a b c) :
  function.semiconj (*a) (*c) (*b) :=
λ j, by simp_rw [mul_assoc, ← h.eq]

@[to_additive]
lemma commute.function_commute_mul_right (h : commute a b) :
  function.commute (*a) (*b) :=
semiconj_by.function_semiconj_mul_right_swap h

end semigroup


/-
Released under Apache 2.0 license as described in the file LICENSE.
Author: Peter Jipsen
Names based on http://math.chapman.edu/~jipsen/structures/doku.php
-/

import init.logic .identities
universes u

class Mag {α:Type u}(o:α→α → α)                         --Magmas (=Binars)

class Sgrp{α:Type u}(o:α→α → α) :=                      --Semigroups
(asso: associative o)

lemma asso_sgrp {α : Type}{o:α→α → α}{e:α} [Sgrp o]:  --sgrps are associative
    ∀a b c:α, o(o a b)c = o a(o b c) := Sgrp.asso o

class CSgrp{α:Type u}(o:α→α → α) extends Sgrp o :=      --Commutative semigroups
(comm: commutative o)

class Band {α:Type u}(m:α→α → α) extends Sgrp m :=      --Bands
(idem: idempotent m)

class Slat {α:Type u}(m:α→α → α) extends Band m :=      --Semiattices
(comm: commutative m)
-- use coersion to tell Lean that every Slat is an idempotent CSgrp

class Lat {α:Type u}(j:α→α → α)(m:α→α → α) :=           --Lattices
(asso_j: associative j)(asso_m: associative m)
(comm_j: commutative j)(comm_m: commutative m)
(abs_jm: absorption j m)(abs_mj: absorption m j)

class Mon {α:Type u}(o:α→α → α)(e:α) extends Sgrp o :=  --Monoids
(id_l: identity_l o e)
(id_r: identity_r o e)

lemma asso {α : Type}{o:α→α → α}{e:α} [Mon o e]:  -- monoids are associative
    ∀a b c:α, o(o a b)c = o a(o b c) := Sgrp.asso o

class CMon {α:Type u}(o:α→α → α)(e:α) extends Mon o e :=--Commutative monoids
(comm: commutative o)

--class MValg {α:Type u}(o:α→α → α)(i:α → α)(e:α) extends Sgrp o := --MV-algebras

class Grp {α:Type u}(o:α→α → α)(i:α → α)(e:α) extends Sgrp o := --Groups
(id_l : identity_l o e)
(inv_l: inverse_r o i e)

-- Some small models

inductive M₂: Type | e:M₂ | a:M₂
export M₂ (e a)
namespace M₂            -- 2-elt idempotent monoid
  def cdot:  M₂→M₂ → M₂ | e x := x  | x e := x | a a := a

  lemma cdot_id: identity_r cdot e := assume x, by cases x; refl
  lemma id_cdot: identity_l cdot e := assume x, by cases x; refl
  lemma cdot_asso: associative cdot :=
    assume x y z, by cases x; cases y; cases z; refl
  lemma cdot_idem: idempotent cdot := assume x, by cases x; refl

  instance: Sgrp cdot := ⟨cdot_asso⟩
  instance: Band cdot := ⟨cdot_idem⟩   -- removed 1st component ⟨cdot_asso⟩,
  instance: Mon cdot e := ⟨id_cdot, cdot_id⟩  -- removed 1st component ⟨cdot_asso⟩,
end M₂

inductive Z₂: Type | e:Z₂ | a:Z₂
export Z₂ (e a)
namespace Z₂            -- 2-elt group
  def add:  Z₂→Z₂ → Z₂ | e x := x  | x e := x | a a := e

  lemma add_zero: right_identity add e := assume x, by cases x; refl
  lemma zero_add: left_identity add e := assume x, by cases x; refl
  lemma add_assoc: associative add :=
  assume x y z, by cases x; cases y; cases z; refl

  instance: Sgrp add := ⟨add_assoc⟩
  instance: Mon add e := ⟨zero_add, add_zero⟩   -- removed 1st component ⟨add_asso⟩,
end Z₂


import tactic

inductive mynat
| Z : mynat
| S : mynat → mynat

namespace mynat

example : mynat := Z

#check Z
#check S(Z)
#check S(S(S(S(S(S(S(S(Z))))))))

-- clearly just numbers (count the S's)

end mynat

-- more powerful system of numbers!

inductive supernat
| Z : supernat
| S : supernat → supernat
| T : supernat → supernat

namespace supernat

#check S(Z)
#check T(Z)

#check S(T(T(S(T(S(S(T(T(Z)))))))))

-- clearly some rich binary tree

end supernat

/-

How can we understand things like STSSTSTSTSTSSZ ?

First thing we notice: they all end in Z

So really a term of this type is just more like STSSSTSTSTSSTS

-- a string of S's and T's

Imagine S=0 and T=1

-- it's a string of zeros and 1s!

-- So it's a binary number!

-- is supernat = nat?

Binary numbers 1001 and 00000001001 are the same

But TSST ≠ SSSSSSSTSST

0
1
10
11
100
101
110
111
1000
...

Other than 0, they do all start with 1. Maybe that was Z?

How about Z=initial 1, and then read it backwards

general number is

ZSSTST (backwards)

and this should become
100101 = 37

so supernat is just binary

-/

inductive binary_nat
| one : binary_nat
| bit0 : binary_nat → binary_nat -- "add a 0 on the end" -- i.e. double
| bit1 : binary_nat → binary_nat -- double and add 1

notation `ℙ` := binary_nat -- \bbP

namespace binary_nat

def thirtyseven : binary_nat := bit1 (bit0 (bit1 (bit0 (bit0 one))))

-- notice that these nats start at 1 -- can't make 0
-- so they're the "British Natural Numbers" :-)
-- now need to make an API for binary nats
-- let's play the British Natural Number Game!

-- succ was important!

instance : has_one binary_nat := ⟨binary_nat.one⟩

def succ : binary_nat → binary_nat
| 1 := bit0 1
| (bit0 t) := bit1 t
| (bit1 t) := bit0 (succ t)

@[simp] lemma one_def : one = 1 := rfl

@[simp] lemma succ_one : succ 1 = bit0 1 := rfl
@[simp] lemma succ_bit0 (t : ℙ) : succ (bit0 t) = bit1 t := rfl
@[simp] lemma succ_bit1 (t : ℙ) : succ (bit1 t) = bit0 (succ t) := rfl

-- now let's define addition of binary nats! This is literally column addition

def add : ℙ → ℙ → ℙ
|       a        1  := succ a
|       1        b  := succ b
| (bit0 a) (bit0 b) := bit0 (add a b)
| (bit0 a) (bit1 b) := bit1 (add a b)
| (bit1 a) (bit0 b) := bit1 (add a b)
| (bit1 a) (bit1 b) := bit0 (succ (add a b))

instance : has_add ℙ := ⟨add⟩

@[simp] lemma bit0_add_bit0 (a b : ℙ) : (bit0 a) + (bit0 b) = bit0 (a + b) := rfl
@[simp] lemma bit0_add_bit1 (a b : ℙ) : (bit0 a) + (bit1 b) = bit1 (a + b) := rfl
@[simp] lemma bit1_add_bit0 (a b : ℙ) : (bit1 a) + (bit0 b) = bit1 (a + b) := rfl
@[simp] lemma bit1_add_bit1 (a b : ℙ) : (bit1 a) + (bit1 b) = bit0 (succ(a + b)) := rfl

-- inspired by NNG, let's prove succ_eq_add_one

@[simp] lemma add_one_eq_succ (a : ℙ) : a + 1 = succ a :=
begin
  cases a; refl
end

@[simp] lemma one_add_eq_succ (b : ℙ) : 1 + b = succ b :=
begin
  cases b,
  { refl },
  { refl },
  { refl }
end

-- next on the agenda in NNG is add_assoc
-- but this will involve 27 cases :-)
-- and some induction as well!
-- a + b in NNG depends on whether b = 0 or succ(c) so two cases

lemma add_assoc_one_one (a : ℙ) : (a + 1) + 1 = a + (1 + 1) :=
begin
  induction a with b hb b hb; simp; try {refl},
end.

@[simp] lemma add_two (a : ℙ) : a + bit0 1 = succ (succ a) :=
begin
  show a + (1 + 1) = succ (succ a),
  rw ←add_assoc_one_one,
  simp
end.

-- -- this is just add_succ
-- lemma add_assoc_one (a b : ℙ) : (a + b) + 1 = a + (b + 1) :=
-- begin
--   induction b; cases a; simp; try {refl},
--   sorry, sorry
-- end.

@[simp] lemma add_succ (a b : ℙ) : a + succ b = succ (a + b) :=
begin
  induction b with d hd d hd generalizing a,
  { simp },
  { induction a with c hc c hc; simp},
  { induction a with c hc c hc; try {simp}; simp [hd c]}

end.

-- don't really want to do associativity -- straightforward but long

-- here's another idea though -- binary nats are just positive natural numbers
-- and we've already proved that addition is associative on natural numbers
-- in NNG (and it was easy!)
-- So why not deduce associativity of binary + from associativity of +

def of_nat'' : Π (n : ℕ), (n ≠ 0) → ℙ
| 0 h := begin exfalso, apply h, refl, end
| 1 h := binary_nat.one
| (n+2) h := succ (of_nat'' (n+1) (nat.succ_ne_zero n))

def of_nat' (a : {x : ℕ // x ≠ 0}) : ℙ := of_nat'' a.1 a.2

def of_nat : ℕ → ℙ
| 0 := thirtyseven
| 1 := 1
| (n + 2) := succ (of_nat (n + 1))

theorem of_nat_succ (a : ℕ) (ha : a ≠ 0) : of_nat (a + 1) = succ (of_nat a) :=
begin
  cases a, cases ha rfl,
  cases a,
  { refl},
  clear ha,
  refl,
end

@[simp] lemma of_nat_one : of_nat 1 = 1 := rfl
@[simp] lemma of_nat_succ_succ (a : ℕ) : of_nat (a + 2) = succ (of_nat (a + 1)) := rfl

-- Theorem: column addition gives the right answer! i.e. we are formally
-- verifying the column addition algorithm
theorem of_nat_add (a b : ℕ) (ha : a ≠ 0) (hb : b ≠ 0) : of_nat (a + b) = of_nat a + of_nat b :=
begin
  cases a, cases ha rfl, cases b, cases hb rfl,
  clear ha hb,
  induction b with d hd generalizing a,
  { simp }, -- simp works
  change of_nat ((a+1)+(d+2)) = of_nat (a+1) + of_nat (d+2),
  rw of_nat_succ_succ,
  rw add_succ,
  rw ←hd a,
  rw (show nat.succ a + nat.succ d = (a+d+1)+1, by omega),
  rw ←of_nat_succ_succ,
  apply congr_arg,
  omega,
end.

end binary_nat


/- A FAMILY OF TYPES ("INDUCTIVE FAMILY")

efine a family of types, *tuple n*, indexed
by natural numbers. For any (n : nat), tuple n
is the type of tuples (of natural numbers) of
length n.
-/

-- nat ⨯ nat

--  ℕ ℕ ℕ
-- (1,2,3)

--  ℕ ⨯ (ℕ×ℕ)
-- (1,(2,3))

-- (1, (2, (3, (4, 5))))

/-
Build a function that takes a natural number, n,
and returns a TYPE: the type of tuples of length
n.

#check tuple

nat → (nat ⨯ (nat ⨯ nat))

tuple : Π (n : ℕ), _
-/

/-
Reminder: prod is a type builder. Given
types, α and β, prod α β (or α × β) is the
the *type* of ordered α-β pairs. We can
then use prod.mk to create values of such
a type.

The following function recursively applies
× to nat, enabling us to build product types
with any number of components, not just two
(where, here, for simplicity, we support
only products of the nat type). The base
case for the recursion when n=0 is the unit
type.
-/

-- for each (n : nat), a type, (tuple n)
def tuple : nat → Type
| 0 := unit
| (n' + 1) := nat × (tuple n')

/-
0   tuple 0 = unit
1   tuple 1 = nat ⨯ unit
2   tuple 2 = nat ⨯ (nat ⨯ unit)
3   tuple 3 = nat ⨯ (nat ⨯ (nat ⨯ unit))
4   tuple 4 = nat ⨯ (tuple 3)
...
n   tuple (n' + 1) = nat ⨯ (tuple n')
-/

#check tuple  -- ℕ → Type (*important*)

#check nat
#check (prod nat nat)

/-
For values of n from 0 to 3, we get the
following types by applying tuple to n.

0: unit
1: nat ⨯ unit
2: nat × (nat × unit)
3: nat × (nat × (nat × unit))

Values of these types include:

0 : (unit.star)
1: (1, unit.star)
2: (1, 2, unit.star)
3: (1, 2, 4, unit.star)
-/

def t0 : tuple 0 := unit.star
def t1' : tuple 1 := prod.mk 1 unit.star
def t1 : tuple 1 := (1, unit.star)  -- notation
def t2 : tuple 2 := (1, 2, unit.star)
def t3 : tuple 3 := (1, (2, (4, (unit.star))))

--  (1, 2, unit.star)
--  (1, (2, (unit.star)))
-- prod.mk 1 (prod.mk 2 unit.star)

/-
The length is typechecked! The error
messages are cryptic, but, hey.
-/

def t3' : tuple 3 := (1, 2, 3, 4, unit.star) -- no
def t3'' : tuple 3 := (1, 2, 4, unit.star) -- no

/-
We could define a nicer concrete syntax that
would let us avoid having to write the star
at the end, but we'll skip that here to stay
focused on the essentials.
-/

/-
Note that tuple is a *type builder*. It
takes a natural number, n, and returns a
*type*: in particular, one that depends
on n. Tuple is defined by recursion on n.
It iteratively computes the product type
of nat and smaller product of nats until
n=0, at which point it returns the product
of all that with the unit type (base case).
-/

/-
More generally, given (α : Type) and
(β : α → Type), we can view β as defining
a *family of types over α*, with a different
type, (β a), for such each value, (a : α).

In our example above, α = nat and β = tuple.
Tuple defines an inductive family of types
"indexed by the natural numbers." To each
natural number, n, tuple thus associates
a corresponding type, tuple n,that depends
on n.
-/

def n0 : tuple 0 := ()
#reduce n0

def nil := tuple 0

def cons : Π {n : ℕ}, nat → tuple n → tuple (n + 1)
| n a t := prod.mk a t

-- {2} 7 (1, 2, star) -> (7, (1, 2, star))
-- #reduce cons 7 ((1, (2, unit.star)) : tuple 2)

def head : Π {n : nat}, tuple  n → option nat
| 0 _ := none
| (n' + 1) (prod.mk h t) := some h

def tail {α : Type} : Π (n : nat), tuple n → option (tuple (n-1))
| 0 _ := none
| (n' + 1) (prod.mk h t) := some t

def append :
  Π {n m : ℕ}, (tuple n) → tuple m → tuple (m + n)
| 0 m tn tm := tm
| (n' + 1) m (prod.mk h tn') tm := prod.mk h (append tn' tm) -- infers n' m

def t6 := append t3 t3
#reduce t6

-- Type check catches bounds errors
def foo (t : tuple 3) : nat := 0
#check foo t2   -- No: type of t2 is tuple 2, not tuple 3

/-
DEPENDENT FUNCTION TYPES
-/

/-
The importance of Pi types, Π x : α, β x, is that they generalize
the notion of a function type, α → β, by allowing the type, β, to
depend on  (a : α). Here's a function that takes a value, n, of
type nat, and that returns a value of type *(tuple n)*. Clearly
the type of the return value depends on the value of the argument,
n. It should now also be clear why Π binds a name to an argument:
so that the value can be used in defining the rest of the *type*
of a function.
-/
def zerotuple : Π (n : nat), tuple n
| 0 := ()
| (n' + 1) := (0, zerotuple n')

-- Π (n : nat), tuple n

#reduce zerotuple 4
#check zerotuple 4

def nToNtuple (n : nat) : tuple n := zerotuple n
#check nToNtuple

def z0 := nToNtuple 0
def z1 := nToNtuple 1
def z2 := nToNtuple 2
def z3 := nToNtuple 3
def z4 := nToNtuple 4

#check z0
#check z1
#check z2
#check z3
#check z4

#reduce z0
#reduce z1
#reduce z2
#reduce z3
#reduce z4

-- General notation for dependently typed functions
-- Π (a : A), B a
-- Π (n : ℕ), tuple n

-- Π (a : A), B   -- special case where B doesn't depend on a
-- A → B

-- Ours is a dependently typed function
#check nToNtuple

/-
SIGMA (DEPENDENT PRODUCT) TYPES
-/

#print sigma

/-
structure sigma : Π {α : Type u}, (α → Type v) → Type (max u v)
fields:
sigma.fst : Π {α : Type u} {β : α → Type v}, sigma β → α
sigma.snd : Π {α : Type u} {β : α → Type v} (c : sigma β), β c.fstLean
-/

#check Σ (n : nat), tuple n   -- dependent pair type, ⟨ n, tuple n ⟩

def s3 : Σ (n : nat), tuple n := sigma.mk 3 (1,2,3,unit.star)
def s5 : Σ (n : nat), tuple n := ⟨  5, (nToNtuple 5) ⟩
def sx : Σ (n : nat), tuple n := ⟨ 5, (nToNtuple 4) ⟩ -- Cannot form, snd has wrong type

#print sigma

#reduce sigma.fst s3
#reduce sigma.snd s3
#reduce s3.fst
#reduce s3.snd
#reduce s3.1
#reduce s3.2

-- Identical types, varying in notation
#check Σ (n : nat), tuple n
#check @sigma nat tuple

#check sigma.mk 3 (nToNtuple 3)
#check sigma.mk 4 (nToNtuple 4)
#reduce sigma.mk 3 (nToNtuple 3)
#reduce sigma.mk 4 (nToNtuple 4)

def nToSigma (n : nat) : sigma tuple :=
⟨ n, nToNtuple n⟩

def nToSigma' (n : nat): Σ (n : nat), tuple n :=
⟨ n, nToNtuple n⟩

#reduce nToSigma 5

/-
variable α : Type
variable β : α → Type
variable a : α
variable b : β a

#check sigma.mk a b      -- Σ (a : α), β a
#check (sigma.mk a b).1  -- α
#check (sigma.mk a b).2  -- β (sigma.fst (sigma.mk a b))

#reduce  (sigma.mk a b).1  -- a
#reduce  (sigma.mk a b).2  -- b-/

def evenNum : {n : nat // n%2 = 0} := ⟨ 2, rfl ⟩

#reduce evenNum

def oops : {n : nat // n%2 = 0} := ⟨ 3, rfl ⟩

def evenId : {n : nat // n%2 = 0} → nat

| ⟨ val, proof_about_val ⟩ := val

#eval evenId ⟨ 0, rfl ⟩
#eval evenId ⟨ 1, rfl ⟩
#eval evenId ⟨ 2, rfl ⟩
#eval evenId ⟨ 3, rfl ⟩
#eval evenId ⟨ 4, rfl ⟩
#eval evenId ⟨ 5, rfl ⟩

#print subtype


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

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

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

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

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


-- ---------------------------------------------------------------------
-- Ejercicio 1. Realizar las siguientes acciones
--    1. Importar la teoría de retículos.
--    2. Declarar α como un tipo sobre retículos
--    3. Declarar x e y como variabkes sobre α
-- ----------------------------------------------------------------------

import order.lattice               -- 1
variables {α : Type*} [lattice α]  -- 2
variables x y : α                  -- 3

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que
--    x ⊓ (x ⊔ y) = x
-- ---------------------------------------------------------------------

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

example : x ⊓ (x ⊔ y) = x :=
begin
  have h1 : x ⊓ (x ⊔ y) ≤ x, finish,
  have h2 : x ≤ x ⊓ (x ⊔ y), finish,
  show x ⊓ (x ⊔ y) = x,
    by exact le_antisymm h1 h2,
end

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

example : x ⊓ (x ⊔ y) = x :=
begin
  have h1 : x ⊓ (x ⊔ y) ≤ x := inf_le_left,
  have h2 : x ≤ x ⊓ (x ⊔ y),
  { have h2a : x ≤ x := rfl.ge,
    have h2b : x ≤ x ⊔ y := le_sup_left,
    show x ≤ x ⊓ (x ⊔ y),
      by exact le_inf h2a h2b, },
  show x ⊓ (x ⊔ y) = x,
    by exact le_antisymm h1 h2,
end

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

example : x ⊓ (x ⊔ y) = x :=
begin
  apply le_antisymm,
  { apply inf_le_left },
  { apply le_inf,
    { apply le_refl },
    { apply le_sup_left }},
end

-- Su desarrollo es
--
-- ⊢ x ⊓ (x ⊔ y) = x
--    apply le_antisymm,
-- | ⊢ x ⊓ (x ⊔ y) ≤ x
-- | |   { apply inf_le_left },
-- | ⊢ x ≤ x ⊓ (x ⊔ y)
-- |   { apply le_inf,
-- | | ⊢ x ≤ x
-- | |     { apply le_refl },
-- | | ⊢ x ≤ x ⊔ y
-- | |     { apply le_sup_left }},
-- no goals

-- 4ª demostración
example : x ⊓ (x ⊔ y) = x :=
-- by library_search
inf_sup_self

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

example : x ⊓ (x ⊔ y) = x :=
-- by hint
by simp

-- ---------------------------------------------------------------------
-- Ejercicio 3. Demostrar que
--    x ⊔ (x ⊓ y) = x
-- ---------------------------------------------------------------------

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

example : x ⊔ (x ⊓ y) = x :=
begin
  have h1 : x ⊔ (x ⊓ y) ≤ x, finish,
  have h2 : x ≤ x ⊔ (x ⊓ y), finish,
  show x ⊔ (x ⊓ y) = x,
    by exact le_antisymm h1 h2,
end

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

example : x ⊔ (x ⊓ y) = x :=
begin
  have h1 : x ⊔ (x ⊓ y) ≤ x,
  { have h1a : x ≤ x := le_rfl,
    have h1b : x ⊓ y ≤ x := inf_le_left,
    show x ⊔ (x ⊓ y) ≤ x,
      by exact sup_le h1a h1b,
  },
  have h2 : x ≤ x ⊔ (x ⊓ y) := le_sup_left,
  show x ⊔ (x ⊓ y) = x,
    by exact le_antisymm h1 h2,
end

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

example : x ⊔ (x ⊓ y) = x :=
begin
  apply le_antisymm,
  { apply sup_le,
    { apply le_refl },
    { apply inf_le_left }},
  { apply le_sup_left },
end

-- Su desarrollo es
--
-- ⊢ x ⊔ x ⊓ y = x
--    apply le_antisymm,
-- | ⊢ x ⊔ x ⊓ y ≤ x
-- |    { apply sup_le,
-- | | ⊢ x ≤ x
-- | |      { apply le_refl },
-- | | ⊢ x ⊓ y ≤ x
-- | |      { apply inf_le_left }},
-- | ⊢ x ≤ x ⊔ x ⊓ y
-- | |    { apply le_sup_left },
-- no goals

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

example : x ⊔ (x ⊓ y) = x :=
-- by library_search
sup_inf_self

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

example : x ⊔ (x ⊓ y) = x :=
-- by hint
by simp


import data.real.basic

open function

definition pals {X Y Z : Type} (f : X → Y) (g : X → Z) := ∃ h : Y → Z, bijective h ∧ g = h ∘ f

lemma Q5 (X Y Z: Type) (f : X → Y) (g : X → Z) (hf : surjective f) (hg : surjective g) : pals f g ↔ ∀ a b : X, (f a = f b) ↔ (g a = g b) :=
begin
  split,
  { -- if pals then equiv relns equal
    rintro ⟨h, hb, hghf⟩,
      rw funext_iff at hghf,
    intros a b,
    split,
    { -- f(a)=f(b) implies g(a)=g(b)
      intro hfab,
      rw hghf,
      rw hghf,
      show h (f a) = h (f b),
      rw hfab,
    },
    intro hgab,
    cases hb with hi hs,
    apply hi,
    rw hghf at hgab,
    rw hghf at hgab,
    exact hgab,
  },
  { intro hequiv,
    unfold pals,
    let hf' := hf,
    choose temp htemp using hf', -- a temporary function Y → X sending y to some random x with f(x)=y
    use g ∘ temp,
    split,
    { split,
      { intros y₁ y₂ h12,
        change g (temp y₁) = g (temp y₂) at h12,
        rw ←hequiv at h12,
        rw htemp at h12,
        rw htemp at h12,
        assumption,
      },
      intro z,
      cases hg z with x hx,
      use f x,
      show g(temp(f(x))) = _,
      rw ←hx,
      rw ←hequiv,
      rw htemp,
    },
    ext,
    show _ = g(temp(f(x))),
    rw ←hequiv,
    rw htemp,
  }
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Alexander Bentkamp
-/
import linear_algebra.linear_independent
import linear_algebra.projection
import linear_algebra.linear_pmap
import data.fintype.card

/-!

# Bases

This file defines bases in a module or vector space.

It is inspired by Isabelle/HOL's linear algebra, and hence indirectly by HOL Light.

## Main definitions

All definitions are given for families of vectors, i.e. `v : ι → M` where `M` is the module or
vector space and `ι : Type*` is an arbitrary indexing type.

* `is_basis R v` states that the vector family `v` is a basis, i.e. it is linearly independent and
  spans the entire space.

* `is_basis.repr hv x` is the basis version of `linear_independent.repr hv x`. It returns the
  linear combination representing `x : M` on a basis `v` of `M` (using classical choice).
  The argument `hv` must be a proof that `is_basis R v`. `is_basis.repr hv` is given as a linear
  map as well.

* `is_basis.constr hv f` constructs a linear map `M₁ →ₗ[R] M₂` given the values `f : ι → M₂` at the
  basis `v : ι → M₁`, given `hv : is_basis R v`.

## Main statements

* `is_basis.ext` states that two linear maps are equal if they coincide on a basis.

* `exists_is_basis` states that every vector space has a basis.

## Implementation notes

We use families instead of sets because it allows us to say that two identical vectors are linearly
dependent. For bases, this is useful as well because we can easily derive ordered bases by using an
ordered index type `ι`.

## Tags

basis, bases

-/

noncomputable theory

universe u

open function set submodule
open_locale classical big_operators

variables {ι : Type*} {ι' : Type*} {R : Type*} {K : Type*}
variables {M : Type*} {M' M'' : Type*} {V : Type u} {V' : Type*}

section module

open linear_map

variables {v : ι → M}
variables [ring R] [add_comm_group M] [add_comm_group M'] [add_comm_group M'']
variables [module R M] [module R M'] [module R M'']
variables {a b : R} {x y : M}

variables (R) (v)
/-- A family of vectors is a basis if it is linearly independent and all vectors are in the span. -/
def is_basis := linear_independent R v ∧ span R (range v) = ⊤
variables {R} {v}

section is_basis
variables {s t : set M} (hv : is_basis R v)

lemma is_basis.mem_span (hv : is_basis R v) : ∀ x, x ∈ span R (range v) := eq_top_iff'.1 hv.2

lemma is_basis.comp (hv : is_basis R v) (f : ι' → ι) (hf : bijective f) :
  is_basis R (v ∘ f) :=
begin
  split,
  { apply hv.1.comp f hf.1 },
  { rw[set.range_comp, range_iff_surjective.2 hf.2, image_univ, hv.2] }
end

lemma is_basis.injective [nontrivial R] (hv : is_basis R v) : injective v :=
  λ x y h, linear_independent.injective hv.1 h

lemma is_basis.range (hv : is_basis R v) : is_basis R (λ x, x : range v → M) :=
⟨hv.1.to_subtype_range,
  by { convert hv.2, ext i, exact ⟨λ ⟨p, hp⟩, hp ▸ p.2, λ hi, ⟨⟨i, hi⟩, rfl⟩⟩ }⟩

/-- Given a basis, any vector can be written as a linear combination of the basis vectors. They are
given by this linear map. This is one direction of `module_equiv_finsupp`. -/
def is_basis.repr : M →ₗ (ι →₀ R) :=
(hv.1.repr).comp (linear_map.id.cod_restrict _ hv.mem_span)

lemma is_basis.total_repr (x) : finsupp.total ι M R v (hv.repr x) = x :=
hv.1.total_repr ⟨x, _⟩

lemma is_basis.total_comp_repr : (finsupp.total ι M R v).comp hv.repr = linear_map.id :=
linear_map.ext hv.total_repr

lemma is_basis.ext {f g : M →ₗ[R] M'} (hv : is_basis R v) (h : ∀i, f (v i) = g (v i)) : f = g :=
linear_map.ext_on_range hv.2 h

lemma is_basis.repr_ker : hv.repr.ker = ⊥ :=
linear_map.ker_eq_bot.2 $ left_inverse.injective hv.total_repr

lemma is_basis.repr_range : hv.repr.range = finsupp.supported R R univ :=
by rw [is_basis.repr, linear_map.range_eq_map, submodule.map_comp,
  linear_map.map_cod_restrict, submodule.map_id, comap_top, map_top, hv.1.repr_range,
  finsupp.supported_univ]

lemma is_basis.repr_total (x : ι →₀ R) (hx : x ∈ finsupp.supported R R (univ : set ι)) :
  hv.repr (finsupp.total ι M R v x) = x :=
begin
  rw [← hv.repr_range, linear_map.mem_range] at hx,
  cases hx with w hw,
  rw [← hw, hv.total_repr],
end

lemma is_basis.repr_eq_single {i} : hv.repr (v i) = finsupp.single i 1 :=
by apply hv.1.repr_eq_single; simp

@[simp]
lemma is_basis.repr_self_apply (i j : ι) [decidable (i = j)] :
  hv.repr (v i) j = if i = j then 1 else 0 :=
by rw [hv.repr_eq_single, finsupp.single_apply]

lemma is_basis.repr_eq_iff {f : M →ₗ[R] (ι →₀ R)} :
  hv.repr = f ↔ ∀ i, f (v i) = finsupp.single i 1 :=
begin
  split,
  { rintros rfl i,
    exact hv.repr_eq_single },
  intro h,
  refine hv.ext (λ _, _),
  rw [h, hv.repr_eq_single]
end

lemma is_basis.repr_apply_eq {f : M → ι → R}
  (hadd : ∀ x y, f (x + y) = f x + f y) (hsmul : ∀ (c : R) (x : M), f (c • x) = c • f x)
  (f_eq : ∀ i, f (v i) = finsupp.single i 1) (x : M) (i : ι) :
  hv.repr x i = f x i :=
begin
  let f_i : M →ₗ[R] R :=
  { to_fun := λ x, f x i,
    map_add' := λ _ _, by rw [hadd, pi.add_apply],
    map_smul' := λ _ _, by rw [hsmul, pi.smul_apply] },
  show (finsupp.lapply i).comp hv.repr x = f_i x,
  congr' 1,
  refine hv.ext (λ j, _),
  show hv.repr (v j) i = f (v j) i,
  rw [hv.repr_eq_single, f_eq]
end

lemma is_basis.range_repr_self (i : ι) :
  hv.range.repr (v i) = finsupp.single ⟨v i, mem_range_self i⟩ 1 :=
hv.1.to_subtype_range.repr_eq_single _ _ rfl

@[simp] lemma is_basis.range_repr (i : ι) :
  hv.range.repr x ⟨v i, mem_range_self i⟩ = hv.repr x i :=
begin
  by_cases H : (0 : R) = 1,
  { exact eq_of_zero_eq_one H _ _ },
  refine (hv.repr_apply_eq _ _ _ x i).symm,
  { intros x y,
    ext j,
    rw [linear_map.map_add, finsupp.add_apply],
    refl },
  { intros c x,
    ext j,
    rw [linear_map.map_smul, finsupp.smul_apply],
    refl },
  { intro i,
    ext j,
    haveI : nontrivial R := ⟨⟨0, 1, H⟩⟩,
    simp [hv.range_repr_self, finsupp.single_apply, hv.injective.eq_iff] }
end

/-- Construct a linear map given the value at the basis. -/
def is_basis.constr (f : ι → M') : M →ₗ[R] M' :=
(finsupp.total M' M' R id).comp $ (finsupp.lmap_domain R R f).comp hv.repr

theorem is_basis.constr_apply (f : ι → M') (x : M) :
  (hv.constr f : M → M') x = (hv.repr x).sum (λb a, a • f b) :=
by dsimp [is_basis.constr] ;
   rw [finsupp.total_apply, finsupp.sum_map_domain_index]; simp [add_smul]

@[simp] lemma constr_basis {f : ι → M'} {i : ι} (hv : is_basis R v) :
  (hv.constr f : M → M') (v i) = f i :=
by simp [is_basis.constr_apply, hv.repr_eq_single, finsupp.sum_single_index]

lemma constr_eq {g : ι → M'} {f : M →ₗ[R] M'} (hv : is_basis R v)
  (h : ∀i, g i = f (v i)) : hv.constr g = f :=
hv.ext $ λ i, (constr_basis hv).trans (h i)

lemma constr_self (f : M →ₗ[R] M') : hv.constr (λ i, f (v i)) = f :=
constr_eq hv $ λ x, rfl

lemma constr_zero (hv : is_basis R v) : hv.constr (λi, (0 : M')) = 0 :=
constr_eq hv $ λ x, rfl

lemma constr_add {g f : ι → M'} (hv : is_basis R v) :
  hv.constr (λi, f i + g i) = hv.constr f + hv.constr g :=
constr_eq hv $ λ b, by simp

lemma constr_neg {f : ι → M'} (hv : is_basis R v) : hv.constr (λi, - f i) = - hv.constr f :=
constr_eq hv $ λ b, by simp

lemma constr_sub {g f : ι → M'} (hs : is_basis R v) :
  hv.constr (λi, f i - g i) = hs.constr f - hs.constr g :=
by simp [sub_eq_add_neg, constr_add, constr_neg]

-- this only works on functions if `R` is a commutative ring
lemma constr_smul {ι R M} [comm_ring R] [add_comm_group M] [module R M]
  {v : ι → R} {f : ι → M} {a : R} (hv : is_basis R v) :
  hv.constr (λb, a • f b) = a • hv.constr f :=
constr_eq hv $ by simp [constr_basis hv] {contextual := tt}

lemma constr_range [nonempty ι] (hv : is_basis R v) {f : ι  → M'} :
  (hv.constr f).range = span R (range f) :=
by rw [is_basis.constr, linear_map.range_comp, linear_map.range_comp, is_basis.repr_range,
    finsupp.lmap_domain_supported, ←set.image_univ, ←finsupp.span_eq_map_total, image_id]

/-- Canonical equivalence between a module and the linear combinations of basis vectors. -/
def module_equiv_finsupp (hv : is_basis R v) : M ≃ₗ[R] ι →₀ R :=
(hv.1.total_equiv.trans (linear_equiv.of_top _ hv.2)).symm

@[simp] theorem module_equiv_finsupp_apply_basis (hv : is_basis R v) (i : ι) :
  module_equiv_finsupp hv (v i) = finsupp.single i 1 :=
(linear_equiv.symm_apply_eq _).2 $ by simp [linear_independent.total_equiv]

/-- Isomorphism between the two modules, given two modules `M` and `M'` with respective bases
`v` and `v'` and a bijection between the indexing sets of the two bases. -/
def linear_equiv_of_is_basis {v : ι → M} {v' : ι' → M'} (hv : is_basis R v) (hv' : is_basis R v')
  (e : ι ≃ ι') : M ≃ₗ[R] M' :=
{ inv_fun := hv'.constr (v ∘ e.symm),
  left_inv := have (hv'.constr (v ∘ e.symm)).comp (hv.constr (v' ∘ e)) = linear_map.id,
      from hv.ext $ by simp,
    λ x, congr_arg (λ h : M →ₗ[R] M, h x) this,
  right_inv := have (hv.constr (v' ∘ e)).comp (hv'.constr (v ∘ e.symm)) = linear_map.id,
      from hv'.ext $ by simp,
    λ y, congr_arg (λ h : M' →ₗ[R] M', h y) this,
  ..hv.constr (v' ∘ e) }

/-- Isomorphism between the two modules, given two modules `M` and `M'` with respective bases
`v` and `v'` and a bijection between the two bases. -/
def linear_equiv_of_is_basis' {v : ι → M} {v' : ι' → M'} (f : M → M') (g : M' → M)
  (hv : is_basis R v) (hv' : is_basis R v')
  (hf : ∀i, f (v i) ∈ range v') (hg : ∀i, g (v' i) ∈ range v)
  (hgf : ∀i, g (f (v i)) = v i) (hfg : ∀i, f (g (v' i)) = v' i) :
  M ≃ₗ M' :=
{ inv_fun := hv'.constr (g ∘ v'),
  left_inv :=
    have (hv'.constr (g ∘ v')).comp (hv.constr (f ∘ v)) = linear_map.id,
    from hv.ext $ λ i, exists.elim (hf i)
      (λ i' hi', by simp [constr_basis, hi'.symm]; rw [hi', hgf]),
    λ x, congr_arg (λ h:M →ₗ[R] M, h x) this,
  right_inv :=
    have (hv.constr (f ∘ v)).comp (hv'.constr (g ∘ v')) = linear_map.id,
    from hv'.ext $ λ i', exists.elim (hg i')
      (λ i hi, by simp [constr_basis, hi.symm]; rw [hi, hfg]),
    λ y, congr_arg (λ h:M' →ₗ[R] M', h y) this,
  ..hv.constr (f ∘ v) }

@[simp] lemma linear_equiv_of_is_basis_comp {ι'' : Type*} {v : ι → M} {v' : ι' → M'}
  {v'' : ι'' → M''} (hv : is_basis R v) (hv' : is_basis R v') (hv'' : is_basis R v'')
  (e : ι ≃ ι') (f : ι' ≃ ι'' ) :
  (linear_equiv_of_is_basis hv hv' e).trans (linear_equiv_of_is_basis hv' hv'' f) =
  linear_equiv_of_is_basis hv hv'' (e.trans f) :=
begin
  apply linear_equiv.to_linear_map_injective,
  apply hv.ext,
  intros i,
  simp [linear_equiv_of_is_basis]
end

@[simp] lemma linear_equiv_of_is_basis_refl :
  linear_equiv_of_is_basis hv hv (equiv.refl ι) = linear_equiv.refl R M :=
begin
  apply linear_equiv.to_linear_map_injective,
  apply hv.ext,
  intros i,
  simp [linear_equiv_of_is_basis]
end

lemma linear_equiv_of_is_basis_trans_symm (e : ι ≃ ι') {v' : ι' → M'} (hv' : is_basis R v') :
  (linear_equiv_of_is_basis hv hv' e).trans (linear_equiv_of_is_basis hv' hv e.symm) =
  linear_equiv.refl R M :=
by simp

lemma linear_equiv_of_is_basis_symm_trans (e : ι ≃ ι') {v' : ι' → M'} (hv' : is_basis R v') :
  (linear_equiv_of_is_basis hv' hv e.symm).trans (linear_equiv_of_is_basis hv hv' e) =
  linear_equiv.refl R M' :=
by simp

lemma is_basis_inl_union_inr {v : ι → M} {v' : ι' → M'}
  (hv : is_basis R v) (hv' : is_basis R v') :
  is_basis R (sum.elim (inl R M M' ∘ v) (inr R M M' ∘ v')) :=
begin
  split,
  apply linear_independent_inl_union_inr' hv.1 hv'.1,
  rw [sum.elim_range, span_union,
      set.range_comp, span_image (inl R M M'), hv.2,  map_top,
      set.range_comp, span_image (inr R M M'), hv'.2, map_top],
  exact linear_map.sup_range_inl_inr
end

@[simp] lemma is_basis.repr_eq_zero {x : M} :
  hv.repr x = 0 ↔ x = 0 :=
⟨λ h, (hv.total_repr x).symm.trans (h.symm ▸ (finsupp.total _ _ _ _).map_zero),
 λ h, h.symm ▸ hv.repr.map_zero⟩

lemma is_basis.ext_elem {x y : M}
  (h : ∀ i, hv.repr x i = hv.repr y i) : x = y :=
by { rw [← hv.total_repr x, ← hv.total_repr y], congr' 1, ext i, exact h i }

section

include hv

-- Can't be an instance because the basis can't be inferred.
lemma is_basis.no_zero_smul_divisors [no_zero_divisors R] :
  no_zero_smul_divisors R M :=
⟨λ c x hcx, or_iff_not_imp_right.mpr (λ hx, begin
  rw [← hv.total_repr x, ← linear_map.map_smul] at hcx,
  have := linear_independent_iff.mp hv.1 (c • hv.repr x) hcx,
  rw smul_eq_zero at this,
  exact this.resolve_right (λ hr, hx (hv.repr_eq_zero.mp hr))
end)⟩

lemma is_basis.smul_eq_zero [no_zero_divisors R] {c : R} {x : M} :
  c • x = 0 ↔ c = 0 ∨ x = 0 :=
@smul_eq_zero _ _ _ _ _ hv.no_zero_smul_divisors _ _

end

end is_basis

lemma is_basis_singleton_iff
  {R : Type*} [ring R] [nontrivial R] [module R M] [no_zero_smul_divisors R M]
  (ι : Type*) [unique ι] (x : M) :
  is_basis R (λ (_ : ι), x) ↔ x ≠ 0 ∧ ∀ y : M, ∃ r : R, r • x = y :=
begin
  fsplit,
  rintro ⟨li, sp⟩,
  fsplit,
  apply linear_independent.ne_zero (default ι) li,
  simpa [span_singleton_eq_top_iff] using sp,
  rintro ⟨nz, w⟩,
  fsplit,
  simpa [linear_independent_unique_iff] using nz,
  simpa [span_singleton_eq_top_iff] using w,
end

lemma is_basis_singleton_one (R : Type*) [unique ι] [ring R] :
  is_basis R (λ (_ : ι), (1 : R)) :=
begin
  split,
  { refine linear_independent_iff.2 (λ l hl, _),
    rw [finsupp.total_unique, smul_eq_mul, mul_one] at hl,
    exact finsupp.unique_ext hl },
  { refine top_unique (λ _ _, _),
    simp only [mem_span_singleton, range_const, mul_one, exists_eq, smul_eq_mul] }
end

protected lemma linear_equiv.is_basis (hs : is_basis R v)
  (f : M ≃ₗ[R] M') : is_basis R (f ∘ v) :=
begin
  split,
  { simpa only using hs.1.map' (f : M →ₗ[R] M') f.ker },
  { rw [set.range_comp, ← linear_equiv.coe_coe, span_image, hs.2, map_top, f.range] }
end

lemma is_basis_span (hs : linear_independent R v) :
  @is_basis ι R (span R (range v)) (λ i : ι, ⟨v i, subset_span (mem_range_self _)⟩) _ _ _ :=
begin
split,
{ apply linear_independent_span hs },
{ rw eq_top_iff',
  intro x,
  have h₁ : subtype.val '' set.range (λ i, subtype.mk (v i) _) = range v,
    by rw ←set.range_comp,
  have h₂ : map (submodule.subtype _) (span R (set.range (λ i, subtype.mk (v i) _)))
              = span R (range v),
    by rw [←span_image, submodule.subtype_eq_val, h₁],
  have h₃ : (x : M) ∈ map (submodule.subtype _) (span R (set.range (λ i, subtype.mk (v i) _))),
    by rw h₂; apply subtype.mem x,
  rcases mem_map.1 h₃ with ⟨y, hy₁, hy₂⟩,
  have h_x_eq_y : x = y,
    by rw [subtype.ext_iff, ← hy₂]; simp,
  rw h_x_eq_y,
  exact hy₁ }
end

variables (M)

lemma is_basis_empty [subsingleton M] (h_empty : ¬ nonempty ι) : is_basis R (λ x : ι, (0 : M)) :=
⟨ linear_independent_empty_type h_empty, subsingleton.elim _ _ ⟩

variables {M}

open fintype
variables [fintype ι] (h : is_basis R v)

/-- A module over `R` with a finite basis is linearly equivalent to functions from its basis to `R`.
-/
def is_basis.equiv_fun : M ≃ₗ[R] (ι → R) :=
linear_equiv.trans (module_equiv_finsupp h)
  { to_fun := coe_fn,
    map_add' := finsupp.coe_add,
    map_smul' := finsupp.coe_smul,
    ..finsupp.equiv_fun_on_fintype }

/-- A module over a finite ring that admits a finite basis is finite. -/
def module.fintype_of_fintype [fintype R] : fintype M :=
fintype.of_equiv _ h.equiv_fun.to_equiv.symm

theorem module.card_fintype [fintype R] [fintype M] :
  card M = (card R) ^ (card ι) :=
calc card M = card (ι → R)    : card_congr h.equiv_fun.to_equiv
        ... = card R ^ card ι : card_fun

/-- Given a basis `v` indexed by `ι`, the canonical linear equivalence between `ι → R` and `M` maps
a function `x : ι → R` to the linear combination `∑_i x i • v i`. -/
@[simp] lemma is_basis.equiv_fun_symm_apply (x : ι → R) :
  h.equiv_fun.symm x = ∑ i, x i • v i :=
begin
  change finsupp.sum
      ((finsupp.equiv_fun_on_fintype.symm : (ι → R) ≃ (ι →₀ R)) x) (λ (i : ι) (a : R), a • v i)
    = ∑ i, x i • v i,
  dsimp [finsupp.equiv_fun_on_fintype, finsupp.sum],
  rw finset.sum_filter,
  refine finset.sum_congr rfl (λi hi, _),
  by_cases H : x i = 0; simp [H]
end

lemma is_basis.equiv_fun_apply (u : M) : h.equiv_fun u = h.repr u := rfl

lemma is_basis.equiv_fun_total (u : M) : ∑ i, h.equiv_fun u i • v i = u:=
begin
  conv_rhs { rw ← h.total_repr u },
  simp [finsupp.total_apply, finsupp.sum_fintype, h.equiv_fun_apply]
end

@[simp]
lemma is_basis.equiv_fun_self (i j : ι) : h.equiv_fun (v i) j = if i = j then 1 else 0 :=
by { rw [h.equiv_fun_apply, h.repr_self_apply] }

@[simp] theorem is_basis.constr_apply_fintype (f : ι → M') (x : M) :
  (h.constr f : M → M') x = ∑ i, (h.equiv_fun x i) • f i :=
by simp [h.constr_apply, h.equiv_fun_apply, finsupp.sum_fintype]

end module

section vector_space

variables [field K] [add_comm_group V] [add_comm_group V'] [module K V] [module K V']
variables {v : ι → V} {s t : set V} {x y z : V}

include K

open submodule

lemma exists_subset_is_basis (hs : linear_independent K (λ x, x : s → V)) :
  ∃b, s ⊆ b ∧ is_basis K (coe : b → V) :=
let ⟨b, hb₀, hx, hb₂, hb₃⟩ := exists_linear_independent hs (@subset_univ _ _) in
⟨ b, hx,
  @linear_independent.restrict_of_comp_subtype _ _ _ id _ _ _ _ hb₃,
  by simp; exact eq_top_iff.2 hb₂⟩

lemma exists_sum_is_basis (hs : linear_independent K v) :
  ∃ (ι' : Type u) (v' : ι' → V), is_basis K (sum.elim v v') :=
begin
  -- This is a hack: we jump through hoops to reuse `exists_subset_is_basis`.
  let s := set.range v,
  let e : ι ≃ s := equiv.of_injective v hs.injective,
  have : (λ x, x : s → V) = v ∘ e.symm := by { ext, dsimp, rw [equiv.apply_of_injective_symm v] },
  have : linear_independent K (λ x, x : s → V),
  { rw this,
    exact linear_independent.comp hs _ (e.symm.injective), },
  obtain ⟨b, ss, is⟩ := exists_subset_is_basis this,
  let e' : ι ⊕ (b \ s : set V) ≃ b :=
  calc ι ⊕ (b \ s : set V) ≃ s ⊕ (b \ s : set V) : equiv.sum_congr e (equiv.refl _)
                       ... ≃ b                   : equiv.set.sum_diff_subset ss,
  refine ⟨(b \ s : set V), λ x, x.1, _⟩,
  convert is_basis.comp is e' _,
  { funext x,
    cases x; simp; refl, },
  { exact e'.bijective, },
end

variables (K V)
lemma exists_is_basis : ∃b : set V, is_basis K (λ i, i : b → V) :=
let ⟨b, _, hb⟩ := exists_subset_is_basis (linear_independent_empty K V : _) in ⟨b, hb⟩
variables {K V}

lemma linear_map.exists_left_inverse_of_injective (f : V →ₗ[K] V')
  (hf_inj : f.ker = ⊥) : ∃g:V' →ₗ V, g.comp f = linear_map.id :=
begin
  rcases exists_is_basis K V with ⟨B, hB⟩,
  have hB₀ : _ := hB.1.to_subtype_range,
  have : linear_independent K (λ x, x : f '' B → V'),
  { have h₁ := hB₀.image_subtype
      (show disjoint (span K (range (λ i : B, i.val))) (linear_map.ker f), by simp [hf_inj]),
    rwa subtype.range_coe at h₁ },
  rcases exists_subset_is_basis this with ⟨C, BC, hC⟩,
  haveI : inhabited V := ⟨0⟩,
  use hC.constr (C.restrict (inv_fun f)),
  refine hB.ext (λ b, _),
  rw image_subset_iff at BC,
  have : f b = (⟨f b, BC b.2⟩ : C) := rfl,
  dsimp,
  rw [this, constr_basis hC],
  exact left_inverse_inv_fun (linear_map.ker_eq_bot.1 hf_inj) _
end

lemma submodule.exists_is_compl (p : submodule K V) : ∃ q : submodule K V, is_compl p q :=
let ⟨f, hf⟩ := p.subtype.exists_left_inverse_of_injective p.ker_subtype in
⟨f.ker, linear_map.is_compl_of_proj $ linear_map.ext_iff.1 hf⟩

instance module.submodule.is_complemented : is_complemented (submodule K V) :=
⟨submodule.exists_is_compl⟩

lemma linear_map.exists_right_inverse_of_surjective (f : V →ₗ[K] V')
  (hf_surj : f.range = ⊤) : ∃g:V' →ₗ V, f.comp g = linear_map.id :=
begin
  rcases exists_is_basis K V' with ⟨C, hC⟩,
  haveI : inhabited V := ⟨0⟩,
  use hC.constr (C.restrict (inv_fun f)),
  refine hC.ext (λ c, _),
  simp [constr_basis hC, right_inverse_inv_fun (linear_map.range_eq_top.1 hf_surj) c]
end

/-- Any linear map `f : p →ₗ[K] V'` defined on a subspace `p` can be extended to the whole
space. -/
lemma linear_map.exists_extend {p : submodule K V} (f : p →ₗ[K] V') :
  ∃ g : V →ₗ[K] V', g.comp p.subtype = f :=
let ⟨g, hg⟩ := p.subtype.exists_left_inverse_of_injective p.ker_subtype in
⟨f.comp g, by rw [linear_map.comp_assoc, hg, f.comp_id]⟩

open submodule linear_map

/-- If `p < ⊤` is a subspace of a vector space `V`, then there exists a nonzero linear map
`f : V →ₗ[K] K` such that `p ≤ ker f`. -/
lemma submodule.exists_le_ker_of_lt_top (p : submodule K V) (hp : p < ⊤) :
  ∃ f ≠ (0 : V →ₗ[K] K), p ≤ ker f :=
begin
  rcases set_like.exists_of_lt hp with ⟨v, -, hpv⟩, clear hp,
  rcases (linear_pmap.sup_span_singleton ⟨p, 0⟩ v (1 : K) hpv).to_fun.exists_extend with ⟨f, hf⟩,
  refine ⟨f, _, _⟩,
  { rintro rfl, rw [linear_map.zero_comp] at hf,
    have := linear_pmap.sup_span_singleton_apply_mk ⟨p, 0⟩ v (1 : K) hpv 0 p.zero_mem 1,
    simpa using (linear_map.congr_fun hf _).trans this },
  { refine λ x hx, mem_ker.2 _,
    have := linear_pmap.sup_span_singleton_apply_mk ⟨p, 0⟩ v (1 : K) hpv x hx 0,
    simpa using (linear_map.congr_fun hf _).trans this }
end

theorem quotient_prod_linear_equiv (p : submodule K V) :
  nonempty ((p.quotient × p) ≃ₗ[K] V) :=
let ⟨q, hq⟩ := p.exists_is_compl in nonempty.intro $
((quotient_equiv_of_is_compl p q hq).prod (linear_equiv.refl _ _)).trans
  (prod_equiv_of_is_compl q p hq.symm)

open fintype
variables (K) (V)

theorem vector_space.card_fintype [fintype K] [fintype V] :
  ∃ n : ℕ, card V = (card K) ^ n :=
exists.elim (exists_is_basis K V) $ λ b hb, ⟨card b, module.card_fintype hb⟩

end vector_space


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

import topology.continuous_function.compact -- funciones continuas, conjuntos compactos

/-!

# Ejercicio
En este fichero el objetivo es demostrar que si `f : X → Y`
es una función continua y `S : set X` es un conjunto compacto,
entonces su imagen `f '' S : set Y` también es compacta.

Un lema útil para esta demostración es

* `continuous.is_open_preimage` : la preimagen de un abierto bajo
una función continua es un abierto.
-/

-- Fijamos espacios topológicos X e Y
variables (X Y : Type) [topological_space X] [topological_space Y]

-- S es un subconjunto de X
variable (S : set X)

-- `f : X → Y` es una función
variables (f : X → Y)

-- Si f es continua y S es compacto,  la imagen f(S) también es un conjunto compacto.
example (hf : continuous f) (hS : is_compact S) : is_compact (f '' S) :=
begin
  rw is_compact_iff_finite_subcover at hS ⊢,
  sorry
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.fintype.sort
! leanprover-community/mathlib commit 509de852e1de55e1efa8eacfa11df0823f26f226
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.Sort
import Mathlib.Data.Fintype.Basic

/-!
# Sorting a finite type

This file provides two equivalences for linearly ordered fintypes:
* `monoEquivOfFin`: Order isomorphism between `α` and `Fin (card α)`.
* `finSumEquivOfFinset`: Equivalence between `α` and `Fin m ⊕ Fin n` where `m` and `n` are
  respectively the cardinalities of some `Finset α` and its complement.
-/

open Finset

/-- Given a linearly ordered fintype `α` of cardinal `k`, the order isomorphism
`monoEquivOfFin α h` is the increasing bijection between `Fin k` and `α`. Here, `h` is a proof
that the cardinality of `α` is `k`. We use this instead of an isomorphism `Fin (card α) ≃o α` to
avoid casting issues in further uses of this function. -/
def monoEquivOfFin (α : Type _) [Fintype α] [LinearOrder α] {k : ℕ} (h : Fintype.card α = k) :
    Fin k ≃o α :=
  (univ.orderIsoOfFin h).trans <| (OrderIso.setCongr _ _ coe_univ).trans OrderIso.Set.univ
#align mono_equiv_of_fin monoEquivOfFin

variable {α : Type _} [DecidableEq α] [Fintype α] [LinearOrder α] {m n : ℕ} {s : Finset α}

/-- If `α` is a linearly ordered fintype, `s : Finset α` has cardinality `m` and its complement has
cardinality `n`, then `Fin m ⊕ Fin n ≃ α`. The equivalence sends elements of Fin m` to
elements of `s` and elements of `Fin n` to elements of `sᶜ` while preserving order on each
"half" of `Fin m ⊕ Fin n` (using `Set.orderIsoOfFin`). -/
def finSumEquivOfFinset (hm : s.card = m) (hn : sᶜ.card = n) : Sum (Fin m) (Fin n) ≃ α :=
  calc
    Sum (Fin m) (Fin n) ≃ Sum (s : Set α) (sᶜ : Set α) :=
      Equiv.sumCongr (s.orderIsoOfFin hm).toEquiv <|
        (sᶜ.orderIsoOfFin hn).toEquiv.trans <| Equiv.Set.ofEq s.coe_compl
    _ ≃ α := Equiv.Set.sumCompl _

#align fin_sum_equiv_of_finset finSumEquivOfFinset

@[simp]
theorem finSumEquivOfFinset_inl (hm : s.card = m) (hn : sᶜ.card = n) (i : Fin m) :
    finSumEquivOfFinset hm hn (Sum.inl i) = s.orderEmbOfFin hm i :=
  rfl
#align fin_sum_equiv_of_finset_inl finSumEquivOfFinset_inl

@[simp]
theorem finSumEquivOfFinset_inr (hm : s.card = m) (hn : sᶜ.card = n) (i : Fin n) :
    finSumEquivOfFinset hm hn (Sum.inr i) = sᶜ.orderEmbOfFin hn i :=
  rfl
#align fin_sum_equiv_of_finset_inr finSumEquivOfFinset_inr


import data.set.finite
-- Church numerals

-- Another way of doing nat.

-- The church nat, chℕ (happy to change the name) is a pi type
-- and not a structure. So proofs are not done by induction!
--import data.equiv

def chℕ := Π X : Type, (X → X) → X → X
namespace chnat

open nat
-- map from normal nats
def of_nat : ℕ → chℕ
| 0 := λ X f x, x
| (succ n) := λ X f x, f (of_nat n X f x)
-- can I close nat now?

-- examples of chnats
def c0 := of_nat 0
def c1 := of_nat 1
def c2 := of_nat 2
def c3 := of_nat 3

-- now we have some constants.

-- what is zero?
example (X f x) : c0 X f x = x := rfl
-- what is one?
example (X f x) : c1 X f x = f x := rfl
-- what is two?
example (X f x) : c2 X f x = f (f x) := rfl
-- what is three?
example (X f x) : c3 X f x = f (f (f x)) := rfl
-- and so on

-- we can go back from chℕ to ℕ
definition to_nat : chℕ → ℕ := λ m, m ℕ nat.succ 0 -- there is a beauty here
-- it is almost as if the structure ℕ were built to be fed into chℕ
-- Why does this happen? KB doesn't understand

-- that definition needs to be moved if we can't prove functoriality wrt succ

example : to_nat c3 = 3 := rfl

-- exercise: define succ
def succ :chℕ → chℕ := λ n X f x, f (n X f x) -- KB can do this one
-- no notation

--unit tests -- KB can pass these
example : succ c0 = c1 := rfl
example : succ c2 = c3 := rfl

example (n : ℕ) : of_nat (nat.succ n) = succ (of_nat n) := rfl

--KB can't do this one. Is it unprovable? If so, move definition of to_nat much further down.
example (m : chℕ) : to_nat (succ m) = nat.succ (to_nat m) := rfl
--Kenny can do this one, lol.

-- exercise : define add
def add : chℕ → chℕ → chℕ := λ m n X f x, n X f (m X f x) -- KB can do this
instance : has_add chℕ := ⟨add⟩ -- now we have + notation

example : c2 + c1 = c3 := rfl
-- KB didn't do this one yet but feels it should be true.
theorem of_nat.add (m n : ℕ) : of_nat (m + n) = of_nat m + of_nat n :=
begin
  induction n with n ih,
  { refl },
  { simp [of_nat, ih], simp [(+), add] }
end

-- exercise : define mul
def mul : chℕ → chℕ → chℕ := λ m n X f, n X (m X f) -- KB can do this
instance : has_mul chℕ := ⟨mul⟩ -- incantation to give us *

-- KB can do this one
example : c1 + c2 + c3 = c2 * c3 := rfl
-- KB didn't try this one
theorem of_nat.mul (m n : ℕ) : of_nat (m * n) = of_nat m * of_nat n :=
begin
  induction n with n ih,
  { refl },
  { rw nat.mul_comm at ih,
    rw [nat.mul_succ, nat.mul_comm, of_nat.add, of_nat, ih],
    dsimp [(*), mul, (+), add],
    refl }
end

-- exercise : define pow
def pow : chℕ → chℕ → chℕ := λ m n X, n (X → X) (m X) -- KB can do this one
-- instance : has_pow chℕ := ⟨pow⟩ -- doesn't seem to work

-- KB can do this
example : pow c2 c3 + c1 = pow c3 c2 := rfl
-- KB didn't try this
example (m n : ℕ) : of_nat (nat.pow m n) = pow (of_nat m) (of_nat n) :=
begin
  induction n with n ih,
  { refl },
  { unfold nat.pow,
    unfold of_nat,
    rw [of_nat.mul, ih],
    unfold pow,
    dsimp [(*), mul],
    refl }
end

-- exercise : define Ackermann
def ack : chℕ → chℕ → chℕ :=
λ m n X, m ((((X → X) → (X → X)) → (X → X) → (X → X)) → ((X → X) → X → X))
  (λ m_ih n f, n
    (λ n_ih x, m_ih sorry f x) -- n_ih represents f
-- composed with itself Ack(m,n) times, but I need
-- to convert it to a church numeral in "sorry".
    (λ x, m_ih id f x))
  (λ n f, n
    (λ n_ih x, f (n_ih x))
    (λ x, f x))
  (n (X → X)) -- KB didn't try this one
-- Is it possible?
-- Kenny : I don't think it is possible, since you need to
-- recursively build a Type 1 function, whereas chℕ only
-- permits recursion on Type 0 stuff.

-- if it's possible, prove it agrees with usual ackermnann
-- example : ack m n = ack (of_nat m) (of_nat n) := sorry

-- question : Is this provable? KB couldn't do this one
theorem add_comm (m n : chℕ) : m + n = n + m := sorry

-- KB thinks this might be chℕ's free theorem
-- KB can't prove it
theorem free_chnat : ∀ (A B : Type), ∀ f : A → B,
∀ r : chℕ, ∀ a : A, r (A → B) (λ g,f) f a  = r (A → B) (λ g,g) f a
 := sorry

structure equiv' (α : Sort*) (β : Sort*) :=
(to_fun    : α → β)
(inv_fun   : β → α)
(left_inv  : ∀ (x : α), inv_fun (to_fun x) = x)
(right_inv : ∀ (y : β), to_fun (inv_fun y) = y)

-- is ℕ equiv to chℕ ?

theorem ij : ∀ n : ℕ, to_nat (of_nat n) = n := begin
intro n,
induction n with d Hd,refl,
unfold of_nat,
unfold to_nat,
unfold to_nat at Hd,
rw Hd,
end

-- KB can't do this one
theorem ji : ∀ c : chℕ, of_nat (to_nat c) = c := sorry
-- Can someone write down an uncomputable counterexample?

-- so KB can't do this either
definition ℕ_is_chℕ : equiv' ℕ chℕ := sorry

-- idle question
theorem is_it_true (X : Type) (f : X → X) (x : X) : f x = x := sorry

-- bad church numeral
local attribute [instance] classical.prop_decidable
noncomputable definition satan (X : Type) (f : X → X) (x : X) := dite (X = ℕ) (λ H,begin show X,rw H,rw H at x,exact x end) (λ _,f x)
#check (satan : chℕ) -- 1 everywhere apart from nat, where it's zero

lemma bool_not_nat : bool ≠ ℕ := λ h,
by haveI : fintype ℕ := eq.rec_on h (by apply_instance);
exact set.not_injective_nat_fintype @nat.succ_inj

theorem satan_is_bad : of_nat (to_nat satan) = satan → false :=
begin
intro H,
have H2 : (of_nat (to_nat satan)) bool bnot tt = satan bool bnot tt := by rw H,
unfold to_nat at H2,
unfold satan at H2,
simp at H2,
change tt = _ at H2,
suffices : ¬ (bool = ℕ),
simp [this] at H2,assumption,
exact bool_not_nat,
end

end chnat


@[elab_as_eliminator]
lemma nat_ind
  {P : ℕ → Prop}
  (zero : P 0)
  (successor : ∀ n, P n → P (n + 1)) (n : ℕ)
  : P n :=
nat.rec zero successor n

example
  {P : ℕ → Prop}
  (z : P 0)
  (s : ∀ n, P n → P (n + 1)) (n : ℕ)
  : P n :=
begin
  with_cases { apply nat_ind },
  case zero { exact z},
  case successor : m ih { exact s m ih }
end


theorem le_succ (a b : mynat) : a ≤ b → a ≤ (succ b) :=
begin
intro h,
cases h with c hc,
use c + 1,
rw add_one_eq_succ,
rw add_succ,
rw hc,
refl,
end


import tactic

/-- The equivalence relation on ℕ² such that equivalence classes are ℤ -/
def nat2.R (a b : ℕ × ℕ) : Prop :=
a.1 + b.2 = b.1 + a.2
-- here a and b are pairs, so a = (a.1, a.2) etc.

-- introduce ≈ (type with `\~~`) notation for this relation
instance : has_equiv (ℕ × ℕ) := ⟨nat2.R⟩

-- let's prove some lemmas about this binary relation
namespace nat2.R

-- The following lemma is true by definition, but it's useful to
-- have it around so you can rewrite with it
lemma equiv_def {i j k l : ℕ} : (i, j) ≈ (k, l) ↔ i + l = k + j :=
begin
  refl
end

-- try rewriting `equiv_def`
lemma practice : (3, 5) ≈ (4, 6) :=
begin
  sorry
end

-- Now let's prove that this binary relation is an equivalence relation
lemma reflexive : ∀ x : ℕ × ℕ, x ≈ x :=
begin
  -- let x be (i,j)
  rintro ⟨i, j⟩,
  sorry
end

lemma symmetric : ∀ x y : ℕ × ℕ, (x ≈ y) → (y ≈ x) :=
begin
  -- here are a couple of tricks
  rintro ⟨i, j⟩ ⟨k, l⟩ h,
  -- type `⊢` with `\|-`
  rw equiv_def at h ⊢,
  sorry
end

-- sub-boss

lemma transitive : ∀ x y z : ℕ × ℕ, (x ≈ y) → (y ≈ z) → (x ≈ z) :=
begin
  -- this is a little trickier
  -- recall `add_left_inj a` says `b + a = c + a ↔ b = c`
  -- and you might want to consider rewriting it in the ← direction
  sorry
end

-- This line tells Lean that the binary relation is an equivalence
-- relation and hence we can take the "quotient", i.e. the
-- type of equivalence classes
instance setoid : setoid (ℕ × ℕ) :=
{ r := nat2.R,
  iseqv := ⟨reflexive, symmetric, transitive⟩ }

-- end of lemmas about the binary relation
end nat2.R

-- ...but we're still going to be using them
open nat2.R

/-- The integers are the equivalence classes of the equivalence relation
 we just defined on ℕ²  -/
def myint := quotient nat2.R.setoid

-- let's make some definitions, and prove some theorems, about integers
namespace myint

-- The first goal is to get a good interface for addition.
-- To do this we need to define a+b, and -a, and 0. Let's do
-- them in reverse order.

/-! ## zero -/

-- Notation: ⟦(a,b)⟧ ∈ ℤ is the equivalence class of (a,b) ∈ ℕ²

/-- 0 is the equivalence class of (0,0) -/
def zero := ⟦(0,0)⟧

-- Notation 0 for zero
instance : has_zero myint := ⟨myint.zero⟩

-- true by definition
lemma zero_def : (0 : myint) = ⟦(0, 0)⟧ :=
begin
  sorry
end

/-! ## negation (additive inverse) -/

-- First we define an "auxiliary" map from ℕ² to ℤ
-- sending (a,b) to the equivalence class of (b,a).

def neg_aux (x : ℕ × ℕ) : myint := ⟦(x.2, x.1)⟧

-- true by definition
lemma neg_aux_def (i j : ℕ) : neg_aux (i, j) = ⟦(j, i)⟧ :=
begin
  sorry
end

/-! ### Well-definedness of negation

OK now here's the concrete problem. We would like to define
a negation map `ℤ → ℤ` sending `z` to `-z`. We want to do this in
the following way: Say `z ∈ ℤ`. Choose `a=(i,j) ∈ ℕ²` representing `z`
(i.e. such that `cl(i,j) = ⟦(i,j)⟧ = z`)
Now apply `neg_aux` to `a`, and define `-z` to be the result.

The problem with this is that what if `b` is a different
element of the equivalence class? Then we also want `-z` to be `neg_aux b`.

Indeed, in Lean this construction is called `quotient.lift`, and
if you uncomment the below code
-/

--def neg : myint → myint :=
--quotient.lift neg_aux _

/-
you'll see an error, and if you put your cursor on the error you'll
see that Lean wants a proof that if two elements `a` and `b` are in the
same equivalence class, then `neg_aux a = neg_aux b`. So let's prove this now.

You'll need to know `quotient.sound : a ≈ b → ⟦a⟧ = ⟦b⟧`
-/

-- negation on the integers, defined via neg_aux, is well-defined.
lemma neg_aux_lemma : ∀ x y : ℕ × ℕ, x ≈ y → neg_aux x = neg_aux y :=
begin
  rintro ⟨i,j⟩ ⟨k,l⟩ h,
  rw [neg_aux_def, neg_aux_def],
  -- ⊢ ⟦(j, i)⟧ = ⟦(l, k)⟧
  -- next step: if ⟦a⟧=⟦b⟧ then a ≈ b
  apply quotient.sound,
  -- ⊢ (j, i) ≈ (l, k)
  -- take it from here.
  sorry
end

-- Note that we use `neg_aux_lemma` in the definition below
-- to justify well-definedness of `neg`

/-- Negation on on the integers. The function sending `z` to `-z`. -/
def neg : myint → myint :=
quotient.lift neg_aux neg_aux_lemma

-- notation for negation
instance : has_neg myint := ⟨neg⟩

-- We can now write `-z` if `z : myint`

-- this is true by definition
lemma neg_def (i j : ℕ) : (-⟦(i, j)⟧ : myint) = ⟦(j, i)⟧ :=
begin
  sorry
end

/-!  ## addition

Our final construction: we want to define addition on `myint`.
Here we have the same problem. Say z₁ and z₂ are integers.
Choose elements a₁=(i,j) and a₂=(k,l) in ℕ². We want to define
z₁ + z₂ to be ⟦(i+k,j+l)⟧, the equivalence class of a₁ + a₂.
We will need to check this is well-defined.

-/

/-- An auxiliary function taking two elements of ℕ² and returning
the equivalence class of their sum. -/
def add_aux (x y : ℕ × ℕ) : myint := ⟦(x.1 + y.1, x.2 + y.2)⟧

-- true by definition
lemma add_aux_def (i j k l : ℕ) : add_aux (i, j) (k, l) = ⟦(i + k, j + l)⟧ :=
begin
  sorry
end

/-

We want the definition of addition to look like the below.
Uncomment it to see the problem.

-/

--def add : myint → myint → myint :=
--quotient.lift₂ add_aux _

/-
We had better check that choosing different elements in the same
equivalence class gives the same definition.

-/

lemma add_aux_lemma : ∀ x₁ x₂ y₁ y₂ : ℕ × ℕ,
(x₁ ≈ y₁) → (x₂ ≈ y₂) → add_aux x₁ x₂ = add_aux y₁ y₂ :=
begin
  sorry
end

-- Now this is checked, we can define addition: it's well-defined.

/-- Addition on the integers -/
def add : myint → myint → myint :=
quotient.lift₂ add_aux add_aux_lemma

-- notation for addition
instance : has_add myint := ⟨add⟩

-- true by definition
lemma add_def (i j k l : ℕ) :
  (⟦(i, j)⟧ + ⟦(k, l)⟧ : myint) = ⟦(i + k, j + l)⟧ :=
begin
  sorry
end

/-
The four fundamental facts about addition on the integers are:
1) associativity
2) commutativity
3) zero is an additive identity
4) negation is an additive inverse.

Let's prove these now.

-/

lemma zero_add (x : myint) : 0 + x = x :=
begin
  -- need to get from ℤ back to ℕ²
  apply quotient.induction_on x,
  sorry,
end

lemma add_zero (x : myint) : x + 0 = x :=
begin
  sorry
end

lemma add_left_neg (x : myint) : -x + x = 0 :=
begin
  sorry
end

-- here we need to change both x and y into elements of ℕ²
lemma add_comm (x y : myint) : x + y = y + x :=
begin
  apply quotient.induction_on₂ x y,
  sorry
end

lemma add_assoc (x y z : myint) : (x + y) + z = x + (y + z) :=
begin
  sorry,
end

-- The lemmas above are the axioms for a commutative group.

-- Hence we just proved that the integers are a
-- commutative group under addition!

instance : add_comm_group myint :=
{ add := (+),
  add_assoc := add_assoc,
  zero := 0,
  zero_add := zero_add,
  add_zero := add_zero,
  neg := has_neg.neg,
  add_left_neg := add_left_neg,
  add_comm := add_comm }

-- woohoo!

/-! ## multiplication

What's left to define is 1 and multiplication (note that we don't need multiplicative
inverses -- if a is a non-zero integer then a⁻¹ is typially not an integer)

-/

def mul_aux (x y : ℕ × ℕ) : myint := ⟦(sorry, sorry)⟧

-- true by definition
lemma mul_aux_def (i j k l : ℕ) : mul_aux (i, j) (k, l) = sorry :=
begin
  sorry
end

-- Boss level.
-- Dr. Lawn: "We leave the similar verification for multiplication as an exercise."

-- This is what we need to check for multiplication to "descend" (or "lift" as Lean
-- calls it) to a well-defined function on the quotient.
lemma mul_aux_lemma : ∀ x₁ x₂ y₁ y₂ : ℕ × ℕ,
(x₁ ≈ y₁) → (x₂ ≈ y₂) → mul_aux x₁ x₂ = mul_aux y₁ y₂ :=
begin
  sorry
end

-- It's much easier from here on

-- definition of multiplication
def mul : myint → myint → myint :=
quotient.lift₂ mul_aux mul_aux_lemma

instance : has_mul myint := ⟨mul⟩

-- true by definition
lemma mul_def (i j k l : ℕ) : (⟦(i, j)⟧ * ⟦(k, l)⟧ : myint) = ⟦(sorry, sorry)⟧ :=
begin
  sorry
end

lemma mul_assoc (x y z : myint) : (x * y) * z = x * (y * z) :=
begin
  sorry
end

def one : myint := ⟦(sorry, sorry)⟧

instance : has_one myint := ⟨myint.one⟩

-- true by definition
lemma one_def : (1 : myint) = sorry :=
begin
  sorry
end

lemma one_mul (x : myint) : 1 * x = x :=
begin
  sorry
end

lemma mul_one (x : myint) : x * 1 = x :=
begin
  sorry
end

lemma mul_comm (x y : myint) : x * y = y * x :=
begin
  sorry
end

lemma mul_add (x y z : myint) : x * (y + z) = x * y + x * z :=
begin
  sorry
end

lemma add_mul (x y z : myint) : (x + y) * z = x * z + y * z :=
begin
  sorry
end

-- The integers are a commutative ring
-- (that is, they satisfy the axioms we just proved)
instance : comm_ring myint :=
{ mul := (*),
  mul_assoc := mul_assoc,
  one := 1,
  one_mul := one_mul,
  mul_one := mul_one,
  left_distrib := mul_add,
  right_distrib := add_mul,
  mul_comm := mul_comm,
  ..myint.add_comm_group }

end myint


import set_theory.cardinal
import data.finset.basic
import data.stream.basic
import tactic

open_locale classical
noncomputable theory

-- Definition 1: Prof V X represents the set of (V, X)-profiles
def Prof : Type → Type → Type := λ (V X : Type), V → X → X → Prop

-- Definition 2: Given a profile P and x, y ∈ X(P)
-- we say that x is majority preferred to y in P if
-- more voters rank x above y than rank y above x.
def majority_preferred {V X : Type} : Prof V X → X → X → Prop := λ P x y,
cardinal.mk {v : V // P v x y} > cardinal.mk {v : V // P v y x}

-- Definition 3: Given a profile P and x₁, x₂ ∈ X(P),
-- the margin of x₁ over x₂ in P, denoted Marginₚ(x₁, x₂), is
-- |{i ∈ V (P) | x₁Pᵢx₂}| − |{i ∈ V (P) | x₂Pᵢx₁}|.
def margin {V X : Type} [fintype V] : Prof V X → X → X → ℤ :=
    λ P x₁ x₂, ↑(finset.univ.filter (λ v, P v x₁ x₂)).card
    - ↑(finset.univ.filter (λ v, P v x₂ x₁)).card

-- The property of skew-symmetry takes in a function
-- and outputs the proposition stating that the
-- skew-symmetry equation holds for all pairs:
def skew_symmetric {X : Type} : (X → X → ℤ) → Prop :=
    λ M, ∀ x y, M x y = - M y x.

-- Proof that Marginₚ is skew-symmetric for any Prof P.
lemma margin_skew_symmetric {V X : Type} (P : Prof V X) [fintype V] : skew_symmetric (margin P) :=
begin
    unfold margin,
    obviously,
end

-- Definition 4: Given a profile P and x ∈ X(P), we say that x is
-- a Condorcet winner in P if for all y ∈ X(P) with y ≠ x,
-- x is majority preferred to y in P.
def condorcet_winner {V X : Type} (P : Prof V X) (x : X) : Prop :=
    ∀ y ≠ x, majority_preferred P x y

-- We say that x is a majority winner in P if the number of voters
-- who rank x (and only x) in first place is greater than the number
-- of voters who do not rank x in first place.
def majority_winner {V X : Type} (P : Prof V X) (x : X) : Prop :=
    cardinal.mk {v : V // ∀ y ≠ x, P v x y} > cardinal.mk {v : V // ∃ y ≠ x, P v y x}

-- Proof that a majority winner is a Condorcet winner.
lemma condorcet_of_majority_winner {V X : Type} (P : Prof V X) [fintype V] (x : X) : majority_winner P x → condorcet_winner P x :=
begin
    intros majority z z_ne_x,
    have imp1 : ∀ v, (∀ y ≠ x, P v x y) → P v x z := by finish,
    refine lt_of_lt_of_le _ (cardinal.mk_subtype_mono imp1),
    have imp2 : ∀ v, P v z x → (∃ y ≠ x, P v y x) := by finish,
    apply lt_of_le_of_lt (cardinal.mk_subtype_mono imp2),
    exact majority,
end

-- Definition 5: Let SCC be a function that assigns
-- to each pair (V, X) the set of all (V, X)-SCCs.
def SCC := λ (V X : Type), Prof V X → set X

def universal_domain_SCC {V X : Type} (F : SCC V X) : Prop :=
    ∀ P : Prof V X, F P ≠ ∅

-- Example 1: Given a (V, X)-profile P, if there is a Condorcet winner,
-- then output the set of all Condorcet winners (which will be a singleton),
-- and otherwise output all candidates in X.
def condorcet_SCC {V X : Type} : SCC V X := λ P,
    {x : X | condorcet_winner P x ∨ (¬∃ y, condorcet_winner P y)}

-- Definition 6: A variable-election social choice correspondence (VSCC)
-- is a function F that assigns to each pair (V, X) a (V,X)-SCC.
def VSCC : Type 1 := Π (V X : Type), SCC V X.

def finite_universal_domain_VSCC (F : VSCC) : Prop :=
    ∀ V X [inhabited V] [inhabited X] [fintype V] [fintype X], universal_domain_SCC (F V X)

-- Example 2
def condorcet_VSCC : VSCC := λ V X, condorcet_SCC

-- A collective choice rule for (V, X), or (V, X)-CCR, is
-- a function f : Prof(V, X) → B(X). Let CCR be a function
-- that assigns to each pair (V, X) of the set of all (V,X)-CCRs.
def CCR := λ (V X : Type), Prof V X → X → X → Prop

-- cycle takes in a binary relation R and a list c of
-- elements of X and  outputs the proposition stating that
-- (i) there is a proof e that c is not the empty list, and
-- (ii) c is a cycle in R.
def cycle {X: Type} := λ (R : X → X → Prop) (c : list X),
    ∃ (e : c ≠ list.nil), list.chain R (c.last e) c

-- Example 3: A candidate x defeats a candidate y in P
-- just in case the margin of x over y is (i) positive and
-- (ii) greater than the weakest margin in each majority cycle containing x and y.
def split_cycle_CCR {V X : Type} : CCR V X :=
    λ (P : Prof V X) (x y : X), ∀ [f: fintype V],
    0 < @margin V X f P x y ∧
    ¬ (∃ (c : list X), x ∈ c ∧ y ∈ c ∧
    cycle (λ a b, @margin V X f P x y ≤ @margin V X f P a b) c)

-- Definition 8: A variable-election collective choice rule (VCCR)
-- is a function that assigns to each pair (V, X) a (V, X)-CCR.
def VCCR := Π (V X : Type), CCR V X

-- Example 4
def split_cycle_VCCR : VCCR := λ V X, split_cycle_CCR

-- Definition 9: Given an asymmetric VCCR F, we define the induced VSCC F*
-- such that for any V, X, and (V, X)-profile P, we have
-- F*(V,X)(P) = {x ∈ X(P) | ∀y ∈ X(P), (y, x) ∉ F(V, X)(P)}.
def max_el_VSCC : VCCR → VSCC := λ f V X P, {x | ∀ y : X, ¬ f V X P y x}

-- Example 5: The Split Cycle voting method is
-- the induced VSCC from the Split Cycle VCCR
def split_cycle : VSCC := max_el_VSCC split_cycle_VCCR

def acyclic {X : Type} : (X → X → Prop) → Prop :=
    λ Q, ∀ (c : list X), ¬ cycle Q c

-- Any acyclic VCCR induces a VSCC satisfying (finite) universal domain
-- the proof for the following theorem can be found in src/main.lean
theorem max_el_VSCC_universal_domain (F : VCCR)
(a : ∀ V X [inhabited V] [inhabited X] [fintype V] [fintype X] (P : Prof V X), acyclic (F V X P)) :
finite_universal_domain_VSCC (max_el_VSCC F) := sorry

-- Converts a walk to a path
noncomputable def to_path {X : Type} : list X → list X
| [] := []
| (u :: p) := let p' := to_path p in
    if u ∈ p' then (p'.drop (p'.index_of u)) else (u :: p')

-- Given a particular candidate c, we say that a nonempty set D of candidates
-- (not containing c) is a set of clones of c if D ∪ {c} is a set of clones.
def clones {V X : Type} (P : Prof V X) (c : X) (D : set {x : X // x ≠ c}) :
    Prop := D.nonempty ∧ (∀ (c' ∈ D) (x : {x : X // x ≠ c}) (i : V),
    x ∈ D → ((P i c x ↔ P i c' x) ∧ (P i x c ↔ P i x c')))

-- minus_candidate takes in a Prof P for V and X, as well as
-- a candidate b from X, and outputs the Prof for V and {x : X // x ̸= b}
-- that agrees with P on how every voter ranks the candidates other than b.
def minus_candidate {V X : Type} (P : Prof V X) (b : X) :
    Prof V {x : X // x ≠ b} := λ v x y, P v x y

--  removing a clone from a profile should not change which non-clones win
def non_clone_choice_ind_clones {V X : Type} (P : Prof V X) (c : X) (D : set {x : X // x ≠ c})
    : VSCC → Prop :=  λ F, clones P c D → (∀ a : {x : X // x ≠ c},
    a ∉ D → (a.val ∈ (F V X P) ↔ a ∈ (F V {x : X // x ≠ c} (minus_candidate P c))))

-- we can state that Split Cycle satisfies part (i) of independence of clones as follows:
-- the proof for the following theorem can be found in src/clones.lean
theorem non_clone_choice_ind_clones_split_cycle {V X : Type} [fintype V]
    (P : Prof V X) (c : X) (D : set {x : X // x ≠ c}) : non_clone_choice_ind_clones P c D split_cycle := sorry


import lecture1

open_locale filter topological_space big_operators
open filter

open_locale classical
noncomputable theory

lemma tendsto_of_le_of_le {x y z : ℕ → ℝ} {t : ℝ} (hx : tendsto x at_top (𝓝 t))
  (hz : tendsto z at_top (𝓝 t)) (hxy : ∀ n, x n ≤ y n) (hyz : ∀ n, y n ≤ z n) :
  tendsto y at_top (𝓝 t) :=
begin
  rw tendsto_seq_iff at *,
  intros ε hε,
  cases hx (ε/2) (half_pos hε) with N₁ hN₁,
  cases hz (ε/2) (half_pos hε) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  specialize hxy n,
  specialize hyz n,
  specialize hN₁ n (le_of_max_le_left hn),
  specialize hN₂ n (le_of_max_le_right hn),
  rw abs_sub_lt_iff at *,
  cases hN₁ with hN₁ hN₁',
  cases hN₂ with hN₂ hN₂',
  split;
  linarith,
end

/-
Theorem 1.3 (Bolzano-Weierstrass)

To prove this, we are going to use the proof given in lecture, that is, the one by halving the
interval every time, and showing that we have an infinite number of elements no matter how small
the interval becomes.
-/
namespace bolzano_weierstrass

/-
First, we define the inductive step. That is, given an interval [a, b], this returns either
  [a, (a+b)/2] or [(a+b)/2, b], depending on whether there is an infinite number of xₙ in the first
  interval.
-/
def step (x : ℕ → ℝ) (a b : ℝ) : ℝ × ℝ :=
if set.infinite {n | x n ∈ set.Icc a ((a+b)/2)} then
  (a, (a + b)/2)
else
  ((a + b)/2, b)

/-
First, we show that the result of `step` still forms a well defined interval.
-/
lemma step_valid (x : ℕ → ℝ) {a b : ℝ} (h : a ≤ b) :
  let p := step x a b in
  p.1 ≤ p.2 :=
begin
  dsimp [step],
  split_ifs with hp hp; linarith
end

/-
Then, we show that the resulting interval still contains an infinite number of xₙs. To show this,
note that it is not possible for both intervals to be finite, as their union is the original
interval, and if they are both finite then so is their union. Contradiction.
-/
lemma step_valid'_aux {x : ℕ → ℝ} {a b : ℝ} (h : a ≤ b)
  (hx : set.infinite {n | x n ∈ set.Icc a b}) :
  set.infinite {n | x n ∈ set.Icc a ((a+b)/2)} ∨ set.infinite {n | x n ∈ set.Icc ((a+b)/2) b} :=
begin
  by_contra h,
  push_neg at h,
  rw [set.infinite, set.infinite, not_not, not_not] at h,
  apply hx,
  have : {n | x n ∈ set.Icc a b} = {n | x n ∈ set.Icc a ((a+b)/2)} ∪ {n | x n ∈ set.Icc ((a+b)/2) b},
  { ext k,
    simp only [set.mem_union_eq, set.mem_set_of_eq, set.mem_Icc],
    split,
    { rintro ⟨h1, h2⟩,
      by_cases h' : x k ≤ (a + b)/ 2,
      { left, split; linarith },
      { right, split; linarith } },
    { rintro (⟨h1,h2⟩|⟨h1, h2⟩);
      split;
      linarith } },
  rw this,
  refine set.finite.union h.1 h.2,
end

lemma step_valid' {x : ℕ → ℝ} {a b : ℝ} (h : a ≤ b)
  (hx : set.infinite {n | x n ∈ set.Icc a b}) :
  let p := step x a b in
  set.infinite {n | x n ∈ set.Icc p.1 p.2} :=
begin
  dsimp [step],
  split_ifs with hp hp,
  { exact hp },
  { exact or.resolve_left (step_valid'_aux h hx) hp }
end

/-
Next, we show that the new interval is contained within the previous interval
-/
lemma step_valid'' (x : ℕ → ℝ) {a b : ℝ} (h : a ≤ b) :
  let p := step x a b in
  a ≤ p.1 :=
begin
  dsimp [step],
  split_ifs with hp hp,
  { refl },
  { linarith }
end

lemma step_valid''' (x : ℕ → ℝ) {a b : ℝ} (h : a ≤ b) :
  let p := step x a b in
  p.2 ≤ b :=
begin
  dsimp [step],
  split_ifs with hp hp,
  { linarith },
  { refl },
end

/-
Finally, we show that the size of the new interval is half the size of the original interval.
-/
lemma step_valid'''' (x : ℕ → ℝ) {a b : ℝ} :
  let p := step x a b in
  p.2 - p.1 = 1/2 * (b - a) :=
begin
  dsimp [step],
  split_ifs with hp hp;
  { linarith },
end

/-
Then, we define the sequence of intervals. [a, b], [a₁, b₁], ...
-/
noncomputable def step_n (x : ℕ → ℝ) (a b : ℝ) : ℕ → ℝ × ℝ
| 0 := (a, b)
| (n + 1) := let p := step_n n in step x p.1 p.2

/-
We can show that the nth term of this is still a well defined sequence, by induction and the fact
that we have already proven this for `step`.
-/
lemma step_n_valid (x : ℕ → ℝ) {a b : ℝ} (h : a ≤ b) (n : ℕ) :
  (step_n x a b n).1 ≤ (step_n x a b n).2 :=
begin
  induction n with k ih,
  { exact h },
  { dsimp [step_n],
    apply step_valid,
    exact ih }
end

/-
We then define two sequences aₙ and bₙ, which are the lower and upper bounds of those intervals
respectively.
-/
def seq_a (x : ℕ → ℝ) (a b : ℝ) (n : ℕ) : ℝ := (step_n x a b n).1
def seq_b (x : ℕ → ℝ) (a b : ℝ) (n : ℕ) : ℝ := (step_n x a b n).2

/-
We note that aₙ is increasing, that is, a₀ ≤ a₁ ≤ a₂ ≤ ...
-/
lemma seq_a_increasing (x : ℕ → ℝ) (a b : ℝ) (ha : a ≤ b) : monotone (seq_a x a b) :=
begin
  apply monotone_of_monotone_nat,
  intro n,
  dsimp [seq_a, step_n],
  apply step_valid'',
  apply step_n_valid,
  exact ha,
end

/-
As a corollary, this means that the aₙ are bounded below by a₀ = a
-/
lemma a_le_seq_a (x : ℕ → ℝ) (a b : ℝ) (ha : a ≤ b) (n : ℕ) : a ≤ seq_a x a b n :=
begin
  exact @seq_a_increasing x a b ha 0 n (nat.zero_le _),
end

/-
We also note that bₙ is decreasing, that is b₀ ≥ b₁ ≥ ...
-/
lemma seq_b_decreasing (x : ℕ → ℝ) (a b : ℝ) (ha : a ≤ b) :
  ∀ n m, n ≤ m → seq_b x a b m ≤ seq_b x a b n :=
begin
  intros n m h,
  induction h with k ih₁ ih₂,
  { refl },
  { dsimp [seq_b, step_n],
    apply le_trans _ ih₂,
    apply step_valid''',
    apply step_n_valid,
    exact ha }
end

/-
And it follows that bₙ are bounded above by b₀ = b
-/
lemma seq_b_le_b (x : ℕ → ℝ) (a b : ℝ) (ha : a ≤ b) (n : ℕ) : seq_b x a b n ≤ b :=
begin
  exact seq_b_decreasing x a b ha 0 n (nat.zero_le _),
end

/-
An alternative statement for `step_n_valid` is that `aₙ ≤ bₙ` for all `n`.
-/
lemma seq_a_le_seq_b (x : ℕ → ℝ) (a b : ℝ) (ha : a ≤ b) (n : ℕ) : seq_a x a b n ≤ seq_b x a b n :=
step_n_valid x ha n

/-
Then, aₙ is an increasing sequence, bounded above by `b`, so it must converge.
-/
lemma is_convergent_seq_a (x : ℕ → ℝ) (a b : ℝ) (ha : a ≤ b) : is_convergent (seq_a x a b) :=
begin
  apply is_convergent_of_increasing_of_bdd_above b,
  { intro n,
    apply seq_a_increasing,
    exact ha,
    exact nat.le_succ _ },
  { intro n,
    apply le_trans (seq_a_le_seq_b x a b ha n),
    apply seq_b_le_b,
    exact ha }
end

/-
Similarly, bₙ is a decreasing sequence that is bounded below, and it must converge as well.
-/
lemma is_convergent_seq_b (x : ℕ → ℝ) (a b : ℝ) (ha : a ≤ b) : is_convergent (seq_b x a b) :=
begin
  apply is_convergent_of_decreasing_of_bdd_below a,
  { intro n,
    apply seq_b_decreasing,
    exact ha,
    exact nat.le_succ _ },
  { intro n,
    apply le_trans _ (seq_a_le_seq_b _ _ _ _ _),
    apply a_le_seq_a,
    exact ha,
    exact ha }
end

/-
An alternative statement of the halving of the sizes of the inverals is that
  bₙ₊₁ - aₙ₊₁ = 1/2 (bₙ - aₙ)
-/
lemma seq_b_succ_sub_seq_a_succ {x : ℕ → ℝ} {a b : ℝ} (h : a ≤ b) (n : ℕ) :
  seq_b x a b n.succ - seq_a x a b n.succ = 1/2 * (seq_b x a b n - seq_a x a b n) :=
begin
  dsimp [seq_a, seq_b, step_n],
  apply step_valid'''',
end

/-
Then we get that aₙ and bₙ must tend to the same limit. To see this, suppose if aₙ → s and bₙ → t,
then bₙ - aₙ → s - t. As a result, bₙ₊₁ - aₙ₊₁ → 1/2 (s - t) from the above. However, bₙ₊₁ - aₙ₊₁
is also a subsequence of bₙ - aₙ, so it must tend to the same limit. Thus, 1/2 (s - t) = (s - t),
and s = t.
-/
lemma seq_a_seq_b_limit_same {x : ℕ → ℝ} {a b : ℝ} (h : a ≤ b) (s t : ℝ)
  (hs : tendsto (seq_a x a b) at_top (𝓝 s))
  (ht : tendsto (seq_b x a b) at_top (𝓝 t)) : s = t :=
begin
  have h1 := filter.tendsto.sub ht hs,
  have h2 := @tendsto_subseq _ _ nat.succ (λ n, nat.lt_succ_self _) h1,
  have h3 : (λ n, seq_b x a b n - seq_a x a b n) ∘ nat.succ = (λ n, 1/2 *(seq_b x a b n - seq_a x a b n)),
  { ext n,
    dsimp,
    rwa seq_b_succ_sub_seq_a_succ },
  rw h3 at h2,
  have h4 := tendsto.const_mul (1/2 : ℝ) h1,
  have h5 := tendsto_at_top_nhds_unique h2 h4,
  linarith,
end

/-
We can then prove that there are infinitely many `n` such that xₙ ∈ [aᵢ, bᵢ] for all i.
-/
lemma step_n_valid' {x : ℕ → ℝ} {a b : ℝ} (h : a ≤ b) (hx : set.infinite {i | x i ∈ set.Icc a b})
  (n : ℕ) : set.infinite {i | x i ∈ set.Icc (seq_a x a b n) (seq_b x a b n)} :=
begin
  induction n with k ih,
  { exact hx },
  { dsimp [seq_a, seq_b, step_n] at *,
    apply step_valid',
    { apply step_n_valid,
      apply h },
    { exact ih } }
end

/-
From this, the set of such `n` mustn't be bounded above. So no matter gow large `k` is, there is
always an `n > k` such that xₙ ∈ [aᵢ, bᵢ]
-/
lemma exists_ge_mem_Icc {x : ℕ → ℝ} {a b : ℝ} (h : a ≤ b)
  (hx : set.infinite {i | x i ∈ set.Icc a b}) (k m : ℕ) :
  ∃ n > k, x n ∈ set.Icc (seq_a x a b m) (seq_b x a b m) :=
begin
  have h1 := step_n_valid' h hx m,
  dsimp at h1,
  by_contra h,
  push_neg at h,
  have h2 : {i | x i ∈ set.Icc (seq_a x a b m) (seq_b x a b m)} ⊆ (finset.range (k+1) : set ℕ),
  { intros n hn,
    rw [finset.mem_coe, finset.mem_range],
    by_contra h',
    have h'' : k < n,
    { linarith },
    specialize h n h'',
    apply h,
    exact hn },
  apply h1,
  exact set.finite.subset (finset.finite_to_set _) h2,
end

/-
We define `nᵢ` such that `nᵢ₊₁ > nᵢ` and that `x_nᵢ ∈ [aᵢ, bᵢ]` for all `i`. We have shown that such
nᵢ always exists so this is well defined.
-/
noncomputable def n {x : ℕ → ℝ} {a b : ℝ} (h : a ≤ b)
  (hx : set.infinite {i | x i ∈ set.Icc a b}) : ℕ → ℕ
| 0 := nat.find $ exists_ge_mem_Icc h hx 0 0
| (k + 1) := let p := n k in nat.find $ exists_ge_mem_Icc h hx p (k+1)

/-
Finally, we show that `n` satisfies the properties outlined above.
-/
lemma n_spec {x : ℕ → ℝ} {a b : ℝ} (h : a ≤ b)
  (hx : set.infinite {i | x i ∈ set.Icc a b}) (k : ℕ) :
  x (n h hx k) ∈ set.Icc (seq_a x a b k) (seq_b x a b k) :=
begin
  cases k,
  { cases nat.find_spec (exists_ge_mem_Icc h hx 0 0) with h1 h2,
    exact h2 },
  { let p := n h hx k,
    cases nat.find_spec (exists_ge_mem_Icc h hx p (k+1)) with h1 h2,
    dsimp [seq_a, seq_b, step_n, n] at *, -- ok, this `dsimp` is necessary?
    exact h2 }
end

end bolzano_weierstrass

/-
Now that we have this, Bolzano-Weierstrass is fairly straightforward. As each of the
`x_nᵢ ∈ [aᵢ, bᵢ]`, aᵢ ≤ x_nᵢ ≤ bᵢ, and that we've shown that aᵢ and bᵢ converge to the same limit,
so x_nᵢ must converge to the same limit as well.
-/
theorem bolzano_weierstrass {x : ℕ → ℝ} (K : ℝ) (hx : ∀ i, |x i| ≤ K) :
  ∃ (n : ℕ → ℕ), (∀ i, n i < n (i + 1)) ∧ is_convergent (x ∘ n) :=
begin
  set a := -K with ha,
  set b := K with ha,
  have hKnonneg : 0 ≤ K,
  { linarith [abs_nonneg (x 0), hx 0] },
  have hab : a ≤ b := by linarith,
  have hx' : set.infinite {i | x i ∈ set.Icc a b},
  { convert set.infinite_univ,
    { ext n,
      rw [iff_true, set.mem_Icc],
      specialize hx n,
      rw abs_le at hx,
      split; linarith },
    { exact nat.infinite } },
  use bolzano_weierstrass.n hab hx',
  split,
  { intro i,
    unfold bolzano_weierstrass.n,
    let p := bolzano_weierstrass.n hab hx' i,
    dsimp only,
    cases nat.find_spec (bolzano_weierstrass.exists_ge_mem_Icc hab hx' p (i+1)) with h1 h2,
    exact h1 },
  { cases bolzano_weierstrass.is_convergent_seq_a x a b hab with t ht,
    cases bolzano_weierstrass.is_convergent_seq_b x a b hab with r hr,
    have := bolzano_weierstrass.seq_a_seq_b_limit_same hab t r ht hr,
    rw this at *,
    use r,
    apply tendsto_of_le_of_le ht hr,
    { intro n,
      exact (bolzano_weierstrass.n_spec hab hx' n).1 },
    { intro n,
      exact (bolzano_weierstrass.n_spec hab hx' n).2 } }
end .

/-
Definition of a Cauchy Sequence
-/
lemma cauchy_seq_iff (x : ℕ → ℝ) :
  cauchy_seq x ↔ ∀ ε > 0, ∃ N, ∀ n m, N ≤ n → N ≤ m → |x n - x m| < ε :=
metric.cauchy_seq_iff

/-
Lemma 1.4

Every convergent sequence is Cauchy
-/
lemma cauchy_seq_of_is_convergent {x : ℕ → ℝ} (hx : is_convergent x) : cauchy_seq x :=
begin
  rw cauchy_seq_iff,
  intros ε hε,
  cases hx with a ha,
  rw tendsto_seq_iff at ha,
  cases ha (ε/2) (half_pos hε) with N hN,
  use N,
  intros n m hn hm,
  have h1 := hN n hn,
  have h2 := hN m hm,
  calc |x n - x m| = |(x n - a) + (a - x m)| : by ring
               ... ≤ |x n - a| + |a - x m| : abs_add _ _
               ... = |x n - a| + |x m - a| : by rw abs_sub a
               ... < ε : by linarith
end

/-
Theorem 1.5

Every Cauchy sequence is convergent
-/

/-
First, we shall show that every Cauchy sequence is bounded.
-/
lemma bdd_of_is_cauchy {x : ℕ → ℝ} (hx : cauchy_seq x) : ∃ k, ∀ n, |x n| ≤ k :=
begin
  rw cauchy_seq_iff at hx,
  cases hx 1 zero_lt_one with N₁ hN₁,
  have h₁ : ∀ m ≥ N₁, |x m| < |x N₁| + 1,
  { intros m hm,
    specialize hN₁ m N₁ hm (le_refl _),
    calc |x m| ≤ |x m - x N₁| + |x N₁| : _
           ... < |x N₁| + 1 : _,
    { convert abs_add _ _, ring },
    { linarith } },
  set S := (finset.range (N₁ + 1)).image (abs ∘ x) with hSdef,
  have hS : S.nonempty,
  { refine finset.nonempty.image _ (abs ∘ x),
    use 0,
    simp only [nat.succ_pos', finset.mem_range] },
  set k := max (|x N₁| + 1) (S.max' hS) with hk,
  use k,
  intro n,
    cases lt_or_le n N₁,
    { have : |x n| ≤ S.max' hS,
      { apply finset.le_max',
        rw [hSdef, finset.mem_image],
        use n,
        split,
        { rw [finset.mem_range], linarith },
        { refl } },
      refine le_trans this (le_max_right (|x N₁| + 1) (finset.max' S hS)) },
    { have : |x n| ≤ |x N₁| + 1,
      { apply le_of_lt,
        apply h₁,
        exact h },
      refine le_trans this (le_max_left (|x N₁| + 1) (finset.max' S hS)) }
end .

theorem is_convergent_of_is_cauchy {x : ℕ → ℝ} (hx : cauchy_seq x) : is_convergent x :=
begin
  cases bdd_of_is_cauchy hx with k hk,
  rcases bolzano_weierstrass k hk with ⟨n, h₁, ⟨a, h₂⟩⟩,
  use a,
  rw tendsto_seq_iff at ⊢ h₂,
  intros ε hε,
  rw cauchy_seq_iff at hx,
  cases hx (ε/2) (half_pos hε) with N₁ hN₁,
  cases h₂ (ε/2) (half_pos hε) with j₀ hj₀,
  use max N₁ j₀,
  intros j hj,
  calc |x j - a| ≤ |x j - x (n j)| + |x (n j) - a| : _
             ... < ε : _,
  { convert abs_add _ _,
    ring },
  { have hnj : j ≤ n j,
    { apply le_of_nat_strict_mono h₁ },
    specialize hN₁ j (n j) (le_of_max_le_left hj) (le_trans (le_of_max_le_left hj) hnj),
    specialize hj₀ j (le_of_max_le_right hj),
    simp only [function.comp_app] at hj₀,
    linarith }
end .

/-
Series

We say the sum is convergent if it the partial sums converge.
-/
def sum_convergent (x : ℕ → ℝ) := is_convergent (λ N, ∑ i in finset.range N, x i)

/-
Lemma 1.6 (i)
   ∞        ∞                                 ∞
If ∑ aₙ and ∑ bₙ both converges, then so does ∑ (αaₙ + βbₙ).
   n=1       n=1                                n=1
-/
lemma sum_convergent_add {a b : ℕ → ℝ} (ha : sum_convergent a) (hb : sum_convergent b) (α β : ℝ):
  sum_convergent (λ n, α * a n + β * b n) :=
begin
  cases ha with x hx,
  cases hb with y hy,
  use α * x + β * y,
  simp_rw [finset.sum_add_distrib, ←finset.mul_sum],
  apply tendsto.add,
  { apply tendsto.const_mul,
    exact hx },
  { apply tendsto.const_mul,
    exact hy },
end

/-
Lemma 1.6 (ii)
                                                   ∞                             ∞
If there exists N such that ∀ n ≥ N, aₙ = bₙ, then ∑ aₙ converges if and only if ∑ bₙ converges.
                                                   n=1                            n=1

The argument here is clearly symmetric, so we shall prove the implication first, and the iff
follows.
-/
lemma foo {a b : ℕ → ℝ} (h : ∃ N, ∀ n ≥ N, a n = b n)  (ha : sum_convergent a) : sum_convergent b :=
begin
  cases h with N hN,
  cases ha with x hx,
  use x - (∑ i in finset.range N, a i) + (∑ i in finset.range N, b i),
  -- have : (λ n, ∑ i in finset.range n, b i) =
  -- λ n, (∑ i in finset.range n, a i) - (∑ i in finset.range N, a i) + (∑ i in finset.range N, b i),
  -- { ext n,
  --   simp only, },
  -- rw this,
  sorry,
end