/-
Copyright (c) 2021 Martin Zinkevich. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Martin Zinkevich
-/
import measure_theory.measurable_space
import data.equiv.encodable.lattice

/-!
# Induction principles for measurable sets, related to π-systems and λ-systems.

## Main statements

* The main theorem of this file is Dynkin's π-λ theorem, which appears
  here as an induction principle `induction_on_inter`. Suppose `s` is a
  collection of subsets of `α` such that the intersection of two members
  of `s` belongs to `s` whenever it is nonempty. Let `m` be the σ-algebra
  generated by `s`. In order to check that a predicate `C` holds on every
  member of `m`, it suffices to check that `C` holds on the members of `s` and
  that `C` is preserved by complementation and *disjoint* countable
  unions.

* The proof of this theorem relies on the notion of `is_pi_system`, i.e., a collection of sets
  which is closed under binary non-empty intersections. Note that this is a small variation around
  the usual notion in the literature, which often requires that a π-system is non-empty, and closed
  also under disjoint intersections. This variation turns out to be convenient for the
  formalization.

* The proof of Dynkin's π-λ theorem also requires the notion of `dynkin_system`, i.e., a collection
  of sets which contains the empty set, is closed under complementation and under countable union
  of pairwise disjoint sets. The disjointness condition is the only difference with `σ`-algebras.

* `generate_pi_system g` gives the minimal π-system containing `g`.
  This can be considered a Galois insertion into both measurable spaces and sets.

* `generate_from_generate_pi_system_eq` proves that if you start from a collection of sets `g`,
  take the generated π-system, and then the generated σ-algebra, you get the same result as
  the σ-algebra generated from `g`. This is useful because there are connections between
  independent sets that are π-systems and the generated independent spaces.

* `mem_generate_pi_system_Union_elim` and `mem_generate_pi_system_Union_elim'` show that any
  element of the π-system generated from the union of a set of π-systems can be
  represented as the intersection of a finite number of elements from these sets.

## Implementation details

* `is_pi_system` is a predicate, not a type. Thus, we don't explicitly define the galois
  insertion, nor do we define a complete lattice. In theory, we could define a complete
  lattice and galois insertion on the subtype corresponding to `is_pi_system`.
-/

open measurable_space set
open_locale classical

/-- A π-system is a collection of subsets of `α` that is closed under binary intersection of
  non-disjoint sets. Usually it is also required that the collection is nonempty, but we don't do
  that here. -/
def is_pi_system {α} (C : set (set α)) : Prop :=
∀ s t ∈ C, (s ∩ t : set α).nonempty → s ∩ t ∈ C

namespace measurable_space

lemma is_pi_system_measurable_set {α:Type*} [measurable_space α] :
  is_pi_system {s : set α | measurable_set s} :=
λ s t hs ht _, hs.inter ht

end measurable_space

lemma is_pi_system.singleton {α} (S : set α) : is_pi_system ({S} : set (set α)) :=
begin
  intros s t h_s h_t h_ne,
  rw [set.mem_singleton_iff.1 h_s, set.mem_singleton_iff.1 h_t, set.inter_self,
      set.mem_singleton_iff],
end

/-- Given a collection `S` of subsets of `α`, then `generate_pi_system S` is the smallest
π-system containing `S`. -/
inductive generate_pi_system {α} (S : set (set α)) : set (set α)
| base {s : set α} (h_s : s ∈ S) : generate_pi_system s
| inter {s t : set α} (h_s : generate_pi_system s) (h_t : generate_pi_system t)
  (h_nonempty : (s ∩ t).nonempty) : generate_pi_system (s ∩ t)

lemma is_pi_system_generate_pi_system {α} (S : set (set α)) :
  is_pi_system (generate_pi_system S) :=
λ s t h_s h_t h_nonempty, generate_pi_system.inter h_s h_t h_nonempty

lemma subset_generate_pi_system_self {α} (S : set (set α)) : S ⊆ generate_pi_system S :=
λ s, generate_pi_system.base

lemma generate_pi_system_subset_self {α} {S : set (set α)} (h_S : is_pi_system S) :
  generate_pi_system S ⊆ S :=
begin
  intros x h,
  induction h with s h_s s u h_gen_s h_gen_u h_nonempty h_s h_u,
  { exact h_s, },
  { exact h_S _ _ h_s h_u h_nonempty, },
end

lemma generate_pi_system_eq {α} {S : set (set α)} (h_pi : is_pi_system S) :
  generate_pi_system S = S :=
set.subset.antisymm (generate_pi_system_subset_self h_pi) (subset_generate_pi_system_self S)

lemma generate_pi_system_mono {α} {S T : set (set α)} (hST : S ⊆ T) :
  generate_pi_system S ⊆ generate_pi_system T :=
begin
  intros t ht,
  induction ht with s h_s s u h_gen_s h_gen_u h_nonempty h_s h_u,
  { exact generate_pi_system.base (set.mem_of_subset_of_mem hST h_s),},
  { exact is_pi_system_generate_pi_system T _ _ h_s h_u h_nonempty, },
end

lemma generate_pi_system_measurable_set {α} [M : measurable_space α] {S : set (set α)}
  (h_meas_S : ∀ s ∈ S, measurable_set s) (t : set α)
  (h_in_pi : t ∈ generate_pi_system S) : measurable_set t :=
begin
  induction h_in_pi with s h_s s u h_gen_s h_gen_u h_nonempty h_s h_u,
  { apply h_meas_S _ h_s, },
  { apply measurable_set.inter h_s h_u, },
end

lemma generate_from_measurable_set_of_generate_pi_system {α} {g : set (set α)} (t : set α)
  (ht : t ∈ generate_pi_system g) :
  (generate_from g).measurable_set' t :=
@generate_pi_system_measurable_set α (generate_from g) g
  (λ s h_s_in_g, measurable_set_generate_from h_s_in_g) t ht

lemma generate_from_generate_pi_system_eq {α} {g : set (set α)} :
  generate_from (generate_pi_system g) = generate_from g :=
begin
  apply le_antisymm; apply generate_from_le,
  { exact λ t h_t, generate_from_measurable_set_of_generate_pi_system t h_t, },
  { exact λ t h_t, measurable_set_generate_from (generate_pi_system.base h_t), },
end

/- Every element of the π-system generated by the union of a family of π-systems
is a finite intersection of elements from the π-systems.
For an indexed union version, see `mem_generate_pi_system_Union_elim'`. -/
lemma mem_generate_pi_system_Union_elim {α β} {g : β → set (set α)}
  (h_pi : ∀ b, is_pi_system (g b)) (t : set α) (h_t : t ∈ generate_pi_system (⋃ b, g b)) :
  ∃ (T : finset β) (f : β → set α), (t = ⋂ b ∈ T, f b) ∧ (∀ b ∈ T, f b ∈ g b) :=
begin
  induction h_t with s h_s s t' h_gen_s h_gen_t' h_nonempty h_s h_t',
  { rcases h_s with ⟨t', ⟨⟨b, rfl⟩, h_s_in_t'⟩⟩,
    refine ⟨{b}, (λ _, s), _⟩,
    simpa using h_s_in_t', },
  { rcases h_t' with ⟨T_t', ⟨f_t', ⟨rfl, h_t'⟩⟩⟩,
    rcases h_s with ⟨T_s, ⟨f_s, ⟨rfl, h_s⟩ ⟩ ⟩,
    use [(T_s ∪ T_t'), (λ (b:β),
      if (b ∈ T_s) then (if (b ∈ T_t') then (f_s b ∩ (f_t' b)) else (f_s b))
      else (if (b ∈ T_t') then (f_t' b) else (∅ : set α)))],
    split,
    { ext a,
      simp_rw [set.mem_inter_iff, set.mem_Inter, finset.mem_union, or_imp_distrib],
      rw ← forall_and_distrib,
      split; intros h1 b; by_cases hbs : b ∈ T_s; by_cases hbt : b ∈ T_t'; specialize h1 b;
        simp only [hbs, hbt, if_true, if_false, true_implies_iff, and_self, false_implies_iff,
          and_true, true_and] at h1 ⊢,
      all_goals { exact h1, }, },
    intros b h_b,
    split_ifs with hbs hbt hbt,
    { refine h_pi b (f_s b) (f_t' b) (h_s b hbs) (h_t' b hbt) (set.nonempty.mono _ h_nonempty),
      exact set.inter_subset_inter (set.bInter_subset_of_mem hbs) (set.bInter_subset_of_mem hbt), },
    { exact h_s b hbs, },
    { exact h_t' b hbt, },
    { rw finset.mem_union at h_b,
      apply false.elim (h_b.elim hbs hbt), }, },
end

/- Every element of the π-system generated by an indexed union of a family of π-systems
is a finite intersection of elements from the π-systems.
For a total union version, see `mem_generate_pi_system_Union_elim`. -/
lemma mem_generate_pi_system_Union_elim' {α β} {g : β → set (set α)} {s: set β}
  (h_pi : ∀ b ∈ s, is_pi_system (g b)) (t : set α) (h_t : t ∈ generate_pi_system (⋃ b ∈ s, g b)) :
  ∃ (T : finset β) (f : β → set α), (↑T ⊆ s) ∧ (t = ⋂ b ∈ T, f b) ∧ (∀ b ∈ T, f b ∈ g b) :=
begin
  have : t ∈ generate_pi_system (⋃ (b : subtype s), (g ∘ subtype.val) b),
  { suffices h1 : (⋃ (b : subtype s), (g ∘ subtype.val) b) = (⋃ b (H : b ∈ s), g b), by rwa h1,
    ext x,
    simp only [exists_prop, set.mem_Union, function.comp_app, subtype.exists, subtype.coe_mk],
    refl },
  rcases @mem_generate_pi_system_Union_elim α (subtype s) (g ∘ subtype.val)
    (λ b, h_pi b.val b.property) t this with ⟨T, ⟨f,⟨ rfl, h_t'⟩⟩⟩,
  refine ⟨T.image subtype.val, function.extend subtype.val f (λ (b:β), (∅ : set α)), by simp, _, _⟩,
  { ext a, split;
    { simp only [set.mem_Inter, subtype.forall, finset.set_bInter_finset_image],
      intros h1 b h_b h_b_in_T,
      have h2 := h1 b h_b h_b_in_T,
      revert h2,
      rw function.extend_apply subtype.val_injective,
      apply id } },
  { intros b h_b,
    simp_rw [finset.mem_image, exists_prop, subtype.exists,
             exists_and_distrib_right, exists_eq_right] at h_b,
    cases h_b,
    have h_b_alt : b = (subtype.mk b h_b_w).val := rfl,
    rw [h_b_alt, function.extend_apply subtype.val_injective],
    apply h_t',
    apply h_b_h },
end

namespace measurable_space
variable {α : Type*}

/-- A Dynkin system is a collection of subsets of a type `α` that contains the empty set,
  is closed under complementation and under countable union of pairwise disjoint sets.
  The disjointness condition is the only difference with `σ`-algebras.

  The main purpose of Dynkin systems is to provide a powerful induction rule for σ-algebras
  generated by a collection of sets which is stable under intersection.

  A Dynkin system is also known as a "λ-system" or a "d-system".
-/
structure dynkin_system (α : Type*) :=
(has : set α → Prop)
(has_empty : has ∅)
(has_compl : ∀ {a}, has a → has aᶜ)
(has_Union_nat : ∀ {f : ℕ → set α}, pairwise (disjoint on f) → (∀ i, has (f i)) → has (⋃ i, f i))

namespace dynkin_system

@[ext] lemma ext : ∀ {d₁ d₂ : dynkin_system α}, (∀ s : set α, d₁.has s ↔ d₂.has s) → d₁ = d₂
| ⟨s₁, _, _, _⟩ ⟨s₂, _, _, _⟩ h := have s₁ = s₂, from funext $ assume x, propext $ h x,
  by subst this

variable (d : dynkin_system α)

lemma has_compl_iff {a} : d.has aᶜ ↔ d.has a :=
⟨λ h, by simpa using d.has_compl h, λ h, d.has_compl h⟩

lemma has_univ : d.has univ :=
by simpa using d.has_compl d.has_empty

theorem has_Union {β} [encodable β] {f : β → set α}
  (hd : pairwise (disjoint on f)) (h : ∀ i, d.has (f i)) : d.has (⋃ i, f i) :=
by { rw ← encodable.Union_decode2, exact
  d.has_Union_nat (encodable.Union_decode2_disjoint_on hd)
    (λ n, encodable.Union_decode2_cases d.has_empty h) }

theorem has_union {s₁ s₂ : set α}
  (h₁ : d.has s₁) (h₂ : d.has s₂) (h : s₁ ∩ s₂ ⊆ ∅) : d.has (s₁ ∪ s₂) :=
by { rw union_eq_Union, exact
  d.has_Union (pairwise_disjoint_on_bool.2 h) (bool.forall_bool.2 ⟨h₂, h₁⟩) }

lemma has_diff {s₁ s₂ : set α} (h₁ : d.has s₁) (h₂ : d.has s₂) (h : s₂ ⊆ s₁) : d.has (s₁ \ s₂) :=
begin
  apply d.has_compl_iff.1,
  simp [diff_eq, compl_inter],
  exact d.has_union (d.has_compl h₁) h₂ (λ x ⟨h₁, h₂⟩, h₁ (h h₂)),
end

instance : partial_order (dynkin_system α) :=
{ le          := λ m₁ m₂, m₁.has ≤ m₂.has,
  le_refl     := assume a b, le_refl _,
  le_trans    := assume a b c, le_trans,
  le_antisymm := assume a b h₁ h₂, ext $ assume s, ⟨h₁ s, h₂ s⟩ }

/-- Every measurable space (σ-algebra) forms a Dynkin system -/
def of_measurable_space (m : measurable_space α) : dynkin_system α :=
{ has       := m.measurable_set',
  has_empty := m.measurable_set_empty,
  has_compl := m.measurable_set_compl,
  has_Union_nat := assume f _ hf, m.measurable_set_Union f hf }

lemma of_measurable_space_le_of_measurable_space_iff {m₁ m₂ : measurable_space α} :
  of_measurable_space m₁ ≤ of_measurable_space m₂ ↔ m₁ ≤ m₂ :=
iff.rfl

/-- The least Dynkin system containing a collection of basic sets.
  This inductive type gives the underlying collection of sets. -/
inductive generate_has (s : set (set α)) : set α → Prop
| basic : ∀ t ∈ s, generate_has t
| empty : generate_has ∅
| compl : ∀ {a}, generate_has a → generate_has aᶜ
| Union : ∀ {f : ℕ → set α}, pairwise (disjoint on f) →
    (∀ i, generate_has (f i)) → generate_has (⋃ i, f i)

lemma generate_has_compl {C : set (set α)} {s : set α} : generate_has C sᶜ ↔ generate_has C s :=
by { refine ⟨_, generate_has.compl⟩, intro h, convert generate_has.compl h, simp }

/-- The least Dynkin system containing a collection of basic sets. -/
def generate (s : set (set α)) : dynkin_system α :=
{ has := generate_has s,
  has_empty := generate_has.empty,
  has_compl := assume a, generate_has.compl,
  has_Union_nat := assume f, generate_has.Union }

lemma generate_has_def {C : set (set α)} : (generate C).has = generate_has C := rfl

instance : inhabited (dynkin_system α) := ⟨generate univ⟩

/-- If a Dynkin system is closed under binary intersection, then it forms a `σ`-algebra. -/
def to_measurable_space (h_inter : ∀ s₁ s₂, d.has s₁ → d.has s₂ → d.has (s₁ ∩ s₂)) :=
{ measurable_space .
  measurable_set'      := d.has,
  measurable_set_empty := d.has_empty,
  measurable_set_compl := assume s h, d.has_compl h,
  measurable_set_Union := assume f hf,
    have ∀ n, d.has (disjointed f n),
      from assume n, disjointed_induct (hf n)
        (assume t i h, h_inter _ _ h $ d.has_compl $ hf i),
    have d.has (⋃ n, disjointed f n), from d.has_Union disjoint_disjointed this,
    by rwa [Union_disjointed] at this }

lemma of_measurable_space_to_measurable_space
  (h_inter : ∀ s₁ s₂, d.has s₁ → d.has s₂ → d.has (s₁ ∩ s₂)) :
  of_measurable_space (d.to_measurable_space h_inter) = d :=
ext $ assume s, iff.rfl

/-- If `s` is in a Dynkin system `d`, we can form the new Dynkin system `{s ∩ t | t ∈ d}`. -/
def restrict_on {s : set α} (h : d.has s) : dynkin_system α :=
{ has       := λ t, d.has (t ∩ s),
  has_empty := by simp [d.has_empty],
  has_compl := assume t hts,
    have tᶜ ∩ s = ((t ∩ s)ᶜ) \ sᶜ,
      from set.ext $ assume x, by { by_cases x ∈ s; simp [h] },
    by { rw [this], exact d.has_diff (d.has_compl hts) (d.has_compl h)
      (compl_subset_compl.mpr $ inter_subset_right _ _) },
  has_Union_nat := assume f hd hf,
    begin
      rw [inter_comm, inter_Union],
      apply d.has_Union_nat,
      { exact λ i j h x ⟨⟨_, h₁⟩, _, h₂⟩, hd i j h ⟨h₁, h₂⟩ },
      { simpa [inter_comm] using hf },
    end }

lemma generate_le {s : set (set α)} (h : ∀ t ∈ s, d.has t) : generate s ≤ d :=
λ t ht, ht.rec_on h d.has_empty
  (assume a _ h, d.has_compl h)
  (assume f hd _ hf, d.has_Union hd hf)

lemma generate_has_subset_generate_measurable {C : set (set α)} {s : set α}
  (hs : (generate C).has s) : (generate_from C).measurable_set' s :=
generate_le (of_measurable_space (generate_from C)) (λ t, measurable_set_generate_from) s hs

lemma generate_inter {s : set (set α)}
  (hs : is_pi_system s) {t₁ t₂ : set α}
  (ht₁ : (generate s).has t₁) (ht₂ : (generate s).has t₂) : (generate s).has (t₁ ∩ t₂) :=
have generate s ≤ (generate s).restrict_on ht₂,
  from generate_le _ $ assume s₁ hs₁,
  have (generate s).has s₁, from generate_has.basic s₁ hs₁,
  have generate s ≤ (generate s).restrict_on this,
    from generate_le _ $ assume s₂ hs₂,
      show (generate s).has (s₂ ∩ s₁), from
        (s₂ ∩ s₁).eq_empty_or_nonempty.elim
        (λ h,  h.symm ▸ generate_has.empty)
        (λ h, generate_has.basic _ (hs _ _ hs₂ hs₁ h)),
  have (generate s).has (t₂ ∩ s₁), from this _ ht₂,
  show (generate s).has (s₁ ∩ t₂), by rwa [inter_comm],
this _ ht₁

/--
  Given a collection of sets closed under binary intersections, then the Dynkin system it
  generates is equal to the σ-algebra it generates.
  This result is known as the π-λ theorem.
  A collection of sets closed under binary intersection is called a π-system (often requiring
  additionnally that is is non-empty, but we drop this condition in the formalization).
-/
lemma generate_from_eq {s : set (set α)} (hs : is_pi_system s) :
  generate_from s = (generate s).to_measurable_space (λ t₁ t₂, generate_inter hs) :=
le_antisymm
  (generate_from_le $ assume t ht, generate_has.basic t ht)
  (of_measurable_space_le_of_measurable_space_iff.mp $
    by { rw [of_measurable_space_to_measurable_space],
    exact (generate_le _ $ assume t ht, measurable_set_generate_from ht) })

end dynkin_system

theorem induction_on_inter {C : set α → Prop} {s : set (set α)} [m : measurable_space α]
  (h_eq : m = generate_from s) (h_inter : is_pi_system s)
  (h_empty : C ∅) (h_basic : ∀ t ∈ s, C t) (h_compl : ∀ t, measurable_set t → C t → C tᶜ)
  (h_union : ∀ f : ℕ → set α, pairwise (disjoint on f) →
    (∀ i, measurable_set (f i)) → (∀ i, C (f i)) → C (⋃ i, f i)) :
  ∀ ⦃t⦄, measurable_set t → C t :=
have eq : measurable_set = dynkin_system.generate_has s,
  by { rw [h_eq, dynkin_system.generate_from_eq h_inter], refl },
assume t ht,
have dynkin_system.generate_has s t, by rwa [eq] at ht,
this.rec_on h_basic h_empty
  (assume t ht, h_compl t $ by { rw [eq], exact ht })
  (assume f hf ht, h_union f hf $ assume i, by { rw [eq], exact ht _ })

end measurable_space


/-
  Induced map from Spec(B) to Spec(A).

  https://stacks.math.columbia.edu/tag/00E2
-/

import topology.basic
import ring_theory.ideal_operations
import spectrum_of_a_ring.zariski_topology

open lattice

universes u v

variables {α : Type u} {β : Type v} [comm_ring α] [comm_ring β]
variables (f : α → β) [is_ring_hom f]

-- Given φ : A → B, we have Spec(φ) : Spec(B) → Spec(A), 𝔭′⟼φ⁻¹(𝔭′).

def Zariski.induced : Spec β → Spec α :=
λ x, ⟨ideal.comap f x.1, @ideal.is_prime.comap _ _ _ _ f _ x.1 x.2⟩

-- This induced map is continuous.

lemma Zariski.induced.continuous : continuous (Zariski.induced f) :=
begin
  rintros U ⟨E, HE⟩,
  use [f '' E],
  apply set.ext,
  rintros ⟨I, PI⟩,
  split,
  { intros HI HC,
    suffices HfI : Zariski.induced f ⟨I, PI⟩ ∈ Spec.V E,
      rw HE at HfI,
      apply HfI,
      exact HC,
    intros x Hx,
    simp [Zariski.induced] at *,
    have HfE : f '' E ⊆ I := HI,
    have Hfx : f x ∈ f '' E := set.mem_image_of_mem f Hx,
    exact (HfE Hfx), },
  { rintros HI x ⟨y, ⟨Hy, Hfy⟩⟩,
    suffices HfI : Zariski.induced f ⟨I, PI⟩ ∈ Spec.V E,
      rw ←Hfy,
      exact (HfI Hy),
    intros z Hz,
    simp [Zariski.induced] at *,
    replace HI : _ ∈ -U := HI,
    rw ←HE at HI,
    exact (HI Hz), }
end

theorem Zariski.induced.preimage_D (x : α)
: Zariski.induced f ⁻¹' (Spec.D' x) = Spec.D' (f x) :=
set.ext $ λ ⟨P, HP⟩,
by simp [Spec.D', Spec.V', Zariski.induced]


-- Razonamiento ecuacional sobre la inversa de listas unitarias
-- ============================================================

import data.list.basic
open list

variable  {α : Type*}
variable  x : α
variables (xs : list α)

-- ----------------------------------------------------
-- Ejercicio 1. Definir, por recursión, la función
--    inversa :: list α → list α
-- tal que (inversa xs) es la lista obtenida
-- invirtiendo el orden de los elementos de xs.
-- Por ejemplo,
--    inversa [3,2,5] = [5,2,3]
-- ----------------------------------------------------

def inversa : list α → list α
| []        := []
| (x :: xs) := inversa xs ++ [x]

-- #eval inversa [3,2,5]

-- ----------------------------------------------------
-- Ejercicio 2. Demostrar los siguientes lemas
-- + inversa_nil :
--     inversa ([] : list α) = []
-- + inversa_cons :
--     inversa (x :: xs) = inversa xs ++ [x]
-- ----------------------------------------------------

@[simp]
lemma inversa_nil :
  inversa ([] : list α) = [] :=
rfl

@[simp]
lemma inversa_cons :
  inversa (x :: xs) = inversa xs ++ [x] :=
rfl

-- ----------------------------------------------------
-- Ejercicio 3. (p. 9) Demostrar que
--    inversa [x] = [x]
-- ----------------------------------------------------

-- 1ª demostración
example : inversa [x] = [x] :=
calc inversa [x]
         = inversa ([] : list α) ++ [x] : by rw inversa_cons
     ... = ([] : list α) ++ [x]         : by rw inversa_nil
     ... = [x]                          : by rw nil_append

-- 2ª demostración
example : inversa [x] = [x] :=
calc inversa [x]
         = inversa ([] : list α) ++ [x] : by simp
     ... = ([] : list α) ++ [x]         : by simp
     ... = [x]                          : by simp

-- 3ª demostración
example : inversa [x] = [x] :=
by simp

-- 4ª demostración
example : inversa [x] = [x] :=
begin
  rw inversa_cons,
  rw inversa_nil,
  rw nil_append,
end

-- 5ª demostración
example : inversa [x] = [x] :=
by rw [inversa_cons,
       inversa_nil,
       nil_append]

-- 6ª demostración
example : inversa [x] = [x] :=
rfl

-- Comentarios sobre la función reverse:
-- + Es equivalente a la función inversa
-- + Para usarla hay que importar la librería
--   data.list.basic y abrir el espacio de nombre
--   list escribiendo al principio del fichero
--      import data.list.basic
--      open list
-- + Se puede evaluar. Por ejemplo,
--      #eval reverse  [3,2,5]
-- + Se puede demostrar. Por ejemplo,
--      example : reverse [x] = [x] :=
--      -- by library_search
--      reverse_singleton x


import tactic
import topology.basic
import topology.subset_properties
/-
Prove connectedness theorems in topology, basic goal to aim for is that if connected spaces share a point, the union is connected. More advanced is goal is closed intervals of the real line are connected.
-/

--use top theorems
open set function topological_space relation
open_locale classical topological_space

-- some vars we can work with
universes u v
variables {α : Type u} [topological_space α] {s t u v : set α}

/- definition of connectivity we use (from mathlibs def of is_preconnected),-/
def connected (s : set α) : Prop :=
∀ (u v : set α), is_open u → is_open v → s ⊆ u ∪ v → (s ∩ u).nonempty → (s ∩ v).nonempty → (s ∩ (u ∩ v)).nonempty

--a theorem I found from other sources to be a nice precursor for other connectivity theorems.
-- if for each point in a set, we can find a connected set contain both that point and a given fixed point (x), then the whole set must be connected.
--Most of the proof as I wrote it is unwrapping definitions
theorem fixedpoint_connected_is_connected {s : set α} (x : α)
  (H : ∀ y ∈ s, ∃ t ⊆ s, x ∈ t ∧ y ∈ t ∧ connected t) :
  connected s :=
begin
 -- Decompose hypothesis to extract sets we can work with
  intros u v hu hv hs hy hz,
  cases hy with y hy,
  cases hy with ys yv,
  cases hz with z hz,
  cases hz with zs zv,
  have xs : x ∈ s, {
    cases H y ys with t h,
    cases h with ts h,
    cases h with xt h,
    cases h with yt con_t,
    exact ts xt,
  },
  --wlog gets around the fact that we would otherwise have to do cases on u,v, but they are identical.
  wlog xu : x ∈ u := hs xs using [u v z y, v u y z],
  specialize H z zs,
  rcases H with ⟨t, ts, xt, zt, ht⟩,
  --use connectivity of t to finish
  specialize ht u v,
  specialize ht hu hv,
  specialize ht (subset.trans ts hs),
  -- x proves t ∩ u nonempty, z proves t ∩ v nonempty
  have h1 : x ∈ t ∩ u, {
  split,
  exact xt,
  exact xu,
  },
  have h2 : (t ∩ u).nonempty, {
    use x,
    exact h1,
  },
   specialize ht h2,
  have h3 : z ∈ t ∩ v, {
    split,
    exact zt,
    exact zv,
  },
  have h4 : (t ∩ v).nonempty, {
    use z,
    exact h3,
  },
  specialize ht h4,
  cases ht with e ht_e,
  cases ht_e with et euv,
  use e,
  split,
  exact ts et,
  exact euv,
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import tactic.abel
import data.polynomial.eval

/-!
# The Pochhammer polynomials

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

We define and prove some basic relations about
`pochhammer S n : S[X] := X * (X + 1) * ... * (X + n - 1)`
which is also known as the rising factorial. A version of this definition
that is focused on `nat` can be found in `data.nat.factorial` as `nat.asc_factorial`.

## Implementation

As with many other families of polynomials, even though the coefficients are always in `ℕ`,
we define the polynomial with coefficients in any `[semiring S]`.

## TODO

There is lots more in this direction:
* q-factorials, q-binomials, q-Pochhammer.
-/

universes u v

open polynomial
open_locale polynomial

section semiring
variables (S : Type u) [semiring S]

/--
`pochhammer S n` is the polynomial `X * (X+1) * ... * (X + n - 1)`,
with coefficients in the semiring `S`.
-/
noncomputable def pochhammer : ℕ → S[X]
| 0 := 1
| (n+1) := X * (pochhammer n).comp (X + 1)

@[simp] lemma pochhammer_zero : pochhammer S 0 = 1 := rfl
@[simp] lemma pochhammer_one : pochhammer S 1 = X := by simp [pochhammer]

lemma pochhammer_succ_left (n : ℕ) : pochhammer S (n+1) = X * (pochhammer S n).comp (X+1) :=
by rw pochhammer

section
variables {S} {T : Type v} [semiring T]
@[simp] lemma pochhammer_map (f : S →+* T) (n : ℕ) : (pochhammer S n).map f = pochhammer T n :=
begin
  induction n with n ih,
  { simp, },
  { simp [ih, pochhammer_succ_left, map_comp], },
end

end

@[simp, norm_cast] lemma pochhammer_eval_cast (n k : ℕ) :
  ((pochhammer ℕ n).eval k : S) = (pochhammer S n).eval k :=
begin
  rw [←pochhammer_map (algebra_map ℕ S), eval_map, ←eq_nat_cast (algebra_map ℕ S),
    eval₂_at_nat_cast, nat.cast_id, eq_nat_cast],
end

lemma pochhammer_eval_zero {n : ℕ} : (pochhammer S n).eval 0 = if n = 0 then 1 else 0 :=
begin
  cases n,
  { simp, },
  { simp [X_mul, nat.succ_ne_zero, pochhammer_succ_left], }
end

lemma pochhammer_zero_eval_zero : (pochhammer S 0).eval 0 = 1 :=
by simp

@[simp] lemma pochhammer_ne_zero_eval_zero {n : ℕ} (h : n ≠ 0) : (pochhammer S n).eval 0 = 0 :=
by simp [pochhammer_eval_zero, h]

lemma pochhammer_succ_right (n : ℕ) : pochhammer S (n+1) = pochhammer S n * (X + n) :=
begin
  suffices h : pochhammer ℕ (n+1) = pochhammer ℕ n * (X + n),
  { apply_fun polynomial.map (algebra_map ℕ S) at h,
    simpa only [pochhammer_map, polynomial.map_mul, polynomial.map_add,
                map_X, polynomial.map_nat_cast] using h },
  induction n with n ih,
  { simp, },
  { conv_lhs
  { rw [pochhammer_succ_left, ih, mul_comp, ←mul_assoc, ←pochhammer_succ_left, add_comp, X_comp,
      nat_cast_comp, add_assoc, add_comm (1 : ℕ[X]), ← nat.cast_succ] } },
end

lemma pochhammer_succ_eval {S : Type*} [semiring S] (n : ℕ) (k : S) :
  (pochhammer S (n + 1)).eval k = (pochhammer S n).eval k * (k + n) :=
by rw [pochhammer_succ_right, mul_add, eval_add, eval_mul_X, ← nat.cast_comm, ← C_eq_nat_cast,
    eval_C_mul, nat.cast_comm, ← mul_add]

lemma pochhammer_succ_comp_X_add_one (n : ℕ) :
  (pochhammer S (n + 1)).comp (X + 1) =
    pochhammer S (n + 1) + (n + 1) • (pochhammer S n).comp (X + 1) :=
begin
  suffices : (pochhammer ℕ (n + 1)).comp (X + 1) =
              pochhammer ℕ (n + 1) + (n + 1) * (pochhammer ℕ n).comp (X + 1),
  { simpa [map_comp] using congr_arg (polynomial.map (nat.cast_ring_hom S)) this },
  nth_rewrite 1 pochhammer_succ_left,
  rw [← add_mul, pochhammer_succ_right ℕ n, mul_comp, mul_comm, add_comp, X_comp,
      nat_cast_comp, add_comm ↑n, ← add_assoc]
end

lemma polynomial.mul_X_add_nat_cast_comp {p q : S[X]} {n : ℕ} :
  (p * (X + n)).comp q = (p.comp q) * (q + n) :=
by rw [mul_add, add_comp, mul_X_comp, ←nat.cast_comm, nat_cast_mul_comp, nat.cast_comm, mul_add]

lemma pochhammer_mul (n m : ℕ) :
  pochhammer S n * (pochhammer S m).comp (X + n) = pochhammer S (n + m) :=
begin
  induction m with m ih,
  { simp, },
  { rw [pochhammer_succ_right, polynomial.mul_X_add_nat_cast_comp, ←mul_assoc, ih,
      nat.succ_eq_add_one, ←add_assoc, pochhammer_succ_right, nat.cast_add, add_assoc], }
end

lemma pochhammer_nat_eq_asc_factorial (n : ℕ) :
  ∀ k, (pochhammer ℕ k).eval (n + 1) = n.asc_factorial k
| 0 := by erw [eval_one]; refl
| (t + 1) := begin
  rw [pochhammer_succ_right, eval_mul, pochhammer_nat_eq_asc_factorial t],
  suffices : n.asc_factorial t * (n + 1 + t) = n.asc_factorial (t + 1), by simpa,
  rw [nat.asc_factorial_succ, add_right_comm, mul_comm]
end

lemma pochhammer_nat_eq_desc_factorial (a b : ℕ) :
  (pochhammer ℕ b).eval a = (a + b - 1).desc_factorial b :=
begin
  cases b,
  { rw [nat.desc_factorial_zero, pochhammer_zero, polynomial.eval_one] },
  rw [nat.add_succ, nat.succ_sub_succ, tsub_zero],
  cases a,
  { rw [pochhammer_ne_zero_eval_zero _ b.succ_ne_zero, zero_add,
    nat.desc_factorial_of_lt b.lt_succ_self] },
  { rw [nat.succ_add, ←nat.add_succ, nat.add_desc_factorial_eq_asc_factorial,
      pochhammer_nat_eq_asc_factorial] }
end

end semiring

section strict_ordered_semiring
variables {S : Type*} [strict_ordered_semiring S]

lemma pochhammer_pos (n : ℕ) (s : S) (h : 0 < s) : 0 < (pochhammer S n).eval s :=
begin
  induction n with n ih,
  { simp only [nat.nat_zero_eq_zero, pochhammer_zero, eval_one], exact zero_lt_one, },
  { rw [pochhammer_succ_right, mul_add, eval_add, ←nat.cast_comm, eval_nat_cast_mul, eval_mul_X,
      nat.cast_comm, ←mul_add],
    exact mul_pos ih
      (lt_of_lt_of_le h ((le_add_iff_nonneg_right _).mpr (nat.cast_nonneg n))), }
end

end strict_ordered_semiring

section factorial

open_locale nat

variables (S : Type*) [semiring S] (r n : ℕ)

@[simp]
lemma pochhammer_eval_one (S : Type*) [semiring S] (n : ℕ) :
  (pochhammer S n).eval (1 : S) = (n! : S) :=
by rw_mod_cast [pochhammer_nat_eq_asc_factorial, nat.zero_asc_factorial]

lemma factorial_mul_pochhammer (S : Type*) [semiring S] (r n : ℕ) :
  (r! : S) * (pochhammer S n).eval (r + 1) = (r + n)! :=
by rw_mod_cast [pochhammer_nat_eq_asc_factorial, nat.factorial_mul_asc_factorial]

lemma pochhammer_nat_eval_succ (r : ℕ) :
  ∀ n : ℕ, n * (pochhammer ℕ r).eval (n + 1) = (n + r) * (pochhammer ℕ r).eval n
| 0 := begin
  by_cases h : r = 0,
  { simp only [h, zero_mul, zero_add], },
  { simp only [pochhammer_eval_zero, zero_mul, if_neg h, mul_zero], }
end
| (k + 1) := by simp only [pochhammer_nat_eq_asc_factorial, nat.succ_asc_factorial, add_right_comm]

lemma pochhammer_eval_succ (r n : ℕ) :
  (n : S) * (pochhammer S r).eval (n + 1 : S) = (n + r) * (pochhammer S r).eval n :=
by exact_mod_cast congr_arg nat.cast (pochhammer_nat_eval_succ r n)

end factorial


local attribute [instance] decidable_inhabited prop_decidable

inductive xnat
| zero : xnat
| succ : xnat → xnat
open xnat
definition one := succ zero
definition two := succ one
definition add :xnat → xnat → xnat
| n zero := n
| n (succ p) := succ (add n p)
notation a + b := add a b
theorem one_add_one_equals_two : one + one = two :=
    begin
    unfold two,
    unfold one,
    unfold add,
    end
theorem add_zerox (n:xnat): n+zero=n:=
    begin
    unfold add,
    end
theorem zero_addx (n:xnat):zero+n=n:=
    begin
    induction n with k H,
    unfold add,
    unfold add,
    rw[H],
    end
theorem add_assocx (a b c:xnat):(a+b)+c=a+(b+c):=
    begin
    induction c with k H,
    unfold add,
    unfold add,
    rw[H],
    end
theorem zero_add_eq_ad_zerox (n:xnat) : zero+n=n+zero:=
    begin
    rw[zero_addx,add_zerox],
    end
theorem add_one_eq_succx (n:xnat) : n + one = succ n:=
    begin
    unfold one add,
    end
theorem one_add_eq_succx (n : xnat) : one+n=succ n:=
    begin
    induction n with k H,
    unfold one add,
    unfold one add,
    rw[←H],
    unfold one,
    end
theorem add_commx (a b:xnat) : a+b = b+a:=
    begin
    induction b with k H,
    rw[zero_add_eq_ad_zerox],
    unfold add,
    rw[H,←add_one_eq_succx,←add_one_eq_succx,add_assocx,add_assocx,add_one_eq_succx,one_add_eq_succx],
    end
theorem eq_iff_succ_eq_succ (a b : xnat) : succ a = succ b ↔ a = b :=
    begin
    split,
    exact succ.inj,
    assume H : a = b,
    rw [H],
    end
theorem add_cancel_right (a b t : xnat) :  a = b ↔ a+t = b+t :=
    begin
    split,
    assume H,
    rw[H],
    induction t with k H,
    rw[add_zerox,add_zerox],
    assume H1,
    exact H1,
    unfold add,
    rw[eq_iff_succ_eq_succ (a+k) (b+k)],
    exact H,
    end
definition mul:xnat→xnat→xnat
| n zero:=zero
| n (succ p):= mul n p + n
notation a * b := mul a b
theorem mul_zerox (a : xnat) : a * zero = zero :=
    begin
    trivial,
    end
theorem zero_mulx (a : xnat) : zero * a = zero :=
    begin
    induction a with k H,
    unfold mul,
    unfold mul add,
    rw[H],
    end
theorem mul_onex (a : xnat) : a * one = a :=
    begin
    unfold one mul,
    rw[zero_addx],
    end
theorem one_mulx (a : xnat) : one * a = a :=
    begin
    induction a with k H,
    unfold mul,
    unfold mul,
    rw[add_one_eq_succx, H],
    end
theorem right_distribx (a b c : xnat) : a * (b + c) = a* b + a * c :=
    begin
    induction c with k H,
    rw[mul_zerox,add_zerox,add_zerox],
    unfold add mul,
    rw[H, add_assocx],
    end
theorem left_distribx (a b c : xnat) : (a + b) * c = a * c + b * c :=
    begin
    induction c with n Hn,
    unfold mul,
    refl,
    rw [←add_one_eq_succx,right_distribx,Hn,right_distribx,right_distribx],
    rw [mul_onex,mul_onex,mul_onex],
    rw [add_assocx,←add_assocx (b*n),add_commx (b*n),←add_assocx,←add_assocx,←add_assocx],
    end
theorem mul_assocx (a b c : xnat) : (a * b) * c = a * (b * c) :=
    begin
    induction c with k H,
    rw[mul_zerox,mul_zerox,mul_zerox],
    unfold mul,
    rw[right_distribx,H]
    end
theorem mul_commx (a b : xnat) : a * b = b * a :=
    begin
    induction b with k H,
    rw[mul_zerox,zero_mulx],
    unfold mul,
    rw[H],
    exact calc k * a + a = k * a + one * a: by rw[one_mulx]
    ...=(k + one) * a: by rw[left_distribx]
    ...=succ k * a: by rw[add_one_eq_succx],
    end
definition lt : xnat → xnat → Prop
    | zero zero := false
    | (succ m) zero := false
    | zero (succ p) := true
    | (succ m) (succ p) := lt m p

notation a < b := lt a b
theorem subtraction (a b:xnat) (Hab:a<b): ∃(c:xnat), succ c+a=b:=begin
    revert a,
    induction b with b1 Hib,
    assume a1 H1,exfalso,revert H1,
    cases a1 with a2,
        unfold lt,trivial,

        unfold lt,trivial,

    assume a1,
        cases a1 with a2,
            assume H1,existsi b1,unfold add,

            unfold lt,
            have H1:∀d:xnat,succ d+a2=b1→∃c,succ c+succ a2=succ b1:=begin
                unfold add,assume d H1,existsi d,
                rw H1,
            end,
            assume H2,
            exact exists.elim (Hib a2 H2) H1,
end
theorem not_lt_itself (x:xnat):¬x<x:=begin
    induction x with k H,
    unfold lt, assume H,trivial,
    unfold lt, exact H,
end
theorem inequality_A1 (a b t : xnat) : a < b ↔ a + t < b + t :=
    begin
    apply iff.intro,
    induction t with k H,
    rw[add_zerox,add_zerox],
    assume H1,exact H1,
    unfold add,unfold lt,exact H,
    induction t with n H,
    rw[add_zerox,add_zerox],
    assume H1,
    exact H1,
    unfold add lt, exact H,
    end
    theorem inequality_A2 (a b c:xnat):a<b→b<c→a<c:=begin
    revert a b,
    induction c with c1 Hic,
        assume a b,
        cases b with b1,
            unfold lt,assume H,trivial,

            unfold lt,assume H,trivial,

        assume a b,
        cases a with a1,
            unfold lt,assume H1 H2,trivial,

            cases b with b1,
                unfold lt,trivial,

                unfold lt,exact Hic a1 b1,
end
theorem inequality_A3 (g b : xnat) : (g < b ∨ g = b ∨ b < g) ∧ (g < b → ¬ (g = b))  ∧ (g < b → ¬ (b < g))∧ ((g = b) → ¬ (b < g)):=begin
    apply and.intro,
    tactic.swap,
    apply and.intro,
    have H1:∀c,succ c+g=b→¬g=b:=begin
        assume c H1,
        rw ←H1,
        have H4:¬zero=succ c:=begin assume H, have H1:zero<zero:= by cc,revert H1,unfold lt, trivial, end,
        revert H4,
        rw[add_cancel_right],tactic.swap,exact g,
        rw zero_addx,assume H3,assumption,
    end,
    assume H2,
    exact exists.elim (subtraction g b H2) H1,
    apply and.intro,
    tactic.swap,
    assume H1, rw H1, exact not_lt_itself b,
    assume H1,
    have H2:∀c,succ c+g=b→¬b < g:=begin
        assume c1 H2,rw ←H2,
        have H3:¬succ c1 < zero:=begin
            unfold lt,assume H3,assumption,
        end,assume H4,revert H3,rw[inequality_A1 (succ c1) zero g,zero_addx],
        assume H5,exact H5 H4,
    end,
    exact exists.elim (subtraction g b H1) H2,

    have H1:∀ x y:xnat, ¬x<y→¬y<x→x=y:=begin
        assume x y H1 H2,revert y,
        induction x with x1 H,
        assume y1 H1 H2,clear H2,
        cases y1 with y1,
        trivial,
        exfalso, have H2:zero<succ y1:= by unfold lt, exact H1 H2,
        assume y1,
        cases y1 with y1,
        assume H1 H2,exfalso,have H3:zero<succ x1:=by unfold lt,
        exact H2 H3,
        unfold lt,rw eq_iff_succ_eq_succ,
        exact H y1,
    end,
    rw [or.comm,or.assoc],
    have H2:¬g < b → ¬b < g → g = b:=H1 g b,clear H1,
    cases classical.em (g<b) with A B,
    right,right,assumption,
    have H:¬b < g → g = b:= H2 B,clear H2 B,
    cases classical.em (b<g) with A B,
    right,left,assumption,left, exact H B,
end
theorem inequality_A4 (g b : xnat) : zero<g → zero<b → zero<g*b :=begin
    cases g with g1,
    assume H1,exfalso,revert H1, unfold lt,trivial,
    cases b with b1,
    assume H1 H2,exfalso,revert H2, unfold lt,trivial,
    assume H1 H2,
    rw[←one_add_eq_succx,←one_add_eq_succx, right_distribx, left_distribx,left_distribx],
    have H3:one*one=one:=begin unfold one,unfold mul,rw zero_addx, end,
    rw[H3, add_assocx, one_add_eq_succx],unfold lt,
end


/-
What I present in M40001 is in some sense the mathematics
of true-false statements.
-/
import tactic

open bool

/-
#print notation ∧
#print and
-- This is one idea of a proposition.
-- ff and tt are the only two terms of type `bool`
-- functions band, bor, bnot
#check ff ∧ tt
#eval band ff tt
#eval tt
-/
example : ∀ p q r : bool,
  p && (q || r) = (p && q) || (p && r)
:=
begin
  intros,
  cases p;
  cases q;
  cases r;
  refl
end

#find bool → bool → bool
-- afterwards change an and to an or,
-- note that it breaks.

/-
Very boring proofs.

But there is always something very weird about
the definition of →. Should it really be the case
that we say "p implies q" if p is completely
irrelevant to the proof of q?
But there is actually a much more profound definition
of a Proposition. A Proposition in Lean is a type `P`,
where `P : Prop`.

You can make pretty much all of the material in
the pure part of Imperial's undergraduate degree
in Lean now, because of its maths library `mathlib`.
Many Imperial students have contributed to
mathlib, but it's now getting harder for beginners
to help out.

This definition looks intimidating
but it is not. A term `p : P` (that is,
a term `p` of type `P`)
is a proof of `P`. In this model of the idea of a
proposition, implication `P ⇒ Q` is a function,
which takes as input a proof of `P` and outputs a
proof of `Q`. In other words, a function
which takes as input a term of type `P` and outputs
a term of type `Q`. In other words, it's
a function `P → Q` between the types `P` and `Q`.

Important thing: any two proofs of `P` are equal.
If `p : P` and `q : P` then `p = q`. This model
of the word "proposition" cannot distinguish
between proofs. Internally a proof knows how
much work it was to construct though.
-/

/-
Let's do some constructive logic.
Let's play with the idea of `P → Q`.
-/

namespace xena

variables (P Q R : Prop)

/-- The theorem that P ⇒ P -/
theorem id : P → P :=
begin
  -- `⊢ X` on the right means "you've got to prove X"
  -- so we've got to prove P → P
  -- assume that `P` is true.
  -- call this hypotheis `hP`
  intro hP,
  -- now we've got to prove `P`
  exact hP,
  -- we never mentioned `P`
  -- we just talked about hypotheses
end

example : P → (Q → P) :=
begin
  intro hP,
  intro hQ,
  exact hP
end
-- then remove bracket at the top

lemma modus_ponens : P → (P → Q) → Q :=
begin
  intro hP,
  intro hPQ,
  apply hPQ, clear hPQ,
  exact hP,
end

-- `a<b` and `b<c` implies `a<c`
-- `a>b` and `b>c` implies `a>c`.

lemma trans : (P → Q) → (Q → R) → (P → R) :=
begin
  intros hPQ hQR hP,
  apply hQR,
  apply hPQ,
  exact hP
end

lemma trans' : (P → Q) → (Q → R) → (P → R) :=
λ hPQ hQR hP, hQR $ hPQ hP

example : (P → Q → R) → (P → Q) → (P → R) :=
begin
  intro hPQR,
  intro hPQ,
  intro hP,
  apply hPQR,
    exact hP,
  exact hPQ(hP),
end
-- todo -- search for why I don't get multicoloured tada

example : (P → Q → R) → (P → Q) → (P → R) :=
begin
  cc,-- "congruence closure"
end

-- `not P`, with notation `¬ P`, is
-- *DEFINED TO MEAN* `P → false`

example : P → ¬ (¬ P) :=
begin
  intro hP,
  change (¬ P) → false,
  intro hnP,
  change P → false at hnP,
  apply hnP,
  exact hP,
end

lemma imp_not_not : P → ¬ (¬ P) :=
begin
  change P → (P → false) → false,
  apply modus_ponens
end

example : (P → Q) → (¬ Q → ¬ P) :=
begin
  -- cc kills it
  intro hPQ,
  intro hnQ,
  intro hP,
  change Q → false at hnQ,-- only change uses P,Q
  apply hnQ,
  apply hPQ,
  exact hP,

end

#print axioms imp_not_not

lemma not_not : ¬ (¬ P) → P :=
begin
  intro hnnP,
  change (P → false) → false at hnnP,
  finish,
end

#print axioms not_not

end xena


-- ---------------------------------------------------------------------
-- Ejercicio. Sea f una función de ℝ en ℝ. Demostrar que si f no tiene
-- cota superior, entonces para cada a existe un x tal que f(x) > a.
-- ----------------------------------------------------------------------

import data.real.basic

def fn_ub (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a
def fn_has_ub (f : ℝ → ℝ) := ∃ a, fn_ub f a

open_locale classical

variable (f : ℝ → ℝ)

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

example
  (h : ¬ fn_has_ub f)
  : ∀ a, ∃ x, f x > a :=
begin
  intro a,
  by_contradiction h1,
  apply h,
  use a,
  intro x,
  apply le_of_not_gt,
  intro h2,
  apply h1,
  use x,
  exact h2,
end

-- Prueba
-- ======

/-
f : ℝ → ℝ,
h : ¬fn_has_ub f
⊢ ∀ (a : ℝ), ∃ (x : ℝ), f x > a
  >> intro a,
a : ℝ
⊢ ∃ (x : ℝ), f x > a
  >> by_contradiction h1,
h1 : ¬∃ (x : ℝ), f x > a
⊢ false
  >> apply h,
⊢ fn_has_ub f
  >> use a,
⊢ fn_ub f a
  >> intro x,
x : ℝ
⊢ f x ≤ a
  >> apply le_of_not_gt,
⊢ ¬f x > a
  >> intro h2,
h2 : f x > a
⊢ false
  >> apply h1,
⊢ ∃ (x : ℝ), f x > a
  >> use x,
⊢ f x > a
  >> exact h2,
no goals
-/

-- 2ª demostración
example
  (h : ¬ fn_has_ub f) :
  ∀ a, ∃ x, f x > a :=
begin
  contrapose! h,
  exact h,
end

-- Prueba
-- ======

/-
f : ℝ → ℝ,
h : ¬fn_has_ub f
⊢ ∀ (a : ℝ), ∃ (x : ℝ), f x > a
  >> contrapose! h,
h : ∃ (a : ℝ), ∀ (x : ℝ), f x ≤ a
⊢ fn_has_ub f
  >> exact h,
no goals
-/

-- Comentario: La táctica (contrapose! h) aplica el contrapositivo entre
-- la hipótesis h y el objetivo; es decir, si (h : P) y el objetivo es Q
-- entonces cambia la hipótesis a (h : ¬Q) el objetivo a ¬P aplicando
-- simplificaciones en ambos.


namespace hidden

def divides (m n : ℕ) : Prop := ∃ k, m * k = n

instance : has_dvd nat := ⟨divides⟩

def even (n : ℕ) : Prop := 2 ∣ n

section user_def
def pow : ℕ → ℕ → ℕ-- [¬ (m = 0 ∧ n = 0)]
| 0 0 := sorry
| _ 0 := 1
| m (nat.succ n) := m * pow m n
end user_def

-- BEGIN
def prime (n : ℕ) : Prop :=
n > 1 ∧ (∀ m : ℕ, 1 < m ∧ m < n → ¬ divides n m)

def infinitely_many_primes : Prop :=
∀ n : ℕ, prime n → ∃ m : ℕ, m > n ∧ prime m

def Fermat_prime (n : ℕ) : Prop :=
∃ m : ℕ, n = pow 2 (pow 2 m) + 1

def infinitely_many_Fermat_primes : Prop :=
∀ n : ℕ, Fermat_prime n → ∃ m : ℕ, m > n ∧ Fermat_prime m

def goldbach_conjecture : Prop :=
∀ n : ℕ, even n ∧ n > 2 → ∃ p1 p2 : ℕ, prime p1 ∧ prime p2 ∧ n = p1 + p2

def Goldbach's_weak_conjecture : Prop :=
∀ n : ℕ, ¬ even n ∧ n > 5 → ∃ p1 p2 p3 : ℕ, prime p1 ∧ prime p2 ∧ prime p3 ∧ n = p1 + p2 + p3

def Fermat's_last_theorem : Prop :=
∀ n : ℕ, n > 2 → ¬ ∃ a b c : ℕ, pow a n + pow b n = pow c n
-- END

end hidden

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

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

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

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

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

end

section
example (x : ℤ) : x * 0 = 0 :=
calc x * 0
        = x * (x - x) : by rw [sub_self]
    ... = x * x - x * x : by rw [mul_sub]
    ... = 0 : by rw [sub_self]
end


import Proofs.Isomorphism

universe u

-- And

structure Pair (a b : Type u) where
  proj₁ : a
  proj₂ : b

infixl:65   " ×´ " => Pair
notation:max "⟨" e "," f "⟩´" => Pair.mk e f

example : Int ×´ Int := ⟨2, 3⟩´

theorem Pair.comm : (a ×´ b) ≅ (b ×´ a) :=
  { To   := λ⟨a, b⟩´ => ⟨b, a⟩´
  , From := λ⟨b, a⟩´ => ⟨a, b⟩´
  , FromTo := λx => rfl
  , ToFrom := λx => rfl }

theorem Pair.eta : ∀ {m n : Type}, (v : m ×´ n) → ⟨Pair.proj₁ v, Pair.proj₂ v⟩´ = v
  | _, _, _ => rfl

-- Bottom and Top types

inductive T : Type
  | t : T

inductive F : Type

notation:65 "⊤" => T
notation:65 "⊥" => F

notation:66 "¬" e "´" => (e → F)

theorem T.idₗ : ∀ {a : Type}, (⊤ ×´ a) ≅ a
  := { To     := λ⟨a, b⟩´ => b
     , From   := λb       => ⟨T.t, b⟩´
     , FromTo := λx => rfl
     , ToFrom := λx => rfl  }

theorem F.elim (h : ⊥) : a := F.rec (fun _ => a) h

theorem Not.elim (e : a) (h : ¬a´) : ⊥ := h e

def Imp.contraposition : ∀ {a b : Type}, (a → b) → (¬b´ → ¬a´)
  | _, _, f, nb, na => nb (f na)

notation:60 a "≢" b => ¬(a = b)

example : 2 ≢ 3 := λx => nomatch x

-- Or

inductive Prod' (a: Type) (b: Type) : Type
  | inj₁ : a → Prod' a b
  | inj₂ : b → Prod' a b

infixl:65 " ⊎ " => Prod'

def Prod'.case : ∀ {a b c : Type}, (a → c) → (b → c) → a ⊎ b → c
  | _, _, _, h1, h2, Prod'.inj₁ a => h1 a
  | _, _, _, h1, h2, Prod'.inj₂ b => h2 b

theorem Prod'.comm : ∀ {a b : Type}, a ⊎ b ≅ b ⊎ a
  | a, b => { To     := Prod'.case Prod'.inj₂ Prod'.inj₁,
              From   := Prod'.case Prod'.inj₂ Prod'.inj₁
              FromTo := fun | Prod'.inj₁ a => rfl
                            | Prod'.inj₂ b => rfl,
              ToFrom := fun | Prod'.inj₁ a => rfl
                            | Prod'.inj₂ b => rfl,
            }


/-
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_numbertheory_412
  (x y : ℕ)
  (h₀ : x % 19 = 4)
  (h₁ : y % 19 = 7) :
  ((x + 1)^2 * (y + 5)^3) % 19 = 13 :=
begin
  norm_num [h₀, h₁, nat.mul_mod, nat.add_mod, pow_succ],
end


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.finset.fold
import data.multiset.gcd

/-!
# GCD and LCM operations on finsets

## Main definitions

- `finset.gcd` - the greatest common denominator of a `finset` of elements of a `gcd_monoid`
- `finset.lcm` - the least common multiple of a `finset` of elements of a `gcd_monoid`

## Implementation notes

Many of the proofs use the lemmas `gcd.def` and `lcm.def`, which relate `finset.gcd`
and `finset.lcm` to `multiset.gcd` and `multiset.lcm`.

TODO: simplify with a tactic and `data.finset.lattice`

## Tags

finset, gcd
-/

variables {α β γ : Type*}

namespace finset
open multiset

variables [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]

/-! ### lcm -/
section lcm

/-- Least common multiple of a finite set -/
def lcm (s : finset β) (f : β → α) : α := s.fold gcd_monoid.lcm 1 f

variables {s s₁ s₂ : finset β} {f : β → α}

lemma lcm_def : s.lcm f = (s.1.map f).lcm := rfl

@[simp] lemma lcm_empty : (∅ : finset β).lcm f = 1 :=
fold_empty

@[simp] lemma lcm_dvd_iff {a : α} : s.lcm f ∣ a ↔ (∀b ∈ s, f b ∣ a) :=
begin
  apply iff.trans multiset.lcm_dvd,
  simp only [multiset.mem_map, and_imp, exists_imp_distrib],
  exact ⟨λ k b hb, k _ _ hb rfl, λ k a' b hb h, h ▸ k _ hb⟩,
end

lemma lcm_dvd {a : α} : (∀b ∈ s, f b ∣ a) → s.lcm f ∣ a :=
lcm_dvd_iff.2

lemma dvd_lcm {b : β} (hb : b ∈ s) : f b ∣ s.lcm f :=
lcm_dvd_iff.1 (dvd_refl _) _ hb

@[simp] lemma lcm_insert [decidable_eq β] {b : β} :
  (insert b s : finset β).lcm f = gcd_monoid.lcm (f b) (s.lcm f) :=
begin
  by_cases h : b ∈ s,
  { rw [insert_eq_of_mem h,
        (lcm_eq_right_iff (f b) (s.lcm f) (multiset.normalize_lcm (s.1.map f))).2 (dvd_lcm h)] },
  apply fold_insert h,
end

@[simp] lemma lcm_singleton {b : β} : ({b} : finset β).lcm f = normalize (f b) :=
multiset.lcm_singleton

@[simp] lemma normalize_lcm : normalize (s.lcm f) = s.lcm f := by simp [lcm_def]

lemma lcm_union [decidable_eq β] : (s₁ ∪ s₂).lcm f = gcd_monoid.lcm (s₁.lcm f) (s₂.lcm f) :=
finset.induction_on s₁ (by rw [empty_union, lcm_empty, lcm_one_left, normalize_lcm]) $ λ a s has ih,
  by rw [insert_union, lcm_insert, lcm_insert, ih, lcm_assoc]

theorem lcm_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀a ∈ s₂, f a = g a) :
  s₁.lcm f = s₂.lcm g :=
by { subst hs, exact finset.fold_congr hfg }

lemma lcm_mono_fun {g : β → α} (h : ∀ b ∈ s, f b ∣ g b) : s.lcm f ∣ s.lcm g :=
lcm_dvd (λ b hb, dvd_trans (h b hb) (dvd_lcm hb))

lemma lcm_mono (h : s₁ ⊆ s₂) : s₁.lcm f ∣ s₂.lcm f :=
lcm_dvd $ assume b hb, dvd_lcm (h hb)

end lcm

/-! ### gcd -/
section gcd

/-- Greatest common divisor of a finite set -/
def gcd (s : finset β) (f : β → α) : α := s.fold gcd_monoid.gcd 0 f

variables {s s₁ s₂ : finset β} {f : β → α}

lemma gcd_def : s.gcd f = (s.1.map f).gcd := rfl

@[simp] lemma gcd_empty : (∅ : finset β).gcd f = 0 :=
fold_empty

lemma dvd_gcd_iff {a : α} : a ∣ s.gcd f ↔ ∀b ∈ s, a ∣ f b :=
begin
  apply iff.trans multiset.dvd_gcd,
  simp only [multiset.mem_map, and_imp, exists_imp_distrib],
  exact ⟨λ k b hb, k _ _ hb rfl, λ k a' b hb h, h ▸ k _ hb⟩,
end

lemma gcd_dvd {b : β} (hb : b ∈ s) : s.gcd f ∣ f b :=
dvd_gcd_iff.1 (dvd_refl _) _ hb

lemma dvd_gcd {a : α} : (∀b ∈ s, a ∣ f b) → a ∣ s.gcd f :=
dvd_gcd_iff.2

@[simp] lemma gcd_insert [decidable_eq β] {b : β} :
  (insert b s : finset β).gcd f = gcd_monoid.gcd (f b) (s.gcd f) :=
begin
  by_cases h : b ∈ s,
  { rw [insert_eq_of_mem h,
    (gcd_eq_right_iff (f b) (s.gcd f) (multiset.normalize_gcd (s.1.map f))).2 (gcd_dvd h)] ,},
  apply fold_insert h,
end

@[simp] lemma gcd_singleton {b : β} : ({b} : finset β).gcd f = normalize (f b) :=
multiset.gcd_singleton

@[simp] lemma normalize_gcd : normalize (s.gcd f) = s.gcd f := by simp [gcd_def]

lemma gcd_union [decidable_eq β] : (s₁ ∪ s₂).gcd f = gcd_monoid.gcd (s₁.gcd f) (s₂.gcd f) :=
finset.induction_on s₁ (by rw [empty_union, gcd_empty, gcd_zero_left, normalize_gcd]) $
  λ a s has ih, by rw [insert_union, gcd_insert, gcd_insert, ih, gcd_assoc]

theorem gcd_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀a ∈ s₂, f a = g a) :
  s₁.gcd f = s₂.gcd g :=
by { subst hs, exact finset.fold_congr hfg }

lemma gcd_mono_fun {g : β → α} (h : ∀ b ∈ s, f b ∣ g b) : s.gcd f ∣ s.gcd g :=
dvd_gcd (λ b hb, dvd_trans (gcd_dvd hb) (h b hb))

lemma gcd_mono (h : s₁ ⊆ s₂) : s₂.gcd f ∣ s₁.gcd f :=
dvd_gcd $ assume b hb, gcd_dvd (h hb)

theorem gcd_eq_zero_iff : s.gcd f = 0 ↔ ∀ (x : β), x ∈ s → f x = 0 :=
begin
  rw [gcd_def, multiset.gcd_eq_zero_iff],
  split; intro h,
  { intros b bs,
    apply h (f b),
    simp only [multiset.mem_map, mem_def.1 bs],
    use b,
    simp [mem_def.1 bs] },
  { intros a as,
    rw multiset.mem_map at as,
    rcases as with ⟨b, ⟨bs, rfl⟩⟩,
    apply h b (mem_def.1 bs) }
end

lemma gcd_eq_gcd_filter_ne_zero [decidable_pred (λ (x : β), f x = 0)] :
  s.gcd f = (s.filter (λ x, f x ≠ 0)).gcd f :=
begin
  classical,
  transitivity ((s.filter (λ x, f x = 0)) ∪ (s.filter (λ x, f x ≠ 0))).gcd f,
  { rw filter_union_filter_neg_eq },
  rw gcd_union,
  transitivity gcd_monoid.gcd (0 : α) _,
  { refine congr (congr rfl _) rfl,
    apply s.induction_on, { simp },
    intros a s has h,
    rw filter_insert,
    split_ifs with h1; simp [h, h1], },
  simp [gcd_zero_left, normalize_gcd],
end

lemma gcd_mul_left {a : α} : s.gcd (λ x, a * f x) = normalize a * s.gcd f :=
begin
  classical,
  apply s.induction_on,
  { simp },
  intros b t hbt h,
  rw [gcd_insert, gcd_insert, h, ← gcd_mul_left],
  apply gcd_eq_of_associated_right,
  apply associated_mul_mul _ (associated.refl _),
  apply normalize_associated,
end

lemma gcd_mul_right {a : α} : s.gcd (λ x, f x * a) = s.gcd f * normalize a :=
begin
  classical,
  apply s.induction_on,
  { simp },
  intros b t hbt h,
  rw [gcd_insert, gcd_insert, h, ← gcd_mul_right],
  apply gcd_eq_of_associated_right,
  apply associated_mul_mul (associated.refl _),
  apply normalize_associated,
end

end gcd
end finset

namespace finset
section integral_domain

variables [nontrivial β] [integral_domain α] [gcd_monoid α]

lemma gcd_eq_of_dvd_sub {s : finset β} {f g : β → α} {a : α}
  (h : ∀ x : β, x ∈ s → a ∣ f x - g x) :
  gcd_monoid.gcd a (s.gcd f) = gcd_monoid.gcd a (s.gcd g) :=
begin
  classical,
  revert h,
  apply s.induction_on,
  { simp },
  intros b s bs hi h,
  rw [gcd_insert, gcd_insert, gcd_comm (f b), ← gcd_assoc, hi (λ x hx, h _ (mem_insert_of_mem hx)),
      gcd_comm a, gcd_assoc, gcd_comm a (gcd_monoid.gcd _ _),
      gcd_comm (g b), gcd_assoc _ _ a, gcd_comm _ a],
  refine congr rfl _,
  apply gcd_eq_of_dvd_sub_right (h _ (mem_insert_self _ _)),
end

end integral_domain

end finset


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import algebra.order.absolute_value
import topology.uniform_space.basic

/-!
# Uniform structure induced by an absolute value

We build a uniform space structure on a commutative ring `R` equipped with an absolute value into
a linear ordered field `𝕜`. Of course in the case `R` is `ℚ`, `ℝ` or `ℂ` and
`𝕜 = ℝ`, we get the same thing as the metric space construction, and the general construction
follows exactly the same path.

## Implementation details

Note that we import `data.real.cau_seq` because this is where absolute values are defined, but
the current file does not depend on real numbers. TODO: extract absolute values from that
`data.real` folder.

## References

* [N. Bourbaki, *Topologie générale*][bourbaki1966]

## Tags

absolute value, uniform spaces
-/

open set function filter uniform_space
open_locale filter

namespace is_absolute_value
variables {𝕜 : Type*} [linear_ordered_field 𝕜]
variables {R : Type*} [comm_ring R] (abv : R → 𝕜) [is_absolute_value abv]

/-- The uniformity coming from an absolute value. -/
def uniform_space_core : uniform_space.core R :=
{ uniformity := (⨅ ε>0, 𝓟 {p:R×R | abv (p.2 - p.1) < ε}),
  refl := le_infi $ assume ε, le_infi $ assume ε_pos, principal_mono.2
    (λ ⟨x, y⟩ h, by simpa [show x = y, from h, abv_zero abv]),
  symm := tendsto_infi.2 $ assume ε, tendsto_infi.2 $ assume h,
    tendsto_infi' ε $ tendsto_infi' h $ tendsto_principal_principal.2 $ λ ⟨x, y⟩ h,
      have h : abv (y - x) < ε, by simpa [-sub_eq_add_neg] using h,
      by rwa abv_sub abv at h,
  comp := le_infi $ assume ε, le_infi $ assume h, lift'_le
    (mem_infi_of_mem (ε / 2) $ mem_infi_of_mem (div_pos h zero_lt_two) (subset.refl _)) $
    have ∀ (a b c : R), abv (c-a) < ε / 2 → abv (b-c) < ε / 2 → abv (b-a) < ε,
      from assume a b c hac hcb,
       calc abv (b - a) ≤ _ : abv_sub_le abv b c a
        ... = abv (c - a) + abv (b - c) : add_comm _ _
        ... < ε / 2 + ε / 2 : add_lt_add hac hcb
        ... = ε : by rw [div_add_div_same, add_self_div_two],
    by simpa [comp_rel] }

/-- The uniform structure coming from an absolute value. -/
def uniform_space : uniform_space R :=
uniform_space.of_core (uniform_space_core abv)

theorem mem_uniformity {s : set (R×R)} :
  s ∈ (uniform_space_core abv).uniformity ↔
  (∃ε>0, ∀{a b:R}, abv (b - a) < ε → (a, b) ∈ s) :=
begin
  suffices : s ∈ (⨅ ε: {ε : 𝕜 // ε > 0}, 𝓟 {p:R×R | abv (p.2 - p.1) < ε.val}) ↔ _,
  { rw infi_subtype at this,
    exact this },
  rw mem_infi_of_directed,
  { simp [subset_def] },
  { rintros ⟨r, hr⟩ ⟨p, hp⟩,
    exact ⟨⟨min r p, lt_min hr hp⟩, by simp [lt_min_iff, (≥)] {contextual := tt}⟩, },
end

end is_absolute_value


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import ring_theory.matrix_algebra
import data.polynomial.algebra_map
import data.matrix.basis
import data.matrix.dmatrix

/-!
# Algebra isomorphism between matrices of polynomials and polynomials of matrices

Given `[comm_ring R] [ring A] [algebra R A]`
we show `A[X] ≃ₐ[R] (A ⊗[R] R[X])`.
Combining this with the isomorphism `matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R)` proved earlier
in `ring_theory.matrix_algebra`, we obtain the algebra isomorphism
```
def mat_poly_equiv :
  matrix n n R[X] ≃ₐ[R] (matrix n n R)[X]
```
which is characterized by
```
coeff (mat_poly_equiv m) k i j = coeff (m i j) k
```

We will use this algebra isomorphism to prove the Cayley-Hamilton theorem.
-/

universes u v w

open_locale polynomial tensor_product

open polynomial
open tensor_product
open algebra.tensor_product (alg_hom_of_linear_map_tensor_product include_left)

noncomputable theory

variables (R A : Type*)
variables [comm_semiring R]
variables [semiring A] [algebra R A]

namespace poly_equiv_tensor

/--
(Implementation detail).
The function underlying `A ⊗[R] R[X] →ₐ[R] A[X]`,
as a bilinear function of two arguments.
-/
@[simps apply_apply]
def to_fun_bilinear : A →ₗ[A] R[X] →ₗ[R] A[X] :=
linear_map.to_span_singleton A _ (aeval (polynomial.X : A[X])).to_linear_map

lemma to_fun_bilinear_apply_eq_sum (a : A) (p : R[X]) :
  to_fun_bilinear R A a p = p.sum (λ n r, monomial n (a * algebra_map R A r)) :=
begin
  simp only [to_fun_bilinear_apply_apply, aeval_def, eval₂_eq_sum, polynomial.sum, finset.smul_sum],
  congr' with i : 1,
  rw [← algebra.smul_def, ←C_mul', mul_smul_comm, C_mul_X_pow_eq_monomial, ←algebra.commutes,
      ← algebra.smul_def, smul_monomial],
end

/--
(Implementation detail).
The function underlying `A ⊗[R] R[X] →ₐ[R] A[X]`,
as a linear map.
-/
def to_fun_linear : A ⊗[R] R[X] →ₗ[R] A[X] :=
tensor_product.lift (to_fun_bilinear R A)

@[simp]
lemma to_fun_linear_tmul_apply (a : A) (p : R[X]) :
  to_fun_linear R A (a ⊗ₜ[R] p) = to_fun_bilinear R A a p := rfl

-- We apparently need to provide the decidable instance here
-- in order to successfully rewrite by this lemma.
lemma to_fun_linear_mul_tmul_mul_aux_1
  (p : R[X]) (k : ℕ) (h : decidable (¬p.coeff k = 0)) (a : A) :
  ite (¬coeff p k = 0) (a * (algebra_map R A) (coeff p k)) 0 = a * (algebra_map R A) (coeff p k) :=
by { classical, split_ifs; simp *, }

lemma to_fun_linear_mul_tmul_mul_aux_2 (k : ℕ) (a₁ a₂ : A) (p₁ p₂ : R[X]) :
  a₁ * a₂ * (algebra_map R A) ((p₁ * p₂).coeff k) =
    (finset.nat.antidiagonal k).sum
      (λ x, a₁ * (algebra_map R A) (coeff p₁ x.1) * (a₂ * (algebra_map R A) (coeff p₂ x.2))) :=
begin
  simp_rw [mul_assoc, algebra.commutes, ←finset.mul_sum, mul_assoc, ←finset.mul_sum],
  congr,
  simp_rw [algebra.commutes (coeff p₂ _), coeff_mul, ring_hom.map_sum, ring_hom.map_mul],
end

lemma to_fun_linear_mul_tmul_mul (a₁ a₂ : A) (p₁ p₂ : R[X]) :
  (to_fun_linear R A) ((a₁ * a₂) ⊗ₜ[R] (p₁ * p₂)) =
    (to_fun_linear R A) (a₁ ⊗ₜ[R] p₁) * (to_fun_linear R A) (a₂ ⊗ₜ[R] p₂) :=
begin
  classical,
  simp only [to_fun_linear_tmul_apply, to_fun_bilinear_apply_eq_sum],
  ext k,
  simp_rw [coeff_sum, coeff_monomial, sum_def, finset.sum_ite_eq', mem_support_iff, ne.def],
  conv_rhs { rw [coeff_mul] },
  simp_rw [finset_sum_coeff, coeff_monomial,
    finset.sum_ite_eq', mem_support_iff, ne.def,
    mul_ite, mul_zero, ite_mul, zero_mul],
  simp_rw [ite_mul_zero_left (¬coeff p₁ _ = 0) (a₁ * (algebra_map R A) (coeff p₁ _))],
  simp_rw [ite_mul_zero_right (¬coeff p₂ _ = 0) _ (_ * _)],
  simp_rw [to_fun_linear_mul_tmul_mul_aux_1, to_fun_linear_mul_tmul_mul_aux_2],
end

lemma to_fun_linear_algebra_map_tmul_one (r : R) :
  (to_fun_linear R A) ((algebra_map R A) r ⊗ₜ[R] 1) = (algebra_map R A[X]) r :=
by rw [to_fun_linear_tmul_apply, to_fun_bilinear_apply_apply, polynomial.aeval_one,
  algebra_map_smul, algebra.algebra_map_eq_smul_one]

/--
(Implementation detail).
The algebra homomorphism `A ⊗[R] R[X] →ₐ[R] A[X]`.
-/
def to_fun_alg_hom : A ⊗[R] R[X] →ₐ[R] A[X] :=
alg_hom_of_linear_map_tensor_product
  (to_fun_linear R A)
  (to_fun_linear_mul_tmul_mul R A)
  (to_fun_linear_algebra_map_tmul_one R A)

@[simp] lemma to_fun_alg_hom_apply_tmul (a : A) (p : R[X]) :
  to_fun_alg_hom R A (a ⊗ₜ[R] p) = p.sum (λ n r, monomial n (a * (algebra_map R A) r)) :=
to_fun_bilinear_apply_eq_sum R A _ _

/--
(Implementation detail.)

The bare function `A[X] → A ⊗[R] R[X]`.
(We don't need to show that it's an algebra map, thankfully --- just that it's an inverse.)
-/
def inv_fun (p : A[X]) : A ⊗[R] R[X] :=
p.eval₂
  (include_left : A →ₐ[R] A ⊗[R] R[X])
  ((1 : A) ⊗ₜ[R] (X : R[X]))

@[simp]
lemma inv_fun_add {p q} : inv_fun R A (p + q) = inv_fun R A p + inv_fun R A q :=
by simp only [inv_fun, eval₂_add]

lemma inv_fun_monomial (n : ℕ) (a : A) :
  inv_fun R A (monomial n a) = include_left a * ((1 : A) ⊗ₜ[R] (X : R[X])) ^ n :=
eval₂_monomial _ _

lemma left_inv (x : A ⊗ R[X]) :
  inv_fun R A ((to_fun_alg_hom R A) x) = x :=
begin
  apply tensor_product.induction_on x,
  { simp [inv_fun], },
  { intros a p, dsimp only [inv_fun],
    rw [to_fun_alg_hom_apply_tmul, eval₂_sum],
    simp_rw [eval₂_monomial, alg_hom.coe_to_ring_hom, algebra.tensor_product.tmul_pow, one_pow,
      algebra.tensor_product.include_left_apply, algebra.tensor_product.tmul_mul_tmul,
      mul_one, one_mul, ←algebra.commutes, ←algebra.smul_def, smul_tmul, sum_def, ←tmul_sum],
    conv_rhs { rw [←sum_C_mul_X_pow_eq p], },
    simp only [algebra.smul_def],
    refl, },
  { intros p q hp hq,
    simp only [alg_hom.map_add, inv_fun_add, hp, hq], },
end

lemma right_inv (x : A[X]) :
  (to_fun_alg_hom R A) (inv_fun R A x) = x :=
begin
  apply polynomial.induction_on' x,
  { intros p q hp hq, simp only [inv_fun_add, alg_hom.map_add, hp, hq], },
  { intros n a,
    rw [inv_fun_monomial, algebra.tensor_product.include_left_apply,
      algebra.tensor_product.tmul_pow, one_pow, algebra.tensor_product.tmul_mul_tmul,
      mul_one, one_mul, to_fun_alg_hom_apply_tmul, X_pow_eq_monomial, sum_monomial_index];
    simp, }
end

/--
(Implementation detail)

The equivalence, ignoring the algebra structure, `(A ⊗[R] R[X]) ≃ A[X]`.
-/
def equiv : (A ⊗[R] R[X]) ≃ A[X] :=
{ to_fun := to_fun_alg_hom R A,
  inv_fun := inv_fun R A,
  left_inv := left_inv R A,
  right_inv := right_inv R A, }

end poly_equiv_tensor

open poly_equiv_tensor

/--
The `R`-algebra isomorphism `A[X] ≃ₐ[R] (A ⊗[R] R[X])`.
-/
def poly_equiv_tensor : A[X] ≃ₐ[R] (A ⊗[R] R[X]) :=
alg_equiv.symm
{ ..(poly_equiv_tensor.to_fun_alg_hom R A), ..(poly_equiv_tensor.equiv R A) }

@[simp]
lemma poly_equiv_tensor_apply (p : A[X]) :
  poly_equiv_tensor R A p =
    p.eval₂ (include_left : A →ₐ[R] A ⊗[R] R[X]) ((1 : A) ⊗ₜ[R] (X : R[X])) :=
rfl

@[simp]
lemma poly_equiv_tensor_symm_apply_tmul (a : A) (p : R[X]) :
  (poly_equiv_tensor R A).symm (a ⊗ₜ p) = p.sum (λ n r, monomial n (a * algebra_map R A r)) :=
to_fun_alg_hom_apply_tmul _ _ _ _

open dmatrix matrix
open_locale big_operators

variables {R}
variables {n : Type w} [decidable_eq n] [fintype n]

/--
The algebra isomorphism stating "matrices of polynomials are the same as polynomials of matrices".

(You probably shouldn't attempt to use this underlying definition ---
it's an algebra equivalence, and characterised extensionally by the lemma
`mat_poly_equiv_coeff_apply` below.)
-/
noncomputable def mat_poly_equiv :
  matrix n n R[X] ≃ₐ[R] (matrix n n R)[X] :=
(((matrix_equiv_tensor R R[X] n)).trans
  (algebra.tensor_product.comm R _ _)).trans
  (poly_equiv_tensor R (matrix n n R)).symm

open finset

lemma mat_poly_equiv_coeff_apply_aux_1 (i j : n) (k : ℕ) (x : R) :
  mat_poly_equiv (std_basis_matrix i j $ monomial k x) =
    monomial k (std_basis_matrix i j x) :=
begin
  simp only [mat_poly_equiv, alg_equiv.trans_apply,
    matrix_equiv_tensor_apply_std_basis],
  apply (poly_equiv_tensor R (matrix n n R)).injective,
  simp only [alg_equiv.apply_symm_apply],
  convert algebra.tensor_product.comm_tmul _ _ _ _ _,
  simp only [poly_equiv_tensor_apply],
  convert eval₂_monomial _ _,
  simp only [algebra.tensor_product.tmul_mul_tmul, one_pow, one_mul, matrix.mul_one,
    algebra.tensor_product.tmul_pow, algebra.tensor_product.include_left_apply, mul_eq_mul],
  rw [← smul_X_eq_monomial, ← tensor_product.smul_tmul],
  congr' with i' j'; simp
end

lemma mat_poly_equiv_coeff_apply_aux_2
  (i j : n) (p : R[X]) (k : ℕ) :
  coeff (mat_poly_equiv (std_basis_matrix i j p)) k =
    std_basis_matrix i j (coeff p k) :=
begin
  apply polynomial.induction_on' p,
  { intros p q hp hq, ext,
    simp [hp, hq, coeff_add, add_apply, std_basis_matrix_add], },
  { intros k x,
    simp only [mat_poly_equiv_coeff_apply_aux_1, coeff_monomial],
    split_ifs; { funext, simp, }, }
end

@[simp] lemma mat_poly_equiv_coeff_apply
  (m : matrix n n R[X]) (k : ℕ) (i j : n) :
  coeff (mat_poly_equiv m) k i j = coeff (m i j) k :=
begin
  apply matrix.induction_on' m,
  { simp, },
  { intros p q hp hq, simp [hp, hq], },
  { intros i' j' x,
    erw mat_poly_equiv_coeff_apply_aux_2,
    dsimp [std_basis_matrix],
    split_ifs,
    { rcases h with ⟨rfl, rfl⟩, simp [std_basis_matrix], },
    { simp [std_basis_matrix, h], }, },
end

@[simp] lemma mat_poly_equiv_symm_apply_coeff
  (p : (matrix n n R)[X]) (i j : n) (k : ℕ) :
  coeff (mat_poly_equiv.symm p i j) k = coeff p k i j :=
begin
  have t : p = mat_poly_equiv
    (mat_poly_equiv.symm p) := by simp,
  conv_rhs { rw t, },
  simp only [mat_poly_equiv_coeff_apply],
end

lemma mat_poly_equiv_smul_one (p : R[X]) :
  mat_poly_equiv (p • 1) = p.map (algebra_map R (matrix n n R)) :=
begin
  ext m i j,
  simp only [coeff_map, one_apply, algebra_map_matrix_apply, mul_boole,
    pi.smul_apply, mat_poly_equiv_coeff_apply],
  split_ifs; simp,
end

lemma support_subset_support_mat_poly_equiv
  (m : matrix n n R[X]) (i j : n) :
  support (m i j) ⊆ support (mat_poly_equiv m) :=
begin
  assume k,
  contrapose,
  simp only [not_mem_support_iff],
  assume hk,
  rw [← mat_poly_equiv_coeff_apply, hk],
  refl
end


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers

/-!

# Doing algebra in the real numbers

The `ring` tactic will prove algebraic identities like
(x + y) ^ 2 = x ^ 2 + 2 * x * y + y ^ 2 in rings, and Lean
knows that the real numbers are a ring. See if you can use
`ring` to prove these theorems.

## New tactics you will need

* `ring`
* `intro` (new functionality: use on a goal of type `⊢ ∀ x, ...`)

-/

example (x y : ℝ) : (x + y) ^ 2  = x ^ 2 + 2 * x * y + y ^ 2 :=
begin
  ring,
end

example : ∀ (a b : ℝ), ∃ x,
  (a + b) ^ 3 = a ^ 3 + x * a ^ 2 * b + 3 * a * b ^ 2 + b ^ 3 :=
begin
  intros a b,
  use 3,
  ring,
end

example : ∃ (x : ℝ), ∀ y, y + y = x * y :=
begin
  use 2,
  intro y,
  ring,
end

example : ∀ (x : ℝ), ∃ y, x + y = 2 :=
begin
  intro x,
  use 2 - x,
  norm_num,
  -- ring, -- also does the job
end

example : ∀ (x : ℝ), ∃ y, x + y ≠ 2 :=
begin
  intro x,
  use 1 - x,
  norm_num,
end


-- Prueba de la reflexividad de la inclusión de conjuntos
-- ======================================================

-- ----------------------------------------------------
-- Ej. 1. Demostrar
--    A ⊆ A
-- ----------------------------------------------------

import data.set
variable  U : Type
variable  x : U
variables A B C : set U

-- #reduce x ∈ A
-- #reduce B ⊆ C

-- 1ª demostración
example : A ⊆ A :=
begin
  intros x h,
  exact h,
end

-- 2ª demostración
example : A ⊆ A :=
assume x,
assume h : x ∈ A,
show x ∈ A, from h

-- 3ª demostración
example : A ⊆ A :=
assume x,
assume h : x ∈ A,
h

-- 4ª demostración
example : A ⊆ A :=
assume x,
λ h : x ∈ A, h

-- 5ª demostración
example : A ⊆ A :=
assume x,
id

-- 6ª demostración
example : A ⊆ A :=
λ x, id

-- 7ª demostración
example : A ⊆ A :=
-- by library_search
set.subset.rfl

open set

-- 8ª demostración
example : A ⊆ A :=
subset.rfl

-- 9ª demostración
example : A ⊆ A :=
-- by hint
by tauto

-- 10ª demostración
example : A ⊆ A :=
by finish

-- 11ª demostración
example : A ⊆ A :=
by refl


import data.int.basic

namespace utils

open int nat list

lemma gt_both_of_mult {m n : ℕ} (h : m * n > 0) : m > 0 ∧ n > 0 :=
and.intro
  begin
    cases m,
      {rw zero_mul at h, cases h},
      {apply nat.zero_lt_succ}
  end
  begin
    cases n,
      {cases h},
      {apply nat.zero_lt_succ}
  end

lemma gt_mult_of_both {m n : ℕ} (h : m > 0) (h₁ : n > 0) : m * n > 0 :=
begin
  suffices h₂ : 0 * n < m * n,
    rw zero_mul at h₂, exact h₂,
  apply mul_lt_mul_of_pos_right; assumption
end

lemma lt_of_coe_lt_gt_zero {x : ℤ} {y : ℕ} (h : y > 0) : x < x + ↑y :=
begin
  apply lt_add_of_pos_right,
  simp [(>)] at *,
  exact h
end

lemma lt_of_add {m n k : ℕ} (h : m + n < k) : m < k :=
begin
  induction n with n ih,
    {exact h},
    {
      apply ih,
      rw [add_comm, nat.succ_add] at h,
      have h : n + m < k,
        from nat.lt_of_succ_lt h,
      rw add_comm,
      exact h
    }
end

lemma nat_le_dest : ∀ {n m : ℕ}, n < m → ∃ k, nat.succ n + k = m
  | n ._ (less_than_or_equal.refl ._)  := ⟨0, rfl⟩
  | n ._ (@less_than_or_equal.step ._ m h) :=
    match le.dest h with
      | ⟨w, hw⟩ := ⟨succ w, hw ▸ rfl⟩
    end

lemma zip_nil_right {α β : Type} {l : list α} : zip l ([] : list β) = [] :=
  by cases l; refl

lemma zip_nil_iff {α β : Type} (l₁ : list α) (l₂ : list β) :
  list.zip l₁ l₂ = [] ↔ l₁ = [] ∨ l₂ = [] :=
iff.intro (λh, by cases l₁; cases l₂; finish)
          (λh, begin cases h with h₁ h₁; rw h₁;
                     unfold zip zip_with,
                     exact zip_nil_right end)

lemma zip_with_len_l {α β γ : Type*} {l₁ : list α} {l₂ : list β} {f : α → β → γ}
  (h : length l₁ = length l₂) : length (zip_with f l₁ l₂) = length l₁ :=
begin
  induction l₁ with x xs ih generalizing l₂,
    {simp [zip_with]},
    {
      cases l₂ with y ys,
        {injection h},
        {
          simp only [zip_with, length],
          rw ih, injection h
        }
    }
end

lemma zip_with_len_r {α β γ : Type*} {l₁ : list α} {l₂ : list β} {f : α → β → γ}
  (h : length l₁ = length l₂) : length (zip_with f l₁ l₂) = length l₂ :=
begin
  induction l₁ with x xs ih generalizing l₂,
    {rw ← h, simp [zip_with]},
    {
      cases l₂ with y ys,
        {injection h},
        {
          simp only [zip_with, length],
          rw ih, injection h
        }
    }
end

lemma repeat_nil {α : Type} (x : α) (n : ℕ) : list.repeat x n = [] ↔ n = 0 :=
iff.intro (λh, begin
                 cases n,
                   refl,
                 unfold list.repeat at h,
                 cases h
               end)
          (λh, by rw h; refl)

lemma nat_abs_zero_iff (a b : ℤ) : nat_abs (a - b) = 0 ↔ a = b :=
iff.intro begin generalize h : a - b = c, intros,
                cases c; dsimp at a_1, rw a_1 at h,
                  apply eq_of_sub_eq_zero,
                  rw of_nat_zero at h,
                  exact h,
                cases a_1
          end
          begin generalize h : a - b = c, intros,
                rw a_1 at h, rw sub_self at h,
                rw ← h, refl
          end

lemma join_empty_of_all_empty {α : Type*} (xs : list (list α))
  (h : (∀x, x ∈ xs → x = [])) : join xs = [] :=
begin
  induction xs with x xs ih,
    {refl},
    {
      unfold join,
      have h₁ : x = [], from h _ (by left; refl),
      rw h₁, rw nil_append,
      apply ih, intros x₁,
      specialize h x₁, intros h₂,
      apply h, right, exact h₂
    }
end

lemma repeat_more {α : Type} (x : α) (n : ℕ) (h : n ≥ 1) :
  repeat x n = x :: repeat x (n - 1) :=
begin
  cases n, cases h,
  dsimp, apply congr_arg, rw sub_one,
  refl
end

lemma one_le_succ (a : ℕ) : 1 ≤ nat.succ a :=
begin
  induction a,
    exact le_refl _,
  constructor, exact a_ih
end

lemma nat_abs_of_lt {a b : ℤ} (h : a < b) : nat_abs (b - a) ≥ 1 :=
have h₁ : b - a > 0, from sub_pos_of_lt h,
begin
  simp only [(≥)],
  rw [← coe_nat_le, nat_abs_of_nonneg (int.le_of_lt h₁), int.coe_nat_one],
  conv { to_lhs, rw ← zero_add (1 : ℤ) },
  apply add_one_le_of_lt,
  exact h₁
end

lemma neg_lt_of_succ (n : ℕ) (a : ℤ) (h : a ≥ 0) : -↑n < a + (1 : ℤ) :=
have h₁ : -↑n ≤ (0 : ℤ), {rw neg_le, rw neg_zero, trivial},
have h₂ : 0 < a + 1, {rw lt_add_one_iff, exact h},
lt_of_le_of_lt h₁ h₂

section bounded

variables {α : Type} [decidable_linear_order α]

def bounded (a b : α) :=
  {x : α // a ≤ x ∧ x < b}

def is_bounded (a b : α) (y : α) :=
  a ≤ y ∧ y < b

lemma is_bounded_of_bounds {a b y : α} (h : a ≤ y) (h₁ : y < b) :
  is_bounded a b y := and.intro h h₁

instance is_bounded_dec (a b y : α) : decidable (is_bounded a b y) :=
  by simp [is_bounded]; apply_instance

def make_bounded {a b : α} {x : α} (h : is_bounded a b x) : bounded a b :=
  ⟨x, h⟩

def z_of_bounded {a b : α} (b : bounded a b) :=
  match b with ⟨z, _⟩ := z end

def bounded_to_str [φ : has_to_string α] {a b : α} :
  bounded a b → string := to_string ∘ z_of_bounded

instance bounded_repr {a b : α} [has_to_string α] :
  has_repr (bounded a b) := ⟨bounded_to_str⟩

instance bounded_str (a b : α) [has_to_string α] :
  has_to_string (bounded a b) := ⟨bounded_to_str⟩

instance bounded_to_carrier_coe (a b : α) : has_coe (bounded a b) α :=
  ⟨z_of_bounded⟩

instance zbound_dec_eq {a b : α} : decidable_eq (bounded a b)
  | ⟨x, _⟩ ⟨y, _⟩ := by apply_instance

instance coe_bounded {α : Type} {a b : α} [decidable_linear_order α] :
  has_coe (@bounded α _ a b) α := ⟨z_of_bounded⟩

lemma coe_is_z_of_bounded {α : Type} {a b : α} [decidable_linear_order α]
  (x : bounded a b) : z_of_bounded x = ↑x := rfl

lemma positive_bounded {x : ℕ} (a : bounded 0 x) : ↑a ≥ 0 :=
let ⟨a, ⟨l, r⟩⟩ := a in by rw ← coe_is_z_of_bounded; simpa [z_of_bounded]

lemma bounded_lt {x : ℕ} (a : bounded 0 x) : ↑a < x :=
let ⟨a, ⟨l, r⟩⟩ := a in by rw ← coe_is_z_of_bounded; simpa [z_of_bounded]

end bounded

structure point := (x : ℤ) (y : ℤ)

private def point_rep : point → string
  | ⟨x, y⟩ := "[" ++ to_string x ++ ", " ++ to_string y ++ "]"

def point_eq (p₁ p₂ : point) := p₁.x = p₂.x ∧ p₁.y = p₂.y

instance dec_eq_p {p₁ p₂} : decidable (point_eq p₁ p₂) :=
  by simp [point_eq]; apply_instance

instance dec_eq_point : decidable_eq point :=
  λ⟨x₁, y₁⟩ ⟨x₂, y₂⟩,
  begin
    by_cases h₁ : x₁ = x₂;
    by_cases h₂ : y₁ = y₂,
      {
        apply is_true,
          rw h₁, rw h₂
      },
      {
        apply is_false,
          rw h₁, intros contra,
          injection contra, contradiction
      },
      {
        apply is_false,
          rw h₂, intros contra,
          injection contra, contradiction
      },
      {
        apply is_false,
          intros contra, injection contra,
          contradiction
      }
  end

instance : has_to_string point := ⟨point_rep⟩

instance : has_repr point := ⟨point_rep⟩

def grid_sorted : point → point → Prop
  | ⟨x, y⟩ ⟨x₁, y₁⟩ := x < x₁ ∧ y₁ < y

infix `↗` : 50 := grid_sorted

instance {a b : point} : decidable (a ↗ b) :=
  let ⟨x, y⟩ := a in
  let ⟨x₁, y₁⟩ := b in by simp [(↗)]; apply_instance

instance {a b : point} : is_irrefl point grid_sorted := {
  irrefl := λ⟨x, y⟩, begin
                      simp [(↗)], intros contra,
                      refl
                    end
}

instance {a b : point} : is_trans point grid_sorted := {
  trans := λ⟨x, y⟩ ⟨x₁, y₁⟩ ⟨x₂, y₂⟩ ⟨h, h₁⟩ ⟨h₂, h₃⟩,
             begin
               simp [(↗)] at *,
               exact and.intro (lt_trans h h₂) (lt_trans h₃ h₁)
             end
}

instance {a b : point}
         [c : is_irrefl point grid_sorted]
         [c₁ : is_trans point grid_sorted] :
         is_strict_order point grid_sorted := by constructor; assumption

def le_of_add_le_left (a b c : ℤ) (h₁ : 0 ≤ b) (h₂ : a + b ≤ c) : a ≤ c :=
begin
  apply (@le_of_add_le_add_right _ _ a b c),
  apply le_add_of_le_of_nonneg; assumption
end

lemma grid_bounded_iff {p₁ p₂ : point} : p₁↗p₂ ↔ (p₁.x < p₂.x ∧ p₂.y < p₁.y) :=
  by cases p₁; cases p₂; simp [(↗)]

lemma length_zip_left {α β : Type*} {l₁ : list α} {l₂ : list β}
  (h : length l₁ = length l₂) : length (zip l₁ l₂) = length l₁ :=
begin
  induction l₁ generalizing l₂; cases l₂,
    refl,
    cases h,
    cases h,
  unfold zip zip_with,
  dsimp,
  repeat {rw add_one},
  apply congr_arg,
  apply l₁_ih,
  dsimp at h, injection h
end

lemma not_grid_bounded_iff {p₁ p₂ : point} :
  ¬p₁↗p₂ ↔ (p₂.x ≤ p₁.x ∨ p₁.y ≤ p₂.y) :=
begin
  cases p₁; cases p₂,
  unfold point.x point.y,
  simp [(↗)],
  split; intros h,
  {
    by_cases h₁ : p₁_x < p₂_x,
    have h := h h₁,
    right, exact h,
    rw not_lt_iff_eq_or_lt at h₁,
    cases h₁, rw h₁, left, refl,
    left, apply int.le_of_lt, assumption
  },
  {
    intros h₁,
    cases h,
    have contra : p₁_x < p₁_x, from lt_of_lt_of_le h₁ h,
    have contra₁ : ¬p₁_x < p₁_x, from lt_irrefl _,
    contradiction,
    exact h
  }
end

lemma abs_nat_lt : ∀n m : ℤ, (0 ≤ n) → n < m → nat_abs n < nat_abs m
  | (of_nat n₁) (of_nat n₂) zlen nltm :=
  begin
    dsimp,
    revert n₁, induction n₂; intros; cases n₁,
    {cases nltm},
    {cases nltm},
    {apply zero_lt_succ},
    {apply succ_lt_succ,
     apply n₂_ih,
       {cases n₁, apply le_refl,
        rewrite of_nat_succ, rewrite add_comm,
        unfold has_le.le},
       {rewrite of_nat_succ at nltm,
        rewrite of_nat_succ at nltm,
        apply lt_of_add_lt_add_right nltm}
       }
  end

def range_weaken_lower_any {a b c : ℤ} (h : c ≤ a) : bounded a b → bounded c b
  | ⟨i, ⟨lbound, rbound⟩⟩ :=
    ⟨i, and.intro
          (le_trans h lbound)
          rbound⟩

def range_weaken_upper_any {a b c : ℤ} (h : b ≤ c) : bounded a b → bounded a c
  | ⟨i, ⟨lbound, rbound⟩⟩ :=
    ⟨i, and.intro
          lbound
          (have h : b < c ∨ b = c, from lt_or_eq_of_le h,
           or.elim h
            (assume h, lt_trans rbound h)
            (by cc))⟩

def range_weaken {a b : ℤ} (h : bounded (a + 1) b) : bounded a b
  := range_weaken_lower_any
       (le_of_add_le_left _ 1 _ dec_trivial (le_refl _)) h

def range : ∀(a b : ℤ), list (bounded a b)
  | fro to := if h : fro < to
              then ⟨fro, and.intro (le_refl _) h⟩
                   :: list.map range_weaken (range (fro + 1) to)
              else []
  using_well_founded {
    rel_tac := λf args,
      `[exact ⟨
          measure (λ⟨fro, to⟩, nat_abs (to - fro)),
          measure_wf _
        ⟩],
    dec_tac := `[apply abs_nat_lt,
                   {rewrite ← sub_sub,
                    have h₁ : 0 < to - fro,
                      apply sub_pos_of_lt, exact h,
                    have h₂ : 0 + 1 < (to - fro) + 1,
                      apply add_lt_add_of_lt_of_le,
                      exact h₁, reflexivity,
                    have h₃ : (0 + 1 : ℤ) = 1,
                      exact dec_trivial,
                    rw h₃ at h₂,
                    have h₄ : (0 + 1 ≤ to - fro - 1 + 1) → 0 ≤ to - fro - 1,
                      exact le_of_add_le_add_right,
                    apply h₄, rw h₃,
                    rewrite sub_eq_add_neg,
                    rewrite sub_eq_add_neg,
                    rewrite add_assoc,
                    have h₅ : (-1 + 1 : ℤ) = 0,
                      exact dec_trivial,
                    rewrite h₅,
                    rewrite add_assoc,
                    rewrite add_comm,
                    rewrite add_zero,
                    rewrite add_comm,
                    have h₆ : to + -fro = to - fro,
                      refl,
                    rewrite h₆,
                    unfold has_lt.lt int.lt at h₁,
                    rewrite h₃ at h₁,
                    exact h₁},
                   {rewrite ← sub_sub,
                    apply lt_of_le_sub_one,
                    reflexivity}]
  }

def range_pure : ℤ → ℤ → list ℤ
  | fro to :=  if h : fro < to
               then fro :: range_pure (fro + 1) to else []
  using_well_founded {
    rel_tac := λf args,
      `[exact ⟨
          measure (λ⟨a, b⟩, nat_abs (b - a)),
          measure_wf _
        ⟩],
    dec_tac := `[
      apply abs_nat_lt,
                   {
                     rewrite ← sub_sub,
                    have h₁ : 0 < to - fro,
                      apply sub_pos_of_lt, exact h,
                    have h₂ : 0 + 1 < (to - fro) + 1,
                      apply add_lt_add_of_lt_of_le,
                      exact h₁, reflexivity,
                    have h₃ : (0 + 1 : ℤ) = 1,
                      exact dec_trivial,
                    rw h₃ at h₂,
                    have h₄ : (0 + 1 ≤ to - fro - 1 + 1) → 0 ≤ to - fro - 1,
                      exact le_of_add_le_add_right,
                    apply h₄, rw h₃,
                    rewrite sub_eq_add_neg,
                    rewrite sub_eq_add_neg,
                    rewrite add_assoc,
                    have h₅ : (-1 + 1 : ℤ) = 0,
                      exact dec_trivial,
                    rewrite h₅,
                    rewrite add_assoc,
                    rewrite add_comm,
                    rewrite add_zero,
                    rewrite add_comm,
                    have h₆ : to + -fro = to - fro,
                      refl,
                    rewrite h₆,
                    unfold has_lt.lt int.lt at h₁,
                    rewrite h₃ at h₁,
                    exact h₁
                    },
                   {
                     rewrite ← sub_sub,
                    apply lt_of_le_sub_one,
                    reflexivity
                    }
                    ]
  }

lemma range_pure_cons {a b} {x xs} (h : range_pure a b = x :: xs) :
  range_pure (a + 1) b = xs :=
begin
  have h₁ : a < b,
    {
      by_cases h₂ : a < b,
        {exact h₂},
        {
          unfold1 range_pure at h,
          rw if_neg h₂ at h,
          cases h
        },
    },
  unfold1 range_pure at h,
  rw if_pos h₁ at h,
  injection h
end

lemma range_pure_bounded {a b : ℤ} :
  ∀{c}, c ∈ range_pure a b → is_bounded a b c :=
assume c,
begin
  generalize h : range_pure a b = l,
  induction l with x xs ih generalizing a b; intros h₁,
    {
      cases h₁
    },
    {
      rw mem_cons_iff at h₁,
      cases h₁ with h₁,
        {
          subst h₁,
          unfold1 range_pure at h,
          by_cases h₂ : a < b; simp [h₂] at h,
            {
              cases h with hl hr, subst hl,
              split, refl, exact h₂
            },
            {
              cases h
            }
        },
        {
          have h₂ : a < b,
            {
              by_cases eq : a < b,
                {exact eq},
                {
                  unfold1 range_pure at h,
                  rw if_neg eq at h,
                  cases h
                },
            },
          unfold1 range_pure at h,
          rw if_pos h₂ at h,
          injection h with hl hr,
          have ih₁ := @ih (a + 1) b hr h₁,
          cases ih₁ with lb ub,
          split,
            {
              have lb := lt_of_add_one_le lb,
              exact int.le_of_lt lb
            },
            {
              exact ub
            }
        }
    }
end

def range_pure_m (a b : ℤ) : list ℤ := map z_of_bounded (range a b)

lemma range_empty_iff (a b : ℤ) : range a b = [] ↔ (b ≤ a) :=
begin
  split; intros h,
  {
    unfold1 range at h,
    by_cases h₁ : a < b; simp [h₁] at h,
      {contradiction},
      {finish},
  },
  {
    unfold1 range,
    by_cases h₁ : a < b; simp [h₁],
    have contra : ¬b ≤ a, from not_le_of_gt h₁,
    contradiction
  }
end

lemma range_length_same (a : ℤ) : length (range a a) = 0 :=
begin
  unfold1 range,
  have h : ¬a < a, from lt_irrefl _,
  simp [h]
end

lemma range_length_one (a : ℤ) : length (range a (a + 1)) = 1 :=
begin
  unfold1 range,
  have h : a < a + 1, from lt_add_succ _ _,
  simp [h],
  rw range_length_same
end

lemma range_pure_length_same (a : ℤ) : length (range_pure a a) = 0 :=
begin
  unfold1 range_pure,
  have h : ¬a < a, from lt_irrefl _,
  simp [h]
end

lemma range_pure_length_one (a : ℤ) : length (range_pure a (a + 1)) = 1 :=
begin
  unfold1 range_pure,
  have h : a < a + 1, from lt_add_succ _ _,
  simp [h],
  rw range_pure_length_same
end

lemma range_length {a b : ℤ} (h : a ≤ b) :
  length (range a b) = nat_abs (b - a) :=
begin
  generalize h₁ : nat_abs (b - a) = n,
  induction n with n ih generalizing a b,
    {
      rw nat_abs_zero_iff at h₁,
      rw h₁,
      exact range_length_same _
    },
    {
      have h₂ : a < b,
        begin
          rw le_iff_eq_or_lt at h,
          cases h,
            {
              have h : b = a, by cc,
              rw ← nat_abs_zero_iff at h,
              rw h at h₁, cases h₁
            },
            {exact h}
        end,
      clear h,
      have h₃ : a + 1 ≤ b, from add_one_le_of_lt h₂,
      have h₄ : nat_abs (b - (a + 1)) = n,
        begin
          rw ← sub_sub,
          rw ← int.coe_nat_eq_coe_nat_iff,
          have h₅ : b - a - 1 ≥ (0 : ℤ),
            {
              simp [(≥)],
              rw ← add_le_add_iff_right (1 : ℤ),
              rw zero_add, rw ← sub_eq_add_neg,
              rw add_sub, rw ← sub_eq_add_neg,
              rw sub_add_cancel,
              rw ← add_le_add_iff_right a,
              rw sub_add_cancel, rw add_comm,
              exact h₃
            },
          rw nat_abs_of_nonneg h₅,
          rw ← add_right_cancel_iff, any_goals {exact (1 : ℤ)},
          rw sub_add_cancel,
          have h₆ : b - a ≥ (0 : ℤ),
            {
              simp [(≥)],
              rw ← sub_lt_sub_iff_right a at h₂,
              rw sub_self at h₂,
              apply int.le_of_lt,
              exact h₂
            },
          rw ← int.coe_nat_eq_coe_nat_iff at h₁,
          rw nat_abs_of_nonneg h₆ at h₁,
          exact h₁
        end,
      have ih := ih h₃ h₄,
      unfold1 range at ih,
      rw le_iff_eq_or_lt at h₃,
      cases h₃,
        {
          have h₇ : ¬a + 1 < b, rw ← h₃, intros contra,
            have h₈ : ¬a + 1 < a + 1, from lt_irrefl _,
            contradiction,
          simp [h₇] at ih,
          rw ← ih, rw ← h₃, rw range_length_one
        },
        {
          simp [h₃] at ih,
          unfold1 range,
          simp [h₂],
          unfold1 range,
          simp [h₃],
          rw ← ih,
          rw ← one_add
        }
    }
end

lemma range_length_pure {a b : ℤ} (h : a ≤ b) :
  length (range_pure a b) = nat_abs (b - a) :=
begin
    generalize h₁ : nat_abs (b - a) = n,
  induction n with n ih generalizing a b,
    {
      rw nat_abs_zero_iff at h₁,
      rw h₁,
      exact range_pure_length_same _
    },
    {
      have h₂ : a < b,
        begin
          rw le_iff_eq_or_lt at h,
          cases h,
            {
              have h : b = a, by cc,
              rw ← nat_abs_zero_iff at h,
              rw h at h₁, cases h₁
            },
            {exact h}
        end,
      clear h,
      have h₃ : a + 1 ≤ b, from add_one_le_of_lt h₂,
      have h₄ : nat_abs (b - (a + 1)) = n,
        begin
          rw ← sub_sub,
          rw ← int.coe_nat_eq_coe_nat_iff,
          have h₅ : b - a - 1 ≥ (0 : ℤ),
            {
              simp [(≥)],
              rw ← add_le_add_iff_right (1 : ℤ),
              rw zero_add, rw ← sub_eq_add_neg,
              rw add_sub, rw ← sub_eq_add_neg,
              rw sub_add_cancel,
              rw ← add_le_add_iff_right a,
              rw sub_add_cancel, rw add_comm,
              exact h₃
            },
          rw nat_abs_of_nonneg h₅,
          rw ← add_right_cancel_iff, any_goals {exact (1 : ℤ)},
          rw sub_add_cancel,
          have h₆ : b - a ≥ (0 : ℤ),
            {
              simp [(≥)],
              rw ← sub_lt_sub_iff_right a at h₂,
              rw sub_self at h₂,
              apply int.le_of_lt,
              exact h₂
            },
          rw ← int.coe_nat_eq_coe_nat_iff at h₁,
          rw nat_abs_of_nonneg h₆ at h₁,
          exact h₁
        end,
      have ih := ih h₃ h₄,
      unfold1 range_pure at ih,
      rw le_iff_eq_or_lt at h₃,
      cases h₃,
        {
          have h₇ : ¬a + 1 < b, rw ← h₃, intros contra,
            have h₈ : ¬a + 1 < a + 1, from lt_irrefl _,
            contradiction,
          simp [h₇] at ih,
          rw ← ih, rw ← h₃, rw range_pure_length_one
        },
        {
          simp [h₃] at ih,
          unfold1 range_pure,
          simp [h₂],
          unfold1 range_pure,
          simp [h₃],
          rw ← ih,
          rw ← one_add
        }
    }
end

open list function

def empty_list {α : Type} (l : list α) := [] = l

lemma not_empty_of_len {α : Type} {l : list α}
  (h : length l > 0) : ¬empty_list l :=
begin
  simp [empty_list],
  cases l,
    {
      cases h
    },
    {
      trivial
    }
end

lemma empty_list_eq_ex {α : Type} {l : list α} (h : ¬empty_list l) :
  ∃(x : α) (xs : list α), l = x :: xs :=
begin
  cases l,
    unfold empty_list at h, contradiction,
  existsi l_hd, existsi l_tl,
  refl
end

instance decidable_empty_list {α : Type} : ∀l : list α,
  decidable (empty_list l)
  | [] := is_true rfl
  | (x :: _) := is_false (by simp [empty_list])

theorem unempty_nil_eq_false {α : Type} : ¬(empty_list (@nil α)) ↔ false :=
  begin
    simp [empty_list]
  end

def head1 {α : Type} (l : list α) (h : ¬empty_list l) :=
  match l, h with
    | [], p := by rw unempty_nil_eq_false at p; contradiction
    | (x :: _), _ := x
  end

def foldr1 {α : Type} (f : α → α → α) (l : list α) (h : ¬empty_list l) : α :=
  match l, h with
    | [], p := by rw unempty_nil_eq_false at p; contradiction
    | (x :: xs), _ := foldr f x xs
  end

lemma foldr1_unempty_eq_foldr {α : Type} (f : α → α → α) (l : list α)
  (h : ¬empty_list l) : foldr1 f l h = list.foldr f (head1 l h) (tail l) :=
begin
  cases l,
    rw unempty_nil_eq_false at h, contradiction,
  unfold foldr1 head1 tail
end

def min_element {α : Type} [decidable_linear_order α]
  (l : list α) (h : ¬empty_list l) := foldr1 min l h

def max_element {α : Type} [decidable_linear_order α]
  (l : list α) (h : ¬empty_list l) := foldr1 max l h

lemma foldr_swap {α : Type*}
  (f : α → α → α) (h : is_commutative _ f) (h₁ : is_associative _ f)
  {x y : α} {xs : list α} :
  foldr f x (y :: xs) = foldr f y (x :: xs) :=
have comm : ∀a b, f a b = f b a, by finish,
have assoc : ∀a b c, f a (f b c) = f (f a b) c, by finish,
list.rec_on xs
  (comm _ _)
  (assume x₁ xs₁ ih,
   by dsimp at *;
      rw [assoc, comm y, ← assoc, ih, assoc, comm x₁, ← assoc])

lemma le_min_elem_all {α : Type*} [decidable_linear_order α]
  (l : list α) (b : α) (h : ¬empty_list l) :
  (∀x, x ∈ l → b ≤ x) → b ≤ min_element l h :=
assume h₁,
begin
  induction l with y ys ih,
    {
      unfold empty_list at h, contradiction
    },
    {
      unfold min_element foldr1,
      cases ys,
        {
          dsimp, apply h₁, left, refl
        },
        {
          have ih := ih _ _,
          unfold min_element foldr1 at ih,
          rw foldr_swap min ⟨min_comm⟩ ⟨min_assoc⟩,
          dsimp at *,
          rw le_min_iff,
          split,
            {
              apply h₁, left, refl
            },
            {
              exact ih_1
            },
          unfold empty_list, intros ok, cases ok,
          intros, apply h₁, right, simp [(∈)] at a, exact a
        }
    }
end

lemma max_le_elem_all {α : Type*} [decidable_linear_order α]
  (l : list α) (b : α) (h : ¬empty_list l) :
  (∀x, x ∈ l → x ≤ b) → max_element l h ≤ b :=
assume h₁,
begin
induction l with y ys ih,
    {
      unfold empty_list at h, contradiction
    },
    {
      unfold max_element foldr1,
      cases ys,
        {
          dsimp, apply h₁, left, refl
        },
        {
          have ih := ih _ _,
          unfold max_element foldr1 at ih,
          rw foldr_swap max ⟨max_comm⟩ ⟨max_assoc⟩,
          dsimp at *,
          rw max_le_iff,
          split,
            {
              apply h₁, left, refl
            },
            {
              exact ih_1
            },
          unfold empty_list, intros ok, cases ok,
          intros, apply h₁, right, simp [(∈)] at a, exact a
        }
    }
end

lemma min_le_max {α : Type*} [decidable_linear_order α] (a : α) {b c : α}
  (H : b ≤ c) : min a b ≤ max a c :=
begin
  unfold min max,
  by_cases h : a ≤ b; simp [h];
    by_cases h₁ : a ≤ c; simp [h₁],
  exact H, rw not_le at h, exact le_of_lt h
end

lemma min_elem_le_max_elem {α : Type*} [decidable_linear_order α] (l : list α)
  (h : ¬empty_list l) : min_element l h ≤ max_element l h :=
begin
  unfold min_element max_element,
  cases l with x xs, unfold empty_list at h, contradiction,
  unfold foldr1,
  induction xs with y ys,
    {dsimp, refl},
    {
      dsimp,
      have h₁ : ¬empty_list (x :: ys),
        by unfold empty_list; intros; contradiction,
      have ih := xs_ih h₁,
      exact min_le_max y ih
    }
end

lemma map_empty_iff_l_empty {α β : Type} (f : α → β) (l : list α) :
  empty_list (map f l) ↔ empty_list l :=
begin
  split; intros h; cases l; try {finish <|> simp [empty_list]}
end

lemma unzip_one {α β : Type} (l : α) (r : β) (xs : list (α × β)) :
  unzip ((l, r) :: xs) = ((l :: (unzip xs).fst), r :: (unzip xs).snd) :=
begin
  simp [unzip],
  cases (unzip xs),
  simp [unzip]
end

lemma unzip_fst_empty_iff_l_empty {α β : Type} (l : list (α × β)) :
  empty_list ((unzip l).fst) ↔ empty_list l :=
begin
  split; intros h; cases l; try {finish};
  simp [empty_list, unzip] at *,
  cases l_hd,
  rw unzip_one at h,
  contradiction
end

lemma unzip_snd_empty_iff_l_empty {α β : Type} (l : list (α × β)) :
  empty_list ((unzip l).snd) ↔ empty_list l :=
begin
  split; intros h; cases l; try {finish};
  simp [empty_list, unzip] at *,
  cases l_hd,
  rw unzip_one at h,
  contradiction
end

lemma pair_in_zip_l {α β} {a b} {l₁ : list α} {l₂ : list β}
  (h : (a, b) ∈ zip l₁ l₂) : a ∈ l₁ :=
begin
  induction l₁ with x xs ih generalizing l₂,
    {
      simp [zip, zip_with] at h, contradiction
    },
    {
      cases l₂ with y ys,
        {
          simp [zip, zip_with] at h,
          contradiction
        },
        {
          unfold1 zip at h,
          unfold1 zip_with at h,
          rw mem_cons_iff at h,
          cases h, injection h with hl hr,
          subst hl, subst hr,
          left, refl, rw mem_cons_eq,
          right, apply ih,
          unfold zip, exact h
        }
    }
end

lemma pair_in_zip_r {α β} {a b} {l₁ : list α} {l₂ : list β}
  (h : (a, b) ∈ zip l₁ l₂) : b ∈ l₂ :=
begin
  induction l₁ with x xs ih generalizing l₂,
    {
      simp [zip, zip_with] at h, contradiction
    },
    {
      cases l₂ with y ys,
        {
          simp [zip, zip_with] at h,
          contradiction
        },
        {
          unfold1 zip at h,
          unfold1 zip_with at h,
          rw mem_cons_iff at h,
          cases h, injection h with hl hr,
          subst hl, subst hr,
          left, refl, rw mem_cons_eq,
          right, apply ih,
          unfold zip, exact h
        }
    }
end

def decidable_uncurry {α β : Type*} {f : α → β → Prop} {x : α × β}
  (h : decidable (f x.fst x.snd)) : decidable (uncurry f x) :=
begin
  resetI,
  cases x, unfold_projs at *,
  simp [uncurry],
  exact h
end

lemma filter_forall {α : Type*} {P : α → Prop} [decidable_pred P] (xs : list α)
  (x : α) (h₁ : x ∈ filter P xs) : P x :=
begin
  induction xs with x₁ xs₁ ih; simp [filter] at h₁,
    {
      contradiction
    },
    {
      by_cases h₂ : (P x₁); simp [h₂] at h₁,
        {cases h₁,
           {cc},
           {exact ih h₁}},
        {exact ih h₁}
    }
end

lemma unempty_filter_ex {α : Type*} {xs : list α} {p : α → Prop}
  [decidable_pred p] (h : ¬empty_list (filter p xs)) :
  ∃x, x ∈ xs ∧ p x :=
begin
  induction xs with x₁ xs₁ ih,
    {
      dsimp at h, unfold empty_list at h, contradiction
    },
    {
      by_cases h₁ : p x₁,
        {
          existsi x₁, finish
        },
        {
          unfold empty_list at *,
          unfold filter at h,
          simp [h₁] at h,
          have ih := ih h,
          cases ih with x₂ px₂,
          existsi x₂,
          simp [(∈), list.mem] at *,
          split, right, exact px₂.left,
          exact px₂.right
        }
    }
end

def conv {α : Type*} (f : α → Type*) {a b : α} : a = b → f a → f b :=
  assume h₁ h₂, by rw ← h₁; exact h₂

def list_iso {α : Type*} [decidable_eq α] : list α → list α → bool
  | []        []        := tt
  | (x :: xs) (y :: ys) := band (x = y) (list_iso xs ys)
  | _         _         := ff

lemma list_iso_refl {α : Type*} [decidable_eq α] (l : list α) :
  list_iso l l :=
begin
  induction l; simp [list_iso], assumption
end

lemma list_iso_nil_l {α : Type*} [decidable_eq α] (l : list α)
  : list_iso nil l ↔ l = nil :=
  iff.intro
    (λh, begin cases l with x xs, refl, simp [list_iso] at h, contradiction end)
    (λh, begin cases l with x xs, exact list_iso_refl _, cases h end)

lemma list_iso_nil_r {α : Type*} [decidable_eq α] (l : list α)
  : list_iso l nil ↔ l = nil :=
  iff.intro
    (λh, begin cases l with x xs, refl, simp [list_iso] at h, contradiction end)
    (λh, begin cases l with x xs, exact list_iso_refl _, cases h end)

lemma list_iso_symm {α : Type*} [decidable_eq α] {l₁ l₂ : list α}
  (h : list_iso l₁ l₂) : list_iso l₂ l₁ :=
begin
  induction l₁ with x xs generalizing l₂; cases l₂ with y ys; try {assumption},
  simp [list_iso], simp [list_iso] at h,
  cases h with h₁ h₂,
  rw and_iff_left, exact eq.symm h₁,
  apply l₁_ih, exact h₂
end

lemma list_iso_trans {α : Type*} [decidable_eq α] {l₁ l₂ l₃ : list α}
  (h : list_iso l₁ l₂) (h₁ : list_iso l₂ l₃) : list_iso l₁ l₃ :=
begin
  induction l₁ with x xs ih generalizing l₂ l₃; cases l₃ with y ys,
    {exact list_iso_refl _},
    {
      rw list_iso_nil_l at h, rw h at h₁,
      rw list_iso_nil_l at h₁, cases h₁
    },
    {
      rw list_iso_nil_r at h₁, rw h₁ at h,
      exact h
    },
    {
      simp [list_iso],
      cases l₂ with z zs,
        {
          rw list_iso_nil_r at h, cases h
        },
        {
          simp [list_iso] at h h₁,
          cases h₁, cases h, split, cc,
          apply ih, exact h_right, exact h₁_right
        }
    }
end

lemma list_iso_hd {α : Type*} [decidable_eq α] {x} {y} {xs ys : list α}
  (h : list_iso (x :: xs) (y :: ys)) : x = y :=
begin
  simp [list_iso] at h,
  exact h.left
end

lemma list_iso_tl {α : Type*} [decidable_eq α] {x} {y} {xs ys : list α}
  (h : list_iso (x :: xs) (y :: ys)) : list_iso xs ys :=
begin
  simp [list_iso] at h,
  exact h.right
end

lemma list_iso_iff {α : Type*} [decidable_eq α] {l₁ l₂ : list α} :
  list_iso l₁ l₂ ↔ l₁ = l₂ :=
begin
  split; intros h,
    {
      induction l₁ with x xs ih generalizing l₂,
        {
          cases l₂ with y ys,
            {refl},
            {rw list_iso_nil_l at h, cases h}
        },
        {
          cases l₂ with y ys,
            {rw list_iso_nil_r at h, cases h},
            {
              have h₁ : x = y, from list_iso_hd h,
              congr, exact h₁, apply ih,
              apply list_iso_tl h
            }
        }
    },
    {
      rw h, exact list_iso_refl _
    }
end

def mod_self {n : ℕ} : n % n = 0 :=
begin
  induction n with n ih, refl,
  rw nat.mod_def,
  rw if_pos,
  rw nat.sub_self,
  rw nat.zero_mod,
  split, rw succ_eq_add_one, rw add_comm,
  exact zero_lt_one_add _, refl
end

lemma repeat_bounded {α : Type*} {a : α} {b} :
  ∀{x}, x ∈ list.repeat a b → x = a :=
assume x h,
begin
  induction b with b ih,
    {
      cases h
    },
    {
      simp at h, cases h, assumption,
      exact ih h
    }
end

end utils