Implicit Arguments proof_irr_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) _) _.
Next Obligation.
hnf; simpl; intros.
destruct x; destruct y; simpl.
destruct k; destruct k0; simpl in *.
destruct H.
inversion H; clear H; subst.
assert (f3 = f) by (apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))); auto).
subst f3.
assert (f4 = f0) by (apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))); auto).
subst f4.
clear H3 H5.
simpl.
destruct (decompose_nat x0 n); simpl.
destruct s; simpl.
generalize e.
subst n; intro e.
replace e with (refl_equal (x + S x0)) by apply proof_irr_nat; simpl.
generalize (floor_mor x (S x0) p p (setoid_refl _ p)).
intro H.
simpl in H.
destruct H.
apply H1.
simpl; split; auto.
apply setoid_refl.
Qed.
Next Obligation.
repeat (hnf; simpl in *; intros).
destruct a; destruct a'; simpl in *.
destruct k; destruct k0; destruct H0; simpl in *.
inversion H0; clear H0; subst.
assert (f3 = f) by (apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))); auto).
subst f3.
assert (f4 = f0) by (apply (inj_pair2_eq_dec nat eq_nat_dec) with (P:=fun x => F (projT1 (sinv x))); auto).
subst f4.
simpl.
destruct (decompose_nat x1 n); simpl.
destruct s; simpl.
generalize e; subst n.
intro e.
replace e with (refl_equal (x0 + S x1)) by (apply proof_irr_nat; auto); simpl.
generalize (floor_mor x0 (S x1) x y H); simpl.
intros [? ?].
apply H2.
split; auto.
reflexivity.
Qed.

(* 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.