/-
Copyright (c) 2021 Gabriel Moise. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Moise, Yaël Dillies, Kyle Miller

! This file was ported from Lean 3 source module combinatorics.simple_graph.inc_matrix
! leanprover-community/mathlib commit bb168510ef455e9280a152e7f31673cabd3d7496
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.SimpleGraph.Basic
import Mathbin.Data.Matrix.Basic

/-!
# Incidence matrix of a simple graph

This file defines the unoriented incidence matrix of a simple graph.

## Main definitions

* `simple_graph.inc_matrix`: `G.inc_matrix R` is the incidence matrix of `G` over the ring `R`.

## Main results

* `simple_graph.inc_matrix_mul_transpose_diag`: The diagonal entries of the product of
  `G.inc_matrix R` and its transpose are the degrees of the vertices.
* `simple_graph.inc_matrix_mul_transpose`: Gives a complete description of the product of
  `G.inc_matrix R` and its transpose; the diagonal is the degrees of each vertex, and the
  off-diagonals are 1 or 0 depending on whether or not the vertices are adjacent.
* `simple_graph.inc_matrix_transpose_mul_diag`: The diagonal entries of the product of the
  transpose of `G.inc_matrix R` and `G.inc_matrix R` are `2` or `0` depending on whether or
  not the unordered pair is an edge of `G`.

## Implementation notes

The usual definition of an incidence matrix has one row per vertex and one column per edge.
However, this definition has columns indexed by all of `sym2 α`, where `α` is the vertex type.
This appears not to change the theory, and for simple graphs it has the nice effect that every
incidence matrix for each `simple_graph α` has the same type.

## TODO

* Define the oriented incidence matrices for oriented graphs.
* Define the graph Laplacian of a simple graph using the oriented incidence matrix from an
  arbitrary orientation of a simple graph.
-/

open Finset Matrix SimpleGraph Sym2

open BigOperators Matrix

namespace SimpleGraph

variable (R : Type _) {α : Type _} (G : SimpleGraph α)

/-- `G.inc_matrix R` is the `α × sym2 α` matrix whose `(a, e)`-entry is `1` if `e` is incident to
`a` and `0` otherwise. -/
noncomputable def incMatrix [Zero R] [One R] : Matrix α (Sym2 α) R := fun a =>
  (G.incidenceSet a).indicator 1
#align simple_graph.inc_matrix SimpleGraph.incMatrix

variable {R}

theorem incMatrix_apply [Zero R] [One R] {a : α} {e : Sym2 α} :
    G.incMatrix R a e = (G.incidenceSet a).indicator 1 e :=
  rfl
#align simple_graph.inc_matrix_apply SimpleGraph.incMatrix_apply

/-- Entries of the incidence matrix can be computed given additional decidable instances. -/
theorem incMatrix_apply' [Zero R] [One R] [DecidableEq α] [DecidableRel G.Adj] {a : α}
    {e : Sym2 α} : G.incMatrix R a e = if e ∈ G.incidenceSet a then 1 else 0 := by convert rfl
#align simple_graph.inc_matrix_apply' SimpleGraph.incMatrix_apply'

section MulZeroOneClass

variable [MulZeroOneClass R] {a b : α} {e : Sym2 α}

theorem incMatrix_apply_mul_incMatrix_apply :
    G.incMatrix R a e * G.incMatrix R b e = (G.incidenceSet a ∩ G.incidenceSet b).indicator 1 e :=
  by
  classical simp only [inc_matrix, Set.indicator_apply, ← ite_and_mul_zero, Pi.one_apply, mul_one,
      Set.mem_inter_iff]
#align simple_graph.inc_matrix_apply_mul_inc_matrix_apply SimpleGraph.incMatrix_apply_mul_incMatrix_apply

theorem incMatrix_apply_mul_incMatrix_apply_of_not_adj (hab : a ≠ b) (h : ¬G.Adj a b) :
    G.incMatrix R a e * G.incMatrix R b e = 0 :=
  by
  rw [inc_matrix_apply_mul_inc_matrix_apply, Set.indicator_of_not_mem]
  rw [G.incidence_set_inter_incidence_set_of_not_adj h hab]
  exact Set.not_mem_empty e
#align simple_graph.inc_matrix_apply_mul_inc_matrix_apply_of_not_adj SimpleGraph.incMatrix_apply_mul_incMatrix_apply_of_not_adj

theorem incMatrix_of_not_mem_incidenceSet (h : e ∉ G.incidenceSet a) : G.incMatrix R a e = 0 := by
  rw [inc_matrix_apply, Set.indicator_of_not_mem h]
#align simple_graph.inc_matrix_of_not_mem_incidence_set SimpleGraph.incMatrix_of_not_mem_incidenceSet

theorem incMatrix_of_mem_incidenceSet (h : e ∈ G.incidenceSet a) : G.incMatrix R a e = 1 := by
  rw [inc_matrix_apply, Set.indicator_of_mem h, Pi.one_apply]
#align simple_graph.inc_matrix_of_mem_incidence_set SimpleGraph.incMatrix_of_mem_incidenceSet

variable [Nontrivial R]

theorem incMatrix_apply_eq_zero_iff : G.incMatrix R a e = 0 ↔ e ∉ G.incidenceSet a :=
  by
  simp only [inc_matrix_apply, Set.indicator_apply_eq_zero, Pi.one_apply, one_ne_zero]
  exact Iff.rfl
#align simple_graph.inc_matrix_apply_eq_zero_iff SimpleGraph.incMatrix_apply_eq_zero_iff

theorem incMatrix_apply_eq_one_iff : G.incMatrix R a e = 1 ↔ e ∈ G.incidenceSet a :=
  by
  convert one_ne_zero.ite_eq_left_iff
  infer_instance
#align simple_graph.inc_matrix_apply_eq_one_iff SimpleGraph.incMatrix_apply_eq_one_iff

end MulZeroOneClass

section NonAssocSemiring

variable [Fintype α] [NonAssocSemiring R] {a b : α} {e : Sym2 α}

theorem sum_incMatrix_apply [DecidableEq α] [DecidableRel G.Adj] :
    (∑ e, G.incMatrix R a e) = G.degree a := by
  simp [inc_matrix_apply', sum_boole, Set.filter_mem_univ_eq_toFinset]
#align simple_graph.sum_inc_matrix_apply SimpleGraph.sum_incMatrix_apply

theorem incMatrix_mul_transpose_diag [DecidableEq α] [DecidableRel G.Adj] :
    (G.incMatrix R ⬝ (G.incMatrix R)ᵀ) a a = G.degree a :=
  by
  rw [← sum_inc_matrix_apply]
  simp [Matrix.mul_apply, inc_matrix_apply', ← ite_and_mul_zero]
#align simple_graph.inc_matrix_mul_transpose_diag SimpleGraph.incMatrix_mul_transpose_diag

theorem sum_incMatrix_apply_of_mem_edgeSetEmbedding :
    e ∈ G.edgeSetEmbedding → (∑ a, G.incMatrix R a e) = 2 := by
  classical
    refine' e.ind _
    intro a b h
    rw [mem_edge_set] at h
    rw [← Nat.cast_two, ← card_doubleton h.ne]
    simp only [inc_matrix_apply', sum_boole, mk_mem_incidence_set_iff, h, true_and_iff]
    congr 2
    ext e
    simp only [mem_filter, mem_univ, true_and_iff, mem_insert, mem_singleton]
#align simple_graph.sum_inc_matrix_apply_of_mem_edge_set SimpleGraph.sum_incMatrix_apply_of_mem_edgeSetEmbedding

theorem sum_incMatrix_apply_of_not_mem_edgeSetEmbedding (h : e ∉ G.edgeSetEmbedding) :
    (∑ a, G.incMatrix R a e) = 0 :=
  sum_eq_zero fun a _ => G.incMatrix_of_not_mem_incidenceSet fun he => h he.1
#align simple_graph.sum_inc_matrix_apply_of_not_mem_edge_set SimpleGraph.sum_incMatrix_apply_of_not_mem_edgeSetEmbedding

theorem incMatrix_transpose_mul_diag [DecidableRel G.Adj] :
    ((G.incMatrix R)ᵀ ⬝ G.incMatrix R) e e = if e ∈ G.edgeSetEmbedding then 2 else 0 := by
  classical
    simp only [Matrix.mul_apply, inc_matrix_apply', transpose_apply, ← ite_and_mul_zero, one_mul,
      sum_boole, and_self_iff]
    split_ifs with h
    · revert h
      refine' e.ind _
      intro v w h
      rw [← Nat.cast_two, ← card_doubleton (G.ne_of_adj h)]
      simp [mk_mem_incidence_set_iff, G.mem_edge_set.mp h]
      congr 2
      ext u
      simp
    · revert h
      refine' e.ind _
      intro v w h
      simp [mk_mem_incidence_set_iff, G.mem_edge_set.not.mp h]
#align simple_graph.inc_matrix_transpose_mul_diag SimpleGraph.incMatrix_transpose_mul_diag

end NonAssocSemiring

section Semiring

variable [Fintype (Sym2 α)] [Semiring R] {a b : α} {e : Sym2 α}

theorem incMatrix_mul_transpose_apply_of_adj (h : G.Adj a b) :
    (G.incMatrix R ⬝ (G.incMatrix R)ᵀ) a b = (1 : R) := by
  classical
    simp_rw [Matrix.mul_apply, Matrix.transpose_apply, inc_matrix_apply_mul_inc_matrix_apply,
      Set.indicator_apply, Pi.one_apply, sum_boole]
    convert Nat.cast_one
    convert card_singleton ⟦(a, b)⟧
    rw [← coe_eq_singleton, coe_filter_univ]
    exact G.incidence_set_inter_incidence_set_of_adj h
#align simple_graph.inc_matrix_mul_transpose_apply_of_adj SimpleGraph.incMatrix_mul_transpose_apply_of_adj

theorem incMatrix_mul_transpose [Fintype α] [DecidableEq α] [DecidableRel G.Adj] :
    G.incMatrix R ⬝ (G.incMatrix R)ᵀ = fun a b =>
      if a = b then G.degree a else if G.Adj a b then 1 else 0 :=
  by
  ext (a b)
  split_ifs with h h'
  · subst b
    convert G.inc_matrix_mul_transpose_diag
  · exact G.inc_matrix_mul_transpose_apply_of_adj h'
  ·
    simp only [Matrix.mul_apply, Matrix.transpose_apply,
      G.inc_matrix_apply_mul_inc_matrix_apply_of_not_adj h h', sum_const_zero]
#align simple_graph.inc_matrix_mul_transpose SimpleGraph.incMatrix_mul_transpose

end Semiring

end SimpleGraph


import tactic
import .num_lemmas .set .single finsum.fin_api  .induction

open_locale classical big_operators
noncomputable theory

universes u v w

/-!
This file contains an API for `size`, which is the noncomputable function assigning each finite
set to its size as an integer, and each infinite set to zero. Also `type_size` is defined similarly
for types. Most lemmas are only true in a finite setting, and have two versions, one with explicit
finiteness assumptions, and one in which they are derived from a `fintype` instance . Lemmas of the
former type are usually less useful for us, and go in the `finite` namespace.
-/

section defs

/-- The size of a set, as an integer. Zero if the set is infinite -/
def size {α : Type*} (s : set α) : ℤ := (fincard s)

/-- The size of a type, as an integer. Zero if the type is infinite -/
def type_size (α : Type* ) : ℤ := size (set.univ : set α)

end defs

/-! Basic lemmas about size.  -/

section basic

variables {α : Type*} {s t : set α} {e f : α}

lemma size_def (s : set α) :
  size s = fincard s :=
rfl

lemma type_size_eq (α : Type*) : type_size α = size (set.univ : set α) := rfl

lemma type_size_eq_fincard_t (α : Type*) : type_size α = fincard_t α :=
by {rw [type_size, size_def], norm_num, refl,  }

lemma type_size_coe_set_eq_size (s : set α) :
  type_size s = size s :=
by rw [type_size_eq_fincard_t, size, fincard_t_subtype_eq_fincard]

lemma type_size_type_of_eq_size_set_of (P : α → Prop):
  type_size {x // P x} = size {x | P x} :=
type_size_coe_set_eq_size P

@[simp] lemma size_empty (α : Type*) : size (∅ : set α) = 0 :=
by simp [size]

@[simp] lemma size_singleton (e : α) : size ({e} : set α) = 1 :=
by simp [size]

lemma size_nonneg (s : set α) : 0 ≤ size s :=
by {simp only [size], norm_cast, apply zero_le}

lemma type_size_nonneg (α : Type*) : 0 ≤ type_size α :=
size_nonneg _

lemma size_zero_of_infinite (hs : s.infinite) :
  size s = 0 :=
by rw [size, fincard_of_infinite hs, int.coe_nat_zero]

lemma finite_of_size_pos (hs : 0 < size s) :
  s.finite :=
by {rw size at hs, norm_num at hs, exact finite_of_fincard_pos hs, }

/-- a positive type size gives rise to a fintype -/
def fintype_of_type_size_pos {α : Type*} (hα : 0 < type_size α) :
  fintype α :=
set.fintype_of_univ_finite (by {rw [type_size_eq] at hα, exact finite_of_size_pos hα,})

lemma nonempty_of_size_pos (hs : 0 < size s) :
  s.nonempty :=
by {rw ← set.ne_empty_iff_nonempty, rintro rfl, linarith [size_empty α], }

lemma nonempty_of_type_size_pos (hα : 0 < type_size α):
  nonempty α :=
by {rw set.nonempty_iff_univ_nonempty, rw type_size_eq at hα, exact nonempty_of_size_pos hα, }

lemma contains_singleton {s : set α} : s.nonempty → (∃ t, t ⊆ s ∧ size t = 1) :=
λ ⟨e,he⟩, ⟨{e},⟨set.singleton_subset_iff.mpr he, size_singleton e⟩⟩

lemma exists_mem_of_size_pos (h : 0 < size s) :
  ∃ e, e ∈ s :=
(ne_empty_iff_has_mem.mp (λ hs, lt_irrefl _ (by {rwa [hs, size_empty] at h})))

@[simp] lemma finsum_ones_eq_size (s : set α) :
  ∑ᶠ x in s, (1 : ℤ) = size s :=
by {rw [size, fincard, nat.coe_int_distrib_finsum_in], refl}

@[simp] lemma finsum_ones_eq_type_size (α : Type*) :
  ∑ᶠ (x : α), (1 : ℤ) = type_size α :=
by {rw [finsum_eq_finsum_in_univ, finsum_ones_eq_size], refl}

lemma size_set_of_eq_size_subtype (P : α → Prop):
  size {x | P x} = type_size {x // P x} :=
by rw [← finsum_ones_eq_size, ← finsum_ones_eq_type_size, ← finsum_subtype_eq_finsum_in_set_of]

lemma size_set_of_push (P Q : α → Prop) :
  size {x : {y // P y} | Q (x : α)} = size { x | P x ∧ Q x } :=
by {rw [← finsum_ones_eq_size, ← finsum_ones_eq_size],
    convert finsum_set_subtype_eq_finsum_set (1 : α → ℤ) P Q,  }

end basic

/-! The lemmas in this section are true without any finiteness assumptions -/
section general

variables {α : Type*} {s t : set α} {e f : α}

lemma size_one_iff_eq_singleton :
  size s = 1 ↔ ∃ e, s = {e} :=
begin
  refine ⟨λ h, _, λ h, _⟩, swap,
    cases h with e he, rw he, apply size_singleton,

  have hs := finite_of_size_pos (by linarith : 0 < size s),
  obtain ⟨e,he⟩ := exists_mem_of_size_pos (by linarith : 0 < size s),
  use e,
  ext,
  simp only [set.mem_singleton_iff],
  refine ⟨λ h', _, λ h', by {rwa ← h' at he}⟩,
  rw ← finsum_ones_eq_size at h,
  have hs' := finsum_in_subset_le_finsum_in_of_nonneg hs
    (_ : {e,x} ⊆ s) (λ x hx, (by norm_num: (0 : ℤ ) ≤ 1)),
  { by_contra hxe,
    rw [finsum_pair (ne.symm hxe), h, add_le_iff_nonpos_right] at hs',
    norm_num at hs'},
  rw ← set.singleton_subset_iff at he h',
  convert set.union_subset he h',
end

lemma eq_of_mems_size_one (hs : size s = 1) (he : e ∈ s) (hf : f ∈ s):
  e = f :=
begin
  obtain ⟨x, rfl⟩ := size_one_iff_eq_singleton.mp hs,
  rw set.mem_singleton_iff at he hf,
  rw [he,hf],
end

lemma size_pair (hef : e ≠ f) :
  size ({e,f} : set α) = 2 :=
by {rw [← finsum_ones_eq_size, finsum_pair hef], refl}

end general

/-! Lemmas about the relationship between size and finsumming ones -/

section sums

variables {α : Type*}

@[simp] lemma int.finsum_const_eq_mul_type_size (α : Type*) (b : ℤ) :
  ∑ᶠ (x : α), b = b * type_size α :=
by rw [← mul_one b, ← finsum_ones_eq_type_size, ← mul_distrib_finsum, mul_one]

@[simp] lemma int.finsum_in_const_eq_mul_size (s : set α) (b : ℤ) :
  ∑ᶠ x in s, b = b * size s :=
by rw [← mul_one b, ← finsum_ones_eq_size, ← mul_distrib_finsum_in, mul_one]

lemma finite.sum_size_fiber_eq_size {ι : Type*} {s : set α} (hs : s.finite) (f : α → ι) :
  ∑ᶠ (i : ι), size {a ∈ s | f a = i} = size s :=
by simp_rw [size_def, ← nat.coe_int_distrib_finsum, sum_fincard_fiber_eq_fincard f hs]

lemma size_set_subtype_eq_size_set (P Q : α → Prop) :
  size {x : {y // P y} | Q (coe x)} = size { x | P x ∧ Q x } :=
by {simp_rw ← finsum_ones_eq_size, apply finsum_set_subtype_eq_finsum_set (1 : α → ℤ)}

end sums

/-!
This section contains lemmas that require finiteness of sets to be true. These versions
all have explicit set.finite assumptions; the versions that use an instance are later.
-/

section finite

variables {α : Type*} {s t : set α} {e f : α}

open set

namespace set.finite

lemma size_modular (s t : set α) (hs : s.finite) (ht : t.finite) :
  size (s ∪ t) + size (s ∩ t) = size s + size t :=
by {simp_rw size, norm_cast, apply fincard_modular; assumption}

lemma size_union (s t : set α) (hs : s.finite) (ht : t.finite) :
  size (s ∪ t) = size s + size t - size (s ∩ t) :=
by linarith [size_modular s t hs ht]

lemma size_monotone (ht : t.finite) (hst : s ⊆ t) : size s ≤ size t :=
begin
  have hs := subset ht hst,
  have := size_modular s (t \ s) hs (ht.diff s),
  rw [union_diff_of_subset hst, inter_diff] at this,
  linarith [size_nonneg (t \ s), size_empty α],
end

lemma ssubset_size (hs : s.finite) (ht : t.finite) (hst : s ⊆ t) (hst' : size s < size t) :
  s ⊂ t :=
by {rw set.ssubset_iff_subset_ne, from ⟨hst, λ hn, by {rw hn at hst', exact lt_irrefl _ hst'}⟩}

lemma size_subadditive (hs : s.finite) (ht : t.finite) : size (s ∪ t) ≤ size s + size t :=
  by linarith [size_modular s t hs ht, size_nonneg (s ∩ t)]

lemma compl_inter_size (s t : set α) (ht : t.finite) :
  size (s ∩ t) + size (sᶜ ∩ t) = size t :=
by {rw [←size_modular, ←inter_distrib_right, union_compl_self, univ_inter,
  ←inter_distrib_inter_left, inter_compl_self, empty_inter, size_empty, add_zero];
  exact inter_right (by assumption) _, }

lemma compl_inter_size_subset (ht : t.finite) (hst : s ⊆ t) :
  size (sᶜ ∩ t) = size t - size s :=
by {have := compl_inter_size s t ht, rw subset_iff_inter_eq_left.mp hst at this, linarith}

lemma diff_size (ht : t.finite) (hst : s ⊆ t) : size (t \ s) = size t - size s :=
by rw [diff_eq, inter_comm, compl_inter_size_subset ht hst]

lemma size_diff_le_size (s t : set α) (hs : s.finite) : size (s \ t) ≤ size s :=
  size_monotone hs (diff_subset _ _)
-- the above lemma is also true if just `s ∩ t` is finite

lemma size_union_of_inter_empty (hs : s.finite) (ht : t.finite) (hst : s ∩ t = ∅) :
  size (s ∪ t) = size s + size t :=
by {have := size_modular s t hs ht, rw [hst, size_empty] at this, linarith}

lemma size_union_of_disjoint (hs : s.finite) (ht : t.finite) (hst : disjoint s t) :
  size (s ∪ t) = size s + size t :=
size_union_of_inter_empty hs ht (disjoint_iff_inter_eq_empty.mp hst)

lemma size_modular_diff (s t : set α) (hs : s.finite) (ht : t.finite) :
  size (s ∪ t) = size (s \ t) + size (t \ s) + size (s ∩ t) :=
begin
  rw [←size_union_of_inter_empty _ _ (inter_diffs_eq_empty s t)],
  { have := (symm_diff_alt s t),
    unfold symm_diff at this,
    rw this,
    linarith [diff_size (union hs ht) (inter_subset_union s t)]},
  repeat {apply diff, assumption},
end

lemma size_induced_partition (s t : set α) (hs : s.finite)  :
  size s = size (s ∩ t) + size (s \ t) :=
begin
  nth_rewrite 0 ←diff_union s t,
  refine size_union_of_inter_empty (inter_left hs _) (diff hs _) (partition_inter _ _),
end

lemma size_induced_partition_inter (s t : set α) (hs : s.finite) :
  size s = size (s ∩ t) + size (s ∩ tᶜ) :=
by {rw ←diff_eq, apply size_induced_partition _ _ hs, }

lemma size_mono_inter_left (s t : set α) (hs : s.finite) : size (s ∩ t) ≤ size s :=
size_monotone hs (inter_subset_left _ _)

lemma size_mono_inter_right (s t : set α) (ht : t.finite) : size (s ∩ t) ≤ size t :=
size_monotone ht (inter_subset_right _ _)

lemma size_mono_union_left (s t : set α) (ht : t.finite) : size s ≤ size (s ∪ t)  :=
begin
  by_cases hs : s.finite,
  apply size_monotone (union hs ht) (subset_union_left _ _),
  rw [size_zero_of_infinite hs, size_zero_of_infinite],
  exact infinite_mono (subset_union_left _ _) hs,
end

lemma size_mono_union_right (s t : set α) (hs : s.finite) : size t ≤ size (s ∪ t) :=
by {rw union_comm, apply size_mono_union_left _ _ hs}

lemma empty_of_size_zero (hs : s.finite) (hsize : size s = 0) : s = ∅ :=
begin
  rw eq_empty_iff_forall_not_mem, intros x hx,
  have h' := size_monotone hs (singleton_subset_iff.mpr hx),
  rw [hsize, size_singleton] at h',
  linarith,
end

lemma size_zero_iff_empty (hs : s.finite) : (size s = 0) ↔ (s = ∅) :=
  by {split, apply empty_of_size_zero hs, intros h, rw h, exact size_empty α}

lemma size_le_zero_iff_eq_empty (hs : s.finite) :
  size s ≤ 0 ↔ s = ∅ :=
by {rw [← size_zero_iff_empty hs], exact ⟨λ h, le_antisymm h (size_nonneg _), λ h, le_of_eq h⟩}

lemma size_nonempty (hs : s.finite) (hne : s.nonempty) : 0 < size s  :=
begin
  suffices h' : 0 ≠ size s, exact lt_of_le_of_ne (size_nonneg _) h',
  rw [←set.ne_empty_iff_nonempty] at hne,
  exact λ h, hne (empty_of_size_zero hs h.symm),
end

lemma nonempty_iff_size_pos (hs : s.finite) : s.nonempty ↔ 0 < size s :=
begin
  refine ⟨λ h, size_nonempty hs h, λ h, _⟩,
  rw ←set.ne_empty_iff_nonempty,
  exact λ h', by {rw [h', size_empty] at h, from lt_irrefl 0 h},
end

lemma one_le_size_iff_nonempty (hs : s.finite) : s.nonempty ↔ 1 ≤ size s :=
  nonempty_iff_size_pos hs

lemma one_le_size_of_nonempty (hs : s.nonempty) (hs' : s.finite) : 1 ≤ size s :=
  (one_le_size_iff_nonempty hs').mp hs

lemma size_strict_monotone (ht : t.finite) (hst : s ⊂ t) : size s < size t :=
begin
  rw [size_induced_partition t s ht, inter_comm, subset_iff_inter_eq_left.mp hst.1],
  linarith [size_nonempty (diff ht _) (ssubset_diff_nonempty hst)],
end

lemma eq_of_eq_size_subset (ht : t.finite) (hst : s ⊆ t) (hsize : size s = size t) :
  s = t :=
begin
  unfreezingI {rcases subset_ssubset_or_eq hst with (hst' | rfl)},
    swap, refl,
  have := size_strict_monotone ht hst', rw hsize at this,
  exact false.elim (lt_irrefl _ this),
end

lemma eq_of_eq_size_subset_iff (ht : t.finite) (hst : s ⊆ t) :
  ((size s = size t) ↔ s = t) :=
⟨λ h, eq_of_eq_size_subset ht hst h, λ h, by {rw h}⟩

lemma eq_of_le_size_subset (ht : t.finite) (hst : s ⊆ t) (hsize : size t ≤ size s) :
  s = t :=
by {apply eq_of_eq_size_subset ht hst, exact le_antisymm (size_monotone ht hst) hsize}

lemma size_eq_of_supset (ht : t.finite) (hst : s ⊆ t) (hsize : size t ≤ size s) :
  size s = size t :=
by linarith [size_monotone ht hst]

lemma size_pos_iff_has_mem (hs : s.finite) :
  0 < size s ↔ ∃ e, e ∈ s :=
by rw [← nonempty_iff_size_pos hs, set.nonempty_def]

lemma one_le_size_iff_has_mem (hs : s.finite) :
  1 ≤ size s ↔ ∃ e, e ∈ s :=
by {convert size_pos_iff_has_mem hs}

lemma size_zero_iff_has_no_mem (hs : s.finite) :
  size s = 0 ↔ ¬ ∃ e, e ∈ s :=
begin
  rw [iff.comm, ←not_iff, ←(size_pos_iff_has_mem hs), not_iff],
  refine ⟨λ h, _, λ h, by linarith ⟩ ,
  linarith [size_nonneg s, not_lt.mp h],
end

lemma size_le_zero_iff_has_no_mem (hs : s.finite) :
  size s ≤ 0 ↔ ¬ ∃ e, e ∈ s :=
by {rw ←(size_zero_iff_has_no_mem hs), split, { intro, linarith [size_nonneg s]}, intro h, rw h}

lemma mem_diff_of_size_lt (hs : s.finite) (hst : size s < size t) :
  ∃ (e : α), e ∈ t ∧ e ∉ s :=
begin
  suffices h' : 0 < size (t \ s),
    obtain ⟨e, he⟩ := exists_mem_of_size_pos h', tauto,
  have ht := finite_of_size_pos (lt_of_le_of_lt (size_nonneg _) hst),
  linarith [size_induced_partition t s ht, size_mono_inter_right t s hs],
end

lemma size_union_singleton_compl (hs : s.finite) (hes : e ∈ sᶜ) :
  size (s ∪ {e}) = size s + 1 :=
begin
  have := size_modular s {e} hs (finite_singleton e),
  rwa [inter_comm s, nonmem_disjoint (by rwa ←mem_compl_iff), size_singleton,
  size_empty, add_zero] at this,
end

lemma size_union_nonmem_singleton (hs : s.finite) (he : e ∉ s) :
  size (s ∪ {e}) = size s + 1 :=
by {apply size_union_singleton_compl hs, rwa ←mem_compl_iff at he, }

lemma size_insert_nonmem (hs : s.finite) (he : e ∉ s) :
  size (has_insert.insert e s) = size s + 1 :=
by {convert size_union_nonmem_singleton hs he, rw union_singleton}

lemma size_remove_mem (hs : s.finite) (he : e ∈ s) :
  size (s \ {e}) = size s - 1 :=
begin
  have h' : has_insert.insert e (s \ {e}) = s,
  { ext, simp, rintro rfl, assumption},
  nth_rewrite 1 ← h',
  rw [size_insert_nonmem],
    ring,
  apply diff hs _,
  simp,
end

lemma has_sub_one_size_ssubset_of_ne_empty (hs : s.finite) (hne : s ≠ ∅) :
  ∃ t, t ⊂ s ∧ size t = size s - 1 :=
by {cases ne_empty_has_mem hne with e he,
exact ⟨s \ {e}, ⟨ssubset_of_remove_mem he, size_remove_mem hs he⟩ ⟩}

lemma has_sub_one_size_ssubset_of_nonempty (hs : s.finite) (hne : s.nonempty) :
  ∃ t, t ⊂ s ∧ size t = size s - 1 :=
has_sub_one_size_ssubset_of_ne_empty hs (ne_empty_iff_nonempty.mpr hne)

lemma ne_univ_has_add_one_size_ssupset (hs : s.finite) (hne : s ≠ univ) :
  ∃ t, s ⊂ t ∧ size t = size s + 1 :=
let ⟨e,he⟩ := ne_univ_iff_has_nonmem.mp hne in
  ⟨has_insert.insert e s, ssubset_insert he, size_insert_nonmem hs he⟩

lemma ne_univ_has_add_one_size_ssupset_element (hs : s.finite) (hne : s ≠ univ) :
  ∃ e, s ⊂ s ∪ {e} ∧ size (s ∪ {e}) = size s + 1 :=
let ⟨e,he⟩ := ne_univ_iff_has_nonmem.mp hne in
   ⟨e, by {rw union_singleton, exact ssubset_insert he}, size_union_nonmem_singleton hs he⟩

lemma eq_or_exists_mem_diff_of_size_eq (ht : t.finite) (hst : size s = size t) :
  s = t ∨ ∃ e, e ∈ s \ t :=
begin
  by_contra h, rw not_or_distrib at h, cases h with h1 h2,
  rw ←ne_empty_iff_has_mem at h2, push_neg at h2,
  rw diff_empty_iff_subset at h2,
  refine h1 (eq_of_eq_size_subset ht h2 hst),
end

lemma size_le_one_iff_empty_or_singleton (hs : s.finite) :
  size s ≤ 1 ↔ s = ∅ ∨ ∃ e, s = {e} :=
begin
  refine ⟨λ h, _, λ h, _⟩, swap,
  { unfreezingI {rcases h with (rfl | ⟨e, rfl⟩)};
  simp only [size_singleton, size_empty], norm_num,},
  by_cases h' : size s ≤ 0,
  { left, rw ←size_zero_iff_empty hs, linarith [size_nonneg s],},
  right, rw ←size_one_iff_eq_singleton,
  exact le_antisymm h (by linarith),
end

lemma two_le_size_iff_has_distinct (hs : s.finite) :
  2 ≤ size s ↔ ∃ e f ∈ s, e ≠ f :=
begin
  split,
  { intro h,
    obtain ⟨e,he⟩ := @exists_mem_of_size_pos _ s (by linarith),
    obtain ⟨f,hf⟩ := @exists_mem_of_size_pos _ (s \ {e}) (by linarith [size_remove_mem hs he]),
    refine ⟨e,f,he,mem_of_mem_of_subset hf (diff_subset _ _), _⟩,
    rintro rfl, simpa using hf,},
  rintro ⟨e,f,he,hf,hef⟩,
  rw ← size_pair hef,
  apply size_monotone hs (pair_subset_iff.mpr ⟨he, hf⟩),
end

lemma size_le_one_iff_mem_unique (hs : s.finite) :
  size s ≤ 1 ↔ ∀ e f ∈ s, e = f :=
begin
  split,
  { rw [size_le_one_iff_empty_or_singleton hs],
    unfreezingI {rintros (rfl | ⟨e,rfl⟩)},
      simp [mem_singleton_iff],
    simp only [mem_singleton_iff],
    unfreezingI {rintros e f rfl rfl},
    refl,},
  refine λ h, by_contra (λ hn, _),
  rw [not_le] at hn, replace hn := int.add_one_le_of_lt hn, norm_num at hn,
  rw two_le_size_iff_has_distinct hs at hn,
  obtain ⟨e,f,he,hf,hef⟩ := hn,
  exact hef (h e f he hf),
end

variables {k : set (set α)}

lemma size_sUnion (hk : k.finite) (hk' : ∀ s ∈ k, set.finite s) (hdisj : pairwise_disjoint k) :
  size (⋃₀ k) = ∑ᶠ s in k, size s :=
by {convert finsum_in_sUnion' (1 : α → ℤ) hk hk' hdisj; {simp_rw ← finsum_ones_eq_size, refl}}

lemma size_collection_le_size_union (hk : ∀ s ∈ k, set.finite s)
(hk' : ∀ s ∈ k, set.nonempty s) (hdisj : pairwise_disjoint k):
  (size k ≤ size (⋃₀ k)) :=
begin
  by_cases hk'' : k.finite, swap,
  { convert size_nonneg _, rw size_zero_of_infinite hk''},
  rw [size_sUnion hk'' hk hdisj, ← finsum_ones_eq_size],
  refine finsum_in_le_finsum_in hk'' (λ x hx, _),
  rw ← (one_le_size_iff_nonempty (hk x hx)),
  exact hk' x hx,
end

lemma singletons_of_size_collection_eq_size_union (hk : k.finite) (hk' : ∀ s ∈ k, set.finite s)
(hk'' : ∀ s ∈ k, set.nonempty s) (hdisj : pairwise_disjoint k) (hsize : size k = size (⋃₀ k)):
  ∀ s ∈ k, size s = 1 :=
begin
  rw [size_sUnion hk hk' hdisj, ← finsum_ones_eq_size] at hsize,
  conv in (_ = _) {rw eq_comm},
  convert (finsum_in_eq_finsum_in_iff_of_le hk (λ x hx, _)).mp hsize,
  apply one_le_size_of_nonempty (hk'' _ hx) (hk' _ hx),
end

lemma size_collection_eq_size_union_iff (hk : k.finite) (hk' : ∀ s ∈ k, set.finite s)
(hk'' : ∀ s ∈ k, set.nonempty s) (hdisj : pairwise_disjoint k) :
  size k = size (⋃₀ k) ↔ ∀ s ∈ k, size s = 1 :=
begin
  refine ⟨λ h, singletons_of_size_collection_eq_size_union hk hk' hk'' hdisj h, λ h, _⟩,
  rw [size_sUnion hk hk' hdisj, ← finsum_ones_eq_size, eq_comm],
  exact finsum_in_eq_of_eq h,
end

end set.finite

end finite

/-! Lemmas that don't need any finiteness assumptions. Some are proved by splitting into
finite and infinite cases, which is why these lemmas need to appear after the previous
section.  -/
section general

variables {α : Type*} {s t : set α} {e f : α}

open set

lemma compl_nonempty_of_size_lt_type_size (hs : size s < type_size α):
  sᶜ.nonempty :=
begin
  rw type_size_eq at hs,
  refine nonempty_compl.mpr (λ h, lt_irrefl (size s) (by {rwa ← h at hs})),
end

lemma size_union_singleton_ub :
  size (s ∪ {e}) ≤ size s + 1 :=
begin
  by_cases hs : s.finite,
    linarith [size_nonneg (s ∩ {e}),
      finite.size_modular s {e} hs (finite_singleton e),
      size_singleton e],
  rw [size_zero_of_infinite (infinite_mono (subset_union_left s {e}) hs)],
  linarith [size_nonneg s],
end

lemma size_insert_ub :
  size (insert e s) ≤ size s + 1 :=
by {rw ← union_singleton, apply size_union_singleton_ub, }

lemma single_subset' (hs : s.nonempty) :
  (∃ t t', t ∩ t' = ∅ ∧ t ∪ t' = s ∧ size t = 1) :=
begin
  obtain ⟨t,ht⟩ := contains_singleton hs,
  refine ⟨t, s \ t, set.inter_diff _ _,  _, ht.2⟩,
  rw [set.union_diff_self, set.subset_iff_union_eq_left.mp ht.1],
end

lemma single_subset (hs : s.nonempty) :
  (∃ t t', disjoint t t' ∧ t ∪ t' = s ∧ size t = 1) :=
by {simp_rw set.disjoint_iff_inter_eq_empty, exact single_subset' hs}

lemma size_remove_union_singleton (he : e ∈ s) (hf : f ∉ s) :
  size ((s \ {e}) ∪ {f}) = size s :=
begin
  by_cases hs : s.finite,
  { have h1 := hs.size_remove_mem he,
    have h2 := finite.size_union_nonmem_singleton
      (hs.diff _)
      (nonmem_diff_of_nonmem {e} hf),
    linarith},
  rw [size_zero_of_infinite hs, size_zero_of_infinite _],
  apply infinite_of_union,
  exact infinite_of_finite_diff (finite_singleton e) hs,
end

lemma size_union_singleton_remove (he : e ∈ s) (hf : f ∉ s) :
  size ((s ∪ {f}) \ {e}) = size s :=
begin
  convert size_remove_union_singleton he hf,
  rw [union_diff_distrib],
  convert rfl,
  rw remove_nonmem,
  simp only [mem_singleton_iff],
  rintro rfl,
  exact hf he,
end

lemma exchange_pair_sizes (hst : size s = size t) (he : e ∈ s \ t) (hf : f ∈ t \ s) :
  size (s \ {e} ∪ {f}) = size (t \ {f} ∪ {e}) :=
begin
  rw mem_diff_iff at he hf,
  rwa [size_remove_union_singleton hf.1 he.2, size_remove_union_singleton he.1 hf.2],
end

lemma eq_of_pair_size_one (h : size ({e,f} : set α) = 1) :
  e = f :=
by_contra (λ hn, by {rw size_pair hn at h, norm_num at h})

lemma size_eq_one_iff_nonempty_unique_mem :
  size s = 1 ↔ s.nonempty ∧ ∀ x y ∈ s, x = y :=
begin
  rw size_one_iff_eq_singleton,
  split, { rintros ⟨e,rfl⟩, tidy, }, rintros ⟨⟨e,he⟩, h⟩, use e, tidy,
end

lemma size_eq_two_iff_pair {s : set α} :
  size s = 2 ↔ ∃ (e f : α), e ≠ f ∧ s = {e,f} :=
begin
  refine ⟨λ h, _, λ h, _⟩, swap,
  { rcases h with ⟨e,f,hef,rfl⟩, apply size_pair hef},
  by_cases hs : s.finite,
  { obtain ⟨e,he⟩ := exists_mem_of_size_pos (by {rw h, norm_num} : 0 < size s),
    obtain ⟨f,hf⟩ := exists_mem_of_size_pos
      (by {rw [finite.size_remove_mem hs he,h], norm_num } : 0 < size (s \ {e})),
    refine ⟨e,f,ne.symm (ne_of_mem_diff hf), _⟩,
    rw eq_comm, apply finite.eq_of_eq_size_subset hs,
    { rw ←union_singletons_eq_pair,
      apply union_subset (singleton_subset_iff.mpr he),
      simp only [set.mem_diff, set.mem_singleton_iff] at hf,
      exact singleton_subset_iff.mpr hf.1, },
    rwa [eq_comm, size_pair  (ne.symm (ne_of_mem_diff hf))]},
  rw size_zero_of_infinite hs at h,
  norm_num at h,
end

lemma size_pair_lb (e f : α) :
  1 ≤ size ({e,f} : set α) :=
by {rcases em (e = f) with (rfl | hef), simp, rw size_pair hef, norm_num}

lemma size_pair_ub (e f : α) :
  size ({e,f} : set α) ≤ 2 :=
begin
  rcases em (e = f) with (rfl | hef),
  { simp only [pair_eq_singleton, size_singleton], norm_num},
  rw size_pair hef,
end

lemma has_distinct_of_two_le_size (hs : 2 ≤ size s):
  ∃ e f ∈ s, e ≠ f :=
(finite.two_le_size_iff_has_distinct (finite_of_size_pos (by linarith))).mp hs

lemma has_distinct_of_one_lt_size (hs : 1 < size s):
  ∃ e f ∈ s, e ≠ f :=
(finite.two_le_size_iff_has_distinct (finite_of_size_pos (by linarith))).mp hs

lemma has_subset_of_size {n : ℤ} (hn : 0 ≤ n) (hnx : n ≤ size t) :
  ∃ s ⊆ t, size s = n :=
begin
  rcases eq_or_lt_of_le hn with (rfl | hn'),
    exact ⟨∅, empty_subset _, size_empty _⟩,
  have hfin := finite_of_size_pos (lt_of_lt_of_le hn' hnx), clear hn',
  revert t, revert n,
  refine nonneg_int_induction _
    (λ _ _ _, ⟨∅, empty_subset _, size_empty _⟩)
    (λ n hn ih t ht ht', _),
  obtain ⟨e,he⟩ := exists_mem_of_size_pos (by linarith : 0 < size t),
  obtain ⟨s, hst, hs⟩ := @ih (t \ {e}) _ (finite.diff ht' _), swap,
  { rw finite.size_remove_mem ht' he, exact le_sub_iff_add_le.mpr ht },
  refine ⟨has_insert.insert e s, λ x, _, _⟩,
  { simp only [mem_insert_iff],
    rintros (rfl | hxs), assumption,
    exact mem_of_mem_of_subset hxs (subset.trans hst (diff_subset _ _)),  },
  rw finite.size_insert_nonmem (finite.subset ht' (subset.trans hst (diff_subset _ _))),
    simpa,
  exact nonmem_of_nonmem_supset (nonmem_removal _ _) hst,
end

lemma has_set_of_size {n : ℤ} (h : 0 ≤ n) (h' : n ≤ type_size α) :
  ∃ (Y : set α), size Y = n :=
by {rw type_size_eq at h', obtain ⟨Y,-,hY⟩ := has_subset_of_size h h', tauto}

lemma has_subset_of_size_of_infinite {n : ℤ} (hn : 0 ≤ n) (ht : t.infinite) :
  ∃ s ⊆ t, size s = n :=
begin
  revert n,
  refine nonneg_int_induction _ ⟨∅, empty_subset _, size_empty _⟩ _,
  rintros n hn ⟨s, hs, hs'⟩,
  by_cases hf : s.finite,
  { obtain ⟨e, he⟩ := set.infinite.nonempty (set.infinite_of_finite_diff hf ht),
    refine ⟨s ∪ {e}, union_singleton_subset_of_subset_mem hs (mem_of_mem_diff he), _⟩,
    rw ← hs', refine finite.size_union_nonmem_singleton hf (not_mem_of_mem_diff he)},
  obtain ⟨e,he⟩ := set.infinite.nonempty ht,
  refine ⟨{e}, singleton_subset_iff.mpr he, _⟩,
  rw [size_singleton, ← hs', size_zero_of_infinite hf],
  refl,
end

lemma has_distinct_mems_of_infinite (ht : t.infinite) :
  ∃ e f ∈ t, e ≠ f :=
begin
  obtain ⟨s,hst, hs⟩ := has_subset_of_size_of_infinite (by norm_num : (0 : ℤ) ≤ 2) ht,
  obtain ⟨e, f, hef, rfl⟩ := size_eq_two_iff_pair.mp hs,
  refine ⟨e,f,_,_,hef⟩,
  { rw [← singleton_subset_iff], apply subset.trans (singleton_subset_pair_left _ _) hst},
  rw [← singleton_subset_iff], apply subset.trans (singleton_subset_pair_right _ _) hst,
end

end general

/-!
This section (nearly) contains only copies of lemmas above, but with the finiteness assumptions
wrapped in a `fintype` instance, as well as a couple of lemmas about type sizes which need
`fintype` for the statement to even be sensible. All lemmas fail without finiteness, and
nearly all are proved by just grabbing finiteness assumptions from the instance and invoking
the versions with explicit assumptions.
-/

section fintype

open set

variables {α β : Type*} [fintype α] [fintype β] {s t : set α} {e f : α}

lemma size_monotone (hst : s ⊆ t) :
  size s ≤ size t :=
by {apply finite.size_monotone _ hst, apply finite.of_fintype, }

lemma size_le_type_size (s : set α):
  size s ≤ type_size α :=
size_monotone (subset_univ _)

lemma sum_size_fiber_eq_size {ι : Type*} (s : set α) (f : α → ι) :
  ∑ᶠ (i : ι), size {a ∈ s | f a = i} = size s :=
by simp_rw [size_def, ← nat.coe_int_distrib_finsum, fin.sum_fincard_fiber_eq_fincard s f]

lemma size_modular (s t : set α) :
  size (s ∪ t) + size (s ∩ t) = size s + size t :=
by {apply finite.size_modular; apply finite.of_fintype, }

lemma compl_size (s : set α) :
  size sᶜ = size (univ : set α) - size s :=
begin
  have := size_modular s sᶜ,
  simp only [add_zero, size_empty, union_compl_self, inter_compl_self] at this,
  rw this,
  ring,
end

lemma size_compl (s : set α) :
  size s = size (univ : set α) - size sᶜ :=
by linarith [compl_size s]

lemma size_union (s t : set α) :
  size (s ∪ t) = size s + size t - size (s ∩ t) :=
by {apply finite.size_union; apply finite.of_fintype,}

lemma ssubset_size (hst : s ⊆ t) (hst' : size s < size t) :
  s ⊂ t :=
by {apply finite.ssubset_size _ _ hst hst'; apply finite.of_fintype,  }

lemma size_subadditive (s t : set α) : size (s ∪ t) ≤ size s + size t :=
by {apply finite.size_subadditive; apply finite.of_fintype }

lemma compl_inter_size (s t : set α) : size (s ∩ t) + size (sᶜ ∩ t) = size t :=
by {apply finite.compl_inter_size, apply finite.of_fintype,}

lemma compl_inter_size_subset (hst : s ⊆ t) :
  size (sᶜ ∩ t) = size t - size s :=
by {apply finite.compl_inter_size_subset _ hst, apply finite.of_fintype, }

lemma diff_size (hst : s ⊆ t) : size (t \ s) = size t - size s :=
by {apply finite.diff_size _ hst, apply finite.of_fintype }

lemma size_diff_le_size (s t : set α) : size (s \ t) ≤ size s :=
by {apply finite.size_diff_le_size, apply finite.of_fintype}

lemma size_union_of_inter_empty (hst : s ∩ t = ∅) :
  size (s ∪ t) = size s + size t :=
by {apply finite.size_union_of_inter_empty _ _ hst ; apply finite.of_fintype}

lemma size_union_of_disjoint (hst : disjoint s t) :
  size (s ∪ t) = size s + size t :=
by {apply finite.size_union_of_disjoint _ _ hst ; apply finite.of_fintype}

lemma size_modular_diff (s t : set α) :
  size (s ∪ t) = size (s \ t) + size (t \ s) + size (s ∩ t) :=
by {apply finite.size_modular_diff; apply finite.of_fintype }

lemma size_induced_partition (s t : set α) :
  size s = size (s ∩ t) + size (s \ t) :=
by {apply finite.size_induced_partition, apply finite.of_fintype}

lemma size_induced_partition_inter (s t : set α) :
  size s = size (s ∩ t) + size (s ∩ tᶜ) :=
by {apply finite.size_induced_partition, apply finite.of_fintype}

lemma size_mono_inter_left (s t : set α) : size (s ∩ t) ≤ size s :=
by {apply finite.size_mono_inter_left, apply finite.of_fintype}

lemma size_mono_inter_right (s t : set α) : size (s ∩ t) ≤ size t :=
by {apply finite.size_mono_inter_right, apply finite.of_fintype}

lemma size_mono_union_left (s t : set α) : size s ≤ size (s ∪ t)  :=
by {apply finite.size_mono_union_left, apply finite.of_fintype}

lemma size_mono_union_right (s t : set α) : size t ≤ size (s ∪ t) :=
by {apply finite.size_mono_union_right, apply finite.of_fintype}

lemma empty_of_size_zero (hsize : size s = 0) : s = ∅ :=
by {apply finite.empty_of_size_zero _ hsize, apply finite.of_fintype, }

@[simp] lemma size_zero_iff_empty : (size s = 0) ↔ (s = ∅) :=
by {apply finite.size_zero_iff_empty, apply finite.of_fintype, }

@[simp] lemma size_le_zero_iff_eq_empty : size s ≤ 0 ↔ s = ∅ :=
by {apply finite.size_le_zero_iff_eq_empty, apply finite.of_fintype, }

lemma size_nonempty (hne : s.nonempty) : 0 < size s  :=
by {apply finite.size_nonempty _ hne, apply finite.of_fintype, }

lemma nonempty_iff_size_pos : s.nonempty ↔ 0 < size s :=
by {apply finite.nonempty_iff_size_pos, apply finite.of_fintype, }

lemma one_le_size_iff_nonempty : s.nonempty ↔ 1 ≤ size s :=
nonempty_iff_size_pos

lemma one_le_size_univ_of_nonempty (hα : nonempty α) : 1 ≤ size (univ : set α) :=
by rwa [nonempty_iff_univ_nonempty, one_le_size_iff_nonempty] at hα

lemma one_le_type_size_of_nonempty (hα: nonempty α) : 1 ≤ type_size α  :=
one_le_size_univ_of_nonempty hα

lemma size_strict_monotone (hst : s ⊂ t) : size s < size t :=
by {apply finite.size_strict_monotone _ hst; apply finite.of_fintype }

lemma eq_of_eq_size_subset (hst : s ⊆ t) (hsize : size s = size t) : s = t :=
by {apply finite.eq_of_eq_size_subset _ hst hsize, apply finite.of_fintype }

lemma eq_of_eq_size_subset_iff (hst : s ⊆ t) :
  ((size s = size t) ↔ s = t) :=
by {apply finite.eq_of_eq_size_subset_iff _ hst; apply finite.of_fintype }

lemma eq_of_le_size_subset (hst : s ⊆ t) (hsize : size t ≤ size s) :
  s = t :=
by {apply finite.eq_of_le_size_subset _ hst hsize, apply finite.of_fintype }

lemma size_eq_of_supset (hst : s ⊆ t) (hsize : size t ≤ size s) :
  size s = size t :=
by {apply finite.size_eq_of_supset _ hst hsize, apply finite.of_fintype }

lemma size_pos_iff_has_mem :
  0 < size s ↔ ∃ e, e ∈ s :=
by rw [← nonempty_iff_size_pos, set.nonempty_def]

lemma one_le_size_iff_has_mem :
  1 ≤ size s ↔ ∃ e, e ∈ s :=
by {convert size_pos_iff_has_mem, apply_instance}

lemma size_zero_iff_has_no_mem :
  size s = 0 ↔ ¬ ∃ e, e ∈ s :=
by {rw finite.size_zero_iff_has_no_mem, apply finite.of_fintype}

lemma size_le_zero_iff_has_no_mem :
  size s ≤ 0 ↔ ¬ ∃ e, e ∈ s :=
by {rw finite.size_le_zero_iff_has_no_mem, apply finite.of_fintype}

lemma mem_diff_of_size_lt (h : size s < size t) :
  ∃ (e : α), e ∈ t ∧ e ∉ s :=
by {apply finite.mem_diff_of_size_lt _ h, apply finite.of_fintype}

lemma size_union_singleton_compl (he : e ∈ sᶜ) :
  size (s ∪ {e}) = size s + 1 :=
by {apply finite.size_union_singleton_compl _ he, apply finite.of_fintype}

lemma size_union_nonmem_singleton (hes : e ∉ s) :
  size (s ∪ {e}) = size s + 1 :=
by {apply finite.size_union_singleton_compl _ hes, apply finite.of_fintype}

lemma size_remove_mem (he : e ∈ s) :
  size (s \ {e}) = size s - 1 :=
by {apply finite.size_remove_mem _ he, apply finite.of_fintype}

lemma size_insert_nonmem (he : e ∉ s):
  size (has_insert.insert e s) = size s + 1 :=
by {apply finite.size_insert_nonmem _ he, apply finite.of_fintype, }

lemma has_sub_one_size_ssubset_of_ne_empty (hne : s ≠ ∅) :
  ∃ t, t ⊂ s ∧ size t = size s - 1 :=
by {apply finite.has_sub_one_size_ssubset_of_ne_empty _ hne, apply finite.of_fintype}

lemma has_sub_one_size_ssubset_of_nonempty (hne : s.nonempty) :
  ∃ t, t ⊂ s ∧ size t = size s - 1 :=
by {apply finite.has_sub_one_size_ssubset_of_nonempty _ hne, apply finite.of_fintype}

lemma ne_univ_has_add_one_size_ssupset (hne : s ≠ univ) :
  ∃ t, s ⊂ t ∧ size t = size s + 1 :=
by {apply finite.ne_univ_has_add_one_size_ssupset _ hne, apply finite.of_fintype}

lemma ne_univ_has_add_one_size_ssupset_element (hne : s ≠ univ) :
  ∃ e, s ⊂ s ∪ {e} ∧ size (s ∪ {e}) = size s + 1 :=
by {apply finite.ne_univ_has_add_one_size_ssupset_element _ hne, apply finite.of_fintype}

lemma eq_or_exists_mem_diff_of_size_eq (hst : size s = size t) :
  s = t ∨ ∃ e, e ∈ s \ t :=
by {apply finite.eq_or_exists_mem_diff_of_size_eq _ hst, apply finite.of_fintype}

lemma size_le_one_iff_empty_or_singleton :
  size s ≤ 1 ↔ s = ∅ ∨ ∃ e, s = {e} :=
by {apply finite.size_le_one_iff_empty_or_singleton, apply finite.of_fintype,}

lemma size_le_one_iff_mem_unique :
  size s ≤ 1 ↔ ∀ e f ∈ s, e = f :=
by {apply finite.size_le_one_iff_mem_unique, apply finite.of_fintype}

lemma size_sUnion {k : set (set α)} (hdisj : pairwise_disjoint k) :
  size (⋃₀ k) = ∑ᶠ s in k, size s :=
by {apply finite.size_sUnion _ (λ b hb, _) hdisj; apply finite.of_fintype, }

lemma size_Union {t : β → set α} (h : ∀ x y, x ≠ y → disjoint (t x) (t y)) :
  size (⋃ x : β, t x) = ∑ᶠ i, (size (t i)) :=
by {simp_rw [← finsum_ones_eq_size], apply fin.finsum_in_Union h, }

lemma size_bUnion {t : β → set α} {b : set β} (h : ∀ x y ∈ b, x ≠ y → disjoint (t x) (t y)):
  size (⋃ (x : β) (H : x ∈ b), t x) = ∑ᶠ i in b, size (t i) :=
begin
  rw [← finsum_subtype_eq_finsum_in, ← size_Union], simp,
  rintros ⟨x,hx⟩ ⟨y,hy⟩ hxy,
  refine h x y hx hy _,
  simpa using hxy,
end

lemma eq_univ_of_size_eq_type_size (hs : size s = type_size α) : s = univ :=
begin
  rw [← finsum_ones_eq_size, ← finsum_ones_eq_type_size, finsum_eq_finsum_in_univ] at hs,
  have h := fin.eq_zero_of_finsum_in_subset_eq_finsum_in_of_nonneg
    (subset_univ s) (λ _ _, int.zero_lt_one.le) hs.symm.le,
  simp only [one_ne_zero, univ_diff, mem_compl_eq, imp_false, not_not] at h,
  ext,
  tauto,
end

variables {k : set (set α)}

lemma size_collection_le_size_union (hk : ∀ s ∈ k, set.nonempty s) (hdisj : pairwise_disjoint k):
  (size k ≤ size (⋃₀ k)) :=
finite.size_collection_le_size_union (λ _ _, finite.of_fintype _) hk hdisj

lemma singletons_of_size_collection_eq_size_union (hk : ∀ s ∈ k, set.nonempty s)
(hdisj : pairwise_disjoint k) (hsize : size k = size (⋃₀ k)):
  ∀ s ∈ k, size s = 1 :=
by apply finite.singletons_of_size_collection_eq_size_union _ (λ _ _, _) hk hdisj hsize;
   apply finite.of_fintype

lemma size_collection_eq_size_union_iff
(hk : ∀ s ∈ k, set.nonempty s) (hdisj : pairwise_disjoint k):
  size k = size (⋃₀ k) ↔ ∀ s ∈ k, size s = 1 :=
by apply finite.size_collection_eq_size_union_iff _ (λ _ _, _) hk hdisj; apply finite.of_fintype

lemma size_disjoint_collection_le_type_size {k : set (set α)} (hk' : ∀ s ∈ k, set.nonempty s)
(hdisj : pairwise_disjoint k):
  size k ≤ type_size α :=
le_trans (size_collection_le_size_union hk' hdisj) (size_le_type_size _)

lemma size_disjoint_collection_eq_type_size_iff (hk : ∀ s ∈ k, set.nonempty s)
(hdisj : pairwise_disjoint k):
  size k = type_size α ↔ ⋃₀ k = univ ∧ ∀ s ∈ k, size s = 1 :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  {  obtain ⟨h₁, h₂⟩ := squeeze_le_trans
      (size_collection_le_size_union hk hdisj)
      (size_le_type_size _)
      h,
    exact ⟨eq_univ_of_size_eq_type_size h₂,
            singletons_of_size_collection_eq_size_union hk hdisj h₁⟩},
  rw [(size_collection_eq_size_union_iff hk hdisj).mpr h.2, h.1, type_size_eq],
end

end fintype

/-! This section deals with fin', an analogue of fin that is defined for all n; it is
an empty type whenever `n ≤ 0`. -/

section fin'

/-- the same as fin, but defined for all integers (empty if `n < 0`)-/
def fin' (n : ℤ) : Type := fin (n.to_nat)

lemma fin'_eq_fin {n : ℕ} :
  fin' n = fin n :=
rfl

lemma fin'_neg_elim {n : ℤ} (hn : n < 0) (x : fin' n) :
  false :=
by {cases x with x hx, rw int.to_nat_zero_of_neg hn at hx, exact nat.not_lt_zero _ hx,  }

lemma fin'_le_zero_elim {n : ℤ} (hn : n ≤ 0) (x : fin' n) :
  false :=
begin
  cases x with x hx,
  rcases eq_or_lt_of_le hn with (rfl | hn),
  { exact nat.not_lt_zero _ hx, },
  rw int.to_nat_zero_of_neg hn at hx,
  exact nat.not_lt_zero _ hx,
end

instance {n : ℤ} : fintype (fin' n) := by {unfold fin', apply_instance}

@[simp] lemma size_fin (n : ℕ) :
  type_size (fin n) = n :=
by {rw [type_size_eq_fincard_t], norm_num}

@[simp] lemma size_fin' (n : ℤ) (hn : 0 ≤ n) :
  type_size (fin' n) = n :=
by {convert size_fin (n.to_nat), exact (int.to_nat_of_nonneg hn).symm}

@[simp] lemma size_fin'_univ (n : ℤ) (hn : 0 ≤ n) :
  size (set.univ : set (fin' n)) = n :=
by {convert size_fin (n.to_nat), exact (int.to_nat_of_nonneg hn).symm}

lemma type_size_eq_iff_equiv_fin' {α : Type*} [fintype α] {n : ℤ} (hn : 0 ≤ n) :
  type_size α = n ↔ nonempty (equiv α (fin' n)) :=
begin
  obtain ⟨m,rfl⟩ := int.eq_coe_of_zero_le hn,
  rw [fin'_eq_fin, ← fincard_t_eq_iff_fin_equiv, type_size_eq_fincard_t, int.coe_nat_inj'],
end

/-- choose an equivalence between a finite type and the appropriate `fin'` -/
def choose_equiv_to_fin' (α : Type*) [fintype α] :
  equiv α (fin' (type_size α)) :=
classical.choice ((type_size_eq_iff_equiv_fin' (type_size_nonneg α)).mp rfl)

lemma type_size_le_zero_elim {α : Type*} [fintype α] (hα : type_size α ≤ 0) (e : α):
  false :=
begin
  let bij := choose_equiv_to_fin' α,
  apply nat.not_lt_zero (bij e).val,
  convert (bij e).property,
  rw int.to_nat_zero_of_nonpos hα,
end

lemma type_size_lt_zero_elim {α : Type*} (hα : type_size α < 0) (e : α):
  false :=
by linarith [type_size_nonneg α]

end fin'

/-! This section covers the relationship between size and functions between sets (mostly embeddings
and bijections) . -/

section embeddings

open set

variables {α : Type*}{β : Type*}

lemma size_image_emb (f : α ↪ β) (s : set α) :
  size (f '' s) = size s :=
by {simp_rw [size], norm_cast, apply fincard_img_emb, }

lemma type_size_le_type_size_inj [fintype β] (f : α ↪ β) :
  type_size α ≤ type_size β :=
begin
  rw [type_size, type_size, ← size_image_emb f],
  apply size_monotone,
  apply subset_univ,
end

lemma size_image_inj {f : α → β} (hf : function.injective f) (s : set α) :
  size (f '' s) = size s :=
size_image_emb ⟨f , hf⟩ s

lemma size_image_equiv (f : α ≃ β) (s : set α) :
  size (f '' s) = size s :=
size_image_emb (f.to_embedding) s

lemma size_range_emb (f : α ↪ β):
  size (range f) = type_size α :=
by {rw [← image_univ, size_image_emb], refl,  }

lemma size_range_inj (f : α → β)(hf : function.injective f):
  size (range f) = type_size α :=
by {rw [← image_univ, size_image_inj hf], refl,  }

lemma type_size_eq_type_size_equiv (f : α ≃ β) :
  type_size α = type_size β :=
by rw [type_size, type_size, ← size_image_equiv f, ← f.range_eq_univ, image_univ]

lemma type_size_eq_iff_equiv [fintype α] [fintype β]:
  type_size α = type_size β ↔ nonempty (α ≃ β) :=
begin
  simp_rw [type_size_eq_fincard_t],
  norm_num,
  simp_rw [fincard_t_eq_fintype_card, fintype.card_eq],
end

/-- Gives an equivalence between two types of equal size -/
def equiv_of_type_size_eq [fintype α] [fintype β] (h : type_size α = type_size β ): α ≃ β :=
classical.choice (type_size_eq_iff_equiv.mp h)

@[simp] lemma equiv.image_mem_image_iff_mem {f : α ≃ β} {x : α} {s : set α} :
  f x ∈ f '' s ↔ x ∈ s :=
begin
  rw mem_image, split,
  { rintros ⟨y, hy, hyx⟩, rw equiv.apply_eq_iff_eq at hyx, rwa ←hyx},
  exact λ hx, ⟨x, hx, rfl⟩,
end

@[simp] lemma size_preimage_equiv (f : α ≃ β) (s : set β) :
  size (f ⁻¹' s) = size s :=
begin
  unfold_coes,
  rw ←set.image_eq_preimage_of_inverse f.right_inv f.left_inv,
  convert size_image_emb (f.symm.to_embedding) s,
end

lemma size_preimage_embed_subset_range (f : α ↪ β) (s : set β) (hs : s ⊆ range f) :
  size (f ⁻¹' s) = size s :=
begin
  suffices h: f '' (f ⁻¹' s) = s,
  { rw eq_comm, nth_rewrite 0 ← h, apply size_image_emb},
  apply image_preimage_eq_of_subset hs,
end

lemma size_subtype_image {E : set α} (s : set E) :
  size (subtype.val '' s) = size s :=
begin
  let f : E ↪ α := ⟨subtype.val, λ x y hxy,
    by {cases x, cases y, simp only [subtype.mk_eq_mk], exact hxy}⟩,
  apply size_image_emb f,
end

@[simp] lemma size_image_coe {E : set α} (s : set E) :
  size (coe '' s : set α) = size s :=
size_subtype_image s

@[simp] lemma size_preimage_coe {E : set α} (s : set α) :
  size (coe ⁻¹' s : set E) = size (s ∩ E) :=
by {rw ← size_image_coe (coe ⁻¹' s : set E), simp, }

lemma nonempty_fin'_emb_of_type_size {n : ℤ} (hα : n ≤ type_size α ) :
  nonempty ((fin' n) ↪ α) :=
begin
  by_cases hn : n ≤ 0,
  { exact ⟨⟨λ x, false.elim (fin'_le_zero_elim hn x), λ x, false.elim (fin'_le_zero_elim hn x)⟩⟩},
  push_neg at hn,
  obtain ⟨m,rfl⟩ := int.eq_coe_of_zero_le (le_of_lt hn),
  rw fin'_eq_fin,

  obtain ⟨s,hs⟩ := has_set_of_size (le_of_lt hn) hα,
  rw [size_def, int.coe_nat_inj'] at hs,
  subst hs,
  letI := fintype_of_type_size_pos (lt_of_lt_of_le hn hα),
  have bij := (@choose_fin_bij ↥s _).symm,
  exact ⟨⟨
    λ x, (bij ⟨x, by {rw fincard_t_subtype_eq_fincard, exact x.property,}⟩).val ,
    λ x y hxy, by {convert subtype.val_injective hxy, tidy,}⟩⟩,
end

/-- an embedding from `fin' n` into `α`, provided that `n ≤ type_size α` -/
def choose_fin'_inj_of_type_size {n : ℤ} (hα : n ≤ type_size α) :
  (fin' n) ↪ α :=
classical.choice (nonempty_fin'_emb_of_type_size hα)

def emb_nonempty_of_size_le_size {α : Type*} {β : Type*} [fintype α]
(hsize : type_size α ≤ type_size β ) :
  nonempty (α ↪ β) :=
⟨(choose_equiv_to_fin' α).to_embedding.trans (@choose_fin'_inj_of_type_size β _ hsize)⟩

lemma type_size_le_iff_emb {α β : Type* } [fintype α] [fintype β] :
  type_size α ≤ type_size β ↔ nonempty (α ↪ β) :=
⟨ λ h, emb_nonempty_of_size_le_size h,
  λ ⟨emb⟩, eq.trans_le (size_range_emb emb).symm (size_le_type_size (range emb)), ⟩

/-- an embedding from `α` into `β`, provided that `type_size α ≤ type_size β` and `α` is finite.
A little scary as this takes a `fintype` and outputs data, so could cause instance issues. Maybe
the `nonempty` version is safer. -/
def choose_emb_of_size_le_size {α : Type*} {β : Type*} [fintype α]
(hsize : type_size α ≤ type_size β ) :
  (α ↪ β) :=
(choose_equiv_to_fin' α).to_embedding.trans (@choose_fin'_inj_of_type_size β _ hsize)

lemma exists_emb_of_type_size_le_size_set {α : Type*} [fintype α] {β : Type*} {s : set β}
(hsize : type_size α ≤ size s ) :
  ∃ (emb : α ↪ β), set.range emb ⊆ s :=
begin
  rw ← type_size_coe_set_eq_size at hsize,
  let emb := choose_emb_of_size_le_size hsize,
  exact ⟨emb.trans ⟨subtype.val, subtype.val_injective ⟩, λ x, by tidy⟩,
end

lemma set.finite.exists_emb_of_type_size_eq_size_set {α : Type*} [fintype α] {β : Type*}
{s : set β} (hs : s.finite) (hsize : type_size α = size s ) :
  ∃ (emb : α ↪ β), set.range emb = s :=
begin
  convert exists_emb_of_type_size_le_size_set (le_of_eq hsize),
  ext emb,
  split,
  { unfreezingI {rintro rfl}, exact subset_refl _, },
  intros hss,
  apply finite.eq_of_eq_size_subset hs hss,
  rw [← image_univ, size_image_emb],
  convert hsize,
end

lemma exists_emb_of_type_size_eq_size_set {α : Type*} [fintype α] {β : Type*} [fintype β]
{s : set β} (hsize : type_size α = size s ) :
  ∃ (emb : α ↪ β), set.range emb = s :=
by {apply set.finite.exists_emb_of_type_size_eq_size_set _ hsize, apply finite.of_fintype }

lemma type_size_lt_of_nonmem_range_emb {α β : Type* } [fintype β] (emb : α ↪ β) {b : β}
(hb : b ∉ range emb):
  type_size α < type_size β :=
begin
  refine lt_of_le_of_ne (by { rw [← size_range_emb emb], apply size_le_type_size, }) (λ h, _),
  letI : fintype α := fintype.of_injective _ (emb.injective),
  let eq := equiv_of_type_size_eq h.symm,
  have h' := size_image_equiv eq (has_insert.insert b (range emb)),
  rw [size_insert_nonmem hb, size_range_emb] at h',
  linarith [size_le_type_size (eq '' insert b (range ⇑emb))],
end

lemma type_size_lt_iff_exists_proper_emb {α β : Type*} [fintype α] [fintype β] :
  type_size α < type_size β ↔ ∃ (emb : α ↪ β) (b : β), b ∉ range emb :=
begin
  refine ⟨λ h, _, λ ⟨emb, b, hb⟩, type_size_lt_of_nonmem_range_emb emb hb⟩,
  obtain ⟨emb⟩ := emb_nonempty_of_size_le_size (le_of_lt h),
  refine ⟨emb, compl_nonempty_iff_exists_nonmem.mp (compl_nonempty_of_size_lt_type_size _)⟩,
  rwa size_range_emb,
end

end embeddings


import game.sets.sets_level05 -- hide
import tactic -- hide

namespace xena -- hide

variable X : Type

open_locale classical -- hide

/-
# Chapter 1 : Sets

## Level 6 : `sdiff` and `neg`
-/

/-

The set-theoretic difference `A \ B` satisfies the following property:

```
lemma mem_sdiff_iff : x ∈ A \ B ↔ x ∈ A ∧ x ∉ B
```

The complement `-A` of a set `A` (often denoted $A^c$ in textbooks)
is all the elements of `X` which are not in `A`:

```
lemma mem_neg_iff : x ∈ -A ↔ x ∉ A
```

In this lemma, you might get a shock. The `rw` tactic is aggressive
in the Real Number Game -- if after a rewrite the goal can be
solved by `refl`, then Lean will close the goal automatically.

-/

/- Axiom : mem_sdiff_iff :
x ∈ A \ B ↔ x ∈ A ∧ x ∉ B
-/

/- Axiom : mem_neg_iff :
x ∈ -A ↔ x ∉ A
-/

/- Lemma
If $A$ and $B$ are sets with elements of type $X$, then

$$(A \setminus B) = A \cap B^{c}.$$
-/
theorem setdiff_eq_intersect_comp (A B : set X) : A \ B = A ∩ Bᶜ :=
begin
  rw ext_iff,
  intro x,
  rw mem_sdiff_iff,
  rw mem_inter_iff,
  rw mem_neg_iff,
end

end xena -- hide


/-
Example from "Inductively defined types",
from Thierry Coquand and Christine Paulin,
COLOG-88.

It shows it is inconsistent to allow inductive datatypes such as

inductive A : Type :=
| intro : ((A → Prop) → Prop) → A

-/

/- Phi is a positive, but not strictly positive, operator. -/
definition Phi (A : Type) := (A → Prop) → Prop

/- If we were allowed to form the inductive type

     inductive A: Type :=
     | introA : Phi A -> A

   we would get the following
-/

universe l
-- The new type A
axiom A : Type.{l}
-- The constructor
axiom introA : Phi A → A
-- The eliminator
axiom recA   : Π {C : A → Type}, (Π (p : Phi A), C (introA p)) → (Π (a : A), C a)
-- The "computational rule"
axiom recA_comp : Π {C : A → Type} (H : Π (p : Phi A), C (introA p)) (p : Phi A), recA H (introA p) = H p

-- The recursor could be used to define matchA
noncomputable definition matchA (a : A) : Phi A :=
recA (λ p, p) a

-- and the computation rule would allows us to define
lemma betaA (p : Phi A) : matchA (introA p) = p :=
!recA_comp

-- As in all inductive datatypes, we would be able to prove that constructors are injective.
lemma introA_injective : ∀ {p p' : Phi A}, introA p = introA p' → p = p' :=
λ p p' h,
  have aux : matchA (introA p) = matchA (introA p'), by rewrite h,
  by rewrite [*betaA at aux]; exact aux

-- For any type T, there is an injection from T to (T → Prop)
definition i {T : Type} : T → (T → Prop) :=
λ x y, x = y

lemma i_injective {T : Type} {a b : T} : i a = i b → a = b :=
λ h,
  have e₁ : i a a = i b a,     by rewrite [h],
  have e₂ : (a = a) = (b = a), from e₁,
  have e₃ : b = a,             from eq.subst e₂ rfl,
  eq.symm e₃

-- Hence, by composition, we get an injection f from (A → Prop) to A
noncomputable definition f : (A → Prop) → A :=
λ p, introA (i p)

lemma f_injective : ∀ {p p' : A → Prop}, f p = f p' → p = p':=
λ (p p' : A → Prop) (h : introA (i p) = introA (i p')),
  i_injective (introA_injective h)

/-
  We are now back to the usual Cantor-Russel paradox.
  We can define
-/
noncomputable definition P0 (a : A) : Prop :=
∃ (P : A → Prop), f P = a ∧ ¬ P a
-- i.e., P0 a := codes a set P such that x∉P

noncomputable definition x0 : A := f P0

lemma fP0_eq : f P0 = x0 :=
rfl

lemma not_P0_x0 : ¬ P0 x0 :=
λ h : P0 x0,
  obtain (P : A → Prop) (hp : f P = x0 ∧ ¬ P x0), from h,
  have fp_eq : f P = f P0,  from and.elim_left hp,
  have p_eq  : P = P0,      from f_injective fp_eq,
  have nh    : ¬ P0 x0,     by rewrite [p_eq at hp]; exact (and.elim_right hp),
  absurd h nh

lemma P0_x0 : P0 x0 :=
exists.intro P0 (and.intro fP0_eq not_P0_x0)

theorem inconsistent : false :=
absurd P0_x0 not_P0_x0


import linear_algebra.matrix.ldl
import linear_algebra.matrix.block
import missing.analysis.inner_product_space.gram_schmidt_ortho
import missing.linear_algebra.matrix.triangular

variables {𝕜 : Type*} [is_R_or_C 𝕜]
variables {n : Type*} [linear_order n] [is_well_order n (<)] [locally_finite_order_bot n]

local notation `⟪`x`, `y`⟫` :=
@inner 𝕜 (n → 𝕜) (pi_Lp.inner_product_space (λ _, 𝕜)).to_has_inner x y

open matrix
open_locale matrix

variables {S : matrix n n 𝕜} [fintype n] (hS : S.pos_def)

@[simp] lemma LDL.lower_inv_diagonal (i : n) :
  LDL.lower_inv hS i i = 1 :=
begin
  rw [LDL.lower_inv_eq_gram_schmidt_basis, basis.to_matrix],
  simpa only [gram_schmidt_basis, basis.coe_mk]
    using @repr_gram_schmidt_diagonal 𝕜 (n → 𝕜) _
      (inner_product_space.of_matrix hS.transpose) n _ _ _ i (pi.basis_fun 𝕜 n)
end

lemma LDL.lower_eq_to_matrix : LDL.lower hS = ((@gram_schmidt_basis 𝕜 (n → 𝕜) _
  (inner_product_space.of_matrix hS.transpose) n _ _ _ (pi.basis_fun 𝕜 n)).to_matrix
    (pi.basis_fun 𝕜 n))ᵀ :=
begin
  simp only [LDL.lower, LDL.lower_inv_eq_gram_schmidt_basis],
  apply matrix.inv_eq_left_inv,
  rw [←transpose_mul, basis.to_matrix_mul_to_matrix_flip, transpose_one]
end

lemma LDL.lower_triangular_lower_inv : lower_triangular (LDL.lower_inv hS) :=
by apply LDL.lower_inv_triangular

lemma LDL.lower_triangular_lower : lower_triangular (LDL.lower hS) :=
lower_triangular_inv_of_lower_triangular (LDL.lower_triangular_lower_inv hS)

noncomputable instance LDL.invertible_lower : invertible (LDL.lower hS) :=
invertible_of_left_inverse _ _ (matrix.mul_inv_of_invertible (LDL.lower_inv hS))

@[simp] lemma inv_lower_eq_lower_inv : (LDL.lower hS)⁻¹ = LDL.lower_inv hS :=
matrix.inv_eq_left_inv (matrix.mul_inv_of_invertible (LDL.lower_inv hS))

@[simp] lemma LDL.lower_diagonal (i : n) :
  LDL.lower hS i i = 1 :=
by simpa using diag_inv_mul_diag_eq_one_of_lower_triangular (LDL.lower_triangular_lower hS) i

@[simp] lemma LDL.det_lower_inv :
  (LDL.lower_inv hS).det = 1 :=
begin
  rw [det_of_lower_triangular (LDL.lower_inv hS) (by apply LDL.lower_inv_triangular),
    finset.prod_eq_one],
  intros,
  rw LDL.lower_inv_diagonal,
end

@[simp] lemma LDL.det_lower :
  (LDL.lower hS).det = 1 :=
by simp [LDL.lower]


import algebra.group
import data.set.basic
import analysis.real
import tactic.norm_num
import .choice

set_option pp.beta true

example (P Q R : Prop) : ((P ∨ Q → R) ∧ P) → R :=
begin
  rintro ⟨hyp1, hyp2⟩,
  apply hyp1,
  left,
  assumption,
end

example (P Q R : Prop) : ((P ∨ Q → R) ∧ P) → R :=
by finish

example (X : Type) (A B C : set X) : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
begin
  ext x,
  split,
  { rintro ⟨x_1, x_B | x_C⟩,
    { left,
      apply and.intro,
      { assumption },
      { assumption } },
    { right,
      apply and.intro,
      { assumption },
      { assumption } } },
  { rintro (⟨x_A, x_B⟩|⟨x_A, x_C⟩),
    { apply and.intro,
      { assumption },
      { left,
        assumption } },
    { apply and.intro,
      { assumption },
      { right,
        assumption } } }
end

example (X : Type) (A B C : set X) : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
by ext x; split; finish

example (X : Type) (A B C : set X) : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
set.inter_distrib_left _ _ _

example (X Y : Type) (f : X → Y) :
  (∀ y : Y, ∃ x : X, f(x) = y) ↔ (∃ g : Y → X, f ∘ g = id) :=
begin
  split,
  { intro hyp,
    choice hyp with g H,
    existsi g,
    exact funext H, },
  { rintros ⟨g, f_rond_g⟩ y,
    existsi g y,
    exact congr_fun f_rond_g y }
end

example (G H : Type) [group G] [group H] (f : G → H)
  (Hyp : ∀ a b : G, f (a*b) = f a * f b) : f 1 = 1 :=
begin
  have clef := calc
   f 1 = f (1*1) : by simp
   ... = f 1 * f 1 : Hyp 1 1,
  exact mul_self_iff_eq_one.1 (eq.symm clef)
end

example (u : ℕ → ℝ) (H : ∀ n, u (n+1) = 2*u n) (H' : u 0 > 0) :
  ∀ n, u n > 0 :=
begin
  intro n,
  induction n with n IH,
  { exact H' },
  { rw H,
    apply mul_pos,
    norm_num,
    exact IH }
end


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import algebra.direct_limit
import field_theory.is_alg_closed.basic
import field_theory.splitting_field
/-!
# Algebraic Closure

In this file we construct the algebraic closure of a field

## Main Definitions

- `algebraic_closure k` is an algebraic closure of `k` (in the same universe).
  It is constructed by taking the polynomial ring generated by indeterminates `x_f`
  corresponding to monic irreducible polynomials `f` with coefficients in `k`, and quotienting
  out by a maximal ideal containing every `f(x_f)`, and then repeating this step countably
  many times. See Exercise 1.13 in Atiyah--Macdonald.

## Tags

algebraic closure, algebraically closed
-/

universes u v w
noncomputable theory
open_locale classical big_operators polynomial
open polynomial

variables (k : Type u) [field k]

namespace algebraic_closure

open mv_polynomial

/-- The subtype of monic irreducible polynomials -/
@[reducible] def monic_irreducible : Type u :=
{ f : k[X] // monic f ∧ irreducible f }

/-- Sends a monic irreducible polynomial `f` to `f(x_f)` where `x_f` is a formal indeterminate. -/
def eval_X_self (f : monic_irreducible k) : mv_polynomial (monic_irreducible k) k :=
polynomial.eval₂ mv_polynomial.C (X f) f

/-- The span of `f(x_f)` across monic irreducible polynomials `f` where `x_f` is an
indeterminate. -/
def span_eval : ideal (mv_polynomial (monic_irreducible k) k) :=
ideal.span $ set.range $ eval_X_self k

/-- Given a finset of monic irreducible polynomials, construct an algebra homomorphism to the
splitting field of the product of the polynomials sending each indeterminate `x_f` represented by
the polynomial `f` in the finset to a root of `f`. -/
def to_splitting_field (s : finset (monic_irreducible k)) :
  mv_polynomial (monic_irreducible k) k →ₐ[k] splitting_field (∏ x in s, x : k[X]) :=
mv_polynomial.aeval $ λ f,
  if hf : f ∈ s
  then root_of_splits _
    ((splits_prod_iff _ $ λ (j : monic_irreducible k) _, j.2.2.ne_zero).1
      (splitting_field.splits _) f hf)
    (mt is_unit_iff_degree_eq_zero.2 f.2.2.not_unit)
  else 37

theorem to_splitting_field_eval_X_self {s : finset (monic_irreducible k)} {f} (hf : f ∈ s) :
  to_splitting_field k s (eval_X_self k f) = 0 :=
by { rw [to_splitting_field, eval_X_self, ← alg_hom.coe_to_ring_hom, hom_eval₂,
         alg_hom.coe_to_ring_hom, mv_polynomial.aeval_X, dif_pos hf,
         ← algebra_map_eq, alg_hom.comp_algebra_map],
  exact map_root_of_splits _ _ _ }

theorem span_eval_ne_top : span_eval k ≠ ⊤ :=
begin
  rw [ideal.ne_top_iff_one, span_eval, ideal.span, ← set.image_univ,
    finsupp.mem_span_image_iff_total],
  rintros ⟨v, _, hv⟩,
  replace hv := congr_arg (to_splitting_field k v.support) hv,
  rw [alg_hom.map_one, finsupp.total_apply, finsupp.sum, alg_hom.map_sum, finset.sum_eq_zero] at hv,
  { exact zero_ne_one hv },
  intros j hj,
  rw [smul_eq_mul, alg_hom.map_mul, to_splitting_field_eval_X_self k hj, mul_zero]
end

/-- A random maximal ideal that contains `span_eval k` -/
def max_ideal : ideal (mv_polynomial (monic_irreducible k) k) :=
classical.some $ ideal.exists_le_maximal _ $ span_eval_ne_top k

instance max_ideal.is_maximal : (max_ideal k).is_maximal :=
(classical.some_spec $ ideal.exists_le_maximal _ $ span_eval_ne_top k).1

theorem le_max_ideal : span_eval k ≤ max_ideal k :=
(classical.some_spec $ ideal.exists_le_maximal _ $ span_eval_ne_top k).2

/-- The first step of constructing `algebraic_closure`: adjoin a root of all monic polynomials -/
def adjoin_monic : Type u :=
mv_polynomial (monic_irreducible k) k ⧸ max_ideal k

instance adjoin_monic.field : field (adjoin_monic k) :=
ideal.quotient.field _

instance adjoin_monic.inhabited : inhabited (adjoin_monic k) := ⟨37⟩

/-- The canonical ring homomorphism to `adjoin_monic k`. -/
def to_adjoin_monic : k →+* adjoin_monic k :=
(ideal.quotient.mk _).comp C

instance adjoin_monic.algebra : algebra k (adjoin_monic k) :=
(to_adjoin_monic k).to_algebra

theorem adjoin_monic.algebra_map : algebra_map k (adjoin_monic k) = (ideal.quotient.mk _).comp C :=
rfl

theorem adjoin_monic.is_integral (z : adjoin_monic k) : is_integral k z :=
let ⟨p, hp⟩ := ideal.quotient.mk_surjective z in hp ▸
mv_polynomial.induction_on p (λ x, is_integral_algebra_map) (λ p q, is_integral_add)
  (λ p f ih, @is_integral_mul _ _ _ _ _ _ (ideal.quotient.mk _ _) ih ⟨f, f.2.1,
    by { erw [adjoin_monic.algebra_map, ← hom_eval₂,
              ideal.quotient.eq_zero_iff_mem],
      exact le_max_ideal k (ideal.subset_span ⟨f, rfl⟩) }⟩)

theorem adjoin_monic.exists_root {f : k[X]} (hfm : f.monic) (hfi : irreducible f) :
  ∃ x : adjoin_monic k, f.eval₂ (to_adjoin_monic k) x = 0 :=
⟨ideal.quotient.mk _ $ X (⟨f, hfm, hfi⟩ : monic_irreducible k),
 by { rw [to_adjoin_monic, ← hom_eval₂, ideal.quotient.eq_zero_iff_mem],
      exact le_max_ideal k (ideal.subset_span $ ⟨_, rfl⟩) }⟩

/-- The `n`th step of constructing `algebraic_closure`, together with its `field` instance. -/
def step_aux (n : ℕ) : Σ α : Type u, field α :=
nat.rec_on n ⟨k, infer_instance⟩ $ λ n ih, ⟨@adjoin_monic ih.1 ih.2, @adjoin_monic.field ih.1 ih.2⟩

/-- The `n`th step of constructing `algebraic_closure`. -/
def step (n : ℕ) : Type u :=
(step_aux k n).1

instance step.field (n : ℕ) : field (step k n) :=
(step_aux k n).2

instance step.inhabited (n) : inhabited (step k n) := ⟨37⟩

/-- The canonical inclusion to the `0`th step. -/
def to_step_zero : k →+* step k 0 :=
ring_hom.id k

/-- The canonical ring homomorphism to the next step. -/
def to_step_succ (n : ℕ) : step k n →+* step k (n + 1) :=
@to_adjoin_monic (step k n) (step.field k n)

instance step.algebra_succ (n) : algebra (step k n) (step k (n + 1)) :=
(to_step_succ k n).to_algebra

theorem to_step_succ.exists_root {n} {f : polynomial (step k n)}
  (hfm : f.monic) (hfi : irreducible f) :
  ∃ x : step k (n + 1), f.eval₂ (to_step_succ k n) x = 0 :=
@adjoin_monic.exists_root _ (step.field k n) _ hfm hfi

/-- The canonical ring homomorphism to a step with a greater index. -/
def to_step_of_le (m n : ℕ) (h : m ≤ n) : step k m →+* step k n :=
{ to_fun := nat.le_rec_on h (λ n, to_step_succ k n),
  map_one' := begin
    induction h with n h ih, { exact nat.le_rec_on_self 1 },
    rw [nat.le_rec_on_succ h, ih, ring_hom.map_one]
  end,
  map_mul' := λ x y, begin
    induction h with n h ih, { simp_rw nat.le_rec_on_self },
    simp_rw [nat.le_rec_on_succ h, ih, ring_hom.map_mul]
  end,
  map_zero' := begin
    induction h with n h ih, { exact nat.le_rec_on_self 0 },
    rw [nat.le_rec_on_succ h, ih, ring_hom.map_zero]
  end,
  map_add' := λ x y, begin
    induction h with n h ih, { simp_rw nat.le_rec_on_self },
    simp_rw [nat.le_rec_on_succ h, ih, ring_hom.map_add]
  end }

@[simp] lemma coe_to_step_of_le (m n : ℕ) (h : m ≤ n) :
  (to_step_of_le k m n h : step k m → step k n) = nat.le_rec_on h (λ n, to_step_succ k n) :=
rfl

instance step.algebra (n) : algebra k (step k n) :=
(to_step_of_le k 0 n n.zero_le).to_algebra

instance step.scalar_tower (n) : is_scalar_tower k (step k n) (step k (n + 1)) :=
is_scalar_tower.of_algebra_map_eq $ λ z,
  @nat.le_rec_on_succ (step k) 0 n n.zero_le (n + 1).zero_le (λ n, to_step_succ k n) z

theorem step.is_integral (n) : ∀ z : step k n, is_integral k z :=
nat.rec_on n (λ z, is_integral_algebra_map) $ λ n ih z,
  is_integral_trans ih _ (adjoin_monic.is_integral (step k n) z : _)

instance to_step_of_le.directed_system :
  directed_system (step k) (λ i j h, to_step_of_le k i j h) :=
⟨λ i x h, nat.le_rec_on_self x, λ i₁ i₂ i₃ h₁₂ h₂₃ x, (nat.le_rec_on_trans h₁₂ h₂₃ x).symm⟩

end algebraic_closure

/-- The canonical algebraic closure of a field, the direct limit of adding roots to the field for
each polynomial over the field. -/
def algebraic_closure : Type u :=
ring.direct_limit (algebraic_closure.step k) (λ i j h, algebraic_closure.to_step_of_le k i j h)

namespace algebraic_closure

instance : field (algebraic_closure k) :=
field.direct_limit.field _ _

instance : inhabited (algebraic_closure k) := ⟨37⟩

/-- The canonical ring embedding from the `n`th step to the algebraic closure. -/
def of_step (n : ℕ) : step k n →+* algebraic_closure k :=
ring.direct_limit.of _ _ _

instance algebra_of_step (n) : algebra (step k n) (algebraic_closure k) :=
(of_step k n).to_algebra

theorem of_step_succ (n : ℕ) : (of_step k (n + 1)).comp (to_step_succ k n) = of_step k n :=
ring_hom.ext $ λ x, show ring.direct_limit.of (step k) (λ i j h, to_step_of_le k i j h) _ _ = _,
  by { convert ring.direct_limit.of_f n.le_succ x, ext x, exact (nat.le_rec_on_succ' x).symm }

theorem exists_of_step (z : algebraic_closure k) : ∃ n x, of_step k n x = z :=
ring.direct_limit.exists_of z

-- slow
theorem exists_root {f : polynomial (algebraic_closure k)}
  (hfm : f.monic) (hfi : irreducible f) :
  ∃ x : algebraic_closure k, f.eval x = 0 :=
begin
  have : ∃ n p, polynomial.map (of_step k n) p = f,
  { convert ring.direct_limit.polynomial.exists_of f },
  unfreezingI { obtain ⟨n, p, rfl⟩ := this },
  rw monic_map_iff at hfm,
  have := hfm.irreducible_of_irreducible_map (of_step k n) p hfi,
  obtain ⟨x, hx⟩ := to_step_succ.exists_root k hfm this,
  refine ⟨of_step k (n + 1) x, _⟩,
  rw [← of_step_succ k n, eval_map, ← hom_eval₂, hx, ring_hom.map_zero]
end

instance : is_alg_closed (algebraic_closure k) :=
is_alg_closed.of_exists_root _ $ λ f, exists_root k

instance {R : Type*} [comm_semiring R] [alg : algebra R k] :
  algebra R (algebraic_closure k) :=
((of_step k 0).comp (@algebra_map _ _ _ _ alg)).to_algebra

lemma algebra_map_def {R : Type*} [comm_semiring R] [alg : algebra R k] :
  algebra_map R (algebraic_closure k) = ((of_step k 0 : k →+* _).comp (@algebra_map _ _ _ _ alg)) :=
rfl

instance {R S : Type*} [comm_semiring R] [comm_semiring S]
  [algebra R S] [algebra S k] [algebra R k] [is_scalar_tower R S k] :
  is_scalar_tower R S (algebraic_closure k) :=
is_scalar_tower.of_algebra_map_eq (λ x,
  ring_hom.congr_arg _ (is_scalar_tower.algebra_map_apply R S k x : _))

/-- Canonical algebra embedding from the `n`th step to the algebraic closure. -/
def of_step_hom (n) : step k n →ₐ[k] algebraic_closure k :=
{ commutes' := λ x, ring.direct_limit.of_f n.zero_le x,
  .. of_step k n }

theorem is_algebraic : algebra.is_algebraic k (algebraic_closure k) :=
λ z, is_algebraic_iff_is_integral.2 $ let ⟨n, x, hx⟩ := exists_of_step k z in
hx ▸ map_is_integral (of_step_hom k n) (step.is_integral k n x)

instance : is_alg_closure k (algebraic_closure k) :=
⟨algebraic_closure.is_alg_closed k, is_algebraic k⟩

end algebraic_closure


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

import algebra.char_p.basic
import algebra.ring_quot

/-!
# Characteristic of quotients rings
-/

universes u v

namespace char_p

theorem quotient (R : Type u) [comm_ring R] (p : ℕ) [hp1 : fact p.prime] (hp2 : ↑p ∈ nonunits R) :
  char_p (ideal.span {p} : ideal R).quotient p :=
have hp0 : (p : (ideal.span {p} : ideal R).quotient) = 0,
  from (ideal.quotient.mk (ideal.span {p} : ideal R)).map_nat_cast p ▸
    ideal.quotient.eq_zero_iff_mem.2 (ideal.subset_span $ set.mem_singleton _),
ring_char.of_eq $ or.resolve_left ((nat.dvd_prime hp1.1).1 $ ring_char.dvd hp0) $ λ h1,
hp2 $ is_unit_iff_dvd_one.2 $ ideal.mem_span_singleton.1 $ ideal.quotient.eq_zero_iff_mem.1 $
@@subsingleton.elim (@@char_p.subsingleton _ $ ring_char.of_eq h1) _ _

/-- If an ideal does not contain any coercions of natural numbers other than zero, then its quotient
inherits the characteristic of the underlying ring. -/
lemma quotient' {R : Type*} [comm_ring R] (p : ℕ) [char_p R p] (I : ideal R)
  (h : ∀ x : ℕ, (x : R) ∈ I → (x : R) = 0) :
  char_p I.quotient p :=
⟨λ x, begin
  rw [←cast_eq_zero_iff R p x, ←(ideal.quotient.mk I).map_nat_cast],
  refine quotient.eq'.trans (_ : ↑x - 0 ∈ I ↔ _),
  rw sub_zero,
  exact ⟨h x, λ h', h'.symm ▸ I.zero_mem⟩,
end⟩

end char_p


import tuto_lib
/-
This file continues the elementary study of limits of sequences.
It can be skipped if the previous file was too easy, it won't introduce
any new tactic or trick.

Remember useful lemmas:

abs_le (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

abs_add (x y : ℝ) : |x + y| ≤ |x| + |y|

abs_sub (x y : ℝ) : |x - y| = |y - x|

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

and the definition:

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

You can also use a property proved in the previous file:

unique_limit : seq_limit u l → seq_limit u l' → l = l'

def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m
-/

variable { φ : ℕ → ℕ}

/-
The next lemma is proved by an easy induction, but we haven't seen induction
in this tutorial. If you did the natural number game then you can delete
the proof below and try to reconstruct it.
-/
/-- An extraction is greater than id -/
lemma id_le_extraction' : extraction φ → ∀ n, n ≤ φ n :=
begin
  intros hyp n,
  induction n with n hn,
  { exact nat.zero_le _ },
  { exact nat.succ_le_of_lt (by linarith [hyp n (n+1) (by linarith)]) },
end

/-- Extractions take arbitrarily large values for arbitrarily large
inputs. -/
-- 0039
lemma extraction_ge : extraction φ → ∀ N N', ∃ n ≥ N', φ n ≥ N :=
begin
  sorry
end

/-- A real number `a` is a cluster point of a sequence `u`
if `u` has a subsequence converging to `a`.

def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a
-/

variables {u : ℕ → ℝ} {a l : ℝ}

/-
In the exercise, we use `∃ n ≥ N, ...` which is the abbreviation of
`∃ n, n ≥ N ∧ ...`.
Lean can read this abbreviation, but displays it as the confusing:
`∃ (n : ℕ) (H : n ≥ N)`
One gets used to it. Alternatively, one can get rid of it using the lemma
  exists_prop {p q : Prop} : (∃ (h : p), q) ↔ p ∧ q
-/

/-- If `a` is a cluster point of `u` then there are values of
`u` arbitrarily close to `a` for arbitrarily large input. -/
-- 0040
lemma near_cluster :
  cluster_point u a → ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
begin
  sorry
end

/-
The above exercice can be done in five lines.
Hint: you can use the anonymous constructor syntax when proving
existential statements.
-/

/-- If `u` tends to `l` then its subsequences tend to `l`. -/
-- 0041
lemma subseq_tendsto_of_tendsto' (h : seq_limit u l) (hφ : extraction φ) :
seq_limit (u ∘ φ) l :=
begin
  sorry
end

/-- If `u` tends to `l` all its cluster points are equal to `l`. -/
-- 0042
lemma cluster_limit (hl : seq_limit u l) (ha : cluster_point u a) : a = l :=
begin
  sorry
end

/-- Cauchy_sequence sequence -/
def cauchy_sequence (u : ℕ → ℝ) := ∀ ε > 0, ∃ N, ∀ p q, p ≥ N → q ≥ N → |u p - u q| ≤ ε

-- 0043
example : (∃ l, seq_limit u l) → cauchy_sequence u :=
begin
  sorry
end

/-
In the next exercise, you can reuse
 near_cluster : cluster_point u a → ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε
-/
-- 0044
example (hu : cauchy_sequence u) (hl : cluster_point u l) : seq_limit u l :=
begin
  sorry
end


import data.real.basic

noncomputable theory

-- Ce fichier prolonge un travail de Frédéric Le Roux qui a traité --
-- des propriétés topologiques des espaces métriques --

open set
open_locale classical

-- Une structure d'espace pré-métrique sur un type X --
class espace_pre_metrique (X : Type*) :=
(d : X → X → ℝ)
(d_pos : ∀ x y, d x y ≥ 0)
(presep : ∀ x y, x=y → d x y = 0)
(sym : ∀ x y, d x y = d y x)
(triangle : ∀ x y z, d x z ≤ d x y + d y z)

-- Une structure d'espace métrique sur un type X --
class espace_metrique (X : Type*) :=
(d : X → X → ℝ)
(d_pos : ∀ x y, d x y ≥ 0)
(presep : ∀ x y, x=y → d x y = 0)
(sep : ∀ x y, d x y = 0 →  x = y)
(sym : ∀ x y, d x y = d y x)
(triangle : ∀ x y z, d x z ≤ d x y + d y z)

open espace_metrique
-- open espace_pre_metrique --

/-- Instantiation des réels comme espace métrique. -/
instance real.metric_space : espace_metrique ℝ :=
{ d                  := λx y, abs (x - y),
  d_pos              := by simp [abs_nonneg],
  presep             := begin simp, apply sub_eq_zero_of_eq end,
  sep                := begin simp, apply eq_of_sub_eq_zero end,
  sym                := assume x y, abs_sub _ _,
  triangle           := assume x y z, abs_sub_le _ _ _ }

theorem real.dist_eq (x y : ℝ) : d x y = abs (x - y) := rfl

theorem real.dist_0_eq_abs (x : ℝ) : d x 0 = abs x :=
by simp [real.dist_eq]


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

namespace Cpdt
namespace Chapter3

def Bool.toProp : Bool → Prop := fun b => if b then True else False
theorem Bool.toProp_false : Bool.toProp false = False := by rfl
theorem Bool.toProp_true : Bool.toProp true = True := by rfl

theorem true_neq_false : true ≠ false := by
  intro h
  rw [←Bool.toProp_false]
  rw [←h]
  rw [Bool.toProp_true]
  exact True.intro

theorem s_inj : Nat.succ n = Nat.succ m → n = m := by
  intro h
  rw [←Nat.pred_succ n]
  rw [←Nat.pred_succ m]
  rw [h]

end Chapter3
end Cpdt


import data.nat.prime
import data.nat.parity
import tactic

example (P : Prop) : ¬ ¬ ¬ P → ¬ P :=
begin
  intros nnnp p, apply nnnp,
  intro np, apply np,
  apply p,
end

example (p : ℕ) : p.prime → p = 2 ∨ p % 2 = 1 :=
begin
  library_search,
end

#check @nat.prime.eq_two_or_odd

lemma eq_two_of_even_prime {p : ℕ} (hp : nat.prime p) (h_even : nat.even p) : p = 2 :=
begin
  cases nat.prime.eq_two_or_odd hp, {assumption},
  rw ← nat.not_even_iff at h, contradiction,
end

lemma even_of_odd_add_odd
  {a b : ℕ} (ha : ¬ nat.even a) (hb : ¬ nat.even b) :
nat.even (a + b) :=
begin
  rw nat.even_add, tauto,
end

lemma one_lt_of_nontrivial_factor
  {b c : ℕ} (hb : b < b * c) :
1 < c :=
begin

  rw ← mul_one b at hb,
  contrapose! hb,
  suggest,
  interval_cases c,
  -- ⊢ b * 0 ≤ b
  simp,
  -- ⊢ b * 1 ≤ b
  simp,
end
example (n : ℕ) : 0 < n ↔ n ≠ 0 :=
begin
  split,
  {intros, linarith,},
  contrapose!,
  simp,
end

lemma nontrivial_product_of_not_prime
  {k : ℕ} (hk : ¬ k.prime) (two_le_k : 2 ≤ k) :
∃ a b < k, 1 < a ∧ 1 < b ∧ a * b = k :=
begin
  have h1 := nat.exists_dvd_of_not_prime2 two_le_k hk,
  rcases h1 with ⟨a, ⟨b, hb⟩, ha1, ha2⟩,
  use [a, b], norm_num,
  split, assumption,
  split, rw [hb, lt_mul_iff_one_lt_left], linarith,
  cases b, {linarith}, {simp},
  split, linarith,
  split, rw hb at ha2, apply one_lt_of_nontrivial_factor ha2,
  rw hb,
end

-- norm_num, linarith
theorem three_fac_of_sum_consecutive_primes
  {p q : ℕ} (hp : p.prime) (hq : q.prime) (hpq : p < q)
  (p_ne_2 : p ≠ 2) (q_ne_2 : q ≠ 2)
  (consecutive : ∀ k, p < k → k < q → ¬ k.prime) :
∃ a b c, p + q = a * b * c ∧ a > 1 ∧ b > 1 ∧ c > 1 :=
begin
  use 2, have h1 : nat.even (p + q),
  { apply even_of_odd_add_odd,
    contrapose! p_ne_2, apply eq_two_of_even_prime; assumption,
    contrapose! q_ne_2, apply eq_two_of_even_prime; assumption, },

  cases h1 with k hk,
  have hk' : ¬ k.prime,
  { apply consecutive; linarith },

  have h2k : 2 ≤ k, { have := nat.prime.two_le hp, linarith, },
  have h2 := nat.exists_dvd_of_not_prime2 _ hk',
  swap, { exact h2k }, -- for some reason I think it's interesting to have the student remember that they've already proved this
  rcases nontrivial_product_of_not_prime hk' h2k with ⟨ b, c, hbk, hck, hb1, hc1, hbc⟩,
  use [b,c],
  split, { rw [hk, ← hbc], ring },
  split, { norm_num },
  split; assumption,
end


/-
Define eigenvalues and eigenspaces of matrices and prove new theorems about them.
-/

import data.matrix.basic
import tactic
import linear_algebra.determinant
import .algebraically_closed
import linear_algebra.nonsingular_inverse
import linear_algebra.char_poly

noncomputable theory
open matrix
open_locale matrix
open_locale classical

-- comm_semiring = semiring α, comm_monoid α
-- comm_ring = ring + semigroup
-- semiring = add_comm_monoid α, monoid_with_zero α, distrib α

universes u

variables {S : Type*} [semiring S]
variables {R : Type*} [ring R]
variables {k : Type*} [field k]
variables {l m n o : Type*} [fintype l] [fintype m] [fintype n] [fintype o]

namespace matrix

def eigenvector (M : matrix n n S) : (n → S) → Prop :=
λ v, ∃ c : S, v ≠ 0 ∧ M.mul_vec v = (c • (1 : matrix n n S)).mul_vec v

def eigenvalue (M : matrix n n S) : S → Prop :=
λ c, ∃ v : n → S, v ≠ 0 ∧ M.mul_vec v = (c • (1 : matrix n n S)).mul_vec v

def eigenvalue_of_eigenvector {M : matrix n n S} {v : n → S}
(hc : eigenvector M v) : S :=
begin
  choose c key using hc,
  exact c,
end

def eigenspace (M : matrix n n S) (c : S) : set (n → S) :=
{v | v = 0 ∨ ((eigenvector M v) ∧ M.mul_vec v = (c • (1 : matrix n n S)).mul_vec v) }

def spectrum (M : matrix n n S) : set S :=
{c | eigenvalue M c}

-- def generalized_eigenspace (M : matrix n n R) (c : R) : set (n → R) :=
-- {v | ∃ k : ℕ, (M - c • 1)^k.mul_vec v = 0}
-- end matrix
end matrix

instance (M : matrix n n S) (c : S) : add_comm_monoid (matrix.eigenspace M c) :=
{ add := sorry,
  add_assoc := sorry,
  zero := sorry,
  zero_add := sorry,
  add_zero := sorry,
  add_comm := sorry }

instance (M : matrix n n S) (c : S) : semimodule S (matrix.eigenspace M c) :=
{ smul := sorry,
  one_smul := sorry,
  mul_smul := sorry,
  smul_add := sorry,
  smul_zero := sorry,
  add_smul := sorry,
  zero_smul := sorry }

#check mul_vec

lemma det_zero_iff_sing {M : matrix n n k} :
  M.det = 0 ↔ ∃ v : n → k, v ≠ 0 ∧ M.mul_vec v = 0 :=
begin
repeat{sorry,},
end

lemma eigenvalue_det {M : matrix n n k} {c : k} :
  (M - c • 1).det = 0 ↔ M.eigenvalue c :=
begin
  sorry,
end

#check mul_nonsing_inv

theorem exists_eigenvalue (M : matrix n n ℂ) : (∃ c : ℂ, matrix.eigenvalue M c) :=
begin
  let k:= ℂ,
  suffices : ∃ c : k, (M - c • 1).det = 0, by sorry,
  set f := char_poly M,
  have hf_deg : 0 < f.degree, by sorry,
  sorry,
end

#check exists_eigenvalue


-- Lucas Moschen
-- Teorema de Cantor

import data.set

variables X Y: Type

def surjective {X: Type} {Y: Type} (f : X → Y) : Prop := ∀ y, ∃ x, f x = y

theorem Cantor : ∀ (A: set X), ¬ ∃ (f: A → set A),  surjective f :=

    begin
        intro A,
        intro h,
        cases h with f h1,
        have h2: ∃ x, f x = {t : A | ¬ (t ∈ f t)}, from h1 {t : A | ¬ (t ∈ f t)},
        cases h2 with x h3,
        apply or.elim (classical.em (x ∈ {t : A | ¬ (t ∈ f t)})),
            intro h4,
                have h5: ¬ (x ∈ f x), from h4,
                rw (eq.symm h3) at h4,
                apply h5 h4,
            intro h4,
                rw (eq.symm h3) at h4,
                have h5: x ∈ {t : A | ¬ (t ∈ f t)}, from h4,
                rw (eq.symm h3) at h5,
                apply h4 h5,
    end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/

import ring_theory.ideal.operations
import linear_algebra.finsupp_vector_space
import algebra.char_p.basic

/-!
# Multivariate polynomials over commutative rings

This file contains basic facts about multivariate polynomials over commutative rings, for example
that the monomials form a basis.

## Main definitions

* `restrict_total_degree σ R m`: the subspace of multivariate polynomials indexed by `σ` over the
  commutative ring `R` of total degree at most `m`.
* `restrict_degree σ R m`: the subspace of multivariate polynomials indexed by `σ` over the
  commutative ring `R` such that the degree in each individual variable is at most `m`.

## Main statements

* The multivariate polynomial ring over a commutative ring of positive characteristic has positive
  characteristic.
* `is_basis_monomials`: shows that the monomials form a basis of the vector space of multivariate
  polynomials.

## TODO

Generalise to noncommutative (semi)rings
-/

noncomputable theory

open_locale classical

open set linear_map submodule
open_locale big_operators

universes u v
variables (σ : Type u) (R : Type v) [comm_ring R] (p m : ℕ)

namespace mv_polynomial

section char_p

instance [char_p R p] : char_p (mv_polynomial σ R) p :=
{ cast_eq_zero_iff := λ n, by rw [← C_eq_coe_nat, ← C_0, C_inj, char_p.cast_eq_zero_iff R p] }

end char_p

section homomorphism

lemma map_range_eq_map {R S : Type*} [comm_ring R] [comm_ring S] (p : mv_polynomial σ R)
  (f : R →+* S) :
  finsupp.map_range f f.map_zero p = map f p :=
begin
  rw [← finsupp.sum_single p, finsupp.sum],
  -- It's not great that we need to use an `erw` here,
  -- but hopefully it will become smoother when we move entirely away from `is_semiring_hom`.
  erw [finsupp.map_range_finset_sum (f : R →+ S)],
  rw [← (finsupp.support p).sum_hom (map f)],
  { refine finset.sum_congr rfl (assume n _, _),
    rw [finsupp.map_range_single, ← monomial, ← monomial, map_monomial], refl, },
  apply_instance
end

end homomorphism

section degree

/-- The submodule of polynomials of total degree less than or equal to `m`.-/
def restrict_total_degree : submodule R (mv_polynomial σ R) :=
finsupp.supported _ _ {n | n.sum (λn e, e) ≤ m }

/-- The submodule of polynomials such that the degree with respect to each individual variable is
less than or equal to `m`.-/
def restrict_degree (m : ℕ) : submodule R (mv_polynomial σ R) :=
finsupp.supported _ _ {n | ∀i, n i ≤ m }

variable {R}

lemma mem_restrict_total_degree (p : mv_polynomial σ R) :
  p ∈ restrict_total_degree σ R m ↔ p.total_degree ≤ m :=
begin
  rw [total_degree, finset.sup_le_iff],
  refl
end

lemma mem_restrict_degree (p : mv_polynomial σ R) (n : ℕ) :
  p ∈ restrict_degree σ R n ↔ (∀s ∈ p.support, ∀i, (s : σ →₀ ℕ) i ≤ n) :=
begin
  rw [restrict_degree, finsupp.mem_supported],
  refl
end

lemma mem_restrict_degree_iff_sup (p : mv_polynomial σ R) (n : ℕ) :
  p ∈ restrict_degree σ R n ↔ ∀i, p.degrees.count i ≤ n :=
begin
  simp only [mem_restrict_degree, degrees, multiset.count_sup, finsupp.count_to_multiset,
    finset.sup_le_iff],
  exact ⟨assume h n s hs, h s hs n, assume h s hs n, h n s hs⟩
end

variables (σ R)

lemma is_basis_monomials :
  is_basis R ((λs, (monomial s 1 : mv_polynomial σ R))) :=
suffices is_basis R (λ (sa : Σ _, unit), (monomial sa.1 1 : mv_polynomial σ R)),
begin
  apply is_basis.comp this (λ (s : σ →₀ ℕ), ⟨s, punit.star⟩),
  split,
  { intros x y hxy,
    simpa using hxy },
  { rintros ⟨x₁, x₂⟩,
    use x₁,
    rw punit_eq punit.star x₂ }
end,
begin
  apply finsupp.is_basis_single (λ _ _, (1 : R)),
  intro _,
  apply is_basis_singleton_one,
end

end degree

end mv_polynomial


import tactic

open set

structure topological_space (X : Type) :=
(is_open : set X → Prop)
(is_open_univ : is_open (univ : set X))
(is_open_inter : ∀(U V : set X), is_open U → is_open V → is_open (U ∩ V))
(is_open_union : ∀s, (∀t∈s, is_open t) → is_open ⋃₀ s)

attribute [class] topological_space
def is_open {X : Type} [t : topological_space X] (U : set X) := topological_space.is_open t U

variables {X Y E B: Type} [topological_space X] [topological_space Y]
[topological_space E] [topological_space B]

def is_continuous (f : X → Y) : Prop := ∀{V : set Y} (hV : is_open V), is_open (f⁻¹' V)
def is_hausdorff (Z : Type) [topological_space Z] : Prop := ∀{x y : Z}, x ≠ y →
∃(U V : set Z) (hU : is_open U) (hV : is_open V) (hUx : x ∈ U) (hVy : y ∈ V),
U ∩ V = ∅
def is_dense (D : set X) : Prop := ∀{U : set X}(U_open : is_open U) (U_nonempty : U ≠ ∅),
∃(d ∈ D), d ∈ U

lemma eq_of_agree_on_dense {f g : X → Y} (hY : is_hausdorff Y) (hf : is_continuous f)
(hg : is_continuous g) {D : set X} (D_dense : is_dense D)
(hfg : ∀{d}, d ∈ D → f d = g d) : f = g :=
begin
	-- Assume for contradiction that f(x) ≠ g(x) for some x ∈ X.
	ext,
	by_contra,
	-- Fix disjoint open neighborhoods U and V around f(x) and g(x) respectively.
	rcases hY h with ⟨U, V, U_open, V_open, hxU, hxV, hUV⟩,

	-- By continuity, f⁻¹(U) and g⁻¹(V) are both open,
	have U_inv_open := hf U_open,
	have V_inv_open := hg V_open,

	-- which means their intersection must also be open.
	have  UV_inv_open := _inst_1.is_open_inter (f ⁻¹' U) (g ⁻¹' V) U_inv_open V_inv_open,
	-- It is also nonempty, since it contains x.
	have UV_nonempty : (f ⁻¹' U ∩ g ⁻¹' V) ≠ ∅ := λcontra,
	eq_empty_iff_forall_not_mem.mp contra x ⟨hxU, hxV⟩,

	-- Hence there is some d ∈ D with d ∈ f⁻¹(U) ∩ g⁻¹(V).
	rcases D_dense UV_inv_open UV_nonempty with ⟨d, d_D, d_inter⟩,

	-- Thus f(d) ∈ U and g(d) ∈ V.
	rw mem_inter_iff at d_inter,
	have hfd : f d ∈ U := d_inter.1,
	have hgd : g d ∈ V := d_inter.2,

	-- But f(d) = g(d),
	rw← hfg d_D at hgd,
	-- so f(d) ∈ U ∩ V = ∅,
	have contra : f d ∈ U ∩ V := ⟨hfd, hgd⟩,
	-- which is a contradiction.
	rw hUV at contra,
	exact not_mem_empty (f d) contra,
end

variables {f : X → Y} {hf : is_continuous f}

def converges_to (a : ℕ → X) (L : X) : Prop :=
∀{U : set X} (hU : is_open U) (hUL : L ∈ U), ∃(N : ℕ), ∀{n : ℕ}, n ≥ N → a n ∈ U

lemma converges_unique_of_hausdorff {a : ℕ → X} {L M : X} (hX : is_hausdorff X)
(hL : converges_to a L) (hM : converges_to a M) : L = M :=
begin
	by_cases h : L = M, {exact h}, exfalso,

	rcases hX h with ⟨U, V, hU, hV, hUx, hVy, hUV⟩,
	rcases hL hU hUx with ⟨N, hN⟩,
	rcases hM hV hVy with ⟨M, hM⟩,

	have hcontra1 := hN (le_max_left N M),
	have hcontra2 := hM (le_max_right N M),
	have hcontra : a (max N M) ∈ (U ∩ V) := ⟨hcontra1, hcontra2⟩,

	finish,
end

lemma converges_of_continuous {a : ℕ → X} {L : X} (hL : converges_to a L) {f : X → Y}
(hf : is_continuous f) : converges_to (f∘a) (f L) :=
begin
	intros U hU hUL,
	have hU' := hf hU,
	cases hL hU' hUL with N hN,
	use N,
	finish,
end

structure continuous_map (A : Type) (B : Type)
[topological_space A] [topological_space B] :=
(f : A → B)
(f_continuous : is_continuous f)

structure homeomorphism :=
(map : continuous_map X Y)
(is_bijection : function.bijective map.f)

def maps_homeomorphically (p : E → B) (U : set E) := (restrict p U)


import tactic

-- Exercise 1

-- (a)
variables p q : Prop
variable given1 : (p ∧ q)
example : p :=
show p, from and.left given1

-- (b)
--example : (p ∧ q → p) :=
--assume h1 : (p ∧ q),
--show p, from and.left h1

-- (c)
example : p → (q → p) :=
begin
  assume h1,
  assume h2,
  exact h1,
end

-- (d)
example: p → (q → p ∧ q) :=
begin
  assume h1,
  assume h2,
  split,
  exact h1,
  exact h2,
end
-- (f)
variable r : Prop
example : (p → (q → r)) → ((p → q) → (p → r)) :=
begin
  assume h1: p → (q → r),
  assume h2: p → q,
  assume h3: p,
  apply h1,
  exact h3,
  apply h2,
  exact h3,

end
-- (e)
example : (p → (q → r)) → (p ∧ q → r) :=
begin
  assume h1,
  assume h2: p ∧ q,
  cases h2 with h3 h4,
  apply h1,
  exact h3,
  exact h4,

end

-- (g)
example : ((p ∧ q) → r) → (p → (q → r)) :=
begin
  intro h1,
  intro h2,
  intro h3,
  apply h1,
  split,
  exact h2,
  exact h3,

end

-- (h)
example : (p ∧ q) → (p ∨ q) :=
begin
  intro h1,
  cases h1 with h2 h3,
  left,
  exact h2,

end

-- (i)
example : p → (q → p) :=
begin
  intro h1,
  intro h2,
  exact h1,

end

-- (j)
example : p ∧ (q ∨ (p → q)) → p ∧ q :=
begin
  intro h1,
  cases h1 with h2 h3,
  split,
  exact h2,
  cases h3 with h4 h5,
  exact h4,
  apply h5,
  exact h2,

end

-- 2.
-- (a)
example : p ∧ (p → q) → p ∧ q :=
begin
  intro h1,
  cases h1 with h1 h2,
  split,
  exact h1,
  apply h2,
  exact h1,

end

-- (b)
example : (q → r) → ((p → q) → (p → r)) :=
begin
  intro h1,
  intro h2,
  intro h3,
  apply h1,
  apply h2,
  exact h3,

end

-- (c)
example : (p ∧ (q ∨ r)) → (p ∧ q) ∨ (p ∧ r) :=
begin
  intro h1,
  cases h1 with h1 h2,
  cases h2 with h2 h3,
  left,
  split,
  exact h1,
  exact h2,
  right,
  split,
  exact h1,
  exact h3,

end

-- (d)
example : (¬ p ∧ (p ∨ q)) → q :=
begin
  intro h1,
  cases h1 with h1 h2,
  cases h2 with h2 h3,
  exfalso,
  show false, from h1 h2,
  exact h3,

end

-- (f)
example : (¬ (p ∨ q)) → (¬ p ∧ ¬ q) :=
begin
  intro h1,
  split,
  push_neg at h1,
  show ¬ p, from and.left h1,
  push_neg at h1,
  show ¬ q, from and.right h1,

end

axiom lawOfExcludedMiddle :  p ∨ ¬ p → true
axiom pAndNotPImpF :  q ∧ ¬ q -> false
-- (g)
example : (p → q) → (¬ q → ¬ p) :=
begin
  intro h1,
  intro h2,
  assume (hp : p),
  have hq : q, from h1 hp,
  have hf : q ∧ ¬ q, from and.intro hq h2,
  show false, from pAndNotPImpF hf,

end

-- The following code defines useful tools that we defined in Nat. deduction.
example (hp : p) (hq : q) : p ∧ q := and.intro hp hq

#check assume (hp : p) (hq : q), and.intro hp hq


import game.world10.level1 -- hide
namespace mynat -- hide
/-

# Inequality world.

Here's a nice easy one.

## Level 2: le_refl
-/
/- Lemma :
The $\le$ relation is reflexive. In other words, if $x$ is a natural number,
then $x\le x$.
-/
lemma le_refl (x : mynat) : x ≤ x :=
begin [nat_num_game]
  use 0,
  rw add_zero,
  refl,

end
/-
## Upgrading the `refl` tactic

Now with the following incantation (NB thanks to master wizard Reid Barton
for correcting my spell)...
-/
attribute [refl] mynat.le_refl
/-
...we find that the `refl` tactic will close all goals
of the form `a ≤ a` as well as all goals of the form `a = a`.
-/
example : (0 : mynat) ≤ 0 := begin
  refl
end

/-
## Pro tip

Did you skip `rw le_iff_exists_add` in your proof of `le_refl` above?
Instead of `rw add_zero` or `ring` or `exact add_zero x` at the end there,
what happens if you just try `refl`? The *definition* of `x + 0` is `x`,
so you don't need to `rw add_zero` either! The proof

```
use 0,
refl,
```

works.

The same remarks are true of
`add_succ`, `mul_zero`, `mul_succ`, `pow_zero` and `pow_succ`. All of those
theorems are true *by definition*. The same is *not* true however of `zero_add`;
the theorem `0 + x = x` was proved by induction on `x`,
and in particular it is not true by *definition*.

Definitional equality is of great importance
to computer scientists, but mathematicians are much more fluid with their idea
of a definition -- a concept can simultaneously have three equivalent definitions
in a maths talk, as long as they're all logically equivalent. In Lean, a definition
is *one thing*, and definitional equality is a subtle concept which depends on
exactly which definition you chose. `add_comm` is certainly not true by definition,
which means that if we had decided to define `a ≤ b` by `∃ c, b = c + a` (rather
than `a + c`) all the same theorems would be true, but `refl` would work in
different places. `refl` closes a goal of the form `X = Y` if `X` and `Y` are
definitionally equal.
-/
end mynat -- hide