Definition knot := { n:nat & F (projT1 (sinv n)) }.Inductive knotEq : knot -> knot -> Prop :=
    keq : forall n (f1 f2:F (projT1 (sinv n))),
      @equiv _ (Fs (projT2 (sinv n))) f1 f2 ->
      knotEq (existT (fun x => F (projT1 (sinv x))) n f1)
             (existT (fun x => F (projT1 (sinv x))) n f2).Inductive knotEq : knot -> knot -> Prop :=
    keq : forall n (f1 f2:F (projT1 (sinv n))),
      @equiv _ (Fs (projT2 (sinv n))) f1 f2 ->
      knotEq (existT (fun x => F (projT1 (sinv x))) n f1)
             (existT (fun x => F (projT1 (sinv x))) n f2).Program Instance knotS : Setoid knot := { equiv := knotEq }.Definition koS : Setoid (knot * other) := @ProdSetoid knot knotS other otherS.Definition predicate := Mor koS Ts.Definition predS : Setoid predicate := MorSetoid koS Ts.Definition natFS : Setoid (nat * F predicate) := @ProdSetoid nat (EqSetoid nat) (F predicate) (Fs predS).Program Definition wrap (n:nat) : Mor (ProdSetoid (Fs (projT2 (sinv n))) otherS) (ProdSetoid knotS otherS) :=
    @Build_Mor _ _ _ _ (fun v => (existT (fun x => F (projT1 (sinv x))) n (fst v), snd v)) _.Fixpoint stratify0 (n:nat) (Q:predicate) {struct n} : projT1 (sinv n) :=
    match n as n' return projT1 (sinv n') with
    | O => tt
    | S n' => ( stratify0 n' Q, Q oo (wrap n'))
    end.

(* Specifications: *)
Lemma stratify_mor : forall n, Morphism (equiv ==> (@equiv _ (projT2 (sinv n)))) (stratify0 n).