/-
James Gibson
Kolmogorov 0-1 law-/

import tactic
import measure_theory.measurable_space
import probability.independence

open  measure_theory.measure probability_theory
open_locale classical measure_theory  ennreal big_operators

namespace measure_theory
namespace probability_theory

variables {α : Type}

/--Construct the σ-algebra of sets, s, such that for each j satisfying n ≤ j ≤ n + k,
   the image under the function Fn j of the set s is measurable in the σ-algebra β j
   Denoted Fₙⁿ⁺ᵏ.--/
def Fnk_algebra (β : ℕ → Type) (fn : Π (n: ℕ), α → β n)
  (m : Π (n : ℕ), measurable_space (β n)) (n k : ℕ) : measurable_space α :=
/-Define the function from set α to Prop which is true when the set is in the σ-algebra-/
  { measurable_set' := λ (s : set α), ∀ (i ∈ finset.range (k + 1)),
      ∃(s' : set (β (n + i))), (m (n + i)).measurable_set' s' ∧ fn (n + i) ⁻¹' s' = s,
  /-Show that ∅ is in the σ-algebra-/
    measurable_set_empty :=
      begin
        intros i hi, use ∅,
        exact ⟨(m (n + i)).measurable_set_empty, rfl⟩
      end,
  /-Show the σ-algebra is closed under complements-/
    measurable_set_compl :=
      begin
      intros s h i hi, specialize h i hi,
      choose s' hs' using h,
      use s'ᶜ,
      split,
        { exact (m (n + i)).measurable_set_compl _ hs'.1},
        { rw ← (hs'.2),
          simp only [set.preimage_compl]},
      end,
  /-Show the σ-algebra is closed under countable unions-/
    measurable_set_Union :=
      begin
        intros seq hyp j hjrange,
        have : ∀ (i : ℕ), (∃ (s' : set (β (n + j))),
          (m (n + j)).measurable_set' s' ∧ fn (n + j) ⁻¹' s' = seq i),
        { intros i,
          exact hyp i j hjrange},
        choose seq' hseq' using this,
        use ⋃ (i : ℕ), seq' i,
        split,
        { exact (m (n + j)).measurable_set_Union (λ (i : ℕ), seq' i) (λ i, (hseq' i).1)},
        { simp only [hseq', set.preimage_Union]},
      end}

/--Define the σ-algebra generated from the union of σ-algebras 𝔽ₙⁿ⁺ᵏ for fixed n with k : ℕ.
   Denoted 𝔽ₙ--/
def Fn_σ_algebra (β : ℕ → Type) (m : Π (n : ℕ), measurable_space (β n))
  (fn : Π (n: ℕ), α → β n) (n : ℕ) : measurable_space α :=
  measurable_space.generate_from
    {s : set α | ∃ (i : ℕ),  (Fnk_algebra β fn m n i).measurable_set' s}

/--Define the tail σ-algebra as the intersection of the σ-algebras 𝔽ₙ for n : ℕ.
   Denoted as τ.--/
def tail_σ_algebra (β : ℕ → Type) (fn : Π (n: ℕ), α → β n) (m : Π (n : ℕ), measurable_space (β n)) :
  measurable_space α :=
  { measurable_set' := λ s, ∀ (n : ℕ), (Fn_σ_algebra β m fn n).measurable_set' s,
  /-Show the empty set is in this σ-algebra-/
  measurable_set_empty :=
    begin
      intro n,
      exact (Fn_σ_algebra β m fn n).measurable_set_empty,
    end,
  /-Show the σ-algebra is closed under complements-/
  measurable_set_compl :=
    begin
      intros s hyp n,
      exact (Fn_σ_algebra β m fn n).measurable_set_compl _ (hyp n),
    end,
  /-Show the σ-algebra is closed under countable unions-/
  measurable_set_Union :=
    begin
      intros seq hyp n,
      have : ∀ (i : ℕ), (Fn_σ_algebra β m fn n).measurable_set' (seq i),
        { intro i,  exact hyp i n},
      exact (Fn_σ_algebra β m fn n).measurable_set_Union _ this,
    end}

/--Define what it means for a σ-algebra, m, to be independent of a collection of sets
    i.e. each m measurable set is independent w.r.t. μ to each set in the collection--/
def indep_mspace_sets [measurable_space α] (μ : measure α) (m : measurable_space α) (col : set (set α)) : Prop :=
  ∀ s₁ s₂ : set α, m.measurable_set' s₁ → s₂ ∈ col → μ(s₁ ∩ s₂) = μ(s₁) * μ(s₂)

/--For events in a σ-algebra which is independent with itself w.r.t. a probability measure μ,
   the probability of each event is either 0 or 1.--/
lemma self_Indep_result (m₁ : measurable_space α) [measurable_space α]
  (μ : measure α) (hμ : is_probability_measure μ) (h : indep m₁ m₁ μ) :
  ∀ (s : set α), m₁.measurable_set' s → μ s = 0 ∨ μ s = 1 :=
begin
  intros s hs,
  /-specialize independence to obtain that μ s = (μ s) ^ 2-/
  specialize h s s hs hs,
  rw s.inter_self at h,
  /-prove μ s < top so that we can use that μ s ≠ top later using a one line lemma-/
  have suppl : μ s < ⊤,
    { calc  μ s ≤ 1  : prob_le_one
            ... < ⊤  : ennreal.one_lt_top,  },
  have this1 : μ s - (μ s) * (μ s) = 0,
    { have : μ s - μ s = 0,
      { norm_num [@ennreal.add_sub_self 0 (μ s) (lt_top_iff_ne_top.1 suppl)], },
      nth_rewrite 0 ← h,
      exact this, },
  /-factorise to a product of 2 things which equals 0-/
  have this2 : μ s * (1 - μ s) = μ s - (μ s) * (μ s),
  { sorry, },
  rw ← this2 at this1, clear this2,
  /-rearrange goal slightly-/
  suffices suff: μ s = 0 ∨ 1 - μ s = 0,
  { cases suff,
    { left,
      assumption, },
    { right,
      norm_num at suff,
      exact ge_antisymm suff prob_le_one, },  },
  apply zero_eq_mul.mp,
  exact eq.symm this1,
  exact canonically_ordered_comm_semiring.to_no_zero_divisors,
end

/--Proves that if a σ-algebra, m, is independent to a collection of measurable sets, col, then m is independent
   to the σ-algebra generated by col, deonted σ(col) --/
lemma indep_of_gen_of_indep_mspace_sets [measurable_space α] (μ : measure α) (m : measurable_space α)
  (col : set (set α)) (h : @indep_mspace_sets α _inst_1 μ m col) (h2: ∀ s ∈ col, _inst_1.measurable_set' s) :
  @indep α m (measurable_space.generate_from col) _inst_1 μ :=
begin
  /-Introduce arbitrary sets s₁, s₂ in m and col respectively-/
  intros s₁ s₂ hs₁ hs₂,
  /-Work through the cases on the inductive type hs₂-/
  cases hs₂,
  /-Case s₂ is in col, follows from assumption-/
  { exact h s₁ s₂ hs₁ hs₂_H, },
  /-Case s₂ is the empty set, follows from measure of empty set-/
  { have : (λ (a : α), false) = (∅ : set α), by congr',
    rw this at *,
    rw [set.inter_empty s₁, measure_empty],
    ring, },
  /-Case s₂ is complement of σ(col) measurable set-/
  { have :  (λ (a : α), a ∉ hs₂_s) = hs₂_sᶜ, by congr',
    rw this at *, clear this,
    /-rw (@measure_compl α _inst_1 μ hs₂_s (h2 hs₂_s hs₂_ᾰ)  (sorry)),-/
    sorry,  },
  /-Case s₂ is union of σ(col) measurable sets-/
  { sorry,  },
end

/--Prove that if the functions fn are measurable w.r.t. (Ω, 𝔽, μ), then for any set, s, in the union
   ⋃ (i : ℕ), 𝔽ₙ₊₁ⁿ⁺¹⁺ⁱ, s is measurable w.r.t. 𝔽 --/
lemma measurable_prelim (β : ℕ → Type) (m : Π (n : ℕ), measurable_space (β n))
  (fn : Π (n: ℕ), α → β n) (k : ℕ) [measurable_space α]
  (h2 : ∀ (i : ℕ), measurable (fn i)) :
  ∀ (s : set α), s ∈ {s : set α | ∃ (j : ℕ), (Fnk_algebra β fn m k j).measurable_set' s} →
  _inst_1.measurable_set' s:=
begin
  /-Introduce a set s in ⋃ (i : ℕ), 𝔽ₙ₊₁ⁿ⁺¹⁺ⁱ-/
  intros s hs,
  /-Using hs, find k_1 s.t. s is measurable in 𝔽ₙⁿ⁺ᵏ-/
  choose k_1 hk using hs,
  /-Produce a function from i ≤ k_1 to a set over the type β (k + i)
    and a hyp stating this set is m (k + i) measurable its fn (k + i) preimage is s. -/
  choose l hl using hk,
  have : 0 ∈ finset.range (k_1 + 1), by  simp only [finset.mem_range, nat.succ_pos'],
  /-Use measurability of fn 0 and that the set fn 0 (s) is measurable to conclude s is measurable-/
  specialize hl 0 this,
  have this3 :  measurable_set (fn (k + 0) ⁻¹' l 0 this),
  { exact (@h2 (k + 0)) (l 0 this) hl.1, },
  rwa hl.2 at this3,
end

/--Proves that the σ-algebra 𝔽₀ⁿ is independent to the collection of sets ⋃ (i : ℕ), 𝔽ₙ₊₁ⁿ⁺¹⁺ⁱ   .--/
lemma F1nindep (β : ℕ → Type) (m : Π (n : ℕ), measurable_space (β n)) (fn : Π (n: ℕ), α → β n) (n : ℕ)
  [measurable_space α] (μ : measure α)
  (hI : Indep_fun m fn μ) :
  indep_mspace_sets μ (Fnk_algebra β fn m 0 n)
  {s : set α | ∃ (i : ℕ),  (Fnk_algebra β fn m (n + 1) i).measurable_set' s} :=
begin
  /-Take arbitrary sets s₁, s₂ in 𝔽₀ⁿ and ⋃ (i : ℕ), 𝔽ₙ₊₁ⁿ⁺¹⁺ⁱ respectively.
    If we show these sets are independent we are done.-/
  intros s₁ s₂ hs₁ hs₂,
  /-Select an j such that s₂ ∈ 𝔽ₙ₊₁ⁿ⁺¹⁺ʲ-/
  choose j hs₂' using hs₂,
  /-Using def of 𝔽ₙ₊₁ⁿ⁺¹⁺ʲ, find m (n + 1 + j) measurable set, s₂', satisfying the preimage
    under fn (n + 1 + j) of s₂' is s₂.-/
  specialize hs₂' j (finset.self_mem_range_succ j),
  choose s₂' hs₂'' using hs₂',
  /-Using def of 𝔽₀ⁿ, find m 0 measurable set s₁' satisfying the preimage
    under fn 0 is s₁.-/
  specialize hs₁ 0 (by simp only [finset.mem_range, nat.succ_pos']),
  choose s₁' hs₁' using hs₁,
  /-Have that the comap σ-algebras generated by (fn 0, m 0) and (fn (n + 1 + j), m (n + 1 + j))
    are independent from the independence of fn's.-/
  have comapindep : indep (measurable_space.comap (fn 0) (m 0)) (measurable_space.comap (fn (n + 1 + j)) (m (n + 1 + j))) μ,
  { exact Indep.indep hI (by linarith), },
  /-Prove s₁ is measurable in the comap σ-algebra of (fn 0, m 0) by using the m 0 measurability of
    s₁' and that fn 0 ⁻¹ s' = s -/
  have h₁ : (measurable_space.comap (fn 0) (m 0)).measurable_set' s₁,
  { exact ⟨s₁', hs₁'⟩,  },
  /-Prove s₂ is measurable in the comap σ-algebra of (fn (n + 1 + j), m (n + 1 + j) using similar logic above-/
  have h₂ : (measurable_space.comap (fn (n + 1 + j)) (m (n + 1 + j))).measurable_set' s₂,
  { exact ⟨ s₂', hs₂''⟩,  },
  /-Use independence of the comap σ-algebras which s₁ and s₂ are in to conclude the goal.-/
  exact (comapindep s₁ s₂ h₁ h₂),
end

/--Prove the σ-algebra 𝔽₀ⁿ is independent to the σ-algebra 𝔽ₙ₊₁ w.r.t. μ given that the functions
   are independent from each other w.r.t. μ--/
lemma F1nFnaddone_indep (β : ℕ → Type) (m : Π (n : ℕ), measurable_space (β n))
  (fn : Π (n: ℕ), α → β n) (n : ℕ) [measurable_space α] (μ : measure α)
  (hI : Indep_fun m fn μ) (h2 : ∀ (n : ℕ), measurable (fn n)):
  indep (Fnk_algebra β fn m 0 n) (Fn_σ_algebra β m fn (n + 1)) μ :=
begin
  exact indep_of_gen_of_indep_mspace_sets μ (Fnk_algebra β fn m 0 n)
    {s : set α | ∃ (i : ℕ),  (Fnk_algebra β fn m (n + 1) i).measurable_set' s}
    (F1nindep β m fn n μ hI)
    (measurable_prelim β m fn (n + 1) h2),
end

/--Prove the Kolmogorov 0-1 law, which states that one a probability space (Ω, 𝔽, μ),
   for independent measurable functions fn, any set in the tail σ-algebra generated by
   the fn's must have probability either 1 or 0.--/
theorem Kolmogorov_0_1 (β : ℕ → Type) (m : Π (n : ℕ), measurable_space (β n))
  (fn : Π (n: ℕ), α → β n) [measurable_space α] (μ : measure α) (hμ : is_probability_measure μ)
  (hI : Indep_fun m fn μ) (h2 : ∀ (n : ℕ), measurable (fn n)) :
  ∀ (s : set α), (tail_σ_algebra β fn m).measurable_set' s → μ s = 0 ∨ μ s = 1 :=
begin
  /-First show 𝔽₀ⁿ is independent to τ for all n-/
  have h₁ : ∀ (n : ℕ), indep (Fnk_algebra β fn m 0 n) (tail_σ_algebra β fn m) μ,
    /-Intro sets s₁ s₂ in 𝔽₀ⁿ, τ respectively for arbitrary n -/
  { intros n s₁ s₂ hs₁ hs₂,
    /-Sufficient that s₂ is 𝔽ₙ₊₁ measurable as we've already proven 𝔽₀ⁿ and 𝔽ₙ₊₁ are independent-/
    suffices : (Fn_σ_algebra β m fn (n + 1)).measurable_set' s₂,
    { exact (F1nFnaddone_indep β m fn n μ hI h2) s₁ s₂ hs₁ this, },
    exact hs₂ (n + 1),
  },
  /-Second show τ and ⋃ n, 𝔽₀ⁿ are independent-/
  have h₂ : indep_mspace_sets μ (tail_σ_algebra β fn m)
    {s : set α | ∃ (n : ℕ), (Fnk_algebra β fn m 0 n).measurable_set' s},
    /-Intro sets s₁ s₂ in τ and ⋃ n, 𝔽₀ⁿ-/
  { intros s₁ s₂ hs₁ hs₂,
    /-Specify an n s.t. s₂ is 𝔽₀ⁿ measurable-/
    choose n hn using hs₂,
    /-result follows from 𝔽₀ⁿ, τ independence after rearranging-/
    have : μ (s₂ ∩ s₁) = μ s₂ * μ s₁, from h₁ n s₂ s₁ hn hs₁,
    rwa [set.inter_comm s₁ s₂, mul_comm (μ s₁) (μ s₂)],
  },
  /-Third prove τ, 𝔽ₙ are independent-/
  have h₃ : indep (tail_σ_algebra β fn m) (Fn_σ_algebra β m fn 0) μ ,
  { exact (indep_of_gen_of_indep_mspace_sets μ (tail_σ_algebra β fn m)
      {s : set α | ∃ (n : ℕ), (Fnk_algebra β fn m 0 n).measurable_set' s} h₂
      (measurable_prelim β m fn 0 h2)),
  },
  /-Finally show τ is independent with itself-/
  have h₄ : indep (tail_σ_algebra β fn m) (tail_σ_algebra β fn m) μ,
    /-Intros 2 sets in τ-/
  { intros s₁ s₂ hs₁ hs₂,
    /-Show its sufficient that s₂ is 𝔽₀ measurable using independence of 𝔽₀ and τ-/
    suffices : (Fn_σ_algebra β m fn 0).measurable_set' s₂,
      { exact h₃ s₁ s₂ hs₁ this, },
    /-Show s₂ is 𝔽₀ measruable using definition of τ-/
    exact hs₂ 0,
  },
  /-Use earlier self_indep_result to conclude since we now have that τ is self-independent-/
  exact self_Indep_result (tail_σ_algebra β fn m) μ hμ h₄,
end

end probability_theory
end measure_theory
#lint


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import topology.locally_constant.basic

/-!
# Algebraic structure on locally constant functions

This file puts algebraic structure (`add_group`, etc)
on the type of locally constant functions.

-/

namespace locally_constant

variables {X Y : Type*} [topological_space X]

@[to_additive] instance [has_one Y] : has_one (locally_constant X Y) :=
{ one := const X 1 }

@[simp, to_additive] lemma one_apply [has_one Y] (x : X) : (1 : locally_constant X Y) x = 1 := rfl

@[to_additive] instance [has_inv Y] : has_inv (locally_constant X Y) :=
{ inv := λ f, ⟨f⁻¹ , f.is_locally_constant.inv⟩ }

@[simp, to_additive]

@[to_additive] instance [has_mul Y] : has_mul (locally_constant X Y) :=
{ mul := λ f g, ⟨f * g, f.is_locally_constant.mul g.is_locally_constant⟩ }

@[simp, to_additive] lemma mul_apply [has_mul Y] (f g : locally_constant X Y) (x : X) :
  (f * g) x = f x * g x := rfl

@[to_additive] instance [mul_one_class Y] : mul_one_class (locally_constant X Y) :=
{ one_mul := by { intros, ext, simp only [mul_apply, one_apply, one_mul] },
  mul_one := by { intros, ext, simp only [mul_apply, one_apply, mul_one] },
  .. locally_constant.has_one,
  .. locally_constant.has_mul }

instance [mul_zero_class Y] : mul_zero_class (locally_constant X Y) :=
{ zero_mul := by { intros, ext, simp only [mul_apply, zero_apply, zero_mul] },
  mul_zero := by { intros, ext, simp only [mul_apply, zero_apply, mul_zero] },
  .. locally_constant.has_zero,
  .. locally_constant.has_mul }

instance [mul_zero_one_class Y] : mul_zero_one_class (locally_constant X Y) :=
{ .. locally_constant.mul_zero_class, .. locally_constant.mul_one_class }

@[to_additive] instance [has_div Y] : has_div (locally_constant X Y) :=
{ div := λ f g, ⟨f / g, f.is_locally_constant.div g.is_locally_constant⟩ }

@[to_additive] lemma div_apply [has_div Y] (f g : locally_constant X Y) (x : X) :
  (f / g) x = f x / g x := rfl

@[to_additive] instance [semigroup Y] : semigroup (locally_constant X Y) :=
{ mul_assoc := by { intros, ext, simp only [mul_apply, mul_assoc] },
  .. locally_constant.has_mul }

instance [semigroup_with_zero Y] : semigroup_with_zero (locally_constant X Y) :=
{ .. locally_constant.mul_zero_class,
  .. locally_constant.semigroup }

@[to_additive] instance [comm_semigroup Y] : comm_semigroup (locally_constant X Y) :=
{ mul_comm := by { intros, ext, simp only [mul_apply, mul_comm] },
  .. locally_constant.semigroup }

@[to_additive] instance [monoid Y] : monoid (locally_constant X Y) :=
{ mul := (*),
  .. locally_constant.semigroup, .. locally_constant.mul_one_class }

@[to_additive] instance [comm_monoid Y] : comm_monoid (locally_constant X Y) :=
{ .. locally_constant.comm_semigroup, .. locally_constant.monoid }

@[to_additive] instance [group Y] : group (locally_constant X Y) :=
{ mul_left_inv := by { intros, ext, simp only [mul_apply, inv_apply, one_apply, mul_left_inv] },
  div_eq_mul_inv := by { intros, ext, simp only [mul_apply, inv_apply, div_apply, div_eq_mul_inv] },
  .. locally_constant.monoid, .. locally_constant.has_inv, .. locally_constant.has_div }

@[to_additive] instance [comm_group Y] : comm_group (locally_constant X Y) :=
{ .. locally_constant.comm_monoid, .. locally_constant.group }

instance [distrib Y] : distrib (locally_constant X Y) :=
{ left_distrib := by { intros, ext, simp only [mul_apply, add_apply, mul_add] },
  right_distrib := by { intros, ext, simp only [mul_apply, add_apply, add_mul] },
  .. locally_constant.has_add, .. locally_constant.has_mul }

instance [semiring Y] : semiring (locally_constant X Y) :=
{ .. locally_constant.add_comm_monoid, .. locally_constant.monoid,
  .. locally_constant.distrib, .. locally_constant.mul_zero_class }

instance [comm_semiring Y] : comm_semiring (locally_constant X Y) :=
{ .. locally_constant.semiring, .. locally_constant.comm_monoid }

instance [ring Y] : ring (locally_constant X Y) :=
{ .. locally_constant.semiring, .. locally_constant.add_comm_group }

instance [comm_ring Y] : comm_ring (locally_constant X Y) :=
{ .. locally_constant.comm_semiring, .. locally_constant.ring }

end locally_constant


import polyrith

/-! ### Standard Cases over ℤ, ℚ, and ℝ -/

example (x y : ℤ) (h1 : 3*x + 2*y = 10):
  3*x + 2*y = 10 :=
by polyrith

example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
  x*y = -2*y + 1 :=
by polyrith

example (x y : ℝ) (h1 : x + 2 = -3) (h2 : y = 10) :
  -y + 2*x + 4 = -16 :=
by polyrith

example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
    (hc : x + 2*y + z = 2) :
  -3*x - 3*y - 4*z = 2 :=
by polyrith

example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
    (h3 : x + y + 5*z + 5*w = 3) :
  x + 2.2*y + 2*z - 5*w = -8.5 :=
by polyrith

example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
  2*a - 3 + 9*c + 3*d = 8 - b + 3*d - 3*a :=
by polyrith

/-! ### Cases with arbitrary coefficients -/

example (a b : ℤ) (h : a = b) :
  a * a = a * b :=
by polyrith

example (a b c : ℤ) (h : a = b) :
  a * c = b * c :=
by polyrith

example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
  c * a + b = c * b + 1 :=
by polyrith

example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
by polyrith

example {α} [h : comm_ring α] {a b c d e f : α} (h1 : a*d = b*c) (h2 : c*f = e*d) :
  c * (a*f - b*e) = 0 :=
by polyrith

example (x y z w : ℚ) (hzw : z = w) : x*z + 2*y*z = x*w + 2*y*w :=
by polyrith

/-! ### Cases with non-hypothesis inputs/input restrictions -/

example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) (hignore : 3 = a + b) :
  b = 2 / 3 :=
by polyrith only [ha, hab]

constant term : ∀ a b : ℚ, a + b = 0

example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0): a + b + c + d = 0 :=
by polyrith only [term c d, h]

constants (qc : ℚ) (hqc : qc = 2*qc)

example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
by polyrith [h a b, hqc]

constant bad (q : ℚ) : q = 0

example (a b : ℚ) : a + b^3 = 0 :=
by polyrith [bad a, bad (b^2)]

/-! ### Case over arbitrary field -/

example {K : Type*} [field K] [invertible 2] [invertible 3]
  {ω p q r s t x: K} (hp_nonzero : p ≠ 0) (hr : r ^ 2 = q ^ 2 + p ^ 3) (hs3 : s ^ 3 = q + r)
  (ht : t * s = p) (x : K) (H : 1 + ω + ω ^ 2 = 0) :
  x ^ 3 + 3 * p * x - 2 * q =
    (x - (s - t)) * (x - (s * ω - t * ω ^ 2)) * (x - (s * ω ^ 2 - t * ω)) :=
begin
  have hs_nonzero : s ≠ 0,
  { contrapose! hp_nonzero with hs_nonzero,
    polyrith,
     },
  have H' : 2 * q = s ^ 3 - t ^ 3,
  { rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero),
    polyrith,},
  polyrith,
end

/-!
### With trace enabled
Here, the tactic will trace the command that gets sent to sage,
and so the tactic will not succeed
-/

set_option trace.polyrith true

example (x y : ℝ) (h1 : x + 2 = -3) (h2 : y = 10) :
  -y + 2*x + 4 = -16 :=
by polyrith

example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
  c * a + b = c * b + 1 :=
by polyrith

example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0): a + b + c + d = 0 :=
by polyrith only [term c d, h]

example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
by polyrith [h a b, hqc]


import definitions
import fib_mod
import data.int.modeq

lemma luc_odd_of_not_3_div (n : ℕ) : luc (3 * n + 1) % 2 = 1 ∧
luc (3 * n + 2) % 2 = 1 :=
begin
  split,
  { rw ←luc_mod_eq,
    rw luc_mod_2,
    simp,refl,
  },
  { rw ←luc_mod_eq,
    rw luc_mod_2,
    simp,refl,
  }
end
--Prove that v m is not a multiple of 3 if 4 divides m.
lemma luc_coprime_to_3_of_4_div (n : ℕ) : luc (4 * n) % 3 ≠ 0 :=
begin
  rw ←luc_mod_eq,
  rw luc_mod_3,
  -- cases n even or odd
  --case on  (n % 2 = 1)
  suffices H : n % 2 = 0 ∨ n % 2 = 1,
  cases H,
  { -- n % 2 = 0
    suffices H2 : 4 * n % 8 = 0,
      rw H2,
      exact dec_trivial,
      change n ≡ 0 [MOD 2] at H,
      show 4 * n ≡ 0 [MOD 8],
      have a : 2∣n, from nat.modeq.modeq_zero_iff.1 H,
      rw nat.modeq.modeq_zero_iff,
      change 4*2 ∣ 4 * n,
      have q : 4 > 0, by norm_num,
      rw nat.mul_dvd_mul_iff_left q,
      exact a,
  },
  {
  suffices H1: 4 * n % 8 = 4,
  rw H1,
  exact dec_trivial,
  have h2 := nat.mod_add_div n 2,
  rw H at h2,
  rw [←h2,mul_add,←mul_assoc],
  show (4 + 8 * _) % 8 = 4,
  rw nat.add_mul_mod_self_left,
  exact dec_trivial,
  },
  generalize H: n % 2 = k,
   have q2: k < 2,
  {
    have q3: 2 > 0, from dec_trivial,
    have q4 : n % 2 < 2, from nat.mod_lt n q3,
    rw H at q4,
    exact q4,
  },
  {
    clear H,
    revert q2 k,
    exact dec_trivial,
  },

end
/-
#check nat.mul_dvd_mul_iff_left
#check int.coe_nat_dvd
-/
--n : ℕ,
--H : n % 2 = 0
--⊢ 4 * n % 8 = 0

--#check nat.mod

--Prove that v m ≡ 7 mod 8 if m ≡ 4 mod 12 or m ≡ 8 mod 12.


open classical

variable p : Prop
#check em p

theorem dne {p : Prop} (h : ¬¬p) : p :=
or.elim (em p)
    (λ hp: p, hp)
    (λ hnp : ¬p, absurd hnp h)

example (h : ¬¬p) : p :=
by_cases
    (λ h1 : p, h1)
    (λ h2 : ¬p, absurd h2 h)


import Complexes.Structures.Category

/-- A `Groupoid` is defined as a `Category` in which every morphism has an inverse satisfying certain conditions. -/
class Groupoid (S : Sort _) extends Category S where
  inv : {X Y : S} → (X ⟶ Y) → (Y ⟶ X)
  inv_comp_id : {X Y : S} → (g : X ⟶ Y) → (inv g) ≫ g = 𝟙 Y
  comp_inv_id : {X Y : S} → (g : X ⟶ Y) → g ≫ (inv g) = 𝟙 X

namespace Groupoid

open Category

attribute [simp] inv_comp_id
attribute [simp] comp_inv_id

variable {S : Sort _} [G : Groupoid S] {X Y Z : S} (g g' : X ⟶ Y) (h h' : Y ⟶ Z)

postfix:max " ⁻¹ " => Groupoid.inv -- type as `\inv`

@[simp] theorem left_inv_cancel : g⁻¹ ≫ (g ≫ h) = h := by
  rw [← comp_assoc]; simp

@[simp] theorem id_inv : (𝟙 X)⁻¹ = 𝟙 X := by
  have := left_inv_cancel (𝟙 X) (𝟙 X)
  rw [comp_id, comp_id] at this; assumption

@[simp] theorem inv_inv : (g⁻¹)⁻¹ = g := by
  have := left_inv_cancel (g⁻¹) g
  rw [inv_comp_id, comp_id] at this; assumption

@[simp] theorem left_cancel_inv (h : X ⟶ Z) : g ≫ (g⁻¹ ≫ h) = h := by
  have := left_inv_cancel g⁻¹ h
  rw [inv_inv] at this; assumption

@[simp] theorem inv_comp : (g ≫ h)⁻¹ = h⁻¹ ≫ g⁻¹ := by
  have := left_cancel_inv (g ≫ h)⁻¹ (h⁻¹ ≫ g⁻¹)
  simp at this; assumption

@[simp] theorem left_cancel : g ≫ h = g ≫ h' ↔ h = h' :=
  ⟨by
    intro hyp
    have := congrArg (g⁻¹ ≫ ·) hyp
    simp at this
    assumption
  ,
    congrArg _⟩

@[simp] theorem right_cancel : g ≫ h = g' ≫ h ↔ g = g' :=
  ⟨by
    intro hyp
    have := congrArg (· ≫ h⁻¹) hyp
    simp at this
    assumption
  ,
    congrArg (· ≫ h)⟩

@[simp] theorem left_cancel_id : (g = g ≫ e) ↔ 𝟙 Y = e := by
  have := left_cancel g (𝟙 _) e
  simp at this; assumption

@[simp] theorem left_cancel_id' : (g ≫ e = g) ↔ e = 𝟙 Y := by
  have := left_cancel g e (𝟙 Y)
  simp at this; assumption

@[simp] theorem right_cancel_id : (g = e ≫ g) ↔ 𝟙 X = e := by
  have := right_cancel (𝟙 X) e g
  simp at this; assumption

@[simp] theorem right_cancel_id' : (e ≫ g = g) ↔ e = 𝟙 X := by
  have := right_cancel e (𝟙 X) g
  simp at this; assumption

end Groupoid

/-- A `Functor` is a morphism of `Groupoid`s. -/
structure Groupoid.Functor {S S' : Sort _} (G : Groupoid S) (G' : Groupoid S')
    extends Category.Functor G.toCategory G'.toCategory

namespace Groupoid.Functor

variable {R S T : Sort _} [F : Groupoid R] [G : Groupoid S] [H : Groupoid T]
variable (Ψ : Groupoid.Functor F G) (Φ : Groupoid.Functor G H)

@[simp] theorem map_id' {X : S} : Φ.map (𝟙 X) = 𝟙 (Φ.obj X) := by
  have := Φ.map_comp (𝟙 X) (𝟙 X)
  rw [Category.comp_id, right_cancel_id] at this
  exact this.symm

@[simp] theorem map_inv {X Y : S} (g : X ⟶ Y) : Φ.map g⁻¹ = (Φ.map g)⁻¹ := by
  apply (Groupoid.left_cancel (Φ.map g) _ _).mp
  rw [← Φ.map_comp]
  simp

end Groupoid.Functor


/-
Copyright (c) 2019 Kenny Lau, Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes
-/
import data.finset.order
import algebra.direct_sum.module
import ring_theory.free_comm_ring
import ring_theory.ideal.operations
/-!
# Direct limit of modules, abelian groups, rings, and fields.

See Atiyah-Macdonald PP.32-33, Matsumura PP.269-270

Generalizes the notion of "union", or "gluing", of incomparable modules over the same ring,
or incomparable abelian groups, or rings, or fields.

It is constructed as a quotient of the free module (for the module case) or quotient of
the free commutative ring (for the ring case) instead of a quotient of the disjoint union
so as to make the operations (addition etc.) "computable".

-/
universes u v w u₁

open submodule

variables {R : Type u} [ring R]
variables {ι : Type v}
variables [dec_ι : decidable_eq ι] [directed_order ι]
variables (G : ι → Type w)

/-- A directed system is a functor from the category (directed poset) to another category.
This is used for abelian groups and rings and fields because their maps are not bundled.
See module.directed_system -/
class directed_system (f : Π i j, i ≤ j → G i → G j) : Prop :=
(map_self [] : ∀ i x h, f i i h x = x)
(map_map [] : ∀ i j k hij hjk x, f j k hjk (f i j hij x) = f i k (le_trans hij hjk) x)

namespace module

variables [Π i, add_comm_group (G i)] [Π i, module R (G i)]

/-- A directed system is a functor from the category (directed poset) to the category of
`R`-modules. -/
class directed_system (f : Π i j, i ≤ j → G i →ₗ[R] G j) : Prop :=
(map_self [] : ∀ i x h, f i i h x = x)
(map_map [] : ∀ i j k hij hjk x, f j k hjk (f i j hij x) = f i k (le_trans hij hjk) x)

variables (f : Π i j, i ≤ j → G i →ₗ[R] G j)

include dec_ι

/-- The direct limit of a directed system is the modules glued together along the maps. -/
def direct_limit : Type (max v w) :=
direct_sum ι G ⧸ (span R $ { a | ∃ (i j) (H : i ≤ j) x,
  direct_sum.lof R ι G i x - direct_sum.lof R ι G j (f i j H x) = a })

namespace direct_limit

instance : add_comm_group (direct_limit G f) := quotient.add_comm_group _
instance : module R (direct_limit G f) := quotient.module _

instance : inhabited (direct_limit G f) := ⟨0⟩

variables (R ι)
/-- The canonical map from a component to the direct limit. -/
def of (i) : G i →ₗ[R] direct_limit G f :=
(mkq _).comp $ direct_sum.lof R ι G i
variables {R ι G f}

@[simp] lemma of_f {i j hij x} : (of R ι G f j (f i j hij x)) = of R ι G f i x :=
eq.symm $ (submodule.quotient.eq _).2 $ subset_span ⟨i, j, hij, x, rfl⟩

/-- Every element of the direct limit corresponds to some element in
some component of the directed system. -/

@[elab_as_eliminator]
protected theorem induction_on [nonempty ι] {C : direct_limit G f → Prop} (z : direct_limit G f)
  (ih : ∀ i x, C (of R ι G f i x)) : C z :=
let ⟨i, x, h⟩ := exists_of z in h ▸ ih i x

variables {P : Type u₁} [add_comm_group P] [module R P] (g : Π i, G i →ₗ[R] P)
variables (Hg : ∀ i j hij x, g j (f i j hij x) = g i x)
include Hg

variables (R ι G f)
/-- The universal property of the direct limit: maps from the components to another module
that respect the directed system structure (i.e. make some diagram commute) give rise
to a unique map out of the direct limit. -/
def lift : direct_limit G f →ₗ[R] P :=
liftq _ (direct_sum.to_module R ι P g)
  (span_le.2 $ λ a ⟨i, j, hij, x, hx⟩, by rw [← hx, set_like.mem_coe, linear_map.sub_mem_ker_iff,
    direct_sum.to_module_lof, direct_sum.to_module_lof, Hg])
variables {R ι G f}

omit Hg
lemma lift_of {i} (x) : lift R ι G f g Hg (of R ι G f i x) = g i x :=
direct_sum.to_module_lof R _ _

theorem lift_unique [nonempty ι] (F : direct_limit G f →ₗ[R] P) (x) :
  F x = lift R ι G f (λ i, F.comp $ of R ι G f i)
    (λ i j hij x, by rw [linear_map.comp_apply, of_f]; refl) x :=
direct_limit.induction_on x $ λ i x, by rw lift_of; refl

section totalize
open_locale classical
variables (G f)
omit dec_ι

/-- `totalize G f i j` is a linear map from `G i` to `G j`, for *every* `i` and `j`.
If `i ≤ j`, then it is the map `f i j` that comes with the directed system `G`,
and otherwise it is the zero map. -/
noncomputable def totalize : Π i j, G i →ₗ[R] G j :=
λ i j, if h : i ≤ j then f i j h else 0
variables {G f}

lemma totalize_apply (i j x) :
  totalize G f i j x = if h : i ≤ j then f i j h x else 0 :=
if h : i ≤ j
  then by dsimp only [totalize]; rw [dif_pos h, dif_pos h]
  else by dsimp only [totalize]; rw [dif_neg h, dif_neg h, linear_map.zero_apply]
end totalize

variables [directed_system G f]
open_locale classical

lemma to_module_totalize_of_le {x : direct_sum ι G} {i j : ι}
  (hij : i ≤ j) (hx : ∀ k ∈ x.support, k ≤ i) :
  direct_sum.to_module R ι (G j) (λ k, totalize G f k j) x =
  f i j hij (direct_sum.to_module R ι (G i) (λ k, totalize G f k i) x) :=
begin
  rw [← @dfinsupp.sum_single ι G _ _ _ x],
  unfold dfinsupp.sum,
  simp only [linear_map.map_sum],
  refine finset.sum_congr rfl (λ k hk, _),
  rw direct_sum.single_eq_lof R k (x k),
  simp [totalize_apply, hx k hk, le_trans (hx k hk) hij, directed_system.map_map f]
end

lemma of.zero_exact_aux [nonempty ι] {x : direct_sum ι G}
  (H : submodule.quotient.mk x = (0 : direct_limit G f)) :
  ∃ j, (∀ k ∈ x.support, k ≤ j) ∧
    direct_sum.to_module R ι (G j) (λ i, totalize G f i j) x = (0 : G j) :=
nonempty.elim (by apply_instance) $ assume ind : ι,
span_induction ((quotient.mk_eq_zero _).1 H)
  (λ x ⟨i, j, hij, y, hxy⟩, let ⟨k, hik, hjk⟩ := directed_order.directed i j in
    ⟨k, begin
      clear_,
      subst hxy,
      split,
      { intros i0 hi0,
        rw [dfinsupp.mem_support_iff, direct_sum.sub_apply, ← direct_sum.single_eq_lof,
            ← direct_sum.single_eq_lof, dfinsupp.single_apply, dfinsupp.single_apply] at hi0,
        split_ifs at hi0 with hi hj hj, { rwa hi at hik }, { rwa hi at hik }, { rwa hj at hjk },
        exfalso, apply hi0, rw sub_zero },
      simp [linear_map.map_sub, totalize_apply, hik, hjk,
        directed_system.map_map f, direct_sum.apply_eq_component,
        direct_sum.component.of],
    end⟩)
  ⟨ind, λ _ h, (finset.not_mem_empty _ h).elim, linear_map.map_zero _⟩
  (λ x y ⟨i, hi, hxi⟩ ⟨j, hj, hyj⟩,
    let ⟨k, hik, hjk⟩ := directed_order.directed i j in
    ⟨k, λ l hl,
      (finset.mem_union.1 (dfinsupp.support_add hl)).elim
        (λ hl, le_trans (hi _ hl) hik)
        (λ hl, le_trans (hj _ hl) hjk),
      by simp [linear_map.map_add, hxi, hyj,
          to_module_totalize_of_le hik hi,
          to_module_totalize_of_le hjk hj]⟩)
  (λ a x ⟨i, hi, hxi⟩,
    ⟨i, λ k hk, hi k (direct_sum.support_smul _ _ hk),
      by simp [linear_map.map_smul, hxi]⟩)

/-- A component that corresponds to zero in the direct limit is already zero in some
bigger module in the directed system. -/
theorem of.zero_exact {i x} (H : of R ι G f i x = 0) :
  ∃ j hij, f i j hij x = (0 : G j) :=
by haveI : nonempty ι := ⟨i⟩; exact
let ⟨j, hj, hxj⟩ := of.zero_exact_aux H in
if hx0 : x = 0 then ⟨i, le_refl _, by simp [hx0]⟩
else
  have hij : i ≤ j, from hj _ $
    by simp [direct_sum.apply_eq_component, hx0],
  ⟨j, hij, by simpa [totalize_apply, hij] using hxj⟩

end direct_limit

end module

namespace add_comm_group

variables [Π i, add_comm_group (G i)]
include dec_ι

/-- The direct limit of a directed system is the abelian groups glued together along the maps. -/
def direct_limit (f : Π i j, i ≤ j → G i →+ G j) : Type* :=
@module.direct_limit ℤ _ ι _ _ G _ _
  (λ i j hij, (f i j hij).to_int_linear_map)

namespace direct_limit

variables (f : Π i j, i ≤ j → G i →+ G j)

omit dec_ι

protected lemma directed_system [directed_system G (λ i j h, f i j h)] :
  module.directed_system G (λ i j hij, (f i j hij).to_int_linear_map) :=
⟨directed_system.map_self (λ i j h, f i j h), directed_system.map_map (λ i j h, f i j h)⟩

include dec_ι

local attribute [instance] direct_limit.directed_system

instance : add_comm_group (direct_limit G f) :=
module.direct_limit.add_comm_group G (λ i j hij, (f i j hij).to_int_linear_map)

instance : inhabited (direct_limit G f) := ⟨0⟩

/-- The canonical map from a component to the direct limit. -/
def of (i) : G i →ₗ[ℤ] direct_limit G f :=
module.direct_limit.of ℤ ι G (λ i j hij, (f i j hij).to_int_linear_map) i
variables {G f}

@[simp] lemma of_f {i j} (hij) (x) : of G f j (f i j hij x) = of G f i x :=
module.direct_limit.of_f

@[elab_as_eliminator]
protected theorem induction_on [nonempty ι] {C : direct_limit G f → Prop} (z : direct_limit G f)
  (ih : ∀ i x, C (of G f i x)) : C z :=
module.direct_limit.induction_on z ih

/-- A component that corresponds to zero in the direct limit is already zero in some
bigger module in the directed system. -/
theorem of.zero_exact [directed_system G (λ i j h, f i j h)] (i x) (h : of G f i x = 0) :
  ∃ j hij, f i j hij x = 0 :=
module.direct_limit.of.zero_exact h

variables (P : Type u₁) [add_comm_group P]
variables (g : Π i, G i →+ P)
variables (Hg : ∀ i j hij x, g j (f i j hij x) = g i x)

variables (G f)
/-- The universal property of the direct limit: maps from the components to another abelian group
that respect the directed system structure (i.e. make some diagram commute) give rise
to a unique map out of the direct limit. -/
def lift : direct_limit G f →ₗ[ℤ] P :=
module.direct_limit.lift ℤ ι G (λ i j hij, (f i j hij).to_int_linear_map)
  (λ i, (g i).to_int_linear_map) Hg
variables {G f}

@[simp] lemma lift_of (i x) : lift G f P g Hg (of G f i x) = g i x :=
module.direct_limit.lift_of _ _ _

lemma lift_unique [nonempty ι] (F : direct_limit G f →+ P) (x) :
  F x = lift G f P (λ i, F.comp (of G f i).to_add_monoid_hom)
    (λ i j hij x, by simp) x :=
direct_limit.induction_on x $ λ i x, by simp

end direct_limit

end add_comm_group

namespace ring

variables [Π i, comm_ring (G i)]

section
variables (f : Π i j, i ≤ j → G i → G j)

open free_comm_ring

/-- The direct limit of a directed system is the rings glued together along the maps. -/
def direct_limit : Type (max v w) :=
free_comm_ring (Σ i, G i) ⧸ (ideal.span { a |
  (∃ i j H x, of (⟨j, f i j H x⟩ : Σ i, G i) - of ⟨i, x⟩ = a) ∨
  (∃ i, of (⟨i, 1⟩ : Σ i, G i) - 1 = a) ∨
  (∃ i x y, of (⟨i, x + y⟩ : Σ i, G i) - (of ⟨i, x⟩ + of ⟨i, y⟩) = a) ∨
  (∃ i x y, of (⟨i, x * y⟩ : Σ i, G i) - (of ⟨i, x⟩ * of ⟨i, y⟩) = a) })

namespace direct_limit

instance : comm_ring (direct_limit G f) :=
ideal.quotient.comm_ring _

instance : ring (direct_limit G f) :=
comm_ring.to_ring _

instance : inhabited (direct_limit G f) := ⟨0⟩

/-- The canonical map from a component to the direct limit. -/
def of (i) : G i →+* direct_limit G f :=
ring_hom.mk'
{ to_fun := λ x, ideal.quotient.mk _ (of (⟨i, x⟩ : Σ i, G i)),
  map_one' := ideal.quotient.eq.2 $ subset_span $ or.inr $ or.inl ⟨i, rfl⟩,
  map_mul' := λ x y, ideal.quotient.eq.2 $ subset_span $ or.inr $ or.inr $ or.inr ⟨i, x, y, rfl⟩, }
(λ x y, ideal.quotient.eq.2 $ subset_span $ or.inr $ or.inr $ or.inl ⟨i, x, y, rfl⟩)

variables {G f}

@[simp] lemma of_f {i j} (hij) (x) : of G f j (f i j hij x) = of G f i x :=
ideal.quotient.eq.2 $ subset_span $ or.inl ⟨i, j, hij, x, rfl⟩

/-- Every element of the direct limit corresponds to some element in
some component of the directed system. -/
theorem exists_of [nonempty ι] (z : direct_limit G f) : ∃ i x, of G f i x = z :=
nonempty.elim (by apply_instance) $ assume ind : ι,
quotient.induction_on' z $ λ x, free_abelian_group.induction_on x
  ⟨ind, 0, (of _ _ ind).map_zero⟩
  (λ s, multiset.induction_on s
    ⟨ind, 1, (of _ _ ind).map_one⟩
    (λ a s ih, let ⟨i, x⟩ := a, ⟨j, y, hs⟩ := ih, ⟨k, hik, hjk⟩ := directed_order.directed i j in
      ⟨k, f i k hik x * f j k hjk y, by rw [(of _ _ _).map_mul, of_f, of_f, hs]; refl⟩))
  (λ s ⟨i, x, ih⟩, ⟨i, -x, by rw [(of _ _ _).map_neg, ih]; refl⟩)
  (λ p q ⟨i, x, ihx⟩ ⟨j, y, ihy⟩, let ⟨k, hik, hjk⟩ := directed_order.directed i j in
    ⟨k, f i k hik x + f j k hjk y, by rw [(of _ _ _).map_add, of_f, of_f, ihx, ihy]; refl⟩)

section
open_locale classical
open polynomial

variables {f' : Π i j, i ≤ j → G i →+* G j}

theorem polynomial.exists_of [nonempty ι] (q : polynomial (direct_limit G (λ i j h, f' i j h))) :
  ∃ i p, polynomial.map (of G (λ i j h, f' i j h) i) p = q :=
polynomial.induction_on q
  (λ z, let ⟨i, x, h⟩ := exists_of z in ⟨i, C x, by rw [map_C, h]⟩)
  (λ q₁ q₂ ⟨i₁, p₁, ih₁⟩ ⟨i₂, p₂, ih₂⟩, let ⟨i, h1, h2⟩ := directed_order.directed i₁ i₂ in
    ⟨i, p₁.map (f' i₁ i h1) + p₂.map (f' i₂ i h2),
     by { rw [polynomial.map_add, map_map, map_map, ← ih₁, ← ih₂],
      congr' 2; ext x; simp_rw [ring_hom.comp_apply, of_f] }⟩)
  (λ n z ih, let ⟨i, x, h⟩ := exists_of z in ⟨i, C x * X ^ (n + 1),
    by rw [polynomial.map_mul, map_C, h, polynomial.map_pow, map_X]⟩)

end

@[elab_as_eliminator] theorem induction_on [nonempty ι] {C : direct_limit G f → Prop}
  (z : direct_limit G f) (ih : ∀ i x, C (of G f i x)) : C z :=
let ⟨i, x, hx⟩ := exists_of z in hx ▸ ih i x

section of_zero_exact
open_locale classical

variables (f' : Π i j, i ≤ j → G i →+* G j)
variables [directed_system G (λ i j h, f' i j h)]
variables (G f)

lemma of.zero_exact_aux2 {x : free_comm_ring Σ i, G i} {s t} (hxs : is_supported x s) {j k}
  (hj : ∀ z : Σ i, G i, z ∈ s → z.1 ≤ j) (hk : ∀ z : Σ i, G i, z ∈ t → z.1 ≤ k)
  (hjk : j ≤ k) (hst : s ⊆ t) :
  f' j k hjk (lift (λ ix : s, f' ix.1.1 j (hj ix ix.2) ix.1.2) (restriction s x)) =
  lift (λ ix : t, f' ix.1.1 k (hk ix ix.2) ix.1.2) (restriction t x) :=
begin
  refine subring.in_closure.rec_on hxs _ _ _ _,
  { rw [(restriction _).map_one, (free_comm_ring.lift _).map_one, (f' j k hjk).map_one,
        (restriction _).map_one, (free_comm_ring.lift _).map_one] },
  { rw [(restriction _).map_neg, (restriction _).map_one,
        (free_comm_ring.lift _).map_neg, (free_comm_ring.lift _).map_one,
        (f' j k hjk).map_neg, (f' j k hjk).map_one,
        (restriction _).map_neg, (restriction _).map_one,
        (free_comm_ring.lift _).map_neg, (free_comm_ring.lift _).map_one] },
  { rintros _ ⟨p, hps, rfl⟩ n ih,
    rw [(restriction _).map_mul, (free_comm_ring.lift _).map_mul,
        (f' j k hjk).map_mul, ih,
        (restriction _).map_mul, (free_comm_ring.lift _).map_mul,
        restriction_of, dif_pos hps, lift_of, restriction_of, dif_pos (hst hps), lift_of],
    dsimp only,
    have := directed_system.map_map (λ i j h, f' i j h),
    dsimp only at this,
    rw this, refl },
  { rintros x y ihx ihy,
    rw [(restriction _).map_add, (free_comm_ring.lift _).map_add,
        (f' j k hjk).map_add, ihx, ihy,
        (restriction _).map_add, (free_comm_ring.lift _).map_add] }
end
variables {G f f'}

lemma of.zero_exact_aux [nonempty ι] {x : free_comm_ring Σ i, G i}
  (H : ideal.quotient.mk _ x = (0 : direct_limit G (λ i j h, f' i j h))) :
  ∃ j s, ∃ H : (∀ k : Σ i, G i, k ∈ s → k.1 ≤ j), is_supported x s ∧
    lift (λ ix : s, f' ix.1.1 j (H ix ix.2) ix.1.2) (restriction s x) = (0 : G j) :=
begin
  refine span_induction (ideal.quotient.eq_zero_iff_mem.1 H) _ _ _ _,
  { rintros x (⟨i, j, hij, x, rfl⟩ | ⟨i, rfl⟩ | ⟨i, x, y, rfl⟩ | ⟨i, x, y, rfl⟩),
    { refine ⟨j, {⟨i, x⟩, ⟨j, f' i j hij x⟩}, _,
        is_supported_sub (is_supported_of.2 $ or.inr rfl) (is_supported_of.2 $ or.inl rfl), _⟩,
      { rintros k (rfl | ⟨rfl | _⟩), exact hij, refl },
      { rw [(restriction _).map_sub, (free_comm_ring.lift _).map_sub,
            restriction_of, dif_pos, restriction_of, dif_pos, lift_of, lift_of],
        dsimp only,
        have := directed_system.map_map (λ i j h, f' i j h),
        dsimp only at this,
        rw this, exact sub_self _,
        exacts [or.inr rfl, or.inl rfl] } },
    { refine ⟨i, {⟨i, 1⟩}, _, is_supported_sub (is_supported_of.2 rfl) is_supported_one, _⟩,
      { rintros k (rfl|h), refl },
      { rw [(restriction _).map_sub, (free_comm_ring.lift _).map_sub, restriction_of, dif_pos,
          (restriction _).map_one, lift_of, (free_comm_ring.lift _).map_one],
        dsimp only, rw [(f' i i _).map_one, sub_self],
        { exact set.mem_singleton _ } } },
    { refine ⟨i, {⟨i, x+y⟩, ⟨i, x⟩, ⟨i, y⟩}, _,
        is_supported_sub (is_supported_of.2 $ or.inl rfl)
          (is_supported_add (is_supported_of.2 $ or.inr $ or.inl rfl)
            (is_supported_of.2 $ or.inr $ or.inr rfl)), _⟩,
      { rintros k (rfl | ⟨rfl | ⟨rfl | hk⟩⟩); refl },
      { rw [(restriction _).map_sub, (restriction _).map_add,
            restriction_of, restriction_of, restriction_of,
            dif_pos, dif_pos, dif_pos,
            (free_comm_ring.lift _).map_sub, (free_comm_ring.lift _).map_add,
            lift_of, lift_of, lift_of],
        dsimp only, rw (f' i i _).map_add, exact sub_self _,
        exacts [or.inl rfl, or.inr (or.inr rfl), or.inr (or.inl rfl)] } },
    { refine ⟨i, {⟨i, x*y⟩, ⟨i, x⟩, ⟨i, y⟩}, _,
        is_supported_sub (is_supported_of.2 $ or.inl rfl)
          (is_supported_mul (is_supported_of.2 $ or.inr $ or.inl rfl)
            (is_supported_of.2 $ or.inr $ or.inr rfl)), _⟩,
      { rintros k (rfl | ⟨rfl | ⟨rfl | hk⟩⟩); refl },
      { rw [(restriction _).map_sub, (restriction _).map_mul,
            restriction_of, restriction_of, restriction_of,
            dif_pos, dif_pos, dif_pos,
            (free_comm_ring.lift _).map_sub, (free_comm_ring.lift _).map_mul,
            lift_of, lift_of, lift_of],
        dsimp only, rw (f' i i _).map_mul,
        exacts [sub_self _, or.inl rfl, or.inr (or.inr rfl),
          or.inr (or.inl rfl)] } } },
  { refine nonempty.elim (by apply_instance) (assume ind : ι, _),
    refine ⟨ind, ∅, λ _, false.elim, is_supported_zero, _⟩,
    rw [(restriction _).map_zero, (free_comm_ring.lift _).map_zero] },
  { rintros x y ⟨i, s, hi, hxs, ihs⟩ ⟨j, t, hj, hyt, iht⟩,
    rcases directed_order.directed i j with ⟨k, hik, hjk⟩,
    have : ∀ z : Σ i, G i, z ∈ s ∪ t → z.1 ≤ k,
    { rintros z (hz | hz), exact le_trans (hi z hz) hik, exact le_trans (hj z hz) hjk },
    refine ⟨k, s ∪ t, this, is_supported_add (is_supported_upwards hxs $ set.subset_union_left s t)
      (is_supported_upwards hyt $ set.subset_union_right s t), _⟩,
    { rw [(restriction _).map_add, (free_comm_ring.lift _).map_add,
        ← of.zero_exact_aux2 G f' hxs hi this hik (set.subset_union_left s t),
        ← of.zero_exact_aux2 G f' hyt hj this hjk (set.subset_union_right s t),
        ihs, (f' i k hik).map_zero, iht, (f' j k hjk).map_zero, zero_add] } },
  { rintros x y ⟨j, t, hj, hyt, iht⟩, rw smul_eq_mul,
    rcases exists_finset_support x with ⟨s, hxs⟩,
    rcases (s.image sigma.fst).exists_le with ⟨i, hi⟩,
    rcases directed_order.directed i j with ⟨k, hik, hjk⟩,
    have : ∀ z : Σ i, G i, z ∈ ↑s ∪ t → z.1 ≤ k,
    { rintros z (hz | hz),
      exacts [(hi z.1 $ finset.mem_image.2 ⟨z, hz, rfl⟩).trans hik, (hj z hz).trans hjk] },
    refine ⟨k, ↑s ∪ t, this, is_supported_mul
      (is_supported_upwards hxs $ set.subset_union_left ↑s t)
      (is_supported_upwards hyt $ set.subset_union_right ↑s t), _⟩,
    rw [(restriction _).map_mul, (free_comm_ring.lift _).map_mul,
        ← of.zero_exact_aux2 G f' hyt hj this hjk (set.subset_union_right ↑s t),
        iht, (f' j k hjk).map_zero, mul_zero] }
end

/-- A component that corresponds to zero in the direct limit is already zero in some
bigger module in the directed system. -/
lemma of.zero_exact {i x} (hix : of G (λ i j h, f' i j h) i x = 0) :
  ∃ j (hij : i ≤ j), f' i j hij x = 0 :=
by haveI : nonempty ι := ⟨i⟩; exact
let ⟨j, s, H, hxs, hx⟩ := of.zero_exact_aux hix in
have hixs : (⟨i, x⟩ : Σ i, G i) ∈ s, from is_supported_of.1 hxs,
⟨j, H ⟨i, x⟩ hixs, by rw [restriction_of, dif_pos hixs, lift_of] at hx; exact hx⟩
end of_zero_exact

variables (f' : Π i j, i ≤ j → G i →+* G j)

/-- If the maps in the directed system are injective, then the canonical maps
from the components to the direct limits are injective. -/
theorem of_injective [directed_system G (λ i j h, f' i j h)]
  (hf : ∀ i j hij, function.injective (f' i j hij)) (i) :
  function.injective (of G (λ i j h, f' i j h) i) :=
begin
  suffices : ∀ x, of G (λ i j h, f' i j h) i x = 0 → x = 0,
  { intros x y hxy, rw ← sub_eq_zero, apply this,
    rw [(of G _ i).map_sub, hxy, sub_self] },
  intros x hx, rcases of.zero_exact hx with ⟨j, hij, hfx⟩,
  apply hf i j hij, rw [hfx, (f' i j hij).map_zero]
end

variables (P : Type u₁) [comm_ring P]
variables (g : Π i, G i →+* P)
variables (Hg : ∀ i j hij x, g j (f i j hij x) = g i x)
include Hg

open free_comm_ring

variables (G f)
/-- The universal property of the direct limit: maps from the components to another ring
that respect the directed system structure (i.e. make some diagram commute) give rise
to a unique map out of the direct limit.
-/
def lift : direct_limit G f →+* P :=
ideal.quotient.lift _ (free_comm_ring.lift $ λ (x : Σ i, G i), g x.1 x.2) begin
  suffices : ideal.span _ ≤
    ideal.comap (free_comm_ring.lift (λ (x : Σ (i : ι), G i), g (x.fst) (x.snd))) ⊥,
  { intros x hx, exact (mem_bot P).1 (this hx) },
  rw ideal.span_le, intros x hx,
  rw [set_like.mem_coe, ideal.mem_comap, mem_bot],
  rcases hx with ⟨i, j, hij, x, rfl⟩ | ⟨i, rfl⟩ | ⟨i, x, y, rfl⟩ | ⟨i, x, y, rfl⟩;
  simp only [ring_hom.map_sub, lift_of, Hg, ring_hom.map_one, ring_hom.map_add, ring_hom.map_mul,
      (g i).map_one, (g i).map_add, (g i).map_mul, sub_self]
end

variables {G f}
omit Hg

@[simp] lemma lift_of (i x) : lift G f P g Hg (of G f i x) = g i x := free_comm_ring.lift_of _ _

theorem lift_unique [nonempty ι] (F : direct_limit G f →+* P) (x) :
  F x = lift G f P (λ i, F.comp $ of G f i) (λ i j hij x, by simp) x :=
direct_limit.induction_on x $ λ i x, by simp

end direct_limit

end

end ring

namespace field

variables [nonempty ι] [Π i, field (G i)]
variables (f : Π i j, i ≤ j → G i → G j)
variables (f' : Π i j, i ≤ j → G i →+* G j)

namespace direct_limit

instance nontrivial [directed_system G (λ i j h, f' i j h)] :
  nontrivial (ring.direct_limit G (λ i j h, f' i j h)) :=
⟨⟨0, 1, nonempty.elim (by apply_instance) $ assume i : ι, begin
  change (0 : ring.direct_limit G (λ i j h, f' i j h)) ≠ 1,
  rw ← (ring.direct_limit.of _ _ _).map_one,
  intros H, rcases ring.direct_limit.of.zero_exact H.symm with ⟨j, hij, hf⟩,
  rw (f' i j hij).map_one at hf,
  exact one_ne_zero hf
end ⟩⟩

theorem exists_inv {p : ring.direct_limit G f} : p ≠ 0 → ∃ y, p * y = 1 :=
ring.direct_limit.induction_on p $ λ i x H,
⟨ring.direct_limit.of G f i (x⁻¹), by erw [← (ring.direct_limit.of _ _ _).map_mul,
    mul_inv_cancel (assume h : x = 0, H $ by rw [h, (ring.direct_limit.of _ _ _).map_zero]),
    (ring.direct_limit.of _ _ _).map_one]⟩

section
open_locale classical

/-- Noncomputable multiplicative inverse in a direct limit of fields. -/
noncomputable def inv (p : ring.direct_limit G f) : ring.direct_limit G f :=
if H : p = 0 then 0 else classical.some (direct_limit.exists_inv G f H)

protected theorem mul_inv_cancel {p : ring.direct_limit G f} (hp : p ≠ 0) : p * inv G f p = 1 :=
by rw [inv, dif_neg hp, classical.some_spec (direct_limit.exists_inv G f hp)]

protected theorem inv_mul_cancel {p : ring.direct_limit G f} (hp : p ≠ 0) : inv G f p * p = 1 :=
by rw [_root_.mul_comm, direct_limit.mul_inv_cancel G f hp]

/-- Noncomputable field structure on the direct limit of fields.
See note [reducible non-instances]. -/
@[reducible]
protected noncomputable def field [directed_system G (λ i j h, f' i j h)] :
  field (ring.direct_limit G (λ i j h, f' i j h)) :=
{ inv := inv G (λ i j h, f' i j h),
  mul_inv_cancel := λ p, direct_limit.mul_inv_cancel G (λ i j h, f' i j h),
  inv_zero := dif_pos rfl,
  .. ring.direct_limit.comm_ring G (λ i j h, f' i j h),
  .. direct_limit.nontrivial G (λ i j h, f' i j h) }

end

end direct_limit

end field


/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro,
Scott Morrison
-/
import data.list.count
import data.list.infix

/-!
# Lattice structure of lists

This files prove basic properties about `list.disjoint`, `list.union`, `list.inter` and
`list.bag_inter`, which are defined in core Lean and `data.list.defs`.

`l₁ ∪ l₂` is the list where all elements of `l₁` have been inserted in `l₂` in order. For example,
`[0, 0, 1, 2, 2, 3] ∪ [4, 3, 3, 0] = [1, 2, 4, 3, 3, 0]`

`l₁ ∩ l₂` is the list of elements of `l₁` in order which are in `l₂`. For example,
`[0, 0, 1, 2, 2, 3] ∪ [4, 3, 3, 0] = [0, 0, 3]`

`bag_inter l₁ l₂` is the list of elements that are in both `l₁` and `l₂`, counted with multiplicity
and in the order they appear in `l₁`. As opposed to `list.inter`, `list.bag_inter` copes well with
multiplicity. For example,
`bag_inter [0, 1, 2, 3, 2, 1, 0] [1, 0, 1, 4, 3] = [0, 1, 3, 1]`
-/

open nat

namespace list
variables {α : Type*} {l l₁ l₂ : list α} {p : α → Prop} {a : α}

/-! ### `disjoint` -/

section disjoint

lemma disjoint.symm (d : disjoint l₁ l₂) : disjoint l₂ l₁ := λ a i₂ i₁, d i₁ i₂

lemma disjoint_comm : disjoint l₁ l₂ ↔ disjoint l₂ l₁ := ⟨disjoint.symm, disjoint.symm⟩

lemma disjoint_left : disjoint l₁ l₂ ↔ ∀ ⦃a⦄, a ∈ l₁ → a ∉ l₂ := iff.rfl

lemma disjoint_right : disjoint l₁ l₂ ↔ ∀ ⦃a⦄, a ∈ l₂ → a ∉ l₁ := disjoint_comm

lemma disjoint_iff_ne : disjoint l₁ l₂ ↔ ∀ a ∈ l₁, ∀ b ∈ l₂, a ≠ b :=
by simp only [disjoint_left, imp_not_comm, forall_eq']

lemma disjoint_of_subset_left (ss : l₁ ⊆ l) (d : disjoint l l₂) : disjoint l₁ l₂ := λ x m, d (ss m)

lemma disjoint_of_subset_right (ss : l₂ ⊆ l) (d : disjoint l₁ l) : disjoint l₁ l₂ :=
λ x m m₁, d m (ss m₁)

lemma disjoint_of_disjoint_cons_left {l₁ l₂} : disjoint (a :: l₁) l₂ → disjoint l₁ l₂ :=
disjoint_of_subset_left (list.subset_cons _ _)

lemma disjoint_of_disjoint_cons_right {l₁ l₂} : disjoint l₁ (a :: l₂) → disjoint l₁ l₂ :=
disjoint_of_subset_right (list.subset_cons _ _)

@[simp] lemma disjoint_nil_left (l : list α) : disjoint [] l := λ a, (not_mem_nil a).elim

@[simp] lemma disjoint_nil_right (l : list α) : disjoint l [] :=
by { rw disjoint_comm, exact disjoint_nil_left _ }

@[simp, priority 1100] lemma singleton_disjoint : disjoint [a] l ↔ a ∉ l :=
by { simp only [disjoint, mem_singleton, forall_eq], refl }

@[simp, priority 1100] lemma disjoint_singleton : disjoint l [a] ↔ a ∉ l :=
by rw [disjoint_comm, singleton_disjoint]

@[simp] lemma disjoint_append_left : disjoint (l₁ ++ l₂) l ↔ disjoint l₁ l ∧ disjoint l₂ l :=
by simp only [disjoint, mem_append, or_imp_distrib, forall_and_distrib]

@[simp] lemma disjoint_append_right : disjoint l (l₁ ++ l₂) ↔ disjoint l l₁ ∧ disjoint l l₂ :=
disjoint_comm.trans $ by simp only [disjoint_comm, disjoint_append_left]

@[simp] lemma disjoint_cons_left : disjoint (a :: l₁) l₂ ↔ a ∉ l₂ ∧ disjoint l₁ l₂ :=
(@disjoint_append_left _ l₂ [a] l₁).trans $ by simp only [singleton_disjoint]

@[simp] lemma disjoint_cons_right : disjoint l₁ (a :: l₂) ↔ a ∉ l₁ ∧ disjoint l₁ l₂ :=
disjoint_comm.trans $ by simp only [disjoint_comm, disjoint_cons_left]

lemma disjoint_of_disjoint_append_left_left (d : disjoint (l₁ ++ l₂) l) : disjoint l₁ l :=
(disjoint_append_left.1 d).1

lemma disjoint_of_disjoint_append_left_right (d : disjoint (l₁ ++ l₂) l) : disjoint l₂ l :=
(disjoint_append_left.1 d).2

lemma disjoint_of_disjoint_append_right_left (d : disjoint l (l₁ ++ l₂)) : disjoint l l₁ :=
(disjoint_append_right.1 d).1

lemma disjoint_of_disjoint_append_right_right (d : disjoint l (l₁ ++ l₂)) : disjoint l l₂ :=
(disjoint_append_right.1 d).2

lemma disjoint_take_drop {m n : ℕ} (hl : l.nodup) (h : m ≤ n) : disjoint (l.take m) (l.drop n) :=
begin
  induction l generalizing m n,
  case list.nil : m n
  { simp },
  case list.cons : x xs xs_ih m n
  { cases m; cases n; simp only [disjoint_cons_left, mem_cons_iff, disjoint_cons_right, drop,
                                 true_or, eq_self_iff_true, not_true, false_and,
                                 disjoint_nil_left, take],
    { cases h },
    cases hl with _ _ h₀ h₁, split,
    { intro h, exact h₀ _ (mem_of_mem_drop h) rfl, },
    solve_by_elim [le_of_succ_le_succ] { max_depth := 4 } },
end

end disjoint

variable [decidable_eq α]

/-! ### `union` -/

section union

@[simp] lemma nil_union (l : list α) : [] ∪ l = l := rfl

@[simp] lemma cons_union (l₁ l₂ : list α) (a : α) : a :: l₁ ∪ l₂ = insert a (l₁ ∪ l₂) := rfl

@[simp] lemma mem_union : a ∈ l₁ ∪ l₂ ↔ a ∈ l₁ ∨ a ∈ l₂ :=
by induction l₁; simp only [nil_union, not_mem_nil, false_or, cons_union, mem_insert_iff,
  mem_cons_iff, or_assoc, *]

lemma mem_union_left (h : a ∈ l₁) (l₂ : list α) : a ∈ l₁ ∪ l₂ := mem_union.2 (or.inl h)

lemma mem_union_right (l₁ : list α) (h : a ∈ l₂) : a ∈ l₁ ∪ l₂ := mem_union.2 (or.inr h)

lemma sublist_suffix_of_union : ∀ l₁ l₂ : list α, ∃ t, t <+ l₁ ∧ t ++ l₂ = l₁ ∪ l₂
| [] l₂ := ⟨[], by refl, rfl⟩
| (a :: l₁) l₂ := let ⟨t, s, e⟩ := sublist_suffix_of_union l₁ l₂ in
  if h : a ∈ l₁ ∪ l₂
  then ⟨t, sublist_cons_of_sublist _ s, by simp only [e, cons_union, insert_of_mem h]⟩
  else ⟨a::t, s.cons_cons _, by simp only [cons_append, cons_union, e, insert_of_not_mem h];
    split; refl⟩

lemma suffix_union_right (l₁ l₂ : list α) : l₂ <:+ l₁ ∪ l₂ :=
(sublist_suffix_of_union l₁ l₂).imp (λ a, and.right)

lemma union_sublist_append (l₁ l₂ : list α) : l₁ ∪ l₂ <+ l₁ ++ l₂ :=
let ⟨t, s, e⟩ := sublist_suffix_of_union l₁ l₂ in
e ▸ (append_sublist_append_right _).2 s

lemma forall_mem_union : (∀ x ∈ l₁ ∪ l₂, p x) ↔ (∀ x ∈ l₁, p x) ∧ (∀ x ∈ l₂, p x) :=
by simp only [mem_union, or_imp_distrib, forall_and_distrib]

lemma forall_mem_of_forall_mem_union_left (h : ∀ x ∈ l₁ ∪ l₂, p x) : ∀ x ∈ l₁, p x :=
(forall_mem_union.1 h).1

lemma forall_mem_of_forall_mem_union_right
   (h : ∀ x ∈ l₁ ∪ l₂, p x) : ∀ x ∈ l₂, p x :=
(forall_mem_union.1 h).2

end union

/-! ### `inter` -/

section inter

@[simp] lemma inter_nil (l : list α) : [] ∩ l = [] := rfl

@[simp] lemma inter_cons_of_mem (l₁ : list α) (h : a ∈ l₂) :
  (a :: l₁) ∩ l₂ = a :: (l₁ ∩ l₂) :=
if_pos h

@[simp] lemma inter_cons_of_not_mem (l₁ : list α) (h : a ∉ l₂) :
  (a :: l₁) ∩ l₂ = l₁ ∩ l₂ :=
if_neg h

lemma mem_of_mem_inter_left : a ∈ l₁ ∩ l₂ → a ∈ l₁ := mem_of_mem_filter

lemma mem_of_mem_inter_right : a ∈ l₁ ∩ l₂ → a ∈ l₂ := of_mem_filter

lemma mem_inter_of_mem_of_mem : a ∈ l₁ → a ∈ l₂ → a ∈ l₁ ∩ l₂ :=
mem_filter_of_mem

@[simp] lemma mem_inter : a ∈ l₁ ∩ l₂ ↔ a ∈ l₁ ∧ a ∈ l₂ := mem_filter

lemma inter_subset_left (l₁ l₂ : list α) : l₁ ∩ l₂ ⊆ l₁ := filter_subset _

lemma inter_subset_right (l₁ l₂ : list α) : l₁ ∩ l₂ ⊆ l₂ := λ a, mem_of_mem_inter_right

lemma subset_inter {l l₁ l₂ : list α} (h₁ : l ⊆ l₁) (h₂ : l ⊆ l₂) : l ⊆ l₁ ∩ l₂ :=
λ a h, mem_inter.2 ⟨h₁ h, h₂ h⟩

lemma inter_eq_nil_iff_disjoint : l₁ ∩ l₂ = [] ↔ disjoint l₁ l₂ :=
by { simp only [eq_nil_iff_forall_not_mem, mem_inter, not_and], refl }

lemma forall_mem_inter_of_forall_left (h : ∀ x ∈ l₁, p x)
  (l₂ : list α) :
  ∀ x, x ∈ l₁ ∩ l₂ → p x :=
ball.imp_left (λ x, mem_of_mem_inter_left) h

lemma forall_mem_inter_of_forall_right (l₁ : list α)
  (h : ∀ x ∈ l₂, p x) :
  ∀ x, x ∈ l₁ ∩ l₂ → p x :=
ball.imp_left (λ x, mem_of_mem_inter_right) h

@[simp] lemma inter_reverse {xs ys : list α} : xs.inter ys.reverse = xs.inter ys :=
by simp only [list.inter, mem_reverse]

end inter

/-! ### `bag_inter` -/

section bag_inter

@[simp] lemma nil_bag_inter (l : list α) : [].bag_inter l = [] :=
by cases l; refl

@[simp] lemma bag_inter_nil (l : list α) : l.bag_inter [] = [] :=
by cases l; refl

@[simp] lemma cons_bag_inter_of_pos (l₁ : list α) (h : a ∈ l₂) :
  (a :: l₁).bag_inter l₂ = a :: l₁.bag_inter (l₂.erase a) :=
by cases l₂; exact if_pos h

@[simp] lemma cons_bag_inter_of_neg (l₁ : list α) (h : a ∉ l₂) :
  (a :: l₁).bag_inter l₂ = l₁.bag_inter l₂ :=
begin
  cases l₂, {simp only [bag_inter_nil]},
  simp only [erase_of_not_mem h, list.bag_inter, if_neg h]
end

@[simp] lemma mem_bag_inter {a : α} : ∀ {l₁ l₂ : list α}, a ∈ l₁.bag_inter l₂ ↔ a ∈ l₁ ∧ a ∈ l₂
| []        l₂ := by simp only [nil_bag_inter, not_mem_nil, false_and]
| (b :: l₁) l₂ := begin
    by_cases b ∈ l₂,
    { rw [cons_bag_inter_of_pos _ h, mem_cons_iff, mem_cons_iff, mem_bag_inter],
      by_cases ba : a = b,
      { simp only [ba, h, eq_self_iff_true, true_or, true_and] },
      { simp only [mem_erase_of_ne ba, ba, false_or] } },
    { rw [cons_bag_inter_of_neg _ h, mem_bag_inter, mem_cons_iff, or_and_distrib_right],
      symmetry, apply or_iff_right_of_imp,
      rintro ⟨rfl, h'⟩, exact h.elim h' }
  end

@[simp] lemma count_bag_inter {a : α} :
  ∀ {l₁ l₂ : list α}, count a (l₁.bag_inter l₂) = min (count a l₁) (count a l₂)
| []         l₂         := by simp
| l₁         []         := by simp
| (h₁ :: l₁) (h₂ :: l₂) :=
begin
  simp only [list.bag_inter, list.mem_cons_iff],
  by_cases p₁ : h₂ = h₁; by_cases p₂ : h₁ = a,
  { simp only [p₁, p₂, count_bag_inter, min_succ_succ, erase_cons_head, if_true, mem_cons_iff,
               count_cons_self, true_or, eq_self_iff_true] },
  { simp only [p₁, ne.symm p₂, count_bag_inter, count_cons, erase_cons_head, if_true, mem_cons_iff,
               true_or, eq_self_iff_true, if_false] },
  { rw p₂ at p₁,
    by_cases p₃ : a ∈ l₂,
    { simp only [p₁, ne.symm p₁, p₂, p₃, erase_cons, count_bag_inter, eq.symm (min_succ_succ _ _),
                 succ_pred_eq_of_pos (count_pos.2 p₃), if_true, mem_cons_iff, false_or,
                 count_cons_self, eq_self_iff_true, if_false, ne.def, not_false_iff,
                 count_erase_self, list.count_cons_of_ne] },
    { simp [ne.symm p₁, p₂, p₃] } },
  { by_cases p₄ : h₁ ∈ l₂; simp only [ne.symm p₁, ne.symm p₂, p₄, count_bag_inter, if_true,
      if_false, mem_cons_iff, false_or, eq_self_iff_true, ne.def, not_false_iff,count_erase_of_ne,
      count_cons_of_ne] }
end

lemma bag_inter_nil_iff_inter_nil : ∀ l₁ l₂ : list α, l₁.bag_inter l₂ = [] ↔ l₁ ∩ l₂ = []
| []        l₂ := by simp
| (b :: l₁) l₂ :=
begin
  by_cases h : b ∈ l₂; simp [h],
  exact bag_inter_nil_iff_inter_nil l₁ l₂
end

end bag_inter
end list