Require Export CompletePreorder. Require Import Relations. Set Implicit Arguments. Unset Strict Implicit. Section fixed_point_constructs. Variables (D:cpo)(f:D-m->D). (* iterate f starting from bot, n times *) Fixpoint f_iter (n:nat_ord) : D := match n with 0 => @bot D | S n' => f (f_iter n') end. Lemma f_iter_increasing : forall (n:nat_ord), f_iter n <= f (f_iter n). induction n; simpl. apply bot_least_law. apply monofun_law. exact IHn. Qed. Lemma f_iter_monotonic : monotonic f_iter. unfold monotonic. intros n m Hnm. induction m. simpl. inversion Hnm. simpl. apply ord_refl_law. (* *) simpl. inversion_clear Hnm. simpl. apply ord_refl_law. apply ord_trans_law with (f_iter m). auto. exact (f_iter_increasing m). Qed. Definition iter : chain D. exists f_iter. unfold monotonic. intros n m Hnm. apply f_iter_monotonic. exact Hnm. Defined. Definition f_fixp : D := lub iter. Lemma f_fixp_increasing : f_fixp <= f f_fixp. unfold f_fixp. apply ord_trans_law with (lub (f@iter)). apply lub_monotonic. simpl. unfold rel_monofunord. apply f_iter_increasing. apply precontinuous. Qed. Lemma f_fixp_least : forall x:D, f x <= x -> f_fixp <= x. unfold f_fixp. intros x Hf. apply lub_least_law. induction n; simpl. apply bot_least_law. apply ord_trans_law with (f x). apply monofun_law; assumption. exact Hf. Qed. Hypothesis Hfcont : continuous f. Lemma f_fixp_converging : f f_fixp <= f_fixp. unfold f_fixp. apply ord_trans_law with (1:=(Hfcont iter)). apply lub_least_law. intro n. replace ((f@iter) n) with (iter (S n)) by trivial. apply lub_upper_bound_law. Qed. Lemma f_fixp_eq : f_fixp == f f_fixp. split; [exact f_fixp_increasing | exact f_fixp_converging]. Qed. End fixed_point_constructs. (* Kleene's fixed point theorem in the context of complete preorders, that is with == replacing =. In antisymmetric complete preorders (i.e., complete partial orders) this is equivalent to the original Kleene's theorem. *) Theorem Kleene_fixpoint : forall (D:cpo)(f:D-c->D), f (lub (iter f)) == lub (iter f) /\ (forall x, f x <= x -> lub (iter f) <= x). intros; repeat split. apply (@f_fixp_converging D f (contfun_law f)). apply (@f_fixp_increasing D f). apply (@f_fixp_least D f). Qed. Lemma iter_monotonic : forall (D:cpo), monotonic (@iter D). intro D. unfold monotonic. intros f g Hfg. simpl. unfold rel_monofunord. intro n. induction n. simpl. apply ord_refl_law. simpl. apply ord_trans_law with (g (f_iter f n)). apply Hfg. apply (monofun_law g). exact IHn. Qed. Definition monoiter (D:cpo) : (D-M->D)-m->(chaincpo D). intro. exists (fun (f:D-M->D) => iter f). unfold monotonic. intros f g Hfg. simpl. apply iter_monotonic. exact Hfg. Defined. Implicit Arguments monoiter [D]. Lemma simpl_monoiter : forall (D:cpo)(c:chain (D-M->D))(n:nat_ord), (monoiter @ c) n = iter (c n). trivial. Qed. Lemma simpl_iterS : forall (D:cpo)(f:D-m->D) n, iter f (S n) = f (iter f n). trivial. Qed. Lemma simpl_monoiterS : forall (D:cpo)(f:D-m->D) n, monoiter f (S n) = f (monoiter f n). trivial. Qed. Lemma f_fixp_monotonic : forall (D:cpo), monotonic (@f_fixp D). intro. unfold monotonic. intros f g Hfg. unfold f_fixp. apply lub_monotonic. apply iter_monotonic. exact Hfg. Qed. Definition monofixp (D:cpo) : (D-m->D)-m->D. intro. exists (@f_fixp D). apply f_fixp_monotonic. Defined. Implicit Arguments monofixp [D]. Lemma simpl_monofixp : forall (D:cpo)(f:D-M->D), monofixp f = f_fixp f. trivial. Qed. Lemma simpl_monofixp_composition : forall (D:cpo)(c:chain (D-M->D))(n:nat_ord), (monofixp @ c) n = lub (iter (c n)). trivial. Qed. Lemma iter_precontinuous : forall (D:cpo)(c:chain (D-M->D)), lub (monoiter @ c) <= iter (lub c). intros. exact (precontinuous monoiter c). Qed. Lemma monofixp_precontinuous : forall (D:cpo)(c:chain (D-M->D)), lub (monofixp @ c) <= f_fixp (lub c). intros. exact (precontinuous monofixp c). Qed. Lemma iter_continuous : forall (D:cpo)(c:chain (D-M->D)), (forall n, continuous (c n)) -> iter (lub c) <= lub (monoiter @ c). intros D c Hc n. induction n. simpl. apply bot_least_law. rewrite simpl_iterS. apply ord_trans_law with (lub c (lub (monoiter @ c) n)). apply monofun_law. exact IHn. simpl. apply ord_trans_law with (lub (lub (monofunord_app2 c ((monoiter @ c) <_m> n)))). apply lub_monotonic. simpl. unfold rel_monofunord. intro m. simpl. apply ord_trans_law with (lub ((c m) @ ((monoiter @ c) <_m> n))). apply Hc. apply ord_refl_law. apply ord_trans_law with (lub (monofunord_diag (monofunord_app2 c ((monoiter @ c) <_m> n)))). destruct (lub2_diag (monofunord_app2 c ((monoiter @ c) <_m> n))) as [Hlub _]. apply ord_trans_law with (1:=Hlub). apply ord_refl_law. apply lub_monotonic. intro m. apply ord_refl_law. Qed. Lemma iter_continuous_eq : forall (D:cpo)(c:chain (D-M->D)), (forall n, continuous (c n)) -> iter (lub c) == lub (monoiter @ c). intros D c Hc. split. exact (iter_continuous Hc). exact (iter_precontinuous c). Qed. Lemma fixp_continuous : forall (D:cpo)(c:chain (D-M->D)), (forall n, continuous (c n)) -> f_fixp (lub c) <= lub (monofixp @ c). intros D c Hc. unfold f_fixp. apply ord_trans_law with (lub (monolub D @ (monoiter @ c))). apply lub_least_law. intro n. apply ord_trans_law with (lub (monoiter @ c) n). exact (iter_continuous Hc n). apply ord_trans_law with (lub (lub_monofuncpo (monoiter @ c))). apply lub_upper_bound_law. exact (lub_monolub_monofunord_app_sym (monoiter @ c)). apply lub_monotonic. intro n. apply ord_refl_law. Qed. Definition fixp (D:cpo) : (D -C-> D) -C-> D. intro. exists (@monofixp D @ (@contfunord_mono_monofunord D D)). unfold continuous. intro c. rewrite simpl_monofunord_composition. rewrite simpl_monofixp. apply ord_trans_law with (f_fixp (lub (contfunord_mono_monofunord D D @ c))). apply ord_refl_law. apply ord_trans_law with (lub (monofixp @ (contfunord_mono_monofunord D D @ c))). refine (fixp_continuous _). intro n. exact (contfun_law (c n)). apply ord_refl_law. Defined. Implicit Arguments fixp [D]. Lemma simpl_fixp : forall (D:cpo)(f:D-c->D), fixp f = monofixp (f_cont f). trivial. Qed. (* the fixed point equality *) Lemma fixp_eq : forall (D:cpo)(f:D-c->D), fixp f == f (fixp f). intros. simpl. refine (f_fixp_eq _). exact (contfun_law f). Qed. (* induction principle *) Definition admissible (D:cpo)(P:D->Type) := forall f:chain D, (forall n, P (f n)) -> P (lub f). Lemma f_fixp_ind : forall (D:cpo)(f:D-m->D)(P:D->Type), admissible P -> P (bot D) -> (forall x, P x -> P (f x)) -> P (f_fixp f). intros D f P Ha H0 Hf. unfold f_fixp. apply Ha. induction n; simpl; auto. Defined. Lemma fixp_ind : forall (D:cpo)(f:D-C->D)(P:D->Type), admissible P -> P (bot D) -> (forall x, P x -> P (f x)) -> P (fixp f). intros; simpl. apply f_fixp_ind; auto. Defined.