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.

Lemma f_mapsto_iterS_n_f_bottom_isMonotonic_for_any_n
: forall n : nat, isMonotonic1 (fun f : `[D -> D] => iterS n (proj1_sig f) bottom_cpo).