Definition stratify (n:nat) : { x:sinv n | stratifies n x }.
End stratifies.

(* Specifications: *)
Lemma decompose_nat : forall (x y:nat), { m:nat & y = (m + S x) } + { ge x y }.
Definition unstratify (n:nat) (p:sinv n) : knot * other -> T := fun w =>
match w with (existT _ nw w',o) =>
match decompose_nat nw n with
| inleft (existT _ m Hm) => snd (proj1_sig (floor m (S nw) (eq_rect  n _ p (m + S nw) Hm))) (w',o)
| inright H => T_bot
end
end.
Lemma floor_shuffle:
forall (m1 n : nat)
(p1 : sinv (m1 + S n)) (H1 : (m1 + S n) = (S m1 + n)),
floor (S m1) n (eq_rect (m1 + S n) sinv p1 (S m1 + n) H1) = fst (proj1_sig (floor m1 (S n) p1)).
Lemma unstratify_hered : forall n p,
hered (unstratify n p).
Lemma unstratify_Q : forall n (p:sinv n) Q,
stratifies Q n p ->
forall (k:knot) (o:other),
projT1 k < n ->
(unstratify n p (k,o) = Q (k,o)).
Lemma stratifies_unstratify_more :
forall (n m1 m2:nat) (p1:sinv (m1+n)) (p2:sinv (m2+n)),
floor m1 n p1 = floor m2 n p2 ->
(stratifies (unstratify (m1+n) p1) n (floor m1 n p1) ->
stratifies (unstratify (m2+n) p2) n (floor m2 n p2)).
Lemma stratify_unstratify : forall n p H,
proj1_sig (stratify (unstratify n p) H n) = p.
Lemma decompose_nat : forall (x y:nat), { m:nat & y = (m + S x) } + { ge x y }.
Definition unstratify (n:nat) (p:sinv n) : knot * other -> T := fun w =>
match w with (existT _ nw w',o) =>
match decompose_nat nw n with
| inleft (existT _ m Hm) => snd (proj1_sig (floor m (S nw) (eq_rect  n _ p (m + S nw) Hm))) (w',o)
| inright H => T_bot
end
end.
Lemma floor_shuffle:
forall (m1 n : nat)
(p1 : sinv (m1 + S n)) (H1 : (m1 + S n) = (S m1 + n)),
floor (S m1) n (eq_rect (m1 + S n) sinv p1 (S m1 + n) H1) = fst (proj1_sig (floor m1 (S n) p1)).
Lemma unstratify_hered : forall n p,
hered (unstratify n p).
Lemma unstratify_Q : forall n (p:sinv n) Q,
stratifies Q n p ->
forall (k:knot) (o:other),
projT1 k < n ->
(unstratify n p (k,o) = Q (k,o)).
Lemma stratifies_unstratify_more :
forall (n m1 m2:nat) (p1:sinv (m1+n)) (p2:sinv (m2+n)),
floor m1 n p1 = floor m2 n p2 ->
(stratifies (unstratify (m1+n) p1) n (floor m1 n p1) ->
stratifies (unstratify (m2+n) p2) n (floor m2 n p2)).
Lemma stratify_unstratify : forall n p H,
proj1_sig (stratify (unstratify n p) H n) = p.
Lemma decompose_nat : forall (x y:nat), { m:nat & y = (m + S x) } + { ge x y }.
Definition unstratify (n:nat) (p:sinv n) : knot * other -> Prop := fun w =>
match w with (existT _ nw w',o) =>
match decompose_nat nw n with
| inleft (existT _ m Hm) => snd (proj1_sig (floor m (S nw) (eq_rect  n _ p (m + S nw) Hm))) (w',o)
| inright H => False
end
end.
Lemma floor_shuffle:
forall (m1 n : nat)
(p1 : sinv (m1 + S n)) (H1 : (m1 + S n) = (S m1 + n)),
floor (S m1) n (eq_rect (m1 + S n) sinv p1 (S m1 + n) H1) = fst (proj1_sig (floor m1 (S n) p1)).
Lemma unstratify_hered : forall n p,
hereditary ko_age (unstratify n p).
Lemma unstratify_Q : forall n (p:sinv n) Q,
stratifies Q n p ->
forall (k:knot) o,
projT1 k < n ->
(unstratify n p (k,o) <-> Q (k,o)).
Lemma stratifies_unstratify_more :
forall (n m1 m2:nat) (p1:sinv (m1+n)) (p2:sinv (m2+n)),
floor m1 n p1 = floor m2 n p2 ->
(stratifies (unstratify (m1+n) p1) n (floor m1 n p1) ->
stratifies (unstratify (m2+n) p2) n (floor m2 n p2)).
Lemma stratify_unstratify : forall n p H,
proj1_sig (stratify (unstratify n p) H n) = p.