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

! This file was ported from Lean 3 source module topology.paracompact
! leanprover-community/mathlib commit 2705404e701abc6b3127da906f40bae062a169c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.SubsetProperties
import Mathlib.Topology.Separation
import Mathlib.Data.Option.Basic

/-!
# Paracompact topological spaces

A topological space `X` is said to be paracompact if every open covering of `X` admits a locally
finite refinement.

The definition requires that each set of the new covering is a subset of one of the sets of the
initial covering. However, one can ensure that each open covering `s : ι → Set X` admits a *precise*
locally finite refinement, i.e., an open covering `t : ι → Set X` with the same index set such that
`∀ i, t i ⊆ s i`, see lemma `precise_refinement`. We also provide a convenience lemma
`precise_refinement_set` that deals with open coverings of a closed subset of `X` instead of the
whole space.

We also prove the following facts.

* Every compact space is paracompact, see instance `paracompact_of_compact`.

* A locally compact sigma compact Hausdorff space is paracompact, see instance
  `paracompact_of_locallyCompact_sigmaCompact`. Moreover, we can choose a locally finite
  refinement with sets in a given collection of filter bases of `𝓝 x, `x : X`, see
  `refinement_of_locallyCompact_sigmaCompact_of_nhds_basis`. For example, in a proper metric space
  every open covering `⋃ i, s i` admits a refinement `⋃ i, Metric.ball (c i) (r i)`.

* Every paracompact Hausdorff space is normal. This statement is not an instance to avoid loops in
  the instance graph.

* Every `EMetricSpace` is a paracompact space, see instance `EMetricSpace.ParacompactSpace` in
  `Topology/MetricSpace/EMetricParacompact`.

## TODO

Prove (some of) [Michael's theorems](https://ncatlab.org/nlab/show/Michael%27s+theorem).

## Tags

compact space, paracompact space, locally finite covering
-/

open Set Filter Function

open Filter Topology

universe u v

/-- A topological space is called paracompact, if every open covering of this space admits a locally
finite refinement. We use the same universe for all types in the definition to avoid creating a
class like `ParacompactSpace.{u v}`. Due to lemma `precise_refinement` below, every open covering
`s : α → Set X` indexed on `α : Type v` has a *precise* locally finite refinement, i.e., a locally
finite refinement `t : α → Set X` indexed on the same type such that each `∀ i, t i ⊆ s i`. -/
class ParacompactSpace (X : Type v) [TopologicalSpace X] : Prop where
  /-- Every open cover of a paracompact space assumes a locally finite refinement. -/
  locallyFinite_refinement :
    ∀ (α : Type v) (s : α → Set X) (_ : ∀ a, IsOpen (s a)) (_ : (⋃ a, s a) = univ),
      ∃ (β : Type v) (t : β → Set X) (_ : ∀ b, IsOpen (t b)) (_ : (⋃ b, t b) = univ),
        LocallyFinite t ∧ ∀ b, ∃ a, t b ⊆ s a
#align paracompact_space ParacompactSpace

variable {ι : Type u} {X : Type v} [TopologicalSpace X]

/-- Any open cover of a paracompact space has a locally finite *precise* refinement, that is,
one indexed on the same type with each open set contained in the corresponding original one. -/
theorem precise_refinement [ParacompactSpace X] (u : ι → Set X) (uo : ∀ a, IsOpen (u a))
    (uc : (⋃ i, u i) = univ) :
    ∃ v : ι → Set X, (∀ a, IsOpen (v a)) ∧ (⋃ i, v i) = univ ∧ LocallyFinite v ∧ ∀ a, v a ⊆ u a :=
  by
  -- Apply definition to `range u`, then turn existence quantifiers into functions using `choose`
  have := ParacompactSpace.locallyFinite_refinement (range u) (fun r ↦ (r : Set X))
    (SetCoe.forall.2 <| forall_range_iff.2 uo) (by rwa [← unionₛ_range, Subtype.range_coe])
  simp only [SetCoe.exists, exists_range_iff', unionᵢ_eq_univ_iff, exists_prop] at this
  choose α t hto hXt htf ind hind using this
  choose t_inv ht_inv using hXt
  choose U hxU hU using htf
  -- Send each `i` to the union of `t a` over `a ∈ ind ⁻¹' {i}`
  refine' ⟨fun i ↦ ⋃ (a : α) (_ha : ind a = i), t a, _, _, _, _⟩
  · exact fun a ↦ isOpen_unionᵢ fun a ↦ isOpen_unionᵢ fun _ ↦ hto a
  · simp only [eq_univ_iff_forall, mem_unionᵢ]
    exact fun x ↦ ⟨ind (t_inv x), _, rfl, ht_inv _⟩
  · refine' fun x ↦ ⟨U x, hxU x, ((hU x).image ind).subset _⟩
    simp only [subset_def, mem_unionᵢ, mem_setOf_eq, Set.Nonempty, mem_inter_iff]
    rintro i ⟨y, ⟨a, rfl, hya⟩, hyU⟩
    exact mem_image_of_mem _ ⟨y, hya, hyU⟩
  · simp only [subset_def, mem_unionᵢ]
    rintro i x ⟨a, rfl, hxa⟩
    exact hind _ hxa
#align precise_refinement precise_refinement

/-- In a paracompact space, every open covering of a closed set admits a locally finite refinement
indexed by the same type. -/
theorem precise_refinement_set [ParacompactSpace X] {s : Set X} (hs : IsClosed s) (u : ι → Set X)
    (uo : ∀ i, IsOpen (u i)) (us : s ⊆ ⋃ i, u i) :
    ∃ v : ι → Set X, (∀ i, IsOpen (v i)) ∧ (s ⊆ ⋃ i, v i) ∧ LocallyFinite v ∧ ∀ i, v i ⊆ u i := by
  -- Porting note: Added proof of uc
  have uc : (unionᵢ fun i => Option.elim' (sᶜ) u i) = univ := by
    apply Subset.antisymm (subset_univ _)
    · simp_rw [← compl_union_self s, Option.elim', unionᵢ_option]
      apply union_subset_union_right (sᶜ) us
  rcases precise_refinement (Option.elim' (sᶜ) u) (Option.forall.2 ⟨isOpen_compl_iff.2 hs, uo⟩)
      uc with
    ⟨v, vo, vc, vf, vu⟩
  refine' ⟨v ∘ some, fun i ↦ vo _, _, vf.comp_injective (Option.some_injective _), fun i ↦ vu _⟩
  · simp only [unionᵢ_option, ← compl_subset_iff_union] at vc
    exact Subset.trans (subset_compl_comm.1 <| vu Option.none) vc
#align precise_refinement_set precise_refinement_set

-- See note [lower instance priority]
/-- A compact space is paracompact. -/
instance (priority := 100) paracompact_of_compact [CompactSpace X] : ParacompactSpace X := by
  -- the proof is trivial: we choose a finite subcover using compactness, and use it
  refine' ⟨fun ι s ho hu ↦ _⟩
  rcases isCompact_univ.elim_finite_subcover _ ho hu.ge with ⟨T, hT⟩
  have := hT; simp only [subset_def, mem_unionᵢ] at this
  choose i _ _ using fun x ↦ this x (mem_univ x)
  refine' ⟨(T : Set ι), fun t ↦ s t, fun t ↦ ho _, _, locallyFinite_of_finite _,
    fun t ↦ ⟨t, Subset.rfl⟩⟩
  simpa only [unionᵢ_coe_set, ← univ_subset_iff]
#align paracompact_of_compact paracompact_of_compact

/-- Let `X` be a locally compact sigma compact Hausdorff topological space, let `s` be a closed set
in `X`. Suppose that for each `x ∈ s` the sets `B x : ι x → Set X` with the predicate
`p x : ι x → Prop` form a basis of the filter `𝓝 x`. Then there exists a locally finite covering
`fun i ↦ B (c i) (r i)` of `s` such that all “centers” `c i` belong to `s` and each `r i` satisfies
`p (c i)`.

The notation is inspired by the case `B x r = Metric.ball x r` but the theorem applies to
`nhds_basis_opens` as well. If the covering must be subordinate to some open covering of `s`, then
the user should use a basis obtained by `Filter.HasBasis.restrict_subset` or a similar lemma, see
the proof of `paracompact_of_locallyCompact_sigmaCompact` for an example.

The formalization is based on two [ncatlab](https://ncatlab.org/) proofs:
* [locally compact and sigma compact spaces are paracompact](https://ncatlab.org/nlab/show/locally+compact+and+sigma-compact+spaces+are+paracompact);
* [open cover of smooth manifold admits locally finite refinement by closed balls](https://ncatlab.org/nlab/show/partition+of+unity#ExistenceOnSmoothManifolds).

See also `refinement_of_locallyCompact_sigmaCompact_of_nhds_basis` for a version of this lemma
dealing with a covering of the whole space.

In most cases (namely, if `B c r ∪ B c r'` is again a set of the form `B c r''`) it is possible
to choose `α = X`. This fact is not yet formalized in `mathlib`. -/
theorem refinement_of_locallyCompact_sigmaCompact_of_nhds_basis_set [LocallyCompactSpace X]
    [SigmaCompactSpace X] [T2Space X] {ι : X → Type u} {p : ∀ x, ι x → Prop} {B : ∀ x, ι x → Set X}
    {s : Set X} (hs : IsClosed s) (hB : ∀ x ∈ s, (𝓝 x).HasBasis (p x) (B x)) :
    ∃ (α : Type v) (c : α → X) (r : ∀ a, ι (c a)),
      (∀ a, c a ∈ s ∧ p (c a) (r a)) ∧
        (s ⊆ ⋃ a, B (c a) (r a)) ∧ LocallyFinite fun a ↦ B (c a) (r a) := by
  classical
    -- For technical reasons we prepend two empty sets to the sequence `CompactExhaustion.choice X`
    set K' : CompactExhaustion X := CompactExhaustion.choice X
    set K : CompactExhaustion X := K'.shiftr.shiftr
    set Kdiff := fun n ↦ K (n + 1) \ interior (K n)
    -- Now we restate some properties of `CompactExhaustion` for `K`/`Kdiff`
    have hKcov : ∀ x, x ∈ Kdiff (K'.find x + 1) := by
      intro x
      simpa only [K'.find_shiftr] using
        diff_subset_diff_right interior_subset (K'.shiftr.mem_diff_shiftr_find x)
    have Kdiffc : ∀ n, IsCompact (Kdiff n ∩ s) :=
      fun n ↦ ((K.isCompact _).diff isOpen_interior).inter_right hs
    -- Next we choose a finite covering `B (c n i) (r n i)` of each
    -- `Kdiff (n + 1) ∩ s` such that `B (c n i) (r n i) ∩ s` is disjoint with `K n`
    have : ∀ (n) (x : ↑(Kdiff (n + 1) ∩ s)), K nᶜ ∈ 𝓝 (x : X) :=
      fun n x ↦ IsOpen.mem_nhds (K.isClosed n).isOpen_compl
        fun hx' ↦ x.2.1.2 <| K.subset_interior_succ _ hx'
    -- Porting note: Commented out `haveI` for now.
    --haveI : ∀ (n) (x : ↑(Kdiff n ∩ s)), Nonempty (ι x) := fun n x ↦ (hB x x.2.2).nonempty
    choose! r hrp hr using fun n (x : ↑(Kdiff (n + 1) ∩ s)) ↦ (hB x x.2.2).mem_iff.1 (this n x)
    have hxr : ∀ (n x) (hx : x ∈ Kdiff (n + 1) ∩ s), B x (r n ⟨x, hx⟩) ∈ 𝓝 x := fun n x hx ↦
      (hB x hx.2).mem_of_mem (hrp _ ⟨x, hx⟩)
    choose T hT using fun n ↦ (Kdiffc (n + 1)).elim_nhds_subcover' _ (hxr n)
    set T' : ∀ n, Set ↑(Kdiff (n + 1) ∩ s) := fun n ↦ T n
    -- Finally, we take the union of all these coverings
    refine' ⟨Σn, T' n, fun a ↦ a.2, fun a ↦ r a.1 a.2, _, _, _⟩
    · rintro ⟨n, x, hx⟩
      exact ⟨x.2.2, hrp _ _⟩
    · refine' fun x hx ↦ mem_unionᵢ.2 _
      rcases mem_unionᵢ₂.1 (hT _ ⟨hKcov x, hx⟩) with ⟨⟨c, hc⟩, hcT, hcx⟩
      exact ⟨⟨_, ⟨c, hc⟩, hcT⟩, hcx⟩
    · intro x
      refine'
        ⟨interior (K (K'.find x + 3)),
          IsOpen.mem_nhds isOpen_interior (K.subset_interior_succ _ (hKcov x).1), _⟩
      have : (⋃ k ≤ K'.find x + 2, range <| Sigma.mk k : Set (Σn, T' n)).Finite :=
        (finite_le_nat _).bunionᵢ fun k _ ↦ finite_range _
      apply this.subset
      rintro ⟨k, c, hc⟩
      simp only [mem_unionᵢ, mem_setOf_eq, mem_image, Subtype.coe_mk]
      rintro ⟨x, hxB : x ∈ B c (r k c), hxK⟩
      refine' ⟨k, _, ⟨c, hc⟩, rfl⟩
      have := (mem_compl_iff _ _).1 (hr k c hxB)
      revert this
      contrapose!
      simp only [ge_iff_le, not_le]
      exact fun hnk ↦ K.subset hnk (interior_subset hxK)
#align refinement_of_locally_compact_sigma_compact_of_nhds_basis_set refinement_of_locallyCompact_sigmaCompact_of_nhds_basis_set

/-- Let `X` be a locally compact sigma compact Hausdorff topological space. Suppose that for each
`x` the sets `B x : ι x → Set X` with the predicate `p x : ι x → Prop` form a basis of the filter
`𝓝 x`. Then there exists a locally finite covering `fun i ↦ B (c i) (r i)` of `X` such that each
`r i` satisfies `p (c i)`.

The notation is inspired by the case `B x r = Metric.ball x r` but the theorem applies to
`nhds_basis_opens` as well. If the covering must be subordinate to some open covering of `s`, then
the user should use a basis obtained by `Filter.HasBasis.restrict_subset` or a similar lemma, see
the proof of `paracompact_of_locallyCompact_sigmaCompact` for an example.

The formalization is based on two [ncatlab](https://ncatlab.org/) proofs:
* [locally compact and sigma compact spaces are paracompact](https://ncatlab.org/nlab/show/locally+compact+and+sigma-compact+spaces+are+paracompact);
* [open cover of smooth manifold admits locally finite refinement by closed balls](https://ncatlab.org/nlab/show/partition+of+unity#ExistenceOnSmoothManifolds).

See also `refinement_of_locallyCompact_sigmaCompact_of_nhds_basis_set` for a version of this lemma
dealing with a covering of a closed set.

In most cases (namely, if `B c r ∪ B c r'` is again a set of the form `B c r''`) it is possible
to choose `α = X`. This fact is not yet formalized in `mathlib`. -/
theorem refinement_of_locallyCompact_sigmaCompact_of_nhds_basis [LocallyCompactSpace X]
    [SigmaCompactSpace X] [T2Space X] {ι : X → Type u} {p : ∀ x, ι x → Prop} {B : ∀ x, ι x → Set X}
    (hB : ∀ x, (𝓝 x).HasBasis (p x) (B x)) :
    ∃ (α : Type v) (c : α → X) (r : ∀ a, ι (c a)),
      (∀ a, p (c a) (r a)) ∧ (⋃ a, B (c a) (r a)) = univ ∧ LocallyFinite fun a ↦ B (c a) (r a) :=
  let ⟨α, c, r, hp, hU, hfin⟩ :=
    refinement_of_locallyCompact_sigmaCompact_of_nhds_basis_set isClosed_univ fun x _ ↦ hB x
  ⟨α, c, r, fun a ↦ (hp a).2, univ_subset_iff.1 hU, hfin⟩
#align refinement_of_locally_compact_sigma_compact_of_nhds_basis refinement_of_locallyCompact_sigmaCompact_of_nhds_basis

-- See note [lower instance priority]
/-- A locally compact sigma compact Hausdorff space is paracompact. See also
`refinement_of_locallyCompact_sigmaCompact_of_nhds_basis` for a more precise statement. -/
instance (priority := 100) paracompact_of_locallyCompact_sigmaCompact [LocallyCompactSpace X]
    [SigmaCompactSpace X] [T2Space X] : ParacompactSpace X := by
  refine' ⟨fun α s ho hc ↦ _⟩
  choose i hi using unionᵢ_eq_univ_iff.1 hc
  have : ∀ x : X, (𝓝 x).HasBasis (fun t : Set X ↦ (x ∈ t ∧ IsOpen t) ∧ t ⊆ s (i x)) id :=
    fun x : X ↦ (nhds_basis_opens x).restrict_subset (IsOpen.mem_nhds (ho (i x)) (hi x))
  rcases refinement_of_locallyCompact_sigmaCompact_of_nhds_basis this with
    ⟨β, c, t, hto, htc, htf⟩
  exact ⟨β, t, fun x ↦ (hto x).1.2, htc, htf, fun b ↦ ⟨i <| c b, (hto b).2⟩⟩
#align paracompact_of_locally_compact_sigma_compact paracompact_of_locallyCompact_sigmaCompact

/- Dieudonné's theorem: a paracompact Hausdorff space is normal. Formalization is based on the proof
at [ncatlab](https://ncatlab.org/nlab/show/paracompact+Hausdorff+spaces+are+normal). -/
theorem normal_of_paracompact_t2 [T2Space X] [ParacompactSpace X] : NormalSpace X := by
  -- First we show how to go from points to a set on one side.
  have : ∀ s t : Set X, IsClosed s → IsClosed t →
      (∀ x ∈ s, ∃ u v, IsOpen u ∧ IsOpen v ∧ x ∈ u ∧ t ⊆ v ∧ Disjoint u v) →
      ∃ u v, IsOpen u ∧ IsOpen v ∧ s ⊆ u ∧ t ⊆ v ∧ Disjoint u v := by
    /- For each `x ∈ s` we choose open disjoint `u x ∋ x` and `v x ⊇ t`. The sets `u x` form an
        open covering of `s`. We choose a locally finite refinement `u' : s → Set X`, then
        `⋃ i, u' i` and `(closure (⋃ i, u' i))ᶜ` are disjoint open neighborhoods of `s` and `t`. -/
    intro s t hs _ H
    choose u v hu hv hxu htv huv using SetCoe.forall'.1 H
    rcases precise_refinement_set hs u hu fun x hx ↦ mem_unionᵢ.2 ⟨⟨x, hx⟩, hxu _⟩ with
      ⟨u', hu'o, hcov', hu'fin, hsub⟩
    refine' ⟨⋃ i, u' i, closure (⋃ i, u' i)ᶜ, isOpen_unionᵢ hu'o, isClosed_closure.isOpen_compl,
      hcov', _, disjoint_compl_right.mono le_rfl (compl_le_compl subset_closure)⟩
    rw [hu'fin.closure_unionᵢ, compl_unionᵢ, subset_interᵢ_iff]
    refine' fun i x hxt hxu ↦
      absurd (htv i hxt) (closure_minimal _ (isClosed_compl_iff.2 <| hv _) hxu)
    exact fun y hyu hyv ↦ (huv i).le_bot ⟨hsub _ hyu, hyv⟩
  -- Now we apply the lemma twice: first to `s` and `t`, then to `t` and each point of `s`.
  refine' ⟨fun s t hs ht hst ↦ this s t hs ht fun x hx ↦ _⟩
  rcases this t {x} ht isClosed_singleton fun y hy ↦ (by
    simp_rw [singleton_subset_iff]
    exact t2_separation (hst.symm.ne_of_mem hy hx))
    with ⟨v, u, hv, hu, htv, hxu, huv⟩
  exact ⟨u, v, hu, hv, singleton_subset_iff.1 hxu, htv, huv.symm⟩
#align normal_of_paracompact_t2 normal_of_paracompact_t2


import IMO2013.N3.N3_general data.pnat.factors

/-! # IMO 2013 N3, Original Version -/

namespace IMOSL
namespace IMO2013N3

open pnat

namespace pnat

/-- The maximum prime divisor of a positive integer n, as a `nat`, or 1 if n = 1. -/
def max_prime_divisor (n : ℕ+) :=
  (n.factor_multiset : multiset ℕ).fold linear_order.max 1

lemma max_prime_divisor_one : max_prime_divisor 1 = 1 :=
  by rw [max_prime_divisor, factor_multiset_one]; refl

lemma max_prime_divisor_prime (p : ℕ+) (h : p.prime) : max_prime_divisor p = p :=
begin
  unfold pnat.prime at h; unfold max_prime_divisor,
  let q : nat.primes := ⟨(p : ℕ), h⟩,
  have h0 : p = ↑q := by ext1; rw nat.primes.coe_pnat_nat; refl,
  rw [h0, factor_multiset_of_prime q, prime_multiset.coe_nat_of_prime,
      multiset.fold_singleton, nat.primes.coe_pnat_nat, subtype.coe_mk],
  exact max_eq_left (le_of_lt (nat.prime.one_lt h))
end

lemma max_prime_divisor_mul (a b : ℕ+) :
  max_prime_divisor (a * b) = max (max_prime_divisor a) (max_prime_divisor b) :=
  by unfold max_prime_divisor; rw [factor_multiset_mul, ← prime_multiset.coe_coe_nat_monoid_hom,
    add_monoid_hom.map_add, ← multiset.fold_add max, max_self]

end pnat

/-- Final solution -/
theorem final_solution_original : set.infinite (set_of (good pnat.max_prime_divisor)) :=
  final_solution_general pnat.max_prime_divisor_mul

end IMO2013N3
end IMOSL


/-
This file defines and proves the correctness of the direct (or naive)
encoding of the n-variable boolean XOR constraint.

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

import cnf.literal
import cnf.assignment
import cnf.clause
import cnf.cnf
import cnf.encoding
import xor.xor
import basic

import data.list.basic
import data.nat.basic

universe u

-- Represents the type of the variable stored in the literal
variables {V : Type u} [decidable_eq V] [inhabited V]

namespace Xor

open literal
open clause -- TODO opening clause doesn't seem to open library...
open cnf
open encoding
open list
open Xor
open explode
open nat

/-! # Direct encoding -/
section direct_encoding

variables {l : list (literal V)} {c : clause V}

/- The direct encoding is the set of all possible clauses with an even number
   of negations on the provided literals in a single CNF formula. -/
def direct_xor : list (literal V) → cnf V
| []        := [[]]
| (l :: ls) := (explode (map var ls)).map
      (λ c, ite (!bodd (c.count_flips ls)) (l :: c) (l.flip :: c))

@[simp] theorem direct_xor_nil : direct_xor ([] : list (literal V)) = [[]] := rfl

@[simp] theorem direct_xor_singleton (lit : literal V) :
  direct_xor [lit] = [[lit]] :=
by simp [direct_xor]

theorem mem_explode_of_mem_direct_xor :
  c ∈ direct_xor l → c ∈ explode (map var l) :=
begin
  cases l with l ls,
  { simp only [explode_nil, imp_self, direct_xor_nil, map_nil] },
  { simp [direct_xor, explode],
    intros cl hcl,
    cases l,
    { cases (bodd (cl.count_flips ls)),
      { simp, intro h, use [cl, hcl, h] },
      { simp, intro h, unfold literal.flip at h,
        right, use [cl, hcl, h] } },
    { cases (bodd (cl.count_flips ls)),
      { simp, intro h, right, use [cl, hcl, h] },
      { simp, intro h, unfold literal.flip at h,
        use [cl, hcl, h] } } }
end

theorem length_direct_xor : l ≠ [] → length (direct_xor l) = 2^(length l - 1) :=
begin
  cases l,
  { contradiction },
  { simp only [direct_xor, length_explode, add_zero, length, add_succ_sub_one,
      ne.def, forall_true_left, not_false_iff, length_map] }
end

theorem length_direct_xor_pos : l ≠ [] → length (direct_xor l) > 0 :=
assume h, by simp only [length_direct_xor h, succ_pos', gt_iff_lt, pow_pos]

theorem exists_mem_direct_xor (l : list (literal V)) :
  ∃ (c : clause V), c ∈ direct_xor l :=
begin
  cases l with l ls,
  { use [nil, mem_singleton_self nil] },
  { exact exists_mem_of_length_pos (length_direct_xor_pos (cons_ne_nil l ls)) }
end

-- These theorems begin to be dependent on order of encoding
-- If the underlying type of Xor changes to (fin)set, must update
theorem map_var_eq_of_mem_direct_xor :
  c ∈ direct_xor l → map var c = map var l :=
begin
  cases l with l ls,
  { simp only [direct_xor, imp_self, map_eq_nil, map_nil, mem_singleton] },
  { simp [direct_xor],
    intros c hc,
    cases (bodd (c.count_flips ls)),
    { simp only [if_true, eq_self_iff_true],
      rintro rfl,
      simp [map_var_eq_iff_mem_explode.mpr hc] },
    { simp only [if_false],
      rintro rfl,
      simp [map_var_eq_iff_mem_explode.mpr hc, flip_var_eq] } }
end

theorem even_flips_iff_mem_direct_xor_of_map_var_eq : map var c = map var l →
  (bodd (c.count_flips l) = ff ↔ c ∈ direct_xor l) :=
begin
  intro hc,
  cases l with l ls,
  { rw [map_nil, map_eq_nil] at hc, subst hc,
    simp only [count_flips_self, bodd_zero, eq_self_iff_true, direct_xor_nil, mem_singleton] },
  { split,
    { simp only [direct_xor, map_cons, bool.cond_to_bool, mem_map],
      intro hf,
      rcases exists_cons_of_map_cons hc with ⟨x, xs, rfl, hx, hxs⟩,
      use xs, split,
      { exact map_var_eq_iff_mem_explode.mp hxs },
      { cases h : (bodd (clause.count_flips xs ls)),
        { rcases var_eq_iff_eq_or_flip_eq.mp hx with rfl | hx,
          { simp only [bool.bnot_ff, coe_sort_tt, if_true], },
          { simp [clause.count_flips, hx] at hf,
            rw h at hf, contradiction } },
        { rcases var_eq_iff_eq_or_flip_eq.mp hx with hx | rfl,
          { simp [clause.count_flips, hx] at hf,
            rw h at hf, contradiction },
          { simp only [flip_flip, bool.bnot_tt, coe_sort_ff, if_false]} } } },
    { { simp only [direct_xor, bool.cond_to_bool, mem_map],
        rintro ⟨a, ha, hf⟩,
        rcases exists_cons_of_map_cons hc with ⟨x, xs, rfl, hx, hxs⟩,
        cases h : (nat.bodd (a.count_flips ls));
        { simp only [h, if_true, eq_self_iff_true, if_false] at hf,
          simp [← hf, clause.count_flips, literal.is_neg, bool.to_nat, h, flip_flip _, flip_ne] } } } }
end

theorem odd_flips_iff_not_mem_direct_xor_of_map_var_eq : map var c = map var l →
  (bodd (c.count_flips l) = tt ↔ c ∉ direct_xor l) :=
begin
  intro hc, split,
  { intro hcount, by_contradiction,
    rw (even_flips_iff_mem_direct_xor_of_map_var_eq hc).mpr h at hcount,
    contradiction },
  { contrapose, simp only [eq_ff_eq_not_eq_tt, not_not],
    exact (even_flips_iff_mem_direct_xor_of_map_var_eq hc).mp }
end

theorem mem_direct_xor_self (l : list (literal V)) : l ∈ (direct_xor l) :=
begin
  have hcount := clause.count_flips_self l,
  have := nat.bodd_zero,
  rw ← hcount at this,
  exact (even_flips_iff_mem_direct_xor_of_map_var_eq (refl _)).mp this
end

-- Some proofs require the stronger statement that direct is exactly xor
theorem eval_direct_xor_eq_eval_Xor (l : list (literal V)) (τ : assignment V) :
  (direct_xor l).eval τ = Xor.eval τ l :=
begin
  cases l with l ls,
  { simp only [cnf.eval_singleton, eval_nil, direct_xor_nil, clause.eval_nil] },
  { have he := eval_eq_bodd_count_tt τ (l :: ls),
    cases h : (Xor.eval τ (l :: ls)),
    { apply eval_ff_iff_exists_clause_eval_ff.mpr,
      use (clause.falsify τ (map var (l :: ls))),
      split,
      { rw [← clause.count_flips_falsify_eq_count_tt τ (l :: ls),
            clause.count_flips_comm] at he,
        apply (even_flips_iff_mem_direct_xor_of_map_var_eq
          (clause.falsify_map_var_eq τ (map var (l :: ls)))).mp,
        rw ← h,
        exact he.symm },
      { exact clause.falsify_eval_ff τ (map var (l :: ls)) } },
    { rw h at he,
      apply eval_tt_iff_forall_clause_eval_tt.mpr,
      intros c hc,
      have mve := map_var_eq_of_mem_direct_xor hc,
      have neqodd := ne_of_eq_ff_of_eq_tt
        ((even_flips_iff_mem_direct_xor_of_map_var_eq mve).mpr hc) he.symm,
      have neq := ne_of_apply_ne nat.bodd neqodd,
      rw clause.count_flips_comm at neq,
      exact clause.eval_tt_of_ne_flips mve.symm (ne.symm neq) } }
end

-- Formal proof of correctness, see encoding.lean
theorem direct_xor_encodes_Xor (l : list (literal V)) :
  encodes Xor (direct_xor l) l :=
begin
  intro τ,
  split,
  { intro h,
    use τ,
    rw eval_direct_xor_eq_eval_Xor l τ,
    exact ⟨h, assignment.eqod.refl τ _⟩ },
  { rintros ⟨σ, he, hs⟩,
    rw [← Xor.eval, eval_eq_of_eqod hs, ← eval_direct_xor_eq_eval_Xor l σ],
    exact he }
end

theorem vars_direct_xor (l : list (literal V)) :
  (direct_xor l).vars = clause.vars l :=
begin
  cases l with l ls,
  { simp only [cnf.vars_singleton, direct_xor_nil] },
  { rw finset.ext_iff, intro v, split,
    { intro hv,
      rcases mem_vars_iff_exists_mem_clause_and_mem.mp hv with ⟨c, hc⟩,
      rw [clause.mem_vars_iff_mem_map_vars],
      rw ← (map_var_eq_of_mem_direct_xor hc.1),
      exact clause.mem_vars_iff_mem_map_vars.mp hc.2 },
    { intro hv,
      apply mem_vars_iff_exists_mem_clause_and_mem.mpr,
      use (l :: ls),
      exact ⟨mem_direct_xor_self _, hv⟩ } }
end

end direct_encoding

end Xor