Module SPWEqP := WEqPropertiesOn SetOfPairsOfPositiveOrderedType SP.
Definition pick_line (s : SS.elt) (sp : SP.t) :=
SP.exists_ (fun p => (S.mem (fstpp p) s) && (S.mem (sndpp p) s)) sp.
Definition exists_witness (f : SS.elt -> bool) (s : SS.t) : option SS.elt :=
SS.choose (SS.filter f s).
Definition pick_lines_aux (s1 : SS.elt)
(ss : SS.t)
(sp : SP.t)
: (option (SS.elt * SS.elt)) :=
match ((exists_witness (fun s2 => let i := S.inter s1 s2 in
pick_line i sp)) ss) with
| None => None
| Some s2 => Some(s1,s2)
end.
Definition pick_lines (ss : SS.t) (sp : SP.t)
: (option (SS.elt * SS.elt)) :=
match (exists_witness (fun s =>
match (pick_lines_aux s (SS.remove s ss) sp) with
| None => false
| _ => true
end) ss) with
| None => None
| Some s1 => pick_lines_aux s1 (SS.remove s1 ss) sp
end.
Definition eqop (p1 p2 : option SS.elt) :=
match p1,p2 with
| None, None => True
| Some s1, Some s2 => True
| _, _ => False
end.
Definition eqopp (p1 p2 : option (SS.elt * SS.elt)) :=
match p1,p2 with
| None, None => True
| Some s1, Some s2 => True
| _, _ => False
end.
Function identify_lines (ss : SS.t) (sp : SP.t) {measure SS.cardinal ss}
: SS.t :=
let lines := pick_lines ss sp in
match lines with
|None => ss
|Some (s1,s2) => let auxsetofsets := SS.remove s2 (SS.remove s1 ss) in
let auxset := S.union s1 s2 in
let newss := SS.add auxset auxsetofsets in
identify_lines newss sp
end.
Definition ss_ok (ss : SS.t) (interp: positive -> COLTpoint) :=
forall s, SS.mem s ss = true ->
forall p1 p2 p3, S.mem p1 s && S.mem p2 s && S.mem p3 s = true ->
CTCol (interp p1) (interp p2) (interp p3).
Definition sp_ok (sp : SP.t) (interp: positive -> COLTpoint) :=
forall p, SP.mem p sp = true -> interp (fstpp p) <> interp (sndpp p).
Definition list_assoc_inv :=
(fix list_assoc_inv_rec (A:Type) (B:Set)
(eq_dec:forall e1 e2:B, {e1 = e2} + {e1 <> e2})
(lst : list (prodT A B)) {struct lst} : B -> A -> A :=
fun (key:B) (default:A) =>
match lst with
| nil => default
| cons (pairT v e) l =>
match eq_dec e key with
| left _ => v
| right _ => list_assoc_inv_rec A B eq_dec l key default
end
end).
Definition partition_ss e ss :=
SS.partition (fun s => S.mem e s) ss.
Definition fst_ss (pair : SS.t * SS.t) :=
match pair with
|(a,b) => a
end.
Definition snd_ss (pair : SS.t * SS.t) :=
match pair with
|(a,b) => b
end.
Definition subst_in_set p1 p2 s := S.add p1 (S.remove p2 s).
Definition subst_in_ss_aux p1 p2 := (fun s ss => SS.add (subst_in_set p1 p2 s) ss).
Definition subst_in_ss p1 p2 ss :=
let pair := partition_ss p2 ss in
let fss := fst_ss(pair) in
let sss := snd_ss(pair) in
let newfss := SS.fold (subst_in_ss_aux p1 p2) fss SS.empty in
SS.union newfss sss.
Definition partition_sp_1 p sp :=
SP.partition (fun e => Pos.eqb (fstpp e) p || Pos.eqb (sndpp e) p) sp.
Definition partition_sp_2 p sp :=
SP.partition (fun e => Pos.eqb (fstpp e) p) sp.
Definition fst_sp (pair : SP.t * SP.t) :=
match pair with
|(a,b) => a
end.
Definition snd_sp (pair : SP.t * SP.t) :=
match pair with
|(a,b) => b
end.
Definition new_pair_1 pair (pos : positive) := (pos, sndpp(pair)).
Definition new_pair_2 pair (pos : positive) := (fstpp(pair), pos).
Definition subst_in_sp_aux_1 := (fun pos pair sp => SP.add (new_pair_1 pair pos) sp).
Definition subst_in_sp_aux_2 := (fun pos pair sp => SP.add (new_pair_2 pair pos) sp).
Definition subst_in_sp p1 p2 sp :=
let pair_1 := partition_sp_1 p2 sp in
let sp_to_modify := fst_sp(pair_1) in
let sp_to_keep := snd_sp(pair_1) in
let pair_2 := partition_sp_2 p2 sp_to_modify in
let sp_to_modify_f := fst_sp(pair_2) in
let sp_to_modify_s := snd_sp(pair_2) in
let newsp_to_modify_f := SP.fold (subst_in_sp_aux_1 p1) sp_to_modify_f SP.empty in
let newsp_to_modify_s := SP.fold (subst_in_sp_aux_2 p1) sp_to_modify_s SP.empty in
SP.union (SP.union newsp_to_modify_f newsp_to_modify_s) sp_to_keep.

Lemma proper_6 : forall p, Proper ((fun t1 t2 : SetOfPairsOfPositiveOrderedType.t =>
Pos.eq (fstpp t1) (fstpp t2) /\ Pos.eq (sndpp t1) (sndpp t2)) ==> eq)
(fun e : SP.elt => (fstpp e =? p)%positive || (sndpp e =? p)%positive).