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.

Lemma subst_ss_ok :
forall (A B : COLTpoint) (H : A = B) pa pb ss (interp :  positive -> COLTpoint),
interp pa = A ->
interp pb = B ->
ss_ok ss interp -> ss_ok (subst_in_ss pa pb ss) interp.