import data.nat.basic
open nat

private lemma induction_strong_version (P : ℕ → Prop) (n : ℕ) :
  (∀ x : ℕ, (∀ y : ℕ, y < x → (P y)) → (P x))  →  (∀ z : ℕ, z < n → (P z))  :=
begin
  intro ass,
  induction n with m ih,

    -- base case --
    intros z z_neg,
    exfalso,
    exact nat.not_lt_zero z z_neg,

    -- induction step --
    intros z z_le_m,
    rw lt_succ_iff at z_le_m,
    cases eq_or_lt_of_le z_le_m with z_eq_m z_lt_m,

      -- case of z = m
      specialize ass m,
      rw z_eq_m,
      exact ass ih,

      -- case of z < m
      exact ih z z_lt_m,
end

theorem induction_complete (P : ℕ → Prop) :
  (∀ x : ℕ, (∀ y : ℕ, y < x → (P y)) → (P x))  →  (∀ n : ℕ, P n)  :=
begin
  intro assum,
  intro n,
  exact induction_strong_version P (n+1) assum n (lt_succ_self n),
end


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

! This file was ported from Lean 3 source module category_theory.single_obj
! leanprover-community/mathlib commit 56adee5b5eef9e734d82272918300fca4f3e7cef
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Endomorphism
import Mathlib.CategoryTheory.Category.Cat
import Mathlib.Algebra.Category.MonCat.Basic
import Mathlib.Combinatorics.Quiver.SingleObj

/-!
# Single-object category

Single object category with a given monoid of endomorphisms.
It is defined to facilitate transfering some definitions and lemmas (e.g., conjugacy etc.)
from category theory to monoids and groups.

## Main definitions

Given a type `α` with a monoid structure, `SingleObj α` is `Unit` type with `Category` structure
such that `End (SingleObj α).star` is the monoid `α`.  This can be extended to a functor
`MonCat ⥤ Cat`.

If `α` is a group, then `SingleObj α` is a groupoid.

An element `x : α` can be reinterpreted as an element of `End (SingleObj.star α)` using
`SingleObj.toEnd`.

## Implementation notes

- `categoryStruct.comp` on `End (SingleObj.star α)` is `flip (*)`, not `(*)`. This way
  multiplication on `End` agrees with the multiplication on `α`.

- By default, Lean puts instances into `CategoryTheory` namespace instead of
  `CategoryTheory.SingleObj`, so we give all names explicitly.
-/

universe u v w

namespace CategoryTheory

/-- Abbreviation that allows writing `CategoryTheory.SingleObj` rather than `Quiver.SingleObj`.
-/
abbrev SingleObj :=
  Quiver.SingleObj
#align category_theory.single_obj CategoryTheory.SingleObj

namespace SingleObj

variable (α : Type u)

/-- One and `flip (*)` become `id` and `comp` for morphisms of the single object category. -/
instance categoryStruct [One α] [Mul α] : CategoryStruct (SingleObj α)
    where
  Hom _ _ := α
  comp x y := y * x
  id _ := 1
#align category_theory.single_obj.category_struct CategoryTheory.SingleObj.categoryStruct

/-- Monoid laws become category laws for the single object category. -/
instance category [Monoid α] : Category (SingleObj α)
    where
  comp_id := one_mul
  id_comp := mul_one
  assoc x y z := (mul_assoc z y x).symm
#align category_theory.single_obj.category CategoryTheory.SingleObj.category

theorem id_as_one [Monoid α] (x : SingleObj α) : 𝟙 x = 1 :=
  rfl
#align category_theory.single_obj.id_as_one CategoryTheory.SingleObj.id_as_one

theorem comp_as_mul [Monoid α] {x y z : SingleObj α} (f : x ⟶ y) (g : y ⟶ z) : f ≫ g = g * f :=
  rfl
#align category_theory.single_obj.comp_as_mul CategoryTheory.SingleObj.comp_as_mul

/-- Groupoid structure on `SingleObj α`.

See <https://stacks.math.columbia.edu/tag/0019>.
-/
instance groupoid [Group α] : Groupoid (SingleObj α)
    where
  inv x := x⁻¹
  inv_comp := mul_right_inv
  comp_inv := mul_left_inv
#align category_theory.single_obj.groupoid CategoryTheory.SingleObj.groupoid

theorem inv_as_inv [Group α] {x y : SingleObj α} (f : x ⟶ y) : inv f = f⁻¹ := by
  apply IsIso.inv_eq_of_hom_inv_id
  rw [comp_as_mul, inv_mul_self, id_as_one]
#align category_theory.single_obj.inv_as_inv CategoryTheory.SingleObj.inv_as_inv

/-- Abbreviation that allows writing `CategoryTheory.SingleObj.star` rather than
`Quiver.SingleObj.star`.
-/
abbrev star : SingleObj α :=
  Quiver.SingleObj.star α
#align category_theory.single_obj.star CategoryTheory.SingleObj.star

/-- The endomorphisms monoid of the only object in `SingleObj α` is equivalent to the original
     monoid α. -/
def toEnd [Monoid α] : α ≃* End (SingleObj.star α) :=
  { Equiv.refl α with map_mul' := fun _ _ => rfl }
#align category_theory.single_obj.to_End CategoryTheory.SingleObj.toEnd

theorem toEnd_def [Monoid α] (x : α) : toEnd α x = x :=
  rfl
#align category_theory.single_obj.to_End_def CategoryTheory.SingleObj.toEnd_def

/-- There is a 1-1 correspondence between monoid homomorphisms `α → β` and functors between the
    corresponding single-object categories. It means that `SingleObj` is a fully faithful
    functor.

See <https://stacks.math.columbia.edu/tag/001F> --
although we do not characterize when the functor is full or faithful.
-/
def mapHom (α : Type u) (β : Type v) [Monoid α] [Monoid β] : (α →* β) ≃ SingleObj α ⥤ SingleObj β
    where
  toFun f :=
    { obj := id
      map := ⇑f
      map_id := fun _ => f.map_one
      map_comp := fun x y => f.map_mul y x }
  invFun f :=
    { toFun := fun x => f.map ((toEnd α) x)
      map_one' := f.map_id _
      map_mul' := fun x y => f.map_comp y x }
  left_inv := by aesop_cat
  right_inv := by aesop_cat
#align category_theory.single_obj.map_hom CategoryTheory.SingleObj.mapHom

theorem mapHom_id (α : Type u) [Monoid α] : mapHom α α (MonoidHom.id α) = 𝟭 _ :=
  rfl
#align category_theory.single_obj.map_hom_id CategoryTheory.SingleObj.mapHom_id

theorem mapHom_comp {α : Type u} {β : Type v} [Monoid α] [Monoid β] (f : α →* β) {γ : Type w}
    [Monoid γ] (g : β →* γ) : mapHom α γ (g.comp f) = mapHom α β f ⋙ mapHom β γ g :=
  rfl
#align category_theory.single_obj.map_hom_comp CategoryTheory.SingleObj.mapHom_comp

/-- Given a function `f : C → G` from a category to a group, we get a functor
    `C ⥤ G` sending any morphism `x ⟶ y` to `f y * (f x)⁻¹`. -/
@[simps]
def differenceFunctor {C G} [Category C] [Group G] (f : C → G) : C ⥤ SingleObj G
    where
  obj _ := ()
  map {x y} _ := f y * (f x)⁻¹
  map_id := by
    intro
    simp only [SingleObj.id_as_one, mul_right_inv]
  map_comp := by
    intros
    dsimp
    rw [SingleObj.comp_as_mul, ← mul_assoc, mul_left_inj, mul_assoc, inv_mul_self, mul_one]
#align category_theory.single_obj.difference_functor CategoryTheory.SingleObj.differenceFunctor

end SingleObj

end CategoryTheory

open CategoryTheory

namespace MonoidHom

/-- Reinterpret a monoid homomorphism `f : α → β` as a functor `(single_obj α) ⥤ (single_obj β)`.
See also `category_theory.single_obj.map_hom` for an equivalence between these types. -/
@[reducible]
def toFunctor {α : Type u} {β : Type v} [Monoid α] [Monoid β] (f : α →* β) :
    SingleObj α ⥤ SingleObj β :=
  SingleObj.mapHom α β f
#align monoid_hom.to_functor MonoidHom.toFunctor

@[simp]
theorem id_toFunctor (α : Type u) [Monoid α] : (id α).toFunctor = 𝟭 _ :=
  rfl
#align monoid_hom.id_to_functor MonoidHom.id_toFunctor

@[simp]
theorem comp_toFunctor {α : Type u} {β : Type v} [Monoid α] [Monoid β] (f : α →* β) {γ : Type w}
    [Monoid γ] (g : β →* γ) : (g.comp f).toFunctor = f.toFunctor ⋙ g.toFunctor :=
  rfl
#align monoid_hom.comp_to_functor MonoidHom.comp_toFunctor

end MonoidHom

namespace Units

variable (α : Type u) [Monoid α]

-- porting note: it was necessary to add `by exact` in this definition, presumably
-- so that Lean4 is not confused by the fact that `α` has two opposite multiplications
/-- The units in a monoid are (multiplicatively) equivalent to
the automorphisms of `star` when we think of the monoid as a single-object category. -/
def toAut : αˣ ≃* Aut (SingleObj.star α) :=
  MulEquiv.trans (Units.mapEquiv (by exact SingleObj.toEnd α))
    (Aut.unitsEndEquivAut (SingleObj.star α))
set_option linter.uppercaseLean3 false in
#align units.to_Aut Units.toAut

@[simp]
theorem toAut_hom (x : αˣ) : (toAut α x).hom = SingleObj.toEnd α x :=
  rfl
set_option linter.uppercaseLean3 false in
#align units.to_Aut_hom Units.toAut_hom

@[simp]
theorem toAut_inv (x : αˣ) : (toAut α x).inv = SingleObj.toEnd α (x⁻¹ : αˣ) :=
  rfl
set_option linter.uppercaseLean3 false in
#align units.to_Aut_inv Units.toAut_inv

end Units

namespace MonCat

open CategoryTheory

/-- The fully faithful functor from `MonCat` to `Cat`. -/
def toCat : MonCat ⥤ Cat where
  obj x := Cat.of (SingleObj x)
  map {x y} f := SingleObj.mapHom x y f
set_option linter.uppercaseLean3 false in
#align Mon.to_Cat MonCat.toCat

instance toCatFull : Full toCat where
  preimage := (SingleObj.mapHom _ _).invFun
  witness _ := rfl
set_option linter.uppercaseLean3 false in
#align Mon.to_Cat_full MonCat.toCatFull

instance toCat_faithful : Faithful toCat where
  map_injective h := by simpa [toCat] using h
set_option linter.uppercaseLean3 false in
#align Mon.to_Cat_faithful MonCat.toCat_faithful

end MonCat


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

! This file was ported from Lean 3 source module algebra.monoid_algebra.support
! leanprover-community/mathlib commit 16749fc4661828cba18cd0f4e3c5eb66a8e80598
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.MonoidAlgebra.Basic

/-!
#  Lemmas about the support of a finitely supported function
-/

universe u₁ u₂ u₃

namespace MonoidAlgebra

open Finset Finsupp

variable {k : Type u₁} {G : Type u₂} [Semiring k]

theorem support_single_mul_subset [DecidableEq G] [Mul G] (f : MonoidAlgebra k G) (r : k) (a : G) :
    (single a r * f : MonoidAlgebra k G).support ⊆ Finset.image ((· * ·) a) f.support := by
  intro x hx
  contrapose hx
  have : ∀ y, a * y = x → f y = 0 := by
    simpa only [not_and', mem_image, mem_support_iff, exists_prop, not_exists,
      Classical.not_not] using hx
  simp only [mem_support_iff, mul_apply, sum_single_index, zero_mul, ite_self, sum_zero,
    Classical.not_not]
  exact
    Finset.sum_eq_zero
      (by
        simp (config := { contextual := true }) only [this, mem_support_iff, mul_zero, Ne.def,
          ite_eq_right_iff, eq_self_iff_true, imp_true_iff])
#align monoid_algebra.support_single_mul_subset MonoidAlgebra.support_single_mul_subset

theorem support_mul_single_subset [DecidableEq G] [Mul G] (f : MonoidAlgebra k G) (r : k) (a : G) :
    (f * single a r).support ⊆ Finset.image (· * a) f.support := by
  intro x hx
  contrapose hx
  have : ∀ y, y * a = x → f y = 0 := by
    simpa only [not_and', mem_image, mem_support_iff, exists_prop, not_exists,
      Classical.not_not] using hx
  simp only [mem_support_iff, mul_apply, sum_single_index, zero_mul, ite_self, sum_zero,
    Classical.not_not]
  exact
    Finset.sum_eq_zero
      (by
        simp (config := { contextual := true }) only [this, sum_single_index, ite_eq_right_iff,
          eq_self_iff_true, imp_true_iff, zero_mul])
#align monoid_algebra.support_mul_single_subset MonoidAlgebra.support_mul_single_subset

theorem support_single_mul_eq_image [DecidableEq G] [Mul G] (f : MonoidAlgebra k G) {r : k}
    (hr : ∀ y, r * y = 0 ↔ y = 0) {x : G} (lx : IsLeftRegular x) :
    (single x r * f : MonoidAlgebra k G).support = Finset.image ((· * ·) x) f.support := by
  refine' subset_antisymm (support_single_mul_subset f _ _) fun y hy => _
  obtain ⟨y, yf, rfl⟩ : ∃ a : G, a ∈ f.support ∧ x * a = y := by
    simpa only [Finset.mem_image, exists_prop] using hy
  simp only [mul_apply, mem_support_iff.mp yf, hr, mem_support_iff, sum_single_index,
    Finsupp.sum_ite_eq', Ne.def, not_false_iff, if_true, zero_mul, ite_self, sum_zero, lx.eq_iff]
#align monoid_algebra.support_single_mul_eq_image MonoidAlgebra.support_single_mul_eq_image

theorem support_mul_single_eq_image [DecidableEq G] [Mul G] (f : MonoidAlgebra k G) {r : k}
    (hr : ∀ y, y * r = 0 ↔ y = 0) {x : G} (rx : IsRightRegular x) :
    (f * single x r).support = Finset.image (· * x) f.support := by
  refine' subset_antisymm (support_mul_single_subset f _ _) fun y hy => _
  obtain ⟨y, yf, rfl⟩ : ∃ a : G, a ∈ f.support ∧ a * x = y := by
    simpa only [Finset.mem_image, exists_prop] using hy
  simp only [mul_apply, mem_support_iff.mp yf, hr, mem_support_iff, sum_single_index,
    Finsupp.sum_ite_eq', Ne.def, not_false_iff, if_true, mul_zero, ite_self, sum_zero, rx.eq_iff]
#align monoid_algebra.support_mul_single_eq_image MonoidAlgebra.support_mul_single_eq_image

theorem support_mul [Mul G] [DecidableEq G] (a b : MonoidAlgebra k G) :
    (a * b).support ⊆ a.support.bunionᵢ fun a₁ => b.support.bunionᵢ fun a₂ => {a₁ * a₂} :=
  Subset.trans support_sum <|
    bunionᵢ_mono fun _ _ =>
      Subset.trans support_sum <| bunionᵢ_mono fun _a₂ _ => support_single_subset
#align monoid_algebra.support_mul MonoidAlgebra.support_mul

theorem support_mul_single [RightCancelSemigroup G] (f : MonoidAlgebra k G) (r : k)
    (hr : ∀ y, y * r = 0 ↔ y = 0) (x : G) :
    (f * single x r).support = f.support.map (mulRightEmbedding x) := by
  classical
    ext
    simp only [support_mul_single_eq_image f hr (isRightRegular_of_rightCancelSemigroup x),
      mem_image, mem_map, mulRightEmbedding_apply]
#align monoid_algebra.support_mul_single MonoidAlgebra.support_mul_single

theorem support_single_mul [LeftCancelSemigroup G] (f : MonoidAlgebra k G) (r : k)
    (hr : ∀ y, r * y = 0 ↔ y = 0) (x : G) :
    (single x r * f : MonoidAlgebra k G).support = f.support.map (mulLeftEmbedding x) := by
  classical
    ext
    simp only [support_single_mul_eq_image f hr (isLeftRegular_of_leftCancelSemigroup x), mem_image,
      mem_map, mulLeftEmbedding_apply]
#align monoid_algebra.support_single_mul MonoidAlgebra.support_single_mul

section Span

variable [MulOneClass G]

/-- An element of `MonoidAlgebra k G` is in the subalgebra generated by its support. -/
theorem mem_span_support (f : MonoidAlgebra k G) :
    f ∈ Submodule.span k (of k G '' (f.support : Set G)) := by
  erw [of, MonoidHom.coe_mk, ← supported_eq_span_single, Finsupp.mem_supported]
#align monoid_algebra.mem_span_support MonoidAlgebra.mem_span_support

end Span

end MonoidAlgebra

namespace AddMonoidAlgebra

open Finset Finsupp MulOpposite

variable {k : Type u₁} {G : Type u₂} [Semiring k]

theorem support_mul [DecidableEq G] [Add G] (a b : AddMonoidAlgebra k G) :
    (a * b).support ⊆ a.support.bunionᵢ fun a₁ => b.support.bunionᵢ fun a₂ => {a₁ + a₂} :=
  @MonoidAlgebra.support_mul k (Multiplicative G) _ _ _ _ _
#align add_monoid_algebra.support_mul AddMonoidAlgebra.support_mul

theorem support_mul_single [AddRightCancelSemigroup G] (f : AddMonoidAlgebra k G) (r : k)
    (hr : ∀ y, y * r = 0 ↔ y = 0) (x : G) :
    (f * single x r : AddMonoidAlgebra k G).support = f.support.map (addRightEmbedding x) :=
  @MonoidAlgebra.support_mul_single k (Multiplicative G) _ _ _ _ hr _
#align add_monoid_algebra.support_mul_single AddMonoidAlgebra.support_mul_single

theorem support_single_mul [AddLeftCancelSemigroup G] (f : AddMonoidAlgebra k G) (r : k)
    (hr : ∀ y, r * y = 0 ↔ y = 0) (x : G) :
    (single x r * f : AddMonoidAlgebra k G).support = f.support.map (addLeftEmbedding x) :=
  @MonoidAlgebra.support_single_mul k (Multiplicative G) _ _ _ _ hr _
#align add_monoid_algebra.support_single_mul AddMonoidAlgebra.support_single_mul

section Span

/-- An element of `AddMonoidAlgebra k G` is in the submodule generated by its support. -/
theorem mem_span_support [AddZeroClass G] (f : AddMonoidAlgebra k G) :
    f ∈ Submodule.span k (of k G '' (f.support : Set G)) := by
  erw [of, MonoidHom.coe_mk, ← Finsupp.supported_eq_span_single, Finsupp.mem_supported]
#align add_monoid_algebra.mem_span_support AddMonoidAlgebra.mem_span_support

/-- An element of `AddMonoidAlgebra k G` is in the subalgebra generated by its support, using
unbundled inclusion. -/
theorem mem_span_support' (f : AddMonoidAlgebra k G) :
    f ∈ Submodule.span k (of' k G '' (f.support : Set G)) := by
  delta of'
  rw [← Finsupp.supported_eq_span_single, Finsupp.mem_supported]
#align add_monoid_algebra.mem_span_support' AddMonoidAlgebra.mem_span_support'

end Span

end AddMonoidAlgebra


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

Linear independence and basis sets in a module or vector space.

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

We define the following concepts:

* `linear_independent α s`: states that `s` are linear independent

* `linear_independent.repr s b`: choose the linear combination representing `b` on the linear
  independent vectors `s`. `b` should be in `span α b` (uses classical choice)

* `is_basis α s`: if `s` is a basis, i.e. linear independent and spans the entire space

* `is_basis.repr s b`: like `linear_independent.repr` but as a `linear_map`

* `is_basis.constr s g`: constructs a `linear_map` by extending `g` from the basis `s`

-/
import linear_algebra.linear_combination order.zorn
noncomputable theory

open function lattice set submodule
local attribute [instance] classical.prop_decidable
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

section module
variables [ring α] [add_comm_group β] [add_comm_group γ] [add_comm_group δ]
variables [module α β] [module α γ] [module α δ]
variables {a b : α} {s t : set β} {x y : β}
include α

variables (α)
/-- Linearly independent set of vectors -/
def linear_independent (s : set β) : Prop :=
disjoint (lc.supported α s) (lc.total α β).ker
variables {α}

theorem linear_independent_iff : linear_independent α s ↔
  ∀l ∈ lc.supported α s, lc.total α β l = 0 → l = 0 :=
by simp [linear_independent, linear_map.disjoint_ker]

theorem linear_independent_iff_total_on : linear_independent α s ↔ (lc.total_on α s).ker = ⊥ :=
by rw [lc.total_on, linear_map.ker, linear_map.comap_cod_restrict, map_bot, comap_bot,
  linear_map.ker_comp, linear_independent, disjoint, ← map_comap_subtype, map_le_iff_le_comap,
  comap_bot, ker_subtype, le_bot_iff]

lemma linear_independent_empty : linear_independent α (∅ : set β) :=
by simp [linear_independent]

lemma linear_independent.mono (h : t ⊆ s) : linear_independent α s → linear_independent α t :=
disjoint_mono_left (lc.supported_mono h)

lemma linear_independent.unique (hs : linear_independent α s) {l₁ l₂ : lc α β} :
  l₁ ∈ lc.supported α s → l₂ ∈ lc.supported α s →
  lc.total α β l₁ = lc.total α β l₂ → l₁ = l₂ :=
linear_map.disjoint_ker'.1 hs _ _

lemma zero_not_mem_of_linear_independent (ne : 0 ≠ (1:α)) (hs : linear_independent α s) : (0:β) ∉ s :=
λ h, ne $ eq.symm begin
  suffices : (finsupp.single 0 1 : lc α β) 0 = 0, {simpa},
  rw disjoint_def.1 hs _ (lc.single_mem_supported 1 h),
  {refl}, {simp}
end

lemma linear_independent_union {s t : set β}
  (hs : linear_independent α s) (ht : linear_independent α t)
  (hst : disjoint (span α s) (span α t)) : linear_independent α (s ∪ t) :=
begin
  rw [linear_independent, disjoint_def, lc.supported_union],
  intros l h₁ h₂, rw mem_sup at h₁,
  rcases h₁ with ⟨ls, hls, lt, hlt, rfl⟩,
  rw [span_eq_map_lc, span_eq_map_lc] at hst,
  have : lc.total α β ls ∈ map (lc.total α β) (lc.supported α t),
  { apply (add_mem_iff_left (map _ _) (mem_image_of_mem _ hlt)).1,
    rw [← linear_map.map_add, linear_map.mem_ker.1 h₂],
    apply zero_mem },
  have ls0 := disjoint_def.1 hs _ hls (linear_map.mem_ker.2 $
    disjoint_def.1 hst _ (mem_image_of_mem _ hls) this),
  subst ls0, simp [-linear_map.mem_ker] at this h₂ ⊢,
  exact disjoint_def.1 ht _ hlt h₂
end

lemma linear_independent_of_finite
  (H : ∀ t ⊆ s, finite t → linear_independent α t) :
  linear_independent α s :=
linear_independent_iff.2 $ λ l hl,
linear_independent_iff.1 (H _ hl (finset.finite_to_set _)) l (subset.refl _)

lemma linear_independent_Union_of_directed {ι : Type*}
  {s : ι → set β} (hs : directed (⊆) s)
  (h : ∀ i, linear_independent α (s i)) : linear_independent α (⋃ i, s i) :=
begin
  by_cases hι : nonempty ι,
  { refine linear_independent_of_finite (λ t ht ft, _),
    rcases finite_subset_Union ft ht with ⟨I, fi, hI⟩,
    rcases hs.finset_le hι fi.to_finset with ⟨i, hi⟩,
    exact (h i).mono (subset.trans hI $ bUnion_subset $
      λ j hj, hi j (finite.mem_to_finset.2 hj)) },
  { refine linear_independent_empty.mono _,
    rintro _ ⟨_, ⟨i, _⟩, _⟩, exact hι ⟨i⟩ }
end

lemma linear_independent_sUnion_of_directed {s : set (set β)}
  (hs : directed_on (⊆) s)
  (h : ∀ a ∈ s, linear_independent α a) : linear_independent α (⋃₀ s) :=
by rw sUnion_eq_Union; exact
linear_independent_Union_of_directed
  ((directed_on_iff_directed _).1 hs) (by simpa using h)

lemma linear_independent_bUnion_of_directed {ι} {s : set ι} {t : ι → set β}
  (hs : directed_on (t ⁻¹'o (⊆)) s) (h : ∀a∈s, linear_independent α (t a)) :
  linear_independent α (⋃a∈s, t a) :=
by rw bUnion_eq_Union; exact
linear_independent_Union_of_directed
  ((directed_comp _ _ _).2 $ (directed_on_iff_directed _).1 hs)
  (by simpa using h)

lemma linear_independent_Union_finite {ι : Type*} {f : ι → set β}
  (hl : ∀i, linear_independent α (f i))
  (hd : ∀i, ∀t:set ι, finite t → i ∉ t → disjoint (span α (f i)) (⨆i∈t, span α (f i))) :
  linear_independent α (⋃i, f i) :=
begin
  classical,
  rw [Union_eq_Union_finset f],
  refine linear_independent_Union_of_directed (directed_of_sup _) _,
  exact (assume t₁ t₂ ht, Union_subset_Union $ assume i, Union_subset_Union_const $ assume h, ht h),
  assume t, rw [set.Union, ← finset.sup_eq_supr],
  refine t.induction_on _ _,
  { exact linear_independent_empty },
  { rintros ⟨i⟩ s his ih,
    rw [finset.sup_insert],
    refine linear_independent_union (hl _) ih _,
    rw [finset.sup_eq_supr],
    refine disjoint_mono (le_refl _) _ (hd i _ _ his),
    { simp only [(span_Union _).symm],
      refine span_mono (@supr_le_supr2 (set β) _ _ _ _ _ _),
      rintros ⟨i⟩, exact ⟨i, le_refl _⟩ },
    { change finite (plift.up ⁻¹' s.to_set),
      exact finite_preimage (assume i j, plift.up.inj) s.finite_to_set } }
end

section repr
variables (hs : linear_independent α s)

def linear_independent.total_equiv : lc.supported α s ≃ₗ span α s :=
linear_equiv.of_bijective (lc.total_on α s)
  (linear_independent_iff_total_on.1 hs) (lc.total_on_range _)

def linear_independent.repr : span α s →ₗ[α] lc α β :=
(submodule.subtype _).comp (hs.total_equiv.symm : span α s →ₗ[α] lc.supported α s)

lemma linear_independent.total_repr (x) : lc.total α β (hs.repr x) = x :=
subtype.ext.1 $ hs.total_equiv.right_inv x

lemma linear_independent.total_comp_repr : (lc.total α β).comp hs.repr = submodule.subtype _ :=
linear_map.ext $ hs.total_repr

lemma linear_independent.repr_ker : hs.repr.ker = ⊥ :=
by rw [linear_independent.repr, linear_map.ker_comp, ker_subtype, comap_bot,
       linear_equiv.ker]

lemma linear_independent.repr_range : hs.repr.range = lc.supported α s :=
by rw [linear_independent.repr, linear_map.range_comp,
       linear_equiv.range, map_top, range_subtype]

lemma linear_independent.repr_eq {l : lc α β} (h : l ∈ lc.supported α s) {x} (eq : lc.total α β l = ↑x) : hs.repr x = l :=
by rw ← (subtype.eq' eq : (lc.total_on α s : lc.supported α s →ₗ span α s) ⟨l, h⟩ = x);
   exact subtype.ext.1 (hs.total_equiv.left_inv ⟨l, h⟩)

lemma linear_independent.repr_eq_single (x) (hx : ↑x ∈ s) : hs.repr x = finsupp.single x 1 :=
hs.repr_eq (lc.single_mem_supported _ hx) (by simp)

lemma linear_independent.repr_supported (x) : hs.repr x ∈ lc.supported α s :=
((hs.total_equiv.symm : span α s →ₗ[α] lc.supported α s) x).2

lemma linear_independent.repr_eq_repr_of_subset
  (h : t ⊆ s) (x y) (e : (↑x:β) = ↑y) :
  (hs.mono h).repr x = hs.repr y :=
eq.symm $ hs.repr_eq (lc.supported_mono h $ (hs.mono h).repr_supported _)
  (by rw [← e, (hs.mono h).total_repr]).

lemma linear_independent_iff_not_smul_mem_span :
  linear_independent α s ↔ (∀ (x ∈ s) (a : α), a • x ∈ span α (s \ {x}) → a = 0) :=
⟨λ hs x hx a ha, begin
  rw [span_eq_map_lc, mem_map] at ha,
  rcases ha with ⟨l, hl, e⟩,
  have := (lc.supported α s).sub_mem
    (lc.supported_mono (diff_subset _ _) hl) (lc.single_mem_supported a hx),
  rw [sub_eq_zero.1 (linear_independent_iff.1 hs _ this $ by simp [e])] at hl,
  by_contra hn,
  exact (not_mem_of_mem_diff (hl $ by simp [hn])) (mem_singleton _)
end, λ H, linear_independent_iff.2 $ λ l ls l0, begin
  ext x, simp,
  by_contra hn,
  have xs : x ∈ s := ls (finsupp.mem_support_iff.2 hn),
  refine hn (H _ xs _ _),
  refine mem_span_iff_lc.2 ⟨finsupp.single x (l x) - l, _, _⟩,
  { have : finsupp.single x (l x) - l ∈ lc.supported α s :=
      sub_mem _ (lc.single_mem_supported _ xs) ls,
    refine λ y hy, ⟨this hy, λ e, _⟩,
    simp at e hy, apply hy, simp [e] },
  { simp [l0] }
end⟩

end repr

lemma eq_of_linear_independent_of_span (nz : (1 : α) ≠ 0)
  (hs : linear_independent α s) (h : t ⊆ s) (hst : s ⊆ span α t) : s = t :=
begin
  refine subset.antisymm (λ b hb, _) h,
  have : (hs.mono h).repr ⟨b, hst hb⟩ = finsupp.single b 1 :=
    (hs.repr_eq_repr_of_subset h ⟨b, hst hb⟩ ⟨b, subset_span hb⟩ rfl).trans
      (hs.repr_eq_single ⟨b, _⟩ hb),
  have ss := (hs.mono h).repr_supported _,
  rw this at ss, exact ss (by simp [nz]),
end

section
variables {f : β →ₗ[α] γ}
  (hs : linear_independent α (f '' s))
  (hf_inj : ∀ a b ∈ s, f a = f b → a = b)
include hs hf_inj
open linear_map

lemma linear_independent.supported_disjoint_ker :
  disjoint (lc.supported α s) (ker (f.comp (lc.total α β))) :=
begin
  refine le_trans (le_inf inf_le_left _) (lc.map_disjoint_ker f hf_inj),
  rw [linear_independent, disjoint_iff, ← lc.map_supported f] at hs,
  rw [← lc.map_total, le_ker_iff_map],
  refine eq_bot_mono (le_inf (map_mono inf_le_left) _) hs,
  rw [map_le_iff_le_comap, ← ker_comp], exact inf_le_right
end

lemma linear_independent.of_image : linear_independent α s :=
disjoint_mono_right (ker_le_ker_comp _ _) (hs.supported_disjoint_ker hf_inj)

lemma linear_independent.disjoint_ker : disjoint (span α s) f.ker :=
by rw [span_eq_map_lc, disjoint_iff, map_inf_eq_map_inf_comap,
  ← ker_comp, disjoint_iff.1 (hs.supported_disjoint_ker hf_inj), map_bot]

end

lemma linear_independent.inj_span_iff_inj {s : set β} {f : β →ₗ[α] γ}
  (hfs : linear_independent α (f '' s)) :
  disjoint (span α s) f.ker ↔ (∀a b ∈ s, f a = f b → a = b) :=
⟨linear_map.inj_of_disjoint_ker subset_span, hfs.disjoint_ker⟩

open linear_map
lemma linear_independent.image {s : set β} {f : β →ₗ γ} (hs : linear_independent α s)
  (hf_inj : disjoint (span α s) f.ker) : linear_independent α (f '' s) :=
by rw [disjoint, span_eq_map_lc, map_inf_eq_map_inf_comap,
    map_le_iff_le_comap, comap_bot] at hf_inj;
  rw [linear_independent, disjoint, ← lc.map_supported f, map_inf_eq_map_inf_comap,
    map_le_iff_le_comap, ← ker_comp, lc.map_total, ker_comp];
  exact le_trans (le_inf inf_le_left hf_inj) (le_trans hs bot_le)

lemma linear_map.linear_independent_image_iff {s : set β} {f : β →ₗ γ}
  (hf_inj : disjoint (span α s) f.ker) :
  linear_independent α (f '' s) ↔ linear_independent α s :=
⟨λ hs, hs.of_image (linear_map.inj_of_disjoint_ker subset_span hf_inj),
 λ hs, hs.image hf_inj⟩

lemma linear_independent_inl_union_inr {s : set β} {t : set γ}
  (hs : linear_independent α s) (ht : linear_independent α t) :
  linear_independent α (inl α β γ '' s ∪ inr α β γ '' t) :=
linear_independent_union (hs.image $ by simp) (ht.image $ by simp) $
by rw [span_image, span_image]; simp [disjoint_iff, prod_inf_prod]

variables (α)
/-- A set of vectors is a basis if it is linearly independent and all vectors are in the span α -/
def is_basis (s : set β) := linear_independent α s ∧ span α s = ⊤
variables {α}

section is_basis
variables (hs : is_basis α s)

lemma is_basis.mem_span (hs : is_basis α s) : ∀ x, x ∈ span α s := eq_top_iff'.1 hs.2

def is_basis.repr : β →ₗ lc α β :=
(hs.1.repr).comp (linear_map.id.cod_restrict _ hs.mem_span)

lemma is_basis.total_repr (x) : lc.total α β (hs.repr x) = x :=
hs.1.total_repr ⟨x, _⟩

lemma is_basis.total_comp_repr : (lc.total α β).comp hs.repr = linear_map.id :=
linear_map.ext hs.total_repr

lemma is_basis.repr_ker : hs.repr.ker = ⊥ :=
linear_map.ker_eq_bot.2 $ injective_of_left_inverse hs.total_repr

lemma is_basis.repr_range : hs.repr.range = lc.supported α s :=
by  rw [is_basis.repr, linear_map.range, submodule.map_comp,
  linear_map.map_cod_restrict, submodule.map_id, comap_top, map_top, hs.1.repr_range]

lemma is_basis.repr_supported (x) : hs.repr x ∈ lc.supported α s :=
hs.1.repr_supported ⟨x, _⟩

lemma is_basis.repr_eq_single {x} : x ∈ s → hs.repr x = finsupp.single x 1 :=
hs.1.repr_eq_single ⟨x, _⟩

/-- Construct a linear map given the value at the basis. -/
def is_basis.constr (f : β → γ) : β →ₗ γ :=
(lc.total α γ).comp $ (lc.map α f).comp hs.repr

theorem is_basis.constr_apply (f : β → γ) (x : β) :
  (hs.constr f : β → γ) x = (hs.repr x).sum (λb a, a • f b) :=
by dsimp [is_basis.constr];
   rw [lc.total_apply, finsupp.sum_map_domain_index]; simp [add_smul]

lemma is_basis.ext {f g : β →ₗ[α] γ} (hs : is_basis α s) (h : ∀x∈s, f x = g x) : f = g :=
linear_map.ext $ λ x, linear_eq_on h (hs.mem_span x)

lemma constr_congr {f g : β → γ} {x : β} (hs : is_basis α s) (h : ∀x∈s, f x = g x) :
  hs.constr f = hs.constr g :=
by ext y; simp [is_basis.constr_apply]; exact
finset.sum_congr rfl (λ x hx, by simp [h x (hs.repr_supported _ hx)])

lemma constr_basis {f : β → γ} {b : β} (hs : is_basis α s) (hb : b ∈ s) :
  (hs.constr f : β → γ) b = f b :=
by simp [is_basis.constr_apply, hs.repr_eq_single hb, finsupp.sum_single_index]

lemma constr_eq {g : β → γ} {f : β →ₗ[α] γ} (hs : is_basis α s)
  (h : ∀x∈s, g x = f x) : hs.constr g = f :=
hs.ext $ λ x hx, (constr_basis hs hx).trans (h _ hx)

lemma constr_self (f : β →ₗ[α] γ) : hs.constr f = f :=
constr_eq hs $ λ x hx, rfl

lemma constr_zero (hs : is_basis α s) : hs.constr (λb, (0 : γ)) = 0 :=
constr_eq hs $ λ x hx, rfl

lemma constr_add {g f : β → γ} (hs : is_basis α s) :
  hs.constr (λb, f b + g b) = hs.constr f + hs.constr g :=
constr_eq hs $ by simp [constr_basis hs] {contextual := tt}

lemma constr_neg {f : β → γ} (hs : is_basis α s) : hs.constr (λb, - f b) = - hs.constr f :=
constr_eq hs $ by simp [constr_basis hs] {contextual := tt}

lemma constr_sub {g f : β → γ} (hs : is_basis α s) :
  hs.constr (λb, f b - g b) = hs.constr f - hs.constr g :=
by simp [constr_add, constr_neg]

-- this only works on functions if `α` is a commutative ring
lemma constr_smul {α β γ} [comm_ring α]
  [add_comm_group β] [add_comm_group γ] [module α β] [module α γ]
  {f : β → γ} {a : α} {s : set β} (hs : is_basis α s) {b : β} :
  hs.constr (λb, a • f b) = a • hs.constr f :=
constr_eq hs $ by simp [constr_basis hs] {contextual := tt}

lemma constr_range (hs : is_basis α s) {f : β → γ} : (hs.constr f).range = span α (f '' s) :=
by rw [is_basis.constr, linear_map.range_comp, linear_map.range_comp,
       is_basis.repr_range, lc.map_supported, span_eq_map_lc]

def module_equiv_lc (hs : is_basis α s) : β ≃ₗ lc.supported α s :=
(hs.1.total_equiv.trans (linear_equiv.of_top _ hs.2)).symm

def equiv_of_is_basis {s : set β} {t : set γ} {f : β → γ} {g : γ → β}
  (hs : is_basis α s) (ht : is_basis α t) (hf : ∀b∈s, f b ∈ t) (hg : ∀c∈t, g c ∈ s)
  (hgf : ∀b∈s, g (f b) = b) (hfg : ∀c∈t, f (g c) = c) :
  β ≃ₗ γ :=
{ inv_fun := ht.constr g,
  left_inv :=
    have (ht.constr g).comp (hs.constr f) = linear_map.id,
    from hs.ext $ by simp [constr_basis, hs, ht, hf, hgf, (∘)] {contextual := tt},
    λ x, congr_arg (λ h:β →ₗ[α] β, h x) this,
  right_inv :=
    have (hs.constr f).comp (ht.constr g) = linear_map.id,
    from ht.ext $ by simp [constr_basis, hs, ht, hg, hfg, (∘)] {contextual := tt},
    λ y, congr_arg (λ h:γ →ₗ[α] γ, h y) this,
  ..hs.constr f }

lemma is_basis_inl_union_inr {s : set β} {t : set γ}
  (hs : is_basis α s) (ht : is_basis α t) : is_basis α (inl α β γ '' s ∪ inr α β γ '' t) :=
⟨linear_independent_inl_union_inr hs.1 ht.1,
  by rw [span_union, span_image, span_image]; simp [hs.2, ht.2]⟩

end is_basis

lemma is_basis_singleton_one (α : Type*) [ring α] : is_basis α ({1} : set α) :=
⟨ by simp [linear_independent_iff_not_smul_mem_span],
  top_unique $ assume a h, by simp [submodule.mem_span_singleton]⟩

lemma linear_equiv.is_basis {s : set β} (hs : is_basis α s)
  (f : β ≃ₗ[α] γ) : is_basis α (f '' s) :=
show is_basis α ((f : β →ₗ[α] γ) '' s), from
⟨hs.1.image $ by simp, by rw [span_image, hs.2, map_top, f.range]⟩

lemma is_basis_injective {s : set γ} {f : β →ₗ[α] γ}
  (hs : linear_independent α s) (h : function.injective f) (hfs : span α s = f.range) :
  is_basis α (f ⁻¹' s) :=
have s_eq : f '' (f ⁻¹' s) = s :=
  image_preimage_eq_of_subset $ by rw [← linear_map.range_coe, ← hfs]; exact subset_span,
have linear_independent α (f '' (f ⁻¹' s)), from hs.mono (image_preimage_subset _ _),
begin
  split,
  exact (this.of_image $ assume a ha b hb eq, h eq),
  refine (top_unique $ (linear_map.map_le_map_iff $ linear_map.ker_eq_bot.2 h).1 _),
  rw [← span_image f,s_eq, hfs, linear_map.range],
  exact le_refl _
end

lemma is_basis_span {s : set β} (hs : linear_independent α s) : is_basis α ((span α s).subtype ⁻¹' s) :=
is_basis_injective hs subtype.val_injective (range_subtype _).symm

lemma is_basis_empty (h : ∀x:β, x = 0) : is_basis α (∅ : set β) :=
⟨linear_independent_empty, eq_top_iff'.2 $ assume x, (h x).symm ▸ submodule.zero_mem _⟩

lemma is_basis_empty_bot : is_basis α ({x | false } : set (⊥ : submodule α β)) :=
is_basis_empty $ assume ⟨x, hx⟩,
  by change x ∈ (⊥ : submodule α β) at hx; simpa [subtype.ext] using hx

end module

section vector_space
variables [discrete_field α] [add_comm_group β] [add_comm_group γ]
  [vector_space α β] [vector_space α γ] {s t : set β} {x y z : β}
include α
open submodule

/- TODO: some of the following proofs can generalized with a zero_ne_one predicate type class
   (instead of a data containing type classs) -/

set_option class.instance_max_depth 36

lemma mem_span_insert_exchange : x ∈ span α (insert y s) → x ∉ span α s → y ∈ span α (insert x s) :=
begin
  simp [mem_span_insert],
  rintro a z hz rfl h,
  refine ⟨a⁻¹, -a⁻¹ • z, smul_mem _ _ hz, _⟩,
  have a0 : a ≠ 0, {rintro rfl, simp * at *},
  simp [a0, smul_add, smul_smul]
end

set_option class.instance_max_depth 32

lemma linear_independent_iff_not_mem_span : linear_independent α s ↔ (∀x∈s, x ∉ span α (s \ {x})) :=
linear_independent_iff_not_smul_mem_span.trans
⟨λ H x xs hx, one_ne_zero (H x xs 1 $ by simpa),
 λ H x xs a hx, classical.by_contradiction $ λ a0,
   H x xs ((smul_mem_iff _ a0).1 hx)⟩

lemma linear_independent_singleton {x : β} (hx : x ≠ 0) : linear_independent α ({x} : set β) :=
linear_independent_iff_not_mem_span.mpr $ by simp [hx] {contextual := tt}

lemma disjoint_span_singleton {p : submodule α β} {x : β} (x0 : x ≠ 0) :
  disjoint p (span α {x}) ↔ x ∉ p :=
⟨λ H xp, x0 (disjoint_def.1 H _ xp (singleton_subset_iff.1 subset_span:_)),
begin
  simp [disjoint_def, mem_span_singleton],
  rintro xp y yp a rfl,
  by_cases a0 : a = 0, {simp [a0]},
  exact xp.elim ((smul_mem_iff p a0).1 yp),
end⟩

lemma linear_independent.insert (hs : linear_independent α s) (hx : x ∉ span α s) :
  linear_independent α (insert x s) :=
begin
  rw ← union_singleton,
  have x0 : x ≠ 0 := mt (by rintro rfl; apply zero_mem _) hx,
  exact linear_independent_union hs (linear_independent_singleton x0)
    ((disjoint_span_singleton x0).2 hx)
end

lemma exists_linear_independent (hs : linear_independent α s) (hst : s ⊆ t) :
  ∃b⊆t, s ⊆ b ∧ t ⊆ span α b ∧ linear_independent α b :=
begin
  rcases zorn.zorn_subset₀ {b | b ⊆ t ∧ linear_independent α b} _ _
    ⟨hst, hs⟩ with ⟨b, ⟨bt, bi⟩, sb, h⟩,
  { refine ⟨b, bt, sb, λ x xt, _, bi⟩,
    by_contra hn,
    apply hn,
    rw ← h _ ⟨insert_subset.2 ⟨xt, bt⟩, bi.insert hn⟩ (subset_insert _ _),
    exact subset_span (mem_insert _ _) },
  { refine λ c hc cc c0, ⟨⋃₀ c, ⟨_, _⟩, λ x, _⟩,
    { exact sUnion_subset (λ x xc, (hc xc).1) },
    { exact linear_independent_sUnion_of_directed cc.directed_on (λ x xc, (hc xc).2) },
    { exact subset_sUnion_of_mem } }
end

lemma exists_subset_is_basis (hs : linear_independent α s) : ∃b, s ⊆ b ∧ is_basis α b :=
let ⟨b, hb₀, hx, hb₂, hb₃⟩ := exists_linear_independent hs (@subset_univ _ _) in
⟨b, hx, hb₃, eq_top_iff.2 hb₂⟩

variables (α β)
lemma exists_is_basis : ∃b : set β, is_basis α b :=
let ⟨b, _, hb⟩ := exists_subset_is_basis linear_independent_empty in ⟨b, hb⟩
variables {α β}

-- TODO(Mario): rewrite?
lemma exists_of_linear_independent_of_finite_span {t : finset β}
  (hs : linear_independent α s) (hst : s ⊆ (span α ↑t : submodule α β)) :
  ∃t':finset β, ↑t' ⊆ s ∪ ↑t ∧ s ⊆ ↑t' ∧ t'.card = t.card :=
have ∀t, ∀(s' : finset β), ↑s' ⊆ s → s ∩ ↑t = ∅ → s ⊆ (span α ↑(s' ∪ t) : submodule α β) →
  ∃t':finset β, ↑t' ⊆ s ∪ ↑t ∧ s ⊆ ↑t' ∧ t'.card = (s' ∪ t).card :=
assume t, finset.induction_on t
  (assume s' hs' _ hss',
    have s = ↑s', from eq_of_linear_independent_of_span (@one_ne_zero α _) hs hs' $ by simpa using hss',
    ⟨s', by simp [this]⟩)
  (assume b₁ t hb₁t ih s' hs' hst hss',
    have hb₁s : b₁ ∉ s,
      from assume h,
      have b₁ ∈ s ∩ ↑(insert b₁ t), from ⟨h, finset.mem_insert_self _ _⟩,
      by rwa [hst] at this,
    have hb₁s' : b₁ ∉ s', from assume h, hb₁s $ hs' h,
    have hst : s ∩ ↑t = ∅,
      from eq_empty_of_subset_empty $ subset.trans
        (by simp [inter_subset_inter, subset.refl]) (le_of_eq hst),
    classical.by_cases
      (assume : s ⊆ (span α ↑(s' ∪ t) : submodule α β),
        let ⟨u, hust, hsu, eq⟩ := ih _ hs' hst this in
        have hb₁u : b₁ ∉ u, from assume h, (hust h).elim hb₁s hb₁t,
        ⟨insert b₁ u, by simp [insert_subset_insert hust],
          subset.trans hsu (by simp), by simp [eq, hb₁t, hb₁s', hb₁u]⟩)
      (assume : ¬ s ⊆ (span α ↑(s' ∪ t) : submodule α β),
        let ⟨b₂, hb₂s, hb₂t⟩ := not_subset.mp this in
        have hb₂t' : b₂ ∉ s' ∪ t, from assume h, hb₂t $ subset_span h,
        have s ⊆ (span α ↑(insert b₂ s' ∪ t) : submodule α β), from
          assume b₃ hb₃,
          have ↑(s' ∪ insert b₁ t) ⊆ insert b₁ (insert b₂ ↑(s' ∪ t) : set β),
            by simp [insert_eq, -singleton_union, -union_singleton, union_subset_union, subset.refl, subset_union_right],
          have hb₃ : b₃ ∈ span α (insert b₁ (insert b₂ ↑(s' ∪ t) : set β)),
            from span_mono this (hss' hb₃),
          have s ⊆ (span α (insert b₁ ↑(s' ∪ t)) : submodule α β),
            by simpa [insert_eq, -singleton_union, -union_singleton] using hss',
          have hb₁ : b₁ ∈ span α (insert b₂ ↑(s' ∪ t)),
            from mem_span_insert_exchange (this hb₂s) hb₂t,
          by rw [span_insert_eq_span hb₁] at hb₃; simpa using hb₃,
        let ⟨u, hust, hsu, eq⟩ := ih _ (by simp [insert_subset, hb₂s, hs']) hst this in
        ⟨u, subset.trans hust $ union_subset_union (subset.refl _) (by simp [subset_insert]),
          hsu, by rw [finset.union_comm] at hb₂t'; simp [eq, hb₂t', hb₁t, hb₁s']⟩)),
have eq : t.filter (λx, x ∈ s) ∪ t.filter (λx, x ∉ s) = t,
  from finset.ext.mpr $ assume x, by by_cases x ∈ s; simp *,
let ⟨u, h₁, h₂, h⟩ := this (t.filter (λx, x ∉ s)) (t.filter (λx, x ∈ s))
  (by simp [set.subset_def]) (by simp [set.ext_iff] {contextual := tt}) (by rwa [eq]) in
⟨u, subset.trans h₁ (by simp [subset_def, and_imp, or_imp_distrib] {contextual:=tt}),
  h₂, by rwa [eq] at h⟩

lemma exists_finite_card_le_of_finite_of_linear_independent_of_span
  (ht : finite t) (hs : linear_independent α s) (hst : s ⊆ span α t) :
  ∃h : finite s, h.to_finset.card ≤ ht.to_finset.card :=
have s ⊆ (span α ↑(ht.to_finset) : submodule α β), by simp; assumption,
let ⟨u, hust, hsu, eq⟩ := exists_of_linear_independent_of_finite_span hs this in
have finite s, from finite_subset u.finite_to_set hsu,
⟨this, by rw [←eq]; exact (finset.card_le_of_subset $ finset.coe_subset.mp $ by simp [hsu])⟩

lemma exists_left_inverse_linear_map_of_injective {f : β →ₗ[α] γ}
  (hf_inj : f.ker = ⊥) : ∃g:γ →ₗ β, g.comp f = linear_map.id :=
begin
  rcases exists_is_basis α β with ⟨B, hB⟩,
  have : linear_independent α (f '' B) :=
    hB.1.image (by simp [hf_inj]),
  rcases exists_subset_is_basis this with ⟨C, BC, hC⟩,
  haveI : inhabited β := ⟨0⟩,
  refine ⟨hC.constr (inv_fun f), hB.ext $ λ b bB, _⟩,
  rw image_subset_iff at BC,
  simp [constr_basis hC (BC bB)],
  exact left_inverse_inv_fun (linear_map.ker_eq_bot.1 hf_inj) _
end

lemma exists_right_inverse_linear_map_of_surjective {f : β →ₗ[α] γ}
  (hf_surj : f.range = ⊤) : ∃g:γ →ₗ β, f.comp g = linear_map.id :=
begin
  rcases exists_is_basis α γ with ⟨C, hC⟩,
  haveI : inhabited β := ⟨0⟩,
  refine ⟨hC.constr (inv_fun f), hC.ext $ λ c cC, _⟩,
  simp [constr_basis hC cC],
  exact right_inverse_inv_fun (linear_map.range_eq_top.1 hf_surj) _
end

set_option class.instance_max_depth 49
open submodule linear_map
theorem quotient_prod_linear_equiv (p : submodule α β) :
  nonempty ((p.quotient × p) ≃ₗ[α] β) :=
begin
  rcases exists_right_inverse_linear_map_of_surjective p.range_mkq with ⟨f, hf⟩,
  have mkf : ∀ x, submodule.quotient.mk (f x) = x := linear_map.ext_iff.1 hf,
  have fp : ∀ x, x - f (p.mkq x) ∈ p :=
    λ x, (submodule.quotient.eq p).1 (mkf (p.mkq x)).symm,
  refine ⟨linear_equiv.of_linear (f.copair p.subtype)
    (p.mkq.pair (cod_restrict p (linear_map.id - f.comp p.mkq) fp))
    (by ext; simp) _⟩,
  ext ⟨⟨x⟩, y, hy⟩; simp,
  { apply (submodule.quotient.eq p).2,
    simpa using sub_mem p hy (fp x) },
  { refine subtype.coe_ext.2 _,
    simp [mkf, (submodule.quotient.mk_eq_zero p).2 hy] }
end.

end vector_space

namespace pi
open set linear_map

section module
variables {ι : Type*} {φ : ι → Type*}
variables [ring α] [∀i, add_comm_group (φ i)] [∀i, module α (φ i)] [fintype ι] [decidable_eq ι]

lemma linear_independent_std_basis (s : Πi, set (φ i)) (hs : ∀i, linear_independent α (s i)) :
  linear_independent α (⋃i, std_basis α φ i '' s i) :=
begin
  refine linear_independent_Union_finite _ _,
  { assume i,
    refine (linear_independent_image_iff _).2 (hs i),
    simp only [ker_std_basis, disjoint_bot_right] },
  { assume i J _ hiJ,
    simp [(set.Union.equations._eqn_1 _).symm, submodule.span_image, submodule.span_Union],
    have h₁ : map (std_basis α φ i) (span α (s i)) ≤ (⨆j∈({i} : set ι), range (std_basis α φ j)),
    { exact (le_supr_of_le i $ le_supr_of_le (set.mem_singleton _) $ map_mono $ le_top) },
    have h₂ : (⨆j∈J, map (std_basis α φ j) (span α (s j))) ≤ (⨆j∈J, range (std_basis α φ j)),
    { exact supr_le_supr (assume i, supr_le_supr $ assume hi, map_mono $ le_top) },
    exact disjoint_mono h₁ h₂
      (disjoint_std_basis_std_basis _ _ _ _ $ set.disjoint_singleton_left.2 hiJ) }
end

lemma is_basis_std_basis [fintype ι] (s : Πi, set (φ i)) (hs : ∀i, is_basis α (s i)) :
  is_basis α (⋃i, std_basis α φ i '' s i) :=
begin
  refine ⟨linear_independent_std_basis _ (assume i, (hs i).1), _⟩,
  simp only [submodule.span_Union, submodule.span_image, (assume i, (hs i).2), submodule.map_top,
    supr_range_std_basis]
end

section
variables (α ι)
lemma is_basis_fun [fintype ι] : is_basis α (⋃i, std_basis α (λi:ι, α) i '' {1}) :=
is_basis_std_basis _ (assume i, is_basis_singleton_one _)
end

end module

end pi


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.lattice
import Mathlib.data.set.basic
import Mathlib.PostPort

universes u w v u_1 l

namespace Mathlib

/-- A family of elements of α is directed (with respect to a relation `≼` on α)
  if there is a member of the family `≼`-above any pair in the family.  -/
def directed {α : Type u} {ι : Sort w} (r : α → α → Prop) (f : ι → α) :=
  ∀ (x y : ι), ∃ (z : ι), r (f x) (f z) ∧ r (f y) (f z)

/-- A subset of α is directed if there is an element of the set `≼`-above any
  pair of elements in the set. -/
def directed_on {α : Type u} (r : α → α → Prop) (s : set α) :=
  ∀ (x : α) (H : x ∈ s) (y : α) (H : y ∈ s), ∃ (z : α), ∃ (H : z ∈ s), r x z ∧ r y z

theorem directed_on_iff_directed {α : Type u} {r : α → α → Prop} {s : set α} : directed_on r s ↔ directed r coe := sorry

theorem directed_on.directed_coe {α : Type u} {r : α → α → Prop} {s : set α} : directed_on r s → directed r coe :=
  iff.mp directed_on_iff_directed

theorem directed_on_image {α : Type u} {β : Type v} {r : α → α → Prop} {s : set β} {f : β → α} : directed_on r (f '' s) ↔ directed_on (f ⁻¹'o r) s := sorry

theorem directed_on.mono {α : Type u} {r : α → α → Prop} {s : set α} (h : directed_on r s) {r' : α → α → Prop} (H : ∀ {a b : α}, r a b → r' a b) : directed_on r' s := sorry

theorem directed_comp {α : Type u} {β : Type v} {r : α → α → Prop} {ι : Sort u_1} {f : ι → β} {g : β → α} : directed r (g ∘ f) ↔ directed (g ⁻¹'o r) f :=
  iff.rfl

theorem directed.mono {α : Type u} {r : α → α → Prop} {s : α → α → Prop} {ι : Sort u_1} {f : ι → α} (H : ∀ (a b : α), r a b → s a b) (h : directed r f) : directed s f := sorry

theorem directed.mono_comp {α : Type u} {β : Type v} (r : α → α → Prop) {ι : Sort u_1} {rb : β → β → Prop} {g : α → β} {f : ι → α} (hg : ∀ {x y : α}, r x y → rb (g x) (g y)) (hf : directed r f) : directed rb (g ∘ f) :=
  iff.mpr directed_comp (directed.mono hg hf)

/-- A monotone function on a sup-semilattice is directed. -/
theorem directed_of_sup {α : Type u} {β : Type v} [semilattice_sup α] {f : α → β} {r : β → β → Prop} (H : ∀ {i j : α}, i ≤ j → r (f i) (f j)) : directed r f :=
  fun (a b : α) => Exists.intro (a ⊔ b) { left := H le_sup_left, right := H le_sup_right }

/-- An antimonotone function on an inf-semilattice is directed. -/
theorem directed_of_inf {α : Type u} {β : Type v} [semilattice_inf α] {r : β → β → Prop} {f : α → β} (hf : ∀ (a₁ a₂ : α), a₁ ≤ a₂ → r (f a₂) (f a₁)) : directed r f :=
  fun (x y : α) => Exists.intro (x ⊓ y) { left := hf (x ⊓ y) x inf_le_left, right := hf (x ⊓ y) y inf_le_right }

/-- A `preorder` is a `directed_order` if for any two elements `i`, `j`
there is an element `k` such that `i ≤ k` and `j ≤ k`. -/
class directed_order (α : Type u)
extends preorder α
where
  directed : ∀ (i j : α), ∃ (k : α), i ≤ k ∧ j ≤ k

protected instance linear_order.to_directed_order (α : Type u_1) [linear_order α] : directed_order α :=
  directed_order.mk sorry


import data.nat.modeq

import ent.modeq
import ent.parity

open nat

namespace gcd
  theorem gcd_row_op (a b k : ℕ) : gcd a b = gcd a (a * k + b) :=
    have mods : b ≡ a * k + b [MOD a] := modeq.modeq_of_rep.symm,
    calc gcd a b = gcd (b % a) a            : by rw gcd_rec
         ...     = gcd ((a * k + b) % a) a  : begin unfold modeq at mods, rw mods end
         ...     = gcd a (a * k + b)        : by rw ←gcd_rec

  lemma sum_difference_sum {a c : ℕ} (H : a ≤ c) : (c - a) + (c + a) = 2 * c :=
    calc (c - a) + (c + a) = (c - a) + (a + c)  : by rw add_comm a c
         ...               = ((c - a) + a) + c  : by rw add_assoc
         ...               = (a + (c - a)) + c  : by rw add_comm (c - a) a
         ...               = c + c              : by rw add_sub_of_le H
         ...               = 2 * c              : by rw two_mul

  lemma sum_difference_difference {a c : ℕ} (H : a ≤ c) : (c + a) - (c - a) = 2 * a :=
    calc (c + a) - (c - a) = (a + c) - (c - a)  : by rw add_comm c a
         ...               = a + (c - (c - a))  : by rw nat.add_sub_assoc (sub_le c a) a
         ...               = a + a              : by rw nat.sub_sub_self H
         ...               = 2 * a              : by rw two_mul

  lemma sum_difference_of_coprime (a c : ℕ) (H : a ≤ c) : coprime a c → gcd (c - a) (c + a) ∣ 2 :=
    begin
      intros ac,
      let g := gcd (c - a) (c + a),
      cases gcd_dvd (c - a) (c + a) with gminus gplus,
      have g2c : g ∣ 2 * c := by rw ←sum_difference_sum H; apply dvd_add; assumption,
      have : c - a ≤ c + a := trans (nat.sub_le c a) (le_add_right c a),
      have g2a : g ∣ 2 * a := by rw ←sum_difference_difference H; apply nat.dvd_sub this; assumption,
      have g2ac : g ∣ gcd (2 * a) (2 * c) := dvd_gcd g2a g2c,
      rw [gcd_mul_left 2 a c, ac.gcd_eq_one] at g2ac,
      exact g2ac
    end

  lemma sum_difference_of_coprime_odd (a c : ℕ) (H : a ≤ c) : coprime a c → odd a → odd c → gcd (c - a) (c + a) = 2 :=
    begin
      intros ac oa oc,
      apply nat.dvd_antisymm,
      { exact sum_difference_of_coprime a c H ac },
      { exact
         dvd_gcd (even_iff_two_dvd.mp (odd_minus_odd_is_even H oa oc))
                 (even_iff_two_dvd.mp (odd_plus_odd_is_even oc oa))
      }
    end

  lemma coprime_iff_squares_coprime {x y : ℕ} : coprime (x^2) (y^2) ↔ coprime x y :=
    iff.intro
      (λ H, coprime.coprime_dvd_left self_divides_square
            (coprime.coprime_dvd_right self_divides_square H))
      (coprime.pow 2 2)
end gcd

lemma coprime_square_product {x y z : ℕ} : x * y = z^2 → coprime x y →
                                           ∃ x1 y1, x = x1^2 ∧ y = y1^2 :=
  begin
    intros,
    rw nat.pow_two at a,
    cases eq_zero_or_pos x with xzero xpos,
    { -- x = 0
      have y1 : y = 1 :=
        begin simp [xzero, coprime, gcd_zero_left] at a_1, exact a_1 end,
      existsi [0, 1],
      split,
      { rw xzero, refl }, { rw y1, refl }
    },
    -- x > 0
    have H : x ∣ z * z := begin rw ←a, apply dvd_mul_right end,
    cases exists_eq_prod_and_dvd_and_dvd H with x1 H1,
    cases H1 with x2,
    cases H1_h,
    cases H1_h_right,
    existsi [x1, (z/x1)],
    let y1 := z / x1,
    let y2 := z / x2,
    have xyz1 : x1 * y1 = z :=
      begin
        show x1 * (z / x1) = z,
        apply nat.mul_div_cancel',
        exact H1_h_right_left
      end,
    have xyz2 : x2 * y2 = z :=
      begin
        show x2 * (z / x2) = z,
        apply nat.mul_div_cancel',
        exact H1_h_right_right
      end,
    have y1y2 : y = y1 * y2 :=
      begin
        show y = (z / x1) * (z / x2),
        rw [←nat.mul_left_inj xpos, a, H1_h_left],
        have res : z * z = x1 * x2 * (z / x1 * (z / x2)) :=
          calc z * z = (x1 * (z / x1)) * z      : by rw nat.mul_div_cancel' H1_h_right_left
               ...   = (x1 * (z / x1)) * (x2 * (z / x2)) : by rw nat.mul_div_cancel' H1_h_right_right
               ...   = x1 * ((z / x1) * (x2 * (z / x2))) : by rw mul_assoc
               ...   = x1 * (((z / x1) * x2) * (z / x2)) : by rw mul_assoc
               ...   = x1 * ((x2 * (z / x1)) * (z / x2)) : by rw mul_comm (z / x1) x2
               ...   = x1 * (x2 * ((z / x1) * (z / x2))) : by rw mul_assoc
               ...   = (x1 * x2) * ((z / x1) * (z / x2)) : by rw mul_assoc,
        exact res
      end,
    have xeq : x1 = x2 :=
      begin
        rw [H1_h_left, y1y2] at a_1,
        have cx1y2 : gcd x1 y2 = 1 := a_1.coprime_mul_right.coprime_mul_left_right,
        have cx2y1 : gcd x2 y1 = 1 := a_1.coprime_mul_left.coprime_mul_right_right,
        have g2 : gcd x z = x2 :=
          begin
            rw [H1_h_left, ←xyz2, mul_comm x2 y2],
            calc gcd (x1 * x2) (y2 * x2) = gcd x1 y2 * x2 : by rw gcd_mul_right
                 ...                     = 1 * x2         : by rw cx1y2
                 ...                     = x2             : by simp
          end,
        have g1 : gcd x z = x1 :=
          begin
            rw [H1_h_left, ←xyz1],
            calc gcd (x1 * x2) (x1 * y1) = x1 * gcd x2 y1 : by rw gcd_mul_left
                 ...                     = x1 * 1         : by rw cx2y1
                 ...                     = x1             : by simp
          end,
        exact (symm g1).trans g2
      end,
    split,
    { rw [nat.pow_two], rwa ←xeq at H1_h_left },
    { have yeq : y1 = y2 := begin show z / x1 = z / x2, rw xeq end,
      rw [nat.pow_two],
      calc y = y1 * y2                : y1y2
           ... = y1 * y1              : by rw yeq
           ... = (z / x1) * (z / x1)  : by simp
    }
  end

/-

x y = z^2, x _|_ y

x = z1 z2
y = (z / z1) (z / z2)

If p divides z2 more times than z1 then p will also divide z / z1 at least once,
and then z / z1 and z2 will not be relatively prime.

gcd(z2, z/z1) = 1 => gcd(z1 z2, z) = z1
gcd(z1, z/z2) = 1 => gcd(z1 z2, z) = z2

-/


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

Very simple (sqrt n) function that returns s s.t.
    s*s ≤ n ≤ s*s + s + s
-/
import data.nat.order data.nat.sub

namespace nat
open decidable

-- This is the simplest possible function that just performs a linear search
definition sqrt_aux : nat → nat → nat
| 0        n := 0
| (succ s) n := if (succ s)*(succ s) ≤ n then succ s else sqrt_aux s n

theorem sqrt_aux_succ_of_pos {s n} : (succ s)*(succ s) ≤ n → sqrt_aux (succ s) n = (succ s) :=
assume h, if_pos h

theorem sqrt_aux_succ_of_neg {s n} : ¬ (succ s)*(succ s) ≤ n → sqrt_aux (succ s) n = sqrt_aux s n :=
assume h, if_neg h

theorem sqrt_aux_of_le : ∀ {s n : nat}, s * s ≤ n → sqrt_aux s n = s
| 0        n h := rfl
| (succ s) n h := by rewrite [sqrt_aux_succ_of_pos h]

theorem sqrt_aux_le : ∀ (s n), sqrt_aux s n ≤ s
| 0        n := !zero_le
| (succ s) n := or.elim (em ((succ s)*(succ s) ≤ n))
  (λ h, begin unfold sqrt_aux, rewrite [if_pos h] end)
  (λ h,
    have sqrt_aux s n ≤ succ s, from le.step (sqrt_aux_le s n),
    begin unfold sqrt_aux, rewrite [if_neg h], assumption end)

definition sqrt (n : nat) : nat :=
sqrt_aux n n

theorem sqrt_aux_lower : ∀ {s n : nat}, s ≤ n → sqrt_aux s n * sqrt_aux s n ≤ n
| 0        n h := h
| (succ s) n h := by_cases
  (λ h₁ : (succ s)*(succ s) ≤ n,   by rewrite [sqrt_aux_succ_of_pos h₁]; exact h₁)
  (λ h₂ : ¬ (succ s)*(succ s) ≤ n,
     have aux : s ≤ n, from le_of_succ_le h,
     by rewrite [sqrt_aux_succ_of_neg h₂]; exact (sqrt_aux_lower aux))

theorem sqrt_lower (n : nat) : sqrt n * sqrt n ≤ n :=
sqrt_aux_lower (le.refl n)

theorem sqrt_aux_upper : ∀ {s n : nat}, n ≤ s*s + s + s → n ≤ sqrt_aux s n * sqrt_aux s n + sqrt_aux s n + sqrt_aux s n
| 0         n   h := h
| (succ s)  n   h := by_cases
  (λ h₁ : (succ s)*(succ s) ≤ n,
    by rewrite [sqrt_aux_succ_of_pos h₁]; exact h)
  (λ h₂ : ¬ (succ s)*(succ s) ≤ n,
    have h₃ : n < (succ s) * (succ s), from lt_of_not_ge h₂,
    have h₄ : n ≤ s * s + s + s, by rewrite [succ_mul_succ_eq at h₃]; exact le_of_lt_succ h₃,
    by rewrite [sqrt_aux_succ_of_neg h₂]; exact (sqrt_aux_upper h₄))

theorem sqrt_upper (n : nat) : n ≤ sqrt n * sqrt n + sqrt n + sqrt n :=
have aux : n ≤ n*n + n + n, from le_add_of_le_right (le_add_of_le_left (le.refl n)),
sqrt_aux_upper aux

private theorem le_squared : ∀ (n : nat), n ≤ n*n
| 0        := !le.refl
| (succ n) :=
  have aux₁ : 1 ≤ succ n, from succ_le_succ !zero_le,
  have aux₂ : 1 * succ n ≤ succ n * succ n, from nat.mul_le_mul aux₁ !le.refl,
  by rewrite [one_mul at aux₂]; exact aux₂

private theorem lt_squared : ∀ {n : nat}, n > 1 → n < n * n
| 0               h := absurd h dec_trivial
| 1               h := absurd h dec_trivial
| (succ (succ n)) h :=
  have 1 < succ (succ n),                                   from dec_trivial,
  have succ (succ n) * 1 < succ (succ n) * succ (succ n), from mul_lt_mul_of_pos_left this dec_trivial,
  by rewrite [mul_one at this]; exact this

theorem sqrt_le (n : nat) : sqrt n ≤ n :=
calc sqrt n ≤ sqrt n * sqrt n : le_squared
        ... ≤ n               : sqrt_lower

theorem eq_zero_of_sqrt_eq_zero {n : nat} : sqrt n = 0 → n = 0 :=
suppose sqrt n = 0,
have n ≤ sqrt n * sqrt n + sqrt n + sqrt n, from !sqrt_upper,
have n ≤ 0, by rewrite [*`sqrt n = 0` at this]; exact this,
eq_zero_of_le_zero this

theorem le_three_of_sqrt_eq_one {n : nat} : sqrt n = 1 → n ≤ 3 :=
suppose sqrt n = 1,
have n ≤ sqrt n * sqrt n + sqrt n + sqrt n, from !sqrt_upper,
show   n ≤ 3, by rewrite [*`sqrt n = 1` at this]; exact this

theorem sqrt_lt : ∀ {n : nat}, n > 1 → sqrt n < n
| 0     h := absurd h dec_trivial
| 1     h := absurd h dec_trivial
| 2     h := dec_trivial
| 3     h := dec_trivial
| (n+4) h :=
  have sqrt (n+4) > 1, from by_contradiction
    (suppose ¬ sqrt (n+4) > 1,
     have sqrt (n+4) ≤ 1, from le_of_not_gt this,
       or.elim (eq_or_lt_of_le this)
         (suppose sqrt (n+4) = 1,
          have n+4 ≤ 3, from le_three_of_sqrt_eq_one this,
          absurd this dec_trivial)
         (suppose sqrt (n+4) < 1,
          have sqrt (n+4) = 0, from eq_zero_of_le_zero (le_of_lt_succ this),
          have n + 4 = 0,      from eq_zero_of_sqrt_eq_zero this,
          absurd this dec_trivial)),
  calc sqrt (n+4) < sqrt (n+4) * sqrt (n+4) : lt_squared this
              ... ≤ n+4                     : sqrt_lower

theorem sqrt_pos_of_pos {n : nat} : n > 0 → sqrt n > 0 :=
suppose n > 0,
have sqrt n ≠ 0, from
  suppose sqrt n = 0,
  have n = 0, from eq_zero_of_sqrt_eq_zero this,
  by subst n; exact absurd `0 > 0` !lt.irrefl,
pos_of_ne_zero this

theorem sqrt_aux_offset_eq {n k : nat} (h₁ : k ≤ n + n) : ∀ {s}, s ≥ n → sqrt_aux s (n*n + k) = n
| 0        h₂ :=
  have neqz : n = 0, from eq_zero_of_le_zero h₂,
  by rewrite neqz
| (succ s) h₂ := by_cases
  (λ hl : (succ s)*(succ s) ≤ n*n + k,
     have l₁ : n*n + k ≤ n*n + n + n,       from by rewrite [add.assoc]; exact (add_le_add_left h₁ (n*n)),
     have l₂ : n*n + k < n*n + n + n + 1,   from lt_succ_of_le l₁,
     have l₃ : n*n + k < (succ n)*(succ n), by rewrite [-succ_mul_succ_eq at l₂]; exact l₂,
     have l₄ : (succ s)*(succ s) < (succ n)*(succ n), from lt_of_le_of_lt hl l₃,
     have ng : ¬ succ s > (succ n), from
       assume g : succ s > succ n,
         have g₁ : (succ s)*(succ s) > (succ n)*(succ n), from mul_lt_mul_of_le_of_le g g,
         absurd (lt.trans g₁ l₄) !lt.irrefl,
     have sslesn  : succ s ≤ succ n, from le_of_not_gt ng,
     have ssnesn  : succ s ≠ succ n, from
       assume sseqsn : succ s = succ n,
         by rewrite [sseqsn at l₄]; exact (absurd l₄ !lt.irrefl),
     have   sslen : s < n, from lt_of_succ_lt_succ (lt_of_le_of_ne sslesn ssnesn),
     have sseqn : succ s = n, from le.antisymm sslen h₂,
     by rewrite [sqrt_aux_succ_of_pos hl]; exact sseqn)
  (λ hg : ¬ (succ s)*(succ s) ≤ n*n + k,
    or.elim (eq_or_lt_of_le h₂)
     (λ neqss : n = succ s,
        have p : n*n ≤ n*n + k, from !le_add_right,
        have n : ¬ n*n ≤ n*n + k, by rewrite [-neqss at hg]; exact hg,
        absurd p n)
     (λ sgen : succ s > n,
        by rewrite [sqrt_aux_succ_of_neg hg]; exact (sqrt_aux_offset_eq (le_of_lt_succ sgen))))

theorem sqrt_offset_eq {n k : nat} : k ≤ n + n → sqrt (n*n + k) = n :=
assume h,
have h₁ : n ≤ n*n + k, from le.trans !le_squared !le_add_right,
sqrt_aux_offset_eq h h₁

theorem sqrt_eq (n : nat) : sqrt (n*n) = n :=
sqrt_offset_eq !zero_le

theorem mul_square_cancel {a b : nat} : a*a = b*b → a = b :=
assume h,
have aux : sqrt (a*a) = sqrt (b*b), by rewrite h,
by rewrite [*sqrt_eq at aux]; exact aux
end nat


import lib.m154

/-
# Un apercu du cours de Logique et démonstations assistées par ordinateur

Ce fichier ne contient pas d'exercice, son but est de montrer à quoi
va ressembler une démonstration expliquée à l'ordinateur au milieu du semestre.
Le but de ce cours est de parvenir à concevoir et rédiger ce genre de
démonstration sur papier.

La syntaxe et les différentes commandes seront expliquées au fur et à mesure.
Pour l'instant, il suffit de lire les définitions, l'énoncé et la démonstration
ci-dessous et de ce convaincre que cela rappelle des souvenirs du cours d'analyse
du premier semestre.

Ce fichier est prévu pour être ouvert dans l'éditeur Visual Studio Code (ou VSCodium).
La partie droite de l'écran doit afficher une zone intitulée « Lean Infoview ».
Si ce n'est pas le cas, la combinaison de touche Ctrl-Maj-Entrée
(ou Cmd-Maj-Entrée sur un Mac) doit la faire apparaître. Si cette zone
Infoview se retrouve accidentellement dans un onglet difficile d'accès, le plus
simple est de fermer l'onglet et de rouvrir la zone par Ctrl-Maj-Entrée.

Lorsque le curseur se trouve dans la démonstration, la zone « Lean Infoview »
affiche les objets et hypothèses intervenant à ce stade de la démonstration,
ainsi que le ou les buts de la démonstration.
-/

-- Définition de « f est continue en x₀ »
-- Lean n'a pas besoin de parenthèse dans f(x)
def continue_en (f : ℝ → ℝ) (x₀ : ℝ) : Prop :=
∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - f x₀| ≤ ε

-- Une suite u est une fonction de ℕ dans ℝ
-- Définition de « u tend vers l »
def limite_suite (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

-- Soit f une fonction, u une suite de réels et x₀ un réel.
-- Si f est continue en x₀ et si la suite u tend vers x₀ alors la suite f ∘ u,
-- qui envoie n sur f (u n), tend vers f x₀
example (f : ℝ → ℝ) (u : ℕ → ℝ) (x₀ : ℝ)
  (hf : continue_en f x₀) (hu : limite_suite u x₀) :
  limite_suite (f ∘ u) (f x₀) :=
begin
  Montrons que ∀ ε > 0, ∃ N, ∀ n ≥ N, |(f ∘ u) n - f x₀| ≤ ε,
  Soit ε > 0,
  Par hf appliqué à [ε, ε_pos] on obtient δ : ℝ tel que
    (δ_pos : δ > 0) (hδf : ∀ x, |x - x₀| ≤ δ → |f x - f x₀| ≤ ε),
  Par hu appliqué à [δ, δ_pos] on obtient N : ℕ tel que
    (hNu : ∀ n ≥ N, |u n - x₀| ≤ δ),
  Montrons que N convient : ∀ n ≥ N, |(f ∘ u) n - f x₀| ≤ ε,
  Soit n ≥ N,
  Montrons que |(f ∘ u) n - f x₀| ≤ ε,
  Par hδf il suffit de montrer que |u n - x₀| ≤ δ,
  On conclut par hNu appliqué à [n, n_ge],
end


/-
Copyright (c) 2021 Antoine Labelle. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Antoine Labelle
-/
import algebra.big_operators.basic
import algebra.big_operators.order
import data.fintype.card
import data.finset.sort
import data.fin.interval
import tactic.linarith
import tactic.by_contra

/-!
# IMO 1994 Q1

Let `m` and `n` be two positive integers.
Let `a₁, a₂, ..., aₘ` be `m` different numbers from the set `{1, 2, ..., n}`
such that for any two indices `i` and `j` with `1 ≤ i ≤ j ≤ m` and `aᵢ + aⱼ ≤ n`,
there exists an index `k` such that `aᵢ + aⱼ = aₖ`.
Show that `(a₁+a₂+...+aₘ)/m ≥ (n+1)/2`

# Sketch of solution

We can order the numbers so that `a₁ ≤ a₂ ≤ ... ≤ aₘ`.
The key idea is to pair the numbers in the sum and show that `aᵢ + aₘ₊₁₋ᵢ ≥ n+1`.
Indeed, if we had `aᵢ + aₘ₊₁₋ᵢ ≤ n`, then `a₁ + aₘ₊₁₋ᵢ, a₂ + aₘ₊₁₋ᵢ, ..., aᵢ + aₘ₊₁₋ᵢ`
would be `m` elements of the set of `aᵢ`'s all larger than `aₘ₊₁₋ᵢ`, which is impossible.
-/

open_locale big_operators

open finset

lemma tedious (m : ℕ) (k : fin (m+1)) : m - (m + (m + 1 - ↑k)) % (m + 1) = ↑k  :=
begin
  cases k with k hk,
  rw [nat.lt_succ_iff,le_iff_exists_add] at hk,
  rcases hk with ⟨c, rfl⟩,
  have : k + c + (k + c + 1 - k) = c + (k + c + 1),
  { simp only [add_assoc, add_tsub_cancel_left], ring_nf, },
  rw [fin.coe_mk, this, nat.add_mod_right, nat.mod_eq_of_lt, nat.add_sub_cancel],
  linarith
end

theorem imo1994_q1 (n : ℕ) (m : ℕ) (A : finset ℕ) (hm : A.card = m + 1)
  (hrange : ∀ a ∈ A, 0 < a ∧ a ≤ n) (hadd : ∀ (a b ∈ A), a + b ≤ n → a + b ∈ A) :
  (m+1)*(n+1) ≤ 2*(∑ x in A, x) :=
begin
  set a := order_emb_of_fin A hm,  -- We sort the elements of `A`
  have ha : ∀ i, a i ∈ A := λ i, order_emb_of_fin_mem A hm i,
  set rev := equiv.sub_left (fin.last m), -- `i ↦ m-i`

  -- We reindex the sum by fin (m+1)
  have : ∑ x in A, x = ∑ i : fin (m+1), a i,
  { convert sum_image (λ x hx y hy, (order_embedding.eq_iff_eq a).1),
    rw ←coe_inj, simp },
  rw this, clear this,

  -- The main proof is a simple calculation by rearranging one of the two sums
  suffices hpair : ∀ k ∈ univ, a k + a (rev k) ≥ n+1,
  calc 2 * ∑ i : fin (m+1), a i
      = ∑ i : fin (m+1), a i + ∑ i : fin (m+1), a i       : two_mul _
  ... = ∑ i : fin (m+1), a i + ∑ i : fin (m+1), a (rev i) : by rw equiv.sum_comp rev
  ... = ∑ i : fin (m+1), (a i + a (rev i))                : sum_add_distrib.symm
  ... ≥ ∑ i : fin (m+1), (n+1)                            : sum_le_sum hpair
  ... = (m+1) * (n+1)                                     : by simp,

  -- It remains to prove the key inequality, by contradiction
  rintros k -,
  by_contra' h : a k + a (rev k) < n + 1,

  -- We exhibit `k+1` elements of `A` greater than `a (rev k)`
  set f : fin (m+1) ↪ ℕ := ⟨λ i, a i + a (rev k),
  begin
    apply injective_of_le_imp_le,
    intros i j hij,
    rwa [add_le_add_iff_right, a.map_rel_iff] at hij,
  end⟩,

  -- Proof that the `f i` are greater than `a (rev k)` for `i ≤ k`
  have hf : map f (Icc 0 k) ⊆ map a.to_embedding (Ioc (rev k) (fin.last m)),
  { intros x hx,
    simp at h hx ⊢,
    rcases hx with ⟨i, ⟨hi, rfl⟩⟩,
    have h1 : a i + a (fin.last m - k) ≤ n,
    { linarith only [h, a.monotone hi.2] },
    have h2 : a i + a (fin.last m - k) ∈ A := hadd _ _ (ha _) (ha _) h1,
    rw [←mem_coe, ←range_order_emb_of_fin A hm, set.mem_range] at h2,
    cases h2 with j hj,
    use j,
    refine ⟨⟨_, fin.le_last j⟩, hj⟩,
    rw [← a.strict_mono.lt_iff_lt, hj],
    simpa using (hrange (a i) (ha i)).1 },

  -- A set of size `k+1` embed in one of size `k`, which yields a contradiction
  have ineq := card_le_of_subset hf,
  simp [fin.coe_sub, tedious] at ineq,
  contradiction ,
end


import basic_defs_world.level1 --hide
open set --hide
namespace topological_space --hide

/-
# Level 2: Union of two open sets
-/

/- Lemma
The union of two open sets is open.
-/
lemma open_of_union {X : Type} [topological_space X] {U V : set X}
(hU : is_open U) (hV : is_open V): is_open (U ∪ V) :=
begin
  let I : set (set X) := {U, V},
  have H : ⋃₀ I = U ∪ V := sUnion_pair U V,
  rw ←H,
  apply union I,
  intros B hB,
  replace hB : B = U ∨ B = V, by tauto,
  cases hB; {rw hB, assumption},

end

end topological_space --hide


import LeanUtils
open Nat

theorem square_of_even_number_is_even (m : Nat) (h₀ : even m) : (even (m ^ 2)) := by

  have ⟨n, h₁⟩ : ∃ (n : Nat), m = 2 * n := by
    simp at *; assumption
  have h₂ : m^2 = 2*(2*n^2) := by
    calc
      m^2 = (2*n)^2 := by
        repeat (first | ring | simp_all)
      _ = 4*n^2 := by
        repeat (first | ring | simp_all)
      _ = 2*(2*n^2) := by
        repeat (first | ring | simp_all)

  simp_all


import algebra.divisibility
import algebra.ring
import data.real.basic
import algebra.order.ring
import tactic.linarith

def divides (a : ℤ) (b : ℤ) := exists c : ℤ, a * c = b

theorem s1p4 (a : ℤ) : divides a a :=
begin
  rw divides,
  use 1,
  ring,
end

theorem s1p5 (a b c : ℤ) (h : divides a b) : divides a (b*c) :=
begin
  rw divides,
  cases h with x,
  have H : c*x*a=b*c,
  { rw mul_assoc, rw mul_comm x a, rw h_h, ring },
  use (x*c),
  ring_nf,
  exact H
end

theorem s1p6 (k a b : ℤ) (ha : divides k a) (hb : divides k b) : divides k (a+b) :=
begin
  rw divides,
  cases ha with x,
  cases hb with y,
  use (x+y),
  rw left_distrib,
  rw ha_h,
  rw hb_h,
end

theorem s1p7 (a b c : ℤ) (ha : divides a b) (hb : divides b c) : divides a c :=
begin
  rw divides,
  cases ha with x,
  cases hb with y,
  use x*y,
  rw <-mul_assoc,
  rw ha_h,
  rw hb_h,
end

theorem s1p8 (a : ℤ) : a * 0 = 0 :=
begin
  sorry
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, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.rat.order
import Mathlib.data.int.sqrt
import Mathlib.PostPort

namespace Mathlib

/-!
# Square root on rational numbers

This file defines the square root function on rational numbers, `rat.sqrt` and proves several theorems about it.

-/

namespace rat

/-- Square root function on rational numbers, defined by taking the (integer) square root of the
numerator and the square root (on natural numbers) of the denominator. -/
def sqrt (q : ℚ) : ℚ :=
  mk (int.sqrt (num q)) ↑(nat.sqrt (denom q))

theorem sqrt_eq (q : ℚ) : sqrt (q * q) = abs q := sorry

theorem exists_mul_self (x : ℚ) : (∃ (q : ℚ), q * q = x) ↔ sqrt x * sqrt x = x := sorry

theorem sqrt_nonneg (q : ℚ) : 0 ≤ sqrt q := sorry


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

import topology.instances.real
import topology.subset_properties

variables (X Y : Type) [topological_space X] [topological_space Y] (f : X → Y)

open filter set

open_locale filter -- para acceder a la notación 𝓟
open_locale topology -- para acceder a la notación 𝓝

/-
## Filtro de entornos
Si `α` es un espacio topológico y `a : α`, entonces `𝓝 a` es el filtro sobre `α`
determinado por `X ∈ 𝓝 a` si y sólo si `X` contiene un entorno abierto de `a`,
o equivalentemente, si `a` está en el interior de `X`.

Interpretamos `𝓝 a` como el "subconjunto generalizado" de `α`
correspondiente a un entorno abierto intinitesimal de `a`.
-/

variables {α : Type*} [topological_space α]

open set

/- En este ejemplo vamos a demostrar que `𝓝 a` es un filtro.

Lemas útiles:

`interior_univ : interior univ = univ`
`mem_univ x : x ∈ univ`
`interior_mono : s ⊆ t → interior s ⊆ interior t`
`??? : interior (s ∩ t) = interior s ∩ interior t` -- ¿Puedes encontrar este lema?
 -/
example (a : α): filter α :=
{ sets := {X : set α | a ∈ interior X},
  univ_sets := begin
    simp only [mem_set_of_eq, interior_univ],
  end,
  sets_of_superset := begin
    intros S T hS hST,
    simp only [mem_set_of_eq] at hS ⊢,
    exact mem_of_subset_of_mem (interior_mono hST) hS,
  end,
  inter_sets := begin
    intros S T hS hT,
    simp only [mem_set_of_eq, interior_inter, mem_inter_iff],
    exact ⟨hS, hT⟩,
  end }

/-
## Puntos de acumulación

Un punto de acumulación, o punto límite (`cluster_pt` en mathlib) `x : α`
de un filtro `F : filter α` en un espacio topológico `α` es un `x : α`
tal que  `𝓝 x ⊓ F ≠ ⊥`.

¿Qué significa esto? `⊥` denota el filtro más pequeño, es decir,
el filtro que contiene todos los subconjuntos de `α`.
Por otro lado, `𝓝 x ⊓ F` es el filtro generado por `F` y por los
entornos de `x`,
Por tanto, el enunciado `𝓝 x ⊓ F ≠ ⊥` dice que no existen conjuntos
`A ∈ 𝓝 x` y `B ∈ F` tal que `A ∩ B = ∅`, o en otras palabras, que
cada elemento del filtro `F` interseca cada entorno de `x`.

Por ejemplo, si `F = 𝓟 S` es el filtro principal de un subconjunto `S`
de `α`, entonces los puntos de acumulación de `𝓟 S` son los puntos
`x` tales que cualquier abierto que contiene a  `x` tiene intersección
no vacía con `S`. Equivalentemente, `x` está en la clausura de `S`.

La idea es que debemos pensar en el punto de acumulación `a : α` de `F : filter α`
como un punto en la clausura del "subconjunto generalizado" correspondiente a `F`.
-/

/-- Este lema se llama `cluster_pt.mono` en mathlib.

La idea es que si `F` y `G` son "subconjuntos generalizados" de un espacio
topológico y "`F ⊆ G`", entonces "`clausura F ⊆ clausura G`".

Empieza la demostración reescribiendo `cluster_pt_iff`.-/
example {x : α} {F G : filter α} (hxF : cluster_pt x F) (hFG : F ≤ G) :
  cluster_pt x G :=
begin
  rw cluster_pt_iff at hxF ⊢,
  intros S hS T hT,
  exact hxF hS (hFG hT),
end

/-
## Compacidad
La definición de compacto (`is_compact`) en mathlib está escrita utilizando
filtros: un subconjunto `S` de un espacio topológico `α` es *compacto*
si para todo filtro no trivial `F ≠ ⊥` tal que `S ∈ F`,
existe `a : α` tal que todo subconjunto de `F` interseca todo entorno abierto de `a`:

`def is_compact (S : set α) := ∀ ⦃F⦄ [ne_bot F], F ≤ 𝓟 S → ∃ a ∈ S, cluster_pt a F`

Esta definición es equivalente a la definición "usual" de subconjunto compacto.

En el siguiente ejercicio, vamos a utilizarla para demostrar que un subconjunto
cerrado de un conjunto compacto es compacto. En realidad demostraremos algo más
general: si `α` es un espacio topológico, entonces la intersección de un
subconjunto compacto de `α` y un subconjunto cerrado de `α` es un subconjunto
compacto de `α`.
-/

lemma closed_of_compact (S : set X) (hS : is_compact S)
  (C : set X) (hC : is_closed C) : is_compact (S ∩ C) :=
begin
  rw is_compact,
  /-  Sea `F` un filtro distinto de `⊥`, y tal que `F ≤ 𝓟 (S ∩ C)`
  (es decir, que contiene `S ∩ C`). -/
  intros F hnF hFSC,
  -- Tenemos que encontrar un punto límite para `F` contenido en `S ∩ C`.

  /- Como `ne_bot f` está entre `[ ]` en la definición de `is_compact`,
    el sistema de inferencia de clases va a buscarlo. Para que lo encuentre,
    lo añadimos explícitamente con esta instrucción `haveI`.-/
  haveI := hnF,

  /- Primero demostraremos que, dado que `S` es compacto, podemos encontrar un
    punto límite `a` para `F` en `S`. -/
  have hFS : ∃ (a : X) (H : a ∈ S), cluster_pt a F,
  { apply hS,
    apply le_trans hFSC,
    rw principal_mono,
    exact set.inter_subset_left _ _, },
  obtain ⟨a, haS, haF⟩ := hFS,

  /- Ahora demostramos que `a` también está en `C`, porque `C` es cerrado.
  Lemas útiles:
  `is_closed.closure_eq : is_closed C → closure C = C`
  `mem_closure_iff_cluster_pt : a ∈ closure S ↔ cluster_pt a (𝓟 S)`- -/
  have haC : a ∈ C,
  { rw [← hC.closure_eq, mem_closure_iff_cluster_pt],
    apply cluster_pt.mono haF,
    apply le_trans hFSC,
    rw principal_mono,
    exact set.inter_subset_right _ _, },

 exact ⟨a, ⟨haS, haC⟩, haF⟩,
end


import data.real.basic

example (x : ℝ) (h : 0 ≤ x) : 0 ≤ x ^ 3 - x ^ 2 + 1 :=
begin
  by_cases x_vs_one : x ≤ 1,
  {
    convert_to 0 ≤ x ^ 3 + 1 - x ^ 2,
    { rw sub_add_eq_add_sub },
    have x_cub : 0 ≤ x ^ 3 := pow_nonneg h 3,
    have x_sqr : x ^ 2 ≤ 1 := (sq_le_one_iff h).mpr x_vs_one,
    have one_sub_x_sqr : 0 ≤ 1 - x ^ 2 := sub_nonneg.mpr x_sqr,
    rw ←add_sub,
    exact add_nonneg x_cub one_sub_x_sqr,
  },
  {
    convert_to 0 ≤ x ^ 2 * (x - 1) + 1,
    { ring },
    nlinarith,
  },
end


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module analysis.subadditive
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Instances.Real
import Mathlib.Order.Filter.Archimedean

/-!
# Convergence of subadditive sequences

A subadditive sequence `u : ℕ → ℝ` is a sequence satisfying `u (m + n) ≤ u m + u n` for all `m, n`.
We define this notion as `Subadditive u`, and prove in `Subadditive.tendsto_lim` that, if `u n / n`
is bounded below, then it converges to a limit (that we denote by `Subadditive.lim` for
convenience). This result is known as Fekete's lemma in the literature.

## TODO

Define a bundled `SubadditiveHom`, use it.
-/

noncomputable section

open Set Filter Topology

/-- A real-valued sequence is subadditive if it satisfies the inequality `u (m + n) ≤ u m + u n`
for all `m, n`. -/
def Subadditive (u : ℕ → ℝ) : Prop :=
  ∀ m n, u (m + n) ≤ u m + u n
#align subadditive Subadditive

namespace Subadditive

variable {u : ℕ → ℝ} (h : Subadditive u)

/-- The limit of a bounded-below subadditive sequence. The fact that the sequence indeed tends to
this limit is given in `Subadditive.tendsto_lim` -/
@[nolint unusedArguments] -- porting note: was irreducible
protected def lim (_h : Subadditive u) :=
  infₛ ((fun n : ℕ => u n / n) '' Ici 1)
#align subadditive.lim Subadditive.lim

theorem lim_le_div (hbdd : BddBelow (range fun n => u n / n)) {n : ℕ} (hn : n ≠ 0) :
    h.lim ≤ u n / n := by
  rw [Subadditive.lim]
  exact cinfₛ_le (hbdd.mono <| image_subset_range _ _) ⟨n, hn.bot_lt, rfl⟩
#align subadditive.lim_le_div Subadditive.lim_le_div

theorem eventually_div_lt_of_div_lt {L : ℝ} {n : ℕ} (hn : n ≠ 0) (hL : u n / n < L) :
    ∀ᶠ p in atTop, u p / p < L := by
  /- It suffices to prove the statement for each arithmetic progression `(n * · + r)`. -/
  refine .atTop_of_arithmetic hn fun r _ => ?_
  /- `(k * u n + u r) / (k * n + r)` tends to `u n / n < L`, hence
  `(k * u n + u r) / (k * n + r) < L` for sufficiently large `k`. -/
  have A : Tendsto (fun x : ℝ => (u n + u r / x) / (n + r / x)) atTop (𝓝 ((u n + 0) / (n + 0))) :=
    (tendsto_const_nhds.add <| tendsto_const_nhds.div_atTop tendsto_id).div
      (tendsto_const_nhds.add <| tendsto_const_nhds.div_atTop tendsto_id) <| by simpa
  have B : Tendsto (fun x => (x * u n + u r) / (x * n + r)) atTop (𝓝 (u n / n)) := by
    rw [add_zero, add_zero] at A
    refine A.congr' <| (eventually_ne_atTop 0).mono fun x hx => ?_
    simp only [(· ∘ ·), add_div' _ _ _ hx, div_div_div_cancel_right _ hx, mul_comm]
  refine ((B.comp tendsto_nat_cast_atTop_atTop).eventually (gt_mem_nhds hL)).mono fun k hk => ?_
  /- Finally, we use an upper estimate on `u (k * n + r)` to get an estimate on
  `u (k * n + r) / (k * n + r)`. -/
  rw [mul_comm]
  refine lt_of_le_of_lt ?_ hk
  simp only [(· ∘ ·), ← Nat.cast_add, ← Nat.cast_mul]
  exact div_le_div_of_le (Nat.cast_nonneg _) (h.apply_mul_add_le _ _ _)
#align subadditive.eventually_div_lt_of_div_lt Subadditive.eventually_div_lt_of_div_lt

/-- Fekete's lemma: a subadditive sequence which is bounded below converges. -/
theorem tendsto_lim (hbdd : BddBelow (range fun n => u n / n)) :
    Tendsto (fun n => u n / n) atTop (𝓝 h.lim) := by
  refine' tendsto_order.2 ⟨fun l hl => _, fun L hL => _⟩
  · refine' eventually_atTop.2
      ⟨1, fun n hn => hl.trans_le (h.lim_le_div hbdd (zero_lt_one.trans_le hn).ne')⟩
  · obtain ⟨n, npos, hn⟩ : ∃ n : ℕ, 0 < n ∧ u n / n < L := by
      rw [Subadditive.lim] at hL
      rcases exists_lt_of_cinfₛ_lt (by simp) hL with ⟨x, hx, xL⟩
      rcases (mem_image _ _ _).1 hx with ⟨n, hn, rfl⟩
      exact ⟨n, zero_lt_one.trans_le hn, xL⟩
    exact h.eventually_div_lt_of_div_lt npos.ne' hn
#align subadditive.tendsto_lim Subadditive.tendsto_lim

end Subadditive


import linear_algebra.basic

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x}  {ι : Type x}

namespace linear_map
section
variables [ring α] [add_comm_group β] [add_comm_group γ] [add_comm_group δ]
variables [module α β] [module α γ] [module α δ]
variables (f g : β →ₗ[α] γ)
include α

lemma comp_eq_mul (f g : β →ₗ[α] β) : f.comp g = f * g := rfl

def restrict
  (f : β →ₗ[α] γ) (p : submodule α β) (q : submodule α γ) (hf : ∀ x ∈ p, f x ∈ q) :
  p →ₗ[α] q :=
{ to_fun := λ x, ⟨f x, hf x.1 x.2⟩,
  map_add' := begin intros, apply set_coe.ext, simp end,
  map_smul' := begin intros, apply set_coe.ext, simp end }

lemma restrict_apply (f : β →ₗ[α] γ) (p : submodule α β) (q : submodule α γ) (hf : ∀ x ∈ p, f x ∈ q) (x : p) :
  f.restrict p q hf x = ⟨f x, hf x.1 x.2⟩ := rfl

end
end linear_map

variables {R : field α} [add_comm_group β] [add_comm_group γ]
variables [vector_space α β] [vector_space α γ]
variables (p p' : submodule α β)
variables {r : α} {x y : β}
include R

lemma vector_space.smul_neq_zero (x : β) (hr : r ≠ 0) : r • x = 0 ↔ x = 0 :=
begin
  have := submodule.smul_mem_iff ⊥ hr,
  rwa [submodule.mem_bot, submodule.mem_bot] at this,
end


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import order.conditionally_complete_lattice.basic
import data.int.least_greatest

/-!
## `ℤ` forms a conditionally complete linear order

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

The integers form a conditionally complete linear order.
-/

open int
open_locale classical
noncomputable theory

instance : conditionally_complete_linear_order ℤ :=
{ Sup := λ s, if h : s.nonempty ∧ bdd_above s then
    greatest_of_bdd (classical.some h.2) (classical.some_spec h.2) h.1 else 0,
  Inf := λ s, if h : s.nonempty ∧ bdd_below s then
    least_of_bdd (classical.some h.2) (classical.some_spec h.2) h.1 else 0,
  le_cSup := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_above s := ⟨⟨n, hns⟩, hs⟩,
    rw [dif_pos this],
    exact (greatest_of_bdd _ _ _).2.2 n hns
  end,
  cSup_le := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_above s := ⟨hs, ⟨n, hns⟩⟩,
    rw [dif_pos this],
    exact hns (greatest_of_bdd _ (classical.some_spec this.2) _).2.1
  end,
  cInf_le := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_below s := ⟨⟨n, hns⟩, hs⟩,
    rw [dif_pos this],
    exact (least_of_bdd _ _ _).2.2 n hns
  end,
  le_cInf := begin
    intros s n hs hns,
    have : s.nonempty ∧ bdd_below s := ⟨hs, ⟨n, hns⟩⟩,
    rw [dif_pos this],
    exact hns (least_of_bdd _ (classical.some_spec this.2) _).2.1
  end,
  .. int.linear_order, ..linear_order.to_lattice }

namespace int

lemma cSup_eq_greatest_of_bdd {s : set ℤ} [decidable_pred (∈ s)]
  (b : ℤ) (Hb : ∀ z ∈ s, z ≤ b) (Hinh : ∃ z : ℤ, z ∈ s) :
  Sup s = greatest_of_bdd b Hb Hinh :=
begin
  convert dif_pos _ using 1,
  { convert coe_greatest_of_bdd_eq _ (classical.some_spec (⟨b, Hb⟩ : bdd_above s)) _ },
  { exact ⟨Hinh, b, Hb⟩, }
end

@[simp]
lemma cSup_empty : Sup (∅ : set ℤ) = 0 := dif_neg (by simp)

lemma cSup_of_not_bdd_above {s : set ℤ} (h : ¬ bdd_above s) : Sup s = 0 := dif_neg (by simp [h])

lemma cInf_eq_least_of_bdd {s : set ℤ} [decidable_pred (∈ s)]
  (b : ℤ) (Hb : ∀ z ∈ s, b ≤ z) (Hinh : ∃ z : ℤ, z ∈ s) :
  Inf s = least_of_bdd b Hb Hinh :=
begin
  convert dif_pos _ using 1,
  { convert coe_least_of_bdd_eq _ (classical.some_spec (⟨b, Hb⟩ : bdd_below s)) _ },
  { exact ⟨Hinh, b, Hb⟩, }
end

@[simp]
lemma cInf_empty : Inf (∅ : set ℤ) = 0 := dif_neg (by simp)

lemma cSup_mem {s : set ℤ} (h1 : s.nonempty) (h2 : bdd_above s) : Sup s ∈ s :=
begin
  convert (greatest_of_bdd _ (classical.some_spec h2) h1).2.1,
  exact dif_pos ⟨h1, h2⟩,
end

lemma cInf_mem {s : set ℤ} (h1 : s.nonempty) (h2 : bdd_below s) : Inf s ∈ s :=
begin
  convert (least_of_bdd _ (classical.some_spec h2) h1).2.1,
  exact dif_pos ⟨h1, h2⟩,
end

end int


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import data.set.lattice
import order.zorn
import tactic.by_contra

/-!
# Extend a partial order to a linear order

This file constructs a linear order which is an extension of the given partial order, using Zorn's
lemma.
-/

universes u
open set classical
open_locale classical

/--
Any partial order can be extended to a linear order.
-/
theorem extend_partial_order {α : Type u} (r : α → α → Prop) [is_partial_order α r] :
  ∃ (s : α → α → Prop) (_ : is_linear_order α s), r ≤ s :=
begin
  let S := {s | is_partial_order α s},
  have hS : ∀ c, c ⊆ S → zorn.chain (≤) c → ∀ y ∈ c, (∃ ub ∈ S, ∀ z ∈ c, z ≤ ub),
  { rintro c hc₁ hc₂ s hs,
    haveI := (hc₁ hs).1,
    refine ⟨Sup c, _, λ z hz, le_Sup hz⟩,
    refine { refl := _, trans := _, antisymm := _ }; simp_rw binary_relation_Sup_iff,
    { intro x,
      exact ⟨s, hs, refl x⟩ },
    { rintro x y z ⟨s₁, h₁s₁, h₂s₁⟩ ⟨s₂, h₁s₂, h₂s₂⟩,
      haveI : is_partial_order _ _ := hc₁ h₁s₁,
      haveI : is_partial_order _ _ := hc₁ h₁s₂,
      cases hc₂.total_of_refl h₁s₁ h₁s₂,
      { exact ⟨s₂, h₁s₂, trans (h _ _ h₂s₁) h₂s₂⟩ },
      { exact ⟨s₁, h₁s₁, trans h₂s₁ (h _ _ h₂s₂)⟩ } },
    { rintro x y ⟨s₁, h₁s₁, h₂s₁⟩ ⟨s₂, h₁s₂, h₂s₂⟩,
      haveI : is_partial_order _ _ := hc₁ h₁s₁,
      haveI : is_partial_order _ _ := hc₁ h₁s₂,
      cases hc₂.total_of_refl h₁s₁ h₁s₂,
      { exact antisymm (h _ _ h₂s₁) h₂s₂ },
      { apply antisymm h₂s₁ (h _ _ h₂s₂) } } },
  obtain ⟨s, hs₁ : is_partial_order _ _, rs, hs₂⟩ := zorn.zorn_nonempty_partial_order₀ S hS r ‹_›,
  resetI,
  refine ⟨s, { total := _ }, rs⟩,
  intros x y,
  by_contra' h,
  let s' := λ x' y', s x' y' ∨ s x' x ∧ s y y',
  rw ←hs₂ s' _ (λ _ _, or.inl) at h,
  { apply h.1 (or.inr ⟨refl _, refl _⟩) },
  { refine
      { refl := λ x, or.inl (refl _),
        trans := _,
        antisymm := _ },
    { rintro a b c (ab | ⟨ax : s a x, yb : s y b⟩) (bc | ⟨bx : s b x, yc : s y c⟩),
      { exact or.inl (trans ab bc), },
      { exact or.inr ⟨trans ab bx, yc⟩ },
      { exact or.inr ⟨ax, trans yb bc⟩ },
      { exact or.inr ⟨ax, yc⟩ } },
    { rintro a b (ab | ⟨ax : s a x, yb : s y b⟩) (ba | ⟨bx : s b x, ya : s y a⟩),
      { exact antisymm ab ba },
      { exact (h.2 (trans ya (trans ab bx))).elim },
      { exact (h.2 (trans yb (trans ba ax))).elim },
      { exact (h.2 (trans yb bx)).elim } } },
end

/-- A type alias for `α`, intended to extend a partial order on `α` to a linear order. -/
def linear_extension (α : Type u) : Type u := α

noncomputable instance {α : Type u} [partial_order α] : linear_order (linear_extension α) :=
{ le := (extend_partial_order ((≤) : α → α → Prop)).some,
  le_refl := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.1.1.1,
  le_trans := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.1.2.1,
  le_antisymm := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.2.1,
  le_total := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.2.1,
  decidable_le := classical.dec_rel _ }

/-- The embedding of `α` into `linear_extension α` as a relation homomorphism. -/
def to_linear_extension {α : Type u} [partial_order α] :
  ((≤) : α → α → Prop) →r ((≤) : linear_extension α → linear_extension α → Prop) :=
{ to_fun := λ x, x,
  map_rel' := λ a b, (extend_partial_order ((≤) : α → α → Prop)).some_spec.some_spec _ _ }

instance {α : Type u} [inhabited α] : inhabited (linear_extension α) :=
⟨(default : α)⟩


/-
Copyright (c) 2021 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.normed_space.ordered
import analysis.asymptotics.asymptotics

/-!
# A collection of specific asymptotic results

This file contains specific lemmas about asymptotics which don't have their place in the general
theory developped in `analysis.asymptotics.asymptotics`.
-/

open filter asymptotics
open_locale topological_space

section normed_field

/-- If `f : 𝕜 → E` is bounded in a punctured neighborhood of `a`, then `f(x) = o((x - a)⁻¹)` as
`x → a`, `x ≠ a`. -/
lemma filter.is_bounded_under.is_o_sub_self_inv {𝕜 E : Type*} [normed_field 𝕜] [has_norm E]
  {a : 𝕜} {f : 𝕜 → E} (h : is_bounded_under (≤) (𝓝[≠] a) (norm ∘ f)) :
  is_o f (λ x, (x - a)⁻¹) (𝓝[≠] a) :=
begin
  refine (h.is_O_const (@one_ne_zero ℝ _ _)).trans_is_o (is_o_const_left.2 $ or.inr _),
  simp only [(∘), normed_field.norm_inv],
  exact (tendsto_norm_sub_self_punctured_nhds a).inv_tendsto_zero
end

end normed_field

section linear_ordered_field

variables {𝕜 : Type*} [linear_ordered_field 𝕜]

lemma pow_div_pow_eventually_eq_at_top {p q : ℕ} :
  (λ x : 𝕜, x^p / x^q) =ᶠ[at_top] (λ x, x^((p : ℤ) -q)) :=
begin
  apply ((eventually_gt_at_top (0 : 𝕜)).mono (λ x hx, _)),
  simp [zpow_sub₀ hx.ne'],
end

lemma pow_div_pow_eventually_eq_at_bot {p q : ℕ} :
  (λ x : 𝕜, x^p / x^q) =ᶠ[at_bot] (λ x, x^((p : ℤ) -q)) :=
begin
  apply ((eventually_lt_at_bot (0 : 𝕜)).mono (λ x hx, _)),
  simp [zpow_sub₀ hx.ne'.symm],
end

lemma tendsto_zpow_at_top_at_top {n : ℤ}
  (hn : 0 < n) : tendsto (λ x : 𝕜, x^n) at_top at_top :=
begin
  lift n to ℕ using hn.le,
  simp only [zpow_coe_nat],
  exact tendsto_pow_at_top (nat.succ_le_iff.mpr $int.coe_nat_pos.mp hn)
end

lemma tendsto_pow_div_pow_at_top_at_top {p q : ℕ}
  (hpq : q < p) : tendsto (λ x : 𝕜, x^p / x^q) at_top at_top :=
begin
  rw tendsto_congr' pow_div_pow_eventually_eq_at_top,
  apply tendsto_zpow_at_top_at_top,
  linarith
end

lemma tendsto_pow_div_pow_at_top_zero [topological_space 𝕜] [order_topology 𝕜] {p q : ℕ}
  (hpq : p < q) : tendsto (λ x : 𝕜, x^p / x^q) at_top (𝓝 0) :=
begin
  rw tendsto_congr' pow_div_pow_eventually_eq_at_top,
  apply tendsto_zpow_at_top_zero,
  linarith
end

end linear_ordered_field

section normed_linear_ordered_field

variables {𝕜 : Type*} [normed_linear_ordered_field 𝕜]

lemma asymptotics.is_o_pow_pow_at_top_of_lt
  [order_topology 𝕜] {p q : ℕ} (hpq : p < q) :
  is_o (λ x : 𝕜, x^p) (λ x, x^q) at_top :=
begin
  refine (is_o_iff_tendsto' _).mpr (tendsto_pow_div_pow_at_top_zero hpq),
  exact (eventually_gt_at_top 0).mono (λ x hx hxq, (pow_ne_zero q hx.ne' hxq).elim),
end

lemma asymptotics.is_O.trans_tendsto_norm_at_top {α : Type*} {u v : α → 𝕜} {l : filter α}
  (huv : is_O u v l) (hu : tendsto (λ x, ∥u x∥) l at_top) : tendsto (λ x, ∥v x∥) l at_top :=
begin
  rcases huv.exists_pos with ⟨c, hc, hcuv⟩,
  rw is_O_with at hcuv,
  convert tendsto.at_top_div_const hc (tendsto_at_top_mono' l hcuv hu),
  ext x,
  rw mul_div_cancel_left _ hc.ne.symm,
end

end normed_linear_ordered_field


variables (A : Type) (p q : A → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
iff.intro
  (assume H : ∀ x, p x ∧ q x,
    and.intro
      (take y : A, and.left (H y))
      (take y : A, and.right (H y)))
  (assume H : (∀ x, p x) ∧ (∀ x, q x),
    take y : A,
    and.intro (and.left H y) (and.right H y))

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
  assume Hpq : ∀ x, p x → q x,
  assume Hp : ∀ x, p x,
  take y : A,
  Hpq y (Hp y)

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
  assume Hpq,
  take y : A,
  or.elim Hpq
    (λ H : (∀ x, p x), or.inl (H y))
    (λ H : (∀ x, q x), or.inr (H y))

variables (a b c : Type) (f : a → b) (g : b → c)

variable r : Prop

example : A → ((∀ x : A, r) ↔ r) :=
  assume H : A,
  iff.intro
    (assume Hr : (∀ x : A, r), Hr H)
    (assume Hr : r, take y, Hr)

open classical

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
iff.intro
  (assume H : ∀ x, p x ∨ r,
    by_cases or.inr
      (assume Hnr : ¬r,
        or.inl
          (take y : A,
            or.elim (H y) id (λ Hr, absurd Hr Hnr))))
  (assume H : (∀ x, p x) ∨ r,
    take y : A,
    or.elim H
      (λ Hp, or.inl (Hp y))
      or.inr)

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
iff.intro
  (assume H : (∀ x, r → p x),
    assume Hr : r,
    take y : A, H y Hr)
  (assume H : r → ∀ x, p x,
    take y : A,
    assume Hr : r, H Hr y)

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

example (H : ∀ x : men, shaves barber x ↔ ¬shaves x x) : false :=
  have Hns : ¬shaves barber barber, from
    not.intro
      (assume Hs : shaves barber barber,
        iff.mp (H barber) Hs Hs),
  have Hs : shaves barber barber, from
    iff.mpr (H barber) Hns,
  Hns Hs


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

inductive Exp where
  | nat : Nat → Exp
  | add : Exp → Exp → Exp
  | bool : Bool → Exp
  | and : Exp → Exp → Exp

inductive Ty where
  | nat : Ty
  | bool : Ty
  deriving DecidableEq

inductive HasType : Exp → Ty → Prop where
  | constNat (n : Nat) : HasType (.nat n) .nat
  | constBool (b : Bool) : HasType (.bool b) .bool
  | addApp (l r : Exp) (hl : HasType l .nat) (hr : HasType r .nat) : HasType (.add l r) .nat
  | andApp (l r : Exp) (hl : HasType l .bool) (hr : HasType r .bool) : HasType (.and l r) .bool

inductive Maybe (p : α → Prop) where
  | found : (a : α) → p a → Maybe p
  | unknown : Maybe p

notation "{{" t "|" p "}}" => Maybe (fun t => p)

def Exp.typecheck : (e : Exp) → {{ t | HasType e t }}
  | nat n => .found .nat (.constNat n)
  | bool b => .found .bool (.constBool b)
  | add l r =>
    match l.typecheck, r.typecheck with
    | .found .nat lth, .found .nat rth => .found .nat (.addApp l r lth rth)
    | _, _ => .unknown
  | and l r =>
    match l.typecheck, r.typecheck with
    | .found .bool lth, .found .bool rth => .found .bool (.andApp l r lth rth)
    | _, _ => .unknown

theorem HasType_det : HasType e t1 → HasType e t2 → t1 = t2 := by
  intro h1 h2
  cases h1 <;> cases h2 <;> rfl

theorem Exp.typecheck_correct : HasType e t → typecheck e ≠ .unknown → typecheck e = .found t h := by
  intro ht1
  cases typecheck e with
  | found t2 ht2 =>
    intros
    have h : t = t2 := HasType_det ht1 ht2
    simp [h]
  | unknown =>
    intros
    contradiction

theorem Exp.typecheck_complete : typecheck e = .unknown → ∀ t, ¬HasType e t := by
  induction e with simp [Exp.typecheck]
  | add l r lih rih =>
    split
    case add.h_1 _ _ htl htr rl rr =>
      intros
      contradiction
    case add.h_2 _ _ hnp =>
      intro h t ht
      cases ht with
      | addApp lt rt lth rth =>
        exact hnp lth rth (typecheck_correct lth (lih · _ lth)) (typecheck_correct rth (rih · _ rth))
  | and l r lih rih =>
    split
    case and.h_1 _ _ htl htr rl rr =>
      intros
      contradiction
    case and.h_2 _ _ hnp =>
      intro h t ht
      cases ht with
      | andApp lt rt lth rth =>
        exact hnp lth rth (typecheck_correct lth (lih · _ lth)) (typecheck_correct rth (rih · _ rth))

def Exp.typecheck' (e : Exp) : {t : Ty // HasType e t} ⊕' (∀ t, ¬HasType e t) :=
  match h:Exp.typecheck e with
  | .found t ht => PSum.inl ⟨t, ht⟩
  | .unknown => PSum.inr (typecheck_complete h)

end Chapter5
end Cpdt


import data.set.basic -- hide
import tactic -- hide

/-

## Working with the image of a function

In this level we will learn how to work with the image of a function.
If `A: set X` and `B: set Y` are sets and we have `f : X → Y`, the image of `A` under `f`, $ f(A) $ is written as `f '' A`.

If we have a proof that an element `b` belongs to the image, `hb: b ∈ f '' A` we can use `cases hb` to get a preimage and a proof that it belongs to the preimage.

```
hb_w : A
hb_h : hb_w ∈ A ∧ f hb_w = b
```

We can change the names using `cases hb with a ha` instead. Now we will get

```
a: A
ha: a ∈ A ∧ f a = b
```

If we want to prove something like `b ∈ f '' A`, we can use the `use` tactic to provide
an element `a : X`, and then prove that `a ∈ A` and `f a = b`.
-/

variables{X Y: Type} -- hide
variables {S : set X}
variables {y : Y}
variables {f : X → Y}

lemma mem_image : y ∈ f '' S ↔ ∃ x , x ∈ S ∧ f x = y
:= set.mem_image f S y
/- Axiom:
mem_image : y ∈ f '' S ↔ ∃ x , x ∈ S ∧ f x = y
-/

/- Lemma
If $ A ⊆ B $, then $ f(A) ⊆ f(B) $
-/
lemma image_subset (f : X → Y) (A B : set X) (h: A ⊆ B): f '' A ⊆  f '' B :=
begin
  intros y hy,
  cases hy with x hx,
  use x,
  split,
  apply h,
  exact hx.1,
  exact hx.2,

end


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_159
  (b : ℝ)
  (f : ℝ → ℝ)
  (h₀ : ∀ x, f x = 3 * x^4 - 7 * x^3 + 2 * x^2 - b * x + 1)
  (h₁ : f 1 = 1) :
  b = -2 :=
begin
  rw h₀ at h₁,
  linarith,
end