Definition proof_irr_nat := eq_proofs_unicity dec_eq_nat.Program Definition unstratify (n:nat) : Mor (projT2 (sinv n)) predS :=
    Build_Mor _ _ (fun p =>
      Build_Mor _ _ (fun w =>
      match w with (existT nw w',e) =>
        match decompose_nat nw n with
          | inleft (existT m Hm) => snd (floor m (S nw) (eq_rect n (fun x => projT1 (sinv x)) p (m + S nw) Hm)) (w', e)
          | inright H => T_bot
        end
      end) _) _.

(* Specifications: *)
Lemma floor_shuffle: forall (m1 n : nat) (p1 : projT1 (sinv (m1 + S n))) (H1 : (m1 + S n) = (S m1 + n)), floor (S m1) n (eq_rect (m1 + S n) (fun x => (projT1 (sinv x))) p1 (S m1 + n) H1) = fst (floor m1 (S n) p1).
Lemma stratify_unstratify_more : forall n m1 m2 p1 p2, @equiv _ (projT2 (sinv n)) (floor m1 n p1) (floor m2 n p2) -> @equiv _ (projT2 (sinv n)) (stratify n (unstratify (m1+n) p1)) (stratify n (unstratify (m2+n) p2)).
Lemma stratify_unstratify : forall n, stratify n oo unstratify n == idM (projT2 (sinv n)).
Lemma unstratify_stratify1 : forall n (p:predicate) w, le_T ((unstratify n oo stratify n) p w) (p w).
Lemma unstratify_stratify2 : forall n (p:predicate) (w:knot * other), projT1 (fst w) < n -> le_T (p w) ((unstratify n oo stratify n) p w).
Lemma unstratify_stratify3 : forall n (p:predicate) w, projT1 (fst w) >= n -> le_T ((unstratify n oo stratify n) p w) T_bot.