Section KNASTER_TARSKI. (* Reference: "https://www.cs.utexas.edu/users/misra/Notes.dir/KnasterTarski.pdf" written by Jayadev Misra *)
Context {D : Type} {PROSET : isProset D} {COLA : isCola D (PROSET := PROSET)}.
Proof with eauto with *.
pose proof (supremum_cola W) as [q q_is_lub_of_W].
pose (fun w : D => q =< w) as W_hat.
assert (q_is_glb_of_W_hat : is_infimum_of q W_hat).
{ unfold W_hat. done!. }
assert (q_in_W_hat : q \in W_hat) by exact (leProp_refl q).
assert (W_hat_closed_under_f : forall x : D, x \in W_hat -> f x \in W_hat).
{ intros x q_le_x. eapply q_is_lub_of_W.
intros w w_in_W. transitivity (f w).
- eapply eqProp_implies_leProp, W_is_a_set_of_fixed_points_of_f...
- eapply f_isMonotonic. transitivity q; trivial. eapply q_is_lub_of_W...
}
assert (q_le_f_q : q =< f q) by exact (W_hat_closed_under_f q q_in_W_hat).
pose proof (infimum_cola (E.intersection (prefixedpointsOf f) W_hat)) as [fix_f fix_f_isInfimum].
enough (claim1 : f fix_f =< fix_f).
enough (claim2 : q =< fix_f).
enough (claim3 : fix_f == f fix_f).
- exists fix_f. split; trivial.
intros [x x_in]. simpl. split.
{ intros fix_f_le_x d d_in. transitivity q.
- eapply q_is_lub_of_W...
- transitivity fix_f...
}
{ intros x_is_upper_bound_of_W. eapply fix_f_isInfimum... split.
- eapply eqProp_implies_leProp. now symmetry.
- eapply q_is_lub_of_W...
}
- eapply leProp_antisymmetry; trivial.
eapply fix_f_isInfimum... done!.
- eapply fix_f_isInfimum. ii; s!. destruct IN as [f_x_le_x q_le_x]...
- eapply fix_f_isInfimum. intros x x_in. s!. destruct x_in as [f_x_le_x q_le_x].
rewrite <- f_x_le_x. eapply f_isMonotonic.
eapply fix_f_isInfimum... split; eauto.
Qed.

Corollary fixedpointsOf_asCoLa (f : `[D -> D])
: isCola (@sig D (fixedpointsOf (proj1_sig f))) (PROSET := @subProset D PROSET (fixedpointsOf (proj1_sig f))).