/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Alexander Bentkamp, Anne Baanen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.finsupp
import Mathlib.order.zorn
import Mathlib.data.finset.order
import Mathlib.data.equiv.fin
import Mathlib.PostPort

universes u_1 u_3 u_5 u_2 u_6 u u_4

namespace Mathlib

/-!

# Linear independence

This file defines linear independence in a module or vector space.

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

We define `linear_independent R v` as `ker (finsupp.total ι M R v) = ⊥`. Here `finsupp.total` is the
linear map sending a function `f : ι →₀ R` with finite support to the linear combination of vectors
from `v` with these coefficients. Then we prove that several other statements are equivalent to this
one, including injectivity of `finsupp.total ι M R v` and some versions with explicitly written
linear combinations.

## Main definitions

All definitions are given for families of vectors, i.e. `v : ι → M` where `M` is the module or
vector space and `ι : Type*` is an arbitrary indexing type.

* `linear_independent R v` states that the elements of the family `v` are linearly independent.

* `linear_independent.repr hv x` returns the linear combination representing `x : span R (range v)`
on the linearly independent vectors `v`, given `hv : linear_independent R v`
(using classical choice). `linear_independent.repr hv` is provided as a linear map.

## Main statements

We prove several specialized tests for linear independence of families of vectors and of sets of
vectors.

* `fintype.linear_independent_iff`: if `ι` is a finite type, then any function `f : ι → R` has
  finite support, so we can reformulate the statement using `∑ i : ι, f i • v i` instead of a sum
  over an auxiliary `s : finset ι`;
* `linear_independent_empty_type`: a family indexed by an empty type is linearly independent;
* `linear_independent_unique_iff`: if `ι` is a singleton, then `linear_independent K v` is
  equivalent to `v (default ι) ≠ 0`;
* linear_independent_option`, `linear_independent_sum`, `linear_independent_fin_cons`,
  `linear_independent_fin_succ`: type-specific tests for linear independence of families of vector
  fields;
* `linear_independent_insert`, `linear_independent_union`, `linear_independent_pair`,
  `linear_independent_singleton`: linear independence tests for set operations.

In many cases we additionally provide dot-style operations (e.g., `linear_independent.union`) to
make the linear independence tests usable as `hv.insert ha` etc.

We also prove that any family of vectors includes a linear independent subfamily spanning the same
submodule.

## Implementation notes

We use families instead of sets because it allows us to say that two identical vectors are linearly
dependent.

If you want to use sets, use the family `(λ x, x : s → M)` given a set `s : set M`. The lemmas
`linear_independent.to_subtype_range` and `linear_independent.of_subtype_range` connect those two
worlds.

## Tags

linearly dependent, linear dependence, linearly independent, linear independence

-/

/-- `linear_independent R v` states the family of vectors `v` is linearly independent over `R`. -/
def linear_independent {ι : Type u_1} (R : Type u_3) {M : Type u_5} (v : ι → M) [ring R]
    [add_comm_group M] [module R M] :=
  linear_map.ker (finsupp.total ι M R v) = ⊥

theorem linear_independent_iff {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R]
    [add_comm_group M] [module R M] :
    linear_independent R v ↔ ∀ (l : ι →₀ R), coe_fn (finsupp.total ι M R v) l = 0 → l = 0 :=
  sorry

theorem linear_independent_iff_injective_total {ι : Type u_1} {R : Type u_3} {M : Type u_5}
    {v : ι → M} [ring R] [add_comm_group M] [module R M] :
    linear_independent R v ↔ function.injective ⇑(finsupp.total ι M R v) :=
  iff.trans linear_independent_iff
    (iff.symm (add_monoid_hom.injective_iff (linear_map.to_add_monoid_hom (finsupp.total ι M R v))))

theorem linear_independent.injective_total {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] :
    linear_independent R v → function.injective ⇑(finsupp.total ι M R v) :=
  iff.mp linear_independent_iff_injective_total

theorem linear_independent_iff' {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R]
    [add_comm_group M] [module R M] :
    linear_independent R v ↔
        ∀ (s : finset ι) (g : ι → R),
          (finset.sum s fun (i : ι) => g i • v i) = 0 → ∀ (i : ι), i ∈ s → g i = 0 :=
  sorry

theorem linear_independent_iff'' {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R]
    [add_comm_group M] [module R M] :
    linear_independent R v ↔
        ∀ (s : finset ι) (g : ι → R),
          (∀ (i : ι), ¬i ∈ s → g i = 0) →
            (finset.sum s fun (i : ι) => g i • v i) = 0 → ∀ (i : ι), g i = 0 :=
  sorry

theorem linear_dependent_iff {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R]
    [add_comm_group M] [module R M] :
    ¬linear_independent R v ↔
        ∃ (s : finset ι),
          ∃ (g : ι → R),
            (finset.sum s fun (i : ι) => g i • v i) = 0 ∧ ∃ (i : ι), ∃ (H : i ∈ s), g i ≠ 0 :=
  sorry

theorem fintype.linear_independent_iff {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] [fintype ι] :
    linear_independent R v ↔
        ∀ (g : ι → R), (finset.sum finset.univ fun (i : ι) => g i • v i) = 0 → ∀ (i : ι), g i = 0 :=
  sorry

theorem linear_independent_empty_type {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] (h : ¬Nonempty ι) : linear_independent R v :=
  eq.mpr (id (Eq._oldrec (Eq.refl (linear_independent R v)) (propext linear_independent_iff)))
    fun (l : ι →₀ R) (ᾰ : coe_fn (finsupp.total ι M R v) l = 0) =>
      finsupp.ext fun (i : ι) => false.elim (h (Nonempty.intro i))

theorem linear_independent.ne_zero {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R]
    [add_comm_group M] [module R M] [nontrivial R] (i : ι) (hv : linear_independent R v) :
    v i ≠ 0 :=
  sorry

/-- A subfamily of a linearly independent family (i.e., a composition with an injective map) is a
linearly independent family. -/
theorem linear_independent.comp {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5}
    {v : ι → M} [ring R] [add_comm_group M] [module R M] (h : linear_independent R v) (f : ι' → ι)
    (hf : function.injective f) : linear_independent R (v ∘ f) :=
  sorry

/-- If `v` is a linearly independent family of vectors and the kernel of a linear map `f` is
disjoint with the sumodule spaned by the vectors of `v`, then `f ∘ v` is a linearly independent
family of vectors. See also `linear_independent.map'` for a special case assuming `ker f = ⊥`. -/
theorem linear_independent.map {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6}
    {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M']
    (hv : linear_independent R v) {f : linear_map R M M'}
    (hf_inj : disjoint (submodule.span R (set.range v)) (linear_map.ker f)) :
    linear_independent R (⇑f ∘ v) :=
  sorry

/-- An injective linear map sends linearly independent families of vectors to linearly independent
families of vectors. See also `linear_independent.map` for a more general statement. -/
theorem linear_independent.map' {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6}
    {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M']
    (hv : linear_independent R v) (f : linear_map R M M') (hf_inj : linear_map.ker f = ⊥) :
    linear_independent R (⇑f ∘ v) :=
  sorry

/-- If the image of a family of vectors under a linear map is linearly independent, then so is
the original family. -/
theorem linear_independent.of_comp {ι : Type u_1} {R : Type u_3} {M : Type u_5} {M' : Type u_6}
    {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M] [module R M']
    (f : linear_map R M M') (hfv : linear_independent R (⇑f ∘ v)) : linear_independent R v :=
  sorry

/-- If `f` is an injective linear map, then the family `f ∘ v` is linearly independent
if and only if the family `v` is linearly independent. -/
protected theorem linear_map.linear_independent_iff {ι : Type u_1} {R : Type u_3} {M : Type u_5}
    {M' : Type u_6} {v : ι → M} [ring R] [add_comm_group M] [add_comm_group M'] [module R M]
    [module R M'] (f : linear_map R M M') (hf_inj : linear_map.ker f = ⊥) :
    linear_independent R (⇑f ∘ v) ↔ linear_independent R v :=
  sorry

theorem linear_independent_of_subsingleton {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] [subsingleton R] : linear_independent R v :=
  iff.mpr linear_independent_iff
    fun (l : ι →₀ R) (hl : coe_fn (finsupp.total ι M R v) l = 0) => subsingleton.elim l 0

theorem linear_independent.injective {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] [nontrivial R] (hv : linear_independent R v) :
    function.injective v :=
  sorry

theorem linear_independent_equiv {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5}
    [ring R] [add_comm_group M] [module R M] (e : ι ≃ ι') {f : ι' → M} :
    linear_independent R (f ∘ ⇑e) ↔ linear_independent R f :=
  sorry

theorem linear_independent_equiv' {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5}
    [ring R] [add_comm_group M] [module R M] (e : ι ≃ ι') {f : ι' → M} {g : ι → M}
    (h : f ∘ ⇑e = g) : linear_independent R g ↔ linear_independent R f :=
  h ▸ linear_independent_equiv e

theorem linear_independent_subtype_range {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M]
    [module R M] {ι : Type u_1} {f : ι → M} (hf : function.injective f) :
    linear_independent R coe ↔ linear_independent R f :=
  iff.symm (linear_independent_equiv' (equiv.set.range f hf) rfl)

theorem linear_independent.of_subtype_range {R : Type u_3} {M : Type u_5} [ring R]
    [add_comm_group M] [module R M] {ι : Type u_1} {f : ι → M} (hf : function.injective f) :
    linear_independent R coe → linear_independent R f :=
  iff.mp (linear_independent_subtype_range hf)

theorem linear_independent.to_subtype_range {R : Type u_3} {M : Type u_5} [ring R]
    [add_comm_group M] [module R M] {ι : Type u_1} {f : ι → M} (hf : linear_independent R f) :
    linear_independent R coe :=
  or.dcases_on (subsingleton_or_nontrivial R)
    (fun (_inst : subsingleton R) =>
      eq.mpr (id (propext (iff_true_intro linear_independent_of_subsingleton))) trivial)
    fun (_inst : nontrivial R) =>
      iff.mpr (linear_independent_subtype_range (linear_independent.injective hf)) hf

theorem linear_independent.to_subtype_range' {R : Type u_3} {M : Type u_5} [ring R]
    [add_comm_group M] [module R M] {ι : Type u_1} {f : ι → M} (hf : linear_independent R f)
    {t : set M} (ht : set.range f = t) : linear_independent R coe :=
  ht ▸ linear_independent.to_subtype_range hf

theorem linear_independent_image {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M]
    [module R M] {ι : Type u_1} {s : set ι} {f : ι → M} (hf : set.inj_on f s) :
    (linear_independent R fun (x : ↥s) => f ↑x) ↔ linear_independent R fun (x : ↥(f '' s)) => ↑x :=
  linear_independent_equiv' (equiv.set.image_of_inj_on f s hf) rfl

theorem linear_independent.image {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M]
    [module R M] {ι : Type u_1} {s : set ι} {f : ι → M}
    (hs : linear_independent R fun (x : ↥s) => f ↑x) :
    linear_independent R fun (x : ↥(f '' s)) => ↑x :=
  sorry

theorem linear_independent_span {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R]
    [add_comm_group M] [module R M] (hs : linear_independent R v) :
    linear_independent R
        fun (i : ι) => { val := v i, property := submodule.subset_span (set.mem_range_self i) } :=
  linear_independent.of_comp (submodule.subtype (submodule.span R (set.range v))) hs

/-! The following lemmas use the subtype defined by a set in `M` as the index set `ι`. -/

theorem linear_independent_comp_subtype {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] {s : set ι} :
    linear_independent R (v ∘ coe) ↔
        ∀ (l : ι →₀ R),
          l ∈ finsupp.supported R R s → coe_fn (finsupp.total ι M R v) l = 0 → l = 0 :=
  sorry

theorem linear_independent_subtype {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M]
    [module R M] {s : set M} :
    (linear_independent R fun (x : ↥s) => ↑x) ↔
        ∀ (l : M →₀ R),
          l ∈ finsupp.supported R R s → coe_fn (finsupp.total M M R id) l = 0 → l = 0 :=
  linear_independent_comp_subtype

theorem linear_independent_comp_subtype_disjoint {ι : Type u_1} {R : Type u_3} {M : Type u_5}
    {v : ι → M} [ring R] [add_comm_group M] [module R M] {s : set ι} :
    linear_independent R (v ∘ coe) ↔
        disjoint (finsupp.supported R R s) (linear_map.ker (finsupp.total ι M R v)) :=
  sorry

theorem linear_independent_subtype_disjoint {R : Type u_3} {M : Type u_5} [ring R]
    [add_comm_group M] [module R M] {s : set M} :
    (linear_independent R fun (x : ↥s) => ↑x) ↔
        disjoint (finsupp.supported R R s) (linear_map.ker (finsupp.total M M R id)) :=
  linear_independent_comp_subtype_disjoint

theorem linear_independent_iff_total_on {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M]
    [module R M] {s : set M} :
    (linear_independent R fun (x : ↥s) => ↑x) ↔ linear_map.ker (finsupp.total_on M M R id s) = ⊥ :=
  sorry

theorem linear_independent.restrict_of_comp_subtype {ι : Type u_1} {R : Type u_3} {M : Type u_5}
    {v : ι → M} [ring R] [add_comm_group M] [module R M] {s : set ι}
    (hs : linear_independent R (v ∘ coe)) : linear_independent R (set.restrict v s) :=
  hs

theorem linear_independent_empty (R : Type u_3) (M : Type u_5) [ring R] [add_comm_group M]
    [module R M] : linear_independent R fun (x : ↥∅) => ↑x :=
  sorry

theorem linear_independent.mono {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M]
    [module R M] {t : set M} {s : set M} (h : t ⊆ s) :
    (linear_independent R fun (x : ↥s) => ↑x) → linear_independent R fun (x : ↥t) => ↑x :=
  eq.mpr
    (id
      (imp_congr_eq (propext linear_independent_subtype_disjoint)
        (propext linear_independent_subtype_disjoint)))
    (disjoint.mono_left (finsupp.supported_mono h))

theorem linear_independent.disjoint_span_image {ι : Type u_1} {R : Type u_3} {M : Type u_5}
    {v : ι → M} [ring R] [add_comm_group M] [module R M] (hv : linear_independent R v) {s : set ι}
    {t : set ι} (hs : disjoint s t) :
    disjoint (submodule.span R (v '' s)) (submodule.span R (v '' t)) :=
  sorry

theorem linear_independent_sum {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5} [ring R]
    [add_comm_group M] [module R M] {v : ι ⊕ ι' → M} :
    linear_independent R v ↔
        linear_independent R (v ∘ sum.inl) ∧
          linear_independent R (v ∘ sum.inr) ∧
            disjoint (submodule.span R (set.range (v ∘ sum.inl)))
              (submodule.span R (set.range (v ∘ sum.inr))) :=
  sorry

theorem linear_independent.sum_type {ι : Type u_1} {ι' : Type u_2} {R : Type u_3} {M : Type u_5}
    {v : ι → M} [ring R] [add_comm_group M] [module R M] {v' : ι' → M} (hv : linear_independent R v)
    (hv' : linear_independent R v')
    (h : disjoint (submodule.span R (set.range v)) (submodule.span R (set.range v'))) :
    linear_independent R (sum.elim v v') :=
  iff.mpr linear_independent_sum { left := hv, right := { left := hv', right := h } }

theorem linear_independent.union {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M]
    [module R M] {s : set M} {t : set M} (hs : linear_independent R fun (x : ↥s) => ↑x)
    (ht : linear_independent R fun (x : ↥t) => ↑x)
    (hst : disjoint (submodule.span R s) (submodule.span R t)) :
    linear_independent R fun (x : ↥(s ∪ t)) => ↑x :=
  sorry

theorem linear_independent_of_finite {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M]
    [module R M] (s : set M)
    (H : ∀ (t : set M), t ⊆ s → set.finite t → linear_independent R fun (x : ↥t) => ↑x) :
    linear_independent R fun (x : ↥s) => ↑x :=
  sorry

theorem linear_independent_Union_of_directed {R : Type u_3} {M : Type u_5} [ring R]
    [add_comm_group M] [module R M] {η : Type u_1} {s : η → set M}
    (hs : directed has_subset.subset s)
    (h : ∀ (i : η), linear_independent R fun (x : ↥(s i)) => ↑x) :
    linear_independent R fun (x : ↥(set.Union fun (i : η) => s i)) => ↑x :=
  sorry

theorem linear_independent_sUnion_of_directed {R : Type u_3} {M : Type u_5} [ring R]
    [add_comm_group M] [module R M] {s : set (set M)} (hs : directed_on has_subset.subset s)
    (h : ∀ (a : set M), a ∈ s → linear_independent R fun (x : ↥a) => ↑x) :
    linear_independent R fun (x : ↥(⋃₀s)) => ↑x :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (linear_independent R fun (x : ↥(⋃₀s)) => ↑x)) set.sUnion_eq_Union))
    (linear_independent_Union_of_directed (directed_on.directed_coe hs)
      (eq.mpr (id (propext set_coe.forall))
        (eq.mp (Eq.refl (∀ (a : set M), a ∈ s → linear_independent R coe)) h)))

theorem linear_independent_bUnion_of_directed {R : Type u_3} {M : Type u_5} [ring R]
    [add_comm_group M] [module R M] {η : Type u_1} {s : set η} {t : η → set M}
    (hs : directed_on (t ⁻¹'o has_subset.subset) s)
    (h : ∀ (a : η), a ∈ s → linear_independent R fun (x : ↥(t a)) => ↑x) :
    linear_independent R
        fun (x : ↥(set.Union fun (a : η) => set.Union fun (H : a ∈ s) => t a)) => ↑x :=
  sorry

theorem linear_independent_Union_finite_subtype {R : Type u_3} {M : Type u_5} [ring R]
    [add_comm_group M] [module R M] {ι : Type u_1} {f : ι → set M}
    (hl : ∀ (i : ι), linear_independent R fun (x : ↥(f i)) => ↑x)
    (hd :
      ∀ (i : ι) (t : set ι),
        set.finite t →
          ¬i ∈ t →
            disjoint (submodule.span R (f i))
              (supr fun (i : ι) => supr fun (H : i ∈ t) => submodule.span R (f i))) :
    linear_independent R fun (x : ↥(set.Union fun (i : ι) => f i)) => ↑x :=
  sorry

theorem linear_independent_Union_finite {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M]
    [module R M] {η : Type u_1} {ιs : η → Type u_2} {f : (j : η) → ιs j → M}
    (hindep : ∀ (j : η), linear_independent R (f j))
    (hd :
      ∀ (i : η) (t : set η),
        set.finite t →
          ¬i ∈ t →
            disjoint (submodule.span R (set.range (f i)))
              (supr fun (i : η) => supr fun (H : i ∈ t) => submodule.span R (set.range (f i)))) :
    linear_independent R fun (ji : sigma fun (j : η) => ιs j) => f (sigma.fst ji) (sigma.snd ji) :=
  sorry

/-- Canonical isomorphism between linear combinations and the span of linearly independent vectors.
-/
def linear_independent.total_equiv {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R]
    [add_comm_group M] [module R M] (hv : linear_independent R v) :
    linear_equiv R (ι →₀ R) ↥(submodule.span R (set.range v)) :=
  linear_equiv.of_bijective
    (linear_map.cod_restrict (submodule.span R (set.range v)) (finsupp.total ι M R v) sorry) sorry
    sorry

/-- Linear combination representing a vector in the span of linearly independent vectors.

Given a family of linearly independent vectors, we can represent any vector in their span as
a linear combination of these vectors. These are provided by this linear map.
It is simply one direction of `linear_independent.total_equiv`. -/
def linear_independent.repr {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R]
    [add_comm_group M] [module R M] (hv : linear_independent R v) :
    linear_map R (↥(submodule.span R (set.range v))) (ι →₀ R) :=
  ↑(linear_equiv.symm (linear_independent.total_equiv hv))

theorem linear_independent.total_repr {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] (hv : linear_independent R v)
    (x : ↥(submodule.span R (set.range v))) :
    coe_fn (finsupp.total ι M R v) (coe_fn (linear_independent.repr hv) x) = ↑x :=
  iff.mp subtype.ext_iff (linear_equiv.apply_symm_apply (linear_independent.total_equiv hv) x)

theorem linear_independent.total_comp_repr {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] (hv : linear_independent R v) :
    linear_map.comp (finsupp.total ι M R v) (linear_independent.repr hv) =
        submodule.subtype (submodule.span R (set.range v)) :=
  linear_map.ext (linear_independent.total_repr hv)

theorem linear_independent.repr_ker {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] (hv : linear_independent R v) :
    linear_map.ker (linear_independent.repr hv) = ⊥ :=
  sorry

theorem linear_independent.repr_range {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] (hv : linear_independent R v) :
    linear_map.range (linear_independent.repr hv) = ⊤ :=
  sorry

theorem linear_independent.repr_eq {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M} [ring R]
    [add_comm_group M] [module R M] (hv : linear_independent R v) {l : ι →₀ R}
    {x : ↥(submodule.span R (set.range v))} (eq : coe_fn (finsupp.total ι M R v) l = ↑x) :
    coe_fn (linear_independent.repr hv) x = l :=
  sorry

theorem linear_independent.repr_eq_single {ι : Type u_1} {R : Type u_3} {M : Type u_5} {v : ι → M}
    [ring R] [add_comm_group M] [module R M] (hv : linear_independent R v) (i : ι)
    (x : ↥(submodule.span R (set.range v))) (hx : ↑x = v i) :
    coe_fn (linear_independent.repr hv) x = finsupp.single i 1 :=
  sorry

-- TODO: why is this so slow?

theorem linear_independent_iff_not_smul_mem_span {ι : Type u_1} {R : Type u_3} {M : Type u_5}
    {v : ι → M} [ring R] [add_comm_group M] [module R M] :
    linear_independent R v ↔
        ∀ (i : ι) (a : R), a • v i ∈ submodule.span R (v '' (set.univ \ singleton i)) → a = 0 :=
  sorry

theorem surjective_of_linear_independent_of_span {ι : Type u_1} {ι' : Type u_2} {R : Type u_3}
    {M : Type u_5} {v : ι → M} [ring R] [add_comm_group M] [module R M] [nontrivial R]
    (hv : linear_independent R v) (f : ι' ↪ ι)
    (hss : set.range v ⊆ ↑(submodule.span R (set.range (v ∘ ⇑f)))) : function.surjective ⇑f :=
  sorry

theorem eq_of_linear_independent_of_span_subtype {R : Type u_3} {M : Type u_5} [ring R]
    [add_comm_group M] [module R M] [nontrivial R] {s : set M} {t : set M}
    (hs : linear_independent R fun (x : ↥s) => ↑x) (h : t ⊆ s) (hst : s ⊆ ↑(submodule.span R t)) :
    s = t :=
  sorry

theorem linear_independent.image_subtype {R : Type u_3} {M : Type u_5} {M' : Type u_6} [ring R]
    [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] {s : set M}
    {f : linear_map R M M'} (hs : linear_independent R fun (x : ↥s) => ↑x)
    (hf_inj : disjoint (submodule.span R s) (linear_map.ker f)) :
    linear_independent R fun (x : ↥(⇑f '' s)) => ↑x :=
  sorry

theorem linear_independent.inl_union_inr {R : Type u_3} {M : Type u_5} {M' : Type u_6} [ring R]
    [add_comm_group M] [add_comm_group M'] [module R M] [module R M'] {s : set M} {t : set M'}
    (hs : linear_independent R fun (x : ↥s) => ↑x) (ht : linear_independent R fun (x : ↥t) => ↑x) :
    linear_independent R
        fun (x : ↥(⇑(linear_map.inl R M M') '' s ∪ ⇑(linear_map.inr R M M') '' t)) => ↑x :=
  sorry

theorem linear_independent_inl_union_inr' {ι : Type u_1} {ι' : Type u_2} {R : Type u_3}
    {M : Type u_5} {M' : Type u_6} [ring R] [add_comm_group M] [add_comm_group M'] [module R M]
    [module R M'] {v : ι → M} {v' : ι' → M'} (hv : linear_independent R v)
    (hv' : linear_independent R v') :
    linear_independent R
        (sum.elim (⇑(linear_map.inl R M M') ∘ v) (⇑(linear_map.inr R M M') ∘ v')) :=
  sorry

/-- Dedekind's linear independence of characters -/
-- See, for example, Keith Conrad's note <https://kconrad.math.uconn.edu/blurbs/galoistheory/linearchar.pdf>

theorem linear_independent_monoid_hom (G : Type u_1) [monoid G] (L : Type u_2) [comm_ring L]
    [no_zero_divisors L] : linear_independent L fun (f : G →* L) => ⇑f :=
  sorry

-- We prove linear independence by showing that only the trivial linear combination vanishes.

-- To do this, we use `finset` induction,

-- Here

-- * `a` is a new character we will insert into the `finset` of characters `s`,

-- * `ih` is the fact that only the trivial linear combination of characters in `s` is zero

-- * `hg` is the fact that `g` are the coefficients of a linear combination summing to zero

-- and it remains to prove that `g` vanishes on `insert a s`.

-- We now make the key calculation:

-- For any character `i` in the original `finset`, we have `g i • i = g i • a` as functions on the monoid `G`.

-- On the other hand, since `a` is not already in `s`, for any character `i ∈ s`

-- there is some element of the monoid on which it differs from `a`.

-- From these two facts we deduce that `g` actually vanishes on `s`,

-- And so, using the fact that the linear combination over `s` and over `insert a s` both vanish,

-- we deduce that `g a = 0`.

-- Now we're done; the last two facts together imply that `g` vanishes on every element of `insert a s`.

theorem le_of_span_le_span {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M] [module R M]
    [nontrivial R] {s : set M} {t : set M} {u : set M} (hl : linear_independent R coe) (hsu : s ⊆ u)
    (htu : t ⊆ u) (hst : submodule.span R s ≤ submodule.span R t) : s ⊆ t :=
  sorry

theorem span_le_span_iff {R : Type u_3} {M : Type u_5} [ring R] [add_comm_group M] [module R M]
    [nontrivial R] {s : set M} {t : set M} {u : set M} (hl : linear_independent R coe) (hsu : s ⊆ u)
    (htu : t ⊆ u) : submodule.span R s ≤ submodule.span R t ↔ s ⊆ t :=
  { mp := le_of_span_le_span hl hsu htu, mpr := submodule.span_mono }

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

theorem mem_span_insert_exchange {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {s : set V} {x : V} {y : V} :
    x ∈ submodule.span K (insert y s) →
        ¬x ∈ submodule.span K s → y ∈ submodule.span K (insert x s) :=
  sorry

theorem linear_independent_iff_not_mem_span {ι : Type u_1} {K : Type u_4} {V : Type u} [field K]
    [add_comm_group V] [vector_space K V] {v : ι → V} :
    linear_independent K v ↔ ∀ (i : ι), ¬v i ∈ submodule.span K (v '' (set.univ \ singleton i)) :=
  sorry

theorem linear_independent_unique_iff {ι : Type u_1} {K : Type u_4} {V : Type u} [field K]
    [add_comm_group V] [vector_space K V] {v : ι → V} [unique ι] :
    linear_independent K v ↔ v Inhabited.default ≠ 0 :=
  sorry

theorem linear_independent_unique {ι : Type u_1} {K : Type u_4} {V : Type u} [field K]
    [add_comm_group V] [vector_space K V] {v : ι → V} [unique ι] :
    v Inhabited.default ≠ 0 → linear_independent K v :=
  iff.mpr linear_independent_unique_iff

theorem linear_independent_singleton {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {x : V} (hx : x ≠ 0) :
    linear_independent K fun (x_1 : ↥(singleton x)) => ↑x_1 :=
  linear_independent_unique hx

theorem linear_independent_option' {ι : Type u_1} {K : Type u_4} {V : Type u} [field K]
    [add_comm_group V] [vector_space K V] {v : ι → V} {x : V} :
    (linear_independent K fun (o : Option ι) => option.cases_on' o x v) ↔
        linear_independent K v ∧ ¬x ∈ submodule.span K (set.range v) :=
  sorry

theorem linear_independent.option {ι : Type u_1} {K : Type u_4} {V : Type u} [field K]
    [add_comm_group V] [vector_space K V] {v : ι → V} {x : V} (hv : linear_independent K v)
    (hx : ¬x ∈ submodule.span K (set.range v)) :
    linear_independent K fun (o : Option ι) => option.cases_on' o x v :=
  iff.mpr linear_independent_option' { left := hv, right := hx }

theorem linear_independent_option {ι : Type u_1} {K : Type u_4} {V : Type u} [field K]
    [add_comm_group V] [vector_space K V] {v : Option ι → V} :
    linear_independent K v ↔
        linear_independent K (v ∘ coe) ∧ ¬v none ∈ submodule.span K (set.range (v ∘ coe)) :=
  sorry

theorem linear_independent.insert {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {s : set V} {x : V} (hs : linear_independent K fun (b : ↥s) => ↑b)
    (hx : ¬x ∈ submodule.span K s) : linear_independent K fun (b : ↥(insert x s)) => ↑b :=
  sorry

theorem linear_independent_insert' {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {ι : Type u_1} {s : set ι} {a : ι} {f : ι → V} (has : ¬a ∈ s) :
    (linear_independent K fun (x : ↥(insert a s)) => f ↑x) ↔
        (linear_independent K fun (x : ↥s) => f ↑x) ∧ ¬f a ∈ submodule.span K (f '' s) :=
  sorry

theorem linear_independent_insert {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {s : set V} {x : V} (hxs : ¬x ∈ s) :
    (linear_independent K fun (b : ↥(insert x s)) => ↑b) ↔
        (linear_independent K fun (b : ↥s) => ↑b) ∧ ¬x ∈ submodule.span K s :=
  sorry

theorem linear_independent_pair {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {x : V} {y : V} (hx : x ≠ 0) (hy : ∀ (a : K), a • x ≠ y) :
    linear_independent K coe :=
  Eq.subst (set.pair_comm y x) (linear_independent.insert (linear_independent_singleton hx))
    (mt (iff.mp submodule.mem_span_singleton) (iff.mpr not_exists hy))

theorem linear_independent_fin_cons {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {x : V} {n : ℕ} {v : fin n → V} :
    linear_independent K (fin.cons x v) ↔
        linear_independent K v ∧ ¬x ∈ submodule.span K (set.range v) :=
  sorry

theorem linear_independent.fin_cons {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {x : V} {n : ℕ} {v : fin n → V} (hv : linear_independent K v)
    (hx : ¬x ∈ submodule.span K (set.range v)) : linear_independent K (fin.cons x v) :=
  iff.mpr linear_independent_fin_cons { left := hv, right := hx }

theorem linear_independent_fin_succ {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {n : ℕ} {v : fin (n + 1) → V} :
    linear_independent K v ↔
        linear_independent K (fin.tail v) ∧ ¬v 0 ∈ submodule.span K (set.range (fin.tail v)) :=
  sorry

theorem linear_independent_fin2 {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {f : fin (bit0 1) → V} :
    linear_independent K f ↔ f 1 ≠ 0 ∧ ∀ (a : K), a • f 1 ≠ f 0 :=
  sorry

theorem exists_linear_independent {K : Type u_4} {V : Type u} [field K] [add_comm_group V]
    [vector_space K V] {s : set V} {t : set V} (hs : linear_independent K fun (x : ↥s) => ↑x)
    (hst : s ⊆ t) :
    ∃ (b : set V),
        ∃ (H : b ⊆ t),
          s ⊆ b ∧ t ⊆ ↑(submodule.span K b) ∧ linear_independent K fun (x : ↥b) => ↑x :=
  sorry

-- TODO(Mario): rewrite?

theorem exists_of_linear_independent_of_finite_span {K : Type u_4} {V : Type u} [field K]
    [add_comm_group V] [vector_space K V] {s : set V} {t : finset V}
    (hs : linear_independent K fun (x : ↥s) => ↑x) (hst : s ⊆ ↑(submodule.span K ↑t)) :
    ∃ (t' : finset V), ↑t' ⊆ s ∪ ↑t ∧ s ⊆ ↑t' ∧ finset.card t' = finset.card t :=
  sorry

theorem exists_finite_card_le_of_finite_of_linear_independent_of_span {K : Type u_4} {V : Type u}
    [field K] [add_comm_group V] [vector_space K V] {s : set V} {t : set V} (ht : set.finite t)
    (hs : linear_independent K fun (x : ↥s) => ↑x) (hst : s ⊆ ↑(submodule.span K t)) :
    ∃ (h : set.finite s),
        finset.card (set.finite.to_finset h) ≤ finset.card (set.finite.to_finset ht) :=
  sorry

end Mathlib


import .qe

open lia

lemma I_atom_le (i : int) (ks zs : list int) :
  I (A' (atom.le i ks)) zs ↔ (i ≤ list.dot_prod ks zs) := iff.refl _

lemma I_atom_dvd (d i ks zs) :
  I (A' (atom.dvd d i ks)) zs ↔ (has_dvd.dvd d (i + list.dot_prod ks zs)) := iff.refl _

lemma I_atom_ndvd (d i ks zs) :
  I (A' (atom.ndvd d i ks)) zs ↔ ¬ (has_dvd.dvd d (i + list.dot_prod ks zs)) := iff.refl _

lemma I_atom_ndvd' (d i : int) (ks zs : list int) :
   I (A' (atom.ndvd d i ks)) zs ↔ ¬ I (A' (atom.dvd d i ks)) zs :=
begin
  unfold I, unfold interp,
  unfold atom_type.val, unfold val
end

meta def atom_dep0_split :=
`[cases ks with k' ks',
  apply or.inl, apply not_not_intro rfl,
  cases (classical.em (k' = 0)) with h h, subst h,
  apply or.inl, apply not_not_intro rfl,
  apply or.inr, existsi k', existsi ks',
  apply and.intro; simp, apply h]

lemma le_dep0_split (i ks) :
  (¬ atom_type.dep0 int (atom.le i ks))
  ∨ ∃ k, ∃ ks', (k ≠ 0 ∧ ks = (k::ks')) := by atom_dep0_split

lemma dvd_dep0_split (d i ks) :
  (¬ atom_type.dep0 int (atom.dvd d i ks))
  ∨ ∃ k, ∃ ks', (k ≠ 0 ∧ ks = (k::ks')) := by atom_dep0_split

lemma ndvd_dep0_split (d i ks) :
  (¬ atom_type.dep0 int (atom.ndvd d i ks))
  ∨ ∃ k, ∃ ks', (k ≠ 0 ∧ ks = (k::ks')) := by atom_dep0_split

lemma subst_prsv (i ks xs) :
  ∀ p, nqfree p →
    (I (subst i ks p) xs ↔ I p ((i + list.dot_prod ks xs)::xs))
| ⊤' _ := by refl
| ⊥' _ := by refl
| (A' (atom.le i ks')) _ :=
  begin
    unfold subst, unfold map_fm, cases ks' with k' ks';
    unfold asubst, repeat {rewrite I_atom_le}, simp,
    simp, rewrite list.comp_add_dot_prod,
    rewrite mul_add, simp,
  end
| (A' (atom.ndvd d i ks')) _ :=
  begin
    unfold subst, unfold map_fm, cases ks' with k' ks';
    unfold asubst, repeat {rewrite I_atom_ndvd}, simp,
    rewrite list.comp_add_dot_prod, simp,
    rewrite mul_add, simp
  end
| (A' (atom.dvd d i ks')) _ :=
  begin
    unfold subst, unfold map_fm, cases ks' with k' ks';
    unfold asubst, repeat {rewrite I_atom_dvd}, simp,
    rewrite list.comp_add_dot_prod, simp,
    rewrite mul_add, simp
  end
| (p ∧' q) hf :=
  begin
    cases hf with hfp hfq,
    unfold subst, unfold map_fm,
    repeat {rewrite exp_I_and},
    let ihp := subst_prsv p hfp,
    unfold subst at ihp, rewrite ihp,
    let ihq := subst_prsv q hfq,
    unfold subst at ihq, rewrite ihq
  end
| (p ∨' q) hf :=
  begin
    cases hf with hfp hfq,
    unfold subst, unfold map_fm,
    repeat {rewrite exp_I_or},
    let ihp := subst_prsv p hfp,
    unfold subst at ihp, rewrite ihp,
    let ihq := subst_prsv q hfq,
    unfold subst at ihq, rewrite ihq
  end
| (¬' p) hf := by cases hf
| (∃' p) hf := by cases hf

meta def hco_not_dep0_tac :=
`[  cases ks with k' ks', refl,
    cases (classical.em (k' = 0)) with hz hnz,
    subst hz, refl, exfalso, apply hnd, apply hnz]

lemma hco_not_dep0 (m) :
  ∀ a, (¬ atom_type.dep0 int a) → hd_coeff_one m a = a :=
begin
  intros a hnd, cases a with i ks d i ks d i ks,
  repeat
  {cases ks with k' ks', refl,
    cases (classical.em (k' = 0)) with hz hnz,
    subst hz, refl, exfalso, apply hnd, apply hnz}
end

lemma hco_le_nonzero (m i k : int) (ks) :
  k ≠ 0 →
  hd_coeff_one m (atom.le i (k::ks)) =
  (let m' := has_div.div m (abs k) in
   atom.le (m' * i) (int.sign k :: list.map (λ x, m' * x) ks)) :=
begin
  intro hne, cases k with n n, cases n, trivial,
  trivial, trivial,
end

lemma hco_dvd_nonzero (m d i k ks) :
  k ≠ 0 →
  hd_coeff_one m (atom.dvd d i (k::ks)) =
 (let m' := has_div.div m k in
  atom.dvd (m' * d) (m' * i) (1 :: list.map (λ x, m' * x) ks)) :=
begin
  intro hne, cases k with n n, cases n, trivial,
  trivial, trivial,
end

lemma hco_ndvd_nonzero (m d i k ks) :
  k ≠ 0 →
  hd_coeff_one m (atom.ndvd d i (k::ks)) =
 (let m' := has_div.div m k in
  atom.ndvd (m' * d) (m' * i) (1 :: list.map (λ x, m' * x) ks)) :=
begin
  intro hne, cases k with n n, cases n, trivial,
  trivial, trivial,
end

lemma normal_hco_atom
(z : int)
(hne : z ≠ 0) :
∀ (a : atom)
(ha1 : atom_type.normal ℤ a)
(ha2 : has_dvd.dvd (hd_coeff a) z ∨ hd_coeff a = 0),
 atom_type.normal ℤ (hd_coeff_one z a)
| (atom.le i ks) ha1 ha2 :=
  begin
    cases ks with k ks, trivial, cases k with n,
    cases n; trivial, trivial
  end
| (atom.dvd d i ks) ha1 ha2 :=
  begin
    cases ks with k ks, trivial,
    cases (classical.em (k = 0)) with hk hk,
    subst hk, trivial,
    cases ha2 with ha2 ha2,
    rewrite hco_dvd_nonzero, simp,
    apply int.mul_nonzero,
    unfold hd_coeff at ha2,
    unfold list.head_dft at ha2,
    apply int.div_nonzero, apply hne, apply ha2,
    apply ha1, apply hk,
    exfalso, apply hk ha2
  end
| (atom.ndvd d i ks) ha1 ha2 :=
  begin
    cases ks with k ks, trivial,
    cases (classical.em (k = 0)) with hk hk,
    subst hk, trivial,
    cases ha2 with ha2 ha2,
    rewrite hco_ndvd_nonzero, simp,
    apply int.mul_nonzero,
    unfold hd_coeff at ha2,
    unfold list.head_dft at ha2,
    apply int.div_nonzero, apply hne, apply ha2,
    apply ha1, apply hk,
    exfalso, apply hk ha2
  end

meta def fnormal_map_hco_of_fnormal_tac :=
 `[unfold map_fm, unfold fnormal,
   cases hn with hnp hnq, unfold atoms at hnz,
   rewrite list.forall_mem_union at hnz,
   cases hnz with hnzp hnzq,  apply and.intro;
   apply fnormal_map_hco_of_fnormal; assumption]

lemma fnormal_map_hco_of_fnormal (z : int) (hz : z ≠ 0) :
  ∀ (p : fm atom), (fnormal ℤ p)
  → (∀ a ∈ atoms p, has_dvd.dvd (hd_coeff a) z ∨ hd_coeff a = 0)
  → fnormal ℤ (map_fm (hd_coeff_one z) p)
| ⊤' hn hnz := by unfold map_fm
| ⊥' hn hnz := by unfold map_fm
| (A' a) hn hnz :=
  begin
    unfold map_fm, unfold fnormal, unfold fnormal at hn,
    apply normal_hco_atom z hz _ hn, apply hnz,
    unfold atoms, simp,
  end
| (p ∧' q) hn hnz := by fnormal_map_hco_of_fnormal_tac
| (p ∨' q) hn hnz := by fnormal_map_hco_of_fnormal_tac
| (¬' p) hp hpz :=
  begin
    unfold map_fm, unfold fnormal,
    apply fnormal_map_hco_of_fnormal p hp hpz,
  end
| (∃' p) hn hnz := by unfold map_fm

lemma hd_coeffs_one_normal_prsv :
  preserves hd_coeffs_one (fnormal int) :=
begin
  intros p hp, unfold hd_coeffs_one,
  unfold fnormal,
  have hne : int.lcms (list.map hd_coeff (atoms_dep0 ℤ p)) ≠ 0,
  apply int.nonzero_of_pos,
  apply int.lcms_pos,
  apply @list.forall_mem_map_of_forall_mem _ _
          (atom_type.dep0 int)
          (λ (z : int), z ≠ 0)
          hd_coeff
          (atoms_dep0 int p),
  unfold atoms_dep0, intros a ha,
  apply list.of_mem_filter ha,
  intros a ha, apply ha,
  apply and.intro, intro hc, apply hne hc,
  apply fnormal_map_hco_of_fnormal _ hne _ hp,
  intros a ha, apply or_of_not_imp_right,
  intro haz, apply int.dvd_lcms,
  rewrite list.mem_map, existsi a, apply and.intro,
  unfold atoms_dep0, apply list.mem_filter_of_mem,
  apply ha, apply haz, refl
end

lemma normal_asubst_of_normal :
  ∀ a : atom, atom_type.normal int a
    → ∀ i ks, atom_type.normal int (asubst i ks a) :=
begin
  intro a, cases a with i ks d i ks d i ks;
  intros h i' ks'; cases ks with k ks; trivial
end

lemma fnormal_subst_of_fnormal (i ks) :
  ∀ p, fnormal int p → fnormal int (subst i ks p)
| ⊤' h := by unfold subst
| ⊥' h := by unfold subst
| (A' a) h :=
  begin
    unfold subst, unfold map_fm,
    unfold fnormal, apply normal_asubst_of_normal _ h
  end
| (p ∧' q) h :=
  begin
    cases h with hp hq, apply and.intro;
    apply fnormal_subst_of_fnormal; assumption
  end
| (p ∨' q) h :=
  begin
    cases h with hp hq, apply and.intro;
    apply fnormal_subst_of_fnormal; assumption
  end
| (¬' p) h := fnormal_subst_of_fnormal p h
| (∃' p) h := by unfold subst

meta def nqfree_hco_of_nqfree_tac :=
`[unfold map_fm, cases h with hp hq, apply and.intro;
  apply nqfree_hco_of_nqfree; assumption]

lemma nqfree_hco_of_nqfree (z) :
  ∀ (p : fm atom), nqfree p → nqfree (map_fm (hd_coeff_one z) p)
| ⊤' h := by unfold map_fm
| ⊥' h := by unfold map_fm
| (A' _) h := by unfold map_fm
| (p ∧' q) h := by nqfree_hco_of_nqfree_tac
| (p ∨' q) h := by nqfree_hco_of_nqfree_tac
| (¬' _) h := by cases h
| (∃' _) h := by unfold map_fm

lemma nqfree_hcso_of_nqfree :
  ∀ (p : fm atom), nqfree p → nqfree (hd_coeffs_one p) :=
begin
  intros p h, unfold hd_coeffs_one,
  apply and.intro, trivial,
  apply nqfree_hco_of_nqfree _ _ h
end

lemma qfree_subst_of_qfree (i ks) :
  ∀ p, qfree p → qfree (subst i ks p)
| ⊤' h := by unfold subst
| ⊥' h := by unfold subst
| (A' a) h := by unfold subst
| (p ∧' q) h :=
  begin
    cases h with hp hq, apply and.intro,
    apply qfree_subst_of_qfree p hp,
    apply qfree_subst_of_qfree q hq
  end
| (p ∨' q) h :=
  begin
    cases h with hp hq, apply and.intro,
    apply qfree_subst_of_qfree p hp,
    apply qfree_subst_of_qfree q hq
  end
| (¬' p) h := qfree_subst_of_qfree p h
| (∃' p) h := by unfold subst

lemma pred_inf_minus_of_pred (P) (hup : prop_up_closed P)
  (hdn : down_closed P) : ∀ p, P p → P (inf_minus p)
| ⊤' h := h
| ⊥' h := h
| (A' a) h :=
  begin
    cases a with k ks, cases ks with k' ks, apply h,
    unfold inf_minus, apply cases_ite; intro h1,
    apply hup ⊤', apply cases_ite; intro h2, apply hup ⊥',
    rewrite int.eq_zero_of_nonpos_of_nonzero k' h1 h2 at h,
    apply h, apply h, apply h
  end
| (p ∧' q) h :=
  begin
    unfold inf_minus, apply pred_and_o _ hup;
    apply pred_inf_minus_of_pred;
    apply hdn _ _ _ h; constructor
  end
| (p ∨' q) h :=
  begin
    unfold inf_minus, apply pred_or_o _ hup;
    apply pred_inf_minus_of_pred;
    apply hdn _ _ _ h; constructor
  end
| (¬' p) h := h
| (∃' p) h := h

lemma qfree_inf_minus_of_qfree :
  ∀ p, qfree p → qfree (inf_minus p) :=
  pred_inf_minus_of_pred _ prop_up_closed_qfree down_closed_qfree

lemma fnormal_inf_minus_of_fnormal :
  ∀ p, fnormal int p → fnormal int (inf_minus p) :=
  pred_inf_minus_of_pred _ prop_up_closed_fnormal down_closed_fnormal

lemma qe_cooper_one_normal_prsv : preserves qe_cooper_one (fnormal int) :=
begin
  unfold preserves, intros p hp,
  unfold qe_cooper_one, simp,
  apply fnormal_or_o, apply fnormal_disj,
  intros z hz, apply fnormal_subst_of_fnormal,
  apply fnormal_inf_minus_of_fnormal, apply hp,
  apply fnormal_disj, intros zzs hzzs,
  apply fnormal_disj, intros z hz,
   apply fnormal_subst_of_fnormal, apply hp
end

lemma sqe_cooper_normal_prsv : preserves sqe_cooper (fnormal int) :=
begin
  intros p hp, unfold sqe_cooper,
  apply qe_cooper_one_normal_prsv,
  apply hd_coeffs_one_normal_prsv,
  apply hp
end

lemma qfree_qco_of_nqfree : qfree_res_of_nqfree_arg qe_cooper_one :=
begin
  unfold qfree_res_of_nqfree_arg, intros p hp,
  unfold qe_cooper_one, simp,
  apply qfree_or_o; apply qfree_disj,

  intros z hz, apply qfree_subst_of_qfree,
  apply qfree_inf_minus_of_qfree,
  apply qfree_of_nqfree _ hp,

  intros zzs hzzs, apply qfree_disj,
  intros z hz, apply qfree_subst_of_qfree,
  apply qfree_of_nqfree _ hp
end

lemma qfree_sqe_cooper_of_nqfree : qfree_res_of_nqfree_arg sqe_cooper :=
begin
  unfold qfree_res_of_nqfree_arg, unfold sqe_cooper,
  intros p h, apply qfree_qco_of_nqfree,
  apply nqfree_hcso_of_nqfree, apply h
end

def unified (p : fm atom) : Prop :=
  ∀ a ∈ atoms p, hd_coeff a = -1 ∨ hd_coeff a = 0 ∨ hd_coeff a = 1

lemma unfied_hd_coeff : ∀ (a : atom) (z : int),
  hd_coeff (hd_coeff_one z a) = -1
∨ hd_coeff (hd_coeff_one z a) = 0
∨ hd_coeff (hd_coeff_one z a) = 1 :=
begin
  intros a z, cases a with i ks d i ks d i ks; cases ks with k ks,

   apply or.inr (or.inl rfl),

   cases (classical.em (k = 0)) with hk hk, subst hk,

     apply or.inr (or.inl rfl),

     rewrite hco_le_nonzero _ _ _ _ hk, simp,
     unfold hd_coeff, unfold list.head_dft,
     apply int.sign_split,

   apply or.inr (or.inl rfl),

   cases (classical.em (k = 0)) with hk hk, subst hk,

     apply or.inr (or.inl rfl),

     rewrite hco_dvd_nonzero _ _ _ _ _ hk, simp,
     unfold hd_coeff, unfold list.head_dft, simp,

   apply or.inr (or.inl rfl),

   cases (classical.em (k = 0)) with hk hk, subst hk,

     apply or.inr (or.inl rfl),

    rewrite hco_ndvd_nonzero _ _ _ _ _ hk, simp,
    unfold hd_coeff, unfold list.head_dft, simp
end

lemma ex_iff_inf_or_bnd_aux (P : int → Prop)
  (hP : ∀ (y : ℤ), (P y → ∃ (x : ℤ), x < y ∧ P x))
  (y : int) : ∀ (m n : nat), n ≤ m → P (y + int.of_nat n) → ∃ (x : int), (x < y ∧ P x)
| 0 n hle hn :=
  begin
    cases n with n,
    have he : int.of_nat 0 = 0, refl,
    rewrite he at hn, rewrite add_zero at hn,
    apply hP, apply hn, cases hle
  end
| (m+1) n hle hn :=
  begin
    cases (lt_or_eq_of_le hle) with hlt heq,
    apply ex_iff_inf_or_bnd_aux m n,
    apply nat.le_of_lt_succ, apply hlt, apply hn,
    subst heq, clear hle,
    cases (hP _ hn) with w hw, cases hw with hw1 hw2,
    cases (classical.em (w < y)) with hw3 hw3,
    existsi w, apply and.intro; assumption,
    rewrite not_lt at hw3,
    cases (int.exists_nat_diff y w (m+1) hw3 hw1) with k hk,
    cases hk with hk1 hk2,
    apply ex_iff_inf_or_bnd_aux m k,
    apply nat.le_of_lt_succ, apply hk1,
    rewrite hk2 at hw2, apply hw2,
  end

lemma ex_iff_inf_or_bnd (P : int → Prop) :
  (∃ z, P z) ↔ ((∀ y, ∃ x, x < y ∧ P x) ∨ (∃ y, (P y ∧ ∀ x, x < y → ¬ P x))) :=
begin
  apply iff.intro; intro h1,
  cases (classical.em ( ∃ (y : ℤ), P y ∧ ∀ (x : ℤ), x < y → ¬P x)) with h2 h2,
  apply or.inr h2, rewrite not_exists at h2,
  apply or.inl, intro y, cases h1 with z hz,
  cases (lt_or_le z y) with hlt hle,
  existsi z, apply and.intro; assumption,
  rewrite iff.symm sub_nonneg at hle,
  rewrite int.nonneg_iff_exists at hle,
  cases hle with n hn,
  apply (ex_iff_inf_or_bnd_aux P _ y n n _),
  rewrite sub_eq_iff_eq_add at hn, rewrite hn at hz,
  rewrite add_comm, apply hz,
  intros x hx, apply classical.by_contradiction,
  intro hc, apply (h2 x), apply and.intro hx,
  rewrite not_exists at hc, intros w hw1 hw2,
  apply hc w, apply and.intro; assumption,
  apply le_refl,

  cases h1 with hinf hbnd, cases (hinf 0) with z hz,
  existsi z, apply hz^.elim_right,
  cases hbnd with z hz,
  existsi z, apply hz^.elim_left
end

lemma mem_bnd_points_and (p q) :
  ∀ b, ((b ∈ bnd_points p ∨ b ∈ bnd_points q) → b ∈ bnd_points (p ∧' q)) :=
begin
  unfold bnd_points, intro zzs,
  repeat {rewrite list.mem_filter_map},
  intro hm, cases hm with hm hm;
 {cases hm with a ha, cases ha with ha1 ha2,
  unfold atoms_dep0 at ha1, rewrite list.mem_filter at ha1,
  cases ha1 with ha1a ha1b, existsi a, apply and.intro _ ha2,
  apply list.mem_filter_of_mem _ ha1b, unfold atoms,
  {apply list.mem_union_left ha1a _
   <|> apply list.mem_union_right _ ha1a}}
end

lemma unified_hd_coeffs_one :
  ∀ p, nqfree p → unified (hd_coeffs_one p) :=
begin
  intros p hf, unfold hd_coeffs_one,
  unfold unified, unfold atoms, simp,
  apply and.intro, apply or.inr (or.inr rfl),
  intros a ha,
  rewrite list.mem_iff_mem_of_equiv
    (atoms_map_fm _ _ hf) at ha,
  rewrite list.mem_map at ha, cases ha with a' ha',
  cases ha' with h1 h2, subst h2,
  apply unfied_hd_coeff
end

meta def inf_minus_prsv_tac :=
`[existsi (0 : int), intros z hz, unfold inf_minus]

lemma inf_minus_prsv (zs) : ∀ (p : fm atom),
  ∃ (y : int), ∀ z, z < y →
    (I (inf_minus p) (z::zs) ↔ I p (z::zs))
| ⊤' :=
  begin
    existsi (0 : int), intros z hz,
    apply true_iff_true; trivial
  end
| ⊥' :=
  begin
    existsi (0 : int), intros z hz,
    apply false_iff_false; intro hc; cases hc
  end
| (A' (atom.le i ks)) :=
  begin
    cases ks with k ks, inf_minus_prsv_tac,
    cases (lt_trichotomy k 0) with hlt heqgt,

    existsi (- abs (i - list.dot_prod ks zs)),
    intros z hz,
    unfold inf_minus, rewrite ite_eq_of,
    rewrite I_atom_le, simp,
    rewrite iff.symm sub_le_iff_le_add,
    apply true_iff_true, trivial,
    apply le_trans (le_abs_self _),
    rewrite lt_neg at hz,
    apply le_trans (le_of_lt hz),
    rewrite eq.symm (neg_neg k),
    rewrite neg_mul_comm,
    apply int.le_mul_of_pos_left,
    apply le_trans _ (le_of_lt hz),
    apply abs_nonneg, unfold gt,
    rewrite lt_neg, apply hlt, apply hlt,

    cases heqgt with heq hgt, subst heq,
    inf_minus_prsv_tac,
    rewrite ite_eq_of_not,
    rewrite ite_eq_of_not, intro hc, cases hc,
    intro hc, cases hc,

    existsi (- abs (i - list.dot_prod ks zs)),
    intros z hz, unfold inf_minus,
    rewrite ite_eq_of_not, rewrite ite_eq_of,
    rewrite I_atom_le, simp,
    rewrite iff.symm sub_le_iff_le_add,
    apply false_iff_false, intro hc, cases hc,
    rewrite not_le,
    apply @lt_of_le_of_lt _ _ _ z,
    rewrite iff.symm neg_le_neg_iff,
    rewrite neg_mul_eq_mul_neg,
    apply int.le_mul_of_pos_left,
    unfold ge, rewrite le_neg,
    apply le_trans, apply le_of_lt hz,
    rewrite neg_le_neg_iff, apply abs_nonneg,
    apply hgt, apply lt_of_lt_of_le hz,
    rewrite neg_le, apply neg_le_abs_self,
    apply hgt, rewrite not_lt,
    apply le_of_lt hgt
  end
| (A' (atom.dvd d i ks)) := by inf_minus_prsv_tac
| (A' (atom.ndvd d i ks)) := by inf_minus_prsv_tac
| (p ∧' q) :=
  begin
    cases (inf_minus_prsv p) with x hx,
    cases (inf_minus_prsv q) with y hy,
    cases (int.exists_lt_and_lt x y) with z hz,
    cases hz with hz1 hz2,
    existsi z, intros w hw,
    unfold inf_minus, rewrite exp_I_and_o,
    rewrite hx, rewrite hy, rewrite exp_I_and,
    apply lt.trans hw hz2,
    apply lt.trans hw hz1,
  end
| (p ∨' q) :=
  begin
    cases (inf_minus_prsv p) with x hx,
    cases (inf_minus_prsv q) with y hy,
    cases (int.exists_lt_and_lt x y) with z hz,
    cases hz with hz1 hz2,
    existsi z, intros w hw,
    unfold inf_minus, rewrite exp_I_or_o,
    rewrite hx, rewrite hy, rewrite exp_I_or,
    apply lt.trans hw hz2,
    apply lt.trans hw hz1,
  end
| (¬' p) := by inf_minus_prsv_tac
| (∃' p) := by inf_minus_prsv_tac

lemma pos_coeffs_lcm (p : fm atom) :
  coeffs_lcm p > 0 :=
begin
  unfold coeffs_lcm, apply int.lcms_pos,
  intros z hz, rewrite list.mem_map at hz,
  cases hz with a ha, cases ha with ha1 ha2,
  subst ha2, unfold atoms_dep0 at ha1,
  rewrite list.mem_filter at ha1, apply ha1^.elim_right
end

lemma pos_divisors_lcm (p : fm atom) (hn : fnormal int p) :
  divisors_lcm p > 0 :=
begin
  unfold divisors_lcm, apply int.lcms_pos,
  intros z hz, rewrite list.mem_map at hz,
  cases hz with a ha, cases ha with ha1 ha2,
  subst ha2, unfold atoms_dep0 at ha1,
  rewrite list.mem_filter at ha1,
  cases ha1 with ha1 ha2,
  rewrite iff.symm normal_iff_divisor_nonzero,
  rewrite fnormal_iff_fnormal_alt at hn,
  apply hn, apply ha1
end

meta def coeffs_lcm_atom_tac :=
`[intro hk, unfold coeffs_lcm,
  unfold atoms_dep0, unfold atoms,
  unfold list.filter, rewrite ite_eq_of,
  unfold list.map, unfold hd_coeff,
  unfold list.head_dft, unfold int.lcms,
  apply int.lcm_one_right, apply hk]

lemma coeffs_lcm_atom_le {i k : int} {ks : list int} :
  k ≠ 0 → coeffs_lcm (A' (atom.le i (k::ks))) = abs k :=
by coeffs_lcm_atom_tac

lemma coeffs_lcm_atom_dvd {d i k : int} {ks : list int} :
  k ≠ 0 → coeffs_lcm (A' (atom.dvd d i (k::ks))) = abs k :=
by coeffs_lcm_atom_tac

lemma coeffs_lcm_atom_ndvd {d i k : int} {ks : list int} :
  k ≠ 0 → coeffs_lcm (A' (atom.ndvd d i (k::ks))) = abs k :=
by coeffs_lcm_atom_tac

meta def divisors_lcm_atom_tac :=
`[intro hk,
  unfold divisors_lcm, unfold atoms_dep0,
  unfold atoms, unfold list.filter,
  rewrite ite_eq_of, unfold list.map,
  unfold divisor, unfold int.lcms,
  apply int.lcm_one_right, apply hk]

lemma divisors_lcm_atom_dvd {d i k : int} {ks : list int} :
  k ≠ 0 → divisors_lcm (A' (atom.dvd d i (k::ks))) = abs d :=
by divisors_lcm_atom_tac

lemma divisors_lcm_atom_ndvd {d i k : int} {ks : list int} :
  k ≠ 0 → divisors_lcm (A' (atom.ndvd d i (k::ks))) = abs d :=
by divisors_lcm_atom_tac

meta def lcm_distrib_tac :=
`[apply int.lcms_distrib,
  apply list.equiv.trans,
  apply list.map_equiv_map_of_equiv,
  apply list.filter_union,
  apply list.map_union]

lemma coeffs_lcm_and (p q) :
  coeffs_lcm (p ∧' q) = int.lcm (coeffs_lcm p) (coeffs_lcm q) :=
by lcm_distrib_tac

lemma coeffs_lcm_or (p q) :
  coeffs_lcm (p ∨' q) = int.lcm (coeffs_lcm p) (coeffs_lcm q) :=
by lcm_distrib_tac

lemma divisors_lcm_and (p q) :
  divisors_lcm (p ∧' q) = int.lcm (divisors_lcm p) (divisors_lcm q) :=
by lcm_distrib_tac

lemma divisors_lcm_or (p q) :
  divisors_lcm (p ∨' q) = int.lcm (divisors_lcm p) (divisors_lcm q) :=
by lcm_distrib_tac

lemma coeffs_lcm_pos (p) :
  coeffs_lcm p > 0 :=
begin
  apply int.lcms_pos,
  intros z hz, rewrite list.mem_map at hz,
  cases hz with a ha, cases ha with ha1 ha2,
  subst ha2, unfold atoms_dep0 at ha1,
  rewrite list.mem_filter at ha1,
  apply ha1^.elim_right
end

lemma divisors_lcm_pos (p) :
  fnormal int p → divisors_lcm p > 0 :=
begin
  intro hn, apply int.lcms_pos,
  intros z hz, rewrite list.mem_map at hz,
  cases hz with a ha, cases ha with ha1 ha2,
  subst ha2, unfold atoms_dep0 at ha1,
  rewrite list.mem_filter at ha1,
  rewrite fnormal_iff_fnormal_alt at hn,
  rewrite iff.symm normal_iff_divisor_nonzero,
  apply hn, apply ha1^.elim_left
end

lemma atom_dvd_mod (m d i ks z zs) :
  has_dvd.dvd d m →
  ((I (A' (atom.dvd d i ks)) (z :: zs)) ↔
   (I (A' (atom.dvd d i ks)) (z % m :: zs))) :=
begin
  intro hdvd,
  repeat {rewrite I_atom_dvd},
  cases ks with k ks; simp,
  repeat {rewrite add_comm i},
  repeat {rewrite (add_assoc)},
  apply iff.symm, apply iff.trans,
  apply (@dvd_add_iff_right _ _ _ (k * (z - z % m))),
  apply dvd_mul_of_dvd_right,
  rewrite int.mod_def,
  rewrite eq.symm (sub_add _ _ _), simp,
  apply dvd_mul_of_dvd_left, apply hdvd,
  rewrite add_comm, rewrite add_assoc,
  rewrite add_comm _ i,
  rewrite add_assoc,
  rewrite eq.symm (mul_add _ _ _),
  rewrite add_comm (z % m),
  rewrite sub_add_cancel, simp
end

lemma atom_ndvd_mod (m d i ks z zs) :
  has_dvd.dvd d m →
  ((I (A' (atom.ndvd d i ks)) (z :: zs)) ↔
   (I (A' (atom.ndvd d i ks)) (z % m :: zs))) :=
begin
  intro hdvd,
  repeat {rewrite I_atom_ndvd'},
  rewrite atom_dvd_mod, apply hdvd
end

lemma divisors_lcm_dvd_and_left (p q) :
  has_dvd.dvd (divisors_lcm p) (divisors_lcm (p ∧'  q)) :=
begin
  rewrite divisors_lcm_and,
  apply int.dvd_lcm_left
end

lemma divisors_lcm_dvd_and_right (p q) :
  has_dvd.dvd (divisors_lcm q) (divisors_lcm (p ∧' q)) :=
begin
  rewrite divisors_lcm_and,
  apply int.dvd_lcm_right
end

lemma inf_minus_mod (k z zs) :
  ∀ p, nqfree p → (has_dvd.dvd (divisors_lcm p) k)
    → ((I (inf_minus p) (z :: zs))
       ↔ (I (inf_minus p) (z % k :: zs)))
| ⊤' _ _ := begin apply true_iff_true; trivial end
| ⊥' _ _ := begin apply false_iff_false; intro hc; cases hc end
| (A' (atom.le i [])) hf hdvd :=
  begin
    unfold inf_minus, repeat {rewrite I_not_dep0},
    repeat {apply not_not_intro, refl}
  end
| (A' (atom.le i (k'::ks'))) hf hdvd :=
  begin
    cases (lt_trichotomy k' 0) with hlt heqgt;
    unfold inf_minus, rewrite ite_eq_of,
    apply true_iff_true; trivial, apply hlt,
    cases heqgt with heq hgt, subst heq,
    rewrite ite_eq_of_not, rewrite ite_eq_of_not,
    repeat {rewrite I_not_dep0},
    repeat {apply not_not_intro, refl},
    simp, simp,
    rewrite ite_eq_of_not, rewrite ite_eq_of,
    apply false_iff_false; intro hc; cases hc,
    apply hgt, rewrite not_lt, apply le_of_lt hgt
  end
| (A' (atom.dvd d i ks)) hf hdvd :=
  begin
    cases (dvd_dep0_split d i ks) with hd0 hd0,
    unfold inf_minus, repeat {rewrite I_not_dep0},
    assumption, assumption,
    cases hd0 with k' hk', cases hk' with ks' hks',
    cases hks' with h1 h2, subst h2,
    rewrite divisors_lcm_atom_dvd at hdvd,
    rewrite int.abs_dvd at hdvd,
    apply atom_dvd_mod, apply hdvd, apply h1
  end
| (A' (atom.ndvd d i ks)) hf hdvd :=
  begin
    cases (ndvd_dep0_split d i ks) with hd0 hd0,
    unfold inf_minus,  repeat {rewrite I_not_dep0},
    assumption, assumption,
    cases hd0 with k' hk', cases hk' with ks' hks',
    cases hks' with h1 h2, subst h2,
    rewrite divisors_lcm_atom_ndvd at hdvd,
    rewrite int.abs_dvd at hdvd,
    apply atom_ndvd_mod, apply hdvd, apply h1
  end
| (p ∧' q) hf hdvd :=
  begin
    cases hf with hfp hfq,
    unfold inf_minus,
    repeat {rewrite exp_I_and_o},
    repeat {rewrite inf_minus_mod; try {assumption}},
    apply dvd.trans _ hdvd,
    apply divisors_lcm_dvd_and_right,
    apply dvd.trans _ hdvd,
    apply divisors_lcm_dvd_and_left
  end
| (p ∨' q) hf hdvd :=
  begin
    cases hf with hfp hfq,
    unfold inf_minus,
    repeat {rewrite exp_I_or_o},
    repeat {rewrite inf_minus_mod; try {assumption}},
    apply dvd.trans _ hdvd,
    apply divisors_lcm_dvd_and_right,
    apply dvd.trans _ hdvd,
    apply divisors_lcm_dvd_and_left
  end
| (¬' p) hf _ := by cases hf
| (∃' p) hf _ := by cases hf

lemma no_lb_inf_minus (p : fm atom) (hf : nqfree p)
  (hn : fnormal int p) (z : int) (zs) : I (inf_minus p) (z::zs)
  → ∀ y, ∃ x, (x < y ∧ I (inf_minus p) (x::zs)) :=
begin
  intros h y, cases lt_or_le z y with hlt hle,
  existsi z, apply and.intro; assumption,
  have hw : ∃ (w : int), z < y + (w * divisors_lcm p),
  existsi (z - y + 1),
  rewrite iff.symm sub_lt_iff_lt_add',
  apply int.lt_mul_of_nonneg_right,
  rewrite int.lt_add_one_iff,
  rewrite iff.symm sub_nonneg at hle,
  apply le_trans hle,
  apply le_of_lt, rewrite int.lt_add_one_iff,
  apply divisors_lcm_pos _ hn,
  cases hw with w hw,
  rewrite iff.symm sub_lt_iff_lt_add at hw,
  existsi (z - w * divisors_lcm p),
  apply and.intro hw,
  rewrite inf_minus_mod (divisors_lcm p),
  rewrite inf_minus_mod (divisors_lcm p) at h,
  rewrite (sub_eq_add_neg _ _),
  rewrite neg_mul_eq_neg_mul,
  rewrite int.add_mul_mod_self, apply h,
  repeat {assumption <|> apply dvd_refl}
end

lemma mod_add_eq_mod (i j k : int) : (has_dvd.dvd k j) → (i + j) % k = i % k :=
begin
  intro hdvd, rewrite int.dvd_iff_exists at hdvd,
  cases hdvd with z hz, subst hz,
  rewrite int.add_mul_mod_self
end

lemma nqfree_inf_minus_of_nqfree :
  ∀ p, nqfree p → nqfree (inf_minus p)
| ⊤' h := h
| ⊥' h := h
| (A' a) h :=
  begin
    cases a with i ks d i ks di ks;
    cases ks with k ks;
    unfold inf_minus,
    apply cases_ite; intro _, trivial,
    apply cases_ite; intro _; trivial
  end
| (p ∧' q) h :=
  begin
    cases h with h1 h2, unfold inf_minus,
    apply cases_and_o, trivial,
    repeat {apply nqfree_inf_minus_of_nqfree, assumption},
    apply and.intro; apply nqfree_inf_minus_of_nqfree;
    assumption
  end
| (p ∨' q) h :=
  begin
    cases h with h1 h2, unfold inf_minus,
    apply cases_or_o, trivial,
    repeat {apply nqfree_inf_minus_of_nqfree, assumption},
    apply and.intro; apply nqfree_inf_minus_of_nqfree;
    assumption
  end
| (¬' p) h := by cases h
| (∃' p) h := by cases h

lemma le_hd_coeff_decr {y z i k : int} {zs ks : list int} :
k < 0 → y < z
→ I (A' atom.le i (k :: ks)) (z :: zs)
→ I (A' atom.le i (k :: ks)) (y :: zs) :=
begin
  intros hk hyz h,
  rewrite I_atom_le at *, simp at *,
  apply le_trans h,
  rewrite add_le_add_iff_right,
  rewrite int.mul_le_mul_iff_le_of_neg_left,
  apply le_of_lt hyz, apply hk
end

lemma qe_cooper_one_prsv_lb (z : ℤ) (zs : list ℤ) :
∀ (p : fm atom), nqfree p → fnormal ℤ p → unified p
  → ∀ k, 0 < k → (has_dvd.dvd (divisors_lcm p) k)
    → ¬ I p (z :: zs) → I p ((z + k)::zs)
    → ∃ (k' : int), ∃ iks, iks ∈ bnd_points p
        ∧ (0 ≤ k'
        ∧ k' < k
        ∧ z + k = (k' + (prod.fst iks) + list.dot_prod (map_neg (prod.snd iks)) zs))
| ⊤' hf hn hu k _ hk h1 h2 := by trivial
| ⊥' hf hn hu k _ hk h1 h2 := by trivial
| (A' (atom.le i ks)) hf hn hu k hkp hk h1 h2 :=
  begin
    cases (atom_type.dec_dep0 atom int (atom.le i ks)) with hdep hdep,

    unfold I at h1, unfold interp at h1,
    rewrite iff.symm (atom_type.decr_prsv atom int) at h1,
    unfold I at h2, unfold interp at h2,
    rewrite iff.symm (atom_type.decr_prsv atom int) at h2,
    exfalso, apply h1 h2, apply hdep, apply hdep,

    cases ks with k' ks', exfalso, apply hdep, refl,

    cases (hu (atom.le i (k' :: ks')) _) with hu1 hu2,
    unfold hd_coeff at hu1, unfold list.head_dft at hu1,
    subst hu1,
    exfalso, apply h1,
    apply le_hd_coeff_decr _ _ h2,
    apply int.pred_self_lt,
    apply lt_add_of_pos_right _ hkp,
    cases hu2 with hu2 hu2,
    unfold hd_coeff at hu2,
    unfold list.head_dft at hu2,
    subst hu2, exfalso, apply hdep, refl,

    unfold hd_coeff at hu2,
    unfold list.head_dft at hu2,
    subst hu2,
    existsi ((z + k) - (i + list.dot_prod (map_neg (ks')) zs)),
    existsi (i,ks'),
    apply and.intro, apply or.inl rfl,
    apply and.intro, unfold map_neg,

    rewrite list.neg_dot_prod,
    rewrite sub_add_eq_sub_sub,
    rewrite sub_neg_eq_add,
    unfold I at h2, unfold interp at h2,
    have hv : i ≤ list.dot_prod (1::ks') ((z + k) :: zs),
    apply h2, rewrite list.cons_dot_prod_cons at hv,
    rewrite iff.symm (sub_le_sub_iff_right i) at hv,
    simp at hv, simp, apply hv,

    apply and.intro,

    have hv : ¬ (i ≤ list.dot_prod (1::ks') (z:: zs)),
    apply h1, rewrite not_le at hv,
    rewrite list.cons_dot_prod_cons at hv,
    unfold map_neg, rewrite list.neg_dot_prod,
    simp at hv,
    have hv' := add_lt_add_right (sub_lt_sub_right hv i) k,
    simp at hv', simp, apply hv',

    simp, rewrite add_comm k (-i),
    rewrite eq.symm (add_assoc _ _ _), simp,

    apply or.inl rfl
  end
| (A' (atom.ndvd d i ks)) hf hn hu k _ hk h1 h2 :=
  begin
    cases (atom_type.dec_dep0 atom int (atom.dvd d i ks)) with hdep hdep,

    unfold I at h1, unfold interp at h1,
    rewrite iff.symm (atom_type.decr_prsv atom int) at h1,
    unfold I at h2, unfold interp at h2,
    rewrite iff.symm (atom_type.decr_prsv atom int) at h2,
    exfalso, apply h1 h2, apply hdep, apply hdep,

    rewrite atom_ndvd_mod d at h1,
    rewrite atom_ndvd_mod d at h2,
    rewrite mod_add_eq_mod at h2,
    exfalso, apply h1 h2,
    apply dvd.trans (int.dvd_lcms _) hk,
    rewrite list.mem_map,
    existsi (atom.ndvd d i ks), apply and.intro,
    unfold atoms_dep0, rewrite list.mem_filter,
    apply and.intro, apply or.inl rfl,
    apply hdep, refl, apply dvd_refl, apply dvd_refl
  end
  | (A' (atom.dvd d i ks)) hf hn hu k _ hk h1 h2 :=
  begin
    cases (atom_type.dec_dep0 atom int (atom.dvd d i ks)) with hdep hdep,

    unfold I at h1, unfold interp at h1,
    rewrite iff.symm (atom_type.decr_prsv atom int) at h1,
    unfold I at h2, unfold interp at h2,
    rewrite iff.symm (atom_type.decr_prsv atom int) at h2,
    exfalso, apply h1 h2, apply hdep, apply hdep,

    rewrite atom_dvd_mod d at h1,
    rewrite atom_dvd_mod d at h2,
    rewrite mod_add_eq_mod at h2,
    exfalso, apply h1 h2,
    apply dvd.trans (int.dvd_lcms _) hk,
    rewrite list.mem_map,
    existsi (atom.dvd d i ks), apply and.intro,
    unfold atoms_dep0, rewrite list.mem_filter,
    apply and.intro, apply or.inl rfl,
    apply hdep, refl,
    apply dvd_refl, apply dvd_refl
  end
| (p ∨' q) hf hn hu k hkp hk h1 h2 :=
  begin
    rewrite exp_I_or at h1,
    rewrite not_or_distrib at h1,
    rewrite exp_I_or at h2, cases h1 with hp hq,
    cases hn with hnp hnq,
    cases hf with hfp hfq,
    unfold unified at hu,
    unfold atoms at hu,
    rewrite list.forall_mem_union at hu,
    cases hu with hup huq,
    cases h2 with h2 h2,
    cases (qe_cooper_one_prsv_lb p hfp hnp hup k hkp _ _ h2) with k' ik',
    cases ik' with iks hiks, cases hiks with hm h,
    existsi k', existsi iks, apply and.intro,
    apply mem_bnd_points_and, apply or.inl hm, apply h,
    apply dvd.trans _ hk, apply divisors_lcm_dvd_and_left,
    assumption,
    cases (qe_cooper_one_prsv_lb q hfq hnq huq k hkp _ _ h2) with k' ik',
    cases ik' with iks hiks, cases hiks with hm h,
    existsi k', existsi iks, apply and.intro,
    apply mem_bnd_points_and, apply or.inr hm, apply h,
    apply dvd.trans _ hk, apply divisors_lcm_dvd_and_right,
    assumption
  end
| (p ∧' q) hf hn hu k hkp hk h1 h2 :=
  begin
    rewrite exp_I_and at h1,
    rewrite (@not_and_distrib _ _ (classical.prop_decidable _)) at h1,
    rewrite exp_I_and at h2,
    cases h2 with h1p h1q,
    cases hn with hnp hnq,
    cases hf with hfp hfq,
    unfold unified at hu,
    unfold atoms at hu,
    rewrite list.forall_mem_union at hu,
    cases hu with hup huq,
    cases h1 with h1 h1,
    cases (qe_cooper_one_prsv_lb p hfp hnp hup k hkp _ h1 _) with k' ik',
    cases ik' with iks hiks, cases hiks with hm h,
    existsi k', existsi iks, apply and.intro,
    apply mem_bnd_points_and, apply or.inl hm, apply h,
    apply dvd.trans _ hk, apply divisors_lcm_dvd_and_left,
    assumption,
    cases (qe_cooper_one_prsv_lb q hfq hnq huq k hkp _ h1 _) with k' ik',
    cases ik' with iks hiks, cases hiks with hm h,
    existsi k', existsi iks, apply and.intro,
    apply mem_bnd_points_and, apply or.inr hm, apply h,
    apply dvd.trans _ hk, apply divisors_lcm_dvd_and_right,
    assumption
  end
| (¬' p) hf hn hu k _ hk h1 h2 := by cases hf
| (∃' p) hf hn hu k _ hk h1 h2 := by cases hf

lemma qe_cooper_one_prsv :
  ∀ (p : fm atom), nqfree p → fnormal ℤ p → unified p
  → ∀ (bs : list ℤ), I (qe_cooper_one p) bs ↔ ∃ (b : ℤ), I p (b :: bs) :=
begin
  intros p hf hn hu bs,
  unfold qe_cooper_one, simp,
  rewrite exp_I_or_o,
  apply iff.intro; intro h,
  cases h with h h, unfold disj at h,
  rewrite I_list_disj at h, cases h with q hq,
  cases hq with hq1 hq2,
  rewrite list.mem_map at hq1,
  cases hq1 with r hr,
  rewrite list.mem_map at hr, cases hr with hr1 hr2,
  subst hr2, cases hr1 with z hz, cases hz with hz1 hz2,
  subst hz2, rewrite subst_prsv at hq2,
  rewrite list.nil_dot_prod at hq2,
  rewrite add_zero at hq2,

  cases (inf_minus_prsv bs p) with lb hlb,

  cases (no_lb_inf_minus p hf hn z bs hq2 lb) with x hx,
  cases hx with hx1 hx2,

  rewrite (hlb x hx1) at hx2,
  existsi x, apply hx2, apply nqfree_inf_minus_of_nqfree _ hf,

  unfold disj at h, rewrite I_list_disj at h,
  cases h with q hq, rewrite list.mem_map at hq,
  cases hq with r hr, cases r with s hs,
  rewrite list.mem_map at hs, cases hs with h1 h2,
  cases h1 with zzs hzzs, cases hzzs with h2 h3,
  subst h3, subst h2, rewrite I_list_disj at hr,
  cases hr with t ht, rewrite list.mem_map at ht,
  cases ht with v hv, cases v with w hw,
  rewrite list.mem_map at hw, cases hw with hw1 hw2,
  subst hw2, cases hw1 with z hz, cases hz with hz1 hz2,
  subst hz2, rewrite subst_prsv at hv,
  constructor, apply hv, apply hf,

  rewrite ex_iff_inf_or_bnd at h, cases h with h h,
  apply or.inl, cases (inf_minus_prsv bs p) with lb hlb,
  cases (h lb) with x hx, cases hx with hx1 hx2,
  rewrite iff.symm (hlb x hx1) at hx2,
  unfold disj, rewrite I_list_disj, simp,
  unfold function.comp,
  existsi (I (inf_minus p) ( (int.mod x (divisors_lcm p)) :: bs)),
  apply and.intro, rewrite list.mem_map,
  existsi (int.mod x (divisors_lcm p)), apply and.intro,
  apply list.mem_irange, apply int.mod_nonneg,

  apply int.nonzero_of_pos, apply pos_divisors_lcm,
  apply hn, apply int.lcms_nonneg,
  unfold divisors_lcm, apply int.mod_lt_of_pos,
  apply pos_divisors_lcm, apply hn,
  rewrite subst_prsv, rewrite list.nil_dot_prod,
  rewrite add_zero, rewrite inf_minus_mod at hx2,
  apply nqfree_inf_minus_of_nqfree _ hf, apply hf,
  apply dvd_refl,
  rewrite inf_minus_mod at hx2,
  apply hx2, apply hf, apply dvd_refl,
  cases h with lb hlb, cases hlb with hlb1 hlb2,
  apply or.inr,

  have h :=
    qe_cooper_one_prsv_lb
      (lb - (divisors_lcm p)) bs p hf hn hu
      (divisors_lcm p) (pos_divisors_lcm _ hn)
      (dvd_refl _) _ _,
  cases h with k' h, cases h with iks h, cases h with hiks h,
  cases h with h1 h, cases h with h2 h3,
  simp at h3, subst h3,

  unfold disj, rewrite I_list_disj,

  existsi (I (list_disj
    (list.map (λ (n : ℤ), subst (n + iks.fst) (map_neg (iks.snd)) p)
       (list.irange (int.lcms (list.map divisor (atoms_dep0 ℤ p)))))) bs),

  apply and.intro, rewrite list.mem_map,

  existsi (list_disj
             (list.map (λ (n : ℤ), subst (n + iks.fst) (map_neg (iks.snd)) p)
                (list.irange (int.lcms (list.map divisor (atoms_dep0 ℤ p)))))),
  apply and.intro, rewrite list.mem_map,
  existsi iks, apply and.intro, apply hiks, refl, refl,
  rewrite I_list_disj,
  existsi (I (subst (k' + iks.fst) (map_neg (iks.snd)) p) bs),
  apply and.intro, rewrite list.mem_map,
  existsi (subst (k' + iks.fst) (map_neg (iks.snd)) p),
  apply and.intro, rewrite list.mem_map,
  existsi k', apply and.intro,
  apply list.mem_irange, apply h1,
  apply int.lcms_nonneg, apply h2, refl, refl,
  rewrite subst_prsv, simp, apply hlb1, apply hf,
  apply hlb2, rewrite sub_lt_self_iff,
  apply pos_divisors_lcm, apply hn,
  simp, apply hlb1
end

lemma I_hco_le (lcm z i : ℤ) (zs ks : list ℤ)
  (hpos : lcm > 0)
  (hdvd : coeffs_lcm (A' atom.le i ks) ∣ lcm) :
  I (A' hd_coeff_one lcm (atom.le i ks)) (lcm * z :: zs)
  ↔ I (A' atom.le i ks) (z :: zs) :=
begin
  cases (le_dep0_split i ks) with hdep0 hdep0,
  rewrite hco_not_dep0 _ _ hdep0,
  repeat {rewrite I_not_dep0 _ _ _ hdep0},

  cases hdep0 with k hk, cases hk with ks' hks',
  cases hks' with hk hks', subst hks',
  rewrite coeffs_lcm_atom_le hk at hdvd,

  rewrite hco_le_nonzero, simp,
  repeat {rewrite I_atom_le}, simp,
  apply iff.trans _
    (int.mul_le_mul_iff_le_of_pos_left _ _ (has_div.div lcm (abs k)) _),
  simp, rewrite mul_add, simp,
  rewrite eq.symm (mul_assoc _ k z),
  rewrite int.div_mul_comm lcm _ k,
  rewrite int.mul_div_assoc,
  rewrite eq.symm (int.sign_eq_div_abs _), --int.div_abs_self,
  rewrite mul_comm lcm (int.sign k), simp,
  rewrite mul_assoc, rewrite int.abs_dvd,
  apply dvd_refl, apply hdvd,
  apply int.div_pos_of_pos_of_dvd, apply hpos,
  apply abs_nonneg, apply hdvd, apply hk
end

lemma I_hco_dvd (lcm z d i : ℤ) (zs ks : list ℤ)
  (hpos : lcm > 0)
  (hdvd : coeffs_lcm (A' atom.dvd d i ks) ∣ lcm) :
  I (A' hd_coeff_one lcm (atom.dvd d i ks)) (lcm * z :: zs)
  ↔ I (A' atom.dvd d i ks) (z :: zs) :=
begin
  cases (dvd_dep0_split d i ks) with hdep0 hdep0,
  rewrite hco_not_dep0 _ _ hdep0,
  repeat {rewrite I_not_dep0 _ _ _ hdep0},
  cases hdep0 with k hk, cases hk with ks' hks',
  cases hks' with hk hks', subst hks',
  rewrite coeffs_lcm_atom_dvd hk at hdvd,
  rewrite int.abs_dvd at hdvd,
  rewrite hco_dvd_nonzero, simp,
  repeat {rewrite I_atom_dvd}, simp,
  apply iff.trans _
    (@mul_dvd_mul_iff_left _ _ (has_div.div lcm k) _ _ _),
  rewrite mul_add, rewrite mul_add,
  rewrite eq.symm (mul_assoc _ _ _),
  rewrite int.div_mul_cancel, simp,
  apply hdvd, apply int.div_nonzero,
  apply int.nonzero_of_pos hpos, apply hdvd,
  apply hk
end

lemma I_hco_ndvd (lcm z d i : ℤ) (zs ks : list ℤ)
  (hpos : lcm > 0)
  (hdvd : coeffs_lcm (A' atom.ndvd d i ks) ∣ lcm) :
  I (A' hd_coeff_one lcm (atom.ndvd d i ks)) (lcm * z :: zs)
  ↔ I (A' atom.ndvd d i ks) (z :: zs) :=
begin
  cases (ndvd_dep0_split d i ks) with hdep0 hdep0,
  rewrite hco_not_dep0 _ _ hdep0,
  repeat {rewrite I_not_dep0 _ _ _ hdep0},
  cases hdep0 with k hk, cases hk with ks' hks',
  cases hks' with hk hks', subst hks',
  rewrite coeffs_lcm_atom_ndvd hk at hdvd,
  rewrite int.abs_dvd at hdvd,
  rewrite hco_ndvd_nonzero, simp,
  repeat {rewrite I_atom_ndvd}, simp,
  rewrite (@not_iff_not _ _ (classical.dec _) (classical.dec _)),
  apply iff.trans _
    (@mul_dvd_mul_iff_left _ _ (has_div.div lcm k) _ _ _),
  rewrite mul_add, rewrite mul_add,
  rewrite eq.symm (mul_assoc _ _ _),
  rewrite int.div_mul_cancel, simp,
  apply hdvd, apply int.div_nonzero,
  apply int.nonzero_of_pos hpos, apply hdvd,
  apply hk
end

lemma hcso_prsv_2 (lcm z : int) (zs)
  (hpos : lcm > 0) :
  ∀ (p : fm atom), nqfree p → fnormal ℤ p
  → has_dvd.dvd (coeffs_lcm p) lcm
  → I p (z::zs)
  → I (map_fm (hd_coeff_one lcm) p) ((lcm * z)::zs)
| ⊤' hf hn hdvd h := trivial
| ⊥' hf hn hdvd h := by cases h
| (A' (atom.le i ks)) hf hn hdvd h :=
  begin
    unfold map_fm, rewrite I_hco_le,
    apply h, apply hpos, apply hdvd
  end
| (A' (atom.dvd d i ks)) hf hn hdvd h :=
  begin
    unfold map_fm, rewrite I_hco_dvd,
    apply h, apply hpos, apply hdvd
  end
| (A' (atom.ndvd d i ks)) hf hn hdvd h :=
  begin
    unfold map_fm, rewrite I_hco_ndvd,
    apply h, apply hpos, apply hdvd
  end
| (p ∧' q) hf hn hdvd h :=
  begin
    unfold map_fm, rewrite exp_I_and,
    rewrite exp_I_and at h, cases h with hp hq,
    cases hn with hnp hnq,
    cases hf with hfp hfq,
    rewrite coeffs_lcm_and at hdvd,
    apply and.intro; apply hcso_prsv_2;
    try {assumption},
    apply dvd.trans _ hdvd, apply int.dvd_lcm_left,
    apply dvd.trans _ hdvd, apply int.dvd_lcm_right
  end
| (p ∨' q) hf hn hdvd h :=
  begin
    unfold map_fm, rewrite exp_I_or,
    rewrite exp_I_or at h,
    cases hn with hnp hnq,
    cases hf with hfp hfq,
    rewrite coeffs_lcm_or at hdvd,
    cases h with hp hq, apply or.inl,
    apply hcso_prsv_2; try {assumption},
    apply dvd.trans _ hdvd, apply int.dvd_lcm_left,
    apply or.inr,
    apply hcso_prsv_2; try {assumption},
    apply dvd.trans _ hdvd, apply int.dvd_lcm_right
  end
| (¬' p) hf hn hdvd h := by cases hf
| (∃' p) hf hn hdvd h := by cases hf

meta def hcso_prsv_tac :=
`[rewrite int.dvd_iff_exists at hdvd,
  cases hdvd with w hw, rewrite eq.symm hw,
  rewrite int.mul_div_assoc,
  rewrite int.div_self, rewrite mul_one,
  rewrite eq.symm hw at h, rewrite mul_comm at h]

lemma hcso_prsv_1 (lcm z : int) (zs)
  (hlcm1 : lcm > 0)
  (hdvd : has_dvd.dvd lcm z) :
  ∀ (p : fm atom), nqfree p → fnormal ℤ p
  → (has_dvd.dvd (coeffs_lcm p) lcm)
  → I (map_fm (hd_coeff_one lcm) p) (z::zs)
  → I p ((has_div.div z lcm)::zs)
| ⊤' hf hn _ h := trivial
| ⊥' hf hn _ h := begin exfalso, apply h end
| (A' (atom.le i ks)) hf hn hlcm2 h :=
  begin
    hcso_prsv_tac, unfold map_fm at h,
    rewrite I_hco_le at h; try {assumption},
    apply int.nonzero_of_pos hlcm1, apply dvd_refl
  end
| (A' (atom.dvd d i ks)) hf hn hlcm2 h :=
  begin
    hcso_prsv_tac, unfold map_fm at h,
    rewrite I_hco_dvd at h; try {assumption},
    apply int.nonzero_of_pos hlcm1, apply dvd_refl
  end
| (A' (atom.ndvd d i ks)) hf hn hlcm2 h :=
  begin
    unfold map_fm at h,
    cases (ndvd_dep0_split d i ks) with hc hc,
    rewrite hco_not_dep0 _ _ hc at h,
    rewrite I_not_dep0, rewrite I_not_dep0 at h,
    apply h, apply hc, apply hc,

    cases hc with k hk, cases hk with ks hks,
    cases hks with hks1 hks2, subst hks2,
    rewrite hco_ndvd_nonzero at h, simp at h,

    rewrite coeffs_lcm_atom_ndvd at hlcm2,
    rewrite int.abs_dvd at hlcm2,
    rewrite I_atom_ndvd, rewrite I_atom_ndvd at h,
    intro hc, exfalso, apply h,
    rewrite iff.symm (@mul_dvd_mul_iff_left _ _ (has_div.div lcm k) _ _ _) at hc,
    simp, simp at hc, rewrite mul_add at hc,
    rewrite mul_add at hc, simp at hc,
    rewrite eq.symm (mul_assoc _ _ _) at hc,
    rewrite int.div_mul_cancel at hc,
    rewrite mul_comm lcm at hc,
    rewrite int.div_mul_cancel at hc,
    simp at hc, apply hc, apply hdvd,
    apply hlcm2, apply int.div_nonzero,
    apply int.nonzero_of_pos, apply hlcm1,
    apply hlcm2, apply hks1, apply hks1
  end
| (p ∧' q) hf hn hlcm2 h :=
  begin
    rewrite exp_I_and,
    cases hf with hfp hfq, cases hn with hnp hnq,
    unfold map_fm at h, cases h with hp hq,
    rewrite coeffs_lcm_and at hlcm2,
    apply and.intro; apply hcso_prsv_1;
    try {assumption},
    apply dvd.trans _ hlcm2, apply int.dvd_lcm_left,
    apply dvd.trans _ hlcm2, apply int.dvd_lcm_right,
  end
  | (p ∨' q) hf hn hlcm2 h :=
  begin
    rewrite coeffs_lcm_or at hlcm2,
    rewrite exp_I_or,
    cases hf with hfp hfq, cases hn with hnp hnq,
    unfold map_fm at h, rewrite exp_I_or at h, cases h with hp hq,
    apply or.inl, apply hcso_prsv_1; try {assumption},
    apply dvd.trans _ hlcm2, apply int.dvd_lcm_left,
    apply or.inr, apply hcso_prsv_1; try {assumption},
    apply dvd.trans _ hlcm2, apply int.dvd_lcm_right
  end
| (¬' p) hf hn _ h := by cases hf
| (∃' p) hf hn _ h := by cases hf

lemma hcso_prsv :
∀ (p : fm atom) (hf : nqfree p) (hn : fnormal ℤ p) (bs : list ℤ),
(∃ (b : ℤ), I (hd_coeffs_one p) (b :: bs)) ↔ ∃ (b : ℤ), I p (b :: bs) :=
begin
  intros p hf hn bs, apply iff.intro;
  intro h; cases h with z hz,

  unfold hd_coeffs_one at hz,
  rewrite exp_I_and at hz,
  existsi (has_div.div z (coeffs_lcm p)),
  cases hz with hz1 hz2,
  apply hcso_prsv_1; try {assumption},
  rewrite I_atom_dvd at hz1,
  rewrite zero_add at hz1,
  rewrite list.cons_dot_prod_cons at hz1,
  rewrite list.nil_dot_prod at hz1,
  rewrite add_zero at hz1, rewrite one_mul at hz1,
  apply coeffs_lcm_pos,
  rewrite I_atom_dvd at hz1, simp at hz1,
  apply hz1, apply dvd_refl,

  existsi (coeffs_lcm p * z), unfold hd_coeffs_one,
  rewrite exp_I_and, apply and.intro,
  rewrite I_atom_dvd, rewrite zero_add,
  rewrite list.cons_dot_prod_cons,
  rewrite list.nil_dot_prod,
  rewrite add_zero, rewrite one_mul,
  apply dvd_mul_right, apply hcso_prsv_2;
  try {assumption},
  apply coeffs_lcm_pos, apply dvd_refl
end

lemma sqe_cooper_prsv :
  ∀ (p : fm atom), nqfree p → fnormal ℤ p
  → ∀ (bs : list ℤ), I (sqe_cooper p) bs ↔ ∃ (b : ℤ), I p (b :: bs) :=
begin
  intros p hf hn bs, unfold sqe_cooper,
  rewrite qe_cooper_one_prsv,
  apply hcso_prsv p hf hn bs,
  apply nqfree_hcso_of_nqfree p hf,
  apply hd_coeffs_one_normal_prsv _ hn,
  apply unified_hd_coeffs_one, apply hf
end

lemma qe_cooper_prsv :
  ∀ p, fnormal int p → ∀ (bs : list int), I (qe_cooper p) bs ↔ I p bs :=
  @lia.lnq_prsv sqe_cooper
    sqe_cooper_normal_prsv
    qfree_sqe_cooper_of_nqfree
    sqe_cooper_prsv


/-
Copyright (c) 2021 Ivan Sadofschi Costa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Ivan Sadofschi Costa.
-/
import data.mv_polynomial.basic
import data.mv_polynomial.comm_ring
import algebra.algebra.basic
import degree
import degree_new
import lemmas_g_S
import assorted_lemmas

/-
# Reduce degree

## Main results

- `is_reduced`: A mv_polynomial f is reduced with respect to m : σ →₀ ℕ if no monomial m' in the
  support of f satisfies m ≤ m'.

- `reduce_degree`: Let R be a integral domain and let f ∈ R[xₛ] be a multivariable polynomial.
   Suppose we are given a finite number of nonconstant polynomials gᵢ ∈ R[xₛ] each having a
   dominant monomial mᵢ with coefficient 1. Then we can find polynomials hᵢ ∈ R[xₛ] such that:
  (i) For each i, either hᵢ = 0 or deg hᵢ + deg gᵢ ≤ deg f.
  (ii) For each i, f - ∑ j : τ, hⱼ gⱼ is reduced with respect to mᵢ.

- `reduce_degree_special_case`: Let R be a integral domain and Sᵢ be finite nonempty subsets of R,
   defined for i ∈ {0, … , n - 1}. Let f ∈ R[x₀, … xₙ]. Let gᵢ = ∏ (xᵢ - s)
   where the product is taken over s ∈ Sᵢ.Then there are polynomials
   hᵢ ∈ F[x₀, … xₙ] such that:
   (i) For each i, either hᵢ = 0 or deg hᵢ + |Sᵢ| ≤ deg f.
  (ii) For each j, degⱼ (f - ∑ᵢ hᵢ gᵢ) < |Sⱼ|.

  This corresponds to the following paragraph in the proof of Theorem 1.1 in Alon's
  "Combinatorial Nullstellensatz" paper:
  'Let \bar{f} be the polynomial obtained by writing f as a linear combination of monomials and replacing,
  repeatedly, each occurrence of x ^ f_i (for 1 ≤ i ≤ n), where f_i > t_i, by a linear combination
  of smaller powers of x_i, using the relations g_i = ∏ s in (S i), (X i - C s) = 0. The resulting
  polynomial \bar{f} is clearly of degree at most t_i in x_i, for each 1 ≤ i ≤ n, and is obtained from
  f by subtracting from it products of the form h_i * g_i, where the degree of each polynomial
  h_i ∈ F[x_1 , ... , x_n] does not exceed deg(f) − deg(g_i)'.

-/

universe u

open set function finsupp add_monoid_algebra

open_locale big_operators

namespace mv_polynomial
open set function finsupp add_monoid_algebra

local attribute [instance] classical.prop_decidable

def is_reduced {R σ : Type*} [comm_ring R] (f : mv_polynomial σ R) (m : σ →₀ ℕ) : Prop
:= ∀ m' ∈ f.support, ¬ m ≤ m' -- would ∀ m', m ≤ m' → m ∉ f.support be better?

lemma is_reduced_add {R σ : Type*} [comm_ring R] {f g: mv_polynomial σ R} {m : σ →₀ ℕ}
  (hf : is_reduced f m) (hg : is_reduced g m) : is_reduced (f + g) m :=
begin
  rw is_reduced,
  intros m' hm',
  have t := support_add hm',
  simp only [finset.mem_union] at t,
  cases t,
  { exact hf m' t },
  { exact hg m' t }
end

private def M {R σ τ : Type*} [comm_ring R] [is_domain R] [fintype τ] {g : τ → mv_polynomial σ R}
  {m : τ → (σ →₀ ℕ)} (hm : ∀ i : τ, dominant_monomial (m i) (g i))
  (h0 : ∀ i : τ, 0 < total_degree (g i)) (hmonic : ∀ i : τ, coeff (m i) (g i) = 1) :
  mv_polynomial σ R → Prop := λ f, ∃ h : τ → mv_polynomial σ R,
    (∀ i : τ, h i = 0 ∨ total_degree (h i) + total_degree (g i) ≤ total_degree f)
     ∧ ∀ i : τ,  is_reduced (f - (∑ j : τ, h j * g j)) (m i)

private lemma h_add_weak_aux_comp  {R σ τ : Type*} [comm_ring R] [fintype τ]
  (g : τ → mv_polynomial σ R) (p q : mv_polynomial σ R)  (h1 h2 : τ → mv_polynomial σ R) :
  p + q - (∑ (i : τ), (h1 + h2) i * g i) = (p - (∑ (i : τ), h1 i * g i))
   + (q - (∑ (i : τ), h2 i * g i)) :=
calc p + q - (∑ (i : τ), (h1 + h2) i * g i)
     = p + q - (∑ (i : τ), (h1 i + h2 i) * g i) : by simp
...  = p + q - (∑ (i : τ), (h1 i * g i + h2 i * g i)) :
  begin
    simp only [sub_right_inj],
    congr,
    ext,
    congr,
    rw add_mul,
  end
...  = p + q - (∑ (i : τ), h1 i * g i + ∑ (i : τ), h2 i * g i) :
  by simp only [sub_right_inj,finset.sum_add_distrib]
...  = (p - (∑ (i : τ), h1 i * g i))
       + (q - (∑ (i : τ), h2 i * g i)) :
  by rw [← add_sub_assoc, ← sub_sub (p+q), sub_left_inj,sub_add_eq_add_sub]

private lemma reduce_degree_h_add_weak {R σ τ : Type*} [comm_ring R] [is_domain R] [fintype τ]
  {g : τ → mv_polynomial σ R} {m : τ → (σ →₀ ℕ)} (hm : ∀ i : τ, dominant_monomial (m i) (g i))
  (h0 : ∀ i : τ, 0 < total_degree (g i)) (hmonic : ∀ i : τ, coeff (m i) (g i) = 1) (a : σ →₀ ℕ)
  (b : R) (f : mv_polynomial σ R) (ha : a ∉ f.support) (hb : b ≠ 0) (Mf : M hm h0 hmonic f)
  (Mab : M hm h0 hmonic (monomial a b))  : M hm h0 hmonic (monomial a b + f) :=
begin
  cases Mf with hf h_hf,
  cases Mab with hab h_hab,
  use hab + hf,
  split,
  { intro i,
    simp only [total_degree_add_monomial f a b ha hb, pi.add_apply],
    by_cases c : hab i = 0,
    { by_cases c' : hf i = 0,
      { simp [c, c'] },
      { right,
        simp only [c, zero_add, pi.add_apply],
        exact (or.resolve_left (h_hf.1 i) c').trans (le_max_right (total_degree (monomial a b)) (total_degree f)) } },
    { by_cases c' : hf i = 0,
      { right,
        rw c',
        simp only [add_zero],
        exact (or.resolve_left (h_hab.1 i) c).trans (le_max_left (total_degree (single a b)) (total_degree f)) },
      { right,
        apply le_trans _ (max_le_max (or.resolve_left (h_hab.1 i) c) (or.resolve_left (h_hf.1 i) c')),
        rw max_add_add_right,
        apply add_le_add_right,
        apply total_degree_add } } },
  { intro i,
    rw h_add_weak_aux_comp,
    exact is_reduced_add (h_hab.2 i) (h_hf.2 i) }
end

private lemma total_degree_p_aux { σ : Type*} { m m' a: σ →₀ ℕ} (h_m_le_a : m ≤ a)
  (h : monomial_degree a ≤ monomial_degree m') (c : a - m ≤ m')
  (t: monomial_degree (m' - (a - m)) ≤ monomial_degree m
    ∧ (monomial_degree (m' - (a - m)) = monomial_degree m → m = m' - (a - m))) : a = m' :=
begin
  have h' : m' - (a - m) = m + m' - a,
  { rw add_comm,
    exact monomial_lemma_1 h_m_le_a c },
  rw h' at t,
  clear h',
  suffices h1 : monomial_degree (m + m' - a) = monomial_degree m,
  { ext i,
    zify,
    have t'' :  (m i : ℤ) = m i + m' i - a i,
    { conv
      begin
        to_lhs,
        rw t.2 h1,
      end,
      simp only [pi.add_apply, coe_tsub, coe_add, pi.sub_apply],
      rw int.coe_nat_sub,
      { rw int.coe_nat_add },
      { rw add_comm,
        exact monomial_lemma_2 c i } },
    rw [← add_sub, self_eq_add_right, sub_eq_zero] at t'',
    symmetry,
    exact t'' },
    apply le_antisymm,
    { exact t.1 },
    { suffices t' : monomial_degree m ≤ monomial_degree m + monomial_degree m' - monomial_degree a,
      { apply t'.trans,
        rw ← monomial_degree_add,
        exact monomial_degree_sub_le (m + m') a },
      rw nat.add_sub_assoc,
      { linarith },
      { exact h } },
end

private lemma total_degree_p {R σ : Type*} [comm_ring R] [is_domain R]
  {g :  mv_polynomial σ R} {m a : (σ →₀ ℕ)} (hm : dominant_monomial m g) (h_monic : coeff m g = 1)
  {b : R} (hb : b ≠ 0) (ha : a ≠ 0) (h_m_le_a : m ≤ a )
  : total_degree (monomial a b - (monomial (a - m) b) * g) < monomial_degree a :=
begin
  apply total_degree_sub_lt,
  { by_contradiction,
    simpa [monomial_degree_zero_iff.1 (le_zero_iff.1 (not_lt.1 h))] using ha },
  { intros m' hm' h',
    simp only [exists_prop, mem_support_iff, coeff_monomial, ite_eq_right_iff, ne.def, not_forall] at hm',
    simp only [← hm'.1, coeff_monomial, if_true, eq_self_iff_true],
    rw [coeff_monomial_mul', if_pos],
    { suffices h : coeff (a - (a - m)) g = 1,
      { simp [h] },
      suffices h : a - (a - m) = m,
      { simp [h, h_monic] },
      ext x,
      simp only [coe_tsub, pi.sub_apply, nat.sub_sub_self (h_m_le_a x)] },
    { simp } },
  { intros m' hm' h,
    simp only [mem_support_iff, ne.def, coeff_monomial_mul'] at hm',
    rw coeff_monomial_mul',
    by_cases c : a - m ≤ m',
    { suffices c_m_m' : a = m',
      { simp only [c, if_true, mul_eq_zero, c_m_m'.symm, eq_self_iff_true, coeff_monomial],
        suffices h : coeff (a - (a - m)) g = 1,
        { simp [h] },
        suffices h : a - (a - m) = m,
        { simp [h, h_monic] },
        ext x,
        simp only [coe_tsub, pi.sub_apply, nat.sub_sub_self (h_m_le_a x)] },
      simp only [c, if_true, mul_eq_zero, decidable.not_or_iff_and_not] at hm',
      have t1 := (dominant_monomial_iff hm) (m' - (a - m)) (mem_support_iff.2 hm'.2),
      apply total_degree_p_aux h_m_le_a h c,
      split,
      { exact t1.1 },
      { intro h,
        symmetry,
        exact t1.2 h } },
    { simp only [c, eq_self_iff_true, not_true, if_false] at hm',
      simpa using hm' } }
end

private lemma reduce_degree_h_monomial_a_eq_zero {R σ τ : Type*} [comm_ring R] [is_domain R] [fintype τ]
  {g : τ → mv_polynomial σ R} {m : τ → (σ →₀ ℕ)} (hm : ∀ i : τ, dominant_monomial (m i) (g i))
  (h0 : ∀ i : τ, 0 < total_degree (g i)) (hmonic : ∀ i : τ, coeff (m i) (g i) = 1)
  (b : R) : M hm h0 hmonic (monomial 0 b) :=
begin
  use λ i, 0,
  split,
  { intro i,
    left,
    refl },
  { intro i,
    conv in (0 * g _)
    begin
      rw zero_mul,
    end,
    simp only [monomial_zero', sub_zero, finset.sum_const_zero, is_reduced],
    intros m' hm',
    simp only [exists_prop, coeff_C, mem_support_iff, ite_eq_right_iff, ne.def, not_forall] at hm',
    simp only [← hm'.1, nonpos_iff_eq_zero],
    have hmi := (hm i).1,
    by_contra,
    simp only [max_degree_monomial, h] at hmi,
    simpa [←hmi.2, monomial_degree] using h0 i }
end

private lemma reduce_degree_h_monomial_comp {R σ τ : Type*} [comm_ring R] [is_domain R] [fintype τ]
  {g h0 : τ → mv_polynomial σ R} {m : σ →₀ ℕ} (a: σ →₀ ℕ) (b: R) (i : τ) :
  monomial a b - ∑ (j : τ), (h0 + single i (monomial (a - m) b)) j * g j
    = (monomial a) b - monomial (a - m) b * g i - ∑ (j : τ), h0 j * g j :=
begin
  simp only [pi.add_apply, sub_sub],
  congr,
  rw [← sum_single' i (monomial (a - m) b * g i), ←finset.sum_add_distrib],
  congr,
  ext1 j,
  rw [add_mul, add_comm (h0 j * g j)],
  congr,
  by_cases c : i = j,
  repeat { simp [c] }
end

private lemma reduce_degree_h_monomial {R σ τ : Type*} [comm_ring R] [is_domain R] [fintype τ]
  {g : τ → mv_polynomial σ R} {m : τ → (σ →₀ ℕ)} (hm : ∀ i : τ, dominant_monomial (m i) (g i))
  (h0 : ∀ i : τ, 0 < total_degree (g i)) (hmonic : ∀ i : τ, coeff (m i) (g i) = 1)
  (a : σ →₀ ℕ) (b : R) (hp : ∀ (p : mv_polynomial σ R), p.total_degree < monomial_degree a
    → M hm h0 hmonic p) : M hm h0 hmonic (monomial a b) :=
begin
  by_cases c : ∀ i, is_reduced (monomial a b) (m i),
  { use λ i, 0,
    simp only [true_and, zero_mul, implies_true_iff, true_or, eq_self_iff_true, sub_zero,
               finset.sum_const_zero, c] },
  { by_cases b_eq_zero : b = 0,
    { use λ i, 0,
      simp only [is_reduced, b_eq_zero, finset.not_mem_empty, monomial_zero, forall_false_left,
                 zero_mul, implies_true_iff, true_or, eq_self_iff_true, sub_zero, support_zero,
                 and_self, finset.sum_const_zero] },
    { by_cases a_eq_zero : a = 0,
      { rw a_eq_zero,
        apply reduce_degree_h_monomial_a_eq_zero },
      { simp only [not_forall] at c,
        cases c with i hi,
        simp only [is_reduced, not_forall, exists_prop, not_not, support_monomial,
                  b_eq_zero, if_false, finset.mem_singleton] at hi,
        cases hi with a' ha',
        have ha := ha'.2,
        rw ha'.1 at ha,
        clear ha' a',
        let p := monomial a b - (monomial (a - m i) b) * (g i),
        have h_total_degree_p : p.total_degree < monomial_degree a,
        { exact total_degree_p (hm i) (hmonic i) b_eq_zero a_eq_zero ha },
        cases hp p h_total_degree_p with h0 h_h0,
        let h := h0 + single i (monomial (a - m i) b),
        use h,
        split,
        { intro j,
          by_cases c : j = i,
          { right,
            rw c,
            simp only [h, total_degree_monomial_eq_monomial_degree b_eq_zero, single_eq_same, pi.add_apply],
            have t := hm i,
            simp only [dominant_monomial, max_degree_monomial] at t,
            rw ← t.1.2,
            clear c j h,
            cases h_h0.1 i with hl hr,
            { rw [hl, zero_add],
              apply le_of_eq,
              rw [total_degree_monomial_eq_monomial_degree, monomial_degree_sub ha, nat.sub_add_cancel],
              { exact monomial_degree_le_of_le ha },
              { exact b_eq_zero } },
            { apply (add_le_add_right (total_degree_add (h0 i) (monomial (a - m i) b)) (monomial_degree (m i))).trans,
              by_cases c : (h0 i).total_degree ≤ (monomial (a - m i) b).total_degree,
              { simp only [c, max_eq_right],
                rw [total_degree_monomial_eq_monomial_degree, monomial_degree_sub ha, nat.sub_add_cancel],
                { exact monomial_degree_le_of_le ha },
                { exact b_eq_zero} },
              { simpa only [(not_le.1 c).le, max_eq_left, t.1.2] using hr.trans h_total_degree_p.le } } },
          { simp only [h, pi.add_apply, c, forall_false_left, true_or, ite_eq_right_iff],
            rw single_eq_of_ne,
            cases h_h0.1 j,
            { left,
              simpa using h_1 },
            { right,
              rw add_zero,
              apply h_1.trans,
              rw total_degree_monomial_eq_monomial_degree,
              { exact le_of_lt h_total_degree_p },
              { exact b_eq_zero } },
            symmetry,
            simpa using c, } },
        { suffices comp : monomial a b - ∑ (j : τ), h j * g j = p - ∑ (j : τ), h0 j * g j,
          { rw comp,
            exact h_h0.2 },
          simp only [p, h],
          apply reduce_degree_h_monomial_comp } } } },
end

lemma reduce_degree {R σ τ : Type*} [comm_ring R] [is_domain R] [fintype τ]
  (f : mv_polynomial σ R) (g : τ → mv_polynomial σ R) {m : τ → (σ →₀ ℕ)}
  (hm : ∀ i : τ, dominant_monomial (m i) (g i) ) (h0 : ∀ i : τ, 0 < total_degree (g i))
  (hmonic : ∀ i : τ, coeff (m i) (g i) = 1) : ∃ h : τ → mv_polynomial σ R,
    (∀ i : τ, h i = 0 ∨ total_degree (h i) + total_degree (g i) ≤ total_degree f)
      ∧ ∀ i : τ,  is_reduced (f - (∑ j : τ, h j * g j)) (m i) :=
begin
  apply induction_on_new f,
  { apply reduce_degree_h_add_weak hm h0 hmonic },
  { apply reduce_degree_h_monomial hm h0 hmonic },
end

lemma reduce_degree' {R σ : Type*} [comm_ring R] [is_domain R] [fintype σ]
  (f : mv_polynomial σ R) (g : σ → mv_polynomial σ R)
  (hg : ∀ i : σ, g i ∈ supported R ({i} : set σ)) (h0 : ∀ i : σ, 0 < total_degree (g i))
  (hm : ∀ i : σ, coeff (single i (g i).total_degree) (g i) = 1) :
  ∃ h : σ → mv_polynomial σ R,
    (∀ i : σ, h i = 0 ∨ total_degree (h i) + total_degree (g i) ≤ total_degree f)
      ∧ ∀ i : σ,  degree_of i (f - (∑ j : σ, h j * g j)) < total_degree (g i) :=
begin
  have hm' : ∀ i : σ, dominant_monomial (single i (g i).total_degree) (g i),
  { intro i,
    apply dominant_monomial_single_of_supported_singleton _ (hg i),
    by_contradiction,
    simpa [h] using h0 i },
  cases reduce_degree f g hm' h0 hm with h h_h,
  use h,
  split,
  { exact h_h.1 },
  { intro i,
    rw [degree_of_eq_sup, finset.sup_lt_iff],
    { simpa only [is_reduced, single_le_iff, not_le, ne.def] using h_h.2 i },
    { exact h0 i } }
end

lemma reduce_degree_special_case {R σ : Type*} [comm_ring R] [is_domain R] [fintype σ]
  [decidable_eq σ] (S : σ → finset R) (hS : ∀ i : σ, 0 < (S i).card) (f : mv_polynomial σ R) :
  ∃ h : σ → mv_polynomial σ R,
    (∀ i : σ, h i = 0 ∨ total_degree (h i) + (S i).card ≤ total_degree f)
      ∧ ∀ j : σ, degree_of j (f - (∑ i : σ, h i * ∏ s in S i, (X i - C s))) < (S j).card :=
begin
  let g : σ → mv_polynomial σ R := λ i, ∏ s in S i, (X i - C s),
  let hg : ∀ i : σ, g i ∈ supported R ({i} : set σ) := λ i,  g_S_mem_supported (S i) i,
  have h0 : ∀ i : σ, 0 < total_degree (g i),
  { intro i,
    rw total_degree_g_S,
    exact hS i,
  },
  have hm : ∀ i : σ, coeff (single i (g i).total_degree) (g i) = 1,
  { intro i,
    simpa only [g, total_degree_g_S] using g_S_monic (S i) i },
  cases reduce_degree' f g hg h0 hm with h hh,
  use h,
  split,
  { intro i,
    rw ← total_degree_g_S (S i) i,
    exact hh.1 i, },
  { intro i,
    rw ← total_degree_g_S (S i) i,
    exact hh.2 i },
end

end mv_polynomial


import tactic

universe u

inductive pSet : Type (u+1)
| mk : ∀ α : Type u, (α → pSet) → pSet

namespace pSet

def equiv : pSet → pSet → Prop
| (mk α fα) (mk β fβ) :=
(∀ a, ∃ b, equiv (fα a) (fβ b)) ∧ (∀ b, ∃ a, equiv (fα a) (fβ b))

/-
def equiv (x y : pSet) : Prop :=
pSet.rec (λ α z m ⟨β, B⟩, (∀ a, ∃ b, m a (B b)) ∧ (∀ b, ∃ a, m a (B b))) x y

#check @pSet.rec
Π {motive : pSet → Sort u},
  (Π α (fα : α → pSet),
    (Π (a : α), motive (fα a)) → motive (mk α fα)) →
  Π (n : pSet), motive n
-/

def equiv' (A B : pSet.{u}) : Prop :=
begin
  refine pSet.rec _ A B,
  refine λ α fα ih, _,
  rintro ⟨β, fβ⟩,
  exact (∀ a, ∃ b, ih a (fβ b)) ∧ (∀ b, ∃ a, ih a (fβ b))
end

def equiv'' (A B : pSet.{u}) : Prop :=
begin
  induction A with α fα ih generalizing B,
  change α → pSet → Prop at ih,
  cases B with β fβ,
  exact (∀ a, ∃ b, ih a (fβ b)) ∧ (∀ b, ∃ a, ih a (fβ b))
end

example (A B : pSet.{u}) : equiv A B ↔ equiv' A B :=
begin
  split,
  all_goals {
    induction A with α fα ih generalizing B,
    change ∀ a B, _ at ih,
    cases B with β fβ,
    rintro ⟨h₁, h₂⟩,
    split,
    { clear h₂, rename h₁ h,
      intro a,
      specialize h a,
      cases h with b hb,
      use b,
      exact ih a (fβ b) hb },
    { clear h₁, rename h₂ h,
      intro b,
      specialize h b,
      cases h with a ha,
      use a,
      exact ih a (fβ b) ha }
  }
end

example (A B : pSet.{u}) : equiv' A B ↔ equiv'' A B :=
by tauto

theorem equiv.refl (A : pSet.{u}) : equiv A A :=
begin
  induction A with α fα ih,
  change ∀ a, equiv (fα a) (fα a) at ih,
  exact ⟨λ a, ⟨a, ih a⟩, λ a, ⟨a, ih a⟩⟩
end

theorem equiv.rfl : ∀ {A : pSet.{u}}, equiv A A := equiv.refl

theorem equiv.symm {A B : pSet.{u}} : equiv A B → equiv B A :=
begin
  induction A with α fα ih generalizing B,
  change ∀ a B, equiv (fα a) B → equiv B (fα a) at ih,
  cases B with β fβ,
  rintro ⟨h₁, h₂⟩,
  split,
  { clear h₁, rename h₂ h,
    intro b,
    specialize h b,
    cases h with a ha,
    use a,
    exact ih a (fβ b) ha },
  { clear h₂, rename h₁ h,
    intro a,
    specialize h a,
    cases h with b hb,
    use b,
    exact ih a (fβ b) hb }
end

theorem equiv.trans {A B C : pSet.{u}} (h₁ : equiv A B) (h₂ : equiv B C) :
  equiv A C :=
begin
  induction A with α fα ih generalizing B C,
  change ∀ a B C, equiv (fα a) B → equiv B C → equiv (fα a) C at ih,
  cases B with β fβ,
  cases C with γ fγ,
  cases h₁ with h₁₁ h₁₂,
  cases h₂ with h₂₁ h₂₂,
  split,
  { clear h₁₂ h₂₂, rename h₁₁ h₁, rename h₂₁ h₂,
    intro a,
    specialize h₁ a,
    cases h₁ with b hb,
    specialize h₂ b,
    cases h₂ with c hc,
    use c,
    exact ih a (fβ b) (fγ c) hb hc },
  { clear h₁₁ h₂₁, rename h₁₂ h₁, rename h₂₂ h₂,
    intro c,
    specialize h₂ c,
    cases h₂ with b hb,
    specialize h₁ b,
    cases h₁ with a ha,
    use a,
    exact ih a (fβ b) (fγ c) ha hb }
end

instance setoid : setoid pSet.{u} :=
⟨pSet.equiv, equiv.refl, @equiv.symm, @equiv.trans⟩

end pSet

def Set : Type (u+1) := quotient pSet.setoid.{u}

/-
inductive pgame : Type (u+1)
| mk : ∀ α β : Type u, (α → pgame) → (β → pgame) → pgame
-/