Section Coinc_refl.
Context {AR : Arity}.
Definition pick_variety_auxCP {m : nat} (s : SS.elt) (cp : cartesianPower positive (S (S m))) : bool.
Definition pick_variety (s : SS.elt) (st : STt) :=
STexists_ (fun t => pick_variety_aux s t) st.
Definition exists_witness (f : SS.elt -> bool) (s : SS.t) : option SS.elt :=
SS.choose (SS.filter f s).
Definition pick_varieties_aux (s1 : SS.elt) (ss : SS.t) (st : STt)
: (option (SS.elt * SS.elt)) :=
match ((exists_witness (fun s2 => let i := S.inter s1 s2 in
pick_variety i st)) ss) with
| None => None
| Some s2 => Some(s1,s2)
end.
Definition pick_varieties (ss : SS.t) (st : STt)
: (option (SS.elt * SS.elt)) :=
match (exists_witness (fun s =>
match (pick_varieties_aux s (SS.remove s ss) st) with
| None => false
| _ => true
end) ss) with
| None => None
| Some s1 => pick_varieties_aux s1 (SS.remove s1 ss) st
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_varieties (ss : SS.t) (st : STt) {measure SS.cardinal ss}
: SS.t :=
let varieties := pick_varieties ss st in
match varieties 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_varieties newss st
end.
Definition memCP (cp : cartesianPower positive (S (S (S n)))) (s : SS.elt) := memCPAux (S n) cp s.
Definition test_coinc (ss : SS.t) (st : STt) (cp : cartesianPower positive (S (S (S n)))) : bool :=
let newss := identify_varieties ss st  in
SS.exists_ (fun s => memCP cp s) newss.
Definition interp_CP {m : nat} (cp : cartesianPower positive (S m)) (interp: positive -> COINCpoint) : cartesianPower COINCpoint (S m).
Context {COP : Coinc_predicates AR}.
Definition ss_ok (ss : SS.t) (interp: positive -> COINCpoint) :=
forall s, SS.mem s ss = true ->
forall cp, memCP cp s = true ->
app coinc (interp_CP cp interp).

Lemma consHdInterpOK : forall (cp : cartesianPower positive 1) (x : tST) interp,
consHeadCP (interp_CP cp interp) (interp_CP x interp) = interp_CP (consHeadCP cp x) interp.