/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.mul_add
import Mathlib.algebra.field
import Mathlib.algebra.opposites
import Mathlib.PostPort

universes u_4 u_5 l u_1 u_2 u_3

namespace Mathlib

/-!
# (Semi)ring equivs

In this file we define extension of `equiv` called `ring_equiv`, which is a datatype representing an
isomorphism of `semiring`s, `ring`s, `division_ring`s, or `field`s. We also introduce the
corresponding group of automorphisms `ring_aut`.

## Notations

The extended equiv have coercions to functions, and the coercion is the canonical notation when
treating the isomorphism as maps.

## Implementation notes

The fields for `ring_equiv` now avoid the unbundled `is_mul_hom` and `is_add_hom`, as these are
deprecated.

Definition of multiplication in the groups of automorphisms agrees with function composition,
multiplication in `equiv.perm`, and multiplication in `category_theory.End`, not with
`category_theory.comp`.

## Tags

equiv, mul_equiv, add_equiv, ring_equiv, mul_aut, add_aut, ring_aut
-/

/-- An equivalence between two (semi)rings that preserves the algebraic structure. -/
structure ring_equiv (R : Type u_4) (S : Type u_5) [Mul R] [Add R] [Mul S] [Add S]
extends R ≃* S, R ≃ S, R ≃+ S
where

infixl:25 " ≃+* " => Mathlib.ring_equiv

/-- The "plain" equivalence of types underlying an equivalence of (semi)rings. -/
/-- The equivalence of additive monoids underlying an equivalence of (semi)rings. -/
/-- The equivalence of multiplicative monoids underlying an equivalence of (semi)rings. -/
namespace ring_equiv

protected instance has_coe_to_fun {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] : has_coe_to_fun (R ≃+* S) :=
  has_coe_to_fun.mk (fun (x : R ≃+* S) => R → S) to_fun

@[simp] theorem to_fun_eq_coe_fun {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (f : R ≃+* S) : to_fun f = ⇑f :=
  rfl

/-- A ring isomorphism preserves multiplication. -/
@[simp] theorem map_mul {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) (x : R) (y : R) : coe_fn e (x * y) = coe_fn e x * coe_fn e y :=
  map_mul' e x y

/-- A ring isomorphism preserves addition. -/
@[simp] theorem map_add {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) (x : R) (y : R) : coe_fn e (x + y) = coe_fn e x + coe_fn e y :=
  map_add' e x y

/-- Two ring isomorphisms agree if they are defined by the
    same underlying function. -/
theorem ext {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] {f : R ≃+* S} {g : R ≃+* S} (h : ∀ (x : R), coe_fn f x = coe_fn g x) : f = g := sorry

protected theorem congr_arg {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] {f : R ≃+* S} {x : R} {x' : R} : x = x' → coe_fn f x = coe_fn f x' := sorry

protected theorem congr_fun {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] {f : R ≃+* S} {g : R ≃+* S} (h : f = g) (x : R) : coe_fn f x = coe_fn g x :=
  h ▸ rfl

theorem ext_iff {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] {f : R ≃+* S} {g : R ≃+* S} : f = g ↔ ∀ (x : R), coe_fn f x = coe_fn g x :=
  { mp := fun (h : f = g) (x : R) => h ▸ rfl, mpr := ext }

protected instance has_coe_to_mul_equiv {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] : has_coe (R ≃+* S) (R ≃* S) :=
  has_coe.mk to_mul_equiv

protected instance has_coe_to_add_equiv {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] : has_coe (R ≃+* S) (R ≃+ S) :=
  has_coe.mk to_add_equiv

theorem coe_mul_equiv {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (f : R ≃+* S) (a : R) : coe_fn (↑f) a = coe_fn f a :=
  rfl

theorem coe_add_equiv {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (f : R ≃+* S) (a : R) : coe_fn (↑f) a = coe_fn f a :=
  rfl

/-- The identity map is a ring isomorphism. -/
protected def refl (R : Type u_1) [Mul R] [Add R] : R ≃+* R :=
  mk (mul_equiv.to_fun (mul_equiv.refl R)) (mul_equiv.inv_fun (mul_equiv.refl R)) sorry sorry sorry sorry

@[simp] theorem refl_apply (R : Type u_1) [Mul R] [Add R] (x : R) : coe_fn (ring_equiv.refl R) x = x :=
  rfl

@[simp] theorem coe_add_equiv_refl (R : Type u_1) [Mul R] [Add R] : ↑(ring_equiv.refl R) = add_equiv.refl R :=
  rfl

@[simp] theorem coe_mul_equiv_refl (R : Type u_1) [Mul R] [Add R] : ↑(ring_equiv.refl R) = mul_equiv.refl R :=
  rfl

protected instance inhabited (R : Type u_1) [Mul R] [Add R] : Inhabited (R ≃+* R) :=
  { default := ring_equiv.refl R }

/-- The inverse of a ring isomorphism is a ring isomorphism. -/
protected def symm {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : S ≃+* R :=
  mk (mul_equiv.to_fun (mul_equiv.symm (to_mul_equiv e))) (mul_equiv.inv_fun (mul_equiv.symm (to_mul_equiv e))) sorry
    sorry sorry sorry

/-- See Note [custom simps projection] -/
def simps.inv_fun {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : S → R :=
  ⇑(ring_equiv.symm e)

@[simp] theorem symm_symm {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : ring_equiv.symm (ring_equiv.symm e) = e :=
  ext fun (x : R) => rfl

@[simp] theorem coe_symm_mk {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (f : R → S) (g : S → R) (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) (h₃ : ∀ (x y : R), f (x * y) = f x * f y) (h₄ : ∀ (x y : R), f (x + y) = f x + f y) : ⇑(ring_equiv.symm (mk f g h₁ h₂ h₃ h₄)) = g :=
  rfl

/-- Transitivity of `ring_equiv`. -/
protected def trans {R : Type u_1} {S : Type u_2} {S' : Type u_3} [Mul R] [Add R] [Mul S] [Add S] [Mul S'] [Add S'] (e₁ : R ≃+* S) (e₂ : S ≃+* S') : R ≃+* S' :=
  mk (mul_equiv.to_fun (mul_equiv.trans (to_mul_equiv e₁) (to_mul_equiv e₂)))
    (mul_equiv.inv_fun (mul_equiv.trans (to_mul_equiv e₁) (to_mul_equiv e₂))) sorry sorry sorry sorry

@[simp] theorem trans_apply {A : Type u_1} {B : Type u_2} {C : Type u_3} [semiring A] [semiring B] [semiring C] (e : A ≃+* B) (f : B ≃+* C) (a : A) : coe_fn (ring_equiv.trans e f) a = coe_fn f (coe_fn e a) :=
  rfl

protected theorem bijective {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : function.bijective ⇑e :=
  equiv.bijective (to_equiv e)

protected theorem injective {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : function.injective ⇑e :=
  equiv.injective (to_equiv e)

protected theorem surjective {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) : function.surjective ⇑e :=
  equiv.surjective (to_equiv e)

@[simp] theorem apply_symm_apply {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) (x : S) : coe_fn e (coe_fn (ring_equiv.symm e) x) = x :=
  equiv.apply_symm_apply (to_equiv e)

@[simp] theorem symm_apply_apply {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) (x : R) : coe_fn (ring_equiv.symm e) (coe_fn e x) = x :=
  equiv.symm_apply_apply (to_equiv e)

theorem image_eq_preimage {R : Type u_1} {S : Type u_2} [Mul R] [Add R] [Mul S] [Add S] (e : R ≃+* S) (s : set R) : ⇑e '' s = ⇑(ring_equiv.symm e) ⁻¹' s :=
  equiv.image_eq_preimage (to_equiv e) s

/-- A commutative ring is isomorphic to its opposite. -/
def to_opposite (R : Type u_1) [comm_semiring R] : R ≃+* (Rᵒᵖ) :=
  mk (equiv.to_fun opposite.equiv_to_opposite) (equiv.inv_fun opposite.equiv_to_opposite) sorry sorry sorry sorry

@[simp] theorem to_opposite_apply (R : Type u_1) [comm_semiring R] (r : R) : coe_fn (to_opposite R) r = opposite.op r :=
  rfl

@[simp] theorem to_opposite_symm_apply (R : Type u_1) [comm_semiring R] (r : Rᵒᵖ) : coe_fn (ring_equiv.symm (to_opposite R)) r = opposite.unop r :=
  rfl

/-- A ring isomorphism sends one to one. -/
@[simp] theorem map_one {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) : coe_fn f 1 = 1 :=
  mul_equiv.map_one ↑f

/-- A ring isomorphism sends zero to zero. -/
@[simp] theorem map_zero {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) : coe_fn f 0 = 0 :=
  add_equiv.map_zero ↑f

@[simp] theorem map_eq_one_iff {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) {x : R} : coe_fn f x = 1 ↔ x = 1 :=
  mul_equiv.map_eq_one_iff ↑f

@[simp] theorem map_eq_zero_iff {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) {x : R} : coe_fn f x = 0 ↔ x = 0 :=
  add_equiv.map_eq_zero_iff ↑f

theorem map_ne_one_iff {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) {x : R} : coe_fn f x ≠ 1 ↔ x ≠ 1 :=
  mul_equiv.map_ne_one_iff ↑f

theorem map_ne_zero_iff {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) {x : R} : coe_fn f x ≠ 0 ↔ x ≠ 0 :=
  add_equiv.map_ne_zero_iff ↑f

/-- Produce a ring isomorphism from a bijective ring homomorphism. -/
def of_bijective {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R →+* S) (hf : function.bijective ⇑f) : R ≃+* S :=
  mk (equiv.to_fun (equiv.of_bijective (⇑f) hf)) (equiv.inv_fun (equiv.of_bijective (⇑f) hf)) sorry sorry
    (ring_hom.map_mul' f) (ring_hom.map_add' f)

@[simp] theorem map_neg {R : Type u_1} {S : Type u_2} [ring R] [ring S] (f : R ≃+* S) (x : R) : coe_fn f (-x) = -coe_fn f x :=
  add_equiv.map_neg (↑f) x

@[simp] theorem map_sub {R : Type u_1} {S : Type u_2} [ring R] [ring S] (f : R ≃+* S) (x : R) (y : R) : coe_fn f (x - y) = coe_fn f x - coe_fn f y :=
  add_equiv.map_sub (↑f) x y

@[simp] theorem map_neg_one {R : Type u_1} {S : Type u_2} [ring R] [ring S] (f : R ≃+* S) : coe_fn f (-1) = -1 :=
  map_one f ▸ map_neg f 1

/-- Reinterpret a ring equivalence as a ring homomorphism. -/
def to_ring_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) : R →+* S :=
  ring_hom.mk (monoid_hom.to_fun (mul_equiv.to_monoid_hom (to_mul_equiv e))) sorry sorry sorry sorry

theorem to_ring_hom_injective {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] : function.injective to_ring_hom :=
  fun (f g : R ≃+* S) (h : to_ring_hom f = to_ring_hom g) => ext (iff.mp ring_hom.ext_iff h)

protected instance has_coe_to_ring_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] : has_coe (R ≃+* S) (R →+* S) :=
  has_coe.mk to_ring_hom

theorem coe_ring_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) (a : R) : coe_fn (↑f) a = coe_fn f a :=
  rfl

theorem coe_ring_hom_inj_iff {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (f : R ≃+* S) (g : R ≃+* S) : f = g ↔ ↑f = ↑g :=
  { mp := congr_arg fun (f : R ≃+* S) => ↑f, mpr := fun (h : ↑f = ↑g) => ext (iff.mp ring_hom.ext_iff h) }

/-- Reinterpret a ring equivalence as a monoid homomorphism. -/
def to_monoid_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) : R →* S :=
  ring_hom.to_monoid_hom (to_ring_hom e)

/-- Reinterpret a ring equivalence as an `add_monoid` homomorphism. -/
def to_add_monoid_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) : R →+ S :=
  ring_hom.to_add_monoid_hom (to_ring_hom e)

@[simp] theorem to_ring_hom_refl {R : Type u_1} [semiring R] : to_ring_hom (ring_equiv.refl R) = ring_hom.id R :=
  rfl

@[simp] theorem to_monoid_hom_refl {R : Type u_1} [semiring R] : to_monoid_hom (ring_equiv.refl R) = monoid_hom.id R :=
  rfl

@[simp] theorem to_add_monoid_hom_refl {R : Type u_1} [semiring R] : to_add_monoid_hom (ring_equiv.refl R) = add_monoid_hom.id R :=
  rfl

@[simp] theorem to_ring_hom_apply_symm_to_ring_hom_apply {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) (y : S) : coe_fn (to_ring_hom e) (coe_fn (to_ring_hom (ring_equiv.symm e)) y) = y :=
  equiv.apply_symm_apply (to_equiv e)

@[simp] theorem symm_to_ring_hom_apply_to_ring_hom_apply {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) (x : R) : coe_fn (to_ring_hom (ring_equiv.symm e)) (coe_fn (to_ring_hom e) x) = x :=
  equiv.symm_apply_apply (to_equiv e)

@[simp] theorem to_ring_hom_trans {R : Type u_1} {S : Type u_2} {S' : Type u_3} [semiring R] [semiring S] [semiring S'] (e₁ : R ≃+* S) (e₂ : S ≃+* S') : to_ring_hom (ring_equiv.trans e₁ e₂) = ring_hom.comp (to_ring_hom e₂) (to_ring_hom e₁) :=
  rfl

@[simp] theorem to_ring_hom_comp_symm_to_ring_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) : ring_hom.comp (to_ring_hom e) (to_ring_hom (ring_equiv.symm e)) = ring_hom.id S := sorry

@[simp] theorem symm_to_ring_hom_comp_to_ring_hom {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (e : R ≃+* S) : ring_hom.comp (to_ring_hom (ring_equiv.symm e)) (to_ring_hom e) = ring_hom.id R := sorry

/--
Construct an equivalence of rings from homomorphisms in both directions, which are inverses.
-/
def of_hom_inv {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (hom : R →+* S) (inv : S →+* R) (hom_inv_id : ring_hom.comp inv hom = ring_hom.id R) (inv_hom_id : ring_hom.comp hom inv = ring_hom.id S) : R ≃+* S :=
  mk (ring_hom.to_fun hom) ⇑inv sorry sorry (ring_hom.map_mul' hom) (ring_hom.map_add' hom)

@[simp] theorem of_hom_inv_apply {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (hom : R →+* S) (inv : S →+* R) (hom_inv_id : ring_hom.comp inv hom = ring_hom.id R) (inv_hom_id : ring_hom.comp hom inv = ring_hom.id S) (r : R) : coe_fn (of_hom_inv hom inv hom_inv_id inv_hom_id) r = coe_fn hom r :=
  rfl

@[simp] theorem of_hom_inv_symm_apply {R : Type u_1} {S : Type u_2} [semiring R] [semiring S] (hom : R →+* S) (inv : S →+* R) (hom_inv_id : ring_hom.comp inv hom = ring_hom.id R) (inv_hom_id : ring_hom.comp hom inv = ring_hom.id S) (s : S) : coe_fn (ring_equiv.symm (of_hom_inv hom inv hom_inv_id inv_hom_id)) s = coe_fn inv s :=
  rfl

end ring_equiv

namespace mul_equiv

/-- Gives a `ring_equiv` from a `mul_equiv` preserving addition.-/
def to_ring_equiv {R : Type u_1} {S : Type u_2} [Add R] [Add S] [Mul R] [Mul S] (h : R ≃* S) (H : ∀ (x y : R), coe_fn h (x + y) = coe_fn h x + coe_fn h y) : R ≃+* S :=
  ring_equiv.mk (equiv.to_fun (to_equiv h)) (equiv.inv_fun (to_equiv h)) sorry sorry (map_mul' h) sorry

end mul_equiv

namespace ring_equiv

@[simp] theorem trans_symm {R : Type u_1} {S : Type u_2} [Add R] [Add S] [Mul R] [Mul S] (e : R ≃+* S) : ring_equiv.trans e (ring_equiv.symm e) = ring_equiv.refl R :=
  ext (left_inv e)

@[simp] theorem symm_trans {R : Type u_1} {S : Type u_2} [Add R] [Add S] [Mul R] [Mul S] (e : R ≃+* S) : ring_equiv.trans (ring_equiv.symm e) e = ring_equiv.refl S :=
  ext (right_inv e)

/-- If two rings are isomorphic, and the second is an integral domain, then so is the first. -/
protected theorem is_integral_domain {A : Type u_1} (B : Type u_2) [ring A] [ring B] (hB : is_integral_domain B) (e : A ≃+* B) : is_integral_domain A := sorry

/-- If two rings are isomorphic, and the second is an integral domain, then so is the first. -/
protected def integral_domain {A : Type u_1} (B : Type u_2) [ring A] [integral_domain B] (e : A ≃+* B) : integral_domain A :=
  integral_domain.mk ring.add ring.add_assoc ring.zero ring.zero_add ring.add_zero ring.neg ring.sub ring.add_left_neg
    ring.add_comm ring.mul ring.mul_assoc ring.one ring.one_mul ring.mul_one ring.left_distrib ring.right_distrib sorry
    sorry sorry

end ring_equiv

namespace equiv

/-- In a division ring `K`, the unit group `units K`
is equivalent to the subtype of nonzero elements. -/
-- TODO: this might already exist elsewhere for `group_with_zero`

-- deduplicate or generalize

def units_equiv_ne_zero (K : Type u_4) [division_ring K] : units K ≃ ↥(set_of fun (a : K) => a ≠ 0) :=
  mk (fun (a : units K) => { val := units.val a, property := sorry })
    (fun (a : ↥(set_of fun (a : K) => a ≠ 0)) => units.mk0 (subtype.val a) sorry) sorry sorry

@[simp] theorem coe_units_equiv_ne_zero {K : Type u_4} [division_ring K] (a : units K) : ↑(coe_fn (units_equiv_ne_zero K) a) = ↑a :=
  rfl


import Saturn.FinSeq
import Saturn.Vector
import Saturn.Clause
import Saturn.Solverstep
open Nat
open FinSeq

/-
The inductive step for adding a new clause when it should be dropped. The new clauses and maps
are defined. All the witnesses for the relations between the old and new clauses are also
constructed.
-/
def addPositiveClause{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
            ReductionClauses branch focus focusLt (head +: clauses) :=
          fun rc head pos =>
          let domN := dom + 1
          let codomN := rc.codom
          let clausesN := head +: clauses
          let forwardVecN := none +: rc.forwardVec
          let forwardN: (k : Nat) →  k < domN → Option Nat  :=
            fun k  =>
            match k with
            | zero => fun _ => none
            | l + 1 =>
              fun w : l + 1 < domN   =>  rc.forward l (le_of_succ_le_succ w)
          have forwardNEq : forwardVecN.coords = forwardN := by
                  apply funext
                  intro j
                  cases j with
                  | zero =>
                    apply funext
                    intro jw
                    rfl
                  | succ i =>
                    apply funext
                    intro jw
                    have tl :forwardVecN.coords (succ i) jw =
                        forwardVecN.coords.tail i (Nat.le_of_succ_le_succ jw) := by rfl
                    rw [tl]
                    rw [tail_commutes none rc.forwardVec]
          have forwardWitN : (k: Nat) → (w: k < domN) → boundOpt codomN (forwardN k w) :=
            fun k  =>
            match k with
            | zero => fun w =>
              let resolve : forwardN zero w = none := by rfl
              by
                rw [resolve]
                exact True.intro
                done
            | l + 1 =>
              fun w : l + 1 < domN   =>
                let lem : forwardN (l + 1) w = rc.forward l (le_of_succ_le_succ w) := by rfl
                by
                  rw [lem]
                  exact (rc.forwardWit l (le_of_succ_le_succ w))
                  done
          let reverseVecN := rc.reverseVec.map (. + 1)
          let reverseN : (k : Nat) →  k < codomN → Nat :=
            fun k w => (rc.reverse k w) + 1
          have reverseNEq : reverseVecN.coords = reverseN := by
                  apply funext
                  intro j
                  apply funext
                  intro jw
                  apply map_coords_commute
                  done
          have reverseWitN : (k : Nat) → (w : k < codomN) → reverseN k w < domN :=
            fun k w => succ_le_succ (rc.reverseWit k  w)
          ReductionClauses.mk codomN rc.restClauses
                    (forwardVecN)
                    (forwardNEq ▸ forwardWitN)
                    reverseVecN
                    (reverseNEq ▸ reverseWitN)

namespace PosResClause

def droppedProof{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
          DroppedProof rc →
          DroppedProof (addPositiveClause  branch focus focusLt clauses rc head pos) :=
        fun rc head pos drc =>
          let rcN := addPositiveClause  branch focus focusLt clauses rc head pos
          let domN := dom + 1
          let codomN := rc.codom
          let clausesN := head +: clauses
          let droppedN :
              (k : Nat) → (w: k < domN) → rcN.forward k w = none →
                  (clausesN.coords k w).coords focus focusLt = some branch := by
                  intro k
                  match k with
                  | zero =>
                    intro _ _
                    exact pos
                  | l + 1 =>
                      intro w nw
                      let resolve : rcN.forward (l + 1) w =
                        rc.forward l (le_of_succ_le_succ w) := by rfl
                      rw [resolve] at nw
                      let lem3 := drc.dropped l (le_of_succ_le_succ w) nw
                      exact lem3
          ⟨droppedN⟩

def forwardRelation{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
          ForwardRelation rc →
          ForwardRelation (addPositiveClause  branch focus focusLt clauses rc head pos) :=
        fun rc head pos frc =>
          let rcN := addPositiveClause  branch focus focusLt clauses rc head pos
          let domN := dom + 1
          let codomN := rc.codom
          let clausesN := head +: clauses
          have forwardRelationN : (k : Nat) → (w: k < domN) → (j: Nat) →  rcN.forward k w = some j →
              (jw : j < codomN) →  delete focus focusLt ((clausesN.coords k w).coords) =
                (rcN.restClauses.coords j jw).coords := by
                intro k
                match k with
                | zero =>
                  intro w j sw
                  exact Option.noConfusion sw
                | l + 1 =>
                  intro w j sw
                  exact frc.forwardRelation l (le_of_succ_le_succ w) j sw
          ⟨forwardRelationN⟩

theorem reverseResolve{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : (head.coords focus focusLt = some branch)) →
        (l: Nat) → (w : l  < rc.codom ) →
          (addPositiveClause  branch focus focusLt clauses rc head pos).reverse l w =
            (rc.reverse l w) + 1 := by
            intro rc head neg l w
            let rcN := addPositiveClause  branch focus focusLt clauses rc head neg
            have res1 : rcN.reverse l w =
                                      rcN.reverseVec.coords l w := by rfl
            have res2 : rc.reverse l w =
                    rc.reverseVec.coords l w := by rfl
            rw [res1]
            rw [res2]
            have res3 :rcN.reverseVec =
              (rc.reverseVec.map (. + 1)) := by rfl
            rw [res3]
            have res4 :
                ( (rc.reverseVec.map (. + 1)) ).coords l w =
                  (zero +:
                  (rc.reverseVec.map (. + 1)) ).coords.tail
                  l w := by rfl
            rw [res4]
            rw [(tail_commutes
                zero (rc.reverseVec.map (. + 1)))]
            rw [map_coords_commute]

def reverseRelation{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
          ReverseRelation rc →
          ReverseRelation (addPositiveClause  branch focus focusLt clauses rc head pos) :=
        fun rc head pos rrc =>
          let rcN := addPositiveClause  branch focus focusLt clauses rc head pos
          let domN := dom + 1
          let codomN := rc.codom
          let clausesN := head +: clauses
          have relationN : (k : Nat) → (w: k < codomN) →
                 (rcN.restClauses.coords k w).coords =
                  delete focus focusLt
                    (clausesN.coords (rcN.reverse k w) (rcN.reverseWit k w)).coords :=
                  by
                    intro l
                    intro w
                    let lem1 : rcN.restClauses.coords l w =
                              rc.restClauses.coords l w := by rfl
                    let lem2 := rrc.relation l w
                    rw [lem1]
                    rw [lem2]
                    have rs0 : clausesN.coords (rcN.reverse l w)
                                (rcN.reverseWit l w) =
                                  clausesN.coords
                                    (rc.reverse l w + 1)
                                    (succ_le_succ
                                      (rc.reverseWit l w)) := by
                                    apply witness_independent
                                    apply reverseResolve
                    rw [rs0]
                    rfl
          ⟨relationN⟩

def pureReverse{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
      (rc: ReductionClauses branch focus focusLt clauses) →
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
          NonPosReverse rc →
          NonPosReverse (addPositiveClause  branch focus focusLt clauses rc head pos) :=
        fun rc head pos prc =>
          let rcN := addPositiveClause  branch focus focusLt clauses rc head pos
          let domN := dom + 1
          let codomN := rc.codom
          let clausesN := head +: clauses
          have pureN : (k : Nat) → (w: k < codomN)  →
                Not (
                  (clausesN.coords (rcN.reverse k w) (rcN.reverseWit k w)).coords
                     focus focusLt = some branch) :=
                  by
                    intro l w hyp
                    have rs0 : clausesN.coords (rcN.reverse l w)
                                (rcN.reverseWit l w) =
                                  clausesN.coords
                                    (rc.reverse l w + 1)
                                    (succ_le_succ
                                      (rc.reverseWit l w)) := by
                                    apply witness_independent
                                    apply reverseResolve
                    rw [rs0] at hyp
                    have rs1 : clausesN.coords
                                    (rc.reverse l w + 1)
                                    (succ_le_succ
                                      (rc.reverseWit l w)) =
                                        clauses.coords (rc.reverse l w)
                                        (rc.reverseWit l w) := by rfl
                    rw [rs1] at hyp
                    let prev := prc.nonPosRev l w
                    exact absurd hyp prev
          ⟨pureN⟩

def prependResData{dom n: Nat}(branch: Bool)(focus: Nat)(focusLt : focus < n + 1)
    (clauses: Vector (Clause (n + 1)) dom):
        (head : Clause (n + 1)) → (pos : head.coords focus focusLt = some branch) →
        (rd : ReductionData branch focus focusLt clauses) →
        ReductionData branch focus focusLt (head +: clauses) :=
          fun head pos rd =>
          let rc := addPositiveClause branch focus focusLt clauses rd.restrictionClauses head pos
          ⟨rc,
          droppedProof branch focus focusLt clauses rd.restrictionClauses head pos rd.droppedProof,
          forwardRelation branch focus focusLt clauses rd.restrictionClauses head pos rd.forwardRelation,
          reverseRelation branch focus focusLt clauses rd.restrictionClauses head pos rd.reverseRelation,
          pureReverse branch focus focusLt clauses rd.restrictionClauses head pos rd.nonPosReverse⟩

end PosResClause


import library_dev.data.list.sort

open list

@[reducible] def pre_pdmap (K : Type) (V : K → Type) := list (Σ (k : K), V k)

namespace pre_pdmap
variables {K : Type} {V : K → Type}

def get [decidable_eq K] [∀ k, inhabited (V k)] (k₀ : K) : pre_pdmap K V → V k₀
| []           := default _
| (⟨k,v⟩::kvs) := if H : k = k₀ then eq.rec_on H v else get kvs

def has_key [decidable_eq K] (k₀ : K) : pre_pdmap K V → Prop
| []           := false
| (⟨k,v⟩::kvs) := if k₀ = k then true else has_key kvs

instance decidable_has_key [decidable_eq K]  (k₀ : K) : Π (kvs : pre_pdmap K V), decidable (has_key k₀ kvs)
| [] := is_false (λ f, f)
| (⟨k, v⟩::kvs) :=
begin
dunfold has_key,
apply (@decidable.by_cases (k₀ = k)),
{ intro H_eq, simp [H_eq], exact decidable.true },
{ intro H_neq, simp [H_neq], apply decidable_has_key }
end

def rm_key [decidable_eq K] (k₀ : K) : pre_pdmap K V → pre_pdmap K V
| []             := []
| (⟨k,v⟩::kvs) := if k₀ = k then kvs else ⟨k,v⟩ :: rm_key kvs

def insert [decidable_eq K] (k₀ : K) (v₀ : V k₀) (pdm : pre_pdmap K V) : pre_pdmap K V :=
if has_key k₀ pdm then ⟨k₀, v₀⟩ :: rm_key k₀ pdm else ⟨k₀, v₀⟩ :: pdm

def keys : pre_pdmap K V → list K
| [] := []
| (⟨k,v⟩::kvs) := k::keys kvs

def erase_dup_keys [decidable_eq K] : pre_pdmap K V → pre_pdmap K V
| []        :=  []
| (⟨k,v⟩ :: kvs) := if has_key k kvs then erase_dup_keys kvs else ⟨k,v⟩ :: erase_dup_keys kvs

end pre_pdmap

def pdmap (K : Type) (V : K → Type) : Type := {xs : pre_pdmap K V // nodup (pre_pdmap.keys xs)}

namespace pdmap
variables {K : Type} {V : K → Type}

-- TODO(dhs): nodup nil
def mk : pdmap K V := ⟨[], sorry⟩

def get [decidable_eq K] [∀ k, inhabited (V k)] (k₀ : K) : pdmap K V → V k₀
| ⟨kvs, H⟩ := pre_pdmap.get k₀ kvs

def has_key [decidable_eq K] (k₀ : K) : pdmap K V → Prop
| ⟨kvs, H⟩ := pre_pdmap.has_key k₀ kvs

instance decidable_has_key [decidable_eq K]  (k₀ : K) : Π (kvs : pdmap K V), decidable (has_key k₀ kvs)
| ⟨kvs, H⟩ := begin dunfold has_key, apply_instance end

-- TODO(dhs): removing does not introduce a duplicate
def rm_key [decidable_eq K] (k₀ : K) : pdmap K V → pdmap K V
| ⟨kvs, H⟩ := ⟨pre_pdmap.rm_key k₀ kvs, sorry⟩

-- TODO(dhs): removing does not introduce a duplicate, and means not in, and consing when not in does not introduce a duplicate
def insert [decidable_eq K] (k₀ : K) (v₀ : V k₀) : pdmap K V → pdmap K V
| ⟨kvs, H⟩ := ⟨pre_pdmap.insert k₀ v₀ kvs, sorry⟩

def keys : pdmap K V → list K
| ⟨kvs, H⟩ := pre_pdmap.keys kvs

definition eqv (l₁ l₂ : pdmap K V) :=
perm l₁.1 l₂.1

local infix ~ := eqv

definition eqv.refl (l : pdmap K V) : l ~ l :=
perm.refl l.1

definition eqv.symm (l₁ l₂ : pdmap K V) : l₁ ~ l₂ → l₂ ~ l₁ :=
perm.symm

definition eqv.trans (l₁ l₂ l₃ : pdmap K V) : l₁ ~ l₂ → l₂ ~ l₃ → l₁ ~ l₃ :=
perm.trans

instance pdmap.eqv_setoid : setoid (pdmap K V) :=
setoid.mk eqv (mk_equivalence eqv eqv.refl eqv.symm eqv.trans)

end pdmap

def dmap (K : Type) (V : K → Type) : Type := quot (@pdmap.eqv K V)

namespace dmap
variables {K : Type} {V : K → Type}

def mk : dmap K V := quotient.mk pdmap.mk

def has_key [decidable_eq K] (k₀ : K) (dm : dmap K V) : Prop :=
quot.lift_on dm (λ pdm, pdmap.has_key k₀ pdm) (λ l₁ l₂ (e : pdmap.eqv l₁ l₂), sorry)

instance decidable_has_key [decidable_eq K] (k₀ : K) (dm : dmap K V) : decidable (has_key k₀ dm) :=
quot.rec_on dm (λ pdm, pdmap.decidable_has_key k₀ pdm) (λ l₁ l₂ (e : pdmap.eqv l₁ l₂), sorry)

def get [decidable_eq K] [∀ k, inhabited (V k)] (k₀ : K) (dm : dmap K V) : V k₀ :=
quot.lift_on dm (λ pdm, pdmap.get k₀ pdm) (λ l₁ l₂ (H_eqv : pdmap.eqv l₁ l₂), sorry)

def insert [decidable_eq K] (k₀ : K) (v₀ : V k₀) (dm : dmap K V) : dmap K V :=
quot.lift_on dm (λ pdm, quotient.mk $ pdmap.insert k₀ v₀ pdm) (λ l₁ l₂ (H_eqv : pdmap.eqv l₁ l₂), sorry)

def keys [has_lt K] [decidable_rel (@has_lt.lt K _)] (dm : dmap K V) : list K :=
quot.lift_on dm (λ pdm, insertion_sort has_lt.lt (pdmap.keys pdm)) (λ l₁ l₂ (H_eqv : pdmap.eqv l₁ l₂), sorry)

lemma has_key_mem_keys [decidable_eq K] [has_lt K] [decidable_rel (@has_lt.lt K _)] {k : K} {dm : dmap K V} :
  has_key k dm → k ∈ keys dm := sorry

lemma has_key_insert [decidable_eq K] {k₁ k₂ : K} {v₂ : V k₂} {dm : dmap K V} :
  has_key k₁ dm → has_key k₁ (insert k₂ v₂ dm) := sorry

lemma has_key_insert_same [decidable_eq K] (k : K) {v : V k} (dm : dmap K V) :
  has_key k (insert k v dm) := sorry

lemma get_insert_same [decidable_eq K] [∀ k, inhabited (V k)] (k : K) (v : V k) (dm : dmap K V) :
  get k (insert k v dm) = v := sorry

lemma get_insert_diff [decidable_eq K] [∀ k, inhabited (V k)] {k₁ k₂ : K} (v₂ : V k₂) (dm : dmap K V) :
  k₁ ≠ k₂ → get k₁ (insert k₂ v₂ dm) = get k₁ dm := sorry

lemma insert_get_same [decidable_eq K] [∀ k, inhabited (V k)] (k : K) (dm : dmap K V) :
  insert k (get k dm) dm = dm := sorry

lemma insert_insert_flip [decidable_eq K] [∀ k, inhabited (V k)] {k₁ k₂ : K} (v₁ : V k₁) (v₂ : V k₂) (dm : dmap K V) :
  k₁ ≠ k₂ → insert k₁ v₁ (insert k₂ v₂ dm) = insert k₂ v₂ (insert k₁ v₁ dm) := sorry

lemma insert_insert_same [decidable_eq K] (k : K) (v₁ v₂ : V k) (dm : dmap K V) :
  insert k v₁ (insert k v₂ dm) = insert k v₁ dm := sorry

lemma nodup_insert [decidable_eq K] [has_lt K] [decidable_rel (@has_lt.lt K _)] {k : K} {v : V k} {ks : list K} {dm : dmap K V} :
  nodup (dmap.keys dm ++ (k :: ks)) → nodup (dmap.keys (dmap.insert k v dm) ++ ks) := sorry

lemma not_mem_of_insert [decidable_eq K] [has_lt K] [decidable_rel (@has_lt.lt K _)] {k₀ k : K} {v : V k} {ks : list K} {dm : dmap K V} :
  k₀ ∉ (dmap.keys dm ++ (k :: ks)) → k₀ ∉ (dmap.keys (dmap.insert k v dm) ++ ks) := sorry

lemma not_mem_of_insert_symm [decidable_eq K] [has_lt K] [decidable_rel (@has_lt.lt K _)] {k₀ k : K} {v : V k} {ks : list K} {dm : dmap K V} :
  k₀ ∉ (dmap.keys (dmap.insert k v dm) ++ ks) → k₀ ∉ (dmap.keys dm ++ (k :: ks)) := sorry

end dmap