import data.set
import tactic
import linear_algebra

namespace helpers

variables {T : Type*} {S : set T}

lemma smaller {A B: set T} {x : T} (le : A ≤ B) (hx : x ∉ A): A ≤ B \ {x} :=
begin
  intros a ha,
  simp,
  split,
  exact le ha,
  intro contra,
  finish,
end

lemma missing_elem (A : set T) {x : T} (hx : x ∈ A): ¬ (A = A \ {x}) :=
begin
  intro,
  have : ∀ t : T, t ∈ A ↔ t ∈ A - {x}, by
  { change ∀ _, _ ↔ _ ∈ A \ {x},
    rw ←a,
    tauto, },
  replace this := (this x).mp hx,
  finish,
end

end helpers

namespace set

variables {S : Type*} {T : Type*} (f : S → T)

lemma image_preimage_eq_range_inter {A : set T} : f '' (f ⁻¹' A) = range f ∩ A := by tidy

@[simp]
lemma Sup_singleton_eq (S : set T) : Sup ((singleton : T → set T) '' S) = S :=
  set.ext $ λ x, ⟨λ ⟨_, ⟨_,h,rfl⟩, rfl⟩, h, λ h, ⟨{x}, ⟨x, h, rfl⟩,rfl⟩⟩

/-
begin
  ext, split; intro hx,
  { tidy },
  { use {x}, finish }
end
-/

lemma Sup_preimage {X : Type*} (S : set (set T)) (f : X → T) : f ⁻¹' (Sup S) = Sup ((λ A, f ⁻¹' A) '' S) :=
  set.ext $ λ x, ⟨λ ⟨U,hU,hxU⟩, ⟨f ⁻¹' U, ⟨U,hU,rfl⟩, hxU⟩, λ ⟨U,⟨V,hUV,rfl⟩,hxU⟩, ⟨V,hUV,hxU⟩⟩

/-
begin
  ext, split; intro hx,
  { rcases hx with ⟨U,hU,hxU⟩,
    refine ⟨f ⁻¹' U,_,hxU⟩,
    refine ⟨U,hU,rfl⟩,
-- this will have some problems, but whatever.
     },
  { rcases hx with ⟨U, ⟨V,hUV,rfl⟩, hxU⟩,
    change f x ∈ _,
    exact ⟨V,hUV, hxU⟩, }
end
-/

end set

namespace submodule
variables {k : Type*} [field k]
variables {V : Type*} [add_comm_group V] [module k V]

theorem span_singleton_eq_iff_smul_nonzero {v : V} {a : k} : a ≠ 0 → submodule.span k ({a • v} : set V) = submodule.span k {v} :=
begin
  intro ha,
  ext, split; intro hx; rw submodule.mem_span_singleton at *;
  rcases hx with ⟨b,rfl⟩,
  {  use b * a,
    rw mul_smul, },
  { use b * a⁻¹,
    rw [←mul_smul, mul_assoc, inv_mul_cancel ha, mul_one], }
end

theorem span_singleton_eq_iff {v w : V} {hv : v ≠ 0} {hw : w ≠ 0} : submodule.span k ({v} : set V) = submodule.span k {w} ↔ ∃ a : k, a • v = w :=
begin
split; intro h,
  { have : w ∈ submodule.span k ({v} : set V),
    { rw h,
      apply submodule.subset_span,
      tauto, },
    rw submodule.mem_span_singleton at this,
    assumption, },
  { rcases h with ⟨a,rfl⟩,
    have ha : a ≠ 0,
    { intro contra, rw [contra, zero_smul] at *, contradiction },
    rw span_singleton_eq_iff_smul_nonzero ha, }
end

end submodule


def kbo_alpha_morph (l:ℕ) : fin l.succ → list (fin l.succ) :=
λ i, ite (i.1=l) [0] [0,i+1]

def kbo_morph (l:ℕ): list (fin l.succ) → list (fin l.succ) :=
λ x, list.rec_on x list.nil (
  λ hd, λ tl, λ outputsofar,
  (kbo_alpha_morph l hd) ++ outputsofar
)

theorem is_morph (l:ℕ) (x: list (fin l.succ)) : ∀ y : list (fin l.succ),
kbo_morph l (x ++ y) = kbo_morph l x ++ kbo_morph l y :=
list.rec_on x (λ y, rfl) (
  λ hd tl h_ind, λ y,
  show kbo_morph l (hd :: tl ++ y) = kbo_morph l (hd :: tl) ++ kbo_morph l y, from
  calc _ = (kbo_alpha_morph l hd) ++ kbo_morph l (tl ++ y)            : rfl
     ... = (kbo_alpha_morph l hd) ++ (kbo_morph l tl ++ kbo_morph l y): by rw (h_ind y)
     ... = ((kbo_alpha_morph l hd) ++ kbo_morph l tl) ++ kbo_morph l y: (list.append_assoc _ _ _).symm
     ... = _: rfl
)


variables (a b c d e : ℕ)
variable h1 : a = b
variable h2 : b = c + 1
variable h3 : c = d
variable h4 : e = 1 + d

theorem T : a = e :=
  calc
    a     = b     : h1
      ... = c + 1 : h2
      ... = d + 1 : congr_arg _ h3
      ... = 1 + d : add_comm _ _
      ... = e     : h4.symm


import linear_algebra.span

/-! Note: some results should go to `linear_algebra.span`. -/
open submodule function

section
variables {R : Type*} {R₂ : Type*} {M : Type*} {M₂ : Type*} [semiring R] [semiring R₂]
  [add_comm_monoid M] [add_comm_monoid M₂] {σ₁₂ : R →+* R₂} [module R M]
  [module R₂ M₂]

lemma submodule.sup_eq_span_union (s t : submodule R M) : s ⊔ t = span R (s ∪ t) :=
by rw [span_union, span_eq s, span_eq t]

lemma submodule.sup_eq_top_iff (s t : submodule R M) :
  s ⊔ t = ⊤ ↔ ∀ m : M, ∃ (u ∈ s) (v ∈ t), m = u + v :=
begin
  rw eq_top_iff',
  apply forall_congr (λ m, _),
  rw mem_sup,
  tauto
end

lemma linear_map.eq_on_sup  {s t : submodule R M} {f g : M →ₛₗ[σ₁₂] M₂} (hs : ∀ x ∈ s, f x = g x)
  (ht : ∀ x ∈ t, f x = g x) {x : M} (hx : x ∈ s ⊔ t) : f x = g x :=
linear_map.eq_on_span (show ∀ x ∈ (s : set M) ∪ t, f x = g x, by { rintros x (h|h) ; tauto })
  ((s.sup_eq_span_union t) ▸ hx)

end
section

variables {R : Type*} {R₂ : Type*} {M : Type*} {M₂ : Type*} [ring R] [ring R₂]
  [add_comm_group M] [add_comm_group M₂] {σ₁₂ : R →+* R₂} [module R M]
  [module R₂ M₂] {p q : submodule R M} [ring_hom_surjective σ₁₂]

lemma submodule.map_inf_le (f : M →ₛₗ[σ₁₂] M₂) (p q : submodule R M) :
  map f (p ⊓ q) ≤ map f p ⊓ map f q :=
set.image_inter_subset _ _ _

lemma submodule.map_inf {f : M →ₛₗ[σ₁₂] M₂} (h : injective f) (p q : submodule R M) :
  map f (p ⊓ q) = map f p ⊓ map f q :=
set_like.coe_injective (set.image_inter h)

lemma linear_map.injective_iff_of_direct_sum (f : M →ₛₗ[σ₁₂] M₂) (hpq : p ⊓ q = ⊥) (hpq' : p ⊔ q = ⊤) :
  injective f ↔ (disjoint p f.ker ∧ disjoint q f.ker ∧ disjoint (map f p) (map f q)) :=
begin
  split,
  { intro h,
    simp [disjoint_iff_inf_le, linear_map.ker_eq_bot.mpr h, ← submodule.map_inf h, hpq] },
  { rintros ⟨hp, hq, h⟩,
    rw linear_map.disjoint_ker at *,
    rw [← linear_map.ker_eq_bot, ← @inf_top_eq _ _ _ f.ker, ← hpq'],
    rw ← le_bot_iff,
    rintros x ⟨hx, hx' : x ∈ p ⊔ q⟩,
    rcases mem_sup.mp hx' with ⟨u, hu, v, hv, rfl⟩,
    rw mem_bot,
    erw [← sub_neg_eq_add, linear_map.sub_mem_ker_iff] at hx,
    have hu' : f u ∈ map f p,
    exact mem_map_of_mem hu,
    have hv' : f (-v) ∈ map f q,
    exact mem_map_of_mem (q.neg_mem hv),
    rw ← hx at hv',
    have H : f u ∈ map f p ⊓ map f q,
    apply mem_inf.mpr ⟨hu', hv'⟩,
    rw [disjoint_iff_inf_le] at h,
    rw [hp u hu (h H), zero_add],
    rw [hp u hu (h H), f.map_zero, f.map_neg, eq_comm, neg_eq_zero] at hx,
    exact hq v hv hx }
end

end

lemma linear_map.ker_inf_eq_bot {R : Type*} {R₂ : Type*} {M : Type*} {M₂ : Type*} [ring R] [ring R₂]
  [add_comm_group M] [add_comm_group M₂] [module R M] [module R₂ M₂]
  {τ₁₂ : R →+* R₂} {f : M →ₛₗ[τ₁₂] M₂} {S : submodule R M} :
  linear_map.ker f ⊓ S = ⊥ ↔ set.inj_on f S :=
begin
  rw [set.inj_on_iff_injective, inf_comm, ← disjoint_iff, linear_map.disjoint_ker'],
  split,
  { intros h x y hxy,
    exact subtype.coe_injective (h x x.prop y y.prop hxy) },
  { intros h x hx y hy hxy,
    have : (S : set M).restrict f ⟨x, hx⟩ = (S : set M).restrict f ⟨y, hy⟩, from hxy,
    cases h this,
    refl }
end


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import topology.algebra.order.basic
import algebra.order.archimedean

/-!
# Rational numbers are dense in a linear ordered archimedean field

In this file we prove that coercion from `ℚ` to a linear ordered archimedean field has dense range.
This lemma is in a separate file because `topology.algebra.order.basic` does not import
`algebra.order.archimedean`.
-/

variables {𝕜 : Type*} [linear_ordered_field 𝕜] [topological_space 𝕜] [order_topology 𝕜]
  [archimedean 𝕜]

/-- Rational numbers are dense in a linear ordered archimedean field. -/
lemma rat.dense_range_cast : dense_range (coe : ℚ → 𝕜) :=
dense_of_exists_between $ λ a b h, set.exists_range_iff.2 $ exists_rat_btwn h


/-Some geometry exercises I did during high school
  I will be gradually adding more of them here -/

import congruence.Elements

open incidence_geometry incidence_order_geometry hilbert_plane

variables [C : hilbert_plane]

include C

example {a b c d e f : pts} (habc : noncol a b c) (hd : midpt d (b-ₛc)) (haed : between a e d)
(hbef : between b e f) (hafc : between a f c) (hbeac : (b-ₛe) ≅ₛ (a-ₛc)) : (a-ₛf) ≅ₛ (e-ₛf) :=
begin
  rw midpt_two_pt at hd,
  have hbd := (between_neq hd.1).1,
  have hcd := (between_neq hd.1).2.2.symm,
  have hbda := col_noncol (col23 (between_col hd.1)) (noncol123 habc) hbd,
  have hcda := col_noncol (col132 (between_col hd.1)) (noncol13 habc) hcd,
  have hda := (noncol_neq hcda).2.2,
  rcases extend_congr_seg' (seg_proper_iff_neq.2 hda) hda with ⟨g, hadg, hdadg, -⟩,
  rw ←between_diff_side_pt at hadg,
  have hdg := (between_neq hadg).2.2,
  rw [seg_symm, seg_symm e f],
  have haf := (between_neq hafc).1,
  have hae := (between_neq haed).1,
  have haec := col_noncol (col23 (between_col haed)) (noncol13 hcda) hae,
  have hafe := col_noncol (col23 (between_col hafc)) (noncol23 haec) haf,
  have hdgb := col_noncol (col12 (between_col hadg)) (noncol123 hbda) hdg,
  apply isosceles' (noncol12 hafe),
  have : ((Δ d a c) ≅ₜ (Δ d g b)),
    apply SAS; unfold three_pt_triang; simp,
    exact noncol123 hcda, exact hdgb,
    exact hdadg,
    rw [seg_symm, seg_symm d b], exact seg_congr_symm hd.2,
    { apply vertical_ang_congr (noncol13 hcda) hadg,
      rw between_symm, exact hd.1 },
  rw [ang_symm, ang_eq_same_side_pt e (between_same_side_pt.1 hafc).1, ang_symm,
      ang_eq_same_side_pt c (between_same_side_pt.1 haed).1, ang_symm],
  apply ang_congr_trans (tri_congr_ang this).1,
  rw between_symm at haed hadg,
  have hgde := (between_trans' hadg haed).1,
  have hge := (between_neq hgde).2.1,
  have hgeb := col_noncol (between_col hgde) (noncol12 hdgb) hge,
  rw [ang_symm, ang_eq_same_side_pt b (between_same_side_pt.1 hgde).1],
  apply ang_congr_trans,
  { apply isosceles (noncol132 hgeb),
    rw seg_symm,
    exact seg_congr_trans (seg_congr_symm (tri_congr_seg this).2.2) (seg_congr_symm hbeac) },
  exact vertical_ang_congr (noncol13 hgeb) hbef (between_trans' hadg haed).2
end

example {a b c p d e f q : pts} (habc : noncol a b c) (hdef : noncol d e f) (hbpc : col b p c)
(heqf : col e q f) (hapb : is_right_ang (∠ a p b)) (hdqe : is_right_ang (∠ d q e))
(habde : (a-ₛb) ≅ₛ (d-ₛe)) (hacdf : (a-ₛc) ≅ₛ (d-ₛf)) (hapdq : (a-ₛp) ≅ₛ (d-ₛq)) :
((∠ a b c) ≅ₐ (∠ d e f)) ∨ ∃ α : ang, ((α ≅ₐ (∠ a b c)) ∧ supplementary α (∠ d e f)) :=
begin
  sorry
end


--import data.list.basic algebra.big_operators data.fintype
import data.finsupp Kenny_comm_alg.Zariski

local infix ` ^ ` := monoid.pow

local attribute [instance] classical.prop_decidable

theorem exists_of_not_forall_not {α : Type*} (P : α → Prop) : (¬ (∀ a : α, ¬ P a)) → (∃ a : α, P a) :=
not_forall_not.1

section generate
universes u

open finsupp

variables {α : Type u} [comm_ring α] (S : set α)

-- generate S = { x | ∀ (T : set α) [is_submodule T], S ⊆ T → x ∈ T }

def generate' : set α :=
{ x | ∃ f : S →₀ α, x = f.sum (λ s a, a*s) }

#print notation →₀ -- it means finsupp
#print finsupp
#check map_domain_comp
#check finset.sum_mul
#print notation •
#print finsupp.sum

instance generate'.is_ideal : is_submodule (generate' S) :=
{ zero_ := ⟨0,eq.symm finsupp.sum_zero_index⟩,
  add_  := λ b c ⟨f,Hf⟩ ⟨g,Hg⟩, ⟨f+g,eq.symm (begin rw Hf,rw Hg,apply sum_add_index;simp [add_mul],end)⟩,
  smul  := λ c b ⟨f,Hf⟩,⟨⟨λ s, c * (f s),@set.finite_subset _ _ f.property _
    (λ x (H1 : ¬ (c * f.val x = 0)) H2,H1 (by rw H2;simp))
  ⟩,begin
  rw Hf,
  unfold has_scalar.smul,
  rw mul_comm c _,
  conv begin
  to_lhs,
  show finset.sum (support f) (λ (s : ↥S) (a : α), a * ↑s) * c,
  end,
--  show finset.sum (support f) (λ (s : ↥S) (a : α), a * ↑s) * c =
--    sum ⟨λ (s : ↥S), c * ⇑f s, _⟩ (λ (s : ↥S) (a : α), a * ↑s),
  --exact @finset.sum_mul _ _ _ _ _ _ _,
  end⟩
}
  --λ x y hy T ht hst, @@is_submodule.smul _ _ ht _ (@hy T ht hst) }

theorem generate_eq_generate' : generate S = generate' S :=
begin
apply set.eq_of_subset_of_subset,
{ intros x Hx,
  apply exists_of_not_forall_not,
  intro H1,
  revert Hx,

}
end

/-
namespace hidden
open hidden

inductive two
| zero : two
| one : two

#print two

instance two_has_zero : has_zero hidden.two := ⟨hidden.two.zero⟩

theorem is_locally_zero_implies_is_zero {R : Type*} [comm_ring R] (r : R)

example (R : Type) [comm_ring R] (n : ℕ) (a : fin n → R) (e : fin n → ℕ)
(r : R) (H : ∀ i : fin n, (a i) ^ (e i) * r = 0) :
(sum (univ) a) ^ (sum (univ) e) * r = 0 := sorry

-/


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

import data.polynomial.algebra_map
import ring_theory.localization.basic

/-!  # Laurent polynomials

We introduce Laurent polynomials over a semiring `R`.  Mathematically, they are expressions of the
form
$$
\sum_{i \in \mathbb{Z}} a_i T ^ i
$$
where the sum extends over a finite subset of `ℤ`.  Thus, negative exponents are allowed.  The
coefficients come from the semiring `R` and the variable `T` commutes with everything.

Since we are going to convert back and forth between polynomials and Laurent polynomials, we
decided to maintain some distinction by using the symbol `T`, rather than `X`, as the variable for
Laurent polynomials

## Notation
The symbol `R[T;T⁻¹]` stands for `laurent_polynomial R`.  We also define

* `C : R →+* R[T;T⁻¹]` the inclusion of constant polynomials, analogous to the one for `R[X]`;
* `T : ℤ → R[T;T⁻¹]` the sequence of powers of the variable `T`.

## Implementation notes

We define Laurent polynomials as `add_monoid_algebra R ℤ`.
Thus, they are essentially `finsupp`s `ℤ →₀ R`.
This choice differs from the current irreducible design of `polynomial`, that instead shields away
the implementation via `finsupp`s.  It is closer to the original definition of polynomials.

As a consequence, `laurent_polynomial` plays well with polynomials, but there is a little roughness
in establishing the API, since the `finsupp` implementation of `R[X]` is well-shielded.

Unlike the case of polynomials, I felt that the exponent notation was not too easy to use, as only
natural exponents would be allowed.  Moreover, in the end, it seems likely that we should aim to
perform computations on exponents in `ℤ` anyway and separating this via the symbol `T` seems
convenient.

I made a *heavy* use of `simp` lemmas, aiming to bring Laurent polynomials to the form `C a * T n`.
Any comments or suggestions for improvements is greatly appreciated!

##  Future work
Lots is missing!
-- (Riccardo) add inclusion into Laurent series.
-- (Riccardo) giving a morphism (as `R`-alg, so in the commutative case)
  from `R[T,T⁻¹]` to `S` is the same as choosing a unit of `S`.
-- A "better" definition of `trunc` would be as an `R`-linear map.  This works:
--  ```
--  def trunc : R[T;T⁻¹] →[R] R[X] :=
--  begin
--    refine (_ : add_monoid_algebra R ℕ →[R] R[X]).comp _,
--    { exact ⟨(to_finsupp_iso R).symm, by simp⟩ },
--    { refine ⟨λ r, comap_domain _ r (set.inj_on_of_injective (λ a b ab, int.of_nat.inj ab) _), _⟩,
--      exact λ r f, comap_domain_smul _ _ _ }
--  end
--  ```
--  but it would make sense to bundle the maps better, for a smoother user experience.
--  I (DT) did not have the strength to embark on this (possibly short!) journey, after getting to
--  this stage of the Laurent process!
--  This would likely involve adding a `comap_domain` analogue of
--  `add_monoid_algebra.map_domain_alg_hom` and an `R`-linear version of
--  `polynomial.to_finsupp_iso`.
-- Add `degree, int_degree, int_trailing_degree, leading_coeff, trailing_coeff,...`.
-/

open_locale polynomial big_operators
open polynomial add_monoid_algebra finsupp
noncomputable theory

variables {R : Type*}

/--  The semiring of Laurent polynomials with coefficients in the semiring `R`.
We denote it by `R[T;T⁻¹]`.
The ring homomorphism `C : R →+* R[T;T⁻¹]` includes `R` as the constant polynomials. -/
abbreviation laurent_polynomial (R : Type*) [semiring R] := add_monoid_algebra R ℤ

local notation R`[T;T⁻¹]`:9000 := laurent_polynomial R

/--  The ring homomorphism, taking a polynomial with coefficients in `R` to a Laurent polynomial
with coefficients in `R`. -/
def polynomial.to_laurent [semiring R] : R[X] →+* R[T;T⁻¹] :=
(map_domain_ring_hom R int.of_nat_hom).comp (to_finsupp_iso R)

/-- This is not a simp lemma, as it is usually preferable to use the lemmas about `C` and `X`
instead. -/
lemma polynomial.to_laurent_apply [semiring R] (p : R[X]) :
  p.to_laurent = p.to_finsupp.map_domain coe := rfl

/--  The `R`-algebra map, taking a polynomial with coefficients in `R` to a Laurent polynomial
with coefficients in `R`. -/
def polynomial.to_laurent_alg [comm_semiring R] :
  R[X] →ₐ[R] R[T;T⁻¹] :=
begin
  refine alg_hom.comp _ (to_finsupp_iso_alg R).to_alg_hom,
  exact (map_domain_alg_hom R R int.of_nat_hom),
end

@[simp]
lemma polynomial.to_laurent_alg_apply [comm_semiring R] (f : R[X]) :
  f.to_laurent_alg = f.to_laurent := rfl

namespace laurent_polynomial

section semiring
variables [semiring R]

lemma single_zero_one_eq_one : (single 0 1 : R[T;T⁻¹]) = (1 : R[T;T⁻¹]) := rfl

/-!  ### The functions `C` and `T`. -/
/--  The ring homomorphism `C`, including `R` into the ring of Laurent polynomials over `R` as
the constant Laurent polynomials. -/
def C : R →+* R[T;T⁻¹] :=
single_zero_ring_hom

lemma algebra_map_apply {R A : Type*} [comm_semiring R] [semiring A] [algebra R A] (r : R) :
  algebra_map R (laurent_polynomial A) r = C (algebra_map R A r) :=
rfl

/--
When we have `[comm_semiring R]`, the function `C` is the same as `algebra_map R R[T;T⁻¹]`.
(But note that `C` is defined when `R` is not necessarily commutative, in which case
`algebra_map` is not available.)
-/
lemma C_eq_algebra_map {R : Type*} [comm_semiring R] (r : R) :
  C r = algebra_map R R[T;T⁻¹] r :=
rfl

lemma single_eq_C (r : R) : single 0 r = C r := rfl

/--  The function `n ↦ T ^ n`, implemented as a sequence `ℤ → R[T;T⁻¹]`.

Using directly `T ^ n` does not work, since we want the exponents to be of Type `ℤ` and there
is no `ℤ`-power defined on `R[T;T⁻¹]`.  Using that `T` is a unit introduces extra coercions.
For these reasons, the definition of `T` is as a sequence. -/
def T (n : ℤ) : R[T;T⁻¹] := single n 1

@[simp]
lemma T_zero : (T 0 : R[T;T⁻¹]) = 1 := rfl

lemma T_add (m n : ℤ) : (T (m + n) : R[T;T⁻¹]) = T m * T n :=
by { convert single_mul_single.symm, simp [T] }

lemma T_sub (m n : ℤ) : (T (m - n) : R[T;T⁻¹]) = T m * T (-n) :=
by rw [← T_add, sub_eq_add_neg]

@[simp]
lemma T_pow (m : ℤ) (n : ℕ) : (T m ^ n : R[T;T⁻¹]) = T (n * m) :=
by rw [T, T, single_pow n, one_pow, nsmul_eq_mul]

/-- The `simp` version of `mul_assoc`, in the presence of `T`'s. -/
@[simp]
lemma mul_T_assoc (f : R[T;T⁻¹]) (m n : ℤ) : f * T m * T n = f * T (m + n) :=
by simp [← T_add, mul_assoc]

@[simp]
lemma single_eq_C_mul_T (r : R) (n : ℤ) :
  (single n r : R[T;T⁻¹]) = (C r * T n : R[T;T⁻¹]) :=
by convert single_mul_single.symm; simp

-- This lemma locks in the right changes and is what Lean proved directly.
-- The actual `simp`-normal form of a Laurent monomial is `C a * T n`, whenever it can be reached.
@[simp]
lemma _root_.polynomial.to_laurent_C_mul_T (n : ℕ) (r : R) :
  ((polynomial.monomial n r).to_laurent : R[T;T⁻¹]) = C r * T n :=
show map_domain coe (monomial n r).to_finsupp = (C r * T n : R[T;T⁻¹]),
by rw [to_finsupp_monomial, map_domain_single, single_eq_C_mul_T]

@[simp]
lemma _root_.polynomial.to_laurent_C (r : R) : (polynomial.C r).to_laurent = C r :=
begin
  convert polynomial.to_laurent_C_mul_T 0 r,
  simp only [int.coe_nat_zero, T_zero, mul_one],
end

@[simp]
lemma _root_.polynomial.to_laurent_X : (polynomial.X.to_laurent : R[T;T⁻¹]) = T 1 :=
begin
  have : (polynomial.X : R[X]) = monomial 1 1,
  { simp [← C_mul_X_pow_eq_monomial] },
  simp [this, polynomial.to_laurent_C_mul_T],
end

@[simp] lemma _root_.polynomial.to_laurent_one : (polynomial.to_laurent : R[X] → R[T;T⁻¹]) 1 = 1 :=
map_one polynomial.to_laurent

@[simp]
lemma _root_.polynomial.to_laurent_C_mul_eq (r : R) (f : R[X]) :
  (polynomial.C r * f).to_laurent = C r * f.to_laurent :=
by simp only [_root_.map_mul, polynomial.to_laurent_C]

@[simp]
lemma _root_.polynomial.to_laurent_X_pow (n : ℕ) : (X ^ n : R[X]).to_laurent = T n :=
by simp only [map_pow, polynomial.to_laurent_X, T_pow, mul_one]

@[simp]
lemma _root_.polynomial.to_laurent_C_mul_X_pow (n : ℕ) (r : R) :
  (polynomial.C r * X ^ n).to_laurent = C r * T n :=
by simp only [_root_.map_mul, polynomial.to_laurent_C, polynomial.to_laurent_X_pow]

instance invertible_T (n : ℤ) : invertible (T n : R[T;T⁻¹]) :=
{ inv_of := T (- n),
  inv_of_mul_self := by rw [← T_add, add_left_neg, T_zero],
  mul_inv_of_self := by rw [← T_add, add_right_neg, T_zero] }

@[simp]
lemma inv_of_T (n : ℤ) : ⅟ (T n : R[T;T⁻¹]) = T (- n) := rfl

lemma is_unit_T (n : ℤ) : is_unit (T n : R[T;T⁻¹]) :=
is_unit_of_invertible _

@[elab_as_eliminator] protected lemma induction_on {M : R[T;T⁻¹] → Prop} (p : R[T;T⁻¹])
  (h_C         : ∀ a, M (C a))
  (h_add       : ∀ {p q}, M p → M q → M (p + q))
  (h_C_mul_T   : ∀ (n : ℕ) (a : R), M (C a * T n) → M (C a * T (n + 1)))
  (h_C_mul_T_Z : ∀ (n : ℕ) (a : R), M (C a * T (- n)) → M (C a * T (- n - 1))) :
  M p :=
begin
  have A : ∀ {n : ℤ} {a : R}, M (C a * T n),
  { assume n a,
    apply n.induction_on,
    { simpa only [T_zero, mul_one] using h_C a },
    { exact λ m, h_C_mul_T m a },
    { exact λ m, h_C_mul_T_Z m a } },
  have B : ∀ (s : finset ℤ), M (s.sum (λ (n : ℤ), C (p.to_fun n) * T n)),
  { apply finset.induction,
    { convert h_C 0, simp only [finset.sum_empty, _root_.map_zero] },
    { assume n s ns ih, rw finset.sum_insert ns, exact h_add A ih } },
  convert B p.support,
  ext a,
  simp_rw [← single_eq_C_mul_T, finset.sum_apply', single_apply, finset.sum_ite_eq'],
  split_ifs with h h,
  { refl },
  { exact finsupp.not_mem_support_iff.mp h }
end

/--  To prove something about Laurent polynomials, it suffices to show that
* the condition is closed under taking sums, and
* it holds for monomials.
-/
@[elab_as_eliminator] protected lemma induction_on' {M : R[T;T⁻¹] → Prop} (p : R[T;T⁻¹])
  (h_add     : ∀p q, M p → M q → M (p + q))
  (h_C_mul_T : ∀(n : ℤ) (a : R), M (C a * T n)) :
  M p :=
begin
  refine p.induction_on (λ a, _) h_add _ _;
  try { exact λ n f _, h_C_mul_T _ f },
  convert h_C_mul_T 0 a,
  exact (mul_one _).symm,
end

lemma commute_T (n : ℤ) (f : R[T;T⁻¹]) : commute (T n) f :=
f.induction_on' (λ p q Tp Tq, commute.add_right Tp Tq) $ λ m a,
show T n * _ = _, by
{ rw [T, T, ← single_eq_C, single_mul_single, single_mul_single, single_mul_single],
  simp [add_comm] }

@[simp]
lemma T_mul (n : ℤ) (f : R[T;T⁻¹]) : T n * f = f * T n :=
(commute_T n f).eq

/--  `trunc : R[T;T⁻¹] →+ R[X]` maps a Laurent polynomial `f` to the polynomial whose terms of
nonnegative degree coincide with the ones of `f`.  The terms of negative degree of `f` "vanish".
`trunc` is a left-inverse to `polynomial.to_laurent`. -/
def trunc : R[T;T⁻¹] →+ R[X] :=
((to_finsupp_iso R).symm.to_add_monoid_hom).comp $
  comap_domain.add_monoid_hom $ λ a b, int.of_nat.inj

@[simp]
lemma trunc_C_mul_T (n : ℤ) (r : R) : trunc (C r * T n) = ite (0 ≤ n) (monomial n.to_nat r) 0 :=
begin
  apply (to_finsupp_iso R).injective,
  rw [← single_eq_C_mul_T, trunc, add_monoid_hom.coe_comp, function.comp_app,
    comap_domain.add_monoid_hom_apply, to_finsupp_iso_apply],
  by_cases n0 : 0 ≤ n,
  { lift n to ℕ using n0,
    erw [comap_domain_single, to_finsupp_iso_symm_apply],
    simp only [int.coe_nat_nonneg, int.to_nat_coe_nat, if_true, to_finsupp_iso_apply,
      to_finsupp_monomial] },
  { lift (- n) to ℕ using (neg_pos.mpr (not_le.mp n0)).le with m,
    rw [to_finsupp_iso_apply, to_finsupp_inj, if_neg n0],
    erw to_finsupp_iso_symm_apply,
    ext a,
    have := ((not_le.mp n0).trans_le (int.coe_zero_le a)).ne',
    simp only [coeff, comap_domain_apply, int.of_nat_eq_coe, coeff_zero, single_apply_eq_zero, this,
      is_empty.forall_iff] }
end

@[simp] lemma left_inverse_trunc_to_laurent :
  function.left_inverse (trunc : R[T;T⁻¹] → R[X]) polynomial.to_laurent :=
begin
  refine λ f, f.induction_on' _ _,
  { exact λ f g hf hg, by simp only [hf, hg, _root_.map_add] },
  { exact λ n r, by simp only [polynomial.to_laurent_C_mul_T, trunc_C_mul_T, int.coe_nat_nonneg,
      int.to_nat_coe_nat, if_true] }
end

@[simp] lemma _root_.polynomial.trunc_to_laurent (f : R[X]) : trunc f.to_laurent = f :=
left_inverse_trunc_to_laurent _

lemma _root_.polynomial.to_laurent_injective :
  function.injective (polynomial.to_laurent : R[X] → R[T;T⁻¹]) :=
left_inverse_trunc_to_laurent.injective

@[simp] lemma _root_.polynomial.to_laurent_inj (f g : R[X]) :
  f.to_laurent = g.to_laurent ↔ f = g :=
⟨λ h, polynomial.to_laurent_injective h, congr_arg _⟩

lemma _root_.polynomial.to_laurent_ne_zero {f : R[X]} :
  f ≠ 0 ↔ f.to_laurent ≠ 0 :=
(map_ne_zero_iff _ (by exact polynomial.to_laurent_injective)).symm

lemma exists_T_pow (f : R[T;T⁻¹]) :
  ∃ (n : ℕ) (f' : R[X]), f'.to_laurent = f * T n :=
begin
  apply f.induction_on' _ (λ n a, _); clear f,
  { rintros f g ⟨m, fn, hf⟩ ⟨n, gn, hg⟩,
    refine ⟨m + n, fn * X ^ n + gn * X ^ m, _⟩,
    simp only [hf, hg, add_mul, add_comm (n : ℤ), map_add, map_mul, polynomial.to_laurent_X_pow,
      mul_T_assoc, int.coe_nat_add] },
  { cases n with n n,
    { exact ⟨0, polynomial.C a * X ^ n, by simp⟩ },
    { refine ⟨n + 1, polynomial.C a, _⟩,
      simp only [int.neg_succ_of_nat_eq, polynomial.to_laurent_C, int.coe_nat_succ, mul_T_assoc,
        add_left_neg, T_zero, mul_one] } }
end

/--  This is a version of `exists_T_pow` stated as an induction principle. -/
@[elab_as_eliminator] lemma induction_on_mul_T {Q : R[T;T⁻¹] → Prop} (f : R[T;T⁻¹])
  (Qf : ∀ {f : R[X]} {n : ℕ}, Q (f.to_laurent * T (- n))) :
  Q f :=
begin
  rcases f.exists_T_pow with ⟨n, f', hf⟩,
  rw [← mul_one f, ← T_zero, ← nat.cast_zero, ← nat.sub_self n, nat.cast_sub rfl.le, T_sub,
    ← mul_assoc, ← hf],
  exact Qf,
end

/--  Suppose that `Q` is a statement about Laurent polynomials such that
* `Q` is true on *ordinary* polynomials;
* `Q (f * T)` implies `Q f`;
it follow that `Q` is true on all Laurent polynomials. -/
lemma reduce_to_polynomial_of_mul_T (f : R[T;T⁻¹]) {Q : R[T;T⁻¹] → Prop}
  (Qf : ∀ (f : R[X]), Q f.to_laurent)
  (QT : ∀ f, Q (f * T 1) → Q f) :
  Q f :=
begin
  induction f using laurent_polynomial.induction_on_mul_T with f n,
  induction n with n hn,
  { simpa only [int.coe_nat_zero, neg_zero, T_zero, mul_one] using Qf _ },
  { convert QT _ _,
    simpa using hn }
end

section support

lemma support_C_mul_T (a : R) (n : ℤ) : (C a * T n).support ⊆ {n} :=
by simpa only [← single_eq_C_mul_T] using support_single_subset

lemma support_C_mul_T_of_ne_zero {a : R} (a0 : a ≠ 0) (n : ℤ) : (C a * T n).support = {n} :=
begin
  rw ← single_eq_C_mul_T,
  exact support_single_ne_zero _ a0,
end

/--  The support of a polynomial `f` is a finset in `ℕ`.  The lemma `to_laurent_support f`
shows that the support of `f.to_laurent` is the same finset, but viewed in `ℤ` under the natural
inclusion `ℕ ↪ ℤ`. -/
lemma to_laurent_support (f : R[X]) :
  f.to_laurent.support = f.support.map nat.cast_embedding :=
begin
  generalize' hd : f.support = s,
  revert f,
  refine finset.induction_on s _ _; clear s,
  { simp only [polynomial.support_eq_empty, map_zero, finsupp.support_zero, eq_self_iff_true,
      implies_true_iff, finset.map_empty] {contextual := tt} },
  { intros a s as hf f fs,
    have : (erase a f).to_laurent.support = s.map nat.cast_embedding := hf (f.erase a) (by simp only
      [fs, finset.erase_eq_of_not_mem as, polynomial.support_erase, finset.erase_insert_eq_erase]),
    rw [← monomial_add_erase f a, finset.map_insert, ← this, map_add,
      polynomial.to_laurent_C_mul_T, support_add_eq, finset.insert_eq],
    { congr,
      exact support_C_mul_T_of_ne_zero (polynomial.mem_support_iff.mp (by simp [fs])) _ },
    { rw this,
      exact disjoint.mono_left (support_C_mul_T _ _) (by simpa) } }
end

end support

section degrees

/--  The degree of a Laurent polynomial takes values in `with_bot ℤ`.
If `f : R[T;T⁻¹]` is a Laurent polynomial, then `f.degree` is the maximum of its support of `f`,
or `⊥`, if `f = 0`. -/
def degree (f : R[T;T⁻¹]) : with_bot ℤ := f.support.max

@[simp] lemma degree_zero : degree (0 : R[T;T⁻¹]) = ⊥ := rfl

@[simp]

section exact_degrees

open_locale classical

@[simp] lemma degree_C_mul_T (n : ℤ) (a : R) (a0 : a ≠ 0) : (C a * T n).degree = n :=
begin
  rw degree,
  convert finset.max_singleton,
  refine support_eq_singleton.mpr _,
  simp only [← single_eq_C_mul_T, single_eq_same, a0, ne.def, not_false_iff, eq_self_iff_true,
    and_self],
end

lemma degree_C_mul_T_ite (n : ℤ) (a : R) : (C a * T n).degree = ite (a = 0) ⊥ n :=
by split_ifs with h h;
  simp only [h, map_zero, zero_mul, degree_zero, degree_C_mul_T, ne.def, not_false_iff]

@[simp] lemma degree_T [nontrivial R] (n : ℤ) : (T n : R[T;T⁻¹]).degree = n :=
begin
  rw [← one_mul (T n), ← map_one C],
  exact degree_C_mul_T n 1 (one_ne_zero : (1 : R) ≠ 0),
end

lemma degree_C {a : R} (a0 : a ≠ 0) : (C a).degree = 0 :=
begin
  rw [← mul_one (C a), ← T_zero],
  exact degree_C_mul_T 0 a a0
end

lemma degree_C_ite (a : R) : (C a).degree = ite (a = 0) ⊥ 0 :=
by split_ifs with h h;
  simp only [h, map_zero, degree_zero, degree_C, ne.def, not_false_iff]

end exact_degrees

section degree_bounds

lemma degree_C_mul_T_le (n : ℤ) (a : R) : (C a * T n).degree ≤ n :=
begin
  by_cases a0 : a = 0,
  { simp only [a0, map_zero, zero_mul, degree_zero, bot_le] },
  { exact (degree_C_mul_T n a a0).le }
end

lemma degree_T_le (n : ℤ) : (T n : R[T;T⁻¹]).degree ≤ n :=
(le_of_eq (by rw [map_one, one_mul])).trans (degree_C_mul_T_le n (1 : R))

lemma degree_C_le (a : R) : (C a).degree ≤ 0 :=
(le_of_eq (by rw [T_zero, mul_one])).trans (degree_C_mul_T_le 0 a)

end degree_bounds

end degrees

instance : module R[X] R[T;T⁻¹] :=
module.comp_hom _ polynomial.to_laurent

instance (R : Type*) [semiring R] : is_scalar_tower R[X] R[X] R[T;T⁻¹] :=
{ smul_assoc := λ x y z, by simp only [has_smul.smul, has_smul.comp.smul, map_mul, mul_assoc] }

end semiring

section comm_semiring
variable [comm_semiring R]

instance algebra_polynomial (R : Type*) [comm_semiring R] : algebra R[X] R[T;T⁻¹] :=
{ commutes' := λ f l, by simp [mul_comm],
  smul_def' := λ f l, rfl,
  .. polynomial.to_laurent }

lemma algebra_map_X_pow (n : ℕ) : algebra_map R[X] R[T;T⁻¹] (X ^ n) = T n :=
polynomial.to_laurent_X_pow n

@[simp]
lemma algebra_map_eq_to_laurent (f : R[X]) : algebra_map R[X] R[T;T⁻¹] f = f.to_laurent :=
rfl

lemma is_localization : is_localization (submonoid.closure ({X} : set R[X])) R[T;T⁻¹] :=
{ map_units := λ t, begin
    cases t with t ht,
    rcases submonoid.mem_closure_singleton.mp ht with ⟨n, rfl⟩,
    simp only [is_unit_T n, set_like.coe_mk, algebra_map_eq_to_laurent, polynomial.to_laurent_X_pow]
  end,
  surj := λ f, begin
    induction f using laurent_polynomial.induction_on_mul_T with f n,
    have := (submonoid.closure ({X} : set R[X])).pow_mem submonoid.mem_closure_singleton_self n,
    refine ⟨(f, ⟨_, this⟩), _⟩,
    simp only [set_like.coe_mk, algebra_map_eq_to_laurent, polynomial.to_laurent_X_pow, mul_T_assoc,
      add_left_neg, T_zero, mul_one],
  end,
  eq_iff_exists := λ f g, begin
    rw [algebra_map_eq_to_laurent, algebra_map_eq_to_laurent, polynomial.to_laurent_inj],
    refine ⟨_, _⟩,
    { rintro rfl,
      exact ⟨1, rfl⟩ },
    { rintro ⟨⟨h, hX⟩, h⟩,
      rcases submonoid.mem_closure_singleton.mp hX with ⟨n, rfl⟩,
      exact mul_X_pow_injective n h }
  end }

end comm_semiring

end laurent_polynomial


/-
This is a file covering the material on Wednesday afternoon
at LFTCM2020. It's how to build some algebraic structures in Lean

This file has the excercise solutions replaced by `sorry`.
-/

import data.rat.basic -- we'll need the rationals at the end of this file

/-
As a mathematician I essentially always start my Lean files with the following line:
-/
import tactic

/- That gives me access to all Lean's tactics
(see https://leanprover-community.github.io/mathlib_docs/tactics.html)
-/

/-

## The point of this file

The idea of this file is to show how to build in Lean what the computer scientists call
"an algebraic heirarchy", and what mathematicians call "groups, rings, fields, modules etc".

Firstly, we will define groups, and develop a basic interface for groups.

Then we will define rings, fields, modules, vector spaces, and just demonstrate
that they are usable, rather than making a complete interface for all of them.

Let's start with the theory of groups. Unfortunately Lean has groups already,
so we will have to do everything in a namespace
-/

namespace lftcm

/-

... which means that now when we define `group`, it will actually be called `lftcm.group`.

## Notation typeclasses

To make a term of type `has_mul G`, you need to give a map G^2 → G (or
more precisely, a map `has_mul.mul : G → G → G`. Lean's notation `g * h`
is notation for `has_mul.mul g h`. Furthermore, `has_mul` is a class.

In short, this means that if you write `[has_mul G]` then `G` will
magically have a multiplication called `*` (satisfying no axioms).

Similarly `[has_one G]` gives you `has_one.one : G` with notation `1 : G`,
and `[has_inv G]` gives you `has_inv.inv : G → G` with notation `g⁻¹ : G`

## Definition of a group

If `G` is a type, equipped with `* : G^2 → G`, `1 : G` and `⁻¹ : G → G`
then it's a group if it satisfies the group axioms.

-/

-- `group G` is the type of group structures on a type `G`.
-- first we ask for the structure
class group (G : Type) extends has_mul G, has_one G, has_inv G :=
-- and then we ask for the axioms
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

/-

Advantages of this approach: axioms look lovely.

Disadvantage: what if I want the group law to be `+`?? I have embedded `has_mul`
in the definition.

Lean's solution: develop a `to_additive` metaprogram which translates all theorems about
`group`s (with group law `*`) to theorems about `add_group`s (with group law `+`). We will
not go into details here.

-/

namespace group

-- let G be a group

variables {G : Type} [group G]

/-
Lemmas about groups are proved in this namespace. We already have some!
All the group axioms are theorems in this namespace. Indeed we have just defined

`group.mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c)`
`group.one_mul : ∀ (a : G), 1 * a = a`
`group.mul_left_inv : ∀ (a : G), a⁻¹ * a = 1`

Because we are in the `group` namespace, we don't need to write `group.`
everywhere.

Let's put some more theorems into the `group` namespace.

We definitely need `mul_one` and `mul_right_inv`, and it's a fun exercise to
get them. Here is a route:

`mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c`
`mul_eq_of_eq_inv_mul {a x y : G} : x = a⁻¹ * y → a * x = y`
`mul_one (a : G) : a * 1 = a`
`mul_right_inv (a : G) : a * a⁻¹ = 1`
-/

lemma mul_left_cancel (a b c : G) (Habac : a * b = a * c) : b = c :=
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : by rw mul_left_inv
    ... = a⁻¹ * (a * b) : by sorry
    ... = a⁻¹ * (a * c) : by sorry
    ... = (a⁻¹ * a) * c : by sorry
    ... = 1 * c         : by sorry
    ... = c             : by sorry

lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  apply mul_left_cancel a⁻¹,
  -- ⊢ a⁻¹ * (a * x) = a⁻¹ * y
  sorry
end

-- The same proof
lemma mul_eq_of_eq_inv_mul' {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
mul_left_cancel a⁻¹ _ _ $ by rwa [←mul_assoc, mul_left_inv, one_mul]

/-

So now we can finally prove `mul_one` and `mul_right_inv`.

But before we start, let's learn a little bit about the simplifier.

## The `simp` tactic -- Lean's simplifier

We have the theorems (axioms) `one_mul g : 1 * g = g` and
`mul_left_inv g : g⁻¹ * g = 1`. Both of these theorems are of
the form `A = B`, with `A` more complicated than `B`. This means
that they are *perfect* theorems for the simplifier. Let's teach
those theorems to the simplifier, by adding the `@[simp]` attribute to them.
An "attribute" is just a tag which we attach to a theorem (or definition).
-/

attribute [simp] one_mul mul_left_inv

/-

Now let's prove `mul_one` using the simplifier. This also a perfect
`simp` lemma, so let's also add the `simp` tag to it.

-/

@[simp] theorem mul_one (a : G) : a * 1 = a :=
begin
  apply mul_eq_of_eq_inv_mul,
  -- ⊢ 1 = a⁻¹ * a
  simp,
end

/-
The simplifier solved `1 = a⁻¹ * a` because it knew `mul_left_inv`.
Feel free to comment out the `attribute [simp] one_mul mul_left_inv` line
above, and observe that the proof breaks.

-/

-- see if you can get the simplifier to do this one too
@[simp] theorem mul_right_inv (a : G) : a * a⁻¹ = 1 :=
begin
  sorry
end

-- Now here's a question. Can we train the simplifier to solve the following problem:

--example (a b c d : G) :
--  ((a * b)⁻¹ * a * 1⁻¹⁻¹⁻¹ * b⁻¹ * b * b * 1 * 1⁻¹)⁻¹ = (c⁻¹⁻¹ * d * d⁻¹ * 1⁻¹⁻¹ * c⁻¹⁻¹⁻¹)⁻¹⁻¹ :=
--by simp

-- Remove the --'s and see that it fails. Let's see if we can get it to work.

-- We start with two very natural `simp` lemmas.

@[simp] lemma one_inv : (1 : G)⁻¹ = 1 :=
begin
  sorry
end

@[simp] lemma inv_inv (a : G) : a⁻¹⁻¹ = a :=
begin
  sorry
end

-- Here is a riskier looking `[simp]` lemma.

attribute [simp] mul_assoc -- recall this says (a * b) * c = a * (b * c)

-- The simplifier will now push all brackets to the right, which means
-- that it's worth proving the following two lemmas and tagging
-- them `[simp]`, so that we can still cancel a with a⁻¹ in these situations.

@[simp] lemma inv_mul_cancel_left (a b : G) : a⁻¹ * (a * b) = b :=
begin
  sorry
end

@[simp] lemma mul_inv_cancel_left (a b : G) : a * (a⁻¹ * b) = b :=
begin
  sorry
end

-- Finally, let's make a `simp` lemma which enables us to
-- reduce all inverses to inverses of variables
@[simp] lemma mul_inv_rev (a b : G) : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  sorry
end

/-

If you solved them all -- congratulations!
You have just turned Lean's simplifier into a normalising confluent
rewriting system for groups, following Knuth-Bendix.

https://en.wikipedia.org/wiki/Confluence_(abstract_rewriting)#Motivating_examples

In other words, the simplifier will now put any element of a free group
into a canonical normal form, and can hence solve the word problem
for free groups.

-/
example (a b c d : G) :
  ((a * b)⁻¹ * a * 1⁻¹⁻¹⁻¹ * b⁻¹ * b * b * 1 * 1⁻¹)⁻¹ = (c⁻¹⁻¹ * d * d⁻¹ * 1⁻¹⁻¹ * c⁻¹⁻¹⁻¹)⁻¹⁻¹ :=
by simp

-- Abstract example of the power of classes: we can define products of groups with instances

instance (G : Type) [group G] (H : Type) [group H] : group (G × H) :=
{ mul := λ k l, (k.1*l.1, k.2*l.2),
  one := (1,1),
  inv := λ k, (k.1⁻¹, k.2⁻¹),
  mul_assoc := begin
    intros a b c,
    cases a, cases b, cases c,
    ext;
    simp,
  end,
  one_mul := begin
    sorry
  end,
  mul_left_inv := begin
    sorry
  end }

-- the type class inference system now knows that products of groups are groups
example (G H K : Type) [group G] [group H] [group K] : group (G × H × K) :=
by apply_instance

end group

-- let's make a group of order two.

-- First the elements {+1, -1}
inductive mu2
| p1 : mu2
| m1 : mu2

namespace mu2

-- Now let's do some CS stuff:

-- 1) prove it has decidable equality
attribute [derive decidable_eq] mu2

-- 2) prove it is finite
instance : fintype mu2 := ⟨⟨[mu2.p1, mu2.m1], by simp⟩, λ x, by cases x; simp⟩

-- now back to the maths.

-- Define multiplication by doing all cases
def mul : mu2 → mu2 → mu2
| p1 p1 := p1
| p1 m1 := m1
| m1 p1 := m1
| m1 m1 := p1

instance : has_mul mu2 := ⟨mul⟩

-- identity
def one : mu2 := p1

-- notation
instance : has_one mu2 := ⟨one⟩

-- inverse
def inv : mu2 → mu2 := id

-- notation
instance : has_inv mu2 := ⟨inv⟩

-- currently we have notation but no axioms

example : p1 * m1 * m1 = p1⁻¹ * p1 := rfl -- all true by definition

-- now let's make it a group
instance : group mu2 :=
begin
  -- first define the structure
  refine_struct { mul := mul, one := one, inv := inv },
  -- now we have three goals (the axioms)
  all_goals {exact dec_trivial}
end

end mu2

-- Now let's build rings and modules and stuff (via monoids and add_comm_groups)

-- a monoid is a group without inverses
class monoid (M : Type) extends has_mul M, has_one M :=
(mul_assoc : ∀ (a b c : M), a * b * c = a * (b * c))
(one_mul : ∀ (a : M), 1 * a = a)
(mul_one : ∀ (a : M), a * 1 = a)

-- additive commutative groups from first principles
class add_comm_group (A : Type) extends has_add A, has_zero A, has_neg A :=
(add_assoc : ∀ (a b c : A), a + b + c = a + (b + c))
(zero_add : ∀ (a : A), 0 + a = a)
(add_left_neg : ∀ (a : A), -a + a = 0)
(add_comm : ∀ a b : A, a + b = b + a)

-- Notation for subtraction is handy to have; define a - b to be a + (-b)
instance (A : Type) [add_comm_group A] : has_sub A := ⟨λ a b, a + -b⟩

-- rings are additive abelian groups and multiplicative monoids,
-- with distributivity
class ring (R : Type) extends monoid R, add_comm_group R :=
(mul_add : ∀ (a b c : R), a * (b + c) = a * b + a * c)
(add_mul : ∀ (a b c : R), (a + b) * c = a * c + b * c)

-- for commutative rings, add commutativity of multiplication
class comm_ring (R : Type) extends ring R :=
(mul_comm : ∀ a b : R, a * b = b * a)

/-- Typeclass for types with a scalar multiplication operation, denoted `•` (`\bu`) -/
class has_scalar (R : Type) (M : Type) := (smul : R → M → M)

infixr ` • `:73 := has_scalar.smul

-- modules for a ring
class module (R : Type) [ring R] (M : Type) [add_comm_group M]
extends has_scalar R M :=
(smul_add : ∀(r : R) (x y : M), r • (x + y) = r • x + r • y)
(add_smul : ∀(r s : R) (x : M), (r + s) • x = r • x + s • x)
(mul_smul : ∀ (r s : R) (x : M), (r * s) • x = r • s • x)
(one_smul : ∀ x : M, (1 : R) • x = x)

-- for fields we let ⁻¹ be defined on the entire field, and demand 0⁻¹ = 0
-- and that a⁻¹ * a = 1 for non-zero a. This is merely for convenience;
-- one can easily check that it's mathematically equivalent to the usual
-- definition of a field.
class field (K : Type) extends comm_ring K, has_inv K :=
(zero_ne_one : (0 : K) ≠ 1)
(mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * a⁻¹ = 1)
(inv_zero : (0 : K)⁻¹ = 0)

-- the type of vector spaces
def vector_space (K : Type) [field K] (V : Type) [add_comm_group V] := module K V

/-
Exercise for the reader: define manifolds, schemes, perfectoid spaces in Lean.
All have been done! As you can see, it is clearly *feasible*, although it does
sometimes take time to get it right. It is all very much work in progress.

The extraordinary thing is that although these computer theorem
provers have been around for about 50 years, there has never been a serious
effort to make the standard definitions used all over modern mathematics in
one of them, and this is why these systems are rarely used in mathematics departments.
Changing this is one of the goals of the Leanprover community.
-/

/-

Let's check that we can make the rational numbers into a field. Of course
they are already a field in Lean, but remember that when we say `field`
below, we mean our just-defined structure `lftcm.field`.

-/

-- the rationals are a field (easy because all the work is done in the import)
instance : field ℚ :=
{ mul := (*),
  one := 1,
  mul_assoc := rat.mul_assoc,
  one_mul := rat.one_mul,
  mul_one := rat.mul_one,
  add := (+),
  zero := 0,
  neg := has_neg.neg, -- no () trickery for unary operators
  add_assoc := rat.add_assoc,
  zero_add := rat.zero_add,
  add_left_neg := rat.add_left_neg,
  add_comm := rat.add_comm,
  mul_add := rat.mul_add,
  add_mul := rat.add_mul,
  mul_comm := rat.mul_comm,
  inv := has_inv.inv, -- see neg
  zero_ne_one := rat.zero_ne_one,
  mul_inv_cancel := rat.mul_inv_cancel,
  inv_zero := inv_zero -- I don't know why rat.inv_zero was never explicitly defined
  }

/-
Below is evidence that we can prove basic theorems about these structures.
Note however that it is a *complete pain* because we are *re-implementing*
everything; `add_comm` defaults to Lean's version for Lean's `add_comm_group`s, so we
have to explicitly write `add_comm_group.add_comm` to use our own version.
The mathlib versions of these proofs are less ugly.
-/

variables {A : Type} [add_comm_group A]

lemma add_comm_group.add_left_cancel (a b c : A) (Habac : a + b = a + c) : b = c :=
begin
  rw ←add_comm_group.zero_add b,
  rw ←add_comm_group.add_left_neg a,
  rw add_comm_group.add_assoc,
  rw Habac,
  rw ←add_comm_group.add_assoc,
  rw add_comm_group.add_left_neg,
  rw add_comm_group.zero_add,
end

lemma add_comm_group.add_right_neg (a : A) : a + -a = 0 :=
begin
  rw add_comm_group.add_comm,
  rw add_comm_group.add_left_neg,
end

lemma add_comm_group.sub_eq_add_neg (a b : A) :
  a - b = a + -b :=
begin
  -- this is just our definition of subtraction
  refl
end

lemma add_comm_group.sub_self (a : A) : a - a = 0 :=
begin
  rw add_comm_group.sub_eq_add_neg,
  rw add_comm_group.add_comm,
  rw add_comm_group.add_left_neg,
end

lemma add_comm_group.neg_eq_of_add_eq_zero (a b : A) (h : a + b = 0) : -a = b :=
begin
  apply add_comm_group.add_left_cancel a,
  rw h,
  rw add_comm_group.add_right_neg,
end

lemma add_comm_group.add_zero (a : A) : a + 0 = a :=
begin
  rw add_comm_group.add_comm,
  rw add_comm_group.zero_add,
end

variables {R : Type} [ring R]

lemma ring.mul_zero (r : R) : r * 0 = 0 :=
begin
  apply add_comm_group.add_left_cancel (r * 0),
  rw ←ring.mul_add,
  rw add_comm_group.add_zero,
  rw add_comm_group.add_zero,
end

lemma ring.mul_neg (a b : R) : a * -b = -(a * b) :=
begin
  sorry
end

lemma ring.mul_sub (R : Type) [comm_ring R] (r a b : R) : r * (a - b) = r * a - r * b :=
begin
  sorry
end

lemma comm_ring.sub_mul (R : Type) [comm_ring R] (r a b : R) : (a - b) * r = a * r - b * r :=
begin
  sorry
end

-- etc etc, for thousands of lines of mathlib, which develop the interface
-- abelian groups, rings, commutative rings, modules, fields, vector spaces etc.

end lftcm


import MyNat.Definition
namespace MyNat
open MyNat

def pow : MyNat → MyNat → MyNat
| _, zero => one
| m, (succ n) => pow m n * m

instance : Pow MyNat MyNat where
  pow := pow

-- notation a ^ b := pow a b

example : (1 : MyNat) ^ (1 : MyNat) = 1 := by rfl

lemma pow_zero (m : MyNat) : m ^ (0 : MyNat) = 1 := by rfl

lemma pow_succ (m n : MyNat) : m ^ (succ n) = m ^ n * m := by rfl

end MyNat


import tactic.basic
import tactic.interactive

import .formula

/-- A formula is satisfied by an assignment if it evaluates to true. -/
@[simp] def satisfies (asgn : symbol → Prop) (modal_asgn : formula → Prop) : formula → Prop
| ⊤ := true
| ⊥ := false
| (formula.symbol s) := asgn s
| ¬a := ¬satisfies a
| (a ∧ b) := satisfies a ∧ satisfies b
| (a ∨ b) := satisfies a ∨ satisfies b
| (a ⟶ b) := satisfies a → satisfies b
| (a ↔ b) := satisfies a ↔ satisfies b
| □a := modal_asgn □a
| ◇a := modal_asgn ◇a

/-- A tautology is a formula that is always true. -/
def tautology (a : formula) := ∀v m, satisfies v m a

/-- A model is a collection of worlds with a relation and an interpretation function that
    determines at which worlds sentence symbols are true. -/
structure model :=
{world : Type}
(w : set world)
(r : world → world → Prop)
(v : symbol → set world)

/-- Definition of truth at a world in a model. -/
@[simp] def truth (m : model) : m.world → formula → Prop
| _ ⊥ := false
| _ ⊤ := true
| w (formula.symbol s) := w ∈ (m.v s)
| w ¬a := ¬truth w a
| w (a ∧ b) := truth w a ∧ truth w b
| w (a ∨ b) := truth w a ∨ truth w b
| w (a ⟶ b) := truth w a → truth w b
| w (a ↔ b) := truth w a ↔ truth w b
| w □a := ∀w' ∈ m.w, m.r w w' → truth w' a
| w ◇a := ∃w' ∈ m.w, m.r w w' ∧ truth w' a

notation ⟨m, w⟩ ` ⊩ ` a := truth m w a

/-- A formula is true in a model iff it is true in all worlds in the model. -/
@[simp] def true_in (m : model) (a : formula) := ∀w ∈ m.w, ⟨m, w⟩ ⊩ a

reserve infix ` ⊩ ` :15
notation m ⊩ a := true_in m a

/-- A formula is true in a set of models iff it is true in all models in the set. -/
@[simp] def valid (𝒞 : set model) (a : formula) := ∀m ∈ 𝒞, m ⊩ a

reserve prefix `⊨ ` :15
reserve infix ` ⊨ ` :15

notation 𝒞 ⊨ a := valid 𝒞 a
notation ⊨ a := set.univ ⊨ a

@[simp] lemma valid_imp_valid_in (a : formula) {ha : ⊨ a} {𝒞 : set model} : 𝒞 ⊨ a :=
begin
  intros m _,
  apply ha,
  tautology,
end

@[simp] def k (a b : formula) := □(a ⟶ b) ⟶ (□a ⟶ □b)

theorem k.valid : ∀(a b : formula), ⊨ k a b :=
begin
  intros a b,
  intros m _ w hw,
  intros h₁ h₂,
  intros w' _ hr,
  apply h₁,
  assumption',
  apply h₂,
  assumption',
end

@[simp] def dual (a : formula) := ◇a ↔ ¬□¬a

theorem dual.valid : ∀a : formula, ⊨ dual a :=
begin
  intro a,
  intros m _ w hw,
  apply iff.intro,
  { intro h₁,
    intro h₂,
    simp at *,
    apply exists.elim h₁,
    intros w' hw',
    cases hw',
    cases hw'_right,
    apply h₂ w',
    assumption', },
  { intro h₁,
    simp at *,
    assumption, }
end

lemma foo (a : formula)
    (m : model) (w ∈ m.w)
    (v : symbol → Prop) (hv : ∀s, v s ↔ ⟨m, w⟩ ⊩ formula.symbol s)
    (mv : formula → Prop) (hmv : ∀a, mv a ↔ ⟨m, w⟩ ⊩ a) :
  satisfies v mv a ↔ ⟨m, w⟩ ⊩ a :=
begin
  induction a,
  repeat { simp * at *, },
end

/-- All tautologies are valid. -/
theorem tautology.valid (a : formula) : tautology a → ⊨ a :=
begin
  contrapose,
  intros h₁ h₂,
  simp at h₁,
  apply exists.elim h₁,
  intros m hm,
  cases hm with w hw,
  cases hw,
  apply hw_right,
  have h := foo a m w hw_left (λs, ⟨m, w⟩ ⊩ formula.symbol s) (by simp) (λa, ⟨m, w⟩ ⊩ a) (by simp),
  simp [←h],
  apply h₂,
end

theorem mp (a b : formula) (m : model) (w ∈ m.w) : (⟨m, w⟩ ⊩ a ⟶ b) → (⟨m, w⟩ ⊩ a) → (⟨m, w⟩ ⊩ b) :=
begin
  intros hab ha,
  apply hab,
  assumption,
end

theorem mp_valid {𝒞 : set model} (a b : formula) : (𝒞 ⊨ a ⟶ b) → (𝒞 ⊨ a) → (𝒞 ⊨ b) :=
begin
  intros hab ha m _ w _,
  apply mp,
  assumption',
  apply hab,
  assumption',
  apply ha,
  assumption',
end

theorem nec_valid {𝒞 : set model} (a : formula) : (𝒞 ⊨ a) → (𝒞 ⊨ □a) :=
begin
  intro ha,
  intros m _ w _,
  intros w' _ hww',
  apply ha,
  assumption',
end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Cardinality calculations for finite sets.
-/
import .to_set .bigops data.set.function data.nat.power
open nat eq.ops

namespace finset

variables {A B : Type}
variables [deceqA : decidable_eq A] [deceqB : decidable_eq B]
include deceqA

theorem card_add_card (s₁ s₂ : finset A) : card s₁ + card s₂ = card (s₁ ∪ s₂) + card (s₁ ∩ s₂) :=
begin
  induction s₂ with a s₂ ans2 IH,
    show card s₁ + card (∅:finset A) = card (s₁ ∪ ∅) + card (s₁ ∩ ∅),
      by rewrite [union_empty, card_empty, inter_empty],
    show card s₁ + card (insert a s₂) = card (s₁ ∪ (insert a s₂)) + card (s₁ ∩ (insert a s₂)),
      from decidable.by_cases
        (assume as1 : a ∈ s₁,
          have H : a ∉ s₁ ∩ s₂, from assume H', ans2 (mem_of_mem_inter_right H'),
          begin
            rewrite [card_insert_of_not_mem ans2, union_comm, -insert_union, union_comm],
            rewrite [insert_union, insert_eq_of_mem as1, insert_eq, inter_distrib_left, inter_comm],
            rewrite [singleton_inter_of_mem as1, -insert_eq, card_insert_of_not_mem H, -*add.assoc],
            rewrite IH
          end)
        (assume ans1 : a ∉ s₁,
          have H : a ∉ s₁ ∪ s₂, from assume H',
            or.elim (mem_or_mem_of_mem_union H') (assume as1, ans1 as1) (assume as2, ans2 as2),
          begin
            rewrite [card_insert_of_not_mem ans2, union_comm, -insert_union, union_comm],
            rewrite [card_insert_of_not_mem H, insert_eq, inter_distrib_left, inter_comm],
            rewrite [singleton_inter_of_not_mem ans1, empty_union, add.right_comm],
            rewrite [-add.assoc, IH]
          end)
end

theorem card_union (s₁ s₂ : finset A) : card (s₁ ∪ s₂) = card s₁ + card s₂ - card (s₁ ∩ s₂) :=
calc
  card (s₁ ∪ s₂) = card (s₁ ∪ s₂) + card (s₁ ∩ s₂) - card (s₁ ∩ s₂) : nat.add_sub_cancel
             ... = card s₁ + card s₂ - card (s₁ ∩ s₂)               : card_add_card

theorem card_union_of_disjoint {s₁ s₂ : finset A} (H : s₁ ∩ s₂ = ∅) :
  card (s₁ ∪ s₂) = card s₁ + card s₂ :=
by rewrite [card_union, H]

theorem card_eq_card_add_card_diff {s₁ s₂ : finset A} (H : s₁ ⊆ s₂) :
  card s₂ = card s₁ + card (s₂ \ s₁) :=
have H1 : s₁ ∩ (s₂ \ s₁) = ∅,
  from inter_eq_empty (take x, assume H1 H2, not_mem_of_mem_diff H2 H1),
calc
  card s₂ = card (s₁ ∪ (s₂ \ s₁))    : union_diff_cancel H
      ... = card s₁ + card (s₂ \ s₁) : card_union_of_disjoint H1

theorem card_le_card_of_subset {s₁ s₂ : finset A} (H : s₁ ⊆ s₂) : card s₁ ≤ card s₂ :=
calc
  card s₂ = card s₁ + card (s₂ \ s₁) : card_eq_card_add_card_diff H
      ... ≥ card s₁                  : le_add_right

section card_image
open set
include deceqB

theorem card_image_eq_of_inj_on {f : A → B} {s : finset A} (H1 : inj_on f (ts s)) :
  card (image f s) = card s :=
begin
  induction s with a t H IH,
    { rewrite [card_empty] },
    { have H2 : ts t ⊆ ts (insert a t), by rewrite [-subset_eq_to_set_subset]; apply subset_insert,
      have H3 : card (image f t) = card t, from IH (inj_on_of_inj_on_of_subset H1 H2),
      have H4 : f a ∉ image f t,
      proof
        assume H5 : f a ∈ image f t,
        obtain x (H6l : x ∈ t) (H6r : f x = f a), from exists_of_mem_image H5,
        have H7 : x = a, from H1 (mem_insert_of_mem _ H6l) !mem_insert H6r,
        show false, from H (H7 ▸ H6l)
      qed,
      calc
        card (image f (insert a t)) = card (insert (f a) (image f t)) : image_insert
                                ... = card (image f t) + 1            : card_insert_of_not_mem H4
                                ... = card t + 1                      : H3
                                ... = card (insert a t)               : card_insert_of_not_mem H
    }
end

lemma card_le_of_inj_on (a : finset A) (b : finset B)
    (Pex : ∃ f : A → B, set.inj_on f (ts a) ∧ (image f a ⊆ b)):
  card a ≤ card b :=
obtain f Pinj, from Pex,
have Psub : _, from and.right Pinj,
have Ple : card (image f a) ≤ card b, from card_le_card_of_subset Psub,
by rewrite [(card_image_eq_of_inj_on (and.left Pinj))⁻¹]; exact Ple

theorem card_image_le (f : A → B) (s : finset A) : card (image f s) ≤ card s :=
finset.induction_on s
  (by rewrite finset.image_empty)
  (take a s',
    assume Ha : a ∉ s',
    assume IH : card (image f s') ≤ card s',
    begin
      rewrite [image_insert, card_insert_of_not_mem Ha],
      apply le.trans !card_insert_le,
      apply add_le_add_right IH
    end)

theorem inj_on_of_card_image_eq {f : A → B} {s : finset A} :
  card (image f s) = card s → inj_on f (ts s) :=
finset.induction_on s
  (by intro H; rewrite to_set_empty; apply inj_on_empty)
  (begin
    intro a s' Ha IH,
    rewrite [image_insert, card_insert_of_not_mem Ha, to_set_insert],
    assume H1 : card (insert (f a) (image f s')) = card s' + 1,
    show inj_on f (set.insert a (ts s')), from
      decidable.by_cases
        (assume Hfa : f a ∈ image f s',
           have H2 : card (image f s') = card s' + 1,
             by rewrite [card_insert_of_mem Hfa at H1]; assumption,
           absurd
             (calc
               card (image f s') ≤ card s'           : !card_image_le
                             ... < card s' + 1       : lt_succ_self
                             ... = card (image f s') : H2)
             !lt.irrefl)
        (assume Hnfa : f a ∉ image f s',
           have H2 : card (image f s') + 1 = card s' + 1,
             by rewrite [card_insert_of_not_mem Hnfa at H1]; assumption,
           have H3 : card (image f s') = card s', from add.right_cancel H2,
           have injf : inj_on f (ts s'), from IH H3,
           show inj_on f (set.insert a (ts s')), from
             take x1 x2,
             assume Hx1 : x1 ∈ set.insert a (ts s'),
             assume Hx2 : x2 ∈ set.insert a (ts s'),
             assume feq : f x1 = f x2,
             or.elim Hx1
               (assume Hx1' : x1 = a,
                 or.elim Hx2
                   (assume Hx2' : x2 = a, by rewrite [Hx1', Hx2'])
                   (assume Hx2' : x2 ∈ ts s',
                     have Hfa : f a ∈ image f s',
                       by rewrite [-Hx1', feq]; apply mem_image_of_mem f Hx2',
                     absurd Hfa Hnfa))
               (assume Hx1' : x1 ∈ ts s',
                 or.elim Hx2
                   (assume Hx2' : x2 = a,
                     have Hfa : f a ∈ image f s',
                       by rewrite [-Hx2', -feq]; apply mem_image_of_mem f Hx1',
                     absurd Hfa Hnfa)
                   (assume Hx2' : x2 ∈ ts s', injf Hx1' Hx2' feq)))
    end)

end card_image

theorem card_pos_of_mem {a : A} {s : finset A} (H : a ∈ s) : card s > 0 :=
begin
  induction s with a s' H1 IH,
  { contradiction },
  { rewrite (card_insert_of_not_mem H1), apply succ_pos }
end

theorem eq_of_card_eq_of_subset {s₁ s₂ : finset A} (Hcard : card s₁ = card s₂) (Hsub : s₁ ⊆ s₂) :
  s₁ = s₂ :=
have H : card s₁ + 0 = card s₁ + card (s₂ \ s₁),
  by rewrite [Hcard at {1}, card_eq_card_add_card_diff Hsub],
have H1 : s₂ \ s₁ = ∅, from eq_empty_of_card_eq_zero (add.left_cancel H)⁻¹,
by rewrite [-union_diff_cancel Hsub, H1, union_empty]

lemma exists_two_of_card_gt_one {s : finset A} : 1 < card s → ∃ a b, a ∈ s ∧ b ∈ s ∧ a ≠ b :=
begin
  intro h,
  induction s with a s nain ih₁,
   {exact absurd h dec_trivial},
   {induction s with b s nbin ih₂,
    {exact absurd h dec_trivial},
     clear ih₁ ih₂,
     existsi a, existsi b, split,
      {apply mem_insert},
      split,
      {apply mem_insert_of_mem _ !mem_insert},
      {intro aeqb, subst a, exact absurd !mem_insert nain}}
end

theorem Sum_const_eq_card_mul (s : finset A) (n : nat) : (∑ x ∈ s, n) = card s * n :=
begin
  induction s with a s' H IH,
    rewrite [Sum_empty, card_empty, zero_mul],
    rewrite [Sum_insert_of_not_mem _ H, IH, card_insert_of_not_mem H, add.comm,
             right_distrib, one_mul]
end

theorem Sum_one_eq_card (s : finset A) : (∑ x ∈ s, (1 : nat)) = card s :=
eq.trans !Sum_const_eq_card_mul !mul_one

section deceqB
include deceqB

theorem card_Union_of_disjoint (s : finset A) (f : A → finset B) :
  (∀{a₁ a₂}, a₁ ∈ s → a₂ ∈ s → a₁ ≠ a₂ → f a₁ ∩ f a₂ = ∅) →
    card (⋃ x ∈ s, f x) = ∑ x ∈ s, card (f x) :=
finset.induction_on s
  (assume H, by rewrite [Union_empty, Sum_empty, card_empty])
  (take a s', assume H : a ∉ s',
    assume IH,
    assume H1 : ∀ {a₁ a₂ : A}, a₁ ∈ insert a s' → a₂ ∈ insert a s' → a₁ ≠ a₂ → f a₁ ∩ f a₂ = ∅,
    have H2  : ∀ a₁ a₂ : A, a₁ ∈ s' → a₂ ∈ s' → a₁ ≠ a₂ → f a₁ ∩ f a₂ = ∅, from
      take a₁ a₂, assume H3 H4 H5,
      H1 (!mem_insert_of_mem H3) (!mem_insert_of_mem H4) H5,
    have H6 : card (⋃ (x : A) ∈ s', f x) = ∑ (x : A) ∈ s', card (f x), from IH H2,
    have H7 : ∀ x, x ∈ s' → f a ∩ f x = ∅, from
      take x, assume xs',
      have anex : a ≠ x, from assume aex, (eq.subst aex H) xs',
      H1 !mem_insert (!mem_insert_of_mem xs') anex,
    have H8 : f a ∩ (⋃ (x : A) ∈ s', f x) = ∅, from
      calc
        f a ∩ (⋃ (x : A) ∈ s', f x) = (⋃ (x : A) ∈ s', f a ∩ f x)  : by rewrite inter_Union
                                ... = (⋃ (x : A) ∈ s', ∅)          : by rewrite [Union_ext H7]
                                ... = ∅                            : by rewrite Union_empty',
    by rewrite [Union_insert, Sum_insert_of_not_mem _ H,
                card_union_of_disjoint H8, H6])
end deceqB

lemma dvd_Sum_of_dvd (f : A → nat) (n : nat) (s : finset A) : (∀ a, a ∈ s → n ∣ f a) → n ∣ Sum s f :=
begin
  induction s with a s nain ih,
   {intros, rewrite [Sum_empty], apply dvd_zero},
   {intro h,
    have h₁ : ∀ a, a ∈ s → n ∣ f a, from
      take a, assume ains, h a (mem_insert_of_mem _ ains),
    have h₂ : n ∣ Sum s f, from ih h₁,
    have h₃ : n ∣ f a, from h a !mem_insert,
    rewrite [Sum_insert_of_not_mem f nain],
    apply dvd_add h₃ h₂}
end
end finset


import .lesson1

noncomputable theory
open_locale classical
open PreHilbertPlane HilbertPlane
open nat

variables {Ω : Type*} [HilbertPlane Ω]

variables {A B C D : Ω}
variables {ℓ r s : Line Ω}

lemma point_in_line_difference (h : r ≠ s) :
	∃ A, A ∈ r ∧ A ∉ s :=
begin
	have AB : ∃ A B , A ≠ B ∧ A ∈ r ∧ B ∈ r := I2 r,
	rcases AB with ⟨ A, B, ⟨ hAB, hAr, hBr⟩⟩,
	have h1 : A ∉ s ∨ B ∉ s,
	{
		by_contradiction hcontra,
		apply hAB,
		apply distinct_lines_have_at_most_one_common_point h;
		tauto,
	},
	cases h1 with h_isA h_isB,
	work_on_goal 1 {use A},
	work_on_goal 2 {use B},
	repeat {tauto},
end

lemma equal_lines_of_contain_two_points
	(hAB: A ≠ B)
	(hAr: A ∈ r) (hAs: A ∈ s) (hBr: B ∈ r) (hBs: B ∈ s) :
	r = s :=
begin
	by_contradiction hcontra,
	apply hAB,
	apply distinct_lines_have_at_most_one_common_point; assumption,
end

lemma between_points_share_line (hAr : A ∈ r) (hCr : C ∈ r) :
	(A * B * C) → B ∈ r :=
begin
	intro h,
	have H := HilbertPlane.B12 h,
	obtain ⟨hAB, hAC, hBC, ⟨ ℓ, ⟨ hAℓ, hBℓ, hCℓ⟩⟩⟩ := H,
	suffices : r = ℓ, by rwa this,
	apply equal_lines_of_contain_two_points hAC; assumption,
end

lemma between_points_share_line_v2 (hAr : A ∈ r) (hBr : B ∈ r) :
	(A * B * C) → C ∈ r :=
begin
	intro h,
	have H := HilbertPlane.B12 h,
	obtain ⟨hAB, hAC, hBC, ⟨ ℓ, ⟨ hAℓ, hBℓ, hCℓ⟩⟩⟩ := H,
	suffices : r = ℓ, by rwa this,
	apply equal_lines_of_contain_two_points hAB; assumption,
end

lemma collinear_of_collinear_collinear (hAB : A ≠ B) (hABC : collinear_triple A B C) (hABD : collinear_triple A B D) :
collinear_triple A C D :=
begin
	obtain ⟨r, hr⟩ := hABC,
	obtain ⟨s, hs⟩ := hABD,
	have hkey : r = s := equal_lines_of_contain_two_points hAB hr.1 hs.1 hr.2.1 hs.2.1,
	subst hkey,
	use r,
	tauto,
end

lemma collinear_subset (S T : set Ω) (hST : S ⊆ T) : collinear T → collinear S :=
begin
	intro h,
	obtain ⟨ℓ, hℓ⟩ := h,
	exact ⟨ℓ, λ P hP, hℓ (hST hP)⟩,
end

lemma collinear_union (S T : set Ω) {P Q : Ω} (h : P ≠ Q) (hS : collinear S) (hT : collinear T)
(hPS : P ∈ S) (hPT : P ∈ T) (hQS : Q ∈ S) (hQT : Q ∈ T) : collinear (S ∪ T) :=
begin
	obtain ⟨u, hu⟩ := hS,
	obtain ⟨v, hv⟩ := hT,
	have huv : u = v,
	{ apply equal_lines_of_contain_two_points h; tauto },
	subst huv,
	use u,
	finish,
end

meta def extfinish : tactic unit := `[ext, finish]

lemma collinear_triple_of_equal (A B C P Q R : Ω)
(h : ({A, B, C} : set Ω) = {P, Q, R} . extfinish) :
(collinear_triple A B C ↔ collinear_triple P Q R) :=
begin
	finish,
end

example (A B C : Ω) (h : collinear_triple A B C)
: collinear_triple B A C :=
begin
	rw collinear_triple_of_equal B A C A B C,
	exact h,
end

lemma collinear_of_equal {S T : set Ω} : S = T → (collinear S ↔ collinear T) :=
begin
	intro h,
	subst h,
end


import tactic
import data.complex.basic

open complex

example : ((-1 + (real.sqrt 3 : ℂ)*I)/2)^3 = 1 :=
begin
  field_simp,
  ring_nf,
  norm_num,
  ring_nf,
  norm_cast,
  norm_num,
end

-- example : ((-1 + (real.sqrt 3 : ℂ)*I)/2)^3 = 1 :=
-- begin
--   have : (real.sqrt 3 : ℂ)^2 * I^2 = -3,
--   { simp, exact_mod_cast @real.sq_sqrt 3 (by norm_num) },
--   linear_combination (this, (-3+(real.sqrt(3)*I))/8),
-- end

variables (k : Type) (V : Type) [field k] [add_comm_group V] [module k V]
variables (n : ℕ) (w : V)
-- variables (v : fin n → α)
-- #check matrix.vec_cons w v
-- #check fin.cons w v

variables (v : vector V n)
#check vector.cons w v
-- #check submodule.span k v
open complex
def myvec : vector ℂ 2 :=
⟨[1+I, 1-I], rfl⟩

example (g : fin 4 → k) (v0 v1 v2 v3 : V) :
g 0 • v0 + (g 1 - g 0) • v1 + (g 2 - g 1) • v2 + (g 3 - g 2) • v3 =
g 0 • (v0 - v1) + g 1 • (v1 - v2) + g 2 • (v2 - v3) + g 3 • v3 := sorry

example (f : fin 4 → k) (v0 v1 v2 v3 : V) : finset.univ.sum (λ (i : fin 4), f i • ![v0, v1, v2, v3] i) = f 0 • v0 + f 1 • v1 + f 2 • v2 + f 3 • v3 := sorry


import natural.addition natural.definition natural.multiplication

namespace N

def le (a b : N) := ∃ c: N, a + c = b

instance : has_le N := ⟨ le ⟩

def lt (a b : N) := (a ≤ b) ∧ ¬(a = b)

instance : has_lt N := ⟨ lt ⟩

lemma eq_comm (a b : N) : (a = b) -> (b = a) :=
begin
  intro h,
  rw h,
end

lemma succ_neq_zero (a : N): ¬(succ a = 0) :=
begin
  intro h,
  let p := eq_comm (succ a) 0 h,
  apply zero_neq_succ a,
  exact p,
end

lemma zero_le_all (a : N): 0 ≤ a :=
begin
  existsi a,
  rw zero_add,
end

lemma zero_lt_succ (a : N): 0 < succ a :=
begin
  split,
  exact zero_le_all (succ a),
  exact zero_neq_succ a,
end

theorem eq_add (a b d : N) : (a + d = b + d) <-> (a = b) :=
begin
  split,
  induction d with d hd,
  rw zero_eq_zero,
  repeat {rw add_zero},
  intro h,
  exact h,
  intro h,
  repeat {rw add_succ at h},
  exact hd (succ_eq (a + d) (b + d) h),
  induction d with d hd,
  rw zero_eq_zero,
  repeat {rw add_zero},
  intro h,
  exact h,
  intro h,
  repeat {rw add_succ},
  rw hd h,
end

theorem add_eq (a b d : N) : (d + a = d + b) <-> (a = b) :=
begin
  have q := eq_add a b d,
  cases q,
  split,
  intro h,
  rw add_comm d a at h,
  rw add_comm d b at h,
  exact q_mp h,
  intro h,
  have t := q_mpr h,
  rw add_comm a d at t,
  rw add_comm b d at t,
  exact t,
end

theorem zero_sum (a b : N) : (a + b = 0) -> (a = 0 ∧ b = 0) :=
begin
  intro h,
  cases a,
  cases b,
  split,
  exact zero_eq_zero,
  exact zero_eq_zero,
  exfalso,
  rw zero_eq_zero at h,
  rw zero_add at h,
  apply succ_neq_zero b,
  exact h,
  exfalso,
  rw succ_add at h,
  apply succ_neq_zero (a + b),
  exact h,
end

end N


variables (men : Type) (barber : men)
variable (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
  have hb : shaves barber barber ↔ ¬ shaves barber barber, from h barber,
  have ¬ shaves barber barber, from
    assume : shaves barber barber,
    hb.mp this this,
   ‹¬ shaves barber barber› (hb.mpr ‹¬ shaves barber barber›)


import group_representation
import linear_algebra.determinant
import linear_algebra.matrix
open linear_map
open MY_TEST              ------------------- cvlasse de matrice n'est pas opérationnelle !
universe variables u v w
open matrix
variables {G : Type u} {R : Type v} [group G] [comm_ring R]
variables {n : Type u} [fintype n] [decidable_eq n]
variables (ρ : group_representation G R (n → R))
variables (g : G)
def to_matrix' (ρ : group_representation G R (n → R))(g : G) :  matrix n n R :=  to_matrix (⟦ρ ⟧ g)
lemma proof_strategy (A B : matrix n n R) : to_lin A = to_lin B → A = B := begin
     intro hyp,
     have RR : to_matrix (to_lin A) = to_matrix (to_lin B),
          congr',
     iterate 2 {rw  to_lin_to_matrix  at RR},
     exact RR,
end
def χ (ρ : group_representation G R (n → R)) : G →  R := λ g,  matrix.trace n R R (to_matrix  (⟦ ρ ⟧  g))

lemma to_matrix_mul (g1 g2 : G) :
to_matrix (⟦ρ ⟧ g1) * to_matrix (⟦ρ ⟧ g2) = to_matrix (⟦ρ ⟧ (g1 * g2) ) := begin
     apply proof_strategy,
     rw mul_eq_mul,
     rw mul_to_lin,
     iterate 2 {rw  to_matrix_to_lin },
     rw ← rmap_mul,
     rw to_matrix_to_lin,
end
lemma to_matrix_one : to_matrix (⟦ρ⟧ 1) = 1 := begin
     rw rmap_one,
     apply proof_strategy,
     rw to_matrix_to_lin,
     rw to_lin_one,
end
lemma χ_comm :  ∀ t s : G, χ ρ (t * s ) = χ ρ (s * t) := begin
     intros s t,
     unfold χ, rw ← to_matrix_mul,
     rw mul_eq_mul,
     rw trace_mul_comm,
     rw ←  mul_eq_mul,
     rw to_matrix_mul,
end
theorem central_function : ∀ t s : G, χ ρ (t*s*t⁻¹ ) = χ ρ s := begin
     intros s t,
     rw  mul_assoc,
     rw χ_comm ρ  s (t * s⁻¹),
     rw  mul_assoc,
     rw inv_mul_self,rw group.mul_one,
end
theorem χ_one : χ ρ 1 =  fintype.card n := begin
     unfold χ, rw to_matrix_one, rw trace_one,
end

/-
     For the moment not nice matrix strategy i have to lear a little
-/
lemma to_matrix_id : to_matrix (linear_map.id : (n →  R)→ₗ(n → R)) = (1 : matrix n n R) := begin
     apply proof_strategy,
     rw to_lin_one,
     rw to_matrix_to_lin,
end
lemma det_mul' (g1  g2 : G) : det (to_matrix (⟦ρ ⟧ g1)) * det (to_matrix (⟦ρ ⟧ g2)) = det (to_matrix (⟦ρ ⟧ (g1*g2))) :=
begin
     rw ← det_mul,rw ← mul_eq_mul,rw to_matrix_mul,
end
lemma one_mul' (g : G) :   det (to_matrix (⟦ρ ⟧ g)) * det (to_matrix (⟦ρ ⟧ g⁻¹ )) = (1 : R) := begin
     rw det_mul',rw_simp,rw to_matrix_id,rw det_one,
end


variables A B  : Prop
example : A ∧ (A -> B) -> B :=
assume h1 : A /\ (A -> B),
have h2 : A, from and.left h1,
have h3 : A -> B, from and.right h1,
show B, from   h3 h2


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Anne Baanen

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

/-!
# Finite dimension of vector spaces

Definition of the rank of a module, or dimension of a vector space, as a natural number.

## Main definitions

Defined is `finite_dimensional.finrank`, the dimension of a finite dimensional space, returning a
`nat`, as opposed to `module.rank`, which returns a `cardinal`. When the space has infinite
dimension, its `finrank` is by convention set to `0`.

The definition of `finrank` does not assume a `finite_dimensional` instance, but lemmas might.
Import `linear_algebra.finite_dimensional` to get access to these additional lemmas.

Formulas for the dimension are given for linear equivs, in `linear_equiv.finrank_eq`

## Implementation notes

Most results are deduced from the corresponding results for the general dimension (as a cardinal),
in `dimension.lean`. Not all results have been ported yet.

You should not assume that there has been any effort to state lemmas as generally as possible.
-/

universe u v v' w

open Classical Cardinal

open Cardinal Submodule Module Function

variable {K : Type u} {V : Type v}

namespace FiniteDimensional

open IsNoetherian

section DivisionRing

variable [DivisionRing K] [AddCommGroup V] [Module K V] {V₂ : Type v'} [AddCommGroup V₂]
  [Module K V₂]

/-- The rank of a module as a natural number.

Defined by convention to be `0` if the space has infinite rank.

For a vector space `V` over a field `K`, this is the same as the finite dimension
of `V` over `K`.
-/
noncomputable def finrank (R V : Type _) [Semiring R] [AddCommGroup V] [Module R V] : ℕ :=
  (Module.rank R V).toNat
#align finite_dimensional.finrank FiniteDimensional.finrank

theorem finrank_eq_of_dim_eq {n : ℕ} (h : Module.rank K V = ↑n) : finrank K V = n :=
  by
  apply_fun to_nat  at h
  rw [to_nat_cast] at h
  exact_mod_cast h
#align finite_dimensional.finrank_eq_of_dim_eq FiniteDimensional.finrank_eq_of_dim_eq

theorem finrank_le_of_dim_le {n : ℕ} (h : Module.rank K V ≤ ↑n) : finrank K V ≤ n :=
  by
  rwa [← Cardinal.toNat_le_iff_le_of_lt_aleph0, to_nat_cast] at h
  · exact h.trans_lt (nat_lt_aleph_0 n)
  · exact nat_lt_aleph_0 n
#align finite_dimensional.finrank_le_of_dim_le FiniteDimensional.finrank_le_of_dim_le

theorem finrank_lt_of_dim_lt {n : ℕ} (h : Module.rank K V < ↑n) : finrank K V < n :=
  by
  rwa [← Cardinal.toNat_lt_iff_lt_of_lt_aleph0, to_nat_cast] at h
  · exact h.trans (nat_lt_aleph_0 n)
  · exact nat_lt_aleph_0 n
#align finite_dimensional.finrank_lt_of_dim_lt FiniteDimensional.finrank_lt_of_dim_lt

theorem dim_lt_of_finrank_lt {n : ℕ} (h : n < finrank K V) : ↑n < Module.rank K V :=
  by
  rwa [← Cardinal.toNat_lt_iff_lt_of_lt_aleph0, to_nat_cast]
  · exact nat_lt_aleph_0 n
  · contrapose! h
    rw [finrank, Cardinal.toNat_apply_of_aleph0_le h]
    exact n.zero_le
#align finite_dimensional.dim_lt_of_finrank_lt FiniteDimensional.dim_lt_of_finrank_lt

/-- If a vector space has a finite basis, then its dimension is equal to the cardinality of the
basis. -/
theorem finrank_eq_card_basis {ι : Type w} [Fintype ι] (h : Basis ι K V) :
    finrank K V = Fintype.card ι :=
  finrank_eq_of_dim_eq (dim_eq_card_basis h)
#align finite_dimensional.finrank_eq_card_basis FiniteDimensional.finrank_eq_card_basis

/-- If a vector space has a finite basis, then its dimension is equal to the cardinality of the
basis. This lemma uses a `finset` instead of indexed types. -/
theorem finrank_eq_card_finset_basis {ι : Type w} {b : Finset ι} (h : Basis.{w} b K V) :
    finrank K V = Finset.card b := by rw [finrank_eq_card_basis h, Fintype.card_coe]
#align finite_dimensional.finrank_eq_card_finset_basis FiniteDimensional.finrank_eq_card_finset_basis

/-- A finite dimensional space is nontrivial if it has positive `finrank`. -/
theorem nontrivial_of_finrank_pos (h : 0 < finrank K V) : Nontrivial V :=
  dim_pos_iff_nontrivial.mp (dim_lt_of_finrank_lt h)
#align finite_dimensional.nontrivial_of_finrank_pos FiniteDimensional.nontrivial_of_finrank_pos

/-- A finite dimensional space is nontrivial if it has `finrank` equal to the successor of a
natural number. -/
theorem nontrivial_of_finrank_eq_succ {n : ℕ} (hn : finrank K V = n.succ) : Nontrivial V :=
  nontrivial_of_finrank_pos (by rw [hn] <;> exact n.succ_pos)
#align finite_dimensional.nontrivial_of_finrank_eq_succ FiniteDimensional.nontrivial_of_finrank_eq_succ

/-- A (finite dimensional) space that is a subsingleton has zero `finrank`. -/
theorem finrank_zero_of_subsingleton [h : Subsingleton V] : finrank K V = 0 :=
  by
  by_contra h0
  obtain ⟨x, y, hxy⟩ := nontrivial_of_finrank_pos (Nat.pos_of_ne_zero h0)
  exact hxy (Subsingleton.elim _ _)
#align finite_dimensional.finrank_zero_of_subsingleton FiniteDimensional.finrank_zero_of_subsingleton

theorem Basis.subset_extend {s : Set V} (hs : LinearIndependent K (coe : s → V)) :
    s ⊆ hs.extend (Set.subset_univ _) :=
  hs.subset_extend _
#align finite_dimensional.basis.subset_extend FiniteDimensional.Basis.subset_extend

variable (K)

/-- A division_ring is one-dimensional as a vector space over itself. -/
@[simp]
theorem finrank_self : finrank K K = 1 :=
  finrank_eq_of_dim_eq (by simp)
#align finite_dimensional.finrank_self FiniteDimensional.finrank_self

/-- The vector space of functions on a fintype ι has finrank equal to the cardinality of ι. -/
@[simp]
theorem finrank_fintype_fun_eq_card {ι : Type v} [Fintype ι] : finrank K (ι → K) = Fintype.card ι :=
  finrank_eq_of_dim_eq dim_fun'
#align finite_dimensional.finrank_fintype_fun_eq_card FiniteDimensional.finrank_fintype_fun_eq_card

/-- The vector space of functions on `fin n` has finrank equal to `n`. -/
@[simp]
theorem finrank_fin_fun {n : ℕ} : finrank K (Fin n → K) = n := by simp
#align finite_dimensional.finrank_fin_fun FiniteDimensional.finrank_fin_fun

end DivisionRing

end FiniteDimensional

variable {K V}

section ZeroDim

variable [DivisionRing K] [AddCommGroup V] [Module K V]

open FiniteDimensional

theorem finrank_eq_zero_of_basis_imp_not_finite
    (h : ∀ s : Set V, Basis.{v} (s : Set V) K V → ¬s.Finite) : finrank K V = 0 :=
  dif_neg fun dim_lt =>
    h _ (Basis.ofVectorSpace K V) ((Basis.ofVectorSpace K V).finite_index_of_dim_lt_aleph0 dim_lt)
#align finrank_eq_zero_of_basis_imp_not_finite finrank_eq_zero_of_basis_imp_not_finite

theorem finrank_eq_zero_of_basis_imp_false (h : ∀ s : Finset V, Basis.{v} (s : Set V) K V → False) :
    finrank K V = 0 :=
  finrank_eq_zero_of_basis_imp_not_finite fun s b hs =>
    h hs.toFinset
      (by
        convert b
        simp)
#align finrank_eq_zero_of_basis_imp_false finrank_eq_zero_of_basis_imp_false

theorem finrank_eq_zero_of_not_exists_basis
    (h : ¬∃ s : Finset V, Nonempty (Basis (s : Set V) K V)) : finrank K V = 0 :=
  finrank_eq_zero_of_basis_imp_false fun s b => h ⟨s, ⟨b⟩⟩
#align finrank_eq_zero_of_not_exists_basis finrank_eq_zero_of_not_exists_basis

theorem finrank_eq_zero_of_not_exists_basis_finite
    (h : ¬∃ (s : Set V)(b : Basis.{v} (s : Set V) K V), s.Finite) : finrank K V = 0 :=
  finrank_eq_zero_of_basis_imp_not_finite fun s b hs => h ⟨s, b, hs⟩
#align finrank_eq_zero_of_not_exists_basis_finite finrank_eq_zero_of_not_exists_basis_finite

theorem finrank_eq_zero_of_not_exists_basis_finset (h : ¬∃ s : Finset V, Nonempty (Basis s K V)) :
    finrank K V = 0 :=
  finrank_eq_zero_of_basis_imp_false fun s b => h ⟨s, ⟨b⟩⟩
#align finrank_eq_zero_of_not_exists_basis_finset finrank_eq_zero_of_not_exists_basis_finset

variable (K V)

@[simp]
theorem finrank_bot : finrank K (⊥ : Submodule K V) = 0 :=
  finrank_eq_of_dim_eq (dim_bot _ _)
#align finrank_bot finrank_bot

end ZeroDim

namespace LinearEquiv

open FiniteDimensional

variable [DivisionRing K] [AddCommGroup V] [Module K V] {V₂ : Type v'} [AddCommGroup V₂]
  [Module K V₂]

variable {R M M₂ : Type _} [Ring R] [AddCommGroup M] [AddCommGroup M₂]

variable [Module R M] [Module R M₂]

/-- The dimension of a finite dimensional space is preserved under linear equivalence. -/
theorem finrank_eq (f : M ≃ₗ[R] M₂) : finrank R M = finrank R M₂ :=
  by
  unfold finrank
  rw [← Cardinal.toNat_lift, f.lift_dim_eq, Cardinal.toNat_lift]
#align linear_equiv.finrank_eq LinearEquiv.finrank_eq

/-- Pushforwards of finite-dimensional submodules along a `linear_equiv` have the same finrank. -/
theorem finrank_map_eq (f : M ≃ₗ[R] M₂) (p : Submodule R M) :
    finrank R (p.map (f : M →ₗ[R] M₂)) = finrank R p :=
  (f.submoduleMap p).finrank_eq.symm
#align linear_equiv.finrank_map_eq LinearEquiv.finrank_map_eq

end LinearEquiv

namespace LinearMap

open FiniteDimensional

section DivisionRing

variable [DivisionRing K] [AddCommGroup V] [Module K V] {V₂ : Type v'} [AddCommGroup V₂]
  [Module K V₂]

/-- The dimensions of the domain and range of an injective linear map are equal. -/
theorem finrank_range_of_inj {f : V →ₗ[K] V₂} (hf : Function.Injective f) :
    finrank K f.range = finrank K V := by rw [(LinearEquiv.ofInjective f hf).finrank_eq]
#align linear_map.finrank_range_of_inj LinearMap.finrank_range_of_inj

end DivisionRing

end LinearMap

open Module FiniteDimensional

section

variable [DivisionRing K] [AddCommGroup V] [Module K V]

@[simp]
theorem finrank_top : finrank K (⊤ : Submodule K V) = finrank K V :=
  by
  unfold finrank
  simp [dim_top]
#align finrank_top finrank_top

end

namespace Submodule

section DivisionRing

variable [DivisionRing K] [AddCommGroup V] [Module K V] {V₂ : Type v'} [AddCommGroup V₂]
  [Module K V₂]

theorem lt_of_le_of_finrank_lt_finrank {s t : Submodule K V} (le : s ≤ t)
    (lt : finrank K s < finrank K t) : s < t :=
  lt_of_le_of_ne le fun h => ne_of_lt lt (by rw [h])
#align submodule.lt_of_le_of_finrank_lt_finrank Submodule.lt_of_le_of_finrank_lt_finrank

theorem lt_top_of_finrank_lt_finrank {s : Submodule K V} (lt : finrank K s < finrank K V) : s < ⊤ :=
  by
  rw [← @finrank_top K V] at lt
  exact lt_of_le_of_finrank_lt_finrank le_top lt
#align submodule.lt_top_of_finrank_lt_finrank Submodule.lt_top_of_finrank_lt_finrank

end DivisionRing

end Submodule

section Span

open Submodule

section DivisionRing

variable [DivisionRing K] [AddCommGroup V] [Module K V]

variable (K)

/-- The rank of a set of vectors as a natural number. -/
protected noncomputable def Set.finrank (s : Set V) : ℕ :=
  finrank K (span K s)
#align set.finrank Set.finrank

variable {K}

theorem finrank_span_le_card (s : Set V) [Fintype s] : finrank K (span K s) ≤ s.toFinset.card :=
  finrank_le_of_dim_le (by simpa using dim_span_le s)
#align finrank_span_le_card finrank_span_le_card

theorem finrank_span_finset_le_card (s : Finset V) : (s : Set V).finrank K ≤ s.card :=
  calc
    (s : Set V).finrank K ≤ (s : Set V).toFinset.card := finrank_span_le_card s
    _ = s.card := by simp

#align finrank_span_finset_le_card finrank_span_finset_le_card

theorem finrank_range_le_card {ι : Type _} [Fintype ι] {b : ι → V} :
    (Set.range b).finrank K ≤ Fintype.card ι :=
  (finrank_span_le_card _).trans <| by
    rw [Set.toFinset_range]
    exact Finset.card_image_le
#align finrank_range_le_card finrank_range_le_card

theorem finrank_span_eq_card {ι : Type _} [Fintype ι] {b : ι → V} (hb : LinearIndependent K b) :
    finrank K (span K (Set.range b)) = Fintype.card ι :=
  finrank_eq_of_dim_eq
    (by
      have : Module.rank K (span K (Set.range b)) = (#Set.range b) := dim_span hb
      rwa [← lift_inj, mk_range_eq_of_injective hb.injective, Cardinal.mk_fintype, lift_nat_cast,
        lift_eq_nat_iff] at this)
#align finrank_span_eq_card finrank_span_eq_card

theorem finrank_span_set_eq_card (s : Set V) [Fintype s] (hs : LinearIndependent K (coe : s → V)) :
    finrank K (span K s) = s.toFinset.card :=
  finrank_eq_of_dim_eq
    (by
      have : Module.rank K (span K s) = (#s) := dim_span_set hs
      rwa [Cardinal.mk_fintype, ← Set.toFinset_card] at this)
#align finrank_span_set_eq_card finrank_span_set_eq_card

theorem finrank_span_finset_eq_card (s : Finset V) (hs : LinearIndependent K (coe : s → V)) :
    finrank K (span K (s : Set V)) = s.card :=
  by
  convert finrank_span_set_eq_card (↑s) hs
  ext
  simp
#align finrank_span_finset_eq_card finrank_span_finset_eq_card

theorem span_lt_of_subset_of_card_lt_finrank {s : Set V} [Fintype s] {t : Submodule K V}
    (subset : s ⊆ t) (card_lt : s.toFinset.card < finrank K t) : span K s < t :=
  lt_of_le_of_finrank_lt_finrank (span_le.mpr subset)
    (lt_of_le_of_lt (finrank_span_le_card _) card_lt)
#align span_lt_of_subset_of_card_lt_finrank span_lt_of_subset_of_card_lt_finrank

theorem span_lt_top_of_card_lt_finrank {s : Set V} [Fintype s]
    (card_lt : s.toFinset.card < finrank K V) : span K s < ⊤ :=
  lt_top_of_finrank_lt_finrank (lt_of_le_of_lt (finrank_span_le_card _) card_lt)
#align span_lt_top_of_card_lt_finrank span_lt_top_of_card_lt_finrank

end DivisionRing

end Span

section Basis

section DivisionRing

variable [DivisionRing K] [AddCommGroup V] [Module K V]

theorem linearIndependent_of_top_le_span_of_card_eq_finrank {ι : Type _} [Fintype ι] {b : ι → V}
    (spans : ⊤ ≤ span K (Set.range b)) (card_eq : Fintype.card ι = finrank K V) :
    LinearIndependent K b :=
  linearIndependent_iff'.mpr fun s g dependent i i_mem_s =>
    by
    by_contra gx_ne_zero
    -- We'll derive a contradiction by showing `b '' (univ \ {i})` of cardinality `n - 1`
    -- spans a vector space of dimension `n`.
    refine'
      not_le_of_gt
        (span_lt_top_of_card_lt_finrank
          (show (b '' (Set.univ \ {i})).toFinset.card < finrank K V from _))
        _
    ·
      calc
        (b '' (Set.univ \ {i})).toFinset.card = ((Set.univ \ {i}).toFinset.image b).card := by
          rw [Set.toFinset_card, Fintype.card_ofFinset]
        _ ≤ (Set.univ \ {i}).toFinset.card := Finset.card_image_le
        _ = (finset.univ.erase i).card := (congr_arg Finset.card (Finset.ext (by simp [and_comm'])))
        _ < finset.univ.card := (Finset.card_erase_lt_of_mem (Finset.mem_univ i))
        _ = finrank K V := card_eq

    -- We already have that `b '' univ` spans the whole space,
    -- so we only need to show that the span of `b '' (univ \ {i})` contains each `b j`.
    refine' spans.trans (span_le.mpr _)
    rintro _ ⟨j, rfl, rfl⟩
    -- The case that `j ≠ i` is easy because `b j ∈ b '' (univ \ {i})`.
    by_cases j_eq : j = i
    swap
    · refine' subset_span ⟨j, (Set.mem_diff _).mpr ⟨Set.mem_univ _, _⟩, rfl⟩
      exact mt set.mem_singleton_iff.mp j_eq
    -- To show `b i ∈ span (b '' (univ \ {i}))`, we use that it's a weighted sum
    -- of the other `b j`s.
    rw [j_eq, SetLike.mem_coe, show b i = -((g i)⁻¹ • (s.erase i).Sum fun j => g j • b j) from _]
    · refine' neg_mem (smul_mem _ _ (sum_mem fun k hk => _))
      obtain ⟨k_ne_i, k_mem⟩ := finset.mem_erase.mp hk
      refine' smul_mem _ _ (subset_span ⟨k, _, rfl⟩)
      simpa using k_mem
    -- To show `b i` is a weighted sum of the other `b j`s, we'll rewrite this sum
    -- to have the form of the assumption `dependent`.
    apply eq_neg_of_add_eq_zero_left
    calc
      (b i + (g i)⁻¹ • (s.erase i).Sum fun j => g j • b j) =
          (g i)⁻¹ • (g i • b i + (s.erase i).Sum fun j => g j • b j) :=
        by rw [smul_add, ← mul_smul, inv_mul_cancel gx_ne_zero, one_smul]
      _ = (g i)⁻¹ • 0 := (congr_arg _ _)
      _ = 0 := smul_zero _

    -- And then it's just a bit of manipulation with finite sums.
    rwa [← Finset.insert_erase i_mem_s, Finset.sum_insert (Finset.not_mem_erase _ _)] at dependent
#align linear_independent_of_top_le_span_of_card_eq_finrank linearIndependent_of_top_le_span_of_card_eq_finrank

/-- A finite family of vectors is linearly independent if and only if
its cardinality equals the dimension of its span. -/
theorem linearIndependent_iff_card_eq_finrank_span {ι : Type _} [Fintype ι] {b : ι → V} :
    LinearIndependent K b ↔ Fintype.card ι = (Set.range b).finrank K :=
  by
  constructor
  · intro h
    exact (finrank_span_eq_card h).symm
  · intro hc
    let f := Submodule.subtype (span K (Set.range b))
    let b' : ι → span K (Set.range b) := fun i =>
      ⟨b i, mem_span.2 fun p hp => hp (Set.mem_range_self _)⟩
    have hs : ⊤ ≤ span K (Set.range b') := by
      intro x
      have h : span K (f '' Set.range b') = map f (span K (Set.range b')) := span_image f
      have hf : f '' Set.range b' = Set.range b :=
        by
        ext x
        simp [Set.mem_image, Set.mem_range]
      rw [hf] at h
      have hx : (x : V) ∈ span K (Set.range b) := x.property
      conv at hx =>
        congr
        skip
        rw [h]
      simpa [mem_map] using hx
    have hi : f.ker = ⊥ := ker_subtype _
    convert(linearIndependent_of_top_le_span_of_card_eq_finrank hs hc).map' _ hi
#align linear_independent_iff_card_eq_finrank_span linearIndependent_iff_card_eq_finrank_span

theorem linearIndependent_iff_card_le_finrank_span {ι : Type _} [Fintype ι] {b : ι → V} :
    LinearIndependent K b ↔ Fintype.card ι ≤ (Set.range b).finrank K := by
  rw [linearIndependent_iff_card_eq_finrank_span, finrank_range_le_card.le_iff_eq]
#align linear_independent_iff_card_le_finrank_span linearIndependent_iff_card_le_finrank_span

/-- A family of `finrank K V` vectors forms a basis if they span the whole space. -/
noncomputable def basisOfTopLeSpanOfCardEqFinrank {ι : Type _} [Fintype ι] (b : ι → V)
    (le_span : ⊤ ≤ span K (Set.range b)) (card_eq : Fintype.card ι = finrank K V) : Basis ι K V :=
  Basis.mk (linearIndependent_of_top_le_span_of_card_eq_finrank le_span card_eq) le_span
#align basis_of_top_le_span_of_card_eq_finrank basisOfTopLeSpanOfCardEqFinrank

@[simp]
theorem coe_basisOfTopLeSpanOfCardEqFinrank {ι : Type _} [Fintype ι] (b : ι → V)
    (le_span : ⊤ ≤ span K (Set.range b)) (card_eq : Fintype.card ι = finrank K V) :
    ⇑(basisOfTopLeSpanOfCardEqFinrank b le_span card_eq) = b :=
  Basis.coe_mk _ _
#align coe_basis_of_top_le_span_of_card_eq_finrank coe_basisOfTopLeSpanOfCardEqFinrank

/-- A finset of `finrank K V` vectors forms a basis if they span the whole space. -/
@[simps]
noncomputable def finsetBasisOfTopLeSpanOfCardEqFinrank {s : Finset V}
    (le_span : ⊤ ≤ span K (s : Set V)) (card_eq : s.card = finrank K V) : Basis (s : Set V) K V :=
  basisOfTopLeSpanOfCardEqFinrank (coe : (s : Set V) → V)
    ((@Subtype.range_coe_subtype _ fun x => x ∈ s).symm ▸ le_span)
    (trans (Fintype.card_coe _) card_eq)
#align finset_basis_of_top_le_span_of_card_eq_finrank finsetBasisOfTopLeSpanOfCardEqFinrank

/-- A set of `finrank K V` vectors forms a basis if they span the whole space. -/
@[simps]
noncomputable def setBasisOfTopLeSpanOfCardEqFinrank {s : Set V} [Fintype s]
    (le_span : ⊤ ≤ span K s) (card_eq : s.toFinset.card = finrank K V) : Basis s K V :=
  basisOfTopLeSpanOfCardEqFinrank (coe : s → V) ((@Subtype.range_coe_subtype _ s).symm ▸ le_span)
    (trans s.toFinset_card.symm card_eq)
#align set_basis_of_top_le_span_of_card_eq_finrank setBasisOfTopLeSpanOfCardEqFinrank

end DivisionRing

end Basis

/-!
We now give characterisations of `finrank K V = 1` and `finrank K V ≤ 1`.
-/

section finrank_eq_one

variable [DivisionRing K] [AddCommGroup V] [Module K V]

/-- If there is a nonzero vector and every other vector is a multiple of it,
then the module has dimension one. -/
theorem finrank_eq_one (v : V) (n : v ≠ 0) (h : ∀ w : V, ∃ c : K, c • v = w) : finrank K V = 1 :=
  by
  obtain ⟨b⟩ := (Basis.basis_singleton_iff PUnit).mpr ⟨v, n, h⟩
  rw [finrank_eq_card_basis b, Fintype.card_punit]
#align finrank_eq_one finrank_eq_one

/-- If every vector is a multiple of some `v : V`, then `V` has dimension at most one.
-/
theorem finrank_le_one (v : V) (h : ∀ w : V, ∃ c : K, c • v = w) : finrank K V ≤ 1 :=
  by
  rcases eq_or_ne v 0 with (rfl | hn)
  · haveI :=
      subsingleton_of_forall_eq (0 : V) fun w =>
        by
        obtain ⟨c, rfl⟩ := h w
        simp
    rw [finrank_zero_of_subsingleton]
    exact zero_le_one
  · exact (finrank_eq_one v hn h).le
#align finrank_le_one finrank_le_one

end finrank_eq_one

section SubalgebraDim

open Module

variable {F E : Type _} [Field F] [Ring E] [Algebra F E]

@[simp]
theorem Subalgebra.dim_bot [Nontrivial E] : Module.rank F (⊥ : Subalgebra F E) = 1 :=
  ((Subalgebra.toSubmoduleEquiv (⊥ : Subalgebra F E)).symm.trans <|
          LinearEquiv.ofEq _ _ Algebra.toSubmodule_bot).dim_eq.trans <|
    by
    rw [dim_span_set]
    exacts[mk_singleton _, linearIndependent_singleton one_ne_zero]
#align subalgebra.dim_bot Subalgebra.dim_bot

@[simp]
theorem Subalgebra.dim_toSubmodule (S : Subalgebra F E) :
    Module.rank F S.toSubmodule = Module.rank F S :=
  rfl
#align subalgebra.dim_to_submodule Subalgebra.dim_toSubmodule

@[simp]
theorem Subalgebra.finrank_toSubmodule (S : Subalgebra F E) :
    finrank F S.toSubmodule = finrank F S :=
  rfl
#align subalgebra.finrank_to_submodule Subalgebra.finrank_toSubmodule

theorem subalgebra_top_dim_eq_submodule_top_dim :
    Module.rank F (⊤ : Subalgebra F E) = Module.rank F (⊤ : Submodule F E) :=
  by
  rw [← Algebra.top_toSubmodule]
  rfl
#align subalgebra_top_dim_eq_submodule_top_dim subalgebra_top_dim_eq_submodule_top_dim

theorem subalgebra_top_finrank_eq_submodule_top_finrank :
    finrank F (⊤ : Subalgebra F E) = finrank F (⊤ : Submodule F E) :=
  by
  rw [← Algebra.top_toSubmodule]
  rfl
#align subalgebra_top_finrank_eq_submodule_top_finrank subalgebra_top_finrank_eq_submodule_top_finrank

theorem Subalgebra.dim_top : Module.rank F (⊤ : Subalgebra F E) = Module.rank F E :=
  by
  rw [subalgebra_top_dim_eq_submodule_top_dim]
  exact dim_top F E
#align subalgebra.dim_top Subalgebra.dim_top

@[simp]
theorem Subalgebra.finrank_bot [Nontrivial E] : finrank F (⊥ : Subalgebra F E) = 1 :=
  finrank_eq_of_dim_eq (by simp)
#align subalgebra.finrank_bot Subalgebra.finrank_bot

end SubalgebraDim


prelude
import Init.Data.List.Basic

@[simp] theorem map_comp_map (f : α → β) (g : β → γ) : List.map g ∘ List.map f = List.map (g ∘ f) :=
  sorry

theorem map_map (f : α → β) (g : β → γ) (xs : List α) : (xs.map f |>.map g) = xs.map (g ∘ f) :=
  sorry

theorem ex1 (f : Nat → Nat) (xs : List Nat) : (xs.map f |>.map f) = xs.map (f ∘ f) := by
  simp
  simp [map_map]
  done

theorem ex2 (f : Nat → Nat) : List.map f ∘ List.map f ∘ List.map f = List.map (f ∘ f ∘ f) := by
  simp

attribute [simp] map_map

theorem ex3 (f : Nat → Nat) (xs : List Nat) : (xs.map f |>.map f |>.map f) = xs.map (fun x => f (f (f x))) := by
  simp


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

import data.set.image

/-!
### Recursion on the natural numbers and `set.range`

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

namespace nat
section set

open set

theorem zero_union_range_succ : {0} ∪ range succ = univ :=
by { ext n, cases n; simp }

@[simp] protected lemma range_succ : range succ = {i | 0 < i} :=
by ext (_ | i); simp [succ_pos, succ_ne_zero]

variables {α : Type*}

theorem range_of_succ (f : ℕ → α) : {f 0} ∪ range (f ∘ succ) = range f :=
by rw [← image_singleton, range_comp, ← image_union, zero_union_range_succ, image_univ]

theorem range_rec {α : Type*} (x : α) (f : ℕ → α → α) :
  (set.range (λ n, nat.rec x f n) : set α) =
    {x} ∪ set.range (λ n, nat.rec (f 0 x) (f ∘ succ) n) :=
begin
  convert (range_of_succ _).symm,
  ext n,
  induction n with n ihn,
  { refl },
  { dsimp at ihn ⊢,
    rw ihn }
end

theorem range_cases_on {α : Type*} (x : α) (f : ℕ → α) :
  (set.range (λ n, nat.cases_on n x f) : set α) = {x} ∪ set.range f :=
(range_of_succ _).symm

end set
end nat