/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import measure_theory.measure.probability_measure
import measure_theory.measure.lebesgue

/-!
# Characterizations of weak convergence of finite measures and probability measures

This file will provide portmanteau characterizations of the weak convergence of finite measures
and of probability measures, i.e., the standard characterizations of convergence in distribution.

## Main definitions

This file does not introduce substantial new definitions: the topologies of weak convergence on
the types of finite measures and probability measures are already defined in their corresponding
files.

## Main results

The main result will be the portmanteau theorem providing various characterizations of the
weak convergence of measures. The separate implications are:
 * `measure_theory.finite_measure.limsup_measure_closed_le_of_tendsto` proves that weak convergence
   implies a limsup-condition for closed sets.
 * `measure_theory.limsup_measure_closed_le_iff_liminf_measure_open_ge` proves for probability
   measures the equivalence of the limsup condition for closed sets and the liminf condition for
   open sets.
 * `measure_theory.tendsto_measure_of_null_frontier` proves that the liminf condition for open
   sets (which is equivalent to the limsup condition for closed sets) implies the convergence of
   probabilities of sets whose boundary carries no mass under the limit measure.
 * `measure_theory.probability_measure.tendsto_measure_of_null_frontier_of_tendsto` is a
   combination of earlier implications, which shows that weak convergence of probability measures
   implies the convergence of probabilities of sets whose boundary carries no mass under the
   limit measure.

TODO:
 * Prove the rest of the implications.

## Implementation notes

Many of the characterizations of weak convergence hold for finite measures and are proven in that
generality and then specialized to probability measures. Some implications hold with slightly
weaker assumptions than usually stated. The full portmanteau theorem, however, is most convenient
for probability measures on metrizable spaces with their Borel sigmas.

Some specific considerations on the assumptions in the different implications:
 * `measure_theory.finite_measure.limsup_measure_closed_le_of_tendsto` assumes
   `pseudo_emetric_space`. The only reason is to have bounded continuous pointwise approximations
   to the indicator function of a closed set. Clearly for example metrizability or
   pseudo-emetrizability would be sufficient assumptions. The typeclass assumptions should be later
   adjusted in a way that takes into account use cases, but the proof will presumably remain
   essentially the same.
 * Where formulations are currently only provided for probability measures, one can obtain the
   finite measure formulations using the characterization of convergence of finite measures by
   their total masses and their probability-normalized versions, i.e., by
   `measure_theory.finite_measure.tendsto_normalize_iff_tendsto`.

## References

* [Billingsley, *Convergence of probability measures*][billingsley1999]

## Tags

weak convergence of measures, convergence in distribution, convergence in law, finite measure,
probability measure

-/

noncomputable theory
open measure_theory
open set
open filter
open bounded_continuous_function
open_locale topology ennreal nnreal bounded_continuous_function

namespace measure_theory

section limsup_closed_le_and_le_liminf_open
/-! ### Portmanteau: limsup condition for closed sets iff liminf condition for open sets

In this section we prove that for a sequence of Borel probability measures on a topological space
and its candidate limit measure, the following two conditions are equivalent:
  (C) For any closed set `F` in `Ω` the limsup of the measures of `F` is at most the limit
      measure of `F`.
  (O) For any open set `G` in `Ω` the liminf of the measures of `G` is at least the limit
      measure of `G`.
Either of these will later be shown to be equivalent to the weak convergence of the sequence
of measures.
-/

variables {Ω : Type*} [measurable_space Ω]

lemma le_measure_compl_liminf_of_limsup_measure_le
  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)]
  {E : set Ω} (E_mble : measurable_set E) (h : L.limsup (λ i, μs i E) ≤ μ E) :
  μ Eᶜ ≤ L.liminf (λ i, μs i Eᶜ) :=
begin
  by_cases L_bot : L = ⊥,
  { simp only [L_bot, le_top,
      (show liminf (λ i, μs i Eᶜ) ⊥ = ⊤, by simp only [liminf, filter.map_bot, Liminf_bot])], },
  haveI : L.ne_bot, from {ne' := L_bot},
  have meas_Ec : μ Eᶜ = 1 - μ E,
  { simpa only [measure_univ] using measure_compl E_mble (measure_lt_top μ E).ne, },
  have meas_i_Ec : ∀ i, μs i Eᶜ = 1 - μs i E,
  { intro i,
    simpa only [measure_univ] using measure_compl E_mble (measure_lt_top (μs i) E).ne, },
  simp_rw [meas_Ec, meas_i_Ec],
  have obs : L.liminf (λ (i : ι), 1 - μs i E) = L.liminf ((λ x, 1 - x) ∘ (λ (i : ι), μs i E)),
    by refl,
  rw obs,
  simp_rw ← antitone_const_tsub.map_limsup_of_continuous_at (λ i, μs i E)
            (ennreal.continuous_sub_left ennreal.one_ne_top).continuous_at,
  exact antitone_const_tsub h,
end

lemma le_measure_liminf_of_limsup_measure_compl_le
  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)]
  {E : set Ω} (E_mble : measurable_set E) (h : L.limsup (λ i, μs i Eᶜ) ≤ μ Eᶜ) :
  μ E ≤ L.liminf (λ i, μs i E) :=
compl_compl E ▸ (le_measure_compl_liminf_of_limsup_measure_le (measurable_set.compl E_mble) h)

lemma limsup_measure_compl_le_of_le_liminf_measure
  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)]
  {E : set Ω} (E_mble : measurable_set E) (h : μ E ≤ L.liminf (λ i, μs i E)) :
  L.limsup (λ i, μs i Eᶜ) ≤ μ Eᶜ :=
begin
  by_cases L_bot : L = ⊥,
  { simp only [L_bot, bot_le,
      (show limsup (λ i, μs i Eᶜ) ⊥ = ⊥, by simp only [limsup, filter.map_bot, Limsup_bot])], },
  haveI : L.ne_bot, from {ne' := L_bot},
  have meas_Ec : μ Eᶜ = 1 - μ E,
  { simpa only [measure_univ] using measure_compl E_mble (measure_lt_top μ E).ne, },
  have meas_i_Ec : ∀ i, μs i Eᶜ = 1 - μs i E,
  { intro i,
    simpa only [measure_univ] using measure_compl E_mble (measure_lt_top (μs i) E).ne, },
  simp_rw [meas_Ec, meas_i_Ec],
  have obs : L.limsup (λ (i : ι), 1 - μs i E) = L.limsup ((λ x, 1 - x) ∘ (λ (i : ι), μs i E)),
    by refl,
  rw obs,
  simp_rw ← antitone_const_tsub.map_liminf_of_continuous_at (λ i, μs i E)
            (ennreal.continuous_sub_left ennreal.one_ne_top).continuous_at,
  exact antitone_const_tsub h,
end

lemma limsup_measure_le_of_le_liminf_measure_compl
  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)]
  {E : set Ω} (E_mble : measurable_set E) (h : μ Eᶜ ≤ L.liminf (λ i, μs i Eᶜ)) :
  L.limsup (λ i, μs i E) ≤ μ E :=
compl_compl E ▸ (limsup_measure_compl_le_of_le_liminf_measure (measurable_set.compl E_mble) h)

variables [topological_space Ω] [opens_measurable_space Ω]

/-- One pair of implications of the portmanteau theorem:
For a sequence of Borel probability measures, the following two are equivalent:

(C) The limsup of the measures of any closed set is at most the measure of the closed set
under a candidate limit measure.

(O) The liminf of the measures of any open set is at least the measure of the open set
under a candidate limit measure.
-/
lemma limsup_measure_closed_le_iff_liminf_measure_open_ge
  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)] :
  (∀ F, is_closed F → L.limsup (λ i, μs i F) ≤ μ F)
    ↔ (∀ G, is_open G → μ G ≤ L.liminf (λ i, μs i G)) :=
begin
  split,
  { intros h G G_open,
    exact le_measure_liminf_of_limsup_measure_compl_le
          G_open.measurable_set (h Gᶜ (is_closed_compl_iff.mpr G_open)), },
  { intros h F F_closed,
    exact limsup_measure_le_of_le_liminf_measure_compl
          F_closed.measurable_set (h Fᶜ (is_open_compl_iff.mpr F_closed)), },
end

end limsup_closed_le_and_le_liminf_open -- section

section tendsto_of_null_frontier
/-! ### Portmanteau: limit of measures of Borel sets whose boundary carries no mass in the limit

In this section we prove that for a sequence of Borel probability measures on a topological space
and its candidate limit measure, either of the following equivalent conditions:
  (C) For any closed set `F` in `Ω` the limsup of the measures of `F` is at most the limit
      measure of `F`
  (O) For any open set `G` in `Ω` the liminf of the measures of `G` is at least the limit
      measure of `G`
implies that
  (B) For any Borel set `E` in `Ω` whose boundary `∂E` carries no mass under the candidate limit
      measure, we have that the limit of measures of `E` is the measure of `E` under the
      candidate limit measure.
-/

variables {Ω : Type*} [measurable_space Ω]

lemma tendsto_measure_of_le_liminf_measure_of_limsup_measure_le
  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
  {E₀ E E₁ : set Ω} (E₀_subset : E₀ ⊆ E) (subset_E₁ : E ⊆ E₁) (nulldiff : μ (E₁ \ E₀) = 0)
  (h_E₀ : μ E₀ ≤ L.liminf (λ i, μs i E₀)) (h_E₁ : L.limsup (λ i, μs i E₁) ≤ μ E₁) :
  L.tendsto (λ i, μs i E) (𝓝 (μ E)) :=
begin
  apply tendsto_of_le_liminf_of_limsup_le,
  { have E₀_ae_eq_E : E₀ =ᵐ[μ] E,
      from eventually_le.antisymm E₀_subset.eventually_le
            (subset_E₁.eventually_le.trans (ae_le_set.mpr nulldiff)),
    calc  μ(E)
        = μ(E₀)                      : measure_congr E₀_ae_eq_E.symm
    ... ≤ L.liminf (λ i, μs i E₀)    : h_E₀
    ... ≤ L.liminf (λ i, μs i E)     : _,
    { refine liminf_le_liminf (eventually_of_forall (λ _, measure_mono E₀_subset)) _,
      apply_auto_param, }, },
  { have E_ae_eq_E₁ : E =ᵐ[μ] E₁,
      from eventually_le.antisymm subset_E₁.eventually_le
            ((ae_le_set.mpr nulldiff).trans E₀_subset.eventually_le),
    calc  L.limsup (λ i, μs i E)
        ≤ L.limsup (λ i, μs i E₁)    : _
    ... ≤ μ E₁                       : h_E₁
    ... = μ E                        : measure_congr E_ae_eq_E₁.symm,
    { refine limsup_le_limsup (eventually_of_forall (λ _, measure_mono subset_E₁)) _,
      apply_auto_param, }, },
end

variables [topological_space Ω] [opens_measurable_space Ω]

/-- One implication of the portmanteau theorem:
For a sequence of Borel probability measures, if the liminf of the measures of any open set is at
least the measure of the open set under a candidate limit measure, then for any set whose
boundary carries no probability mass under the candidate limit measure, then its measures under the
sequence converge to its measure under the candidate limit measure.
-/
lemma tendsto_measure_of_null_frontier
  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)]
  (h_opens : ∀ G, is_open G → μ G ≤ L.liminf (λ i, μs i G))
  {E : set Ω} (E_nullbdry : μ (frontier E) = 0) :
  L.tendsto (λ i, μs i E) (𝓝 (μ E)) :=
begin
  have h_closeds : ∀ F, is_closed F → L.limsup (λ i, μs i F) ≤ μ F,
    from limsup_measure_closed_le_iff_liminf_measure_open_ge.mpr h_opens,
  exact tendsto_measure_of_le_liminf_measure_of_limsup_measure_le
        interior_subset subset_closure E_nullbdry
        (h_opens _ is_open_interior) (h_closeds _ is_closed_closure),
end

end tendsto_of_null_frontier --section

section convergence_implies_limsup_closed_le
/-! ### Portmanteau implication: weak convergence implies a limsup condition for closed sets

In this section we prove, under the assumption that the underlying topological space `Ω` is
pseudo-emetrizable, that the weak convergence of measures on `measure_theory.finite_measure Ω`
implies that for any closed set `F` in `Ω` the limsup of the measures of `F` is at most the
limit measure of `F`. This is one implication of the portmanteau theorem characterizing weak
convergence of measures.

Combining with an earlier implication we also get that weak convergence implies that for any Borel
set `E` in `Ω` whose boundary `∂E` carries no mass under the limit measure, the limit of measures
of `E` is the measure of `E` under the limit measure.
-/

variables {Ω : Type*} [measurable_space Ω]

/-- If bounded continuous functions tend to the indicator of a measurable set and are
uniformly bounded, then their integrals against a finite measure tend to the measure of the set.
This formulation assumes:
 * the functions tend to a limit along a countably generated filter;
 * the limit is in the almost everywhere sense;
 * boundedness holds almost everywhere.
-/
lemma measure_of_cont_bdd_of_tendsto_filter_indicator {ι : Type*} {L : filter ι}
  [L.is_countably_generated] [topological_space Ω] [opens_measurable_space Ω]
  (μ : measure Ω) [is_finite_measure μ] {c : ℝ≥0} {E : set Ω} (E_mble : measurable_set E)
  (fs : ι → (Ω →ᵇ ℝ≥0)) (fs_bdd : ∀ᶠ i in L, ∀ᵐ (ω : Ω) ∂μ, fs i ω ≤ c)
  (fs_lim : ∀ᵐ (ω : Ω) ∂μ,
            tendsto (λ (i : ι), (coe_fn : (Ω →ᵇ ℝ≥0) → (Ω → ℝ≥0)) (fs i) ω) L
                    (𝓝 (indicator E (λ x, (1 : ℝ≥0)) ω))) :
  tendsto (λ n, lintegral μ (λ ω, fs n ω)) L (𝓝 (μ E)) :=
begin
  convert finite_measure.tendsto_lintegral_nn_filter_of_le_const μ fs_bdd fs_lim,
  have aux : ∀ ω, indicator E (λ ω, (1 : ℝ≥0∞)) ω = ↑(indicator E (λ ω, (1 : ℝ≥0)) ω),
  from λ ω, by simp only [ennreal.coe_indicator, ennreal.coe_one],
  simp_rw [←aux, lintegral_indicator _ E_mble],
  simp only [lintegral_one, measure.restrict_apply, measurable_set.univ, univ_inter],
end

/-- If a sequence of bounded continuous functions tends to the indicator of a measurable set and
the functions are uniformly bounded, then their integrals against a finite measure tend to the
measure of the set.

A similar result with more general assumptions is
`measure_theory.measure_of_cont_bdd_of_tendsto_filter_indicator`.
-/
lemma measure_of_cont_bdd_of_tendsto_indicator
  [topological_space Ω] [opens_measurable_space Ω]
  (μ : measure Ω) [is_finite_measure μ] {c : ℝ≥0} {E : set Ω} (E_mble : measurable_set E)
  (fs : ℕ → (Ω →ᵇ ℝ≥0)) (fs_bdd : ∀ n ω, fs n ω ≤ c)
  (fs_lim : tendsto (λ (n : ℕ), (coe_fn : (Ω →ᵇ ℝ≥0) → (Ω → ℝ≥0)) (fs n))
            at_top (𝓝 (indicator E (λ x, (1 : ℝ≥0))))) :
  tendsto (λ n, lintegral μ (λ ω, fs n ω)) at_top (𝓝 (μ E)) :=
begin
  have fs_lim' : ∀ ω, tendsto (λ (n : ℕ), (fs n ω : ℝ≥0))
                 at_top (𝓝 (indicator E (λ x, (1 : ℝ≥0)) ω)),
  by { rw tendsto_pi_nhds at fs_lim, exact λ ω, fs_lim ω, },
  apply measure_of_cont_bdd_of_tendsto_filter_indicator μ E_mble fs
      (eventually_of_forall (λ n, eventually_of_forall (fs_bdd n))) (eventually_of_forall fs_lim'),
end

/-- The integrals of thickened indicators of a closed set against a finite measure tend to the
measure of the closed set if the thickening radii tend to zero.
-/
lemma tendsto_lintegral_thickened_indicator_of_is_closed
  {Ω : Type*} [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
  (μ : measure Ω) [is_finite_measure μ] {F : set Ω} (F_closed : is_closed F) {δs : ℕ → ℝ}
  (δs_pos : ∀ n, 0 < δs n) (δs_lim : tendsto δs at_top (𝓝 0)) :
  tendsto (λ n, lintegral μ (λ ω, (thickened_indicator (δs_pos n) F ω : ℝ≥0∞)))
          at_top (𝓝 (μ F)) :=
begin
  apply measure_of_cont_bdd_of_tendsto_indicator μ F_closed.measurable_set
          (λ n, thickened_indicator (δs_pos n) F)
          (λ n ω, thickened_indicator_le_one (δs_pos n) F ω),
  have key := thickened_indicator_tendsto_indicator_closure δs_pos δs_lim F,
  rwa F_closed.closure_eq at key,
end

/-- One implication of the portmanteau theorem:
Weak convergence of finite measures implies that the limsup of the measures of any closed set is
at most the measure of the closed set under the limit measure.
-/
lemma finite_measure.limsup_measure_closed_le_of_tendsto
  {Ω ι : Type*} {L : filter ι}
  [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
  {μ : finite_measure Ω} {μs : ι → finite_measure Ω}
  (μs_lim : tendsto μs L (𝓝 μ)) {F : set Ω} (F_closed : is_closed F) :
  L.limsup (λ i, (μs i : measure Ω) F) ≤ (μ : measure Ω) F :=
begin
  by_cases L = ⊥,
  { simp only [h, limsup, filter.map_bot, Limsup_bot, ennreal.bot_eq_zero, zero_le], },
  apply ennreal.le_of_forall_pos_le_add,
  intros ε ε_pos μ_F_finite,
  set δs := λ (n : ℕ), (1 : ℝ) / (n+1) with def_δs,
  have δs_pos : ∀ n, 0 < δs n, from λ n, nat.one_div_pos_of_nat,
  have δs_lim : tendsto δs at_top (𝓝 0), from tendsto_one_div_add_at_top_nhds_0_nat,
  have key₁ := tendsto_lintegral_thickened_indicator_of_is_closed
                  (μ : measure Ω) F_closed δs_pos δs_lim,
  have room₁ : (μ : measure Ω) F < (μ : measure Ω) F + ε / 2,
  { apply ennreal.lt_add_right (measure_lt_top (μ : measure Ω) F).ne
          ((ennreal.div_pos_iff.mpr
              ⟨(ennreal.coe_pos.mpr ε_pos).ne.symm, ennreal.two_ne_top⟩).ne.symm), },
  rcases eventually_at_top.mp (eventually_lt_of_tendsto_lt room₁ key₁) with ⟨M, hM⟩,
  have key₂ := finite_measure.tendsto_iff_forall_lintegral_tendsto.mp
                μs_lim (thickened_indicator (δs_pos M) F),
  have room₂ : lintegral (μ : measure Ω) (λ a, thickened_indicator (δs_pos M) F a)
                < lintegral (μ : measure Ω) (λ a, thickened_indicator (δs_pos M) F a) + ε / 2,
  { apply ennreal.lt_add_right
          (lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : measure Ω) _).ne
          ((ennreal.div_pos_iff.mpr
              ⟨(ennreal.coe_pos.mpr ε_pos).ne.symm, ennreal.two_ne_top⟩).ne.symm), },
  have ev_near := eventually.mono (eventually_lt_of_tendsto_lt room₂ key₂) (λ n, le_of_lt),
  have aux := λ n, le_trans (measure_le_lintegral_thickened_indicator
                            (μs n : measure Ω) F_closed.measurable_set (δs_pos M)),
  have ev_near' := eventually.mono ev_near aux,
  apply (filter.limsup_le_limsup ev_near').trans,
  haveI : ne_bot L, from ⟨h⟩,
  rw limsup_const,
  apply le_trans (add_le_add (hM M rfl.le).le (le_refl (ε/2 : ℝ≥0∞))),
  simp only [add_assoc, ennreal.add_halves, le_refl],
end

/-- One implication of the portmanteau theorem:
Weak convergence of probability measures implies that the limsup of the measures of any closed
set is at most the measure of the closed set under the limit probability measure.
-/
lemma probability_measure.limsup_measure_closed_le_of_tendsto
  {Ω ι : Type*} {L : filter ι}
  [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
  {μ : probability_measure Ω} {μs : ι → probability_measure Ω}
  (μs_lim : tendsto μs L (𝓝 μ)) {F : set Ω} (F_closed : is_closed F) :
  L.limsup (λ i, (μs i : measure Ω) F) ≤ (μ : measure Ω) F :=
by apply finite_measure.limsup_measure_closed_le_of_tendsto
         ((probability_measure.tendsto_nhds_iff_to_finite_measures_tendsto_nhds L).mp μs_lim)
         F_closed

/-- One implication of the portmanteau theorem:
Weak convergence of probability measures implies that the liminf of the measures of any open set
is at least the measure of the open set under the limit probability measure.
-/
lemma probability_measure.le_liminf_measure_open_of_tendsto
  {Ω ι : Type*} {L : filter ι}
  [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
  {μ : probability_measure Ω} {μs : ι → probability_measure Ω}
  (μs_lim : tendsto μs L (𝓝 μ)) {G : set Ω} (G_open : is_open G) :
  (μ : measure Ω) G ≤ L.liminf (λ i, (μs i : measure Ω) G) :=
begin
  have h_closeds : ∀ F, is_closed F → L.limsup (λ i, (μs i : measure Ω) F) ≤ (μ : measure Ω) F,
    from λ F F_closed, probability_measure.limsup_measure_closed_le_of_tendsto μs_lim F_closed,
  exact le_measure_liminf_of_limsup_measure_compl_le
        G_open.measurable_set (h_closeds _ (is_closed_compl_iff.mpr G_open)),
end

lemma probability_measure.tendsto_measure_of_null_frontier_of_tendsto'
  {Ω ι : Type*} {L : filter ι}
  [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
  {μ : probability_measure Ω} {μs : ι → probability_measure Ω}
  (μs_lim : tendsto μs L (𝓝 μ)) {E : set Ω} (E_nullbdry : (μ : measure Ω) (frontier E) = 0) :
  tendsto (λ i, (μs i : measure Ω) E) L (𝓝 ((μ : measure Ω) E)) :=
begin
  have h_opens : ∀ G, is_open G → (μ : measure Ω) G ≤ L.liminf (λ i, (μs i : measure Ω) G),
    from λ G G_open, probability_measure.le_liminf_measure_open_of_tendsto μs_lim G_open,
  exact tendsto_measure_of_null_frontier h_opens E_nullbdry,
end

/-- One implication of the portmanteau theorem:
Weak convergence of probability measures implies that if the boundary of a Borel set
carries no probability mass under the limit measure, then the limit of the measures of the set
equals the measure of the set under the limit probability measure.

A version with coercions to ordinary `ℝ≥0∞`-valued measures is
`measure_theory.probability_measure.tendsto_measure_of_null_frontier_of_tendsto'`.
-/
lemma probability_measure.tendsto_measure_of_null_frontier_of_tendsto
  {Ω ι : Type*} {L : filter ι}
  [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
  {μ : probability_measure Ω} {μs : ι → probability_measure Ω}
  (μs_lim : tendsto μs L (𝓝 μ)) {E : set Ω} (E_nullbdry : μ (frontier E) = 0) :
  tendsto (λ i, μs i E) L (𝓝 (μ E)) :=
begin
  have E_nullbdry' : (μ : measure Ω) (frontier E) = 0,
    by rw [← probability_measure.ennreal_coe_fn_eq_coe_fn_to_measure, E_nullbdry, ennreal.coe_zero],
  have key := probability_measure.tendsto_measure_of_null_frontier_of_tendsto' μs_lim E_nullbdry',
  exact (ennreal.tendsto_to_nnreal (measure_ne_top ↑μ E)).comp key,
end

end convergence_implies_limsup_closed_le --section

section limit_borel_implies_limsup_closed_le
/-! ### Portmanteau implication: limit condition for Borel sets implies limsup for closed sets

TODO: The proof of the implication is not yet here. Add it.
-/

variables {Ω : Type*} [pseudo_emetric_space Ω] [measurable_space Ω] [opens_measurable_space Ω]

lemma exists_null_frontier_thickening
  (μ : measure Ω) [sigma_finite μ] (s : set Ω) {a b : ℝ} (hab : a < b) :
  ∃ r ∈ Ioo a b, μ (frontier (metric.thickening r s)) = 0 :=
begin
  have mbles : ∀ (r : ℝ), measurable_set (frontier (metric.thickening r s)),
    from λ r, (is_closed_frontier).measurable_set,
  have disjs := metric.frontier_thickening_disjoint s,
  have key := @measure.countable_meas_pos_of_disjoint_Union Ω _ _ μ _ _ mbles disjs,
  have aux := @measure_diff_null ℝ _ volume (Ioo a b) _ (set.countable.measure_zero key volume),
  have len_pos : 0 < ennreal.of_real (b - a), by simp only [hab, ennreal.of_real_pos, sub_pos],
  rw [← real.volume_Ioo, ← aux] at len_pos,
  rcases nonempty_of_measure_ne_zero len_pos.ne.symm with ⟨r, ⟨r_in_Ioo, hr⟩⟩,
  refine ⟨r, r_in_Ioo, _⟩,
  simpa only [mem_set_of_eq, not_lt, le_zero_iff] using hr,
end

lemma exists_null_frontiers_thickening (μ : measure Ω) [sigma_finite μ] (s : set Ω) :
  ∃ (rs : ℕ → ℝ), tendsto rs at_top (𝓝 0) ∧
                  ∀ n, 0 < rs n ∧ μ (frontier (metric.thickening (rs n) s)) = 0 :=
begin
  rcases exists_seq_strict_anti_tendsto (0 : ℝ) with ⟨Rs, ⟨rubbish, ⟨Rs_pos, Rs_lim⟩⟩⟩,
  have obs := λ (n : ℕ), exists_null_frontier_thickening μ s (Rs_pos n),
  refine ⟨(λ (n : ℕ), (obs n).some), ⟨_, _⟩⟩,
  { exact tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds Rs_lim
              (λ n, (obs n).some_spec.some.1.le) (λ n, (obs n).some_spec.some.2.le), },
  { exact λ n, ⟨(obs n).some_spec.some.1, (obs n).some_spec.some_spec⟩, },
end

end limit_borel_implies_limsup_closed_le --section

end measure_theory --namespace


/-
This file contains the definition of a Boolean (disjunctive) clause.
This particular implementation has clauses as lists.

Authors: Cayden Codel, Jeremy Avigad, Marijn Heule
Carnegie Mellon Univeristy
-/

import cnf.literal
import cnf.assignment
import basic

import data.list.basic

-- Represents the parametric type of the variable stored in the literal
variables {V : Type*}

/- Disjunctive clauses are lists of literals, joined by logical ORs. -/
def clause (V : Type*) := list (literal V)

-- Note that the above definition allows for duplication of literals, whereas
-- a set definition would not. Lists also allow for computable functions,
-- while Lean sets are noncomputable by default

namespace clause

open function
open literal
open list

/-! # Properties -/

-- Many of these properties follow directly from lists

instance [inhabited V] : inhabited (clause V) := ⟨[arbitrary (literal V)]⟩

instance has_decidable_eq [decidable_eq V] : decidable_eq (clause V)
| []        []        := is_true rfl
| (a :: as) []        := is_false (λ h, list.no_confusion h)
| []        (b :: bs) := is_false (λ h, list.no_confusion h)
| (a :: as) (b :: bs) :=
  match (literal.decidable_eq V) a b with
  | is_true hab  :=
    match has_decidable_eq as bs with
    | is_true h := is_true (eq.subst hab (eq.subst h rfl))
    | is_false hf := is_false (λ h, list.no_confusion h (λ _ ha, absurd ha hf))
    end
  | is_false hf := is_false (λ h, list.no_confusion h (λ hab _, absurd hab hf))
  end

instance : has_mem (literal V) (clause V) := ⟨list.mem⟩
instance : has_emptyc (clause V) := ⟨list.nil⟩ -- Refactor empty into [] below?
instance [decidable_eq V] : has_union (clause V) := ⟨list.union⟩
instance [decidable_eq V] : has_inter (clause V) := ⟨list.inter⟩
instance : has_singleton (literal V) (clause V) := ⟨λ l, [l]⟩
instance [decidable_eq V] : has_insert (literal V) (clause V) := ⟨list.insert⟩
instance : has_append (clause V) := ⟨list.append⟩
instance : has_subset (clause V) := ⟨list.subset⟩
instance [has_repr V] : has_repr (clause V) := ⟨list.repr⟩

instance [decidable_eq V] (l : literal V) (c : clause V) : decidable (l ∈ c) :=
by apply_instance

/-! # eval -/
section eval

variables (τ : assignment V) (l : literal V) (c c₁ c₂ : clause V)

protected def eval : bool := c.foldr (λ l b, b || (l.eval τ)) ff

@[simp] theorem eval_nil : clause.eval τ [] = ff := rfl

@[simp] theorem eval_singleton : clause.eval τ [l] = l.eval τ :=
by simp only [clause.eval, foldr, ff_bor]

@[simp] theorem eval_cons : clause.eval τ (l :: c) = (l.eval τ) || (c.eval τ) :=
by simp only [clause.eval, foldr, bool.bor_comm]

theorem eval_append : clause.eval τ (c₁ ++ c₂) = c₁.eval τ || c₂.eval τ :=
begin
  unfold clause.eval,
  rw foldr_append,
  cases foldr (λ l b, b || literal.eval τ l) ff c₂,
  { rw bor_ff },
  { rw [bor_tt, foldr_bor_tt] }
end

theorem eval_tt_iff_exists_literal_eval_tt {τ : assignment V} {c : clause V} :
  c.eval τ = tt ↔ ∃ l, l ∈ c ∧ literal.eval τ l = tt :=
begin
  induction c with l ls ih,
  { simp only [eval_nil, not_mem_nil, false_and, exists_false] },
  { simp only [eval_cons, bor_eq_true_eq_eq_tt_or_eq_tt, mem_cons_iff],
    split,
    { rintros (h | h),
      { use [l, or.inl rfl, h] },
      { rcases ih.mp h with ⟨l₂, hl, he⟩,
        use [l₂, mem_cons_of_mem l hl, he] } },
    { rintros ⟨l₂, (rfl | hl), he⟩,
      { exact or.inl he },
      { exact or.inr (ih.mpr ⟨l₂, hl, he⟩) } } }
end

theorem eval_ff_iff_forall_literal_eval_ff {τ : assignment V} {c : clause V} :
  c.eval τ = ff ↔ ∀ l, l ∈ c → literal.eval τ l = ff :=
begin
  induction c with l ls ih,
  { simp only [eval_nil, eq_self_iff_true, not_mem_nil, is_empty.forall_iff, implies_true_iff] },
  { simp only [ih, eval_cons, bor_eq_false_eq_eq_ff_and_eq_ff, mem_cons_iff, forall_eq_or_imp] }
end

theorem eval_tautology {c : clause V} {l : literal V} :
  l ∈ c → l.flip ∈ c → ∀ (τ : assignment V), clause.eval τ c = tt :=
begin
  intros hl hlf τ,
  apply eval_tt_iff_exists_literal_eval_tt.mpr,
  cases h : (literal.eval τ l),
  { exact ⟨l.flip, hlf, eval_flip_of_eval h⟩ },
  { exact ⟨l, hl, h⟩ }
end

theorem eval_tt_of_subset_eval_tt {τ : assignment V} {c₁ c₂ : clause V} :
  c₁ ⊆ c₂ → clause.eval τ c₁ = tt → clause.eval τ c₂ = tt :=
begin
  intros h₁ h₂,
  apply eval_tt_iff_exists_literal_eval_tt.mpr,
  rcases eval_tt_iff_exists_literal_eval_tt.mp h₂ with ⟨l, hl, he⟩,
  exact ⟨l, h₁ hl, he⟩
end

theorem eval_ff_of_superset_eval_ff {τ : assignment V} {c₁ c₂ : clause V} :
  c₁ ⊆ c₂ → clause.eval τ c₂ = ff → clause.eval τ c₁ = ff :=
begin
  intros h₁ h₂,
  apply eval_ff_iff_forall_literal_eval_ff.mpr,
  intros l hl,
  exact (eval_ff_iff_forall_literal_eval_ff.mp h₂) l (h₁ hl)
end

theorem eval_tt_of_sublist_eval_tt {τ : assignment V} {c₁ c₂ : clause V} :
  c₁ <+ c₂ → clause.eval τ c₁ = tt → clause.eval τ c₂ = tt :=
assume h₁, eval_tt_of_subset_eval_tt (sublist.subset h₁)

theorem eval_ff_of_superlist_eval_ff {τ : assignment V} {c₁ c₂ : clause V} :
  c₁ <+ c₂ → clause.eval τ c₂ = ff → clause.eval τ c₁ = ff :=
assume h₁, eval_ff_of_superset_eval_ff (sublist.subset h₁)

theorem eval_tt_cons_of_eval_tt {τ : assignment V} {c : clause V} (l : literal V) :
  clause.eval τ c = tt → clause.eval τ (l :: c) = tt :=
assume h, eval_tt_of_sublist_eval_tt (sublist_cons l c) h

theorem eval_ff_of_eval_ff_cons {τ : assignment V} {c : clause V} {l : literal V} :
  clause.eval τ (l :: c) = ff → clause.eval τ c = ff :=
assume h, eval_ff_of_superlist_eval_ff (sublist_cons l c) h

end eval

/-! ### Counting -/
section counting

variables (τ : assignment V) (l : literal V) (c c₁ c₂ : clause V)

protected def count_tt : nat := c.countp (literal.is_true τ)
protected def count_ff : nat := c.countp (literal.is_false τ)

def count_pos (c : clause V) : nat := c.countp literal.is_pos
def count_neg (c : clause V) : nat := c.countp literal.is_neg

@[simp] lemma count_tt_nil : clause.count_tt τ [] = 0 := rfl
@[simp] lemma count_ff_nil : clause.count_ff τ [] = 0 := rfl
@[simp] lemma count_pos_nil : count_pos ([] : clause V) = 0 := rfl
@[simp] lemma count_neg_nil : count_neg ([] : clause V) = 0 := rfl

@[simp] theorem count_tt_singleton : clause.count_tt τ [l] = cond (l.eval τ) 1 0 :=
by cases h : (l.eval τ); simp [h, clause.count_tt, literal.is_true]

@[simp] theorem count_ff_singleton : clause.count_ff τ [l] = cond (l.eval τ) 0 1 :=
by cases h : (l.eval τ); simp [h, clause.count_ff, literal.is_false]

@[simp] theorem count_pos_singleton : count_pos [l] = cond l.is_pos 1 0 :=
by cases l; simp [count_pos, literal.is_pos]

@[simp] theorem count_neg_singleton : count_neg [l] = cond l.is_neg 1 0 :=
by cases l; simp [count_neg, literal.is_neg]

@[simp] theorem count_tt_cons : clause.count_tt τ (l :: c) = cond (l.eval τ) (1 + c.count_tt τ) (c.count_tt τ) :=
by cases h : (l.eval τ); simp [h, literal.is_true, clause.count_tt, add_comm]

@[simp] theorem count_ff_cons : clause.count_ff τ (l :: c) = cond (l.eval τ) (c.count_ff τ) (1 + c.count_ff τ) :=
by cases h : (l.eval τ); simp [h, literal.is_false, clause.count_ff, add_comm]

@[simp] theorem count_pos_cons : count_pos (l :: c) = cond l.is_pos (1 + c.count_pos) c.count_pos :=
by cases l; simp [count_pos, literal.is_pos, add_comm]

@[simp] theorem count_neg_cons : count_neg (l :: c) = cond l.is_neg (1 + c.count_neg) c.count_neg :=
by cases l; simp [count_neg, literal.is_neg, add_comm]

theorem count_tt_append : clause.count_tt τ (c₁ ++ c₂) = clause.count_tt τ c₁ + clause.count_tt τ c₂ :=
begin
  induction c₁ with l ls ih,
  { simp only [count_tt_nil, zero_add, nil_append] },
  { cases h : (literal.eval τ l); simp [h, ih, add_assoc] }
end

theorem count_ff_append : clause.count_ff τ (c₁ ++ c₂) = clause.count_ff τ c₁ + clause.count_ff τ c₂ :=
begin
  induction c₁ with l ls ih,
  { simp only [count_ff_nil, zero_add, nil_append] },
  { cases h : (literal.eval τ l); { simp [h, ih, add_assoc] } }
end

theorem count_pos_append : clause.count_pos (c₁ ++ c₂) = clause.count_pos c₁ + clause.count_pos c₂ :=
begin
  induction c₁ with l ls ih,
  { simp only [nil_append, count_pos_nil, zero_add] },
  { cases l; simp [ih, literal.is_pos, add_assoc] }
end

theorem count_neg_append : clause.count_neg (c₁ ++ c₂) = clause.count_neg c₁ + clause.count_neg c₂ :=
begin
  induction c₁ with l ls ih,
  { simp only [nil_append, count_neg_nil, zero_add] },
  { cases l; { simp [ih, literal.is_neg, add_assoc] } }
end

theorem count_tt_le_length : c.count_tt τ ≤ c.length :=
by simp only [clause.count_tt, countp_eq_length_filter, length_filter]

theorem count_ff_le_length : c.count_ff τ ≤ c.length :=
by simp only [clause.count_ff, countp_eq_length_filter, length_filter]

theorem count_pos_le_length : c.count_pos ≤ c.length :=
by simp only [count_pos, countp_eq_length_filter, length_filter]

theorem count_neg_le_length : c.count_neg ≤ c.length :=
by simp only [count_neg, countp_eq_length_filter, length_filter]

theorem count_tt_plus_count_ff_eq_length (τ : assignment V) (c : clause V) :
  c.count_tt τ + c.count_ff τ = c.length :=
begin
  induction c with l ls ih,
  { simp },
  { cases h : (l.eval τ);
    simp [count_tt_cons, count_ff_cons, h, ← ih],
    { rw [add_assoc, add_comm (clause.count_ff τ ls) 1] },
    { rw [add_comm (clause.count_tt τ ls + clause.count_ff τ ls) 1, ← add_assoc] } }
end

theorem count_tt_eq_length_sub_count_ff : c.count_tt τ = c.length - c.count_ff τ :=
eq_tsub_of_add_eq (count_tt_plus_count_ff_eq_length τ c)

theorem count_ff_eq_length_sub_count_tt : c.count_ff τ = c.length - c.count_tt τ :=
eq_tsub_of_add_eq (add_comm (c.count_tt τ) (c.count_ff τ) ▸ count_tt_plus_count_ff_eq_length τ c)

theorem count_pos_plus_count_neg_eq_length : c.count_pos + c.count_neg = c.length :=
begin
  induction c with l ls ih,
  { simp },
  { cases l;
    simp [count_pos_cons, count_neg_cons, literal.is_pos, literal.is_neg, ← ih],
    { rw [add_comm (count_pos ls + count_neg ls) 1, ← add_assoc] },
    { rw [add_assoc, add_comm 1] } }
end

theorem count_pos_eq_length_sub_count_neg : c.count_pos = c.length - c.count_neg :=
eq_tsub_of_add_eq (count_pos_plus_count_neg_eq_length c)

theorem count_neg_eq_length_sub_count_pos : c.count_neg = c.length - c.count_pos :=
eq_tsub_of_add_eq (add_comm (c.count_pos) (c.count_neg) ▸ count_pos_plus_count_neg_eq_length c)

theorem count_tt_eq_zero_iff_eval_ff {τ : assignment V} {c : clause V} :
  c.count_tt τ = 0 ↔ c.eval τ = ff :=
begin
  rw [clause.count_tt, countp_eq_zero, eval_ff_iff_forall_literal_eval_ff],
  split,
  { intros hc l hl,
    have := hc l hl,
    rw [literal.is_true, eq_ff_eq_not_eq_tt] at this,
    exact this },
  { intros hl a ha, simp [literal.is_true, hl a ha] }
end

theorem count_tt_gt_zero_iff_eval_tt {τ : assignment V} {c : clause V} :
  c.count_tt τ > 0 ↔ c.eval τ = tt :=
begin
  rw [clause.count_tt, eval_tt_iff_exists_literal_eval_tt],
  split,
  { intro hp,
    rcases (countp_pos _).mp hp with ⟨l, hl, he⟩,
    exact ⟨l, hl, he⟩ },
  { rintro ⟨l, hl, he⟩,
    exact (countp_pos _).mpr ⟨l, hl, he⟩ }
end

end counting

/-! # falsify and truthify -/
section falsify

variables (τ : assignment V) (v : V) (l : list V) {c c₁ c₂ : clause V}

-- For any assignment and variables, there is a clause that evaluates to false
-- Simply map each variable in the list to the literal which evaluates to false
def falsify : clause V := l.map (λ v, cond (τ v) (Neg v) (Pos v))
def truthify : clause V := l.map (λ v, cond (τ v) (Pos v) (Neg v))

@[simp] lemma falsify_nil : falsify τ [] = [] := rfl
@[simp] lemma truthify_nil : truthify τ [] = [] := rfl

@[simp] lemma falsify_singleton : falsify τ [v] = cond (τ v) [Neg v] [Pos v] :=
by cases h : τ v; simp [h, falsify]

@[simp] lemma truthify_singleton : truthify τ [v] = cond (τ v) [Pos v] [Neg v] :=
by cases h : τ v; simp [h, truthify]

@[simp] theorem falsify_cons : falsify τ (v :: l) = cond (τ v) (Neg v :: falsify τ l) (Pos v :: falsify τ l) :=
by cases h : τ v; simp [falsify, map_cons, h]

@[simp] theorem truthify_cons : truthify τ (v :: l) = cond (τ v) (Pos v :: truthify τ l) (Neg v :: truthify τ l) :=
by cases h : τ v; simp [truthify, map_cons, h]

theorem falsify_eval_ff : clause.eval τ (falsify τ l) = ff :=
begin
  induction l with v vs ih,
  { rw [falsify_nil, eval_nil] },
  { cases h : (τ v); simp [h, eval_cons, literal.eval, ih] }
end

theorem truthify_eval_tt {l : list V} (hl : l ≠ []) : clause.eval τ (truthify τ l) = tt :=
begin
  induction l with v vs ih,
  { contradiction },
  { cases h : (τ v); simp [h, literal.eval, eval_cons] }
end

theorem flip_truthify_eq_falsify : map literal.flip (truthify τ l) = falsify τ l :=
begin
  induction l with v vs ih,
  { refl },
  { cases h : (τ v); simp [h, literal.eval, ih, literal.flip] }
end

theorem falsify_map_var_eq : map var (falsify τ l) = l :=
begin
  induction l with v vs ih,
  { refl },
  { cases h : (τ v);
    { simp only [falsify_cons, map_cons, h, var, true_and, eq_self_iff_true, cond],
      exact ih } }
end

theorem truthify_map_var_eq : map var (truthify τ l) = l :=
begin
  induction l with v vs ih,
  { refl },
  { cases h : (τ v);
    { simp only [truthify_cons, map_cons, h, var, true_and, eq_self_iff_true, cond],
      exact ih } }
end

theorem count_tt_falsify : clause.count_tt τ (falsify τ l) = 0 :=
count_tt_eq_zero_iff_eval_ff.mpr (falsify_eval_ff τ l)

lemma count_tt_truthify : clause.count_tt τ (truthify τ l) = length l :=
begin
  induction l with v vs ih,
  { refl },
  { cases h : τ v; simp [literal.eval, h, ih, add_comm] }
end

theorem count_tt_sublist : c₁ <+ c₂ → c₁.count_tt τ ≤ c₂.count_tt τ :=
assume h, by simp [clause.count_tt, sublist.countp_le (literal.is_true τ) h]

theorem count_ff_sublist : c₁ <+ c₂ → c₁.count_ff τ ≤ c₂.count_ff τ :=
assume h, by simp [clause.count_ff, sublist.countp_le (literal.is_false τ) h]

theorem count_pos_sublist : c₁ <+ c₂ → c₁.count_pos ≤ c₂.count_pos :=
assume h, by simp [count_pos, sublist.countp_le literal.is_pos h]

theorem count_neg_sublist : c₁ <+ c₂ → c₁.count_neg ≤ c₂.count_neg :=
assume h, by simp [count_neg, sublist.countp_le literal.is_neg h]

theorem pos_count_tt_iff_exists_tt {τ} : c.count_tt τ > 0 ↔ ∃ l, l ∈ c ∧ literal.is_true τ l :=
by simp [clause.count_tt, countp_pos]

theorem pos_count_ff_iff_exists_ff {τ} : c.count_ff τ > 0 ↔ ∃ l, l ∈ c ∧ literal.is_false τ l :=
by simp [clause.count_ff, countp_pos]

theorem pos_count_pos_iff_exists_pos : c.count_pos > 0 ↔ ∃ l, l ∈ c ∧ literal.is_pos l :=
by simp [count_pos, countp_pos]

theorem pos_count_neg_iff_exists_neg : c.count_neg > 0 ↔ ∃ l, l ∈ c ∧ literal.is_neg l :=
by simp [count_neg, countp_pos]

theorem count_tt_perm : c₁ ~ c₂ → ∀ (τ : assignment V), c₁.count_tt τ = c₂.count_tt τ :=
begin
  intros hp τ,
  induction hp with x l₂ l₂' p IH  x y l₂  l₂ m₂ r₂ p₁ p₂ IH₁ IH₂,
  { refl },
  { simp [count_tt_cons, IH] },
  { simp [count_tt_cons], cases literal.eval τ x; cases literal.eval τ y; simp },
  { exact eq.trans IH₁ IH₂ }
end

end falsify

/-! # Flip counting -/
section flips

variables [decidable_eq V]

-- If two clauses have the same length, literals can be compared at each
-- position. If they are literal.flip's of each other, increment a counter
def count_flips : clause V → clause V → nat
| []         _        := 0
| _         []        := 0
| (l :: ls) (m :: ms) := ite (l.flip = m)
                         (1 + count_flips ls ms) (count_flips ls ms)

@[simp] lemma count_flips_nil (c : clause V) : count_flips [] c = 0 :=
by cases c; refl

@[simp] theorem count_flips_cons (c₁ c₂ : clause V) (l₁ l₂ : literal V) :
  count_flips (l₁ :: c₁) (l₂ :: c₂) = ite (l₁.flip = l₂)
    (1 + count_flips c₁ c₂) (count_flips c₁ c₂) :=
by by_cases l₁.flip = l₂; simp only [count_flips]

@[simp] theorem count_flips_self (c : clause V) : count_flips c c = 0 :=
begin
  induction c with l ls ih,
  { refl },
  { simp [count_flips, flip_ne, ih] }
end

theorem count_flips_comm (c₁ c₂ : clause V) : count_flips c₁ c₂ = count_flips c₂ c₁ :=
begin
  induction c₁ with l ls ih generalizing c₂,
  { cases c₂; simp [count_flips] },
  { cases c₂,
    { refl },
    { simp [count_flips, ih c₂_tl],
      by_cases h : (l.flip = c₂_hd),
      { simp [h, flip_eq_iff_eq_flip.mp h, flip_flip] },
      { simp [h, ne.symm (flip_ne_iff_ne_flip.mp h), flip_flip] } } }
end

theorem count_flips_pos_of_map_var_eq_of_neq {c₁ c₂ : clause V} :
  map var c₁ = map var c₂ → c₁ ≠ c₂ → count_flips c₁ c₂ > 0 :=
begin
  intros h hne,
  induction c₁ with l ls ih generalizing c₂,
  { exact absurd (eq_nil_of_map_eq_nil h.symm).symm hne },
  { rcases exists_map_cons_of_map_cons h.symm with ⟨x, xs, rfl, hxl, hxs⟩,
    unfold count_flips,
    rcases var_eq_iff_eq_or_flip_eq.mp hxl with rfl | rfl,
    { simp [ih (tail_eq_of_cons_eq h) (ne_tail_of_eq_head_of_ne hne rfl)] },
    { simp [flip_flip, nat.zero_lt_one_add] } }
end

theorem count_flips_falsify_eq_count_tt (τ : assignment V) (c : clause V) :
  count_flips c (falsify τ (map var c)) = clause.count_tt τ c :=
begin
  induction c with l ls ih,
  { simp },
  { cases l; { cases h : (τ l); { simp [var, h, literal.eval, literal.flip, ih] } } }
end

/-! ## Parity reasoning for evaluation -/

theorem eval_tt_of_map_var_eq_of_tt_ne_neg {τ : assignment V} {l : list V} {c : clause V} :
  map var c = l → clause.count_tt τ (map Pos l) ≠ count_neg c → c.eval τ = tt :=
begin
  induction l with v vs ih generalizing c,
  { rw map_eq_nil, rintro rfl, contradiction },
  { intros hc hne,
    rcases exists_cons_of_map_cons hc with ⟨l, ls, rfl, rfl, hls⟩,
    cases l,
    { cases h : τ l,
      { simp [literal.eval, var, literal.is_neg, h] at hne,
        exact eval_tt_cons_of_eval_tt _ (ih hls hne) },
      { simp [literal.eval, h] } },
    { cases h : τ l,
      { simp [literal.eval, h] },
      { simp [literal.eval, var, literal.is_neg, h] at hne,
        exact eval_tt_cons_of_eval_tt _ (ih hls hne) } } }
end

-- Corollary of the above wrt parity reasoning
theorem eval_tt_of_map_var_eq_of_ne_parity {τ : assignment V} {l : list V} {c : clause V} :
  map var c = l → (clause.count_tt τ (map Pos l)).bodd ≠ (count_neg c).bodd → c.eval τ = tt :=
λ hc hcount, eval_tt_of_map_var_eq_of_tt_ne_neg hc (ne_of_apply_ne nat.bodd hcount)

-- Parity reasoning based on flips rather than negs
theorem eval_tt_of_ne_flips {τ : assignment V} {c₁ c₂ : clause V} :
  map var c₁ = map var c₂ → c₁.count_tt τ ≠ count_flips c₁ c₂ → c₂.eval τ = tt :=
begin
  induction c₁ with l ls ih generalizing c₂,
  { simp },
  { intros hc₂ hne,
    rcases exists_map_cons_of_map_cons hc₂.symm with ⟨m, ms, rfl, hm, hms⟩,
    cases m,
    { cases h : (τ m),
      { cases l;
        { unfold var at hm,
          simp [literal.eval, literal.flip, ← hm, h] at hne,
          exact eval_tt_cons_of_eval_tt _ (ih hms.symm hne) } },
      { simp only [eval_cons, literal.eval, hm, h, tt_bor] } },
    { cases h : (τ m),
      { simp only [eval_cons, literal.eval, hm, h, bnot, tt_bor] },
      { cases l;
        { unfold var at hm,
          simp [literal.eval, literal.flip, ← hm, h] at hne,
          exact eval_tt_cons_of_eval_tt _ (ih hms.symm hne) } } } }
end

end flips

/-! # vars -/
section vars

variables [decidable_eq V]

protected def vars : clause V → finset V
| []        := ∅
| (l :: ls) := {l.var} ∪ (vars ls)
--| (l :: ls) := insert l.var (vars ls) -- Use insert instead?

@[simp] theorem vars_nil : clause.vars ([] : clause V) = ∅ := rfl
@[simp] theorem vars_singleton (l : literal V) : clause.vars [l] = {l.var} := rfl
@[simp] theorem vars_cons (l : literal V) (c : clause V) : clause.vars (l :: c) = {l.var} ∪ c.vars := rfl

theorem mem_vars_cons_self (l : literal V) (c : clause V) : l.var ∈ clause.vars (l :: c) :=
finset.mem_union_left _ (finset.mem_singleton_self l.var)

theorem mem_vars_cons_of_mem_vars {c : clause V} (l : literal V) {v : V} :
  v ∈ c.vars → v ∈ clause.vars (l :: c) :=
assume h, finset.mem_union.mpr (or.inr h)

theorem vars_cons_of_mem {l : literal V} {c : clause V} : l.var ∈ c.vars →
  clause.vars (l :: c) = c.vars :=
begin
  intro h,
  rw vars_cons,
  apply finset.ext_iff.mpr, intro v,
  split,
  { intro hv,
    rcases finset.mem_union.mp hv with (hmem | hmem),
    { rw finset.mem_singleton at hmem,
      subst hmem,
      exact h },
    { exact hmem } },
  { exact finset.mem_union_right _ }
end

theorem vars_append (c₁ c₂ : clause V) : (c₁ ++ c₂).vars = c₁.vars ∪ c₂.vars :=
begin
  induction c₁ with l ls ih,
  { simp only [finset.empty_union, vars_nil, nil_append] },
  { simp only [cons_append, clause.vars, ih, finset.union_assoc], }
end

theorem vars_perm {c₁ c₂ : clause V} : c₁ ~ c₂ → c₁.vars = c₂.vars :=
begin
  intro hp,
  induction hp with _ _ _ _ IH  x y _  _ _ _ _ _ IH₁ IH₂,
  { refl },
  { unfold clause.vars, rw IH },
  { unfold clause.vars,
    rw [← finset.union_assoc, ← finset.union_assoc, finset.union_comm {x.var} {y.var}] },
  { exact eq.trans IH₁ IH₂ }
end

theorem mem_vars_of_mem {c : clause V} {l : literal V} : l ∈ c → l.var ∈ c.vars :=
begin
  induction c with d ds ih,
  { simp },
  { intro hl,
    rcases eq_or_ne_mem_of_mem hl with rfl | hm,
    { exact finset.mem_union.mpr (or.inl (finset.mem_singleton_self l.var)) },
    { exact finset.mem_union.mpr (or.inr (ih hm.2)) } }
end

theorem exists_mem_clause_of_mem_vars {c : clause V} {v : V} :
  v ∈ c.vars → ∃ (l : literal V), l ∈ c ∧ l.var = v :=
begin
  induction c with l ls ih,
  { simp },
  { intro hmem,
    by_cases h : (l.var = v),
    { use [l, mem_cons_self l ls, h] },
    { rcases finset.mem_union.mp hmem with h₁| h₂,
      { exact absurd (finset.mem_singleton.mp h₁).symm h },
      { rcases ih h₂ with ⟨m, hm, hv⟩, use [m, mem_cons_of_mem l hm, hv] } } }
end

theorem vars_subset_of_vars_cons (l : literal V) (c : clause V) : c.vars ⊆ clause.vars (l :: c) :=
finset.subset_union_right _ _

theorem vars_subset_of_subset {c₁ c₂ : clause V} : c₁ ⊆ c₂ → c₁.vars ⊆ c₂.vars :=
begin
  intros h v hv,
  rcases exists_mem_clause_of_mem_vars hv with ⟨l, hl, rfl⟩,
  exact mem_vars_of_mem (h hl)
end

section mem_vars_lemmas

variables {v : V} {c : clause V}

-- (map var c) and vars c are equivalent from a set perspective
theorem mem_vars_iff_mem_map_vars : v ∈ c.vars ↔ v ∈ map var c :=
begin
  split,
  { intro h,
    exact mem_map.mpr (exists_mem_clause_of_mem_vars h) },
  { intro h,
    rcases mem_map.mp h with ⟨l, hmem, hv⟩,
    exact hv ▸ mem_vars_of_mem hmem }
end

theorem not_mem_vars_iff_not_mem_map_vars : v ∉ map var c ↔ v ∉ c.vars :=
by simp [mem_vars_iff_mem_map_vars]

theorem mem_vars_iff_pos_or_neg_mem_clause : v ∈ c.vars ↔ (Pos v) ∈ c ∨ (Neg v) ∈ c :=
begin
  split,
  { intro h,
    rcases exists_mem_clause_of_mem_vars h with ⟨l, hmem, hv⟩,
    cases l; { rw ← hv, simp [var, hmem] } },
  { rintros (h | h); { exact mem_vars_of_mem h } }
end

theorem vars_append_subset_left (c₁ c₂ : clause V) : c₁.vars ⊆ (c₁ ++ c₂).vars :=
by { rw vars_append, exact finset.subset_union_left _ _ }

theorem vars_append_subset_right (c₁ c₂ : clause V) : c₂.vars ⊆ (c₁ ++ c₂).vars :=
by { rw vars_append, exact finset.subset_union_right _ _ }

theorem mem_vars_append_left {c₁ : clause V} (c₂) : v ∈ c₁.vars → v ∈ (c₁ ++ c₂).vars :=
assume h, vars_append_subset_left c₁ c₂ h

theorem mem_vars_append_right (c₁) {c₂ : clause V} : v ∈ c₂.vars → v ∈ (c₁ ++ c₂).vars :=
assume h, vars_append_subset_right c₁ c₂ h

theorem mem_left_or_right_of_mem_vars_append {c₁ c₂ : clause V} :
  v ∈ (c₁ ++ c₂).vars → (v ∈ c₁.vars) ∨ (v ∈ c₂.vars) :=
by { rw vars_append, exact finset.mem_union.mp }

theorem not_mem_vars_append_left {c₁ c₂ : clause V} : v ∉ (c₁ ++ c₂).vars → v ∉ c₁.vars :=
assume h, mt (mem_vars_append_left c₂) h

theorem not_mem_vars_append_right {c₁ c₂ : clause V} : v ∉ (c₁ ++ c₂).vars → v ∉ c₂.vars :=
assume h, mt (mem_vars_append_right c₁) h

theorem not_mem_vars_append_of_not_mem_of_not_mem {c₁ c₂ : clause V} :
  v ∉ c₁.vars → v ∉ c₂.vars → v ∉ (c₁ ++ c₂).vars :=
begin
  intros h₁ h₂ hcon,
  rcases mem_left_or_right_of_mem_vars_append hcon; { contradiction }
end

end mem_vars_lemmas

open assignment

variables {τ₁ τ₂ : assignment V} {c : clause V}

theorem eval_eq_of_agree_on : (agree_on τ₁ τ₂ c.vars) → c.eval τ₁ = c.eval τ₂ :=
begin
  intro h,
  cases hev : (c.eval τ₂),
  { rw eval_ff_iff_forall_literal_eval_ff at hev,
    apply eval_ff_iff_forall_literal_eval_ff.mpr,
    intros l hl,
    exact hev l hl ▸ eval_eq_of_agree_on_of_var_mem h (mem_vars_of_mem hl) },
  { rcases eval_tt_iff_exists_literal_eval_tt.mp hev with ⟨l, hl, htt⟩,
    apply eval_tt_iff_exists_literal_eval_tt.mpr,
    use [l, hl],
    exact htt ▸ eval_eq_of_agree_on_of_var_mem h (mem_vars_of_mem hl) }
end

theorem nth_eval_eq_of_agree_on {l : list (literal V)} {i : nat} (hi : i < length l) :
  (agree_on τ₁ τ₂ (clause.vars l)) → (l.nth_le i hi).eval τ₁ = (l.nth_le i hi).eval τ₂ :=
assume hagree_on, eval_eq_of_agree_on_of_var_mem hagree_on (mem_vars_of_mem (nth_le_mem _ _ _))

theorem agree_on_of_agree_on_vars_cons {l : literal V} :
  (agree_on τ₁ τ₂ (clause.vars (l :: c))) → agree_on τ₁ τ₂ (clause.vars c) :=
assume hagree_on v hv, hagree_on _ (finset.mem_union_right _ hv)

theorem count_tt_eq_of_agree_on : (agree_on τ₁ τ₂ c.vars) → c.count_tt τ₁ = c.count_tt τ₂ :=
begin
  induction c with l ls ih,
  { simp only [count_tt_nil, agree_on_nil, vars_nil, forall_true_left] },
  { intro h,
    rw clause.vars at h,
    cases l;
    { rw literal.var at h,
      simp [literal.eval, agree_on_union_left h l (finset.mem_singleton_self l), ih (agree_on_union_right h)] } }
end

theorem count_tt_ite (c : clause V) : c.count_tt (aite c.vars τ₁ τ₂) = c.count_tt τ₁ :=
count_tt_eq_of_agree_on (aite_agree_on c.vars τ₁ τ₂)

end vars

end clause


/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky
-/
import group_theory.perm.list
import data.list.cycle
import group_theory.perm.cycle_type

/-!

# Properties of cyclic permutations constructed from lists/cycles

In the following, `{α : Type*} [fintype α] [decidable_eq α]`.

## Main definitions

* `cycle.form_perm`: the cyclic permutation created by looping over a `cycle α`
* `equiv.perm.to_list`: the list formed by iterating application of a permutation
* `equiv.perm.to_cycle`: the cycle formed by iterating application of a permutation
* `equiv.perm.iso_cycle`: the equivalence between cyclic permutations `f : perm α`
  and the terms of `cycle α` that correspond to them
* `equiv.perm.iso_cycle'`: the same equivalence as `equiv.perm.iso_cycle`
  but with evaluation via choosing over fintypes
* The notation `c[1, 2, 3]` to emulate notation of cyclic permutations `(1 2 3)`
* A `has_repr` instance for any `perm α`, by representing the `finset` of
  `cycle α` that correspond to the cycle factors.

## Main results

* `list.is_cycle_form_perm`: a nontrivial list without duplicates, when interpreted as
  a permutation, is cyclic
* `equiv.perm.is_cycle.exists_unique_cycle`: there is only one nontrivial `cycle α`
  corresponding to each cyclic `f : perm α`

## Implementation details

The forward direction of `equiv.perm.iso_cycle'` uses `fintype.choose` of the uniqueness
result, relying on the `fintype` instance of a `cycle.nodup` subtype.
It is unclear if this works faster than the `equiv.perm.to_cycle`, which relies
on recursion over `finset.univ`.
Running `#eval` on even a simple noncyclic permutation `c[(1 : fin 7), 2, 3] * c[0, 5]`
to show it takes a long time. TODO: is this because computing the cycle factors is slow?

-/

open equiv equiv.perm list

namespace list

variables {α : Type*} [decidable_eq α] {l l' : list α}

lemma form_perm_disjoint_iff (hl : nodup l) (hl' : nodup l')
  (hn : 2 ≤ l.length) (hn' : 2 ≤ l'.length) :
  perm.disjoint (form_perm l) (form_perm l') ↔ l.disjoint l' :=
begin
  rw [disjoint_iff_eq_or_eq, list.disjoint],
  split,
  { rintro h x hx hx',
    specialize h x,
    rw [form_perm_apply_mem_eq_self_iff _ hl _ hx,
        form_perm_apply_mem_eq_self_iff _ hl' _ hx'] at h,
    rcases h with hl | hl'; linarith },
  { intros h x,
    by_cases hx : x ∈ l, by_cases hx' : x ∈ l',
    { exact (h hx hx').elim },
    all_goals { have := form_perm_eq_self_of_not_mem _ _ ‹_›, tauto } }
end

lemma is_cycle_form_perm (hl : nodup l) (hn : 2 ≤ l.length) :
  is_cycle (form_perm l) :=
begin
  cases l with x l,
  { norm_num at hn },
  induction l with y l IH generalizing x,
  { norm_num at hn },
  { use x,
    split,
    { rwa form_perm_apply_mem_ne_self_iff _ hl _ (mem_cons_self _ _) },
    { intros w hw,
      have : w ∈ (x :: y :: l) := mem_of_form_perm_ne_self _ _ hw,
      obtain ⟨k, hk, rfl⟩ := nth_le_of_mem this,
      use k,
      simp only [zpow_coe_nat, form_perm_pow_apply_head _ _ hl k, nat.mod_eq_of_lt hk] } }
end

lemma pairwise_same_cycle_form_perm (hl : nodup l) (hn : 2 ≤ l.length) :
  pairwise (l.form_perm.same_cycle) l :=
pairwise.imp_mem.mpr (pairwise_of_forall (λ x y hx hy, (is_cycle_form_perm hl hn).same_cycle
  ((form_perm_apply_mem_ne_self_iff _ hl _ hx).mpr hn)
  ((form_perm_apply_mem_ne_self_iff _ hl _ hy).mpr hn)))

lemma cycle_of_form_perm (hl : nodup l) (hn : 2 ≤ l.length) (x) :
  cycle_of l.attach.form_perm x = l.attach.form_perm :=
have hn : 2 ≤ l.attach.length := by rwa ← length_attach at hn,
have hl : l.attach.nodup := by rwa ← nodup_attach at hl,
(is_cycle_form_perm hl hn).cycle_of_eq
  ((form_perm_apply_mem_ne_self_iff _ hl _ (mem_attach _ _)).mpr hn)

lemma cycle_type_form_perm (hl : nodup l) (hn : 2 ≤ l.length) :
  cycle_type l.attach.form_perm = {l.length} :=
begin
  rw ←length_attach at hn,
  rw ←nodup_attach at hl,
  rw cycle_type_eq [l.attach.form_perm],
  { simp only [map, function.comp_app],
    rw [support_form_perm_of_nodup _ hl, card_to_finset, erase_dup_eq_self.mpr hl],
    { simpa },
    { intros x h,
      simpa [h, nat.succ_le_succ_iff] using hn } },
  { simp },
  { simpa using is_cycle_form_perm hl hn },
  { simp }
end

lemma form_perm_apply_mem_eq_next (hl : nodup l) (x : α) (hx : x ∈ l) :
  form_perm l x = next l x hx :=
begin
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
  rw [next_nth_le _ hl, form_perm_apply_nth_le _ hl]
end

end list

namespace cycle

variables {α : Type*} [decidable_eq α] (s s' : cycle α)

/--
A cycle `s : cycle α` , given `nodup s` can be interpreted as a `equiv.perm α`
where each element in the list is permuted to the next one, defined as `form_perm`.
-/
def form_perm : Π (s : cycle α) (h : nodup s), equiv.perm α :=
λ s, quot.hrec_on s (λ l h, form_perm l)
  (λ l₁ l₂ (h : l₁ ~r l₂),
    begin
      ext,
      { exact h.nodup_iff },
      { intros h₁ h₂ _,
        exact heq_of_eq (form_perm_eq_of_is_rotated h₁ h) }
    end)

@[simp] lemma form_perm_coe (l : list α) (hl : l.nodup) :
  form_perm (l : cycle α) hl = l.form_perm := rfl

lemma form_perm_subsingleton (s : cycle α) (h : subsingleton s) :
  form_perm s h.nodup = 1 :=
begin
  induction s using quot.induction_on,
  simp only [form_perm_coe, mk_eq_coe],
  simp only [length_subsingleton_iff, length_coe, mk_eq_coe] at h,
  cases s with hd tl,
  { simp },
  { simp only [length_eq_zero, add_le_iff_nonpos_left, list.length, nonpos_iff_eq_zero] at h,
    simp [h] }
end

lemma is_cycle_form_perm (s : cycle α) (h : nodup s) (hn : nontrivial s) :
  is_cycle (form_perm s h) :=
begin
  induction s using quot.induction_on,
  exact list.is_cycle_form_perm h (length_nontrivial hn)
end

lemma support_form_perm [fintype α] (s : cycle α) (h : nodup s) (hn : nontrivial s) :
  support (form_perm s h) = s.to_finset :=
begin
  induction s using quot.induction_on,
  refine support_form_perm_of_nodup s h _,
  rintro _ rfl,
  simpa [nat.succ_le_succ_iff] using length_nontrivial hn
end

lemma form_perm_eq_self_of_not_mem (s : cycle α) (h : nodup s) (x : α) (hx : x ∉ s) :
  form_perm s h x = x :=
begin
  induction s using quot.induction_on,
  simpa using list.form_perm_eq_self_of_not_mem _ _ hx
end

lemma form_perm_apply_mem_eq_next (s : cycle α) (h : nodup s) (x : α) (hx : x ∈ s) :
  form_perm s h x = next s h x hx :=
begin
  induction s using quot.induction_on,
  simpa using list.form_perm_apply_mem_eq_next h _ _
end

lemma form_perm_reverse (s : cycle α) (h : nodup s) :
  form_perm s.reverse (nodup_reverse_iff.mpr h) = (form_perm s h)⁻¹ :=
begin
  induction s using quot.induction_on,
  simpa using form_perm_reverse _ h
end

lemma form_perm_eq_form_perm_iff {α : Type*} [decidable_eq α]
  {s s' : cycle α} {hs : s.nodup} {hs' : s'.nodup} :
  s.form_perm hs = s'.form_perm hs' ↔ s = s' ∨ s.subsingleton ∧ s'.subsingleton :=
begin
  rw [cycle.length_subsingleton_iff, cycle.length_subsingleton_iff],
  revert s s',
  intros s s',
  apply quotient.induction_on₂' s s',
  intros l l',
  simpa using form_perm_eq_form_perm_iff
end

end cycle
variables {α : Type*}

namespace equiv.perm

variables [fintype α] [decidable_eq α] (p : equiv.perm α) (x : α)

/--
`equiv.perm.to_list (f : perm α) (x : α)` generates the list `[x, f x, f (f x), ...]`
until looping. That means when `f x = x`, `to_list f x = []`.
-/
def to_list : list α :=
(list.range (cycle_of p x).support.card).map (λ k, (p ^ k) x)

@[simp] lemma to_list_one : to_list (1 : perm α) x = [] :=
by simp [to_list, cycle_of_one]

@[simp] lemma to_list_eq_nil_iff {p : perm α} {x} : to_list p x = [] ↔ x ∉ p.support :=
by simp [to_list]

@[simp] lemma length_to_list : length (to_list p x) = (cycle_of p x).support.card :=
by simp [to_list]

lemma to_list_ne_singleton (y : α) : to_list p x ≠ [y] :=
begin
  intro H,
  simpa [card_support_ne_one] using congr_arg length H
end

lemma two_le_length_to_list_iff_mem_support {p : perm α} {x : α} :
  2 ≤ length (to_list p x) ↔ x ∈ p.support :=
by simp

lemma length_to_list_pos_of_mem_support (h : x ∈ p.support) : 0 < length (to_list p x) :=
zero_lt_two.trans_le (two_le_length_to_list_iff_mem_support.mpr h)

lemma nth_le_to_list (n : ℕ) (hn : n < length (to_list p x)) :
  nth_le (to_list p x) n hn = (p ^ n) x :=
by simp [to_list]

lemma to_list_nth_le_zero (h : x ∈ p.support) :
  (to_list p x).nth_le 0 (length_to_list_pos_of_mem_support _ _ h) = x :=
by simp [to_list]

variables {p} {x}

lemma mem_to_list_iff {y : α} :
  y ∈ to_list p x ↔ same_cycle p x y ∧ x ∈ p.support :=
begin
  simp only [to_list, mem_range, mem_map],
  split,
  { rintro ⟨n, hx, rfl⟩,
    refine ⟨⟨n, rfl⟩, _⟩,
    contrapose! hx,
    rw ←support_cycle_of_eq_nil_iff at hx,
    simp [hx] },
  { rintro ⟨h, hx⟩,
    simpa using same_cycle.nat_of_mem_support _ h hx }
end

lemma nodup_to_list (p : perm α) (x : α) :
  nodup (to_list p x) :=
begin
  by_cases hx : p x = x,
  { rw [←not_mem_support, ←to_list_eq_nil_iff] at hx,
    simp [hx] },
  have hc : is_cycle (cycle_of p x) := is_cycle_cycle_of p hx,
  rw nodup_iff_nth_le_inj,
  rintros n m hn hm,
  rw [length_to_list, ←order_of_is_cycle hc] at hm hn,
  rw [←cycle_of_apply_self, ←ne.def, ←mem_support] at hx,
  rw [nth_le_to_list, nth_le_to_list,
      ←cycle_of_pow_apply_self p x n, ←cycle_of_pow_apply_self p x m],
  cases n; cases m,
  { simp },
  { rw [←hc.mem_support_pos_pow_iff_of_lt_order_of m.zero_lt_succ hm,
        mem_support, cycle_of_pow_apply_self] at hx,
    simp [hx.symm] },
  { rw [←hc.mem_support_pos_pow_iff_of_lt_order_of n.zero_lt_succ hn,
        mem_support, cycle_of_pow_apply_self] at hx,
    simp [hx] },
  intro h,
  have hn' : ¬ order_of (p.cycle_of x) ∣ n.succ := nat.not_dvd_of_pos_of_lt n.zero_lt_succ hn,
  have hm' : ¬ order_of (p.cycle_of x) ∣ m.succ := nat.not_dvd_of_pos_of_lt m.zero_lt_succ hm,
  rw ←hc.support_pow_eq_iff at hn' hm',
  rw [←nat.mod_eq_of_lt hn, ←nat.mod_eq_of_lt hm, ←pow_inj_mod],
  refine support_congr _ _,
  { rw [hm', hn'],
    exact finset.subset.refl _ },
  { rw hm',
    intros y hy,
    obtain ⟨k, rfl⟩ := hc.exists_pow_eq (mem_support.mp hx) (mem_support.mp hy),
    rw [←mul_apply, (commute.pow_pow_self _ _ _).eq, mul_apply, h, ←mul_apply, ←mul_apply,
        (commute.pow_pow_self _ _ _).eq] }
end

lemma next_to_list_eq_apply (p : perm α) (x y : α) (hy : y ∈ to_list p x) :
  next (to_list p x) y hy = p y :=
begin
  rw mem_to_list_iff at hy,
  obtain ⟨k, hk, hk'⟩ := hy.left.nat_of_mem_support _ hy.right,
  rw ←nth_le_to_list p x k (by simpa using hk) at hk',
  simp_rw ←hk',
  rw [next_nth_le _ (nodup_to_list _ _), nth_le_to_list, nth_le_to_list, ←mul_apply, ←pow_succ,
      length_to_list, pow_apply_eq_pow_mod_order_of_cycle_of_apply p (k + 1), order_of_is_cycle],
  exact is_cycle_cycle_of _ (mem_support.mp hy.right)
end

lemma to_list_pow_apply_eq_rotate (p : perm α) (x : α) (k : ℕ) :
  p.to_list ((p ^ k) x) = (p.to_list x).rotate k :=
begin
  apply ext_le,
  { simp },
  { intros n hn hn',
    rw [nth_le_to_list, nth_le_rotate, nth_le_to_list, length_to_list,
        pow_mod_card_support_cycle_of_self_apply, pow_add, mul_apply] }
end

lemma same_cycle.to_list_is_rotated {f : perm α} {x y : α} (h : same_cycle f x y) :
  to_list f x ~r to_list f y :=
begin
  by_cases hx : x ∈ f.support,
  { obtain ⟨_ | k, hk, hy⟩ := h.nat_of_mem_support _ hx,
    { simp only [coe_one, id.def, pow_zero] at hy,
      simp [hy] },
    use k.succ,
    rw [←to_list_pow_apply_eq_rotate, hy] },
  { rw [to_list_eq_nil_iff.mpr hx, is_rotated_nil_iff', eq_comm, to_list_eq_nil_iff],
    rwa ←h.mem_support_iff }
end

lemma pow_apply_mem_to_list_iff_mem_support {n : ℕ} :
  (p ^ n) x ∈ p.to_list x ↔ x ∈ p.support :=
begin
  rw [mem_to_list_iff, and_iff_right_iff_imp],
  refine λ _, same_cycle.symm _,
  rw same_cycle_pow_left_iff
end

lemma to_list_form_perm_nil (x : α) :
  to_list (form_perm ([] : list α)) x = [] :=
by simp

lemma to_list_form_perm_singleton (x y : α) :
  to_list (form_perm [x]) y = [] :=
by simp

lemma to_list_form_perm_nontrivial (l : list α) (hl : 2 ≤ l.length) (hn : nodup l) :
  to_list (form_perm l) (l.nth_le 0 (zero_lt_two.trans_le hl)) = l :=
begin
  have hc : l.form_perm.is_cycle := list.is_cycle_form_perm hn hl,
  have hs : l.form_perm.support = l.to_finset,
  { refine support_form_perm_of_nodup _ hn _,
    rintro _ rfl,
    simpa [nat.succ_le_succ_iff] using hl },
  rw [to_list, hc.cycle_of_eq (mem_support.mp _), hs, card_to_finset, erase_dup_eq_self.mpr hn],
  { refine list.ext_le (by simp) (λ k hk hk', _),
    simp [form_perm_pow_apply_nth_le _ hn, nat.mod_eq_of_lt hk'] },
  { simpa [hs] using nth_le_mem _ _ _ }
end

lemma to_list_form_perm_is_rotated_self (l : list α) (hl : 2 ≤ l.length) (hn : nodup l)
  (x : α) (hx : x ∈ l):
  to_list (form_perm l) x ~r l :=
begin
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
  have hr : l ~r l.rotate k := ⟨k, rfl⟩,
  rw form_perm_eq_of_is_rotated hn hr,
  rw ←nth_le_rotate' l k k,
  simp only [nat.mod_eq_of_lt hk, tsub_add_cancel_of_le hk.le, nat.mod_self],
  rw [to_list_form_perm_nontrivial],
  { simp },
  { simpa using hl },
  { simpa using hn }
end

lemma form_perm_to_list (f : perm α) (x : α) :
  form_perm (to_list f x) = f.cycle_of x :=
begin
  by_cases hx : f x = x,
  { rw [(cycle_of_eq_one_iff f).mpr hx, to_list_eq_nil_iff.mpr (not_mem_support.mpr hx),
        form_perm_nil] },
  ext y,
  by_cases hy : same_cycle f x y,
  { obtain ⟨k, hk, rfl⟩ := hy.nat_of_mem_support _ (mem_support.mpr hx),
    rw [cycle_of_apply_apply_pow_self, list.form_perm_apply_mem_eq_next (nodup_to_list f x),
        next_to_list_eq_apply, pow_succ, mul_apply],
    rw mem_to_list_iff,
    exact ⟨⟨k, rfl⟩, mem_support.mpr hx⟩ },
  { rw [cycle_of_apply_of_not_same_cycle hy, form_perm_apply_of_not_mem],
    simp [mem_to_list_iff, hy] }
end

lemma is_cycle.exists_unique_cycle {f : perm α} (hf : is_cycle f) :
  ∃! (s : cycle α), ∃ (h : s.nodup), s.form_perm h = f :=
begin
  obtain ⟨x, hx, hy⟩ := id hf,
  refine ⟨f.to_list x, ⟨nodup_to_list f x, _⟩, _⟩,
  { simp [form_perm_to_list, hf.cycle_of_eq hx] },
  { rintro ⟨l⟩ ⟨hn, rfl⟩,
    simp only [cycle.mk_eq_coe, cycle.coe_eq_coe, subtype.coe_mk, cycle.form_perm_coe],
    refine (to_list_form_perm_is_rotated_self _ _ hn _ _).symm,
    { contrapose! hx,
      suffices : form_perm l = 1,
      { simp [this] },
      rw form_perm_eq_one_iff _ hn,
      exact nat.le_of_lt_succ hx },
    { rw ←mem_to_finset,
      refine support_form_perm_le l _,
      simpa using hx } }
end

lemma is_cycle.exists_unique_cycle_subtype {f : perm α} (hf : is_cycle f) :
  ∃! (s : {s : cycle α // s.nodup}), (s : cycle α).form_perm s.prop = f :=
begin
  obtain ⟨s, ⟨hs, rfl⟩, hs'⟩ := hf.exists_unique_cycle,
  refine ⟨⟨s, hs⟩, rfl, _⟩,
  rintro ⟨t, ht⟩ ht',
  simpa using hs' _ ⟨ht, ht'⟩
end

lemma is_cycle.exists_unique_cycle_nontrivial_subtype {f : perm α} (hf : is_cycle f) :
  ∃! (s : {s : cycle α // s.nodup ∧ s.nontrivial}), (s : cycle α).form_perm s.prop.left = f :=
begin
  obtain ⟨⟨s, hn⟩, hs, hs'⟩ := hf.exists_unique_cycle_subtype,
  refine ⟨⟨s, hn, _⟩, _, _⟩,
  { rw hn.nontrivial_iff,
    subst f,
    intro H,
    refine hf.ne_one _,
    simpa using cycle.form_perm_subsingleton _ H },
  { simpa using hs },
  { rintro ⟨t, ht, ht'⟩ ht'',
    simpa using hs' ⟨t, ht⟩ ht'' }
end

/--
Given a cyclic `f : perm α`, generate the `cycle α` in the order
of application of `f`. Implemented by finding an element `x : α`
in the support of `f` in `finset.univ`, and iterating on using
`equiv.perm.to_list f x`.
-/
def to_cycle (f : perm α) (hf : is_cycle f) : cycle α :=
multiset.rec_on (finset.univ : finset α).val
  (quot.mk _ [])
  (λ x s l, if f x = x then l else to_list f x)
  (by { intros x y m s,
    refine heq_of_eq _,
    split_ifs with hx hy hy; try { refl },
    { have hc : same_cycle f x y := is_cycle.same_cycle hf hx hy,
      exact quotient.sound' hc.to_list_is_rotated }})

lemma to_cycle_eq_to_list (f : perm α) (hf : is_cycle f) (x : α) (hx : f x ≠ x) :
  to_cycle f hf = to_list f x :=
begin
  have key : (finset.univ : finset α).val = x ::ₘ finset.univ.val.erase x,
  { simp },
  rw [to_cycle, key],
  simp [hx]
end

lemma nodup_to_cycle (f : perm α) (hf : is_cycle f) : (to_cycle f hf).nodup :=
begin
  obtain ⟨x, hx, -⟩ := id hf,
  simpa [to_cycle_eq_to_list f hf x hx] using nodup_to_list _ _
end

lemma nontrivial_to_cycle (f : perm α) (hf : is_cycle f) : (to_cycle f hf).nontrivial :=
begin
  obtain ⟨x, hx, -⟩ := id hf,
  simp [to_cycle_eq_to_list f hf x hx, hx, cycle.nontrivial_coe_nodup_iff (nodup_to_list _ _)]
end

/--
Any cyclic `f : perm α` is isomorphic to the nontrivial `cycle α`
that corresponds to repeated application of `f`.
The forward direction is implemented by `equiv.perm.to_cycle`.
-/
def iso_cycle : {f : perm α // is_cycle f} ≃ {s : cycle α // s.nodup ∧ s.nontrivial} :=
{ to_fun := λ f, ⟨to_cycle (f : perm α) f.prop, nodup_to_cycle f f.prop,
    nontrivial_to_cycle _ f.prop⟩,
  inv_fun := λ s, ⟨(s : cycle α).form_perm s.prop.left,
    (s : cycle α).is_cycle_form_perm _ s.prop.right⟩,
  left_inv := λ f, by
  { obtain ⟨x, hx, -⟩ := id f.prop,
    simpa [to_cycle_eq_to_list (f : perm α) f.prop x hx, form_perm_to_list, subtype.ext_iff]
      using f.prop.cycle_of_eq hx },
  right_inv := λ s, by
  { rcases s with ⟨⟨s⟩, hn, ht⟩,
    obtain ⟨x, -, -, hx, -⟩ := id ht,
    have hl : 2 ≤ s.length := by simpa using cycle.length_nontrivial ht,
    simp only [cycle.mk_eq_coe, cycle.nodup_coe_iff, cycle.mem_coe_iff, subtype.coe_mk,
               cycle.form_perm_coe] at hn hx ⊢,
    rw to_cycle_eq_to_list _ _ x,
    { refine quotient.sound' _,
      exact to_list_form_perm_is_rotated_self _ hl hn _ hx },
    { rw [←mem_support, support_form_perm_of_nodup _ hn],
      { simpa using hx },
      { rintro _ rfl,
        simpa [nat.succ_le_succ_iff] using hl } } } }

/--
Any cyclic `f : perm α` is isomorphic to the nontrivial `cycle α`
that corresponds to repeated application of `f`.
The forward direction is implemented by finding this `cycle α` using `fintype.choose`.
-/
def iso_cycle' : {f : perm α // is_cycle f} ≃ {s : cycle α // s.nodup ∧ s.nontrivial} :=
{ to_fun := λ f, fintype.choose _ f.prop.exists_unique_cycle_nontrivial_subtype,
  inv_fun := λ s, ⟨(s : cycle α).form_perm s.prop.left,
    (s : cycle α).is_cycle_form_perm _ s.prop.right⟩,
  left_inv := λ f, by simpa [subtype.ext_iff]
    using fintype.choose_spec _ f.prop.exists_unique_cycle_nontrivial_subtype,
  right_inv := λ ⟨s, hs, ht⟩, by
  { simp [subtype.coe_mk],
    convert fintype.choose_subtype_eq (λ (s' : cycle α), s'.nodup ∧ s'.nontrivial) _,
    ext ⟨s', hs', ht'⟩,
    simp [cycle.form_perm_eq_form_perm_iff, (iff_not_comm.mp hs.nontrivial_iff),
          (iff_not_comm.mp hs'.nontrivial_iff), ht] } }

notation `c[` l:(foldr `, ` (h t, list.cons h t) list.nil `]`) :=
  cycle.form_perm ↑l (cycle.nodup_coe_iff.mpr dec_trivial)

instance repr_perm [has_repr α] : has_repr (perm α) :=
⟨λ f, repr (multiset.pmap (λ (g : perm α) (hg : g.is_cycle),
  iso_cycle ⟨g, hg⟩) -- to_cycle is faster?
  (perm.cycle_factors_finset f).val
  (λ g hg, (mem_cycle_factors_finset_iff.mp (finset.mem_def.mpr hg)).left))⟩

end equiv.perm


/-
This defines additional operations used to normalize inequalitis.
-/
import ClausalExtraction.ArithTheory.Nat

namespace Int

-- Thoems only about subNatNat and nat-level operations
-- We make these private as the intention is that users should not need to directly
-- work with subNatNat
section subNatNat

private
theorem subNatNat.is_ofNat {x y:Nat} (p:y ≤ x) : subNatNat x y = ofNat (x - y) := by
  simp [subNatNat]
  have h : y - x = 0 := by simp only [Nat.sub_is_zero_is_le, p]
  simp [h]

private theorem subNatNat.is_negSucc {x y:Nat} (p:x < y) : subNatNat x y = negSucc (y - Nat.succ x) := by
  generalize g: y - x = y_sub_x
  cases y_sub_x with
  | zero =>
    have h : Nat.zero = 0 := rfl
    simp only [h, Nat.sub_is_zero_is_le] at g
    exact (False.elim (Nat.not_le_of_gt p g))
  | succ y_sub_x =>
    simp only [subNatNat, g, Nat.sub_succ, Nat.pred]

private
theorem succ_subNatNat_succ (x y : Nat) : subNatNat (Nat.succ x) (Nat.succ y) = subNatNat x y := by
  match Nat.lt_or_ge x y with
  | Or.inr p =>
    have q := Nat.succ_le_succ p
    simp [subNatNat.is_ofNat, p, q, Nat.succ_sub_succ]
  | Or.inl p =>
    have q := Nat.succ_lt_succ p
    simp [subNatNat.is_negSucc, p, q, Nat.succ_sub_succ]

private
theorem subNatNat_self (x:Nat) : subNatNat x x = 0 := by
  induction x with
  | zero => rfl
  | succ x ind => simp [succ_subNatNat_succ, ind]

private
theorem subNatNat_zero (x : Nat) : subNatNat x 0 = ofNat x := by
  simp [subNatNat.is_ofNat, Nat.zero_le]

private
theorem zero_subNatNat_succ (x:Nat) : subNatNat 0 (Nat.succ x) = Int.negSucc x := by
  simp [subNatNat.is_negSucc, Nat.zero_lt_succ, Nat.succ_sub_succ, Nat.sub_zero]

private
theorem subNatNat_sub_lhs (p : x ≥ y) (z:Nat) : subNatNat (x - y) z = subNatNat x (y + z) := by
  match Nat.lt_or_ge x (y+z) with
  | Or.inr q =>
    have r : x - y ≥ z := by simp only [Nat.le_sub_simp p, Nat.add_comm]; exact q
    simp only [subNatNat.is_ofNat q, subNatNat.is_ofNat r]
    simp only [Nat.sub_sub_left]
  | Or.inl q =>
    have r : x - y < z := by simp only [Nat.sub_lt_simp p]; exact q
    simp only [subNatNat.is_negSucc q, subNatNat.is_negSucc r]
    simp only [negSucc.injEq, Nat.sub_succ]
    simp only [Nat.sub_sub_right p]
    rw [Nat.add_comm z y]

private
theorem subNatNat_sub {y z :Nat} (p : z ≤ y) (x:Nat) : subNatNat x (y - z) = subNatNat (x + z) y := by
  match Nat.lt_or_ge (x+z) y with
  | Or.inr q =>
    have r : y - z ≤ x := by
      simp only [Nat.sub_le_simp, Nat.add_comm z x]
      exact q
    simp only [subNatNat.is_ofNat q, subNatNat.is_ofNat r]
    simp only [Nat.sub_sub_right p]
  | Or.inl q =>
    have r : Nat.succ x ≤ y - z := by
      simp only [Nat.le_sub_simp, p, Nat.succ_add]
      exact q
    simp only [subNatNat.is_negSucc q, subNatNat.is_negSucc r, Nat.sub_succ]
    simp only [Nat.sub_sub_left, Nat.add_comm]

private
theorem subNatNat_zero_implies_equal {x y :Nat} (q:Int.subNatNat x y = 0) : x = y := by
  simp [Int.subNatNat] at q
  have p : y - x = 0 := by
    generalize g:y-x=z
    cases z with
    | zero => rfl
    | succ z => simp [g] at q
  simp only [OfNat.ofNat, p, ofNat.injEq] at q
  revert y
  induction x with
  | zero =>
    intros y p q
    exact p.symm
  | succ x ind =>
    intros y
    cases y with
    | zero =>
      intros p q
      simp [Nat.sub_zero] at q
    | succ y =>
      simp [Nat.succ_sub_succ]
      exact (@ind y)

private
theorem subNatNat_eq_zero (x y :Nat) : (Int.subNatNat x y = 0) = (x = y) := by
  apply propext
  apply Iff.intro subNatNat_zero_implies_equal
  intro eq
  simp only [eq, subNatNat_self]

private
theorem nonNeg_subNatNat (m n : Nat) : NonNeg (subNatNat m n) = (n <= m) := by
  apply propext
  apply Iff.intro
  case a.mp =>
    intro p
    match Nat.lt_or_ge m n with
    | Or.inr q =>
      exact q
    | Or.inl q =>
      simp [subNatNat.is_negSucc q] at p
      contradiction
  case a.mpr =>
    intro le
    simp [subNatNat.is_ofNat le]
    exact (NonNeg.mk _)

end subNatNat

section Addition

private theorem ofNat_add_ofNat (m n : Nat) : ofNat m + ofNat n = ofNat (m + n) := by rfl

private theorem ofNat_add_negSucc (m n : Nat) : ofNat m + negSucc n = subNatNat m (Nat.succ n) := by rfl

private theorem negSucc_add_ofNat (m n : Nat) : negSucc m + ofNat n = subNatNat n (Nat.succ m) := by rfl

private theorem negSucc_add_negSucc (m n : Nat) : negSucc m + negSucc n = negSucc (Nat.succ (m + n)) := by rfl

@[simp]
theorem zero_add (x : Int) : 0 + x = x :=
  match x with
  | ofNat n => congrArg ofNat (Nat.zero_add _)
  | negSucc n => rfl

@[simp]
theorem add_zero (x : Int) : x + 0 = x :=
  match x with
  | ofNat n => Eq.refl (ofNat n)
  | negSucc n => Eq.refl (negSucc n)

theorem add_comm (x y : Int) : x + y = y + x := by
  cases x <;> cases y <;> simp only
    [ofNat_add_ofNat, ofNat_add_negSucc,
     negSucc_add_ofNat, negSucc_add_negSucc,
     Nat.add_comm]

private
theorem ofNat_add_subNatNat (x y z:Nat)
  : ofNat x + subNatNat y z = subNatNat (x + y) z := by
    match Nat.lt_or_ge y z with
    | Or.inl p =>
      rw [subNatNat.is_negSucc p, ofNat_add_negSucc, Nat.succ_sub p, Nat.succ_sub_succ]
      exact (subNatNat_sub (Nat.le_of_lt p) _)
    | Or.inr p =>
      have q : x + y ≥ z := Nat.le_trans p (Nat.le_add_left y x)
      rw [subNatNat.is_ofNat p, ofNat_add_ofNat]
      rw [subNatNat.is_ofNat q, ofNat.injEq]
      exact (Nat.add_sub_right p _)

private
theorem subNatNat_add_ofNat (x y z:Nat) : subNatNat x y + ofNat z = subNatNat (x + z) y := by
  simp only [add_comm, ofNat_add_subNatNat, Nat.add_comm]

private
theorem negSucc_add_subNatNat (x y z:Nat) : negSucc x + subNatNat y z = subNatNat y (Nat.succ (x + z)) := by
  match Nat.lt_or_ge y z with
  | Or.inr p =>
    rw [subNatNat.is_ofNat p, negSucc_add_ofNat]
    simp only [subNatNat_sub_lhs p, Nat.add_succ, Nat.add_comm]
  | Or.inl p =>
    rw [subNatNat.is_negSucc p, negSucc_add_negSucc]
    have r : y < x + z := Nat.le_trans p (Nat.le_add_left z x)
    have q : y < Nat.succ (x + z) := Nat.le.step r
    rw [subNatNat.is_negSucc q, negSucc.injEq]
    rw [Nat.add_sub_right p]
    rw [Nat.succ_sub r]

private
theorem subNatNat_add_negSucc (x y z:Nat)
  : subNatNat x y + negSucc z = subNatNat x (Nat.succ (y + z)) := by
  simp only [add_comm, negSucc_add_subNatNat, Nat.add_comm]

private theorem subNatNat_add_subNatNat (a b c d:Nat)
  : subNatNat a b + subNatNat c d = subNatNat (a + c) (b + d) := by
  match Nat.lt_or_ge a b with
  | Or.inr a_ge_b =>
    simp only [subNatNat.is_ofNat a_ge_b]
    match Nat.lt_or_ge c d with
    | Or.inr c_ge_d =>
      have ge : a + c ≥ b + d := Nat.add_le_add a_ge_b c_ge_d
      rw [subNatNat.is_ofNat c_ge_d, subNatNat.is_ofNat ge]
      rw [ofNat_add_ofNat, ofNat.injEq]
      rw [Nat.add_sub_left a_ge_b]
      rw [Nat.add_sub_right c_ge_d]
      simp only [Nat.sub_sub_left, Nat.add_comm]
    | Or.inl c_lt_d =>
      simp only [subNatNat.is_negSucc c_lt_d]
      simp only [ofNat_add_negSucc]
      simp only [Nat.succ_sub c_lt_d, Nat.succ_sub_succ]
      simp only [subNatNat_sub (Nat.le_of_lt c_lt_d)]
      simp only [Nat.add_sub_left a_ge_b]
      have ac_ge_b : a+c ≥ b := Nat.le_trans a_ge_b (Nat.le_add_right a c)
      simp only [subNatNat_sub_lhs ac_ge_b]
  | Or.inl a_lt_b =>
    simp only [subNatNat.is_negSucc a_lt_b]
    match Nat.lt_or_ge c d with
    | Or.inr c_ge_d =>
      simp only [subNatNat.is_ofNat c_ge_d, negSucc_add_ofNat]
      simp only [Nat.succ_sub a_lt_b, Nat.succ_sub_succ]
      simp only [subNatNat_sub_lhs c_ge_d]
      simp only [Nat.add_sub_right (Nat.le_of_lt a_lt_b)]
      have db_ge_a : d + b >= a :=
             Nat.le_trans (Nat.le_of_lt a_lt_b) (Nat.le_add_left b d)
      simp only [subNatNat_sub db_ge_a]
      simp only [Nat.add_comm]
    | Or.inl c_lt_d =>
      have lt : a + c < b + d := Nat.add_lt_add a_lt_b c_lt_d
      simp only [subNatNat.is_negSucc c_lt_d, subNatNat.is_negSucc lt]
      rw [negSucc_add_negSucc, negSucc.injEq]
      simp only [Nat.add_sub_left a_lt_b]
      simp only [Nat.add_sub_right c_lt_d]
      simp only [Nat.sub_sub_left, Nat.succ_add, Nat.add_succ, Nat.add_comm c a]
      rw [Nat.sub_succ, Nat.sub_succ]
      have gt1 : Nat.pred (b + d - (a + c)) > 0 := by
            apply Nat.lt_of_succ_le
            simp only [Nat.succ_le_pred, Nat.succ_le_sub, Nat.succ_add, Nat.zero_add]
            rw [(Nat.add_succ _ c).symm, (Nat.succ_add a _).symm]
            exact Nat.add_le_add a_lt_b c_lt_d
      simp only [Nat.succ_pred gt1]

theorem add_assoc (x y z : Int) : x + y + z = x + (y + z) := by
  cases x <;> cases y <;> cases z <;>  simp only
    [ofNat_add_ofNat, ofNat_add_negSucc, negSucc_add_ofNat, negSucc_add_negSucc,
      ofNat_add_subNatNat, subNatNat_add_ofNat,
      subNatNat_add_negSucc, negSucc_add_subNatNat,
      Nat.succ_add, Nat.add_succ, Nat.add_assoc]

end Addition

-- Just desugar negOfNat into subNatNat
section negOfNat

private
theorem negOfNat_is_subNatNat (x:Nat) : negOfNat x = subNatNat 0 x := by
  cases x with
  | zero => rfl
  | succ x => rfl

end negOfNat

section Negation

@[simp]
theorem neg_zero : - (0:Int) = 0 := by rfl

private
theorem neg_ofNat (n:Nat) : -ofNat n = subNatNat 0 n := negOfNat_is_subNatNat n

private
theorem neg_negSucc (n:Nat) : -negSucc n = ofNat (n+1) := by rfl

private
theorem neg_subNatNat (m n: Nat) : - (subNatNat m n) = subNatNat n m := by
  match Nat.lt_or_ge m n with
  | Or.inl p =>
    have q : m ≤ n := Nat.le_of_lt p
    simp only [subNatNat.is_negSucc p, subNatNat.is_ofNat q, neg_negSucc]
    simp only [Nat.add_sub_left p, Nat.succ_sub_succ]
  | Or.inr p =>
    simp only [subNatNat.is_ofNat p, neg_ofNat]
    simp only [subNatNat_sub p, Nat.zero_add]

theorem neg_add (x y : Int) : -(x + y) = -x + -y := by
  cases x <;> cases y <;> simp only
         [ofNat_add_ofNat, ofNat_add_negSucc, negSucc_add_ofNat, negSucc_add_negSucc,
          neg_ofNat, neg_negSucc,
          subNatNat_add_subNatNat, subNatNat_add_ofNat, ofNat_add_subNatNat,
          neg_subNatNat,
          Nat.zero_add, Nat.add_zero, Nat.add_succ, Nat.succ_add]

end Negation

section Subtraction

theorem sub_to_add_neg (x : Int) : x - y = x + -y := by rfl

theorem sub_self (x : Int) : x - x = 0 := by
  simp only [sub_to_add_neg]
  cases x with
  | ofNat x =>
    simp only [neg_ofNat, negOfNat_is_subNatNat, ofNat_add_subNatNat, Nat.add_zero,
               subNatNat_self]
  | negSucc x =>
    simp only [neg_negSucc, negSucc_add_ofNat, Nat.add_succ, Nat.add_zero,
               subNatNat_self]

theorem sub_eq_zero_implies_eq {x y : Int} (q : x - y = 0) : x = y := by
  cases x with
  | ofNat x =>
    cases y with
    | ofNat y =>
      simp only [sub_to_add_neg, neg_ofNat, ofNat_add_subNatNat, Nat.add_zero, subNatNat_eq_zero] at q
      simp only [q]
    | negSucc y =>
      simp only [sub_to_add_neg, neg_negSucc, ofNat_add_ofNat] at q
      simp only [Nat.add_succ, OfNat.ofNat, ofNat.injEq] at q
  | negSucc x =>
    cases y with
    | ofNat y =>
      simp only [sub_to_add_neg, neg_ofNat, negSucc_add_subNatNat, subNatNat_eq_zero] at q
    | negSucc y =>
      simp only [sub_to_add_neg, neg_negSucc, negSucc_add_ofNat, succ_subNatNat_succ,
                 subNatNat_eq_zero] at q
      simp only [q]

end Subtraction

protected theorem lt_or_ge (x y : Int) : x < y ∨ x ≥ y := by
  have h : -1 = Int.negSucc 0 := rfl
  have succ_le : ∀(a b), (Nat.succ a ≤ b) = (a < b) := by
        intros a b
        exact propext (Iff.intro id id)
  simp only [LT.lt, Int.lt, LE.le, GE.ge, Int.le, sub_to_add_neg, neg_add, h]
  cases x <;> cases y <;> simp only
    [ neg_ofNat, neg_negSucc,
      ofNat_add_ofNat, ofNat_add_negSucc, ofNat_add_subNatNat,
      negSucc_add_ofNat, negSucc_add_subNatNat, subNatNat_add_negSucc,
      NonNeg.mk,
      succ_subNatNat_succ, subNatNat_zero,
      Nat.add_zero, Nat.add_succ,
      nonNeg_subNatNat, succ_le, Nat.lt_or_ge,
      or_true, true_or
    ]

section Multiplication

private theorem ofNat_mul_ofNat (m n : Nat) : ofNat m * ofNat n = ofNat (m * n) := by rfl

private theorem ofNat_mul_negSucc (m n : Nat) : ofNat m * negSucc n = subNatNat 0 (m * Nat.succ n) :=
  negOfNat_is_subNatNat (m * Nat.succ n)

private theorem negSucc_mul_ofNat (m n : Nat) : negSucc m * ofNat n = subNatNat 0 (Nat.succ m * n) :=
  negOfNat_is_subNatNat (Nat.succ m * n)

private theorem negSucc_mul_negSucc (m n : Nat) : negSucc m * negSucc n = ofNat (Nat.succ m * Nat.succ n) := by rfl

theorem zero_mul (x:Int) : 0 * x = 0 := by
  simp only [OfNat.ofNat]
  cases x <;> simp only [ofNat_mul_ofNat, ofNat_mul_negSucc, Nat.zero_mul]

theorem one_mul (x:Int) : 1 * x = x := by
  simp only [OfNat.ofNat]
  cases x <;> simp only [ofNat_mul_ofNat, ofNat_mul_negSucc, Nat.one_mul, zero_subNatNat_succ]

theorem mul_comm (x y : Int) : x * y = y * x := by
  cases x <;> cases y <;> simp only
    [ ofNat_mul_ofNat, ofNat_mul_negSucc, negSucc_mul_ofNat, negSucc_mul_negSucc,
      Nat.mul_comm
    ]

theorem mul_zero (x : Int) : x * 0 = 0 := by simp [mul_comm x 0, zero_mul]

theorem mul_one (x : Int) : x * 1 = x := by simp [mul_comm x 1, one_mul]

private
theorem ofNat_mul_subNatNat (x y z : Nat) : ofNat x * subNatNat y z = subNatNat (x * y) (x * z) :=
  match Nat.lt_or_ge y z with
  | Or.inr p => by
    have q : x*y ≥ x*z := Nat.mul_le_mul_left x p
    simp only [subNatNat.is_ofNat, p, q, ofNat_mul_ofNat, Nat.mul_sub ]
  | Or.inl p =>
    match Nat.eq_zero_or_pos x with
    | Or.inl x_eq_zero => by
      simp only [x_eq_zero, Nat.zero_mul]
      exact zero_mul (subNatNat y z)
    | Or.inr x_pos => by
      have q : x*y < x*z := Nat.mul_lt_mul_of_pos_left p x_pos
      simp only [subNatNat.is_negSucc p, subNatNat.is_negSucc q, ofNat_mul_negSucc]
      have r : x * z ≥ (x * y + x) := by
        simp only [(Nat.mul_succ x y).symm]
        exact Nat.mul_le_mul_left x p
      simp only [
        Nat.add_sub_left r,
        Nat.mul_succ, Nat.mul_sub,  Nat.add_sub_add_self ]
      rw [subNatNat_sub (Nat.le_of_lt q), Nat.zero_add, subNatNat.is_negSucc q]

private
theorem negSucc_mul_subNatNat (x y z : Nat) : negSucc x * subNatNat y z = subNatNat (Nat.succ x * z) (Nat.succ x * y) :=
  match Nat.lt_or_ge y z with
  | Or.inr p => by
    have q : Nat.succ x*y ≥ Nat.succ x*z := Nat.mul_le_mul_left (Nat.succ x) p
    simp only [subNatNat.is_ofNat, p, q]
    simp only [negSucc_mul_ofNat, Nat.mul_sub]
    simp only [subNatNat_sub q, Nat.zero_add]
  | Or.inl p => by
    have q : Nat.succ x*y < Nat.succ x*z := Nat.mul_lt_mul_of_pos_left p (Nat.zero_lt_succ x)
    simp only [subNatNat.is_negSucc p, subNatNat.is_ofNat (Nat.le_of_lt q)]
    simp only [negSucc_mul_negSucc, Nat.succ_sub p, Nat.succ_sub_succ]
    simp only [Nat.mul_sub]

private
theorem subNatNat_mul_ofNat (x y z : Nat) : subNatNat x y * ofNat z = subNatNat (x * z) (y * z) := by
  simp [mul_comm, ofNat_mul_subNatNat, Nat.mul_comm]

private
theorem subNatNat_mul_negSucc (x y z : Nat) : subNatNat x y * negSucc z = subNatNat (y * Nat.succ z) (x * Nat.succ z)  := by
  simp [mul_comm, negSucc_mul_subNatNat, Nat.mul_comm]

theorem neg_one_mul (x:Int) : -1 * x = -x := by
  simp only [OfNat.ofNat]
  have h : Nat.succ 0 = 1 := rfl
  cases x <;> simp only
    [neg_ofNat, negSucc_mul_ofNat, negSucc_mul_negSucc, h, neg_negSucc,
     subNatNat_mul_ofNat, subNatNat_mul_negSucc,
     Nat.zero_mul, Nat.one_mul, subNatNat_zero
     ]

theorem mul_assoc (x y z : Int) : x * y * z = x * (y * z) := by
  cases x <;> cases y <;> cases z <;> simp only
    [ ofNat_mul_ofNat, ofNat_mul_negSucc, negSucc_mul_ofNat, negSucc_mul_negSucc,
      ofNat_mul_subNatNat, subNatNat_mul_ofNat,
      negSucc_mul_subNatNat, subNatNat_mul_negSucc,
      subNatNat_zero,
      Nat.mul_assoc, Nat.mul_zero, Nat.zero_mul]

theorem add_mul (x y z : Int) : (x + y) * z = x * z + y * z := by
  cases x <;> cases y <;> cases z <;> simp only
    [ ofNat_add_ofNat, ofNat_mul_ofNat,
      ofNat_add_negSucc, ofNat_mul_negSucc,
      negSucc_add_ofNat, negSucc_mul_ofNat,
      negSucc_add_negSucc, negSucc_mul_negSucc,
      ofNat_add_subNatNat, subNatNat_add_ofNat, subNatNat_add_subNatNat,
      subNatNat_mul_ofNat, subNatNat_mul_negSucc,
      (Nat.add_mul _ _ _).symm,
      Nat.succ_add, Nat.add_succ, Nat.zero_add, Nat.add_zero
    ]

theorem mul_add  (x y z : Int) : x * (y + z) = x * y + x * z := by
  cases x <;> cases y <;> cases z <;> simp only
    [ ofNat_add_ofNat, ofNat_mul_ofNat,
      ofNat_add_negSucc, ofNat_mul_negSucc,
      negSucc_add_ofNat, negSucc_mul_ofNat,
      negSucc_add_negSucc, negSucc_mul_negSucc,
      ofNat_add_subNatNat, subNatNat_add_ofNat, subNatNat_add_subNatNat,
      ofNat_mul_subNatNat, negSucc_mul_subNatNat,
      (Nat.mul_add _ _ _).symm,
      Nat.succ_add, Nat.add_succ, Nat.zero_add, Nat.add_zero
    ]

theorem neg_mul (x y : Int) : -(x * y) = -x * y := by
  cases x <;> cases y <;> simp only
    [ neg_ofNat, neg_negSucc,
      ofNat_mul_ofNat,
      ofNat_mul_negSucc,
      negSucc_mul_ofNat,
      negSucc_mul_negSucc,
      subNatNat_mul_ofNat,
      subNatNat_mul_negSucc,
      neg_subNatNat,
      subNatNat_zero,
      Nat.zero_mul
    ]

theorem mul_neg (x y : Int) : x * -y = -x * y := by
  cases x <;> cases y <;> simp only
    [ neg_ofNat, neg_negSucc,
      ofNat_mul_ofNat,
      negSucc_mul_ofNat,
      ofNat_mul_negSucc,
      ofNat_mul_subNatNat,
      subNatNat_mul_ofNat,
      subNatNat_mul_negSucc,
      negSucc_mul_subNatNat,
      subNatNat_zero,
      Nat.zero_mul, Nat.mul_zero, Nat.add_succ, Nat.add_zero
    ]

end Multiplication

section NeZero
-- Special cases

theorem neg_ne_zero {x:Int} : x ≠ 0 → -x ≠ 0 := by
  intro p eq
  apply p; clear p
  revert eq
  match x with
  | ofNat 0 =>
    simp
  | ofNat (Nat.succ x) =>
    simp only [neg_ofNat]
    intro p
    simp only [subNatNat_eq_zero] at p
  | negSucc x =>
    intro eq
    simp [OfNat.ofNat, neg_negSucc, Nat.add_succ, Nat.add_zero] at eq

theorem mul_ne_zero {x y:Int} : x ≠ 0 → y ≠ 0 → x * y ≠ 0 :=
  have h : ∀(n:Nat), ofNat (Nat.succ n) ≠ 0 := by
    intro n
    simp [OfNat.ofNat]
  match x, y with
  | ofNat 0, y  => by
    intro ne
    contradiction
  | _, 0 => by
    intro _ ne
    simp only [] at ne
  | ofNat (Nat.succ x), ofNat (Nat.succ y) => by
    intros p q
    simp only [ofNat_mul_ofNat, Nat.succ_mul, Nat.add_succ, OfNat.ofNat, ne_eq, ofNat.injEq]
  | ofNat (Nat.succ x), negSucc y => by
    intros p q eq
    simp only [ofNat_mul_negSucc, negOfNat_is_subNatNat] at eq
    simp only [subNatNat_eq_zero] at eq
    simp only [Nat.succ_mul, Nat.add_succ, OfNat.ofNat] at eq
  | negSucc x, ofNat (Nat.succ y) => by
    intros p q eq
    simp only [negSucc_mul_ofNat, negOfNat_is_subNatNat, subNatNat_eq_zero] at eq
    simp only [Nat.succ_mul, Nat.add_succ, OfNat.ofNat] at eq
  | negSucc x, negSucc y => by
    intros p q
    simp only [negSucc_mul_negSucc, Nat.succ_mul, Nat.add_succ, OfNat.ofNat, ne_eq, ofNat.injEq]

end NeZero

section Comparison

theorem nonNeg_of_nat_le {x y : Nat} (p : x ≤ y)
  : NonNeg (OfNat.ofNat y - OfNat.ofNat x) := by
  simp [OfNat.ofNat, Int.sub_to_add_neg]
  simp only [neg_ofNat]
  simp only [ofNat_add_subNatNat, Nat.add_zero]
  simp only [subNatNat.is_ofNat p]
  apply NonNeg.mk

end Comparison

end Int


import tactic

/--
`injective` Basic definition of injectivity.
-/
def injective {X Y} (f : X → Y) := ∀ x₁ x₂, f x₁ = f x₂ → x₁ = x₂

/--
`comp_inj_is_inj` Demonstrates the composition of injective functions is injective.
-/
theorem comp_inj_is_inj
{X Y Z} (f : X → Y) (g : Y → Z)
(p1 : injective f)
(p2 : injective g)
:  injective (g ∘ f)
:=
begin
  introv x p3,
  change g (f x) = g (f x₂) at p3,
  apply p1,
  apply p2,
  apply p3,
end

/--
`succ_greater_than_nat` Simple statement that n + 1 > n.
-/
lemma succ_greater_than_nat
(n : ℕ)
: nat.succ n > n
:=
begin
  rw nat.succ_eq_add_one,
  linarith
end

lemma ge_zero_witness_k
(n k : ℕ )
(p : k ≥ 0)
(p2 : n > k)
: n > 0
:=
begin
exact lt_of_le_of_lt p p2,
end

lemma ge_zero
(k : ℕ)
: k ≥ 0
:= begin
exact bot_le,
end

lemma minus_one_both_sides_eq
{n m k : ℕ }
(p : k ≥ 0)
(p2 : m > k)
(p3 : n > k)
(p4: m - 1 = n - 1)
: m = n
:=
begin
have m_ge_zero  := (ge_zero_witness_k m k p p2),
have n_ge_zero := (ge_zero_witness_k n k p p3),
exact nat.pred_inj m_ge_zero n_ge_zero p4,
end

lemma my_le_trans
(j k m : ℕ)
(p1: k < m)
(p2: j ≤ k)
(p3 m > 0)
: j < m - 1
:=
begin
  intros,

  /-
  induction j with d hd,
  {
    induction m with dm hdm,
    {exact lt_of_le_of_lt p2 p1},
    {

    }
  },
  {
    induction m with dm hdm,
    {linarith,},
    {

    }
  },
  -/
  sorry,
end

lemma downward_ineq
(j m : ℕ)
(p: j < m)
(p2: 0 < j)
: j - 1 < m - 1
:=
begin
  intros,
  exact nat.sub_mono_left_strict p2 p,
end

/--
Type of pairs (k,p) where k
is a natural number and p is a witness to the proof that k < n.
-/
def finite_subset (n : ℕ) := { k // k < n }

/--
Every pair that lives in finite_subest m lives in finite_subset n
where m < n
-/
def lift_finite
(m n : ℕ)
(p : m < n)
: finite_subset m → finite_subset n
:=
  λ k, ⟨k.1, lt.trans k.2 p⟩

/--
`lift_one` Application of lift_finite from m to m + 1
-/
def lift_one
(m : ℕ)
: finite_subset m → finite_subset (m + 1)
:=
  (lift_finite m (m+1) (succ_greater_than_nat m))

/--
`lift_one_fst` Establishes that lifting preserves the first half of the pair.
-/
lemma lift_one_fst {m} (j : finite_subset m) : (lift_one m j).1 = j.1
:=
begin
  refl,
end

/--
`ext_iff` Extensionality theorem for finite subsets as pairs.
-/
lemma ext_iff
(n : ℕ)
(a b : finite_subset n)
: a = b ↔ a.1 = b.1
:=
begin
  cases a,
  cases b,
  split,
  { intro h, rw h},
  { intro h, cases h, refl,}
end

/--
`lift_finite_injective` Demonstrates the lifting function is injective.
-/
theorem lift_finite_injective
(m n : ℕ)
(p : m < n)
: injective (lift_finite m n p)
:=
begin
  intros x₁ x₂ h,
  rw ext_iff at ⊢ h,
  exact h
end

/--
`lift_one_injective` Direct lemma of `lift_finite_injective`
-/
lemma lift_one_injective (m : ℕ)
: injective (lift_one m)
:=
begin
  apply lift_finite_injective m (m + 1) (succ_greater_than_nat m),
end

/--
Small proof of the `j.1 < m - 1` in the `then` case below.
-/
lemma relabel_inequality_lower_case
(m k : ℕ)
(h : k < m)
(j : finite_subset m)
(p : j.1 ≤ k)
: j.1 < m - 1
:=
begin
let witness := (ge_zero_witness_k m k (ge_zero k) h),
let reason := my_le_trans j.1 k m h p m m witness,
apply reason,
apply witness,
end

/--
`relabel` Given an element `⟨ k , k < m ⟩` that is missing from the a collection of
`finite_subset m`, this function can 'squash' the collection into
`finite_subset (m - 1)`.
-/
def relabel
(m k : ℕ)
(h : k < m)
(j : finite_subset m)
: finite_subset (m - 1)
:=
  if H : j.1 ≤ k
  then ⟨j.1, relabel_inequality_lower_case m k h j H⟩
  else ⟨j.1 - 1, downward_ineq j.1 m j.2 sorry⟩

/--
`miss_proof` Proof that `f : [m + 2] -> [m + 1]` restricted
to `[m + 1] = {0, 1, ..., m}` does not hit `f (m + 1)`
-/
lemma miss_proof
(m : ℕ)
(f : finite_subset (m + 2) → finite_subset (m + 1))
(inj : injective f)
(pf: m + 1 < m + 2)
: ∀ j : finite_subset (m + 1), (f ∘ lift_one (m + 1)) j ≠ f ⟨m + 1,  pf⟩
:=
begin
  introv p,
  change f (lift_one (m+1) j) = f ⟨m + 1,  pf⟩ at p,
  let p2 := inj (lift_one (m+1) j) ⟨m + 1,  pf⟩,
  let p3 := p2 p,
  rw ext_iff at p3,
  rw lift_one_fst at p3,
  let p4 := j.2,
  linarith,
end

/--
`relabel_behavior` Given `m k : ℕ`, `h : k < m`, `x y : finite_subset m`,
and `(relabel m k h) x = (relabel m k h) y`, the `if-then-else` structure
of `relabel` yields that either the values of `x, y` must either be less than
or equal to `k` or vice versa
-/
lemma relabel_behavior
(m k : ℕ)
(h : k < m)
(x y : finite_subset m)
(hxy : relabel m k h x = relabel m k h y)
: (x.1 ≤ k ∧ y.1 ≤ k) ∨ (x.1 ≥ k ∧ y.1 ≥ k)
:=
begin
  unfold relabel at hxy,
  split_ifs at hxy with hxk hyk hyk,
  {
    left; split; assumption
  },
  { right; split,
    { rw subtype.mk_eq_mk at hxy,
      cases lt_or_eq_of_le hxk with hxlk hxek,
      {
        rw hxy at hxlk,
        exact absurd (nat.le_of_pred_lt hxlk) hyk,
      },

      {
        exact ge_of_eq hxek
      },
    },

    {
      exact le_of_not_ge hyk
    },
  },
  { right; split,
    {
      exact le_of_not_ge hxk
    },

    { rw subtype.mk_eq_mk at hxy,
      cases lt_or_eq_of_le hyk with hylk hyek,
      {
        rw ← hxy at hylk, exact absurd (nat.le_of_pred_lt hylk) hxk
      },
      { exact ge_of_eq hyek
      },
    },
  },

  {
    right; split; apply le_of_not_ge; assumption
  },

end

/--
`apply_relabel_lt` Lemma that describes the behavior of
`relabel m k h` when the argument is less than `k`.
-/
lemma apply_relabel_lt
(m k : ℕ)
(hkm : k < m)
(z : finite_subset m)
(h2 : z.1 ≤ k)
: (relabel m k hkm z).1 = z.1 :=
begin
  unfold relabel,
  rw dif_pos h2,
end

/--
`apply_relabel_lt` Lemma that describes the behavior of
`relabel m k h` when the argument is greater than `k`.
-/
lemma apply_relabel_gt
(m k : ℕ)
(hkm : k < m)
(z : finite_subset m)
(h2 : k < z.1)
: (relabel m k hkm z).1 = z.1 - 1
:=
begin
  unfold relabel,
  rw dif_neg (not_le_of_lt h2),
end

/--
`relabel_inj` This formalizes the notion that when `f` is injective and misses `k`
in the codomain, then when we relabel to bring `m` to `m - 1`,
composition is in fact injective.
-/
lemma relabel_inj (m k : ℕ) (hkm : k < m + 1)
(f: finite_subset (m + 2) → finite_subset (m + 1))
(inj : injective f)
(pf : (f ⟨ m + 1, succ_greater_than_nat (m + 1)⟩ ).1 < m + 1)
(miss : ∀ j : finite_subset (m + 1), (f ∘ lift_one (m + 1)) j ≠ f ⟨m + 1,  succ_greater_than_nat (m + 1)⟩ )
: injective ((relabel (m + 1) (f ⟨m + 1, succ_greater_than_nat (m + 1)⟩).1 pf) ∘ f ∘ lift_one (m + 1))
:=
begin
  intros x y h,
  change (relabel (m + 1) (f ⟨ m + 1, succ_greater_than_nat (m + 1)⟩ ).1 pf (f (lift_one (m + 1) x))) = (relabel (m + 1) (f ⟨ m + 1, succ_greater_than_nat (m + 1)⟩ ).1 pf (f (lift_one (m + 1) y))) at h,
  rcases relabel_behavior _ _ _ _ _ h with ⟨h1, h2⟩ | ⟨h1, h2⟩; unfold relabel at h,
  {
    rw [dif_pos h1, dif_pos h2, subtype.mk_eq_mk] at h,
    rw ← subtype.ext at h,

    let comp_inj := comp_inj_is_inj (lift_one (m + 1)) f (lift_one_injective (m + 1)) inj,
    change (f ∘ lift_one (m + 1)) x = (f ∘ lift_one (m + 1)) y at h,
    apply comp_inj,
    apply h,
  },

  {
    have m_x := (miss x),
    replace m_x := mt subtype.eq m_x,
    have m_y := (miss y),
    replace m_y := mt subtype.eq m_y,

    have h1_strict := lt_of_le_of_ne h1 (ne.symm m_x),
    have h2_strict := lt_of_le_of_ne h2 (ne.symm m_y),

    rw dif_neg (not_le.mpr h1_strict) at h,
    rw dif_neg (not_le.mpr h2_strict) at h,

    let comp_inj := comp_inj_is_inj (lift_one (m + 1)) f (lift_one_injective (m + 1)) inj,

    rw ext_iff at h,

    let k_ge_zero := ge_zero (f ⟨ m + 1, succ_greater_than_nat (m + 1)⟩).val,
    let h_final := minus_one_both_sides_eq k_ge_zero h1_strict h2_strict h,
    rw ← ext_iff at h_final,
    apply comp_inj,
    apply h_final,
  },

end

/--
`pigeonhole_principle` The pigeonhole principle, which states
that among `n` pigeons, there must be at least `n` cages
for the pigeons to reside in order for every pigeon to have its
own unique page.  Stated more formally, the pigeonhole principle
asserts that there exists no injective function from any finite set
of `n` elements to any set with fewer than `n` elements.
-/
theorem pigeonhole_principle
(n m : ℕ)
(f : finite_subset n → finite_subset m)
: (n > m) → ¬(injective f)
:=
begin

  intros n_gt_m f_injective,
  induction n with d hd,
  { linarith, /- case d = 0 -/ },

  let g := f ∘ (lift_one d),
  let hd' := hd g,

  rcases lt_or_eq_of_le (nat.lt_succ_iff.1 n_gt_m) with h | rfl,

  {   /- case where d > m -/
      /- prove injective g -/
    apply hd' h,
    let g_injective := comp_inj_is_inj (lift_one d) f (lift_one_injective d) f_injective,
    exact g_injective,
  },

  {   /- case where d = m -/
      /- prove f : finite_subset (nat.succ m) → finite_subset m is not injective -/

    induction m with l hl,

    {
      let e:= f ⟨0,_ ⟩,
      let e2 := e.2,
      linarith,
      exact n_gt_m,
    },

    let k := f ⟨l + 1, succ_greater_than_nat (l + 1)⟩,
    let violator := f ∘ (lift_one (l + 1)),
    let restriction := (relabel (l + 1) k.1 k.2) ∘ violator,
    let violator_is_inj := comp_inj_is_inj (lift_one (l + 1)) f (lift_one_injective (l + 1)) f_injective,
    let miss := miss_proof l f f_injective (succ_greater_than_nat (l + 1)),
    let res_is_inj := relabel_inj l k.1 k.2 f f_injective k.2 miss,

    refine hl _ _ _ _ ,
    {
      intros,
      linarith,
    },
    {
      exact restriction,
    },
    {
      exact succ_greater_than_nat _,
    },
    {
      exact res_is_inj,
    },
  }
end