Section SCOTT_FIX.
Context {D : Type}.
Fixpoint iterS (n : nat) (f : D -> D) (x : D) {struct n} : D :=
match n with
| O => x
| S n' => f (iterS n' f x)
end.
Variant IterS (f : D -> D) (x : D) : ensemble D :=
| In_IterS (n : nat) : iterS n f x \in IterS f x.
#[local] Hint Constructors IterS : core.
Context {PROSET : isProset D} {CPO : isCpo D}.
Proof with eauto with *.
assert (claim1 : forall n : nat, iterS n f bottom_cpo =< iterS (S n) f bottom_cpo).
{ induction n as [ | n IH]; [eapply bottom_cpo_spec | simpl]... }
intros n1 n2 n1_le_n2. induction n1_le_n2 as [ | n2 n1_le_n2 IH].
- reflexivity.
- rewrite IH...
Qed.
Proof with eauto with *.
assert (claim1 : forall n1 : nat, forall n2 : nat, n1 <= max n1 n2) by lia.
assert (claim2 : forall n1 : nat, forall n2 : nat, n2 <= max n1 n2) by lia.
pose proof (claim3 := iterS_monotonic).
split.
- exists (iterS 0 f bottom_cpo)...
- ii. inversion x1_IN; subst. rename n into n1. inversion x2_IN; subst. rename n into n2.
exists (iterS (max n1 n2) f bottom_cpo). split...
Qed.
Definition lfp_cpo (f : `[D -> D]) : D :=
supremum_cpo (IterS (proj1_sig f) bottom_cpo) (IterS_f_bottom_isDirected_if_f_isMonotonic (proj1_sig f) (ScottContinuousMap_isMonotonic (proj1_sig f) (proj2_sig f))).
Proof with eauto with *.
pose proof (lfp_f_is_supremum_of_F := supremum_cpo_spec (IterS (proj1_sig f) bottom_cpo) (IterS_f_bottom_isDirected_if_f_isMonotonic (proj1_sig f) (ScottContinuousMap_isMonotonic (proj1_sig f) (proj2_sig f)))). fold (lfp_cpo f) in lfp_f_is_supremum_of_F.
pose proof (sup_Y_is_supremum_of_image_f_X_iff_f_sup_X_eq_sup_Y (proj1_sig f) (IterS (proj1_sig f) bottom_cpo)) as claim1.
enough (to_show : proj1_sig f (lfp_cpo f) == lfp_cpo f) by now do 2 red.
eapply claim1.
- exact (proj2_sig f).
- eapply IterS_f_bottom_isDirected_if_f_isMonotonic. eapply ScottContinuousMap_isMonotonic. exact (proj2_sig f).
- exact (lfp_f_is_supremum_of_F).
- ii; split.
+ intros ? y ?. s!. destruct IN as [x [? H_IN]]; subst y. inversion H_IN; subst.
rewrite <- H. eapply lfp_f_is_supremum_of_F...
change (iterS (S n) (proj1_sig f) bottom_cpo \in IterS (proj1_sig f) bottom_cpo)...
+ ii. s!. eapply lfp_f_is_supremum_of_F. ii. inversion IN; subst.
destruct n as [ | n']; simpl.
{ eapply bottom_cpo_spec. }
{ eapply H... econs... }
Qed.
Proof with eauto with *.
pose proof (every_ScottContinuousMap_has_a_fixed_point f) as claim1.
split; trivial. intros y ?. s!. rename IN into y_eq_f_y.
eapply supremum_cpo_spec. ii. inversion IN; subst. induction n as [ | n IH].
- eapply bottom_cpo_spec.
- transitivity (proj1_sig f y).
+ simpl. eapply ScottContinuousMap_isMonotonic; [exact (proj2_sig f) | eapply IH]...
+ now rewrite <- y_eq_f_y.
Qed.
Proof with eauto with *.
induction n as [ | n IH]; intros [f1 x1] [f2 x2] [f1_le_f2 x1_le_x2]; simpl in *; trivial.
transitivity (proj1_sig f2 (iterS n (proj1_sig f1) x1)).
- eapply f1_le_f2.
- eapply ScottContinuousMap_isMonotonic.
+ exact (proj2_sig f2).
+ eapply IH with (x1 := (f1, x1)) (x2 := (f2, x2)). split...
Qed.
#[local] Hint Resolve iterS_isMonotonic f_mapsto_iterS_n_f_bottom_isMonotonic_for_any_n : core.
Proof with eauto with *.
induction n as [ | n IH].
- eapply botOfScottContinuousMaps_isContinuous.
- eapply the_main_reason_for_introducing_ScottTopology.
+ ii. eapply leProp_antisymmetry; eapply f_mapsto_iterS_n_f_bottom_isMonotonic_for_any_n...
+ intros F F_isDirected.
set (sup_F := supremum_cpo F F_isDirected).
assert (sup_F_is_supremum_of_F : is_supremum_of sup_F F) by exact (supremum_cpo_spec F F_isDirected).
set (Y := E.image (fun f : `[D -> D] => iterS (S n) (proj1_sig f) bottom_cpo) F).
assert (Y_isDirected : isDirected Y).
{ eapply preservesDirectedness_if_isMonotonic... }
set (X := E.image (fun f : `[D -> D] => iterS n (proj1_sig f) bottom_cpo) F).
assert (X_isDirected : isDirected X).
{ eapply preservesDirectedness_if_isMonotonic... }
set (sup_X := iterS n (proj1_sig sup_F) bottom_cpo).
assert (sup_X_is_supremum_of_X : is_supremum_of sup_X X).
{ eapply ScottContinuousMap_preserves_supremum with (f := fun f : `[D -> D] => iterS n (proj1_sig f) bottom_cpo)... }
set (sup_Y := proj1_sig sup_F (iterS n (proj1_sig sup_F) bottom_cpo)).
assert (claim1 : proj1_sig sup_F sup_X == sup_Y).
{ eapply leProp_antisymmetry... }
assert (claim2 : iterS n (proj1_sig sup_F) bottom_cpo == sup_X).
{ eapply sup_Y_is_supremum_of_image_f_X_iff_f_sup_X_eq_sup_Y with (f := fun f : `[D -> D] => iterS n (proj1_sig f) bottom_cpo).
- exact (IH).
- exact (F_isDirected).
- exact (sup_F_is_supremum_of_F).
- exact (sup_X_is_supremum_of_X).
}
assert (claim3 : is_supremum_of (proj1_sig sup_F sup_X) (E.unions (E.image (fun f_i : `[D -> D] => E.image (fun x : D => proj1_sig f_i x) X) F))).
{ eapply supOfScottContinuousMaps_F_sup_X_is_supremum_of_unions_i_image_f_i_X_F... }
exists (sup_F), (sup_Y). split; trivial. split; trivial. ii; split.
{ intros ? y ?. unfold X, Y in *. rewrite E.in_image_iff in IN. destruct IN as [f_i [? H_IN]]; subst y. transitivity (proj1_sig f_i sup_X).
- simpl. eapply ScottContinuousMap_isMonotonic; [exact (proj2_sig f_i) | eapply sup_X_is_supremum_of_X]... done!.
- rewrite <- H, <- claim1. eapply sup_F_is_supremum_of_F...
}
{ ii. rewrite <- claim1. eapply claim3. intros y ?. s!. destruct IN as [Z [Z_in H_IN]]. s!.
destruct H_IN as [f1 [? H_IN1]]; subst Z. s!. destruct Z_in as [x [? x_in_X]]; subst y. unfold X, Y in *. s!.
destruct x_in_X as [f2 [? H_IN2]]; subst x. inversion F_isDirected. pose proof (DIRECTED' f1 f2 H_IN1 H_IN2) as [f3 [? [f1_le_f3 f2_le_f3]]].
transitivity (proj1_sig f3 (iterS n (proj1_sig f3) bottom_cpo)).
- etransitivity; [eapply f1_le_f3 | eapply ScottContinuousMap_isMonotonic].
+ exact (proj2_sig f3).
+ eapply f_mapsto_iterS_n_f_bottom_isMonotonic_for_any_n...
- eapply H... econs...
}
Qed.

Lemma lfp_cpo_isContinuous
: isContinuous lfp_cpo.