Section CPO_THEORY.
#[local] Existing Instance direct_product_of_two_Prosets.
#[local] Existing Instance subProset.
#[local] Existing Instance pi_isProset.
#[local] Existing Instance Scott_topology.
Definition U {D : Type} {PROSET : isProset D} (x : D) : ensemble D :=
fun z : D => ~ z =< x.
#[local] Hint Resolve ScottContinuousMap_isMonotonic : poset_hints.
Proof with eauto with *.
assert (MONOTONIC : isMonotonic1 f) by now eapply ScottContinuousMap_isMonotonic.
set (E.image f X) as Y in *. set (sup_Y := supremum_cpo Y DIRECTED').
pose proof (SUPREMUM' := supremum_cpo_spec Y DIRECTED').
assert (claim1 : sup_Y =< f sup_X).
{ eapply SUPREMUM'. intros y y_in_Y. unfold Y in *. s!.
des. subst y. eapply MONOTONIC, SUPREMUM...
}
assert (claim2 : f sup_X =< sup_Y).
{ eapply NNPP. intros f_sup_X_in_U_sup_Y.
assert (sup_X_in_preimage_f_U_sup_Y : sup_X \in E.preimage f (U sup_Y)) by now done!.
assert (f_U_sup_Y_isOpen : isOpen (E.preimage f (U sup_Y))) by now eapply CONTINUIOUS, U_x_isOpen.
inv f_U_sup_Y_isOpen. pose proof (LIMIT X sup_X DIRECTED SUPREMUM sup_X_in_preimage_f_U_sup_Y) as [x1 [x1_in_X x1_in_preimage_f_U_sup_Y]].
assert (f_x1_in_image_f_X : f x1 \in E.image f X).
{ econstructor... }
assert (f_x1_in_U_sup_Y : f x1 \in U sup_Y).
{ s!. des. done!. }
contradiction f_x1_in_U_sup_Y. eapply SUPREMUM'...
}
eapply @leProp_antisymmetry with (A_isProset := PROSET')...
Qed.
Definition preserves_supremum {D : Type} {D' : Type} {PROSET : isProset D} {PROSET' : isProset D'} {CPO : isCpo D} {CPO' : isCpo D'} (f : D -> D') : Prop :=
forall X, isDirected X -> exists sup_X, exists sup_Y, is_supremum_of sup_X X /\ is_supremum_of sup_Y (E.image f X) /\ f sup_X == sup_Y.
Proof with eauto with *.
intros x1 x2 x1_le_x2. pose (E.fromList [x1; x2]) as X. set (E.image f X) as Y.
assert (claim1 : is_supremum_of x2 X).
{ intros z. split.
- intros x2_le_z x x_in_X. unfold X in *. s!. destruct x_in_X as [x_eq_x1 | [x_eq_x2 | []]]; subst x; rewrite <- x2_le_z...
- intros z_isUpperBoundOf_X. eapply z_isUpperBoundOf_X. done!.
}
assert (X_isDirected : isDirected X).
{ split.
- exists x1. done!.
- intros z1 z2 ? ?. unfold X in *. s!. destruct x1_IN as [<- | [<- | []]], x2_IN as [<- | [<- | []]]; exists x2; done!.
}
pose proof (PRESERVES_SUPREMUM X X_isDirected) as [sup_X [sup_Y [sup_X_is_supremum_of_X [sup_Y_is_supremum_of_Y f_sup_X_eq_sup_Y]]]].
assert (it_is_sufficient_to_show : f sup_X == f x2).
{ eapply COMPAT_WITH_eqProp. eapply supremum_unique... }
unfold X, Y in *. transitivity (f sup_X).
- eapply sup_Y_is_supremum_of_Y; done!.
- eapply eqProp_implies_leProp; done!.
Qed.

Lemma preservesDirectedness_if_preservesSupremum {D : Type} {D' : Type} {PROSET : isProset D} {PROSET' : isProset D'} {CPO : isCpo D} {CPO' : isCpo D'} (f : D -> D')
(COMPAT_WITH_eqProp : eqPropCompatible1 f)
(PRESERVES_SUPREMUM : preserves_supremum f)
: forall X, isDirected X -> isDirected (E.image f X).