Some can probably be restored with some love.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basics/lists/list.ma".
+
+axiom alpha : Type[0].
+notation "πΈ" non associative with precedence 90 for @{'alphabet}.
+interpretation "set of names" 'alphabet = alpha.
+
+inductive tp : Type[0] β
+| top : tp
+| arr : tp β tp β tp.
+inductive tm : Type[0] β
+| var : nat β tm
+| par : πΈ β tm
+| abs : tp β tm β tm
+| app : tm β tm β tm.
+
+let rec Nth T n (l:list T) on n β
+ match l with
+ [ nil β None ?
+ | cons hd tl β match n with
+ [ O β Some ? hd
+ | S n0 β Nth T n0 tl ] ].
+
+inductive judg : list tp β tm β tp β Prop β
+| t_var : βg,n,t.Nth ? n g = Some ? t β judg g (var n) t
+| t_app : βg,m,n,t,u.judg g m (arr t u) β judg g n t β judg g (app m n) u
+| t_abs : βg,t,m,u.judg (t::g) m u β judg g (abs t m) (arr t u).
+
+definition Env := list (πΈ Γ tp).
+
+axiom vclose_env : Env β list tp.
+axiom vclose_tm : Env β tm β tm.
+axiom Lam : πΈ β tp β tm β tm.
+definition Judg β Ξ»G,M,T.judg (vclose_env G) (vclose_tm G M) T.
+definition dom β Ξ»G:Env.map ?? (fst ??) G.
+
+definition sctx β πΈ Γ tm.
+axiom swap_tm : πΈ β πΈ β tm β tm.
+definition sctx_app : sctx β πΈ β tm β Ξ»M0,Y.let β©X,Mβͺ β M0 in swap_tm X Y M.
+
+axiom in_list : βA:Type[0].A β list A β Prop.
+interpretation "list membership" 'mem x l = (in_list ? x l).
+interpretation "list non-membership" 'notmem x l = (Not (in_list ? x l)).
+
+axiom in_Env : πΈ Γ tp β Env β Prop.
+notation "X β G" non associative with precedence 45 for @{'lefttriangle $X $G}.
+interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
+
+let rec FV M β match M with
+ [ par X β [X]
+ | app M1 M2 β FV M1@FV M2
+ | abs T M0 β FV M0
+ | _ β [ ] ].
+
+(* axiom Lookup : πΈ β Env β option tp. *)
+
+(* forma alto livello del judgment
+ t_abs* : βG,T,X,M,U.
+ (βY β supp(M).Judg (β©Y,Tβͺ::G) (M[Y]) U) β
+ Judg G (Lam X T (M[X])) (arr T U) *)
+
+(* prima dimostrare, poi perfezionare gli assiomi, poi dimostrarli *)
+
+axiom Judg_ind : βP:Env β tm β tp β Prop.
+ (βX,G,T.β©X,Tβͺ β G β P G (par X) T) β
+ (βG,M,N,T,U.
+ Judg G M (arr T U) β Judg G N T β
+ P G M (arr T U) β P G N T β P G (app M N) U) β
+ (βG,T1,T2,X,M1.
+ (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β Judg (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
+ (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β P (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
+ P G (Lam X T1 (sctx_app M1 X)) (arr T1 T2)) β
+ βG,M,T.Judg G M T β P G M T.
+
+axiom t_par : βX,G,T.β©X,Tβͺ β G β Judg G (par X) T.
+axiom t_app2 : βG,M,N,T,U.Judg G M (arr T U) β Judg G N T β Judg G (app M N) U.
+axiom t_Lam : βG,X,M,T,U.Judg (β©X,Tβͺ::G) M U β Judg G (Lam X T M) (arr T U).
+
+definition subenv β Ξ»G1,G2.βx.x β G1 β x β G2.
+interpretation "subenv" 'subseteq G1 G2 = (subenv G1 G2).
+
+axiom daemon : βP:Prop.P.
+
+theorem weakening : βG1,G2,M,T.G1 β G2 β Judg G1 M T β Judg G2 M T.
+#G1 #G2 #M #T #Hsub #HJ lapply Hsub lapply G2 -G2 change with (βG2.?)
+@(Judg_ind β¦ HJ)
+[ #X #G #T0 #Hin #G2 #Hsub @t_par @Hsub //
+| #G #M0 #N #T0 #U #HM0 #HN #IH1 #IH2 #G2 #Hsub @t_app2
+ [| @IH1 // | @IH2 // ]
+| #G #T1 #T2 #X #M1 #HM1 #IH #G2 #Hsub @t_Lam @IH
+ [ (* trivial property of Lam *) @daemon
+ | (* trivial property of subenv *) @daemon ]
+]
+qed.
+
+(* Serve un tipo Tm per i termini localmente chiusi e i suoi principi di induzione e
+ ricorsione *)
\ No newline at end of file
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "binding/names.ma".
+
+(* permutations *)
+definition finite_perm : βX:Nset.(X β X) β Prop β
+ Ξ»X,f.injective X X f β§ surjective X X f β§ βl.βx.x β l β f x = x.
+
+(* maps a permutation to a list of parameters *)
+definition Pi_list : βX:Nset.(X β X) β list X β list X β
+ Ξ»X,p,xl.map ?? (Ξ»x.p x) xl.
+
+interpretation "permutation of X list" 'middot p x = (Pi_list p x).
+
+definition swap : βN:Nset.N β N β N β N β
+ Ξ»N,u,v,x.match (x == u) with
+ [true β v
+ |false β match (x == v) with
+ [true β u
+ |false β x]].
+
+axiom swap_right : βN,x,y.swap N x y y = x.
+(*
+#N x y;nnormalize;nrewrite > (p_eqb3 ? y y β¦);//;
+nlapply (refl ? (y β x));ncases (y β x) in β’ (???% β %);nnormalize;//;
+#H1;napply p_eqb1;//;
+nqed.
+*)
+
+axiom swap_left : βN,x,y.swap N x y x = y.
+(*
+#N x y;nnormalize;nrewrite > (p_eqb3 ? x x β¦);//;
+nqed.
+*)
+
+axiom swap_other : βN,x,y,z.x β z β y β z β swap N x y z = z.
+(*
+#N x y z H1 H2;nnormalize;nrewrite > (p_eqb4 β¦);
+##[nrewrite > (p_eqb4 β¦);//;@;ncases H2;/2/;
+##|@;ncases H1;/2/
+##]
+nqed.
+*)
+
+axiom swap_inv : βN,x,y,z.swap N x y (swap N x y z) = z.
+(*
+#N x y z;nlapply (refl ? (x β z));ncases (x β z) in β’ (???% β ?);#H1
+##[nrewrite > (p_eqb1 β¦ H1);nrewrite > (swap_left β¦);//;
+##|nlapply (refl ? (y β z));ncases (y β z) in β’ (???% β ?);#H2
+ ##[nrewrite > (p_eqb1 β¦ H2);nrewrite > (swap_right β¦);//;
+ ##|nrewrite > (swap_other β¦) in β’ (??(????%)?);/2/;
+ nrewrite > (swap_other β¦);/2/;
+ ##]
+##]
+nqed.
+*)
+
+axiom swap_fp : βN,x1,x2.finite_perm ? (swap N x1 x2).
+(*
+#N x1 x2;@
+##[@
+ ##[nwhd;#xa xb;nnormalize;nlapply (refl ? (xa β x1));
+ ncases (xa β x1) in β’ (???% β %);#H1
+ ##[nrewrite > (p_eqb1 β¦ H1);nlapply (refl ? (xb β x1));
+ ncases (xb β x1) in β’ (???% β %);#H2
+ ##[nrewrite > (p_eqb1 β¦ H2);//
+ ##|nlapply (refl ? (xb β x2));
+ ncases (xb β x2) in β’ (???% β %);#H3
+ ##[nnormalize;#H4;nrewrite > H4 in H3;
+ #H3;nrewrite > H3 in H2;#H2;ndestruct (H2)
+ ##|nnormalize;#H4;nrewrite > H4 in H3;
+ nrewrite > (p_eqb3 β¦);//;#H5;ndestruct (H5)
+ ##]
+ ##]
+ ##|nlapply (refl ? (xa β x2));
+ ncases (xa β x2) in β’ (???% β %);#H2
+ ##[nrewrite > (p_eqb1 β¦ H2);nlapply (refl ? (xb β x1));
+ ncases (xb β x1) in β’ (???% β %);#H3
+ ##[nnormalize;#H4;nrewrite > H4 in H3;
+ #H3;nrewrite > (p_eqb1 β¦ H3);@
+ ##|nnormalize;nlapply (refl ? (xb β x2));
+ ncases (xb β x2) in β’ (???% β %);#H4
+ ##[nrewrite > (p_eqb1 β¦ H4);//
+ ##|nnormalize;#H5;nrewrite > H5 in H3;
+ nrewrite > (p_eqb3 β¦);//;#H6;ndestruct (H6);
+ ##]
+ ##]
+ ##|nnormalize;nlapply (refl ? (xb β x1));
+ ncases (xb β x1) in β’ (???% β %);#H3
+ ##[nnormalize;#H4;nrewrite > H4 in H2;nrewrite > (p_eqb3 β¦);//;
+ #H5;ndestruct (H5)
+ ##|nlapply (refl ? (xb β x2));
+ ncases (xb β x2) in β’ (???% β %);#H4
+ ##[nnormalize;#H5;nrewrite > H5 in H1;nrewrite > (p_eqb3 β¦);//;
+ #H6;ndestruct (H6)
+ ##|nnormalize;//
+ ##]
+ ##]
+ ##]
+ ##]
+ ##|nwhd;#z;nnormalize;nlapply (refl ? (z β x1));
+ ncases (z β x1) in β’ (???% β %);#H1
+ ##[nlapply (refl ? (z β x2));
+ ncases (z β x2) in β’ (???% β %);#H2
+ ##[@ z;nrewrite > H1;nrewrite > H2;napply p_eqb1;//
+ ##|@ x2;nrewrite > (p_eqb4 β¦);
+ ##[nrewrite > (p_eqb3 β¦);//;
+ nnormalize;napply p_eqb1;//
+ ##|nrewrite < (p_eqb1 β¦ H1);@;#H3;nrewrite > H3 in H2;
+ nrewrite > (p_eqb3 β¦);//;#H2;ndestruct (H2)
+ ##]
+ ##]
+ ##|nlapply (refl ? (z β x2));
+ ncases (z β x2) in β’ (???% β %);#H2
+ ##[@ x1;nrewrite > (p_eqb3 β¦);//;
+ napply p_eqb1;nnormalize;//
+ ##|@ z;nrewrite > H1;nrewrite > H2;@;
+ ##]
+ ##]
+ ##]
+##|@ [x1;x2];#x0 H1;nrewrite > (swap_other β¦)
+ ##[@
+ ##|@;#H2;nrewrite > H2 in H1;*;#H3;napply H3;/2/;
+ ##|@;#H2;nrewrite > H2 in H1;*;#H3;napply H3;//;
+ ##]
+##]
+nqed.
+*)
+
+axiom inj_swap : βN,u,v.injective ?? (swap N u v).
+(*
+#N u v;ncases (swap_fp N u v);*;#H1 H2 H3;//;
+nqed.
+*)
+
+axiom surj_swap : βN,u,v.surjective ?? (swap N u v).
+(*
+#N u v;ncases (swap_fp N u v);*;#H1 H2 H3;//;
+nqed.
+*)
+
+axiom finite_swap : βN,u,v.βl.βx.x β l β swap N u v x = x.
+(*
+#N u v;ncases (swap_fp N u v);*;#H1 H2 H3;//;
+nqed.
+*)
+
+(* swaps two lists of parameters
+definition Pi_swap_list : βxl,xl':list X.X β X β
+ Ξ»xl,xl',x.foldr2 ??? (Ξ»u,v,r.swap ? u v r) x xl xl'.
+
+nlemma fp_swap_list :
+ βxl,xl'.finite_perm ? (Pi_swap_list xl xl').
+#xl xl';@
+##[@;
+ ##[ngeneralize in match xl';nelim xl
+ ##[nnormalize;//;
+ ##|#x0 xl0;#IH xl'';nelim xl''
+ ##[nnormalize;//
+ ##|#x1 xl1 IH1 y0 y1;nchange in β’ (??%% β ?) with (swap ????);
+ #H1;nlapply (inj_swap β¦ H1);#H2;
+ nlapply (IH β¦ H2);//
+ ##]
+ ##]
+ ##|ngeneralize in match xl';nelim xl
+ ##[nnormalize;#_;#z;@z;@
+ ##|#x' xl0 IH xl'';nelim xl''
+ ##[nnormalize;#z;@z;@
+ ##|#x1 xl1 IH1 z;
+ nchange in β’ (??(Ξ»_.???%)) with (swap ????);
+ ncases (surj_swap X x' x1 z);#x2 H1;
+ ncases (IH xl1 x2);#x3 H2;@ x3;
+ nrewrite < H2;napply H1
+ ##]
+ ##]
+ ##]
+##|ngeneralize in match xl';nelim xl
+ ##[#;@ [];#;@
+ ##|#x0 xl0 IH xl'';ncases xl''
+ ##[@ [];#;@
+ ##|#x1 xl1;ncases (IH xl1);#xl2 H1;
+ ncases (finite_swap X x0 x1);#xl3 H2;
+ @ (xl2@xl3);#x2 H3;
+ nchange in β’ (??%?) with (swap ????);
+ nrewrite > (H1 β¦);
+ ##[nrewrite > (H2 β¦);//;@;#H4;ncases H3;#H5;napply H5;
+ napply in_list_to_in_list_append_r;//
+ ##|@;#H4;ncases H3;#H5;napply H5;
+ napply in_list_to_in_list_append_l;//
+ ##]
+ ##]
+ ##]
+##]
+nqed.
+
+(* the 'reverse' swap of lists of parameters
+ composing Pi_swap_list and Pi_swap_list_r yields the identity function
+ (see the Pi_swap_list_inv lemma) *)
+ndefinition Pi_swap_list_r : βxl,xl':list X. Pi β
+ Ξ»xl,xl',x.foldl2 ??? (Ξ»r,u,v.swap ? u v r ) x xl xl'.
+
+nlemma fp_swap_list_r :
+ βxl,xl'.finite_perm ? (Pi_swap_list_r xl xl').
+#xl xl';@
+##[@;
+ ##[ngeneralize in match xl';nelim xl
+ ##[nnormalize;//;
+ ##|#x0 xl0;#IH xl'';nelim xl''
+ ##[nnormalize;//
+ ##|#x1 xl1 IH1 y0 y1;nwhd in β’ (??%% β ?);
+ #H1;nlapply (IH β¦ H1);#H2;
+ napply (inj_swap β¦ H2);
+ ##]
+ ##]
+ ##|ngeneralize in match xl';nelim xl
+ ##[nnormalize;#_;#z;@z;@
+ ##|#x' xl0 IH xl'';nelim xl''
+ ##[nnormalize;#z;@z;@
+ ##|#x1 xl1 IH1 z;nwhd in β’ (??(Ξ»_.???%));
+ ncases (IH xl1 z);#x2 H1;
+ ncases (surj_swap X x' x1 x2);#x3 H2;
+ @ x3;nrewrite < H2;napply H1;
+ ##]
+ ##]
+ ##]
+##|ngeneralize in match xl';nelim xl
+ ##[#;@ [];#;@
+ ##|#x0 xl0 IH xl'';ncases xl''
+ ##[@ [];#;@
+ ##|#x1 xl1;
+ ncases (IH xl1);#xl2 H1;
+ ncases (finite_swap X x0 x1);#xl3 H2;
+ @ (xl2@xl3);#x2 H3;nwhd in β’ (??%?);
+ nrewrite > (H2 β¦);
+ ##[nrewrite > (H1 β¦);//;@;#H4;ncases H3;#H5;napply H5;
+ napply in_list_to_in_list_append_l;//
+ ##|@;#H4;ncases H3;#H5;napply H5;
+ napply in_list_to_in_list_append_r;//
+ ##]
+ ##]
+ ##]
+##]
+nqed.
+
+nlemma Pi_swap_list_inv :
+ βxl1,xl2,x.
+ Pi_swap_list xl1 xl2 (Pi_swap_list_r xl1 xl2 x) = x.
+#xl;nelim xl
+##[#;@
+##|#x1 xl1 IH xl';ncases xl'
+ ##[#;@
+ ##|#x2 xl2;#x;
+ nchange in β’ (??%?) with
+ (swap ??? (Pi_swap_list ??
+ (Pi_swap_list_r ?? (swap ????))));
+ nrewrite > (IH xl2 ?);napply swap_inv;
+ ##]
+##]
+nqed.
+
+nlemma Pi_swap_list_fresh :
+ βx,xl1,xl2.x β xl1 β x β xl2 β Pi_swap_list xl1 xl2 x = x.
+#x xl1;nelim xl1
+##[#;@
+##|#x3 xl3 IH xl2' H1;ncases xl2'
+ ##[#;@
+ ##|#x4 xl4 H2;ncut (x β xl3 β§ x β xl4);
+ ##[@
+ ##[@;#H3;ncases H1;#H4;napply H4;/2/;
+ ##|@;#H3;ncases H2;#H4;napply H4;/2/
+ ##]
+ ##] *; #H1' H2';
+ nchange in β’ (??%?) with (swap ????);
+ nrewrite > (swap_other β¦)
+ ##[napply IH;//;
+ ##|nchange in β’ (?(???%)) with (Pi_swap_list ???);
+ nrewrite > (IH β¦);//;@;#H3;ncases H2;#H4;napply H4;//;
+ ##|nchange in β’ (?(???%)) with (Pi_swap_list ???);
+ nrewrite > (IH β¦);//;@;#H3;ncases H1;#H4;napply H4;//
+ ##]
+ ##]
+##]
+nqed.
+*)
\ No newline at end of file
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basics/lists/list.ma".
+include "basics/deqsets.ma".
+include "binding/names.ma".
+include "binding/fp.ma".
+
+axiom alpha : Nset.
+notation "πΈ" non associative with precedence 90 for @{'alphabet}.
+interpretation "set of names" 'alphabet = alpha.
+
+inductive tp : Type[0] β
+| top : tp
+| arr : tp β tp β tp.
+inductive pretm : Type[0] β
+| var : nat β pretm
+| par : πΈ β pretm
+| abs : tp β pretm β pretm
+| app : pretm β pretm β pretm.
+
+let rec Nth T n (l:list T) on n β
+ match l with
+ [ nil β None ?
+ | cons hd tl β match n with
+ [ O β Some ? hd
+ | S n0 β Nth T n0 tl ] ].
+
+let rec vclose_tm_aux u x k β match u with
+ [ var n β if (leb k n) then var (S n) else u
+ | par x0 β if (x0 == x) then (var k) else u
+ | app v1 v2 β app (vclose_tm_aux v1 x k) (vclose_tm_aux v2 x k)
+ | abs s v β abs s (vclose_tm_aux v x (S k)) ].
+definition vclose_tm β Ξ»u,x.vclose_tm_aux u x O.
+
+definition vopen_var β Ξ»n,x,k.match eqb n k with
+ [ true β par x
+ | false β match leb n k with
+ [ true β var n
+ | false β var (pred n) ] ].
+
+let rec vopen_tm_aux u x k β match u with
+ [ var n β vopen_var n x k
+ | par x0 β u
+ | app v1 v2 β app (vopen_tm_aux v1 x k) (vopen_tm_aux v2 x k)
+ | abs s v β abs s (vopen_tm_aux v x (S k)) ].
+definition vopen_tm β Ξ»u,x.vopen_tm_aux u x O.
+
+let rec FV u β match u with
+ [ par x β [x]
+ | app v1 v2 β FV v1@FV v2
+ | abs s v β FV v
+ | _ β [ ] ].
+
+definition lam β Ξ»x,s,u.abs s (vclose_tm u x).
+
+let rec Pi_map_tm p u on u β match u with
+[ par x β par (p x)
+| var _ β u
+| app v1 v2 β app (Pi_map_tm p v1) (Pi_map_tm p v2)
+| abs s v β abs s (Pi_map_tm p v) ].
+
+interpretation "permutation of tm" 'middot p x = (Pi_map_tm p x).
+
+notation "hvbox(uβxβ)"
+ with precedence 45
+ for @{ 'open $u $x }.
+
+(*
+notation "hvbox(uβxβ)"
+ with precedence 45
+ for @{ 'open $u $x }.
+notation "β΄ u β΅ x" non associative with precedence 90 for @{ 'open $u $x }.
+*)
+interpretation "ln term variable open" 'open u x = (vopen_tm u x).
+notation < "hvbox(Ξ½ x break . u)"
+ with precedence 20
+for @{'nu $x $u }.
+notation > "Ξ½ list1 x sep , . term 19 u" with precedence 20
+ for ${ fold right @{$u} rec acc @{'nu $x $acc)} }.
+interpretation "ln term variable close" 'nu x u = (vclose_tm u x).
+
+let rec tm_height u β match u with
+[ app v1 v2 β S (max (tm_height v1) (tm_height v2))
+| abs s v β S (tm_height v)
+| _ β O ].
+
+theorem le_n_O_rect_Type0 : βn:nat. n β€ O β βP: nat βType[0]. P O β P n.
+#n (cases n) // #a #abs cases (?:False) /2/ qed.
+
+theorem nat_rect_Type0_1 : βn:nat.βP:nat β Type[0].
+(βm.(βp. p < m β P p) β P m) β P n.
+#n #P #H
+cut (βq:nat. q β€ n β P q) /2/
+(elim n)
+ [#q #HleO (* applica male *)
+ @(le_n_O_rect_Type0 ? HleO)
+ @H #p #ltpO cases (?:False) /2/ (* 3 *)
+ |#p #Hind #q #HleS
+ @H #a #lta @Hind @le_S_S_to_le /2/
+ ]
+qed.
+
+lemma leb_false_to_lt : βn,m. leb n m = false β m < n.
+#n elim n
+[ #m normalize #H destruct(H)
+| #n0 #IH * // #m normalize #H @le_S_S @IH // ]
+qed.
+
+lemma nominal_eta_aux : βx,u.x β FV u β βk.vclose_tm_aux (vopen_tm_aux u x k) x k = u.
+#x #u elim u
+[ #n #_ #k normalize cases (decidable_eq_nat n k) #Hnk
+ [ >Hnk >eqb_n_n normalize >(\b ?) //
+ | >(not_eq_to_eqb_false β¦ Hnk) normalize cases (true_or_false (leb n k)) #Hleb
+ [ >Hleb normalize >(?:leb k n = false) //
+ @lt_to_leb_false @not_eq_to_le_to_lt /2/
+ | >Hleb normalize >(?:leb k (pred n) = true) normalize
+ [ cases (leb_false_to_lt β¦ Hleb) //
+ | @le_to_leb_true cases (leb_false_to_lt β¦ Hleb) normalize /2/ ] ] ]
+| #y normalize #Hy >(\bf ?) // @(not_to_not β¦ Hy) //
+| #s #v #IH normalize #Hv #k >IH // @Hv
+| #v1 #v2 #IH1 #IH2 normalize #Hv1v2 #k
+ >IH1 [ >IH2 // | @(not_to_not β¦ Hv1v2) @in_list_to_in_list_append_l ]
+ @(not_to_not β¦ Hv1v2) @in_list_to_in_list_append_r ]
+qed.
+
+corollary nominal_eta : βx,u.x β FV u β (Ξ½x.uβxβ) = u.
+#x #u #Hu @nominal_eta_aux //
+qed.
+
+lemma eq_height_vopen_aux : βv,x,k.tm_height (vopen_tm_aux v x k) = tm_height v.
+#v #x elim v
+[ #n #k normalize cases (eqb n k) // cases (leb n k) //
+| #u #k %
+| #s #u #IH #k normalize >IH %
+| #u1 #u2 #IH1 #IH2 #k normalize >IH1 >IH2 % ]
+qed.
+
+corollary eq_height_vopen : βv,x.tm_height (vβxβ) = tm_height v.
+#v #x @eq_height_vopen_aux
+qed.
+
+theorem pretm_ind_plus_aux :
+ βP:pretm β Type[0].
+ (βx:πΈ.P (par x)) β
+ (βn:β.P (var n)) β
+ (βv1,v2. P v1 β P v2 β P (app v1 v2)) β
+ βC:list πΈ.
+ (βx,s,v.x β FV v β x β C β P (vβxβ) β P (lam x s (vβxβ))) β
+ βn,u.tm_height u β€ n β P u.
+#P #Hpar #Hvar #Happ #C #Hlam #n change with ((Ξ»n.?) n); @(nat_rect_Type0_1 n ??)
+#m cases m
+[ #_ * /2/
+ [ normalize #s #v #Hfalse cases (?:False) cases (not_le_Sn_O (tm_height v)) /2/
+ | #v1 #v2 whd in β’ (?%?β?); #Hfalse cases (?:False) cases (not_le_Sn_O (max ??))
+ [ #H @H @Hfalse|*:skip] ] ]
+-m #m #IH * /2/
+[ #s #v whd in β’ (?%?β?); #Hv
+ lapply (p_fresh β¦ (C@FV v)) letin y β (N_fresh β¦ (C@FV v)) #Hy
+ >(?:abs s v = lam y s (vβyβ))
+ [| whd in β’ (???%); >nominal_eta // @(not_to_not β¦ Hy) @in_list_to_in_list_append_r ]
+ @Hlam
+ [ @(not_to_not β¦ Hy) @in_list_to_in_list_append_r
+ | @(not_to_not β¦ Hy) @in_list_to_in_list_append_l ]
+ @IH [| @Hv | >eq_height_vopen % ]
+| #v1 #v2 whd in β’ (?%?β?); #Hv @Happ
+ [ @IH [| @Hv | @le_max_1 ] | @IH [| @Hv | @le_max_2 ] ] ]
+qed.
+
+corollary pretm_ind_plus :
+ βP:pretm β Type[0].
+ (βx:πΈ.P (par x)) β
+ (βn:β.P (var n)) β
+ (βv1,v2. P v1 β P v2 β P (app v1 v2)) β
+ βC:list πΈ.
+ (βx,s,v.x β FV v β x β C β P (vβxβ) β P (lam x s (vβxβ))) β
+ βu.P u.
+#P #Hpar #Hvar #Happ #C #Hlam #u @pretm_ind_plus_aux /2/
+qed.
+
+(* maps a permutation to a list of terms *)
+definition Pi_map_list : (πΈ β πΈ) β list πΈ β list πΈ β map πΈ πΈ .
+
+(* interpretation "permutation of name list" 'middot p x = (Pi_map_list p x).*)
+
+(*
+inductive tm : pretm β Prop β
+| tm_par : βx:πΈ.tm (par x)
+| tm_app : βu,v.tm u β tm v β tm (app u v)
+| tm_lam : βx,s,u.tm u β tm (lam x s u).
+
+inductive ctx_aux : nat β pretm β Prop β
+| ctx_var : βn,k.n < k β ctx_aux k (var n)
+| ctx_par : βx,k.ctx_aux k (par x)
+| ctx_app : βu,v,k.ctx_aux k u β ctx_aux k v β ctx_aux k (app u v)
+(* Γ¨ sostituibile da ctx_lam ? *)
+| ctx_abs : βs,u.ctx_aux (S k) u β ctx_aux k (abs s u).
+*)
+
+inductive tm_or_ctx (k:nat) : pretm β Type[0] β
+| toc_var : βn.n < k β tm_or_ctx k (var n)
+| toc_par : βx.tm_or_ctx k (par x)
+| toc_app : βu,v.tm_or_ctx k u β tm_or_ctx k v β tm_or_ctx k (app u v)
+| toc_lam : βx,s,u.tm_or_ctx k u β tm_or_ctx k (lam x s u).
+
+definition tm β Ξ»t.tm_or_ctx O t.
+definition ctx β Ξ»t.tm_or_ctx 1 t.
+
+definition check_tm β Ξ»u,k.
+ pretm_ind_plus ?
+ (Ξ»_.true)
+ (Ξ»n.leb (S n) k)
+ (Ξ»v1,v2,rv1,rv2.rv1 β§ rv2)
+ [] (Ξ»x,s,v,px,pC,rv.rv)
+ u.
+
+axiom pretm_ind_plus_app : βP,u,v,C,H1,H2,H3,H4.
+ pretm_ind_plus P H1 H2 H3 C H4 (app u v) =
+ H3 u v (pretm_ind_plus P H1 H2 H3 C H4 u) (pretm_ind_plus P H1 H2 H3 C H4 v).
+
+axiom pretm_ind_plus_lam : βP,x,s,u,C,px,pC,H1,H2,H3,H4.
+ pretm_ind_plus P H1 H2 H3 C H4 (lam x s (uβxβ)) =
+ H4 x s u px pC (pretm_ind_plus P H1 H2 H3 C H4 (uβxβ)).
+
+record TM : Type[0] β {
+ pretm_of_TM :> pretm;
+ tm_of_TM : check_tm pretm_of_TM O = true
+}.
+
+record CTX : Type[0] β {
+ pretm_of_CTX :> pretm;
+ ctx_of_CTX : check_tm pretm_of_CTX 1 = true
+}.
+
+inductive tm2 : pretm β Type[0] β
+| tm_par : βx.tm2 (par x)
+| tm_app : βu,v.tm2 u β tm2 v β tm2 (app u v)
+| tm_lam : βx,s,u.x β FV u β (βy.y β FV u β tm2 (uβyβ)) β tm2 (lam x s (uβxβ)).
+
+(*
+inductive tm' : pretm β Prop β
+| tm_par : βx.tm' (par x)
+| tm_app : βu,v.tm' u β tm' v β tm' (app u v)
+| tm_lam : βx,s,u,C.x β FV u β x β C β (βy.y β FV u β tm' (β΄uβ΅y)) β tm' (lam x s (β΄uβ΅x)).
+*)
+
+lemma pi_vclose_tm :
+ βz1,z2,x,u.swap πΈ z1 z2Β·(Ξ½x.u) = (Ξ½ swap ? z1 z2 x.swap πΈ z1 z2 Β· u).
+#z1 #z2 #x #u
+change with (vclose_tm_aux ???) in match (vclose_tm ??);
+change with (vclose_tm_aux ???) in β’ (???%); lapply O elim u normalize //
+[ #n #k cases (leb k n) normalize %
+| #x0 #k cases (true_or_false (x0==z1)) #H1 >H1 normalize
+ [ cases (true_or_false (x0==x)) #H2 >H2 normalize
+ [ <(\P H2) >H1 normalize >(\b (refl ? z2)) %
+ | >H1 normalize cases (true_or_false (x==z1)) #H3 >H3 normalize
+ [ >(\P H3) in H2; >H1 #Hfalse destruct (Hfalse)
+ | cases (true_or_false (x==z2)) #H4 >H4 normalize
+ [ cases (true_or_false (z2==z1)) #H5 >H5 normalize //
+ >(\P H5) in H4; >H3 #Hfalse destruct (Hfalse)
+ | >(\bf ?) // @sym_not_eq @(\Pf H4) ]
+ ]
+ ]
+ | cases (true_or_false (x0==x)) #H2 >H2 normalize
+ [ <(\P H2) >H1 normalize >(\b (refl ??)) %
+ | >H1 normalize cases (true_or_false (x==z1)) #H3 >H3 normalize
+ [ cases (true_or_false (x0==z2)) #H4 >H4 normalize
+ [ cases (true_or_false (z1==z2)) #H5 >H5 normalize //
+ <(\P H5) in H4; <(\P H3) >H2 #Hfalse destruct (Hfalse)
+ | >H4 % ]
+ | cases (true_or_false (x0==z2)) #H4 >H4 normalize
+ [ cases (true_or_false (x==z2)) #H5 >H5 normalize
+ [ <(\P H5) in H4; >H2 #Hfalse destruct (Hfalse)
+ | >(\bf ?) // @sym_not_eq @(\Pf H3) ]
+ | cases (true_or_false (x==z2)) #H5 >H5 normalize
+ [ >H1 %
+ | >H2 % ]
+ ]
+ ]
+ ]
+ ]
+]
+qed.
+
+lemma pi_vopen_tm :
+ βz1,z2,x,u.swap πΈ z1 z2Β·(uβxβ) = (swap πΈ z1 z2 Β· uβswap πΈ z1 z2 xβ).
+#z1 #z2 #x #u
+change with (vopen_tm_aux ???) in match (vopen_tm ??);
+change with (vopen_tm_aux ???) in β’ (???%); lapply O elim u normalize //
+#n #k cases (true_or_false (eqb n k)) #H1 >H1 normalize //
+cases (true_or_false (leb n k)) #H2 >H2 normalize //
+qed.
+
+lemma pi_lam :
+ βz1,z2,x,s,u.swap πΈ z1 z2 Β· lam x s u = lam (swap πΈ z1 z2 x) s (swap πΈ z1 z2 Β· u).
+#z1 #z2 #x #s #u whd in β’ (???%); <(pi_vclose_tm β¦) %
+qed.
+
+lemma eqv_FV : βz1,z2,u.FV (swap πΈ z1 z2 Β· u) = Pi_map_list (swap πΈ z1 z2) (FV u).
+#z1 #z2 #u elim u //
+[ #s #v normalize //
+| #v1 #v2 normalize /2/ ]
+qed.
+
+lemma swap_inv_tm : βz1,z2,u.swap πΈ z1 z2 Β· (swap πΈ z1 z2 Β· u) = u.
+#z1 #z2 #u elim u [1,3,4:normalize //]
+#x whd in β’ (??%?); >swap_inv %
+qed.
+
+lemma eqv_in_list : βx,l,z1,z2.x β l β swap πΈ z1 z2 x β Pi_map_list (swap πΈ z1 z2) l.
+#x #l #z1 #z2 #Hin elim Hin
+[ #x0 #l0 %
+| #x1 #x2 #l0 #Hin #IH %2 @IH ]
+qed.
+
+lemma eqv_tm2 : βu.tm2 u β βz1,z2.tm2 ((swap ? z1 z2)Β·u).
+#u #Hu #z1 #z2 letin p β (swap ? z1 z2) elim Hu /2/
+#x #s #v #Hx #Hv #IH >pi_lam >pi_vopen_tm %3
+[ @(not_to_not β¦ Hx) -Hx #Hx
+ <(swap_inv ? z1 z2 x) <(swap_inv_tm z1 z2 v) >eqv_FV @eqv_in_list //
+| #y #Hy <(swap_inv ? z1 z2 y)
+ <pi_vopen_tm @IH @(not_to_not β¦ Hy) -Hy #Hy <(swap_inv ? z1 z2 y)
+ >eqv_FV @eqv_in_list //
+]
+qed.
+
+lemma vclose_vopen_aux : βx,u,k.vopen_tm_aux (vclose_tm_aux u x k) x k = u.
+#x #u elim u normalize //
+[ #n #k cases (true_or_false (leb k n)) #H >H whd in β’ (??%?);
+ [ cases (true_or_false (eqb (S n) k)) #H1 >H1
+ [ <(eqb_true_to_eq β¦ H1) in H; #H lapply (leb_true_to_le β¦ H) -H #H
+ cases (le_to_not_lt β¦ H) -H #H cases (H ?) %
+ | whd in β’ (??%?); >lt_to_leb_false // @le_S_S /2/ ]
+ | cases (true_or_false (eqb n k)) #H1 >H1 normalize
+ [ >(eqb_true_to_eq β¦ H1) in H; #H lapply (leb_false_to_not_le β¦ H) -H
+ * #H cases (H ?) %
+ | >le_to_leb_true // @not_lt_to_le % #H2 >le_to_leb_true in H;
+ [ #H destruct (H) | /2/ ]
+ ]
+ ]
+| #x0 #k cases (true_or_false (x0==x)) #H1 >H1 normalize // >(\P H1) >eqb_n_n % ]
+qed.
+
+lemma vclose_vopen : βx,u.((Ξ½x.u)βxβ) = u. #x #u @vclose_vopen_aux
+qed.
+
+(*
+theorem tm_to_tm : βt.tm' t β tm t.
+#t #H elim H
+*)
+
+lemma in_list_singleton : βT.βt1,t2:T.t1 β [t2] β t1 = t2.
+#T #t1 #t2 #H @(in_list_inv_ind ??? H) /2/
+qed.
+
+lemma fresh_vclose_tm_aux : βu,x,k.x β FV (vclose_tm_aux u x k).
+#u #x elim u //
+[ #n #k normalize cases (leb k n) normalize //
+| #x0 #k normalize cases (true_or_false (x0==x)) #H >H normalize //
+ lapply (\Pf H) @not_to_not #Hin >(in_list_singleton ??? Hin) %
+| #v1 #v2 #IH1 #IH2 #k normalize % #Hin cases (in_list_append_to_or_in_list ???? Hin) /2/ ]
+qed.
+
+lemma fresh_vclose_tm : βu,x.x β FV (Ξ½x.u). //
+qed.
+
+lemma check_tm_true_to_toc : βu,k.check_tm u k = true β tm_or_ctx k u.
+#u @(pretm_ind_plus ???? [ ] ? u)
+[ #x #k #_ %2
+| #n #k change with (leb (S n) k) in β’ (??%?β?); #H % @leb_true_to_le //
+| #v1 #v2 #rv1 #rv2 #k change with (pretm_ind_plus ???????) in β’ (??%?β?);
+ >pretm_ind_plus_app #H cases (andb_true ?? H) -H #Hv1 #Hv2 %3
+ [ @rv1 @Hv1 | @rv2 @Hv2 ]
+| #x #s #v #Hx #_ #rv #k change with (pretm_ind_plus ???????) in β’ (??%?β?);
+ >pretm_ind_plus_lam // #Hv %4 @rv @Hv ]
+qed.
+
+lemma toc_to_check_tm_true : βu,k.tm_or_ctx k u β check_tm u k = true.
+#u #k #Hu elim Hu //
+[ #n #Hn change with (leb (S n) k) in β’ (??%?); @le_to_leb_true @Hn
+| #v1 #v2 #Hv1 #Hv2 #IH1 #IH2 change with (pretm_ind_plus ???????) in β’ (??%?);
+ >pretm_ind_plus_app change with (check_tm v1 k β§ check_tm v2 k) in β’ (??%?); /2/
+| #x #s #v #Hv #IH <(vclose_vopen x v) change with (pretm_ind_plus ???????) in β’ (??%?);
+ >pretm_ind_plus_lam [| // | @fresh_vclose_tm ] >(vclose_vopen x v) @IH ]
+qed.
+
+lemma fresh_swap_tm : βz1,z2,u.z1 β FV u β z2 β FV u β swap πΈ z1 z2 Β· u = u.
+#z1 #z2 #u elim u
+[2: normalize in β’ (?β%β%β?); #x #Hz1 #Hz2 whd in β’ (??%?); >swap_other //
+ [ @(not_to_not β¦ Hz2) | @(not_to_not β¦ Hz1) ] //
+|1: //
+| #s #v #IH normalize #Hz1 #Hz2 >IH // [@Hz2|@Hz1]
+| #v1 #v2 #IH1 #IH2 normalize #Hz1 #Hz2
+ >IH1 [| @(not_to_not β¦ Hz2) @in_list_to_in_list_append_l | @(not_to_not β¦ Hz1) @in_list_to_in_list_append_l ]
+ >IH2 // [@(not_to_not β¦ Hz2) @in_list_to_in_list_append_r | @(not_to_not β¦ Hz1) @in_list_to_in_list_append_r ]
+]
+qed.
+
+theorem tm_to_tm2 : βu.tm u β tm2 u.
+#t #Ht elim Ht
+[ #n #Hn cases (not_le_Sn_O n) #Hfalse cases (Hfalse Hn)
+| @tm_par
+| #u #v #Hu #Hv @tm_app
+| #x #s #u #Hu #IHu <(vclose_vopen x u) @tm_lam
+ [ @fresh_vclose_tm
+ | #y #Hy <(fresh_swap_tm x y (Ξ½x.u)) /2/ @fresh_vclose_tm ]
+]
+qed.
+
+theorem tm2_to_tm : βu.tm2 u β tm u.
+#u #pu elim pu /2/ #x #s #v #Hx #Hv #IH %4 @IH //
+qed.
+
+(* define PAR APP LAM *)
+definition PAR β Ξ»x.mk_TM (par x) ?. // qed.
+definition APP β Ξ»u,v:TM.mk_TM (app u v) ?.
+change with (pretm_ind_plus ???????) in match (check_tm ??); >pretm_ind_plus_app
+change with (check_tm ??) in match (pretm_ind_plus ???????); change with (check_tm ??) in match (pretm_ind_plus ???????) in β’ (??(??%)?);
+@andb_elim >(tm_of_TM u) >(tm_of_TM v) % qed.
+definition LAM β Ξ»x,s.Ξ»u:TM.mk_TM (lam x s u) ?.
+change with (pretm_ind_plus ???????) in match (check_tm ??); <(vclose_vopen x u)
+>pretm_ind_plus_lam [| // | @fresh_vclose_tm ]
+change with (check_tm ??) in match (pretm_ind_plus ???????); >vclose_vopen
+@(tm_of_TM u) qed.
+
+axiom vopen_tm_down : βu,x,k.tm_or_ctx (S k) u β tm_or_ctx k (uβxβ).
+(* needs true_plus_false
+
+#u #x #k #Hu elim Hu
+[ #n #Hn normalize cases (true_or_false (eqb n O)) #H >H [%2]
+ normalize >(?: leb n O = false) [|cases n in H; // >eqb_n_n #H destruct (H) ]
+ normalize lapply Hn cases n in H; normalize [ #Hfalse destruct (Hfalse) ]
+ #n0 #_ #Hn0 % @le_S_S_to_le //
+| #x0 %2
+| #v1 #v2 #Hv1 #Hv2 #IH1 #IH2 %3 //
+| #x0 #s #v #Hv #IH normalize @daemon
+]
+qed.
+*)
+
+definition vopen_TM β Ξ»u:CTX.Ξ»x.mk_TM (uβxβ) ?.
+@toc_to_check_tm_true @vopen_tm_down @check_tm_true_to_toc @ctx_of_CTX qed.
+
+axiom vclose_tm_up : βu,x,k.tm_or_ctx k u β tm_or_ctx (S k) (Ξ½x.u).
+
+definition vclose_TM β Ξ»u:TM.Ξ»x.mk_CTX (Ξ½x.u) ?.
+@toc_to_check_tm_true @vclose_tm_up @check_tm_true_to_toc @tm_of_TM qed.
+
+interpretation "ln wf term variable open" 'open u x = (vopen_TM u x).
+interpretation "ln wf term variable close" 'nu x u = (vclose_TM u x).
+
+theorem tm_alpha : βx,y,s,u.x β FV u β y β FV u β lam x s (uβxβ) = lam y s (uβyβ).
+#x #y #s #u #Hx #Hy whd in β’ (??%%); @eq_f >nominal_eta // >nominal_eta //
+qed.
+
+lemma TM_to_tm2 : βu:TM.tm2 u.
+#u @tm_to_tm2 @check_tm_true_to_toc @tm_of_TM qed.
+
+theorem TM_ind_plus_weak :
+ βP:pretm β Type[0].
+ (βx:πΈ.P (PAR x)) β
+ (βv1,v2:TM.P v1 β P v2 β P (APP v1 v2)) β
+ βC:list πΈ.
+ (βx,s.βv:CTX.x β FV v β x β C β
+ (βy.y β FV v β P (vβyβ)) β P (LAM x s (vβxβ))) β
+ βu:TM.P u.
+#P #Hpar #Happ #C #Hlam #u elim (TM_to_tm2 u) //
+[ #v1 #v2 #pv1 #pv2 #IH1 #IH2 @(Happ (mk_TM β¦) (mk_TM β¦) IH1 IH2)
+ @toc_to_check_tm_true @tm2_to_tm //
+| #x #s #v #Hx #pv #IH
+ lapply (p_fresh β¦ (C@FV v)) letin x0 β (N_fresh β¦ (C@FV v)) #Hx0
+ >(?:lam x s (vβxβ) = lam x0 s (vβx0β))
+ [|@tm_alpha // @(not_to_not β¦ Hx0) @in_list_to_in_list_append_r ]
+ @(Hlam x0 s (mk_CTX v ?) ??)
+ [ <(nominal_eta β¦ Hx) @toc_to_check_tm_true @vclose_tm_up @tm2_to_tm @pv //
+ | @(not_to_not β¦ Hx0) @in_list_to_in_list_append_r
+ | @(not_to_not β¦ Hx0) @in_list_to_in_list_append_l
+ | @IH ]
+]
+qed.
+
+lemma eq_mk_TM : βu,v.u = v β βpu,pv.mk_TM u pu = mk_TM v pv.
+#u #v #Heq >Heq #pu #pv %
+qed.
+
+lemma eq_P : βT:Type[0].βt1,t2:T.t1 = t2 β βP:T β Type[0].P t1 β P t2. // qed.
+
+theorem TM_ind_plus :
+ βP:TM β Type[0].
+ (βx:πΈ.P (PAR x)) β
+ (βv1,v2:TM.P v1 β P v2 β P (APP v1 v2)) β
+ βC:list πΈ.
+ (βx,s.βv:CTX.x β FV v β x β C β
+ (βy.y β FV v β P (vβyβ)) β P (LAM x s (vβxβ))) β
+ βu:TM.P u.
+#P #Hpar #Happ #C #Hlam * #u #pu
+>(?:mk_TM u pu =
+ mk_TM u (toc_to_check_tm_true β¦ (tm2_to_tm β¦ (tm_to_tm2 β¦ (check_tm_true_to_toc β¦ pu))))) [|%]
+elim (tm_to_tm2 u ?) //
+[ #v1 #v2 #pv1 #pv2 #IH1 #IH2 @(Happ (mk_TM β¦) (mk_TM β¦) IH1 IH2)
+| #x #s #v #Hx #pv #IH
+ lapply (p_fresh β¦ (C@FV v)) letin x0 β (N_fresh β¦ (C@FV v)) #Hx0
+ lapply (Hlam x0 s (mk_CTX v ?) ???)
+ [2: @(not_to_not β¦ Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_l @Hx0
+ |4: @toc_to_check_tm_true <(nominal_eta x v) // @vclose_tm_up @tm2_to_tm @pv //
+ | #y #Hy whd in match (vopen_TM ??);
+ >(?:mk_TM (vβyβ) ? = mk_TM (vβyβ) (toc_to_check_tm_true (vβyβ) O (tm2_to_tm (vβyβ) (pv y Hy))))
+ [@IH|%]
+ | @(not_to_not β¦ Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_r @Hx0
+ | @eq_P @eq_mk_TM whd in match (vopen_TM ??); @tm_alpha // @(not_to_not β¦ Hx0) @in_list_to_in_list_append_r ]
+]
+qed.
+
+notation
+"hvbox('nominal' u 'return' out 'with'
+ [ 'xpar' ident x β f1
+ | 'xapp' ident v1 ident v2 ident recv1 ident recv2 β f2
+ | 'xlam' β¨ident y # Cβ© ident s ident w ident py1 ident py2 ident recw β f3 ])"
+with precedence 48
+for @{ TM_ind_plus $out (Ξ»${ident x}:?.$f1)
+ (Ξ»${ident v1}:?.Ξ»${ident v2}:?.Ξ»${ident recv1}:?.Ξ»${ident recv2}:?.$f2)
+ $C (Ξ»${ident y}:?.Ξ»${ident s}:?.Ξ»${ident w}:?.Ξ»${ident py1}:?.Ξ»${ident py2}:?.Ξ»${ident recw}:?.$f3)
+ $u }.
+
+(* include "basics/jmeq.ma".*)
+
+definition subst β (Ξ»u:TM.Ξ»x,v.
+ nominal u return (Ξ»_.TM) with
+ [ xpar x0 β match x == x0 with [ true β v | false β PAR x0 ] (* u instead of PAR x0 does not work, u stays the same at every rec call! *)
+ | xapp v1 v2 recv1 recv2 β APP recv1 recv2
+ | xlam β¨y # x::FV vβ© s w py1 py2 recw β LAM y s (recw y py1) ]).
+
+lemma subst_def : βu,x,v.subst u x v =
+ nominal u return (Ξ»_.TM) with
+ [ xpar x0 β match x == x0 with [ true β v | false β PAR x0 ]
+ | xapp v1 v2 recv1 recv2 β APP recv1 recv2
+ | xlam β¨y # x::FV vβ© s w py1 py2 recw β LAM y s (recw y py1) ]. //
+qed.
+
+axiom TM_ind_plus_LAM :
+ βx,s,u,out,f1,f2,C,f3,Hx1,Hx2.
+ TM_ind_plus out f1 f2 C f3 (LAM x s (uβxβ)) =
+ f3 x s u Hx1 Hx2 (Ξ»y,Hy.TM_ind_plus ? f1 f2 C f3 ?).
+
+axiom TM_ind_plus_APP :
+ βu1,u2,out,f1,f2,C,f3.
+ TM_ind_plus out f1 f2 C f3 (APP u1 u2) =
+ f2 u1 u2 (TM_ind_plus out f1 f2 C f3 ?) (TM_ind_plus out f1 f2 C f3 ?).
+
+lemma eq_mk_CTX : βu,v.u = v β βpu,pv.mk_CTX u pu = mk_CTX v pv.
+#u #v #Heq >Heq #pu #pv %
+qed.
+
+lemma vclose_vopen_TM : βx.βu:TM.((Ξ½x.u)βxβ) = u.
+#x * #u #pu @eq_mk_TM @vclose_vopen qed.
+
+lemma nominal_eta_CTX : βx.βu:CTX.x β FV u β (Ξ½x.(uβxβ)) = u.
+#x * #u #pu #Hx @eq_mk_CTX @nominal_eta // qed.
+
+theorem TM_alpha : βx,y,s.βu:CTX.x β FV u β y β FV u β LAM x s (uβxβ) = LAM y s (uβyβ).
+#x #y #s #u #Hx #Hy @eq_mk_TM @tm_alpha // qed.
+
+axiom in_vopen_CTX : βx,y.βv:CTX.x β FV (vβyβ) β x = y β¨ x β FV v.
+
+theorem subst_fresh : βu,v:TM.βx.x β FV u β subst u x v = u.
+#u #v #x @(TM_ind_plus β¦ (x::FV v) β¦ u)
+[ #x0 normalize in β’ (%β?); #Hx normalize in β’ (??%?);
+ >(\bf ?) [| @(not_to_not β¦ Hx) #Heq >Heq % ] %
+| #u1 #u2 #IH1 #IH2 normalize in β’ (%β?); #Hx
+ >subst_def >TM_ind_plus_APP @eq_mk_TM @eq_f2 @eq_f
+ [ <subst_def @IH1 @(not_to_not β¦ Hx) @in_list_to_in_list_append_l
+ | <subst_def @IH2 @(not_to_not β¦ Hx) @in_list_to_in_list_append_r ]
+| #x0 #s #v0 #Hx0 #HC #IH #Hx >subst_def >TM_ind_plus_LAM [|@HC|@Hx0]
+ @eq_f <subst_def @IH // @(not_to_not β¦ Hx) -Hx #Hx
+ change with (FV (Ξ½x0.(v0βx0β))) in β’ (???%); >nominal_eta_CTX //
+ cases (in_vopen_CTX β¦ Hx) // #Heq >Heq in HC; * #HC @False_ind @HC %
+]
+qed.
+
+example subst_LAM_same : βx,s,u,v. subst (LAM x s u) x v = LAM x s u.
+#x #s #u #v >subst_def <(vclose_vopen_TM x u)
+lapply (p_fresh β¦ (FV (Ξ½x.u)@x::FV v)) letin x0 β (N_fresh β¦ (FV (Ξ½x.u)@x::FV v)) #Hx0
+>(TM_alpha x x0)
+[| @(not_to_not β¦ Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_l @Hx0 | @fresh_vclose_tm ]
+>TM_ind_plus_LAM [| @(not_to_not β¦ Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_r @Hx0 | @(not_to_not β¦ Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_l @Hx0 ]
+@eq_f change with (subst ((Ξ½x.u)βx0β) x v) in β’ (??%?); @subst_fresh
+@(not_to_not β¦ Hx0) #Hx0' cases (in_vopen_CTX β¦ Hx0')
+[ #Heq >Heq @in_list_to_in_list_append_r %
+| #Hfalse @False_ind cases (fresh_vclose_tm u x) #H @H @Hfalse ]
+qed.
+
+(*
+notation > "Ξ ident x. ident T [ident x] β¦ P"
+ with precedence 48 for @{'foo (Ξ»${ident x}.Ξ»${ident T}.$P)}.
+
+notation < "Ξ ident x. ident T [ident x] β¦ P"
+ with precedence 48 for @{'foo (Ξ»${ident x}:$Q.Ξ»${ident T}:$R.$P)}.
+*)
+
+(*
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x β f1
+ | 'xapp' ident v1 ident v2 β f2
+ | 'xlam' ident x # C s w β f3 ])"
+with precedence 48
+for @{ tm2_ind_plus ? (Ξ»${ident x}:$Tx.$f1)
+ (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
+ $C (Ξ»${ident x}:$Tx.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+*)
+
+(*
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x ^ f1
+ | 'xapp' ident v1 ident v2 ^ f2 ])"
+(* | 'xlam' ident x # C s w ^ f3 ]) *)
+with precedence 48
+for @{ tm2_ind_plus ? (Ξ»${ident x}:$Tx.$f1)
+ (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
+ $C (Ξ»${ident x}:$Tx.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+*)
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x ^ f1
+ | 'xapp' ident v1 ident v2 ^ f2 ])"
+with precedence 48
+for @{ tm2_ind_plus ? (Ξ»${ident x}:?.$f1)
+ (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
+ $C (Ξ»${ident x}:?.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+
+axiom in_Env : πΈ Γ tp β Env β Prop.
+notation "X β G" non associative with precedence 45 for @{'lefttriangle $X $G}.
+interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
+
+
+
+inductive judg : list tp β tm β tp β Prop β
+| t_var : βg,n,t.Nth ? n g = Some ? t β judg g (var n) t
+| t_app : βg,m,n,t,u.judg g m (arr t u) β judg g n t β judg g (app m n) u
+| t_abs : βg,t,m,u.judg (t::g) m u β judg g (abs t m) (arr t u).
+
+definition Env := list (πΈ Γ tp).
+
+axiom vclose_env : Env β list tp.
+axiom vclose_tm : Env β tm β tm.
+axiom Lam : πΈ β tp β tm β tm.
+definition Judg β Ξ»G,M,T.judg (vclose_env G) (vclose_tm G M) T.
+definition dom β Ξ»G:Env.map ?? (fst ??) G.
+
+definition sctx β πΈ Γ tm.
+axiom swap_tm : πΈ β πΈ β tm β tm.
+definition sctx_app : sctx β πΈ β tm β Ξ»M0,Y.let β©X,Mβͺ β M0 in swap_tm X Y M.
+
+axiom in_list : βA:Type[0].A β list A β Prop.
+interpretation "list membership" 'mem x l = (in_list ? x l).
+interpretation "list non-membership" 'notmem x l = (Not (in_list ? x l)).
+
+axiom in_Env : πΈ Γ tp β Env β Prop.
+notation "X β G" non associative with precedence 45 for @{'lefttriangle $X $G}.
+interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
+
+(* axiom Lookup : πΈ β Env β option tp. *)
+
+(* forma alto livello del judgment
+ t_abs* : βG,T,X,M,U.
+ (βY β supp(M).Judg (β©Y,Tβͺ::G) (M[Y]) U) β
+ Judg G (Lam X T (M[X])) (arr T U) *)
+
+(* prima dimostrare, poi perfezionare gli assiomi, poi dimostrarli *)
+
+axiom Judg_ind : βP:Env β tm β tp β Prop.
+ (βX,G,T.β©X,Tβͺ β G β P G (par X) T) β
+ (βG,M,N,T,U.
+ Judg G M (arr T U) β Judg G N T β
+ P G M (arr T U) β P G N T β P G (app M N) U) β
+ (βG,T1,T2,X,M1.
+ (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β Judg (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
+ (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β P (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
+ P G (Lam X T1 (sctx_app M1 X)) (arr T1 T2)) β
+ βG,M,T.Judg G M T β P G M T.
+
+axiom t_par : βX,G,T.β©X,Tβͺ β G β Judg G (par X) T.
+axiom t_app2 : βG,M,N,T,U.Judg G M (arr T U) β Judg G N T β Judg G (app M N) U.
+axiom t_Lam : βG,X,M,T,U.Judg (β©X,Tβͺ::G) M U β Judg G (Lam X T M) (arr T U).
+
+definition subenv β Ξ»G1,G2.βx.x β G1 β x β G2.
+interpretation "subenv" 'subseteq G1 G2 = (subenv G1 G2).
+
+axiom daemon : βP:Prop.P.
+
+theorem weakening : βG1,G2,M,T.G1 β G2 β Judg G1 M T β Judg G2 M T.
+#G1 #G2 #M #T #Hsub #HJ lapply Hsub lapply G2 -G2 change with (βG2.?)
+@(Judg_ind β¦ HJ)
+[ #X #G #T0 #Hin #G2 #Hsub @t_par @Hsub //
+| #G #M0 #N #T0 #U #HM0 #HN #IH1 #IH2 #G2 #Hsub @t_app2
+ [| @IH1 // | @IH2 // ]
+| #G #T1 #T2 #X #M1 #HM1 #IH #G2 #Hsub @t_Lam @IH
+ [ (* trivial property of Lam *) @daemon
+ | (* trivial property of subenv *) @daemon ]
+]
+qed.
+
+(* Serve un tipo Tm per i termini localmente chiusi e i suoi principi di induzione e
+ ricorsione *)
\ No newline at end of file
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basics/lists/list.ma".
+include "basics/deqsets.ma".
+include "binding/names.ma".
+include "binding/fp.ma".
+
+definition alpha : Nset β X. check alpha
+notation "πΈ" non associative with precedence 90 for @{'alphabet}.
+interpretation "set of names" 'alphabet = alpha.
+
+inductive tp : Type[0] β
+| top : tp
+| arr : tp β tp β tp.
+inductive pretm : Type[0] β
+| var : nat β pretm
+| par : πΈ β pretm
+| abs : tp β pretm β pretm
+| app : pretm β pretm β pretm.
+
+let rec Nth T n (l:list T) on n β
+ match l with
+ [ nil β None ?
+ | cons hd tl β match n with
+ [ O β Some ? hd
+ | S n0 β Nth T n0 tl ] ].
+
+let rec vclose_tm_aux u x k β match u with
+ [ var n β if (leb k n) then var (S n) else u
+ | par x0 β if (x0 == x) then (var k) else u
+ | app v1 v2 β app (vclose_tm_aux v1 x k) (vclose_tm_aux v2 x k)
+ | abs s v β abs s (vclose_tm_aux v x (S k)) ].
+definition vclose_tm β Ξ»u,x.vclose_tm_aux u x O.
+
+definition vopen_var β Ξ»n,x,k.match eqb n k with
+ [ true β par x
+ | false β match leb n k with
+ [ true β var n
+ | false β var (pred n) ] ].
+
+let rec vopen_tm_aux u x k β match u with
+ [ var n β vopen_var n x k
+ | par x0 β u
+ | app v1 v2 β app (vopen_tm_aux v1 x k) (vopen_tm_aux v2 x k)
+ | abs s v β abs s (vopen_tm_aux v x (S k)) ].
+definition vopen_tm β Ξ»u,x.vopen_tm_aux u x O.
+
+let rec FV u β match u with
+ [ par x β [x]
+ | app v1 v2 β FV v1@FV v2
+ | abs s v β FV v
+ | _ β [ ] ].
+
+definition lam β Ξ»x,s,u.abs s (vclose_tm u x).
+
+let rec Pi_map_tm p u on u β match u with
+[ par x β par (p x)
+| var _ β u
+| app v1 v2 β app (Pi_map_tm p v1) (Pi_map_tm p v2)
+| abs s v β abs s (Pi_map_tm p v) ].
+
+interpretation "permutation of tm" 'middot p x = (Pi_map_tm p x).
+
+notation "hvbox(uβxβ)"
+ with precedence 45
+ for @{ 'open $u $x }.
+
+(*
+notation "hvbox(uβxβ)"
+ with precedence 45
+ for @{ 'open $u $x }.
+notation "β΄ u β΅ x" non associative with precedence 90 for @{ 'open $u $x }.
+*)
+interpretation "ln term variable open" 'open u x = (vopen_tm u x).
+notation < "hvbox(Ξ½ x break . u)"
+ with precedence 20
+for @{'nu $x $u }.
+notation > "Ξ½ list1 x sep , . term 19 u" with precedence 20
+ for ${ fold right @{$u} rec acc @{'nu $x $acc)} }.
+interpretation "ln term variable close" 'nu x u = (vclose_tm u x).
+
+let rec tm_height u β match u with
+[ app v1 v2 β S (max (tm_height v1) (tm_height v2))
+| abs s v β S (tm_height v)
+| _ β O ].
+
+theorem le_n_O_rect_Type0 : βn:nat. n β€ O β βP: nat βType[0]. P O β P n.
+#n (cases n) // #a #abs cases (?:False) /2/ qed.
+
+theorem nat_rect_Type0_1 : βn:nat.βP:nat β Type[0].
+(βm.(βp. p < m β P p) β P m) β P n.
+#n #P #H
+cut (βq:nat. q β€ n β P q) /2/
+(elim n)
+ [#q #HleO (* applica male *)
+ @(le_n_O_rect_Type0 ? HleO)
+ @H #p #ltpO cases (?:False) /2/ (* 3 *)
+ |#p #Hind #q #HleS
+ @H #a #lta @Hind @le_S_S_to_le /2/
+ ]
+qed.
+
+lemma leb_false_to_lt : βn,m. leb n m = false β m < n.
+#n elim n
+[ #m normalize #H destruct(H)
+| #n0 #IH * // #m normalize #H @le_S_S @IH // ]
+qed.
+
+lemma nominal_eta_aux : βx,u.x β FV u β βk.vclose_tm_aux (vopen_tm_aux u x k) x k = u.
+#x #u elim u
+[ #n #_ #k normalize cases (decidable_eq_nat n k) #Hnk
+ [ >Hnk >eqb_n_n whd in β’ (??%?); >(\b ?) //
+ | >(not_eq_to_eqb_false β¦ Hnk) normalize cases (true_or_false (leb n k)) #Hleb
+ [ >Hleb normalize >(?:leb k n = false) //
+ @lt_to_leb_false @not_eq_to_le_to_lt /2/
+ | >Hleb normalize >(?:leb k (pred n) = true) normalize
+ [ cases (leb_false_to_lt β¦ Hleb) //
+ | @le_to_leb_true cases (leb_false_to_lt β¦ Hleb) normalize /2/ ] ] ]
+| #y normalize in β’ (%β?β?); #Hy whd in β’ (?β??%?); >(\bf ?) // @(not_to_not β¦ Hy) //
+| #s #v #IH normalize #Hv #k >IH // @Hv
+| #v1 #v2 #IH1 #IH2 normalize #Hv1v2 #k
+ >IH1 [ >IH2 // | @(not_to_not β¦ Hv1v2) @in_list_to_in_list_append_l ]
+ @(not_to_not β¦ Hv1v2) @in_list_to_in_list_append_r ]
+qed.
+
+corollary nominal_eta : βx,u.x β FV u β (Ξ½x.uβxβ) = u.
+#x #u #Hu @nominal_eta_aux //
+qed.
+
+lemma eq_height_vopen_aux : βv,x,k.tm_height (vopen_tm_aux v x k) = tm_height v.
+#v #x elim v
+[ #n #k normalize cases (eqb n k) // cases (leb n k) //
+| #u #k %
+| #s #u #IH #k normalize >IH %
+| #u1 #u2 #IH1 #IH2 #k normalize >IH1 >IH2 % ]
+qed.
+
+corollary eq_height_vopen : βv,x.tm_height (vβxβ) = tm_height v.
+#v #x @eq_height_vopen_aux
+qed.
+
+theorem pretm_ind_plus_aux :
+ βP:pretm β Type[0].
+ (βx:πΈ.P (par x)) β
+ (βn:β.P (var n)) β
+ (βv1,v2. P v1 β P v2 β P (app v1 v2)) β
+ βC:list πΈ.
+ (βx,s,v.x β FV v β x β C β P (vβxβ) β P (lam x s (vβxβ))) β
+ βn,u.tm_height u β€ n β P u.
+#P #Hpar #Hvar #Happ #C #Hlam #n change with ((Ξ»n.?) n); @(nat_rect_Type0_1 n ??)
+#m cases m
+[ #_ * /2/
+ [ normalize #s #v #Hfalse cases (?:False) cases (not_le_Sn_O (tm_height v)) /2/
+ | #v1 #v2 whd in β’ (?%?β?); #Hfalse cases (?:False) cases (not_le_Sn_O (S (max ??))) /2/ ] ]
+-m #m #IH * /2/
+[ #s #v whd in β’ (?%?β?); #Hv
+ lapply (p_fresh β¦ (C@FV v)) letin y β (N_fresh β¦ (C@FV v)) #Hy
+ >(?:abs s v = lam y s (vβyβ))
+ [| whd in β’ (???%); >nominal_eta // @(not_to_not β¦ Hy) @in_list_to_in_list_append_r ]
+ @Hlam
+ [ @(not_to_not β¦ Hy) @in_list_to_in_list_append_r
+ | @(not_to_not β¦ Hy) @in_list_to_in_list_append_l ]
+ @IH [| @Hv | >eq_height_vopen % ]
+| #v1 #v2 whd in β’ (?%?β?); #Hv @Happ
+ [ @IH [| @Hv | // ] | @IH [| @Hv | // ] ] ]
+qed.
+
+corollary pretm_ind_plus :
+ βP:pretm β Type[0].
+ (βx:πΈ.P (par x)) β
+ (βn:β.P (var n)) β
+ (βv1,v2. P v1 β P v2 β P (app v1 v2)) β
+ βC:list πΈ.
+ (βx,s,v.x β FV v β x β C β P (vβxβ) β P (lam x s (vβxβ))) β
+ βu.P u.
+#P #Hpar #Hvar #Happ #C #Hlam #u @pretm_ind_plus_aux /2/
+qed.
+
+(* maps a permutation to a list of terms *)
+definition Pi_map_list : (πΈ β πΈ) β list πΈ β list πΈ β map πΈ πΈ .
+
+(* interpretation "permutation of name list" 'middot p x = (Pi_map_list p x).*)
+
+(*
+inductive tm : pretm β Prop β
+| tm_par : βx:πΈ.tm (par x)
+| tm_app : βu,v.tm u β tm v β tm (app u v)
+| tm_lam : βx,s,u.tm u β tm (lam x s u).
+
+inductive ctx_aux : nat β pretm β Prop β
+| ctx_var : βn,k.n < k β ctx_aux k (var n)
+| ctx_par : βx,k.ctx_aux k (par x)
+| ctx_app : βu,v,k.ctx_aux k u β ctx_aux k v β ctx_aux k (app u v)
+(* Γ¨ sostituibile da ctx_lam ? *)
+| ctx_abs : βs,u.ctx_aux (S k) u β ctx_aux k (abs s u).
+*)
+
+inductive tm_or_ctx (k:nat) : pretm β Type[0] β
+| toc_var : βn.n < k β tm_or_ctx k (var n)
+| toc_par : βx.tm_or_ctx k (par x)
+| toc_app : βu,v.tm_or_ctx k u β tm_or_ctx k v β tm_or_ctx k (app u v)
+| toc_lam : βx,s,u.tm_or_ctx k u β tm_or_ctx k (lam x s u).
+
+definition tm β Ξ»t.tm_or_ctx O t.
+definition ctx β Ξ»t.tm_or_ctx 1 t.
+
+record TM : Type[0] β {
+ pretm_of_TM :> pretm;
+ tm_of_TM : tm pretm_of_TM
+}.
+
+record CTX : Type[0] β {
+ pretm_of_CTX :> pretm;
+ ctx_of_CTX : ctx pretm_of_CTX
+}.
+
+inductive tm2 : pretm β Type[0] β
+| tm_par : βx.tm2 (par x)
+| tm_app : βu,v.tm2 u β tm2 v β tm2 (app u v)
+| tm_lam : βx,s,u.x β FV u β (βy.y β FV u β tm2 (uβyβ)) β tm2 (lam x s (uβxβ)).
+
+(*
+inductive tm' : pretm β Prop β
+| tm_par : βx.tm' (par x)
+| tm_app : βu,v.tm' u β tm' v β tm' (app u v)
+| tm_lam : βx,s,u,C.x β FV u β x β C β (βy.y β FV u β tm' (β΄uβ΅y)) β tm' (lam x s (β΄uβ΅x)).
+*)
+
+axiom swap_inj : βN.βz1,z2,x,y.swap N z1 z2 x = swap N z1 z2 y β x = y.
+
+lemma pi_vclose_tm :
+ βz1,z2,x,u.swap πΈ z1 z2Β·(Ξ½x.u) = (Ξ½ swap ? z1 z2 x.swap πΈ z1 z2 Β· u).
+#z1 #z2 #x #u
+change with (vclose_tm_aux ???) in match (vclose_tm ??);
+change with (vclose_tm_aux ???) in β’ (???%); lapply O elim u
+[3:whd in β’ (?β?β(?β ??%%)β?β??%%); //
+|4:whd in β’ (?β?β(?β??%%)β(?β??%%)β?β??%%); //
+| #n #k whd in β’ (??(??%)%); cases (leb k n) normalize %
+| #x0 #k cases (true_or_false (x0==z1)) #H1 >H1 whd in β’ (??%%);
+ [ cases (true_or_false (x0==x)) #H2 >H2 whd in β’ (??(??%)%);
+ [ <(\P H2) >H1 whd in β’ (??(??%)%); >(\b ?) // >(\b ?) //
+ | >H2 whd in match (swap ????); >H1
+ whd in match (if false then var k else ?);
+ whd in match (if true then z2 else ?); >(\bf ?)
+ [ >(\P H1) >swap_left %
+ | <(swap_inv ? z1 z2 z2) in β’ (?(??%?)); % #H3
+ lapply (swap_inj β¦ H3) >swap_right #H4 <H4 in H2; >H1 #H destruct (H) ]
+ ]
+ | >(?:(swap ? z1 z2 x0 == swap ? z1 z2 x) = (x0 == x))
+ [| cases (true_or_false (x0==x)) #H2 >H2
+ [ >(\P H2) @(\b ?) %
+ | @(\bf ?) % #H >(swap_inj β¦ H) in H2; >(\b ?) // #H0 destruct (H0) ] ]
+ cases (true_or_false (x0==x)) #H2 >H2 whd in β’ (??(??%)%);
+ [ <(\P H2) >H1 >(\b (refl ??)) %
+ | >H1 >H2 % ]
+ ]
+ ]
+qed.
+
+lemma pi_vopen_tm :
+ βz1,z2,x,u.swap πΈ z1 z2Β·(uβxβ) = (swap πΈ z1 z2 Β· uβswap πΈ z1 z2 xβ).
+#z1 #z2 #x #u
+change with (vopen_tm_aux ???) in match (vopen_tm ??);
+change with (vopen_tm_aux ???) in β’ (???%); lapply O elim u //
+[2: #s #v whd in β’ ((?β??%%)β?β??%%); //
+|3: #v1 #v2 whd in β’ ((?β??%%)β(?β??%%)β?β??%%); /2/ ]
+#n #k whd in β’ (??(??%)%); cases (true_or_false (eqb n k)) #H1 >H1 //
+cases (true_or_false (leb n k)) #H2 >H2 normalize //
+qed.
+
+lemma pi_lam :
+ βz1,z2,x,s,u.swap πΈ z1 z2 Β· lam x s u = lam (swap πΈ z1 z2 x) s (swap πΈ z1 z2 Β· u).
+#z1 #z2 #x #s #u whd in β’ (???%); <(pi_vclose_tm β¦) %
+qed.
+
+lemma eqv_FV : βz1,z2,u.FV (swap πΈ z1 z2 Β· u) = Pi_map_list (swap πΈ z1 z2) (FV u).
+#z1 #z2 #u elim u //
+[ #s #v #H @H
+| #v1 #v2 whd in β’ (??%%β??%%β??%%); #H1 #H2 >H1 >H2
+ whd in β’ (???(????%)); /2/ ]
+qed.
+
+lemma swap_inv_tm : βz1,z2,u.swap πΈ z1 z2 Β· (swap πΈ z1 z2 Β· u) = u.
+#z1 #z2 #u elim u
+[1: #n %
+|3: #s #v whd in β’ (?β??%%); //
+|4: #v1 #v2 #Hv1 #Hv2 whd in β’ (??%%); // ]
+#x whd in β’ (??%?); >swap_inv %
+qed.
+
+lemma eqv_in_list : βx,l,z1,z2.x β l β swap πΈ z1 z2 x β Pi_map_list (swap πΈ z1 z2) l.
+#x #l #z1 #z2 #Hin elim Hin
+[ #x0 #l0 %
+| #x1 #x2 #l0 #Hin #IH %2 @IH ]
+qed.
+
+lemma eqv_tm2 : βu.tm2 u β βz1,z2.tm2 ((swap ? z1 z2)Β·u).
+#u #Hu #z1 #z2 letin p β (swap ? z1 z2) elim Hu /2/
+#x #s #v #Hx #Hv #IH >pi_lam >pi_vopen_tm %3
+[ @(not_to_not β¦ Hx) -Hx #Hx
+ <(swap_inv ? z1 z2 x) <(swap_inv_tm z1 z2 v) >eqv_FV @eqv_in_list //
+| #y #Hy <(swap_inv ? z1 z2 y)
+ <pi_vopen_tm @IH @(not_to_not β¦ Hy) -Hy #Hy <(swap_inv ? z1 z2 y)
+ >eqv_FV @eqv_in_list //
+]
+qed.
+
+lemma vclose_vopen_aux : βx,u,k.vopen_tm_aux (vclose_tm_aux u x k) x k = u.
+#x #u elim u [1,3,4:normalize //]
+[ #n #k cases (true_or_false (leb k n)) #H >H whd in β’ (??%?);
+ [ cases (true_or_false (eqb (S n) k)) #H1 >H1
+ [ <(eqb_true_to_eq β¦ H1) in H; #H lapply (leb_true_to_le β¦ H) -H #H
+ cases (le_to_not_lt β¦ H) -H #H cases (H ?) %
+ | whd in β’ (??%?); >lt_to_leb_false // @le_S_S /2/ ]
+ | cases (true_or_false (eqb n k)) #H1 >H1 normalize
+ [ >(eqb_true_to_eq β¦ H1) in H; #H lapply (leb_false_to_not_le β¦ H) -H
+ * #H cases (H ?) %
+ | >le_to_leb_true // @not_lt_to_le % #H2 >le_to_leb_true in H;
+ [ #H destruct (H) | /2/ ]
+ ]
+ ]
+| #x0 #k whd in β’ (??(?%??)?); cases (true_or_false (x0==x))
+ #H1 >H1 normalize // >(\P H1) >eqb_n_n % ]
+qed.
+
+lemma vclose_vopen : βx,u.((Ξ½x.u)βxβ) = u. #x #u @vclose_vopen_aux
+qed.
+
+(*
+theorem tm_to_tm : βt.tm' t β tm t.
+#t #H elim H
+*)
+
+lemma in_list_singleton : βT.βt1,t2:T.t1 β [t2] β t1 = t2.
+#T #t1 #t2 #H @(in_list_inv_ind ??? H) /2/
+qed.
+
+lemma fresh_vclose_tm_aux : βu,x,k.x β FV (vclose_tm_aux u x k).
+#u #x elim u //
+[ #n #k normalize cases (leb k n) normalize //
+| #x0 #k whd in β’ (?(???(?%))); cases (true_or_false (x0==x)) #H >H normalize //
+ lapply (\Pf H) @not_to_not #Hin >(in_list_singleton ??? Hin) %
+| #v1 #v2 #IH1 #IH2 #k normalize % #Hin cases (in_list_append_to_or_in_list ???? Hin) -Hin #Hin
+ [ cases (IH1 k) -IH1 #IH1 @IH1 @Hin | cases (IH2 k) -IH2 #IH2 @IH2 @Hin ]
+qed.
+
+lemma fresh_vclose_tm : βu,x.x β FV (Ξ½x.u). //
+qed.
+
+lemma fresh_swap_tm : βz1,z2,u.z1 β FV u β z2 β FV u β swap πΈ z1 z2 Β· u = u.
+#z1 #z2 #u elim u
+[2: normalize in β’ (?β%β%β?); #x #Hz1 #Hz2 whd in β’ (??%?); >swap_other //
+ [ @(not_to_not β¦ Hz2) | @(not_to_not β¦ Hz1) ] //
+|1: //
+| #s #v #IH normalize #Hz1 #Hz2 >IH // [@Hz2|@Hz1]
+| #v1 #v2 #IH1 #IH2 normalize #Hz1 #Hz2
+ >IH1 [| @(not_to_not β¦ Hz2) @in_list_to_in_list_append_l | @(not_to_not β¦ Hz1) @in_list_to_in_list_append_l ]
+ >IH2 // [@(not_to_not β¦ Hz2) @in_list_to_in_list_append_r | @(not_to_not β¦ Hz1) @in_list_to_in_list_append_r ]
+]
+qed.
+
+theorem tm_to_tm2 : βu.tm u β tm2 u.
+#t #Ht elim Ht
+[ #n #Hn cases (not_le_Sn_O n) #Hfalse cases (Hfalse Hn)
+| @tm_par
+| #u #v #Hu #Hv @tm_app
+| #x #s #u #Hu #IHu <(vclose_vopen x u) @tm_lam
+ [ @fresh_vclose_tm
+ | #y #Hy <(fresh_swap_tm x y (Ξ½x.u)) /2/ @fresh_vclose_tm ]
+]
+qed.
+
+theorem tm2_to_tm : βu.tm2 u β tm u.
+#u #pu elim pu /2/ #x #s #v #Hx #Hv #IH %4 @IH //
+qed.
+
+definition PAR β Ξ»x.mk_TM (par x) ?. // qed.
+definition APP β Ξ»u,v:TM.mk_TM (app u v) ?./2/ qed.
+definition LAM β Ξ»x,s.Ξ»u:TM.mk_TM (lam x s u) ?./2/ qed.
+
+axiom vopen_tm_down : βu,x,k.tm_or_ctx (S k) u β tm_or_ctx k (uβxβ).
+(* needs true_plus_false
+
+#u #x #k #Hu elim Hu
+[ #n #Hn normalize cases (true_or_false (eqb n O)) #H >H [%2]
+ normalize >(?: leb n O = false) [|cases n in H; // >eqb_n_n #H destruct (H) ]
+ normalize lapply Hn cases n in H; normalize [ #Hfalse destruct (Hfalse) ]
+ #n0 #_ #Hn0 % @le_S_S_to_le //
+| #x0 %2
+| #v1 #v2 #Hv1 #Hv2 #IH1 #IH2 %3 //
+| #x0 #s #v #Hv #IH normalize @daemon
+]
+qed.
+*)
+
+definition vopen_TM β Ξ»u:CTX.Ξ»x.mk_TM (uβxβ) (vopen_tm_down β¦). @ctx_of_CTX qed.
+
+axiom vclose_tm_up : βu,x,k.tm_or_ctx k u β tm_or_ctx (S k) (Ξ½x.u).
+
+definition vclose_TM β Ξ»u:TM.Ξ»x.mk_CTX (Ξ½x.u) (vclose_tm_up β¦). @tm_of_TM qed.
+
+interpretation "ln wf term variable open" 'open u x = (vopen_TM u x).
+interpretation "ln wf term variable close" 'nu x u = (vclose_TM u x).
+
+theorem tm_alpha : βx,y,s,u.x β FV u β y β FV u β lam x s (uβxβ) = lam y s (uβyβ).
+#x #y #s #u #Hx #Hy whd in β’ (??%%); @eq_f >nominal_eta // >nominal_eta //
+qed.
+
+theorem TM_ind_plus :
+(* non si puΓ² dare il principio in modo dipendente (almeno utilizzando tm2)
+ la "prova" purtroppo Γ¨ in Type e non si puΓ² garantire che sia esattamente
+ quella che ci aspetteremmo
+ *)
+ βP:pretm β Type[0].
+ (βx:πΈ.P (PAR x)) β
+ (βv1,v2:TM.P v1 β P v2 β P (APP v1 v2)) β
+ βC:list πΈ.
+ (βx,s.βv:CTX.x β FV v β x β C β
+ (βy.y β FV v β P (vβyβ)) β P (LAM x s (vβxβ))) β
+ βu:TM.P u.
+#P #Hpar #Happ #C #Hlam * #u #pu elim (tm_to_tm2 u pu) //
+[ #v1 #v2 #pv1 #pv2 #IH1 #IH2 @(Happ (mk_TM β¦) (mk_TM β¦)) /2/
+| #x #s #v #Hx #pv #IH
+ lapply (p_fresh β¦ (C@FV v)) letin x0 β (N_fresh β¦ (C@FV v)) #Hx0
+ >(?:lam x s (vβxβ) = lam x0 s (vβx0β))
+ [|@tm_alpha // @(not_to_not β¦ Hx0) @in_list_to_in_list_append_r ]
+ @(Hlam x0 s (mk_CTX v ?) ??)
+ [ <(nominal_eta β¦ Hx) @vclose_tm_up @tm2_to_tm @pv //
+ | @(not_to_not β¦ Hx0) @in_list_to_in_list_append_r
+ | @(not_to_not β¦ Hx0) @in_list_to_in_list_append_l
+ | @IH ]
+]
+qed.
+
+notation
+"hvbox('nominal' u 'return' out 'with'
+ [ 'xpar' ident x β f1
+ | 'xapp' ident v1 ident v2 ident recv1 ident recv2 β f2
+ | 'xlam' β¨ident y # Cβ© ident s ident w ident py1 ident py2 ident recw β f3 ])"
+with precedence 48
+for @{ TM_ind_plus $out (Ξ»${ident x}:?.$f1)
+ (Ξ»${ident v1}:?.Ξ»${ident v2}:?.Ξ»${ident recv1}:?.Ξ»${ident recv2}:?.$f2)
+ $C (Ξ»${ident y}:?.Ξ»${ident s}:?.Ξ»${ident w}:?.Ξ»${ident py1}:?.Ξ»${ident py2}:?.Ξ»${ident recw}:?.$f3)
+ $u }.
+
+(* include "basics/jmeq.ma".*)
+
+definition subst β (Ξ»u:TM.Ξ»x,v.
+ nominal u return (Ξ»_.TM) with
+ [ xpar x0 β match x == x0 with [ true β v | false β u ]
+ | xapp v1 v2 recv1 recv2 β APP recv1 recv2
+ | xlam β¨y # x::FV vβ© s w py1 py2 recw β LAM y s (recw y py1) ]).
+
+lemma fasfd : βs,v. pretm_of_TM (subst (LAM O s (PAR 1)) O v) = pretm_of_TM (LAM O s (PAR 1)).
+#s #v normalize in β’ (??%?);
+
+
+theorem tm2_ind_plus :
+(* non si puΓ² dare il principio in modo dipendente (almeno utilizzando tm2) *)
+ βP:pretm β Type[0].
+ (βx:πΈ.P (par x)) β
+ (βv1,v2.tm2 v1 β tm2 v2 β P v1 β P v2 β P (app v1 v2)) β
+ βC:list πΈ.
+ (βx,s,v.x β FV v β x β C β (βy.y β FV v β tm2 (vβyβ)) β
+ (βy.y β FV v β P (vβyβ)) β P (lam x s (vβxβ))) β
+ βu.tm2 u β P u.
+#P #Hpar #Happ #C #Hlam #u #pu elim pu /2/
+#x #s #v #px #pv #IH
+lapply (p_fresh β¦ (C@FV v)) letin y β (N_fresh β¦ (C@FV v)) #Hy
+>(?:lam x s (vβxβ) = lam y s (vβyβ)) [| @tm_alpha // @(not_to_not β¦ Hy) @in_list_to_in_list_append_r ]
+@Hlam /2/ lapply Hy -Hy @not_to_not #Hy
+[ @in_list_to_in_list_append_r @Hy | @in_list_to_in_list_append_l @Hy ]
+qed.
+
+definition check_tm β
+ Ξ»u.pretm_ind_plus ? (Ξ»_.true) (Ξ»_.false)
+ (Ξ»v1,v2,r1,r2.r1 β§ r2) [ ] (Ξ»x,s,v,pv1,pv2,rv.rv) u.
+
+(*
+lemma check_tm_complete : βu.tm u β check_tm u = true.
+#u #pu @(tm2_ind_plus β¦ [ ] β¦ (tm_to_tm2 ? pu)) //
+[ #v1 #v2 #pv1 #pv2 #IH1 #IH2
+| #x #s #v #Hx1 #Hx2 #Hv #IH
+*)
+
+notation
+"hvbox('nominal' u 'return' out 'with'
+ [ 'xpar' ident x β f1
+ | 'xapp' ident v1 ident v2 ident pv1 ident pv2 ident recv1 ident recv2 β f2
+ | 'xlam' β¨ident y # Cβ© ident s ident w ident py1 ident py2 ident pw ident recw β f3 ])"
+with precedence 48
+for @{ tm2_ind_plus $out (Ξ»${ident x}:?.$f1)
+ (Ξ»${ident v1}:?.Ξ»${ident v2}:?.Ξ»${ident pv1}:?.Ξ»${ident pv2}:?.Ξ»${ident recv1}:?.Ξ»${ident recv2}:?.$f2)
+ $C (Ξ»${ident y}:?.Ξ»${ident s}:?.Ξ»${ident w}:?.Ξ»${ident py1}:?.Ξ»${ident py2}:?.Ξ»${ident pw}:?.Ξ»${ident recw}:?.$f3)
+ ? (tm_to_tm2 ? $u) }.
+(* notation
+"hvbox('nominal' u 'with'
+ [ 'xlam' ident x # C ident s ident w β f3 ])"
+with precedence 48
+for @{ tm2_ind_plus ???
+ $C (Ξ»${ident x}:?.Ξ»${ident s}:?.Ξ»${ident w}:?.Ξ»${ident py1}:?.Ξ»${ident py2}:?.
+ Ξ»${ident pw}:?.Ξ»${ident recw}:?.$f3) $u (tm_to_tm2 ??) }.
+*)
+
+
+definition subst β (Ξ»u.Ξ»pu:tm u.Ξ»x,v.
+ nominal pu return (Ξ»_.pretm) with
+ [ xpar x0 β match x == x0 with [ true β v | false β u ]
+ | xapp v1 v2 pv1 pv2 recv1 recv2 β app recv1 recv2
+ | xlam β¨y # x::FV vβ© s w py1 py2 pw recw β lam y s (recw y py1) ]).
+
+lemma fasfd : βx,s,u,p1,v. subst (lam x s u) p1 x v = lam x s u.
+#x #s #u #p1 #v
+
+
+definition subst β Ξ»u.Ξ»pu:tm u.Ξ»x,y.
+ tm2_ind_plus ?
+ (* par x0 *) (Ξ»x0.match x == x0 with [ true β v | false β u ])
+ (* app v1 v2 *) (Ξ»v1,v2,pv1,pv2,recv1,recv2.app recv1 recv2)
+ (* lam y#(x::FV v) s w *) (x::FV v) (Ξ»y,s,w,py1,py2,pw,recw.lam y s (recw y py1))
+ u (tm_to_tm2 β¦ pu).
+check subst
+definition subst β Ξ»u.Ξ»pu:tm u.Ξ»x,v.
+ nominal u with
+ [ xlam y # (x::FV v) s w ^ ? ].
+
+(*
+notation > "Ξ ident x. ident T [ident x] β¦ P"
+ with precedence 48 for @{'foo (Ξ»${ident x}.Ξ»${ident T}.$P)}.
+
+notation < "Ξ ident x. ident T [ident x] β¦ P"
+ with precedence 48 for @{'foo (Ξ»${ident x}:$Q.Ξ»${ident T}:$R.$P)}.
+*)
+
+(*
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x β f1
+ | 'xapp' ident v1 ident v2 β f2
+ | 'xlam' ident x # C s w β f3 ])"
+with precedence 48
+for @{ tm2_ind_plus ? (Ξ»${ident x}:$Tx.$f1)
+ (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
+ $C (Ξ»${ident x}:$Tx.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+*)
+
+(*
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x ^ f1
+ | 'xapp' ident v1 ident v2 ^ f2 ])"
+(* | 'xlam' ident x # C s w ^ f3 ]) *)
+with precedence 48
+for @{ tm2_ind_plus ? (Ξ»${ident x}:$Tx.$f1)
+ (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
+ $C (Ξ»${ident x}:$Tx.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+*)
+notation
+"hvbox('nominal' u 'with'
+ [ 'xpar' ident x ^ f1
+ | 'xapp' ident v1 ident v2 ^ f2 ])"
+with precedence 48
+for @{ tm2_ind_plus ? (Ξ»${ident x}:?.$f1)
+ (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
+ $C (Ξ»${ident x}:?.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
+
+
+definition subst β Ξ»u.Ξ»pu:tm u.Ξ»x,v.
+ nominal u with
+ [ xpar x0 ^ match x == x0 with [ true β v | false β u ]
+ | xapp v1 v2 ^ ? ].
+ | xlam y # (x::FV v) s w ^ ? ].
+
+
+ (* par x0 *) (Ξ»x0.match x == x0 with [ true β v | false β u ])
+ (* app v1 v2 *) (Ξ»v1,v2,pv1,pv2,recv1,recv2.app recv1 recv2)
+ (* lam y#(x::FV v) s w *) (x::FV v) (Ξ»y,s,w,py1,py2,pw,recw.lam y s (recw y py1))
+ u (tm_to_tm2 β¦ pu).
+
+
+*)
+definition subst β Ξ»u.Ξ»pu:tm u.Ξ»x,v.
+ tm2_ind_plus ?
+ (* par x0 *) (Ξ»x0.match x == x0 with [ true β v | false β u ])
+ (* app v1 v2 *) (Ξ»v1,v2,pv1,pv2,recv1,recv2.app recv1 recv2)
+ (* lam y#(x::FV v) s w *) (x::FV v) (Ξ»y,s,w,py1,py2,pw,recw.lam y s (recw y py1))
+ u (tm_to_tm2 β¦ pu).
+
+check subst
+
+
+axiom in_Env : πΈ Γ tp β Env β Prop.
+notation "X β G" non associative with precedence 45 for @{'lefttriangle $X $G}.
+interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
+
+
+
+inductive judg : list tp β tm β tp β Prop β
+| t_var : βg,n,t.Nth ? n g = Some ? t β judg g (var n) t
+| t_app : βg,m,n,t,u.judg g m (arr t u) β judg g n t β judg g (app m n) u
+| t_abs : βg,t,m,u.judg (t::g) m u β judg g (abs t m) (arr t u).
+
+definition Env := list (πΈ Γ tp).
+
+axiom vclose_env : Env β list tp.
+axiom vclose_tm : Env β tm β tm.
+axiom Lam : πΈ β tp β tm β tm.
+definition Judg β Ξ»G,M,T.judg (vclose_env G) (vclose_tm G M) T.
+definition dom β Ξ»G:Env.map ?? (fst ??) G.
+
+definition sctx β πΈ Γ tm.
+axiom swap_tm : πΈ β πΈ β tm β tm.
+definition sctx_app : sctx β πΈ β tm β Ξ»M0,Y.let β©X,Mβͺ β M0 in swap_tm X Y M.
+
+axiom in_list : βA:Type[0].A β list A β Prop.
+interpretation "list membership" 'mem x l = (in_list ? x l).
+interpretation "list non-membership" 'notmem x l = (Not (in_list ? x l)).
+
+axiom in_Env : πΈ Γ tp β Env β Prop.
+notation "X β G" non associative with precedence 45 for @{'lefttriangle $X $G}.
+interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
+
+let rec FV M β match M with
+ [ par X β [X]
+ | app M1 M2 β FV M1@FV M2
+ | abs T M0 β FV M0
+ | _ β [ ] ].
+
+(* axiom Lookup : πΈ β Env β option tp. *)
+
+(* forma alto livello del judgment
+ t_abs* : βG,T,X,M,U.
+ (βY β supp(M).Judg (β©Y,Tβͺ::G) (M[Y]) U) β
+ Judg G (Lam X T (M[X])) (arr T U) *)
+
+(* prima dimostrare, poi perfezionare gli assiomi, poi dimostrarli *)
+
+axiom Judg_ind : βP:Env β tm β tp β Prop.
+ (βX,G,T.β©X,Tβͺ β G β P G (par X) T) β
+ (βG,M,N,T,U.
+ Judg G M (arr T U) β Judg G N T β
+ P G M (arr T U) β P G N T β P G (app M N) U) β
+ (βG,T1,T2,X,M1.
+ (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β Judg (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
+ (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β P (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
+ P G (Lam X T1 (sctx_app M1 X)) (arr T1 T2)) β
+ βG,M,T.Judg G M T β P G M T.
+
+axiom t_par : βX,G,T.β©X,Tβͺ β G β Judg G (par X) T.
+axiom t_app2 : βG,M,N,T,U.Judg G M (arr T U) β Judg G N T β Judg G (app M N) U.
+axiom t_Lam : βG,X,M,T,U.Judg (β©X,Tβͺ::G) M U β Judg G (Lam X T M) (arr T U).
+
+definition subenv β Ξ»G1,G2.βx.x β G1 β x β G2.
+interpretation "subenv" 'subseteq G1 G2 = (subenv G1 G2).
+
+axiom daemon : βP:Prop.P.
+
+theorem weakening : βG1,G2,M,T.G1 β G2 β Judg G1 M T β Judg G2 M T.
+#G1 #G2 #M #T #Hsub #HJ lapply Hsub lapply G2 -G2 change with (βG2.?)
+@(Judg_ind β¦ HJ)
+[ #X #G #T0 #Hin #G2 #Hsub @t_par @Hsub //
+| #G #M0 #N #T0 #U #HM0 #HN #IH1 #IH2 #G2 #Hsub @t_app2
+ [| @IH1 // | @IH2 // ]
+| #G #T1 #T2 #X #M1 #HM1 #IH #G2 #Hsub @t_Lam @IH
+ [ (* trivial property of Lam *) @daemon
+ | (* trivial property of subenv *) @daemon ]
+]
+qed.
+
+(* Serve un tipo Tm per i termini localmente chiusi e i suoi principi di induzione e
+ ricorsione *)
\ No newline at end of file
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||M|| *)
+(* ||A|| A project by Andrea Asperti *)
+(* ||T|| *)
+(* ||I|| Developers: *)
+(* ||T|| The HELM team. *)
+(* ||A|| http://helm.cs.unibo.it *)
+(* \ / *)
+(* \ / This file is distributed under the terms of the *)
+(* v GNU General Public License Version 2 *)
+(* *)
+(**************************************************************************)
+
+include "basics/logic.ma".
+include "basics/lists/in.ma".
+include "basics/types.ma".
+
+(*interpretation "list membership" 'mem x l = (in_list ? x l).*)
+
+record Nset : Type[1] β
+{
+ (* carrier is specified as a coercion: when an object X of type Nset is
+ given, but something of type Type is expected, Matita will insert a
+ hidden coercion: the user sees "X", but really means "carrier X" *)
+ carrier :> DeqSet;
+ N_fresh : list carrier β carrier;
+ p_fresh : βl.N_fresh l β l
+}.
+
+definition maxlist β
+ Ξ»l.foldr ?? (Ξ»x,acc.max x acc) 0 l.
+
+definition natfresh β Ξ»l.S (maxlist l).
+
+lemma le_max_1 : βx,y.x β€ max x y. /2/
+qed.
+
+lemma le_max_2 : βx,y.y β€ max x y. /2/
+qed.
+
+lemma le_maxlist : βl,x.x β l β x β€ maxlist l.
+#l elim l
+[#x #Hx @False_ind cases (not_in_list_nil ? x) #H1 /2/
+|#y #tl #IH #x #H1 change with (max ??) in β’ (??%);
+ cases (in_list_cons_case ???? H1);#H2;
+ [ >H2 @le_max_1
+ | whd in β’ (??%); lapply (refl ? (leb y (maxlist tl)));
+ cases (leb y (maxlist tl)) in β’ (???% β %);#H3
+ [ @IH //
+ | lapply (IH ? H2) #H4
+ lapply (leb_false_to_not_le β¦ H3) #H5
+ lapply (not_le_to_lt β¦ H5) #H6
+ @(transitive_le β¦ H4)
+ @(transitive_le β¦ H6) %2 %
+ ]
+ ]
+]
+qed.
+
+(* prove freshness for nat *)
+lemma lt_l_natfresh_l : βl,x.x β l β x < natfresh l.
+#l #x #H1 @le_S_S /2/
+qed.
+
+(*naxiom p_Xfresh : βl.βx:Xcarr.x β l β x β ntm (Xfresh l) β§ x β ntp (Xfresh l).*)
+lemma p_natfresh : βl.natfresh l β l.
+#l % #H1 lapply (lt_l_natfresh_l β¦ H1) #H2
+cases (lt_to_not_eq β¦ H2) #H3 @H3 %
+qed.
+
+include "basics/finset.ma".
+
+definition X : Nset β mk_Nset DeqNat β¦.
+[ @natfresh
+| @p_natfresh
+]
+qed.
\ No newline at end of file
--- /dev/null
+(*
+ ||M|| This file is part of HELM, an Hypertextual, Electronic
+ ||A|| Library of Mathematics, developed at the Computer Science
+ ||T|| Department of the University of Bologna, Italy.
+ ||I||
+ ||T||
+ ||A|| This file is distributed under the terms of the
+ \ / GNU General Public License Version 2
+ \ /
+ V_______________________________________________________________ *)
+
+include "finite_lambda/reduction.ma".
+
+
+axiom canonical_to_T: βO,D.βM:T O D.βty.(* type_of M ty β *)
+ βa:FinSet_of_FType O D ty. star ? (red O D) M (to_T O D ty a).
+
+axiom normal_to_T: βO,D,M,ty,a. red O D (to_T O D ty a) M β False.
+
+axiom red_closed: βO,D,M,M1.
+ is_closed O D 0 M β red O D M M1 β is_closed O D 0 M1.
+
+lemma critical: βO,D,ty,M,N.
+ βM3:T O D
+ .star (T O D) (red O D) (subst O D M 0 N) M3
+ β§star (T O D) (red O D)
+ (App O D
+ (Vec O D ty
+ (map (FinSet_of_FType O D ty) (T O D)
+ (Ξ»a0:FinSet_of_FType O D ty.subst O D M 0 (to_T O D ty a0))
+ (enum (FinSet_of_FType O D ty)))) N) M3.
+#O #D #ty #M #N
+lapply (canonical_to_T O D N ty) * #a #Ha
+%{(subst O D M 0 (to_T O D ty a))} (* CR-term *)
+%[@red_star_subst @Ha
+ |@trans_star [|@(star_red_appr β¦ Ha)] @R_to_star @riota
+ lapply (enum_complete (FinSet_of_FType O D ty) a)
+ elim (enum (FinSet_of_FType O D ty))
+ [normalize #H1 destruct (H1)
+ |#hd #tl #Hind #H cases (orb_true_l β¦ H) -H #Hcase
+ [normalize >Hcase >(\P Hcase) //
+ |normalize cases (true_or_false (a==hd)) #Hcase1
+ [normalize >Hcase1 >(\P Hcase1) // |>Hcase1 @Hind @Hcase]
+ ]
+ ]
+ ]
+qed.
+
+lemma critical2: βO,D,ty,a,M,M1,M2,v.
+ red O D (Vec O D ty v) M β
+ red O D (App O D (Vec O D ty v) (to_T O D ty a)) M1 β
+ assoc (FinSet_of_FType O D ty) (T O D) a (enum (FinSet_of_FType O D ty)) v
+ =Some (T O D) M2 β
+ βM3:T O D
+ .star (T O D) (red O D) M2 M3
+ β§star (T O D) (red O D) (App O D M (to_T O D ty a)) M3.
+#O #D #ty #a #M #M1 #M2 #v #redM #redM1 #Ha lapply (red_vec β¦ redM) -redM
+* #N * #N1 * #v1 * #v2 * * #Hred1 #Hv #HM0 >HM0 -HM0 >Hv in Ha; #Ha
+cases (same_assoc β¦ a (enum (FinSet_of_FType O D ty)) v1 v2 N N1)
+ [* >Ha -Ha #H1 destruct (H1) #Ha
+ %{N1} (* CR-term *) % [@R_to_star //|@R_to_star @(riota β¦ Ha)]
+ |#Ha1 %{M2} (* CR-term *) % [// | @R_to_star @riota <Ha1 @Ha]
+ ]
+qed.
+
+
+lemma critical3: βO,D,ty,M1,M2. red O D M1 M2 β
+ βM3:T O D.star (T O D) (red O D) (Lambda O D ty M2) M3
+ β§star (T O D) (red O D)
+ (Vec O D ty
+ (map (FinSet_of_FType O D ty) (T O D)
+ (Ξ»a:FinSet_of_FType O D ty.subst O D M1 0 (to_T O D ty a))
+ (enum (FinSet_of_FType O D ty)))) M3.
+#O #D #ty #M1 #M2 #Hred
+ %{(Vec O D ty
+ (map (FinSet_of_FType O D ty) (T O D)
+ (Ξ»a:FinSet_of_FType O D ty.subst O D M2 0 (to_T O D ty a))
+ (enum (FinSet_of_FType O D ty))))} (* CR-term *) %
+ [@R_to_star @rmem
+ |@star_red_vec2 [>length_map >length_map //] #n #M0
+ cases (true_or_false (leb (|enum (FinSet_of_FType O D ty)|) n)) #Hcase
+ [>nth_to_default [2:>length_map @(leb_true_to_le β¦ Hcase)]
+ >nth_to_default [2:>length_map @(leb_true_to_le β¦ Hcase)] //
+ |cut (n < |enum (FinSet_of_FType O D ty)|)
+ [@not_le_to_lt @leb_false_to_not_le @Hcase] #Hlt
+ cut (βa:FinSet_of_FType O D ty.True)
+ [lapply Hlt lapply (enum_complete (FinSet_of_FType O D ty))
+ cases (enum (FinSet_of_FType O D ty))
+ [#_ normalize #H @False_ind @(absurd β¦ H) @lt_to_not_le //
+ |#a #l #_ #_ %{a} //
+ ]
+ ] * #a #_
+ >(nth_map ?????? a Hlt) >(nth_map ?????? a Hlt) #_
+ @red_star_subst2 //
+ ]
+ ]
+qed.
+
+(* we need to proceed by structural induction on the term and then
+by inversion on the two redexes. The problem are the moves in a
+same subterm, since we need an induction hypothesis, there *)
+
+lemma local_confluence: βO,D,M,M1,M2. red O D M M1 β red O D M M2 β
+βM3. star ? (red O D) M1 M3 β§ star ? (red O D) M2 M3.
+#O #D #M @(T_elim β¦ M)
+ [#o #a #M1 #M2 #H elim(red_val ????? H)
+ |#n #M1 #M2 #H elim(red_rel ???? H)
+ |(* app : this is the interesting case *)
+ #P #Q #HindP #HindQ
+ #M1 #M2 #H1 inversion H1 -H1
+ [(* right redex is beta *)
+ #ty #Q #N #Hc #HM >HM -HM #HM1 >HM1 - HM1 #Hl inversion Hl
+ [#ty1 #Q1 #N1 #Hc1 #H1 destruct (H1) #H_
+ %{(subst O D Q1 0 N1)} (* CR-term *) /2/
+ |#ty #v #a #M0 #_ #H1 destruct (H1) (* vacuous *)
+ |#M0 #M10 #N0 #redM0 #_ #H1 destruct (H1) #_ cases (red_lambda β¦ redM0)
+ [* #Q1 * #redQ #HM10 >HM10
+ %{(subst O D Q1 0 N0)} (* CR-term *) %
+ [@red_star_subst2 //|@R_to_star @rbeta @Hc]
+ |#HM1 >HM1 @critical
+ ]
+ |#M0 #N0 #N1 #redN0N1 #_ #H1 destruct (H1) #HM2
+ %{(subst O D Q 0 N1)} (* CR-term *)
+ %[@red_star_subst @R_to_star //|@R_to_star @rbeta @(red_closed β¦ Hc) //]
+ |#ty1 #N0 #N1 #_ #_ #H1 destruct (H1) (* vacuous *)
+ |#ty1 #M0 #H1 destruct (H1) (* vacuous *)
+ |#ty1 #N0 #N1 #v #v1 #_ #_ #H1 destruct (H1) (* vacuous *)
+ ]
+ |(* right redex is iota *)#ty #v #a #M3 #Ha #_ #_ #Hl inversion Hl
+ [#P1 #M1 #N1 #_ #H1 destruct (H1) (* vacuous *)
+ |#ty1 #v1 #a1 #M4 #Ha1 #H1 destruct (H1) -H1 #HM4 >(inj_to_T β¦ e0) in Ha;
+ >Ha1 #H1 destruct (H1) %{M3} (* CR-term *) /2/
+ |#M0 #M10 #N0 #redM0 #_ #H1 destruct (H1) #HM2 @(critical2 β¦ redM0 Hl Ha)
+ |#M0 #N0 #N1 #redN0N1 #_ #H1 destruct (H1) elim (normal_to_T β¦ redN0N1)
+ |#ty1 #N0 #N1 #_ #_ #H1 destruct (H1) (* vacuous *)
+ |#ty1 #M0 #H1 destruct (H1) (* vacuous *)
+ |#ty1 #N0 #N1 #v #v1 #_ #_ #H1 destruct (H1) (* vacuous *)
+ ]
+ |(* right redex is appl *)#M3 #M4 #N #redM3M4 #_ #H1 destruct (H1) #_
+ #Hl inversion Hl
+ [#ty1 #M1 #N1 #Hc #H1 destruct (H1) #HM2 lapply (red_lambda β¦ redM3M4) *
+ [* #M3 * #H1 #H2 >H2 %{(subst O D M3 0 N1)} %
+ [@R_to_star @rbeta @Hc|@red_star_subst2 // ]
+ |#H >H -H lapply (critical O D ty1 M1 N1) * #M3 * #H1 #H2
+ %{M3} /2/
+ ]
+ |#ty1 #v1 #a1 #M4 #Ha1 #H1 #H2 destruct
+ lapply (critical2 β¦ redM3M4 Hl Ha1) * #M3 * #H1 #H2 %{M3} /2/
+ |#M0 #M10 #N0 #redM0 #_ #H1 destruct (H1) #HM2
+ lapply (HindP β¦ redM0 redM3M4) * #M3 * #H1 #H2
+ %{(App O D M3 N0)} (* CR-term *) % [@star_red_appl //|@star_red_appl //]
+ |#M0 #N0 #N1 #redN0N1 #_ #H1 destruct (H1) #_
+ %{(App O D M4 N1)} % @R_to_star [@rappr //|@rappl //]
+ |#ty1 #N0 #N1 #_ #_ #H1 destruct (H1) (* vacuous *)
+ |#ty1 #M0 #H1 destruct (H1) (* vacuous *)
+ |#ty1 #N0 #N1 #v #v1 #_ #_ #H1 destruct (H1) (* vacuous *)
+ ]
+ |(* right redex is appr *)#M3 #N #N1 #redN #_ #H1 destruct (H1) #_
+ #Hl inversion Hl
+ [#ty1 #M0 #N0 #Hc #H1 destruct (H1) #HM2
+ %{(subst O D M0 0 N1)} (* CR-term *) %
+ [@R_to_star @rbeta @(red_closed β¦ Hc) //|@red_star_subst @R_to_star // ]
+ |#ty1 #v1 #a1 #M4 #Ha1 #H1 #H2 destruct (H1) elim (normal_to_T β¦ redN)
+ |#M0 #M10 #N0 #redM0 #_ #H1 destruct (H1) #HM2
+ %{(App O D M10 N1)} (* CR-term *) % @R_to_star [@rappl //|@rappr //]
+ |#M0 #N0 #N10 #redN0 #_ #H1 destruct (H1) #_
+ lapply (HindQ β¦ redN0 redN) * #M3 * #H1 #H2
+ %{(App O D M0 M3)} (* CR-term *) % [@star_red_appr //|@star_red_appr //]
+ |#ty1 #N0 #N1 #_ #_ #H1 destruct (H1) (* vacuous *)
+ |#ty1 #M0 #H1 destruct (H1) (* vacuous *)
+ |#ty1 #N0 #N1 #v #v1 #_ #_ #H1 destruct (H1) (* vacuous *)
+ ]
+ |(* right redex is rlam *) #ty #N0 #N1 #_ #_ #H1 destruct (H1) (* vacuous *)
+ |(* right redex is rmem *) #ty #M0 #H1 destruct (H1) (* vacuous *)
+ |(* right redex is vec *) #ty #N #N1 #v #v1 #_ #_
+ #H1 destruct (H1) (* vacuous *)
+ ]
+ |#ty #M1 #Hind #M2 #M3 #H1 #H2 (* this case is not trivial any more *)
+ lapply (red_lambda β¦ H1) *
+ [* #M4 * #H3 #H4 >H4 lapply (red_lambda β¦ H2) *
+ [* #M5 * #H5 #H6 >H6 lapply(Hind β¦ H3 H5) * #M6 * #H7 #H8
+ %{(Lambda O D ty M6)} (* CR-term *) % @star_red_lambda //
+ |#H5 >H5 @critical3 //
+ ]
+ |#HM2 >HM2 lapply (red_lambda β¦ H2) *
+ [* #M4 * #Hred #HM3 >HM3 lapply (critical3 β¦ ty ?? Hred) * #M5
+ * #H3 #H4 %{M5} (* CR-term *) % //
+ |#HM3 >HM3 %{M3} (* CR-term *) % //
+ ]
+ ]
+ |#ty #v1 #Hind #M1 #M2 #H1 #H2
+ lapply (red_vec β¦ H1) * #N11 * #N12 * #v11 * #v12 * * #redN11 #Hv1 #HM1
+ lapply (red_vec β¦ H2) * #N21* #N22 * #v21 * #v22 * * #redN21 #Hv2 #HM2
+ >Hv1 in Hv2; #Hvv lapply (compare_append β¦ Hvv) -Hvv *
+ (* we must proceed by cases on the list *) * normalize
+ [(* N11 = N21 *) *
+ [>append_nil * #Hl1 #Hl2 destruct lapply(Hind N11 β¦ redN11 redN21)
+ [@mem_append_l2 %1 //]
+ * #M3 * #HM31 #HM32
+ %{(Vec O D ty (v21@M3::v12))} (* CR-term *)
+ % [@star_red_vec //|@star_red_vec //]
+ |>append_nil * #Hl1 #Hl2 destruct lapply(Hind N21 β¦ redN21 redN11)
+ [@mem_append_l2 %1 //]
+ * #M3 * #HM31 #HM32
+ %{(Vec O D ty (v11@M3::v22))} (* CR-term *)
+ % [@star_red_vec //|@star_red_vec //]
+ ]
+ |(* N11 β N21 *) -Hind #P #l *
+ [* #Hv11 #Hv22 destruct
+ %{((Vec O D ty ((v21@N22::l)@N12::v12)))} (* CR-term *) % @R_to_star
+ [>associative_append >associative_append normalize @rvec //
+ |>append_cons <associative_append <append_cons in β’ (???%?); @rvec //
+ ]
+ |* #Hv11 #Hv22 destruct
+ %{((Vec O D ty ((v11@N12::l)@N22::v22)))} (* CR-term *) % @R_to_star
+ [>append_cons <associative_append <append_cons in β’ (???%?); @rvec //
+ |>associative_append >associative_append normalize @rvec //
+ ]
+ ]
+ ]
+ ]
+qed.
+
+
+
+
--- /dev/null
+(*
+ ||M|| This file is part of HELM, an Hypertextual, Electronic
+ ||A|| Library of Mathematics, developed at the Computer Science
+ ||T|| Department of the University of Bologna, Italy.
+ ||I||
+ ||T||
+ ||A|| This file is distributed under the terms of the
+ \ / GNU General Public License Version 2
+ \ /
+ V_______________________________________________________________ *)
+
+include "finite_lambda/terms_and_types.ma".
+
+(* some auxiliary lemmas *)
+
+lemma nth_to_default: βA,l,n,d.
+ |l| β€ n β nth n A l d = d.
+#A #l elim l [//] #a #tl #Hind #n cases n
+ [#d normalize #H @False_ind @(absurd β¦ H) @lt_to_not_le //
+ |#m #d normalize #H @Hind @le_S_S_to_le @H
+ ]
+qed.
+
+lemma mem_nth: βA,l,n,d.
+ n < |l| β mem ? (nth n A l d) l.
+#A #l elim l
+ [#n #d normalize #H @False_ind @(absurd β¦ H) @lt_to_not_le //
+ |#a #tl #Hind * normalize
+ [#_ #_ %1 //| #m #d #HSS %2 @Hind @le_S_S_to_le @HSS]
+ ]
+qed.
+
+lemma nth_map: βA,B,l,f,n,d1,d2.
+ n < |l| β nth n B (map β¦ f l) d1 = f (nth n A l d2).
+#n #B #l #f elim l
+ [#m #d1 #d2 normalize #H @False_ind @(absurd β¦ H) @lt_to_not_le //
+ |#a #tl #Hind #m #d1 #d2 cases m normalize //
+ #m1 #H @Hind @le_S_S_to_le @H
+ ]
+qed.
+
+
+
+(* end of auxiliary lemmas *)
+
+let rec to_T O D ty on ty: FinSet_of_FType O D ty β T O D β
+ match ty return (Ξ»ty.FinSet_of_FType O D ty β T O D) with
+ [atom o β Ξ»a.Val O D o a
+ |arrow ty1 ty2 β Ξ»a:FinFun ??.Vec O D ty1
+ (map ((FinSet_of_FType O D ty1)Γ(FinSet_of_FType O D ty2))
+ (T O D) (Ξ»p.to_T O D ty2 (snd β¦ p)) (pi1 β¦ a))
+ ]
+.
+
+lemma is_closed_to_T: βO,D,ty,a. is_closed O D 0 (to_T O D ty a).
+#O #D #ty elim ty //
+#ty1 #ty2 #Hind1 #Hind2 #a normalize @cvec #m #Hmem
+lapply (mem_map ????? Hmem) * #a1 * #H1 #H2 <H2 @Hind2
+qed.
+
+axiom inj_to_T: βO,D,ty,a1,a2. to_T O D ty a1 = to_T O D ty a2 β a1 = a2.
+(* complicata
+#O #D #ty elim ty
+ [#o normalize #a1 #a2 #H destruct //
+ |#ty1 #ty2 #Hind1 #Hind2 * #l1 #Hl1 * #l2 #Hl2 normalize #H destruct -H
+ cut (l1=l2) [2: #H generalize in match Hl1; >H //] -Hl1 -Hl2
+ lapply e0 -e0 lapply l2 -l2 elim l1
+ [#l2 cases l2 normalize [// |#a1 #tl1 #H destruct]
+ |#a1 #tl1 #Hind #l2 cases l2
+ [normalize #H destruct
+ |#a2 #tl2 normalize #H @eq_f2
+ [@Hind2 *)
+
+let rec assoc (A:FinSet) (B:Type[0]) (a:A) l1 l2 on l1 : option B β
+ match l1 with
+ [ nil β None ?
+ | cons hd1 tl1 β match l2 with
+ [ nil β None ?
+ | cons hd2 tl2 β if a==hd1 then Some ? hd2 else assoc A B a tl1 tl2
+ ]
+ ].
+
+lemma same_assoc: βA,B,a,l1,v1,v2,N,N1.
+ assoc A B a l1 (v1@N::v2) = Some ? N β§ assoc A B a l1 (v1@N1::v2) = Some ? N1
+ β¨ assoc A B a l1 (v1@N::v2) = assoc A B a l1 (v1@N1::v2).
+#A #B #a #l1 #v1 #v2 #N #N1 lapply v1 -v1 elim l1
+ [#v1 %2 // |#hd #tl #Hind * normalize cases (a==hd) normalize /3/]
+qed.
+
+lemma assoc_to_mem: βA,B,a,l1,l2,b.
+ assoc A B a l1 l2 = Some ? b β mem ? b l2.
+#A #B #a #l1 elim l1
+ [#l2 #b normalize #H destruct
+ |#hd1 #tl1 #Hind *
+ [#b normalize #H destruct
+ |#hd2 #tl2 #b normalize cases (a==hd1) normalize
+ [#H %1 destruct //|#H %2 @Hind @H]
+ ]
+ ]
+qed.
+
+lemma assoc_to_mem2: βA,B,a,l1,l2,b.
+ assoc A B a l1 l2 = Some ? b β βl21,l22.l2=l21@b::l22.
+#A #B #a #l1 elim l1
+ [#l2 #b normalize #H destruct
+ |#hd1 #tl1 #Hind *
+ [#b normalize #H destruct
+ |#hd2 #tl2 #b normalize cases (a==hd1) normalize
+ [#H %{[]} %{tl2} destruct //
+ |#H lapply (Hind β¦ H) * #la * #lb #H1
+ %{(hd2::la)} %{lb} >H1 //]
+ ]
+ ]
+qed.
+
+lemma assoc_map: βA,B,C,a,l1,l2,f,b.
+ assoc A B a l1 l2 = Some ? b β assoc A C a l1 (map ?? f l2) = Some ? (f b).
+#A #B #C #a #l1 elim l1
+ [#l2 #f #b normalize #H destruct
+ |#hd1 #tl1 #Hind *
+ [#f #b normalize #H destruct
+ |#hd2 #tl2 #f #b normalize cases (a==hd1) normalize
+ [#H destruct // |#H @(Hind β¦ H)]
+ ]
+ ]
+qed.
+
+(*************************** One step reduction *******************************)
+
+inductive red (O:Type[0]) (D:OβFinSet) : T O D βT O D β Prop β
+ | (* we only allow beta on closed arguments *)
+ rbeta: βP,M,N. is_closed O D 0 N β
+ red O D (App O D (Lambda O D P M) N) (subst O D M 0 N)
+ | riota: βty,v,a,M.
+ assoc ?? a (enum (FinSet_of_FType O D ty)) v = Some ? M β
+ red O D (App O D (Vec O D ty v) (to_T O D ty a)) M
+ | rappl: βM,M1,N. red O D M M1 β red O D (App O D M N) (App O D M1 N)
+ | rappr: βM,N,N1. red O D N N1 β red O D (App O D M N) (App O D M N1)
+ | rlam: βty,N,N1. red O D N N1 β red O D (Lambda O D ty N) (Lambda O D ty N1)
+ | rmem: βty,M. red O D (Lambda O D ty M)
+ (Vec O D ty (map ?? (Ξ»a. subst O D M 0 (to_T O D ty a))
+ (enum (FinSet_of_FType O D ty))))
+ | rvec: βty,N,N1,v,v1. red O D N N1 β
+ red O D (Vec O D ty (v@N::v1)) (Vec O D ty (v@N1::v1)).
+
+(*********************************** inversion ********************************)
+lemma red_vec: βO,D,ty,v,M.
+ red O D (Vec O D ty v) M β βN,N1,v1,v2.
+ red O D N N1 β§ v = v1@N::v2 β§ M = Vec O D ty (v1@N1::v2).
+#O #D #ty #v #M #Hred inversion Hred
+ [#ty1 #M0 #N #Hc #H destruct
+ |#ty1 #v1 #a #M0 #_ #H destruct
+ |#M0 #M1 #N #_ #_ #H destruct
+ |#M0 #M1 #N #_ #_ #H destruct
+ |#ty1 #M #M1 #_ #_ #H destruct
+ |#ty1 #M0 #H destruct
+ |#ty1 #N #N1 #v1 #v2 #Hred1 #_ #H destruct #_ %{N} %{N1} %{v1} %{v2} /3/
+ ]
+qed.
+
+lemma red_lambda: βO,D,ty,M,N.
+ red O D (Lambda O D ty M) N β
+ (βM1. red O D M M1 β§ N = (Lambda O D ty M1)) β¨
+ N = Vec O D ty (map ?? (Ξ»a. subst O D M 0 (to_T O D ty a))
+ (enum (FinSet_of_FType O D ty))).
+#O #D #ty #M #N #Hred inversion Hred
+ [#ty1 #M0 #N #Hc #H destruct
+ |#ty1 #v1 #a #M0 #_ #H destruct
+ |#M0 #M1 #N #_ #_ #H destruct
+ |#M0 #M1 #N #_ #_ #H destruct
+ |#ty1 #P #P1 #redP #_ #H #H1 destruct %1 %{P1} % //
+ |#ty1 #M0 #H destruct #_ %2 //
+ |#ty1 #N #N1 #v1 #v2 #Hred1 #_ #H destruct
+ ]
+qed.
+
+lemma red_val: βO,D,ty,a,N.
+ red O D (Val O D ty a) N β False.
+#O #D #ty #M #N #Hred inversion Hred
+ [#ty1 #M0 #N #Hc #H destruct
+ |#ty1 #v1 #a #M0 #_ #H destruct
+ |#M0 #M1 #N #_ #_ #H destruct
+ |#M0 #M1 #N #_ #_ #H destruct
+ |#ty1 #N1 #N2 #_ #_ #H destruct
+ |#ty1 #M0 #H destruct #_
+ |#ty1 #N #N1 #v1 #v2 #Hred1 #_ #H destruct
+ ]
+qed.
+
+lemma red_rel: βO,D,n,N.
+ red O D (Rel O D n) N β False.
+#O #D #n #N #Hred inversion Hred
+ [#ty1 #M0 #N #Hc #H destruct
+ |#ty1 #v1 #a #M0 #_ #H destruct
+ |#M0 #M1 #N #_ #_ #H destruct
+ |#M0 #M1 #N #_ #_ #H destruct
+ |#ty1 #N1 #N2 #_ #_ #H destruct
+ |#ty1 #M0 #H destruct #_
+ |#ty1 #N #N1 #v1 #v2 #Hred1 #_ #H destruct
+ ]
+qed.
+
+(*************************** multi step reduction *****************************)
+lemma star_red_appl: βO,D,M,M1,N. star ? (red O D) M M1 β
+ star ? (red O D) (App O D M N) (App O D M1 N).
+#O #D #M #N #N1 #H elim H //
+#P #Q #Hind #HPQ #Happ %1[|@Happ] @rappl @HPQ
+qed.
+
+lemma star_red_appr: βO,D,M,N,N1. star ? (red O D) N N1 β
+ star ? (red O D) (App O D M N) (App O D M N1).
+#O #D #M #N #N1 #H elim H //
+#P #Q #Hind #HPQ #Happ %1[|@Happ] @rappr @HPQ
+qed.
+
+lemma star_red_vec: βO,D,ty,N,N1,v1,v2. star ? (red O D) N N1 β
+ star ? (red O D) (Vec O D ty (v1@N::v2)) (Vec O D ty (v1@N1::v2)).
+#O #D #ty #N #N1 #v1 #v2 #H elim H //
+#P #Q #Hind #HPQ #Hvec %1[|@Hvec] @rvec @HPQ
+qed.
+
+lemma star_red_vec1: βO,D,ty,v1,v2,v. |v1| = |v2| β
+ (βn,M. n < |v1| β star ? (red O D) (nth n ? v1 M) (nth n ? v2 M)) β
+ star ? (red O D) (Vec O D ty (v@v1)) (Vec O D ty (v@v2)).
+#O #D #ty #v1 elim v1
+ [#v2 #v normalize #Hv2 >(lenght_to_nil β¦ (sym_eq β¦ Hv2)) normalize //
+ |#N1 #tl1 #Hind * [normalize #v #H destruct] #N2 #tl2 #v normalize #HS
+ #H @(trans_star β¦ (Vec O D ty (v@N2::tl1)))
+ [@star_red_vec @(H 0 N1) @le_S_S //
+ |>append_cons >(append_cons ??? tl2) @(Hind⦠(injective_S ⦠HS))
+ #n #M #H1 @(H (S n)) @le_S_S @H1
+ ]
+ ]
+qed.
+
+lemma star_red_vec2: βO,D,ty,v1,v2. |v1| = |v2| β
+ (βn,M. n < |v1| β star ? (red O D) (nth n ? v1 M) (nth n ? v2 M)) β
+ star ? (red O D) (Vec O D ty v1) (Vec O D ty v2).
+#O #D #ty #v1 #v2 @(star_red_vec1 β¦ [ ])
+qed.
+
+lemma star_red_lambda: βO,D,ty,N,N1. star ? (red O D) N N1 β
+ star ? (red O D) (Lambda O D ty N) (Lambda O D ty N1).
+#O #D #ty #N #N1 #H elim H //
+#P #Q #Hind #HPQ #Hlam %1[|@Hlam] @rlam @HPQ
+qed.
+
+(************************ reduction and substitution **************************)
+
+lemma red_star_subst : βO,D,M,N,N1,i.
+ star ? (red O D) N N1 β star ? (red O D) (subst O D M i N) (subst O D M i N1).
+#O #D #M #N #N1 #i #Hred lapply i -i @(T_elim β¦ M) normalize
+ [#o #a #i //
+ |#i #n cases (leb n i) normalize // cases (eqb n i) normalize //
+ |#P #Q #HindP #HindQ #n normalize
+ @(trans_star β¦ (App O D (subst O D P n N1) (subst O D Q n N)))
+ [@star_red_appl @HindP |@star_red_appr @HindQ]
+ |#ty #P #HindP #i @star_red_lambda @HindP
+ |#ty #v #Hindv #i @star_red_vec2 [>length_map >length_map //]
+ #j #Q inversion v [#_ normalize //] #a #tl #_ #Hv
+ cases (true_or_false (leb (S j) (|a::tl|))) #Hcase
+ [lapply (leb_true_to_le β¦ Hcase) -Hcase #Hcase
+ >(nth_map ?????? a Hcase) >(nth_map ?????? a Hcase) #_ @Hindv >Hv @mem_nth //
+ |>nth_to_default
+ [2:>length_map @le_S_S_to_le @not_le_to_lt @leb_false_to_not_le //]
+ >nth_to_default
+ [2:>length_map @le_S_S_to_le @not_le_to_lt @leb_false_to_not_le //] //
+ ]
+ ]
+qed.
+
+lemma red_star_subst2 : βO,D,M,M1,N,i. is_closed O D 0 N β
+ red O D M M1 β star ? (red O D) (subst O D M i N) (subst O D M1 i N).
+#O #D #M #M1 #N #i #HNc #Hred lapply i -i elim Hred
+ [#ty #P #Q #HQc #i normalize @starl_to_star @sstepl
+ [|@rbeta >(subst_closed β¦ HQc) //] >(subst_closed β¦ HQc) //
+ lapply (subst_lemma ?? P ?? i 0 (is_closed_mono β¦ HQc) HNc) //
+ <plus_n_Sm <plus_n_O #H <H //
+ |#ty #v #a #P #HP #i normalize >(subst_closed β¦ (le_O_n β¦)) //
+ @R_to_star @riota @assoc_map @HP
+ |#P #P1 #Q #Hred #Hind #i normalize @star_red_appl @Hind
+ |#P #P1 #Q #Hred #Hind #i normalize @star_red_appr @Hind
+ |#ty #P #P1 #Hred #Hind #i normalize @star_red_lambda @Hind
+ |#ty #P #i normalize @starl_to_star @sstepl [|@rmem]
+ @star_to_starl @star_red_vec2 [>length_map >length_map >length_map //]
+ #n #Q >length_map #H
+ cut (βa:(FinSet_of_FType O D ty).True)
+ [lapply H -H lapply (enum_complete (FinSet_of_FType O D ty))
+ cases (enum (FinSet_of_FType O D ty))
+ [#x normalize #H @False_ind @(absurd β¦ H) @lt_to_not_le //
+ |#x #l #_ #_ %{x} //
+ ]
+ ] * #a #_
+ >(nth_map ?????? a H) >(nth_map ?????? Q) [2:>length_map @H]
+ >(nth_map ?????? a H)
+ lapply (subst_lemma O D P (to_T O D ty
+ (nth n (FinSet_of_FType O D ty) (enum (FinSet_of_FType O D ty)) a))
+ N i 0 (is_closed_mono β¦ (is_closed_to_T β¦)) HNc) // <plus_n_O #H1 >H1
+ <plus_n_Sm <plus_n_O //
+ |#ty #P #Q #v #v1 #Hred #Hind #n normalize
+ <map_append <map_append @star_red_vec @Hind
+ ]
+qed.
+
+
+
+
+
--- /dev/null
+(*
+ ||M|| This file is part of HELM, an Hypertextual, Electronic
+ ||A|| Library of Mathematics, developed at the Computer Science
+ ||T|| Department of the University of Bologna, Italy.
+ ||I||
+ ||T||
+ ||A|| This file is distributed under the terms of the
+ \ / GNU General Public License Version 2
+ \ /
+ V_______________________________________________________________ *)
+
+include "basics/finset.ma".
+include "basics/star.ma".
+
+
+inductive FType (O:Type[0]): Type[0] β
+ | atom : O β FType O
+ | arrow : FType O β FType O β FType O.
+
+inductive T (O:Type[0]) (D:O β FinSet): Type[0] β
+ | Val: βo:O.carr (D o) β T O D (* a value in a finset *)
+ | Rel: nat β T O D (* DB index, base is 0 *)
+ | App: T O D β T O D β T O D (* function, argument *)
+ | Lambda: FType O β T O D β T O D (* type, body *)
+ | Vec: FType O β list (T O D) β T O D (* type, body *)
+.
+
+let rec FinSet_of_FType O (D:OβFinSet) (ty:FType O) on ty : FinSet β
+ match ty with
+ [atom o β D o
+ |arrow ty1 ty2 β FinFun (FinSet_of_FType O D ty1) (FinSet_of_FType O D ty2)
+ ].
+
+(* size *)
+
+let rec size O D (M:T O D) on M β
+match M with
+ [Val o a β 1
+ |Rel n β 1
+ |App P Q β size O D P + size O D Q + 1
+ |Lambda Ty P β size O D P + 1
+ |Vec Ty v β foldr ?? (Ξ»x,a. size O D x + a) 0 v +1
+ ]
+.
+
+(* axiom pos_size: βM. 1 β€ size M. *)
+
+theorem Telim_size: βO,D.βP: T O D β Prop.
+ (βM. (βN. size O D N < size O D M β P N) β P M) β βM. P M.
+#O #D #P #H #M (cut (βp,N. size O D N = p β P N))
+ [2: /2/]
+#p @(nat_elim1 p) #m #H1 #N #sizeN @H #N0 #Hlt @(H1 (size O D N0)) //
+qed.
+
+lemma T_elim:
+ βO: Type[0].βD:OβFinSet.βP:T O DβProp.
+ (βo:O.βx:D o.P (Val O D o x)) β
+ (βn:β.P(Rel O D n)) β
+ (βm,n:T O D.P mβP nβP (App O D m n)) β
+ (βTy:FType O.βm:T O D.P mβP(Lambda O D Ty m)) β
+ (βTy:FType O.βv:list (T O D).
+ (βx:T O D. mem ? x v β P x) β P(Vec O D Ty v)) β
+ βx:T O D.P x.
+#O #D #P #Hval #Hrel #Happ #Hlam #Hvec @Telim_size #x cases x //
+ [ (* app *) #m #n #Hind @Happ @Hind // /2 by le_minus_to_plus/
+ | (* lam *) #ty #m #Hind @Hlam @Hind normalize //
+ | (* vec *) #ty #v #Hind @Hvec #x lapply Hind elim v
+ [#Hind normalize *
+ |#hd #tl #Hind1 #Hind2 *
+ [#Hx >Hx @Hind2 normalize //
+ |@Hind1 #N #H @Hind2 @(lt_to_le_to_lt β¦ H) normalize //
+ ]
+ ]
+ ]
+qed.
+
+(* since we only consider beta reduction with closed arguments we could avoid
+lifting. We define it for the sake of generality *)
+
+(* arguments: k is the nesting depth (starts from 0), p is the lift
+let rec lift O D t k p on t β
+ match t with
+ [ Val o a β Val O D o a
+ | Rel n β if (leb k n) then Rel O D (n+p) else Rel O D n
+ | App m n β App O D (lift O D m k p) (lift O D n k p)
+ | Lambda Ty n β Lambda O D Ty (lift O D n (S k) p)
+ | Vec Ty v β Vec O D Ty (map ?? (Ξ»x. lift O D x k p) v)
+ ].
+
+notation "β ^ n ( M )" non associative with precedence 40 for @{'Lift 0 $n $M}.
+notation "β _ k ^ n ( M )" non associative with precedence 40 for @{'Lift $n $k $M}.
+
+interpretation "Lift" 'Lift n k M = (lift ?? M k n).
+
+let rec subst O D t k s on t β
+ match t with
+ [ Val o a β Val O D o a
+ | Rel n β if (leb k n) then
+ (if (eqb k n) then lift O D s 0 n else Rel O D (n-1))
+ else(Rel O D n)
+ | App m n β App O D (subst O D m k s) (subst O D n k s)
+ | Lambda T n β Lambda O D T (subst O D n (S k) s)
+ | Vec T v β Vec O D T (map ?? (Ξ»x. subst O D x k s) v)
+ ].
+*)
+
+(* simplified version of subst, assuming the argument s is closed *)
+
+let rec subst O D t k s on t β
+ match t with
+ [ Val o a β Val O D o a
+ | Rel n β if (leb k n) then
+ (if (eqb k n) then (* lift O D s 0 n*) s else Rel O D (n-1))
+ else(Rel O D n)
+ | App m n β App O D (subst O D m k s) (subst O D n k s)
+ | Lambda T n β Lambda O D T (subst O D n (S k) s)
+ | Vec T v β Vec O D T (map ?? (Ξ»x. subst O D x k s) v)
+ ].
+(* notation "hvbox(M break [ k β N ])"
+ non associative with precedence 90
+ for @{'Subst1 $M $k $N}. *)
+
+interpretation "Subst" 'Subst1 M k N = (subst M k N).
+
+(*
+lemma subst_rel1: βO,D,A.βk,i. i < k β
+ (Rel O D i) [k β A] = Rel O D i.
+#A #k #i normalize #ltik >(lt_to_leb_false β¦ ltik) //
+qed.
+
+lemma subst_rel2: βO,D, A.βk.
+ (Rel k) [k β A] = lift A 0 k.
+#A #k normalize >(le_to_leb_true k k) // >(eq_to_eqb_true β¦ (refl β¦)) //
+qed.
+
+lemma subst_rel3: βA.βk,i. k < i β
+ (Rel i) [k β A] = Rel (i-1).
+#A #k #i normalize #ltik >(le_to_leb_true k i) /2/
+>(not_eq_to_eqb_false k i) // @lt_to_not_eq //
+qed. *)
+
+
+(* closed terms ????
+let rec closed_k O D (t: T O D) k on t β
+ match t with
+ [ Val o a β True
+ | Rel n β n < k
+ | App m n β (closed_k O D m k) β§ (closed_k O D n k)
+ | Lambda T n β closed_k O D n (k+1)
+ | Vec T v β closed_list O D v k
+ ]
+
+and closed_list O D (l: list (T O D)) k on l β
+ match l with
+ [ nil β True
+ | cons hd tl β closed_k O D hd k β§ closed_list O D tl k
+ ]
+. *)
+
+inductive is_closed (O:Type[0]) (D:OβFinSet): nat β T O D β Prop β
+| cval : βk,o,a.is_closed O D k (Val O D o a)
+| crel : βk,n. n < k β is_closed O D k (Rel O D n)
+| capp : βk,m,n. is_closed O D k m β is_closed O D k n β
+ is_closed O D k (App O D m n)
+| clam : βT,k,m. is_closed O D (S k) m β is_closed O D k (Lambda O D T m)
+| cvec: βT,k,v. (βm. mem ? m v β is_closed O D k m) β
+ is_closed O D k (Vec O D T v).
+
+lemma is_closed_rel: βO,D,n,k.
+ is_closed O D k (Rel O D n) β n < k.
+#O #D #n #k #H inversion H
+ [#k0 #o #a #eqk #H destruct
+ |#k0 #n0 #ltn0 #eqk #H destruct //
+ |#k0 #M #N #_ #_ #_ #_ #_ #H destruct
+ |#T #k0 #M #_ #_ #_ #H destruct
+ |#T #k0 #v #_ #_ #_ #H destruct
+ ]
+qed.
+
+lemma is_closed_app: βO,D,k,M, N.
+ is_closed O D k (App O D M N) β is_closed O D k M β§ is_closed O D k N.
+#O #D #k #M #N #H inversion H
+ [#k0 #o #a #eqk #H destruct
+ |#k0 #n0 #ltn0 #eqk #H destruct
+ |#k0 #M1 #N1 #HM #HN #_ #_ #_ #H1 destruct % //
+ |#T #k0 #M #_ #_ #_ #H destruct
+ |#T #k0 #v #_ #_ #_ #H destruct
+ ]
+qed.
+
+lemma is_closed_lam: βO,D,k,ty,M.
+ is_closed O D k (Lambda O D ty M) β is_closed O D (S k) M.
+#O #D #k #ty #M #H inversion H
+ [#k0 #o #a #eqk #H destruct
+ |#k0 #n0 #ltn0 #eqk #H destruct
+ |#k0 #M1 #N1 #HM #HN #_ #_ #_ #H1 destruct
+ |#T #k0 #M1 #HM1 #_ #_ #H1 destruct //
+ |#T #k0 #v #_ #_ #_ #H destruct
+ ]
+qed.
+
+lemma is_closed_vec: βO,D,k,ty,v.
+ is_closed O D k (Vec O D ty v) β βm. mem ? m v β is_closed O D k m.
+#O #D #k #ty #M #H inversion H
+ [#k0 #o #a #eqk #H destruct
+ |#k0 #n0 #ltn0 #eqk #H destruct
+ |#k0 #M1 #N1 #HM #HN #_ #_ #_ #H1 destruct
+ |#T #k0 #M1 #HM1 #_ #_ #H1 destruct
+ |#T #k0 #v #Hv #_ #_ #H1 destruct @Hv
+ ]
+qed.
+
+lemma is_closed_S: βO,D,M,m.
+ is_closed O D m M β is_closed O D (S m) M.
+#O #D #M #m #H elim H //
+ [#k #n0 #Hlt @crel @le_S //
+ |#k #P #Q #HP #HC #H1 #H2 @capp //
+ |#ty #k #P #HP #H1 @clam //
+ |#ty #k #v #Hind #Hv @cvec @Hv
+ ]
+qed.
+
+lemma is_closed_mono: βO,D,M,m,n. m β€ n β
+ is_closed O D m M β is_closed O D n M.
+#O #D #M #m #n #lemn elim lemn // #i #j #H #H1 @is_closed_S @H @H1
+qed.
+
+
+(*** properties of lift and subst ***)
+
+(*
+lemma lift_0: βO,D.βt:T O D.βk. lift O D t k 0 = t.
+#O #D #t @(T_elim β¦ t) normalize //
+ [#n #k cases (leb k n) normalize //
+ |#o #v #Hind #k @eq_f lapply Hind -Hind elim v //
+ #hd #tl #Hind #Hind1 normalize @eq_f2
+ [@Hind1 %1 //|@Hind #x #Hx @Hind1 %2 //]
+ ]
+qed.
+
+lemma lift_closed: βO,D.βt:T O D.βk,p.
+ is_closed O D k t β lift O D t k p = t.
+#O #D #t @(T_elim β¦ t) normalize //
+ [#n #k #p #H >(not_le_to_leb_false β¦ (lt_to_not_le β¦ (is_closed_rel β¦ H))) //
+ |#M #N #HindM #HindN #k #p #H lapply (is_closed_app β¦ H) * #HcM #HcN
+ >(HindM β¦ HcM) >(HindN β¦ HcN) //
+ |#ty #M #HindM #k #p #H lapply (is_closed_lam β¦ H) -H #H >(HindM β¦ H) //
+ |#ty #v #HindM #k #p #H lapply (is_closed_vec β¦ H) -H #H @eq_f
+ cut (βm. mem ? m v β lift O D m k p = m)
+ [#m #Hmem @HindM [@Hmem | @H @Hmem]] -HindM
+ elim v // #a #tl #Hind #H1 normalize @eq_f2
+ [@H1 %1 //|@Hind #m #Hmem @H1 %2 @Hmem]
+ ]
+qed.
+
+*)
+
+lemma subst_closed: βO,D,M,N,k,i. k β€ i β
+ is_closed O D k M β subst O D M i N = M.
+#O #D #M @(T_elim β¦ M)
+ [#o #a normalize //
+ |#n #N #k #j #Hlt #Hc lapply (is_closed_rel β¦ Hc) #Hnk normalize
+ >not_le_to_leb_false [2:@lt_to_not_le @(lt_to_le_to_lt β¦ Hnk Hlt)] //
+ |#P #Q #HindP #HindQ #N #k #i #ltki #Hc lapply (is_closed_app β¦ Hc) *
+ #HcP #HcQ normalize >(HindP β¦ ltki HcP) >(HindQ β¦ ltki HcQ) //
+ |#ty #P #HindP #N #k #i #ltki #Hc lapply (is_closed_lam β¦ Hc)
+ #HcP normalize >(HindP β¦ HcP) // @le_S_S @ltki
+ |#ty #v #Hindv #N #k #i #ltki #Hc lapply (is_closed_vec β¦ Hc)
+ #Hcv normalize @eq_f
+ cut (βm:T O D.mem (T O D) m vβ subst O D m i N=m)
+ [#m #Hmem @(Hindv β¦ Hmem N β¦ ltki) @Hcv @Hmem]
+ elim v // #a #tl #Hind #H normalize @eq_f2
+ [@H %1 //| @Hind #Hmem #Htl @H %2 @Htl]
+ ]
+qed.
+
+lemma subst_lemma: βO,D,A,B,C,k,i. is_closed O D k B β is_closed O D i C β
+ subst O D (subst O D A i B) (k+i) C =
+ subst O D (subst O D A (k+S i) C) i B.
+#O #D #A #B #C #k @(T_elim β¦ A) normalize
+ [//
+ |#n #i #HBc #HCc @(leb_elim i n) #Hle
+ [@(eqb_elim i n) #eqni
+ [<eqni >(lt_to_leb_false (k+(S i)) i) // normalize
+ >(subst_closed β¦ HBc) // >le_to_leb_true // >eq_to_eqb_true //
+ |(cut (i < n))
+ [cases (le_to_or_lt_eq β¦ Hle) // #eqin @False_ind /2/] #ltin
+ (cut (0 < n)) [@(le_to_lt_to_lt β¦ ltin) //] #posn
+ normalize @(leb_elim (k+i) (n-1)) #nk
+ [@(eqb_elim (k+i) (n-1)) #H normalize
+ [cut (k+(S i) = n); [/2 by S_pred/] #H1
+ >(le_to_leb_true (k+(S i)) n) /2/
+ >(eq_to_eqb_true β¦ H1) normalize >(subst_closed β¦ HCc) //
+ |(cut (k+i < n-1)) [@not_eq_to_le_to_lt; //] #Hlt
+ >(le_to_leb_true (k+(S i)) n) normalize
+ [>(not_eq_to_eqb_false (k+(S i)) n) normalize
+ [>le_to_leb_true [2:@lt_to_le @(le_to_lt_to_lt β¦ Hlt) //]
+ >not_eq_to_eqb_false // @lt_to_not_eq @(le_to_lt_to_lt β¦ Hlt) //
+ |@(not_to_not β¦ H) #Hn /2 by plus_minus/
+ ]
+ |<plus_n_Sm @(lt_to_le_to_lt β¦ Hlt) //
+ ]
+ ]
+ |>(not_le_to_leb_false (k+(S i)) n) normalize
+ [>(le_to_leb_true β¦ Hle) >(not_eq_to_eqb_false β¦ eqni) //
+ |@(not_to_not β¦ nk) #H @le_plus_to_minus_r //
+ ]
+ ]
+ ]
+ |(cut (n < k+i)) [@(lt_to_le_to_lt ? i) /2 by not_le_to_lt/] #ltn
+ >not_le_to_leb_false [2: @lt_to_not_le @(transitive_lt β¦ltn) //] normalize
+ >not_le_to_leb_false [2: @lt_to_not_le //] normalize
+ >(not_le_to_leb_false β¦ Hle) //
+ ]
+ |#M #N #HindM #HindN #i #HBC #HCc @eq_f2 [@HindM // |@HindN //]
+ |#ty #M #HindM #i #HBC #HCc @eq_f >plus_n_Sm >plus_n_Sm @HindM //
+ @is_closed_S //
+ |#ty #v #Hindv #i #HBC #HCc @eq_f
+ cut (βm.mem ? m v β subst O D (subst O D m i B) (k+i) C =
+ subst O D (subst O D m (k+S i) C) i B)
+ [#m #Hmem @Hindv //] -Hindv elim v normalize [//]
+ #a #tl #Hind #H @eq_f2 [@H %1 // | @Hind #m #Hmem @H %2 //]
+ ]
+qed.
+
+
--- /dev/null
+(*
+ ||M|| This file is part of HELM, an Hypertextual, Electronic
+ ||A|| Library of Mathematics, developed at the Computer Science
+ ||T|| Department of the University of Bologna, Italy.
+ ||I||
+ ||T||
+ ||A|| This file is distributed under the terms of the
+ \ / GNU General Public License Version 2
+ \ /
+ V_______________________________________________________________ *)
+
+include "finite_lambda/reduction.ma".
+
+
+(****************************************************************)
+
+inductive TJ (O: Type[0]) (D:O β FinSet): list (FType O) β T O D β FType O β Prop β
+ | tval: βG,o,a. TJ O D G (Val O D o a) (atom O o)
+ | trel: βG1,ty,G2,n. length ? G1 = n β TJ O D (G1@ty::G2) (Rel O D n) ty
+ | tapp: βG,M,N,ty1,ty2. TJ O D G M (arrow O ty1 ty2) β TJ O D G N ty1 β
+ TJ O D G (App O D M N) ty2
+ | tlambda: βG,M,ty1,ty2. TJ O D (ty1::G) M ty2 β
+ TJ O D G (Lambda O D ty1 M) (arrow O ty1 ty2)
+ | tvec: βG,v,ty1,ty2.
+ (|v| = |enum (FinSet_of_FType O D ty1)|) β
+ (βM. mem ? M v β TJ O D G M ty2) β
+ TJ O D G (Vec O D ty1 v) (arrow O ty1 ty2).
+
+lemma wt_to_T: βO,D,G,ty,a.TJ O D G (to_T O D ty a) ty.
+#O #D #G #ty elim ty
+ [#o #a normalize @tval
+ |#ty1 #ty2 #Hind1 #Hind2 normalize * #v #Hv @tvec
+ [<Hv >length_map >length_map //
+ |#M elim v
+ [normalize @False_ind |#a #v1 #Hind3 * [#eqM >eqM @Hind2 |@Hind3]]
+ ]
+ ]
+qed.
+
+lemma inv_rel: βO,D,G,n,ty.
+ TJ O D G (Rel O D n) ty β βG1,G2.|G1|=nβ§G=G1@ty::G2.
+#O #D #G #n #ty #Hrel inversion Hrel
+ [#G1 #o #a #_ #H destruct
+ |#G1 #ty1 #G2 #n1 #H1 #H2 #H3 #H4 destruct %{G1} %{G2} /2/
+ |#G1 #M0 #N #ty1 #ty2 #_ #_ #_ #_ #_ #H destruct
+ |#G1 #M0 #ty4 #ty5 #HM0 #_ #_ #H #H1 destruct
+ |#G1 #v #ty3 #ty4 #_ #_ #_ #_ #H destruct
+ ]
+qed.
+
+lemma inv_tlambda: βO,D,G,M,ty1,ty2,ty3.
+ TJ O D G (Lambda O D ty1 M) (arrow O ty2 ty3) β
+ ty1 = ty2 β§ TJ O D (ty2::G) M ty3.
+#O #D #G #M #ty1 #ty2 #ty3 #Hlam inversion Hlam
+ [#G1 #o #a #_ #H destruct
+ |#G1 #ty #G2 #n #_ #_ #H destruct
+ |#G1 #M0 #N #ty1 #ty2 #_ #_ #_ #_ #_ #H destruct
+ |#G1 #M0 #ty4 #ty5 #HM0 #_ #_ #H #H1 destruct % //
+ |#G1 #v #ty3 #ty4 #_ #_ #_ #_ #H destruct
+ ]
+qed.
+
+lemma inv_tvec: βO,D,G,v,ty1,ty2,ty3.
+ TJ O D G (Vec O D ty1 v) (arrow O ty2 ty3) β
+ (|v| = |enum (FinSet_of_FType O D ty1)|) β§
+ (βM. mem ? M v β TJ O D G M ty3).
+#O #D #G #v #ty1 #ty2 #ty3 #Hvec inversion Hvec
+ [#G #o #a #_ #H destruct
+ |#G1 #ty #G2 #n #_ #_ #H destruct
+ |#G1 #M0 #N #ty1 #ty2 #_ #_ #_ #_ #_ #H destruct
+ |#G1 #M0 #ty4 #ty5 #HM0 #_ #_ #H #H1 destruct
+ |#G1 #v1 #ty4 #ty5 #Hv #Hmem #_ #_ #H #H1 destruct % // @Hmem
+ ]
+qed.
+
+(* could be generalized *)
+lemma weak_rel: βO,D,G1,G2,ty1,ty2,n. length ? G1 < n β
+ TJ O D (G1@G2) (Rel O D n) ty1 β
+ TJ O D (G1@ty2::G2) (Rel O D (S n)) ty1.
+#O #D #G1 #G2 #ty1 #ty2 #n #HG1 #Hrel lapply (inv_rel β¦ Hrel)
+* #G3 * #G4 * #H1 #H2 lapply (compare_append β¦ H2)
+* #G5 *
+ [* #H3 @False_ind >H3 in HG1; >length_append >H1 #H4
+ @(absurd β¦ H4) @le_to_not_lt //
+ |* #H3 #H4 >H4 >append_cons <associative_append @trel
+ >length_append >length_append <H1 >H3 >length_append normalize
+ >plus_n_Sm >associative_plus @eq_f //
+ ]
+qed.
+
+lemma strength_rel: βO,D,G1,G2,ty1,ty2,n. length ? G1 < n β
+ TJ O D (G1@ty2::G2) (Rel O D n) ty1 β
+ TJ O D (G1@G2) (Rel O D (n-1)) ty1.
+#O #D #G1 #G2 #ty1 #ty2 #n #HG1 #Hrel lapply (inv_rel β¦ Hrel)
+* #G3 * #G4 * #H1 #H2 lapply (compare_append β¦ H2)
+* #G5 *
+ [* #H3 @False_ind >H3 in HG1; >length_append >H1 #H4
+ @(absurd β¦ H4) @le_to_not_lt //
+ |lapply G5 -G5 *
+ [>append_nil normalize * #H3 #H4 destruct @False_ind @(absurd β¦ HG1)
+ @le_to_not_lt //
+ |#ty3 #G5 * #H3 normalize #H4 destruct (H4) <associative_append @trel
+ <H1 >H3 >length_append >length_append normalize <plus_minus_associative //
+ ]
+ ]
+qed.
+
+lemma no_matter: βO,D,G,N,tyN.
+ TJ O D G N tyN β βG1,G2,G3.G=G1@G2 β is_closed O D (|G1|) N β
+ TJ O D (G1@G3) N tyN.
+#O #D #G #N #tyN #HN elim HN -HN -tyN -N -G
+ [#G #o #a #G1 #G2 #G3 #_ #_ @tval
+ |#G #ty #G2 #n #HG #G3 #G4 #G5 #H #HNC normalize
+ lapply (is_closed_rel β¦ HNC) #Hlt lapply (compare_append β¦ H) * #G6 *
+ [* #H1 @False_ind @(absurd ? Hlt) @le_to_not_lt <HG >H1 >length_append //
+ |* cases G6
+ [>append_nil normalize #H1 @False_ind
+ @(absurd ? Hlt) @le_to_not_lt <HG >H1 //
+ |#ty1 #G7 #H1 normalize #H2 destruct >associative_append @trel //
+ ]
+ ]
+ |#G #M #N #ty1 #ty2 #HM #HN #HindM #HindN #G1 #G2 #G3
+ #Heq #Hc lapply (is_closed_app β¦ Hc) -Hc * #HMc #HNc
+ @(tapp β¦ (HindM β¦ Heq HMc) (HindN β¦ Heq HNc))
+ |#G #M #ty1 #ty2 #HM #HindM #G1 #G2 #G3 #Heq #Hc
+ lapply (is_closed_lam β¦ Hc) -Hc #HMc
+ @tlambda @(HindM (ty1::G1) G2) [>Heq // |@HMc]
+ |#G #v #ty1 #ty2 #Hlen #Hv #Hind #G1 #G2 #G3 #H1 #Hc @tvec
+ [>length_map //
+ |#M #Hmem @Hind // lapply (is_closed_vec β¦ Hc) #Hvc @Hvc //
+ ]
+ ]
+qed.
+
+lemma nth_spec: βA,a,d,l1,l2,n. |l1| = n β nth n A (l1@a::l2) d = a.
+#A #a #d #l1 elim l1 normalize
+ [#l2 #n #Hn <Hn //
+ |#b #tl #Hind #l2 #m #Hm <Hm normalize @Hind //
+ ]
+qed.
+
+lemma wt_subst_gen: βO,D,G,M,tyM.
+ TJ O D G M tyM β
+ βG1,G2,N,tyN.G=(G1@tyN::G2) β
+ TJ O D G2 N tyN β is_closed O D 0 N β
+ TJ O D (G1@G2) (subst O D M (|G1|) N) tyM.
+#O #D #G #M #tyM #HM elim HM -HM -tyM -M -G
+ [#G #o #a #G1 #G2 #N #tyN #_ #HG #_ normalize @tval
+ |#G #ty #G2 #n #Hlen #G21 #G22 #N #tyN #HG #HN #HNc
+ normalize cases (true_or_false (leb (|G21|) n))
+ [#H >H cases (le_to_or_lt_eq β¦ (leb_true_to_le β¦ H))
+ [#ltn >(not_eq_to_eqb_false β¦ (lt_to_not_eq β¦ ltn)) normalize
+ lapply (compare_append β¦ HG) * #G3 *
+ [* #HG1 #HG2 @(strength_rel β¦ tyN β¦ ltn) <HG @trel @Hlen
+ |* #HG >HG in ltn; >length_append #ltn @False_ind
+ @(absurd β¦ ltn) @le_to_not_lt >Hlen //
+ ]
+ |#HG21 >(eq_to_eqb_true β¦ HG21)
+ cut (ty = tyN)
+ [<(nth_spec ? ty ty ? G2 β¦ Hlen) >HG @nth_spec @HG21] #Hty >Hty
+ normalize <HG21 @(no_matter ????? HN []) //
+ ]
+ |#H >H normalize lapply (compare_append β¦ HG) * #G3 *
+ [* #H1 @False_ind @(absurd ? Hlen) @sym_not_eq @lt_to_not_eq >H1
+ >length_append @(lt_to_le_to_lt n (|G21|)) // @not_le_to_lt
+ @(leb_false_to_not_le β¦ H)
+ |cases G3
+ [>append_nil * #H1 @False_ind @(absurd ? Hlen) <H1 @sym_not_eq
+ @lt_to_not_eq @not_le_to_lt @(leb_false_to_not_le β¦ H)
+ |#ty2 #G4 * #H1 normalize #H2 destruct >associative_append @trel //
+ ]
+ ]
+ ]
+ |#G #M #N #ty1 #ty2 #HM #HN #HindM #HindN #G1 #G2 #N0 #tyN0 #eqG
+ #HN0 #Hc normalize @(tapp β¦ ty1)
+ [@(HindM β¦ eqG HN0 Hc) |@(HindN β¦ eqG HN0 Hc)]
+ |#G #M #ty1 #ty2 #HM #HindM #G1 #G2 #N0 #tyN0 #eqG
+ #HN0 #Hc normalize @(tlambda β¦ ty1) @(HindM (ty1::G1) β¦ HN0) // >eqG //
+ |#G #v #ty1 #ty2 #Hlen #Hv #Hind #G1 #G2 #N0 #tyN0 #eqG
+ #HN0 #Hc normalize @(tvec β¦ ty1)
+ [>length_map @Hlen
+ |#M #Hmem lapply (mem_map ????? Hmem) * #a * -Hmem #Hmem #eqM <eqM
+ @(Hind β¦ Hmem β¦ eqG HN0 Hc)
+ ]
+ ]
+qed.
+
+lemma wt_subst: βO,D,M,N,G,ty1,ty2.
+ TJ O D (ty1::G) M ty2 β
+ TJ O D G N ty1 β is_closed O D 0 N β
+ TJ O D G (subst O D M 0 N) ty2.
+#O #D #M #N #G #ty1 #ty2 #HM #HN #Hc @(wt_subst_gen β¦(ty1::G) β¦ [ ] β¦ HN) //
+qed.
+
+lemma subject_reduction: βO,D,M,M1,G,ty.
+ TJ O D G M ty β red O D M M1 β TJ O D G M1 ty.
+#O #D #M #M1 #G #ty #HM lapply M1 -M1 elim HM -HM -ty -G -M
+ [#G #o #a #M1 #Hval elim (red_val ????? Hval)
+ |#G #ty #G1 #n #_ #M1 #Hrel elim (red_rel ???? Hrel)
+ |#G #M #N #ty1 #ty2 #HM #HN #HindM #HindN #M1 #Hred inversion Hred
+ [#P #M0 #N0 #Hc #H1 destruct (H1) #HM1 @(wt_subst β¦ HN) //
+ @(proj2 β¦ (inv_tlambda β¦ HM))
+ |#ty #v #a #M0 #Ha #H1 #H2 destruct @(proj2 β¦ (inv_tvec β¦ HM))
+ @(assoc_to_mem β¦ Ha)
+ |#M2 #M3 #N0 #Hredl #_ #H1 destruct (H1) #eqM1 @(tapp β¦ HN) @HindM @Hredl
+ |#M2 #M3 #N0 #Hredr #_ #H1 destruct (H1) #eqM1 @(tapp β¦ HM) @HindN @Hredr
+ |#ty #N0 #N1 #_ #_ #H1 destruct (H1)
+ |#ty #M0 #H1 destruct (H1)
+ |#ty #N0 #N1 #v #v1 #_ #_ #H1 destruct (H1)
+ ]
+ |#G #P #ty1 #ty2 #HP #Hind #M1 #Hred lapply(red_lambda ????? Hred) *
+ [* #P1 * #HredP #HM1 >HM1 @tlambda @Hind //
+ |#HM1 >HM1 @tvec // #N #HN lapply(mem_map ????? HN)
+ * #a * #mema #eqN <eqN -eqN @(wt_subst β¦HP) // @wt_to_T
+ ]
+ |#G #v #ty1 #ty2 #Hlen #Hv #Hind #M1 #Hred lapply(red_vec ????? Hred)
+ * #N * #N1 * #v1 * #v2 * * #H1 #H2 #H3 >H3 @tvec
+ [<Hlen >H2 >length_append >length_append @eq_f //
+ |#M2 #Hmem cases (mem_append ???? Hmem) -Hmem #Hmem
+ [@Hv >H2 @mem_append_l1 //
+ |cases Hmem
+ [#HM2 >HM2 -HM2 @(Hind N β¦ H1) >H2 @mem_append_l2 %1 //
+ |-Hmem #Hmem @Hv >H2 @mem_append_l2 %2 //
+ ]
+ ]
+ ]
+ ]
+qed.
+
--- /dev/null
+
+include "arithmetics/nat.ma".
+include "basics/sets.ma".
+
+(******************************** big O notation ******************************)
+
+(* O f g means g β O(f) *)
+definition O: relation (natβnat) β
+ Ξ»f,g. βc.βn0.βn. n0 β€ n β g n β€ c* (f n).
+
+lemma O_refl: βs. O s s.
+#s %{1} %{0} #n #_ >commutative_times <times_n_1 @le_n qed.
+
+lemma O_trans: βs1,s2,s3. O s2 s1 β O s3 s2 β O s3 s1.
+#s1 #s2 #s3 * #c1 * #n1 #H1 * #c2 * # n2 #H2 %{(c1*c2)}
+%{(max n1 n2)} #n #Hmax
+@(transitive_le β¦ (H1 ??)) [@(le_maxl β¦ Hmax)]
+>associative_times @le_times [//|@H2 @(le_maxr β¦ Hmax)]
+qed.
+
+lemma sub_O_to_O: βs1,s2. O s1 β O s2 β O s2 s1.
+#s1 #s2 #H @H // qed.
+
+lemma O_to_sub_O: βs1,s2. O s2 s1 β O s1 β O s2.
+#s1 #s2 #H #g #Hg @(O_trans β¦ H) // qed.
+
+lemma le_to_O: βs1,s2. (βx.s1 x β€ s2 x) β O s2 s1.
+#s1 #s2 #Hle %{1} %{0} #n #_ normalize <plus_n_O @Hle
+qed.
+
+definition sum_f β Ξ»f,g:natβnat.Ξ»n.f n + g n.
+interpretation "function sum" 'plus f g = (sum_f f g).
+
+lemma O_plus: βf,g,s. O s f β O s g β O s (f+g).
+#f #g #s * #cf * #nf #Hf * #cg * #ng #Hg
+%{(cf+cg)} %{(max nf ng)} #n #Hmax normalize
+>distributive_times_plus_r @le_plus
+ [@Hf @(le_maxl β¦ Hmax) |@Hg @(le_maxr β¦ Hmax) ]
+qed.
+
+lemma O_plus_l: βf,s1,s2. O s1 f β O (s1+s2) f.
+#f #s1 #s2 * #c * #a #Os1f %{c} %{a} #n #lean
+@(transitive_le β¦ (Os1f n lean)) @le_times //
+qed.
+
+lemma O_plus_r: βf,s1,s2. O s2 f β O (s1+s2) f.
+#f #s1 #s2 * #c * #a #Os1f %{c} %{a} #n #lean
+@(transitive_le β¦ (Os1f n lean)) @le_times //
+qed.
+
+lemma O_absorbl: βf,g,s. O s f β O f g β O s (g+f).
+#f #g #s #Osf #Ofg @(O_plus β¦ Osf) @(O_trans β¦ Osf) //
+qed.
+
+lemma O_absorbr: βf,g,s. O s f β O f g β O s (f+g).
+#f #g #s #Osf #Ofg @(O_plus β¦ Osf) @(O_trans β¦ Osf) //
+qed.
+
+lemma O_times_c: βf,c. O f (Ξ»x:β.c*f x).
+#f #c %{c} %{0} //
+qed.
+
+lemma O_ext2: βf,g,s. O s f β (βx.f x = g x) β O s g.
+#f #g #s * #c * #a #Osf #eqfg %{c} %{a} #n #lean <eqfg @Osf //
+qed.
+
+
+definition not_O β Ξ»f,g.βc,n0.βn. n0 β€ n β§ c* (f n) < g n .
+
+(* this is the only classical result *)
+axiom not_O_def: βf,g. Β¬ O f g β not_O f g.
+
+(******************************* small O notation *****************************)
+
+(* o f g means g β o(f) *)
+definition o: relation (natβnat) β
+ Ξ»f,g.βc.βn0.βn. n0 β€ n β c * (g n) < f n.
+
+lemma o_irrefl: βs. Β¬ o s s.
+#s % #oss cases (oss 1) #n0 #H @(absurd ? (le_n (s n0)))
+@lt_to_not_le >(times_n_1 (s n0)) in β’ (?%?); >commutative_times @H //
+qed.
+
+lemma o_trans: βs1,s2,s3. o s2 s1 β o s3 s2 β o s3 s1.
+#s1 #s2 #s3 #H1 #H2 #c cases (H1 c) #n1 -H1 #H1 cases (H2 1) #n2 -H2 #H2
+%{(max n1 n2)} #n #Hmax
+@(transitive_lt β¦ (H1 ??)) [@(le_maxl β¦ Hmax)]
+>(times_n_1 (s2 n)) in β’ (?%?); >commutative_times @H2 @(le_maxr β¦ Hmax)
+qed.
--- /dev/null
+
+include "arithmetics/minimization.ma".
+include "arithmetics/bigops.ma".
+include "arithmetics/pidgeon_hole.ma".
+include "arithmetics/iteration.ma".
+
+(************************** notation for miminimization ***********************)
+
+(* an alternative defintion of minimization
+definition Min β Ξ»a,f.
+ \big[min,a]_{i < a | f i} i. *)
+
+notation "ΞΌ_{ ident i < n } p"
+ with precedence 80 for @{min $n 0 (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β€ n } p"
+ with precedence 80 for @{min (S $n) 0 (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β [a,b] } p"
+ with precedence 80 for @{min (S $b-$a) $a (Ξ»${ident i}.$p)}.
+
+lemma f_min_true: βf,a,b.
+ (βi. a β€ i β§ i β€ b β§ f i = true) β f (ΞΌ_{i β[a,b]} (f i)) = true.
+#f #a #b * #i * * #Hil #Hir #Hfi @(f_min_true β¦ (Ξ»x. f x)) <plus_minus_m_m
+ [%{i} % // % [@Hil |@le_S_S @Hir]|@le_S @(transitive_le β¦ Hil Hir)]
+qed.
+
+lemma min_up: βf,a,b.
+ (βi. a β€ i β§ i β€ b β§ f i = true) β ΞΌ_{i β[a,b]}(f i) β€ b.
+#f #a #b * #i * * #Hil #Hir #Hfi @le_S_S_to_le
+cut ((S b) = S b - a + a) [@plus_minus_m_m @le_S @(transitive_le β¦ Hil Hir)]
+#Hcut >Hcut in β’ (??%); @lt_min %{i} % // % [@Hil |<Hcut @le_S_S @Hir]
+qed.
+
+(*************************** Kleene's predicate *******************************)
+
+axiom U: nat β nat βnat β option nat.
+
+axiom monotonic_U: βi,x,n,m,y.n β€m β
+ U i x n = Some ? y β U i x m = Some ? y.
+
+lemma unique_U: βi,x,n,m,yn,ym.
+ U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
+#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
+ [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
+ |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
+ >Hn #HS destruct (HS) //
+ ]
+qed.
+
+definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
+
+notation "β©i,xβͺ β r" with precedence 60 for @{terminate $i $x $r}.
+
+lemma terminate_dec: βi,x,n. β©i,xβͺ β n β¨ Β¬ β©i,xβͺ β n.
+#i #x #n normalize cases (U i x n)
+ [%2 % * #y #H destruct|#y %1 %{y} //]
+qed.
+
+definition termb β Ξ»i,x,t.
+ match U i x t with [None β false |Some y β true].
+
+lemma termb_true_to_term: βi,x,t. termb i x t = true β β©i,xβͺ β t.
+#i #x #t normalize cases (U i x t) normalize [#H destruct | #y #_ %{y} //]
+qed.
+
+lemma term_to_termb_true: βi,x,t. β©i,xβͺ β t β termb i x t = true.
+#i #x #t * #y #H normalize >H //
+qed.
+
+lemma decidable_test : βn,x,r,r1.
+ (βi. i < n β β©i,xβͺ β r β¨ Β¬ β©i,xβͺ β r1) β¨
+ (βi. i < n β§ (Β¬ β©i,xβͺ β r β§ β©i,xβͺ β r1)).
+#n #x #r1 #r2
+ cut (βi0.decidable ((β©i0,xβͺβr1) β¨ Β¬ β©i0,xβͺ β r2))
+ [#j @decidable_or [@terminate_dec |@decidable_not @terminate_dec ]] #Hdec
+ cases(decidable_forall ? Hdec n)
+ [#H %1 @H
+ |#H %2 cases (not_forall_to_exists β¦ Hdec H) #j * #leji #Hj
+ %{j} % // %
+ [@(not_to_not β¦ Hj) #H %1 @H
+ |cases (terminate_dec j x r2) // #H @False_ind cases Hj -Hj #Hj
+ @Hj %2 @H
+ ]
+qed.
+
+(**************************** the gap theorem *********************************)
+definition gapP β Ξ»n,x,g,r. βi. i < n β β©i,xβͺ β r β¨ Β¬ β©i,xβͺ β g r.
+
+lemma gapP_def : βn,x,g,r.
+ gapP n x g r = βi. i < n β β©i,xβͺ β r β¨ Β¬ β©i,xβͺ β g r.
+// qed.
+
+lemma upper_bound_aux: βg,b,n,x. (βx. x β€ g x) β βk.
+ (βj.j < k β§
+ (βi. i < n β β©i,xβͺ β g^j b β¨ Β¬ β©i,xβͺ β g^(S j) b)) β¨
+ βl. |l| = k β§ unique ? l β§ βi. i β l β i < n β§ β©i,xβͺ β g^k b .
+#g#b #n #x #Hg #k elim k
+ [%2 %{([])} normalize % [% //|#x @False_ind]
+ |#k0 *
+ [* #j * #lej #H %1 %{j} % [@le_S // | @H ]
+ |* #l * * #Hlen #Hunique #Hterm
+ cases (decidable_test n x (g^k0 b) (g^(S k0) b))
+ [#Hcase %1 %{k0} % [@le_n | @Hcase]
+ |* #j * #ltjn * #H1 #H2 %2
+ %{(j::l)} %
+ [ % [normalize @eq_f @Hlen] whd % // % #H3
+ @(absurd ?? H1) @(proj2 β¦ (Hterm β¦)) @H3
+ |#x *
+ [#eqxj >eqxj % //
+ |#Hmemx cases(Hterm β¦ Hmemx) #lexn * #y #HU
+ % [@lexn] %{y} @(monotonic_U ?????? HU) @Hg
+ ]
+ ]
+ ]
+ ]
+ ]
+qed.
+
+lemma upper_bound: βg,b,n,x. (βx. x β€ g x) β βr.
+ (* b β€ r β§ r β€ g^n b β§ βi. i < n β β©i,xβͺ β r β¨ Β¬ β©i,xβͺ β g r. *)
+ b β€ r β§ r β€ g^n b β§ gapP n x g r.
+#g #b #n #x #Hg
+cases (upper_bound_aux g b n x Hg n)
+ [* #j * #Hj #H %{(g^j b)} % [2: @H] % [@le_iter //]
+ @monotonic_iter2 // @lt_to_le //
+ |* #l * * #Hlen #Hunique #Hterm %{(g^n b)} %
+ [% [@le_iter // |@le_n]]
+ #i #lein %1 @(proj2 β¦ (Hterm ??))
+ @(eq_length_to_mem_all β¦ Hlen Hunique β¦ lein)
+ #x #memx @(proj1 β¦ (Hterm ??)) //
+ ]
+qed.
+
+definition gapb β Ξ»n,x,g,r.
+ \big[andb,true]_{i < n} ((termb i x r) β¨ Β¬(termb i x (g r))).
+
+lemma gapb_def : βn,x,g,r. gapb n x g r =
+ \big[andb,true]_{i < n} ((termb i x r) β¨ Β¬(termb i x (g r))).
+// qed.
+
+lemma gapb_true_to_gapP : βn,x,g,r.
+ gapb n x g r = true β βi. i < n β β©i,xβͺ β r β¨ Β¬(β©i,xβͺ β (g r)).
+#n #x #g #r elim n
+ [>gapb_def >bigop_Strue //
+ #H #i #lti0 @False_ind @(absurd β¦ lti0) @le_to_not_lt //
+ |#m #Hind >gapb_def >bigop_Strue //
+ #H #i #leSm cases (le_to_or_lt_eq β¦ leSm)
+ [#lem @Hind [@(andb_true_r β¦ H)|@le_S_S_to_le @lem]
+ |#eqi >(injective_S β¦ eqi) lapply (andb_true_l β¦ H) -H #H cases (orb_true_l β¦ H) -H
+ [#H %1 @termb_true_to_term //
+ |#H %2 % #H1 >(term_to_termb_true β¦ H1) in H; normalize #H destruct
+ ]
+ ]
+ ]
+qed.
+
+lemma gapP_to_gapb_true : βn,x,g,r.
+ (βi. i < n β β©i,xβͺ β r β¨ Β¬(β©i,xβͺ β (g r))) β gapb n x g r = true.
+#n #x #g #r elim n //
+#m #Hind #H >gapb_def >bigop_Strue // @true_to_andb_true
+ [cases (H m (le_n β¦))
+ [#H2 @orb_true_r1 @term_to_termb_true //
+ |#H2 @orb_true_r2 @sym_eq @noteq_to_eqnot @sym_not_eq
+ @(not_to_not β¦ H2) @termb_true_to_term
+ ]
+ |@Hind #i0 #lei0 @H @le_S //
+ ]
+qed.
+
+
+(* the gap function *)
+let rec gap g n on n β
+ match n with
+ [ O β 1
+ | S m β let b β gap g m in ΞΌ_{i β [b,g^n b]} (gapb n n g i)
+ ].
+
+lemma gapS: βg,m.
+ gap g (S m) =
+ (let b β gap g m in
+ ΞΌ_{i β [b,g^(S m) b]} (gapb (S m) (S m) g i)).
+// qed.
+
+lemma upper_bound_gapb: βg,m. (βx. x β€ g x) β
+ βr:β.gap g m β€ r β§ r β€ g^(S m) (gap g m) β§ gapb (S m) (S m) g r = true.
+#g #m #leg
+lapply (upper_bound g (gap g m) (S m) (S m) leg) * #r * *
+#H1 #H2 #H3 %{r} %
+ [% // |@gapP_to_gapb_true @H3]
+qed.
+
+lemma gapS_true: βg,m. (βx. x β€g x) β gapb (S m) (S m) g (gap g (S m)) = true.
+#g #m #leg @(f_min_true (gapb (S m) (S m) g)) @upper_bound_gapb //
+qed.
+
+theorem gap_theorem: βg,i.(βx. x β€ g x)ββk.βn.k < n β
+ β©i,nβͺ β (gap g n) β¨ Β¬ β©i,nβͺ β (g (gap g n)).
+#g #i #leg %{i} *
+ [#lti0 @False_ind @(absurd ?? (not_le_Sn_O i) ) //
+ |#m #leim lapply (gapS_true g m leg) #H
+ @(gapb_true_to_gapP β¦ H) //
+ ]
+qed.
+
+(* an upper bound *)
+
+let rec sigma n β
+ match n with
+ [ O β 0 | S m β n + sigma m ].
+
+lemma gap_bound: βg. (βx. x β€ g x) β (monotonic ? le g) β
+ βn.gap g n β€ g^(sigma n) 1.
+#g #leg #gmono #n elim n
+ [normalize //
+ |#m #Hind >gapS @(transitive_le ? (g^(S m) (gap g m)))
+ [@min_up @upper_bound_gapb //
+ |@(transitive_le ? (g^(S m) (g^(sigma m) 1)))
+ [@monotonic_iter // |>iter_iter >commutative_plus @le_n
+ ]
+ ]
+qed.
+
+lemma gap_bound2: βg. (βx. x β€ g x) β (monotonic ? le g) β
+ βn.gap g n β€ g^(n*n) 1.
+#g #leg #gmono #n elim n
+ [normalize //
+ |#m #Hind >gapS @(transitive_le ? (g^(S m) (gap g m)))
+ [@min_up @upper_bound_gapb //
+ |@(transitive_le ? (g^(S m) (g^(m*m) 1)))
+ [@monotonic_iter //
+ |>iter_iter @monotonic_iter2 [@leg | normalize <plus_n_Sm @le_S_S //
+ ]
+ ]
+qed.
+
+(*
+axiom universal: βu.βi,x,y.
+ βn. U u β©i,xβͺ n = Some y β βm.U i x m = Some y. *)
+
+
+
+
+
+
+
+
+
+
+
+
--- /dev/null
+
+include "arithmetics/nat.ma".
+include "arithmetics/log.ma".
+(* include "arithmetics/ord.ma". *)
+include "arithmetics/bigops.ma".
+include "arithmetics/bounded_quantifiers.ma".
+include "arithmetics/pidgeon_hole.ma".
+include "basics/sets.ma".
+include "basics/types.ma".
+
+(************************************ MAX *************************************)
+notation "Max_{ ident i < n | p } f"
+ with precedence 80
+for @{'bigop $n max 0 (Ξ»${ident i}. $p) (Ξ»${ident i}. $f)}.
+
+notation "Max_{ ident i < n } f"
+ with precedence 80
+for @{'bigop $n max 0 (Ξ»${ident i}.true) (Ξ»${ident i}. $f)}.
+
+notation "Max_{ ident j β [a,b[ } f"
+ with precedence 80
+for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.true) (${ident j}+$a)))
+ (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
+
+notation "Max_{ ident j β [a,b[ | p } f"
+ with precedence 80
+for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.$p) (${ident j}+$a)))
+ (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
+
+lemma Max_assoc: βa,b,c. max (max a b) c = max a (max b c).
+#a #b #c normalize cases (true_or_false (leb a b)) #leab >leab normalize
+ [cases (true_or_false (leb b c )) #lebc >lebc normalize
+ [>(le_to_leb_true a c) // @(transitive_le ? b) @leb_true_to_le //
+ |>leab //
+ ]
+ |cases (true_or_false (leb b c )) #lebc >lebc normalize //
+ >leab normalize >(not_le_to_leb_false a c) // @lt_to_not_le
+ @(transitive_lt ? b) @not_le_to_lt @leb_false_to_not_le //
+ ]
+qed.
+
+lemma Max0 : βn. max 0 n = n.
+// qed.
+
+lemma Max0r : βn. max n 0 = n.
+#n >commutative_max //
+qed.
+
+definition MaxA β
+ mk_Aop nat 0 max Max0 Max0r (Ξ»a,b,c.sym_eq β¦ (Max_assoc a b c)).
+
+definition MaxAC β mk_ACop nat 0 MaxA commutative_max.
+
+lemma le_Max: βf,p,n,a. a < n β p a = true β
+ f a β€ Max_{i < n | p i}(f i).
+#f #p #n #a #ltan #pa
+>(bigop_diff p ? 0 MaxAC f a n) // @(le_maxl β¦ (le_n ?))
+qed.
+
+lemma Max_le: βf,p,n,b.
+ (βa.a < n β p a = true β f a β€ b) β Max_{i < n | p i}(f i) β€ b.
+#f #p #n elim n #b #H //
+#b0 #H1 cases (true_or_false (p b)) #Hb
+ [>bigop_Strue [2:@Hb] @to_max [@H1 // | @H #a #ltab #pa @H1 // @le_S //]
+ |>bigop_Sfalse [2:@Hb] @H #a #ltab #pa @H1 // @le_S //
+ ]
+qed.
+
+(******************************** big O notation ******************************)
+
+(* O f g means g β O(f) *)
+definition O: relation (natβnat) β
+ Ξ»f,g. βc.βn0.βn. n0 β€ n β g n β€ c* (f n).
+
+lemma O_refl: βs. O s s.
+#s %{1} %{0} #n #_ >commutative_times <times_n_1 @le_n qed.
+
+lemma O_trans: βs1,s2,s3. O s2 s1 β O s3 s2 β O s3 s1.
+#s1 #s2 #s3 * #c1 * #n1 #H1 * #c2 * # n2 #H2 %{(c1*c2)}
+%{(max n1 n2)} #n #Hmax
+@(transitive_le β¦ (H1 ??)) [@(le_maxl β¦ Hmax)]
+>associative_times @le_times [//|@H2 @(le_maxr β¦ Hmax)]
+qed.
+
+lemma sub_O_to_O: βs1,s2. O s1 β O s2 β O s2 s1.
+#s1 #s2 #H @H // qed.
+
+lemma O_to_sub_O: βs1,s2. O s2 s1 β O s1 β O s2.
+#s1 #s2 #H #g #Hg @(O_trans β¦ H) // qed.
+
+definition sum_f β Ξ»f,g:natβnat.Ξ»n.f n + g n.
+interpretation "function sum" 'plus f g = (sum_f f g).
+
+lemma O_plus: βf,g,s. O s f β O s g β O s (f+g).
+#f #g #s * #cf * #nf #Hf * #cg * #ng #Hg
+%{(cf+cg)} %{(max nf ng)} #n #Hmax normalize
+>distributive_times_plus_r @le_plus
+ [@Hf @(le_maxl β¦ Hmax) |@Hg @(le_maxr β¦ Hmax) ]
+qed.
+
+lemma O_plus_l: βf,s1,s2. O s1 f β O (s1+s2) f.
+#f #s1 #s2 * #c * #a #Os1f %{c} %{a} #n #lean
+@(transitive_le β¦ (Os1f n lean)) @le_times //
+qed.
+
+lemma O_plus_r: βf,s1,s2. O s2 f β O (s1+s2) f.
+#f #s1 #s2 * #c * #a #Os1f %{c} %{a} #n #lean
+@(transitive_le β¦ (Os1f n lean)) @le_times //
+qed.
+
+lemma O_absorbl: βf,g,s. O s f β O f g β O s (g+f).
+#f #g #s #Osf #Ofg @(O_plus β¦ Osf) @(O_trans β¦ Osf) //
+qed.
+
+lemma O_absorbr: βf,g,s. O s f β O f g β O s (f+g).
+#f #g #s #Osf #Ofg @(O_plus β¦ Osf) @(O_trans β¦ Osf) //
+qed.
+
+(*
+lemma O_ff: βf,s. O s f β O s (f+f).
+#f #s #Osf /2/
+qed. *)
+
+lemma O_ext2: βf,g,s. O s f β (βx.f x = g x) β O s g.
+#f #g #s * #c * #a #Osf #eqfg %{c} %{a} #n #lean <eqfg @Osf //
+qed.
+
+
+definition not_O β Ξ»f,g.βc,n0.βn. n0 β€ n β§ c* (f n) < g n .
+
+(* this is the only classical result *)
+axiom not_O_def: βf,g. Β¬ O f g β not_O f g.
+
+(******************************* small O notation *****************************)
+
+(* o f g means g β o(f) *)
+definition o: relation (natβnat) β
+ Ξ»f,g.βc.βn0.βn. n0 β€ n β c * (g n) < f n.
+
+lemma o_irrefl: βs. Β¬ o s s.
+#s % #oss cases (oss 1) #n0 #H @(absurd ? (le_n (s n0)))
+@lt_to_not_le >(times_n_1 (s n0)) in β’ (?%?); >commutative_times @H //
+qed.
+
+lemma o_trans: βs1,s2,s3. o s2 s1 β o s3 s2 β o s3 s1.
+#s1 #s2 #s3 #H1 #H2 #c cases (H1 c) #n1 -H1 #H1 cases (H2 1) #n2 -H2 #H2
+%{(max n1 n2)} #n #Hmax
+@(transitive_lt β¦ (H1 ??)) [@(le_maxl β¦ Hmax)]
+>(times_n_1 (s2 n)) in β’ (?%?); >commutative_times @H2 @(le_maxr β¦ Hmax)
+qed.
+
+
+(*********************************** pairing **********************************)
+
+axiom pair: nat βnat βnat.
+axiom fst : nat β nat.
+axiom snd : nat β nat.
+axiom fst_pair: βa,b. fst (pair a b) = a.
+axiom snd_pair: βa,b. snd (pair a b) = b.
+
+interpretation "abstract pair" 'pair f g = (pair f g).
+
+(************************ basic complexity notions ****************************)
+
+(* u is the deterministic configuration relation of the universal machine (one
+ step)
+
+axiom u: nat β option nat.
+
+let rec U c n on n β
+ match n with
+ [ O β None ?
+ | S m β match u c with
+ [ None β Some ? c (* halting case *)
+ | Some c1 β U c1 m
+ ]
+ ].
+
+lemma halt_U: βi,n,y. u i = None ? β U i n = Some ? y β y = i.
+#i #n #y #H cases n
+ [normalize #H1 destruct |#m normalize >H normalize #H1 destruct //]
+qed.
+
+lemma Some_to_halt: βn,i,y. U i n = Some ? y β u y = None ? .
+#n elim n
+ [#i #y normalize #H destruct (H)
+ |#m #Hind #i #y normalize
+ cut (u i = None ? β¨ βc. u i = Some ? c)
+ [cases (u i) [/2/ | #c %2 /2/ ]]
+ *[#H >H normalize #H1 destruct (H1) // |* #c #H >H normalize @Hind ]
+ ]
+qed. *)
+
+axiom U: nat β nat β nat β option nat.
+(*
+lemma monotonici_U: βy,n,m,i.
+ U i m = Some ? y β U i (n+m) = Some ? y.
+#y #n #m elim m
+ [#i normalize #H destruct
+ |#p #Hind #i <plus_n_Sm normalize
+ cut (u i = None ? β¨ βc. u i = Some ? c)
+ [cases (u i) [/2/ | #c %2 /2/ ]]
+ *[#H1 >H1 normalize // |* #c #H >H normalize #H1 @Hind //]
+ ]
+qed. *)
+
+axiom monotonic_U: βi,x,n,m,y.n β€m β
+ U i x n = Some ? y β U i x m = Some ? y.
+(* #i #n #m #y #lenm #H >(plus_minus_m_m m n) // @monotonici_U //
+qed. *)
+
+(* axiom U: nat β nat β option nat. *)
+(* axiom monotonic_U: βi,n,m,y.n β€m β
+ U i n = Some ? y β U i m = Some ? y. *)
+
+lemma unique_U: βi,x,n,m,yn,ym.
+ U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
+#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
+ [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
+ |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
+ >Hn #HS destruct (HS) //
+ ]
+qed.
+
+definition code_for β Ξ»f,i.βx.
+ βn.βm. n β€ m β U i x m = f x.
+
+definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
+notation "[i,x] β r" with precedence 60 for @{terminate $i $x $r}.
+
+definition lang β Ξ»i,x.βr,y. U i x r = Some ? y β§ 0 < y.
+
+lemma lang_cf :βf,i,x. code_for f i β
+ lang i x β βy.f x = Some ? y β§ 0 < y.
+#f #i #x normalize #H %
+ [* #n * #y * #H1 #posy %{y} % //
+ cases (H x) -H #m #H <(H (max n m)) [2:@(le_maxr β¦ n) //]
+ @(monotonic_U β¦ H1) @(le_maxl β¦ m) //
+ |cases (H x) -H #m #Hm * #y #Hy %{m} %{y} >Hm //
+ ]
+qed.
+
+(******************************* complexity classes ***************************)
+
+axiom size: nat β nat.
+axiom of_size: nat β nat.
+
+interpretation "size" 'card n = (size n).
+
+axiom size_of_size: βn. |of_size n| = n.
+axiom monotonic_size: monotonic ? le size.
+
+axiom of_size_max: βi,n. |i| = n β i β€ of_size n.
+
+axiom size_fst : βn. |fst n| β€ |n|.
+
+definition size_f β Ξ»f,n.Max_{i < S (of_size n) | eqb (|i|) n}|(f i)|.
+
+lemma size_f_def: βf,n. size_f f n =
+ Max_{i < S (of_size n) | eqb (|i|) n}|(f i)|.
+// qed.
+
+(*
+definition Max_const : βf,p,n,a. a < n β p a β
+ βn. f n = g n β
+ Max_{i < n | p n}(f n) = *)
+
+lemma size_f_size : βf,n. size_f (f β size) n = |(f n)|.
+#f #n @le_to_le_to_eq
+ [@Max_le #a #lta #Ha normalize >(eqb_true_to_eq β¦ Ha) //
+ |<(size_of_size n) in β’ (?%?); >size_f_def
+ @(le_Max (Ξ»i.|f (|i|)|) ? (S (of_size n)) (of_size n) ??)
+ [@le_S_S // | @eq_to_eqb_true //]
+ ]
+qed.
+
+lemma size_f_id : βn. size_f (Ξ»x.x) n = n.
+#n @le_to_le_to_eq
+ [@Max_le #a #lta #Ha >(eqb_true_to_eq β¦ Ha) //
+ |<(size_of_size n) in β’ (?%?); >size_f_def
+ @(le_Max (Ξ»i.|i|) ? (S (of_size n)) (of_size n) ??)
+ [@le_S_S // | @eq_to_eqb_true //]
+ ]
+qed.
+
+lemma size_f_fst : βn. size_f fst n β€ n.
+#n @Max_le #a #lta #Ha <(eqb_true_to_eq β¦ Ha) //
+qed.
+
+(* definition def β Ξ»f:nat β option nat.Ξ»x.βy. f x = Some ? y.*)
+
+(* C s i means that the complexity of i is O(s) *)
+
+definition C β Ξ»s,i.βc.βa.βx.a β€ |x| β βy.
+ U i x (c*(s(|x|))) = Some ? y.
+
+definition CF β Ξ»s,f.βi.code_for f i β§ C s i.
+
+lemma ext_CF : βf,g,s. (βn. f n = g n) β CF s f β CF s g.
+#f #g #s #Hext * #i * #Hcode #HC %{i} %
+ [#x cases (Hcode x) #a #H %{a} <Hext @H | //]
+qed.
+
+lemma monotonic_CF: βs1,s2,f. O s2 s1 β CF s1 f β CF s2 f.
+#s1 #s2 #f * #c1 * #a #H * #i * #Hcodef #HCs1 %{i} % //
+cases HCs1 #c2 * #b #H2 %{(c2*c1)} %{(max a b)}
+#x #Hmax cases (H2 x ?) [2:@(le_maxr β¦ Hmax)] #y #Hy
+%{y} @(monotonic_U β¦Hy) >associative_times @le_times // @H @(le_maxl β¦ Hmax)
+qed.
+
+(************************** The diagonal language *****************************)
+
+(* the diagonal language used for the hierarchy theorem *)
+
+definition diag β Ξ»s,i.
+ U (fst i) i (s (|i|)) = Some ? 0.
+
+lemma equiv_diag: βs,i.
+ diag s i β [fst i,i] β s (|i|) β§ Β¬lang (fst i) i.
+#s #i %
+ [whd in β’ (%β?); #H % [%{0} //] % * #x * #y *
+ #H1 #Hy cut (0 = y) [@(unique_U β¦ H H1)] #eqy /2/
+ |* * #y cases y //
+ #y0 #H * #H1 @False_ind @H1 -H1 whd %{(s (|i|))} %{(S y0)} % //
+ ]
+qed.
+
+(* Let us define the characteristic function diag_cf for diag, and prove
+it correctness *)
+
+definition diag_cf β Ξ»s,i.
+ match U (fst i) i (s (|i|)) with
+ [ None β None ?
+ | Some y β if (eqb y 0) then (Some ? 1) else (Some ? 0)].
+
+lemma diag_cf_OK: βs,x. diag s x β βy.diag_cf s x = Some ? y β§ 0 < y.
+#s #x %
+ [whd in β’ (%β?); #H %{1} % // whd in β’ (??%?); >H //
+ |* #y * whd in β’ (??%?β?β%);
+ cases (U (fst x) x (s (|x|))) normalize
+ [#H destruct
+ |#x cases (true_or_false (eqb x 0)) #Hx >Hx
+ [>(eqb_true_to_eq β¦ Hx) //
+ |normalize #H destruct #H @False_ind @(absurd ? H) @lt_to_not_le //
+ ]
+ ]
+ ]
+qed.
+
+lemma diag_spec: βs,i. code_for (diag_cf s) i β βx. lang i x β diag s x.
+#s #i #Hcode #x @(iff_trans β¦ (lang_cf β¦ Hcode)) @iff_sym @diag_cf_OK
+qed.
+
+(******************************************************************************)
+
+lemma absurd1: βP. iff P (Β¬ P) βFalse.
+#P * #H1 #H2 cut (Β¬P) [% #H2 @(absurd β¦ H2) @H1 //]
+#H3 @(absurd ?? H3) @H2 @H3
+qed.
+
+(* axiom weak_pad : βa,βa0.βn. a0 < n β βb. |β©a,bβͺ| = n. *)
+lemma weak_pad1 :βn,a.βb. n β€ β©a,bβͺ.
+#n #a
+cut (βi.decidable (β©a,iβͺ < n))
+ [#i @decidable_le ]
+ #Hdec cases(decidable_forall (Ξ»b. β©a,bβͺ < n) Hdec n)
+ [#H cut (βi. i < n β βb. b < n β§ β©a,bβͺ = i)
+ [@(injective_to_exists β¦ H) //]
+ #Hcut %{n} @not_lt_to_le % #Han
+ lapply(Hcut ? Han) * #x * #Hx #Hx2
+ cut (x = n) [//] #Hxn >Hxn in Hx; /2 by absurd/
+ |#H lapply(not_forall_to_exists β¦ Hdec H)
+ * #b * #H1 #H2 %{b} @not_lt_to_le @H2
+ ]
+qed.
+
+lemma pad : βn,a. βb. n β€ |β©a,bβͺ|.
+#n #a cases (weak_pad1 (of_size n) a) #b #Hb
+%{b} <(size_of_size n) @monotonic_size //
+qed.
+
+lemma o_to_ex: βs1,s2. o s1 s2 β βi. C s2 i β
+ βb.[i, β©i,bβͺ] β s1 (|β©i,bβͺ|).
+#s1 #s2 #H #i * #c * #x0 #H1
+cases (H c) #n0 #H2 cases (pad (max x0 n0) i) #b #Hmax
+%{b} cases (H1 β©i,bβͺ ?)
+ [#z #H3 %{z} @(monotonic_U β¦ H3) @lt_to_le @H2
+ @(le_maxr β¦ Hmax)
+ |@(le_maxl β¦ Hmax)
+ ]
+qed.
+
+lemma diag1_not_s1: βs1,s2. o s1 s2 β Β¬ CF s2 (diag_cf s1).
+#s1 #s2 #H1 % * #i * #Hcode_i #Hs2_i
+cases (o_to_ex β¦ H1 ? Hs2_i) #b #H2
+lapply (diag_spec β¦ Hcode_i) #H3
+@(absurd1 (lang i β©i,bβͺ))
+@(iff_trans β¦ (H3 β©i,bβͺ))
+@(iff_trans β¦ (equiv_diag β¦)) >fst_pair
+%[* #_ // |#H6 % // ]
+qed.
+
+(******************************************************************************)
+
+definition to_Some β Ξ»f.Ξ»x:nat. Some nat (f x).
+
+definition deopt β Ξ»n. match n with
+ [ None β 1
+ | Some n β n].
+
+definition opt_comp β Ξ»f,g:nat β option nat. Ξ»x.
+ match g x with
+ [ None β None ?
+ | Some y β f y ].
+
+(* axiom CFU: βh,g,s. CF s (to_Some h) β CF s (to_Some (of_size β g)) β
+ CF (Slow s) (Ξ»x.U (h x) (g x)). *)
+
+axiom sU2: nat β nat β nat.
+axiom sU: nat β nat β nat β nat.
+
+(* axiom CFU: CF sU (Ξ»x.U (fst x) (snd x)). *)
+
+axiom CFU_new: βh,g,f,s.
+ CF s (to_Some h) β CF s (to_Some g) β CF s (to_Some f) β
+ O s (Ξ»x. sU (size_f h x) (size_f g x) (size_f f x)) β
+ CF s (Ξ»x.U (h x) (g x) (|f x|)).
+
+lemma CFU: βh,g,f,s1,s2,s3.
+ CF s1 (to_Some h) β CF s2 (to_Some g) β CF s3 (to_Some f) β
+ CF (Ξ»x. s1 x + s2 x + s3 x + sU (size_f h x) (size_f g x) (size_f f x))
+ (Ξ»x.U (h x) (g x) (|f x|)).
+#h #g #f #s1 #s2 #s3 #Hh #Hg #Hf @CFU_new
+ [@(monotonic_CF β¦ Hh) @O_plus_l @O_plus_l @O_plus_l //
+ |@(monotonic_CF β¦ Hg) @O_plus_l @O_plus_l @O_plus_r //
+ |@(monotonic_CF β¦ Hf) @O_plus_l @O_plus_r //
+ |@O_plus_r //
+ ]
+qed.
+
+axiom monotonic_sU: βa1,a2,b1,b2,c1,c2. a1 β€ a2 β b1 β€ b2 β c1 β€c2 β
+ sU a1 b1 c1 β€ sU a2 b2 c2.
+
+axiom superlinear_sU: βi,x,r. r β€ sU i x r.
+
+definition sU_space β Ξ»i,x,r.i+x+r.
+definition sU_time β Ξ»i,x,r.i+x+(i^2)*r*(log 2 r).
+
+(*
+axiom CF_comp: βf,g,s1, s2. CF s1 f β CF s2 g β
+ CF (Ξ»x.s2 x + s1 (size (deopt (g x)))) (opt_comp f g).
+
+(* axiom CF_comp: βf,g,s1, s2. CF s1 f β CF s2 g β
+ CF (s1 β (Ξ»x. size (deopt (g x)))) (opt_comp f g). *)
+
+axiom CF_comp_strong: βf,g,s1,s2. CF s1 f β CF s2 g β
+ CF (s1 β s2) (opt_comp f g). *)
+
+definition IF β Ξ»b,f,g:nat βoption nat. Ξ»x.
+ match b x with
+ [None β None ?
+ |Some n β if (eqb n 0) then f x else g x].
+
+axiom IF_CF_new: βb,f,g,s. CF s b β CF s f β CF s g β CF s (IF b f g).
+
+lemma IF_CF: βb,f,g,sb,sf,sg. CF sb b β CF sf f β CF sg g β
+ CF (Ξ»n. sb n + sf n + sg n) (IF b f g).
+#b #f #g #sb #sf #sg #Hb #Hf #Hg @IF_CF_new
+ [@(monotonic_CF β¦ Hb) @O_plus_l @O_plus_l //
+ |@(monotonic_CF β¦ Hf) @O_plus_l @O_plus_r //
+ |@(monotonic_CF β¦ Hg) @O_plus_r //
+ ]
+qed.
+
+lemma diag_cf_def : βs.βi.
+ diag_cf s i =
+ IF (Ξ»i.U (fst i) i (|of_size (s (|i|))|)) (Ξ»i.Some ? 1) (Ξ»i.Some ? 0) i.
+#s #i normalize >size_of_size // qed.
+
+(* and now ... *)
+axiom CF_pair: βf,g,s. CF s (Ξ»x.Some ? (f x)) β CF s (Ξ»x.Some ? (g x)) β
+ CF s (Ξ»x.Some ? (pair (f x) (g x))).
+
+axiom CF_fst: βf,s. CF s (Ξ»x.Some ? (f x)) β CF s (Ξ»x.Some ? (fst (f x))).
+
+definition minimal β Ξ»s. CF s (Ξ»n. Some ? n) β§ βc. CF s (Ξ»n. Some ? c).
+
+
+(*
+axiom le_snd: βn. |snd n| β€ |n|.
+axiom daemon: βP:Prop.P. *)
+
+definition constructible β Ξ»s. CF s (Ξ»x.Some ? (of_size (s (|x|)))).
+
+lemma diag_s: βs. minimal s β constructible s β
+ CF (Ξ»x.sU x x (s x)) (diag_cf s).
+#s * #Hs_id #Hs_c #Hs_constr
+cut (O (Ξ»x:β.sU x x (s x)) s) [%{1} %{0} #n //]
+#O_sU_s @ext_CF [2: #n @sym_eq @diag_cf_def | skip]
+@IF_CF_new [2,3:@(monotonic_CF β¦ (Hs_c ?)) // ]
+@CFU_new
+ [@CF_fst @(monotonic_CF β¦ Hs_id) //
+ |@(monotonic_CF β¦ Hs_id) //
+ |@(monotonic_CF β¦ Hs_constr) //
+ |%{1} %{0} #n #_ >commutative_times <times_n_1
+ @monotonic_sU // >size_f_size >size_of_size //
+ ]
+qed.
+
+(*
+lemma diag_s: βs. minimal s β constructible s β
+ CF (Ξ»x.s x + sU x x (s x)) (diag_cf s).
+#s * #Hs_id #Hs_c #Hs_constr
+@ext_CF [2: #n @sym_eq @diag_cf_def | skip]
+@IF_CF_new [2,3:@(monotonic_CF β¦ (Hs_c ?)) @O_plus_l //]
+@CFU_new
+ [@CF_fst @(monotonic_CF β¦ Hs_id) @O_plus_l //
+ |@(monotonic_CF β¦ Hs_id) @O_plus_l //
+ |@(monotonic_CF β¦ Hs_constr) @O_plus_l //
+ |@O_plus_r %{1} %{0} #n #_ >commutative_times <times_n_1
+ @monotonic_sU // >size_f_size >size_of_size //
+ ]
+qed. *)
+
+(* proof with old axioms
+lemma diag_s: βs. minimal s β constructible s β
+ CF (Ξ»x.s x + sU x x (s x)) (diag_cf s).
+#s * #Hs_id #Hs_c #Hs_constr
+@ext_CF [2: #n @sym_eq @diag_cf_def | skip]
+@(monotonic_CF ???? (IF_CF (Ξ»i:β.U (pair (fst i) i) (|of_size (s (|i|))|))
+ β¦ (Ξ»i.s i + s i + s i + (sU (size_f fst i) (size_f (Ξ»i.i) i) (size_f (Ξ»i.of_size (s (|i|))) i))) β¦ (Hs_c 1) (Hs_c 0) β¦ ))
+ [2: @CFU [@CF_fst // | // |@Hs_constr]
+ |@(O_ext2 (Ξ»n:β.s n+sU (size_f fst n) n (s n) + (s n+s n+s n+s n)))
+ [2: #i >size_f_size >size_of_size >size_f_id //]
+ @O_absorbr
+ [%{1} %{0} #n #_ >commutative_times <times_n_1 @le_plus //
+ @monotonic_sU //
+ |@O_plus_l @(O_plus β¦ (O_refl s)) @(O_plus β¦ (O_refl s))
+ @(O_plus β¦ (O_refl s)) //
+ ]
+qed.
+*)
+
+(*************************** The hierachy theorem *****************************)
+
+(*
+theorem hierarchy_theorem_right: βs1,s2:natβnat.
+ O s1 idN β constructible s1 β
+ not_O s2 s1 β Β¬ CF s1 β CF s2.
+#s1 #s2 #Hs1 #monos1 #H % #H1
+@(absurd β¦ (CF s2 (diag_cf s1)))
+ [@H1 @diag_s // |@(diag1_not_s1 β¦ H)]
+qed.
+*)
+
+theorem hierarchy_theorem_left: βs1,s2:natβnat.
+ O(s1) β O(s2) β CF s1 β CF s2.
+#s1 #s2 #HO #f * #i * #Hcode * #c * #a #Hs1_i %{i} % //
+cases (sub_O_to_O β¦ HO) -HO #c1 * #b #Hs1s2
+%{(c*c1)} %{(max a b)} #x #lemax
+cases (Hs1_i x ?) [2: @(le_maxl β¦lemax)]
+#y #Hy %{y} @(monotonic_U β¦ Hy) >associative_times
+@le_times // @Hs1s2 @(le_maxr β¦ lemax)
+qed.
+
--- /dev/null
+include "basics/types.ma".
+include "arithmetics/minimization.ma".
+include "arithmetics/bigops.ma".
+include "arithmetics/sigma_pi.ma".
+include "arithmetics/bounded_quantifiers.ma".
+include "reverse_complexity/big_O.ma".
+include "basics/core_notation/napart_2.ma".
+
+(************************* notation for minimization *****************************)
+notation "ΞΌ_{ ident i < n } p"
+ with precedence 80 for @{min $n 0 (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β€ n } p"
+ with precedence 80 for @{min (S $n) 0 (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β [a,b[ } p"
+ with precedence 80 for @{min ($b-$a) $a (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β [a,b] } p"
+ with precedence 80 for @{min (S $b-$a) $a (Ξ»${ident i}.$p)}.
+
+(************************************ MAX *************************************)
+notation "Max_{ ident i < n | p } f"
+ with precedence 80
+for @{'bigop $n max 0 (Ξ»${ident i}. $p) (Ξ»${ident i}. $f)}.
+
+notation "Max_{ ident i < n } f"
+ with precedence 80
+for @{'bigop $n max 0 (Ξ»${ident i}.true) (Ξ»${ident i}. $f)}.
+
+notation "Max_{ ident j β [a,b[ } f"
+ with precedence 80
+for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.true) (${ident j}+$a)))
+ (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
+
+notation "Max_{ ident j β [a,b[ | p } f"
+ with precedence 80
+for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.$p) (${ident j}+$a)))
+ (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
+
+lemma Max_assoc: βa,b,c. max (max a b) c = max a (max b c).
+#a #b #c normalize cases (true_or_false (leb a b)) #leab >leab normalize
+ [cases (true_or_false (leb b c )) #lebc >lebc normalize
+ [>(le_to_leb_true a c) // @(transitive_le ? b) @leb_true_to_le //
+ |>leab //
+ ]
+ |cases (true_or_false (leb b c )) #lebc >lebc normalize //
+ >leab normalize >(not_le_to_leb_false a c) // @lt_to_not_le
+ @(transitive_lt ? b) @not_le_to_lt @leb_false_to_not_le //
+ ]
+qed.
+
+lemma Max0 : βn. max 0 n = n.
+// qed.
+
+lemma Max0r : βn. max n 0 = n.
+#n >commutative_max //
+qed.
+
+definition MaxA β
+ mk_Aop nat 0 max Max0 Max0r (Ξ»a,b,c.sym_eq β¦ (Max_assoc a b c)).
+
+definition MaxAC β mk_ACop nat 0 MaxA commutative_max.
+
+lemma le_Max: βf,p,n,a. a < n β p a = true β
+ f a β€ Max_{i < n | p i}(f i).
+#f #p #n #a #ltan #pa
+>(bigop_diff p ? 0 MaxAC f a n) // @(le_maxl β¦ (le_n ?))
+qed.
+
+lemma le_MaxI: βf,p,n,m,a. m β€ a β a < n β p a = true β
+ f a β€ Max_{i β [m,n[ | p i}(f i).
+#f #p #n #m #a #lema #ltan #pa
+>(bigop_diff ? ? 0 MaxAC (Ξ»i.f (i+m)) (a-m) (n-m))
+ [<plus_minus_m_m // @(le_maxl β¦ (le_n ?))
+ |<plus_minus_m_m //
+ |/2 by monotonic_lt_minus_l/
+ ]
+qed.
+
+lemma Max_le: βf,p,n,b.
+ (βa.a < n β p a = true β f a β€ b) β Max_{i < n | p i}(f i) β€ b.
+#f #p #n elim n #b #H //
+#b0 #H1 cases (true_or_false (p b)) #Hb
+ [>bigop_Strue [2:@Hb] @to_max [@H1 // | @H #a #ltab #pa @H1 // @le_S //]
+ |>bigop_Sfalse [2:@Hb] @H #a #ltab #pa @H1 // @le_S //
+ ]
+qed.
+
+(********************************** pairing ***********************************)
+axiom pair: nat β nat β nat.
+axiom fst : nat β nat.
+axiom snd : nat β nat.
+
+interpretation "abstract pair" 'pair f g = (pair f g).
+
+axiom fst_pair: βa,b. fst β©a,bβͺ = a.
+axiom snd_pair: βa,b. snd β©a,bβͺ = b.
+axiom surj_pair: βx. βa,b. x = β©a,bβͺ.
+
+axiom le_fst : βp. fst p β€ p.
+axiom le_snd : βp. snd p β€ p.
+axiom le_pair: βa,a1,b,b1. a β€ a1 β b β€ b1 β β©a,bβͺ β€ β©a1,b1βͺ.
+
+(************************************* U **************************************)
+axiom U: nat β nat βnat β option nat.
+
+axiom monotonic_U: βi,x,n,m,y.n β€m β
+ U i x n = Some ? y β U i x m = Some ? y.
+
+lemma unique_U: βi,x,n,m,yn,ym.
+ U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
+#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
+ [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
+ |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
+ >Hn #HS destruct (HS) //
+ ]
+qed.
+
+definition code_for β Ξ»f,i.βx.
+ βn.βm. n β€ m β U i x m = f x.
+
+definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
+
+notation "{i β x} β r" with precedence 60 for @{terminate $i $x $r}.
+
+lemma terminate_dec: βi,x,n. {i β x} β n β¨ Β¬ {i β x} β n.
+#i #x #n normalize cases (U i x n)
+ [%2 % * #y #H destruct|#y %1 %{y} //]
+qed.
+
+lemma monotonic_terminate: βi,x,n,m.
+ n β€ m β {i β x} β n β {i β x} β m.
+#i #x #n #m #lenm * #z #H %{z} @(monotonic_U β¦ H) //
+qed.
+
+definition termb β Ξ»i,x,t.
+ match U i x t with [None β false |Some y β true].
+
+lemma termb_true_to_term: βi,x,t. termb i x t = true β {i β x} β t.
+#i #x #t normalize cases (U i x t) normalize [#H destruct | #y #_ %{y} //]
+qed.
+
+lemma term_to_termb_true: βi,x,t. {i β x} β t β termb i x t = true.
+#i #x #t * #y #H normalize >H //
+qed.
+
+definition out β Ξ»i,x,r.
+ match U i x r with [ None β 0 | Some z β z].
+
+definition bool_to_nat: bool β nat β
+ Ξ»b. match b with [true β 1 | false β 0].
+
+coercion bool_to_nat.
+
+definition pU : nat β nat β nat β nat β Ξ»i,x,r.β©termb i x r,out i x rβͺ.
+
+lemma pU_vs_U_Some : βi,x,r,y. pU i x r = β©1,yβͺ β U i x r = Some ? y.
+#i #x #r #y % normalize
+ [cases (U i x r) normalize
+ [#H cut (0=1) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H @H]
+ #H1 destruct
+ |#a #H cut (a=y) [lapply (eq_f β¦ snd β¦ H) >snd_pair >snd_pair #H1 @H1]
+ #H1 //
+ ]
+ |#H >H //]
+qed.
+
+lemma pU_vs_U_None : βi,x,r. pU i x r = β©0,0βͺ β U i x r = None ?.
+#i #x #r % normalize
+ [cases (U i x r) normalize //
+ #a #H cut (1=0) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H1 @H1]
+ #H1 destruct
+ |#H >H //]
+qed.
+
+lemma fst_pU: βi,x,r. fst (pU i x r) = termb i x r.
+#i #x #r normalize cases (U i x r) normalize >fst_pair //
+qed.
+
+lemma snd_pU: βi,x,r. snd (pU i x r) = out i x r.
+#i #x #r normalize cases (U i x r) normalize >snd_pair //
+qed.
+
+(********************************* the speedup ********************************)
+
+definition min_input β Ξ»h,i,x. ΞΌ_{y β [S i,x] } (termb i y (h (S i) y)).
+
+lemma min_input_def : βh,i,x.
+ min_input h i x = min (x -i) (S i) (Ξ»y.termb i y (h (S i) y)).
+// qed.
+
+lemma min_input_i: βh,i,x. x β€ i β min_input h i x = S i.
+#h #i #x #lexi >min_input_def
+cut (x - i = 0) [@sym_eq /2 by eq_minus_O/] #Hcut //
+qed.
+
+lemma min_input_to_terminate: βh,i,x.
+ min_input h i x = x β {i β x} β (h (S i) x).
+#h #i #x #Hminx
+cases (decidable_le (S i) x) #Hix
+ [cases (true_or_false (termb i x (h (S i) x))) #Hcase
+ [@termb_true_to_term //
+ |<Hminx in Hcase; #H lapply (fmin_false (Ξ»x.termb i x (h (S i) x)) (x-i) (S i) H)
+ >min_input_def in Hminx; #Hminx >Hminx in β’ (%β?);
+ <plus_n_Sm <plus_minus_m_m [2: @lt_to_le //]
+ #Habs @False_ind /2/
+ ]
+ |@False_ind >min_input_i in Hminx;
+ [#eqix >eqix in Hix; * /2/ | @le_S_S_to_le @not_le_to_lt //]
+ ]
+qed.
+
+lemma min_input_to_lt: βh,i,x.
+ min_input h i x = x β i < x.
+#h #i #x #Hminx cases (decidable_le (S i) x) //
+#ltxi @False_ind >min_input_i in Hminx;
+ [#eqix >eqix in ltxi; * /2/ | @le_S_S_to_le @not_le_to_lt //]
+qed.
+
+lemma le_to_min_input: βh,i,x,x1. x β€ x1 β
+ min_input h i x = x β min_input h i x1 = x.
+#h #i #x #x1 #lex #Hminx @(min_exists β¦ (le_S_S β¦ lex))
+ [@(fmin_true β¦ (sym_eq β¦ Hminx)) //
+ |@(min_input_to_lt β¦ Hminx)
+ |#j #H1 <Hminx @lt_min_to_false //
+ |@plus_minus_m_m @le_S_S @(transitive_le β¦ lex) @lt_to_le
+ @(min_input_to_lt β¦ Hminx)
+ ]
+qed.
+
+definition g β Ξ»h,u,x.
+ S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
+
+lemma g_def : βh,u,x. g h u x =
+ S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
+// qed.
+
+lemma le_u_to_g_1 : βh,u,x. x β€ u β g h u x = 1.
+#h #u #x #lexu >g_def cut (x-u = 0) [/2 by minus_le_minus_minus_comm/]
+#eq0 >eq0 normalize // qed.
+
+lemma g_lt : βh,i,x. min_input h i x = x β
+ out i x (h (S i) x) < g h 0 x.
+#h #i #x #H @le_S_S @(le_MaxI β¦ i) /2 by min_input_to_lt/
+qed.
+
+(*
+axiom ax1: βh,i.
+ (βy.i < y β§ (termb i y (h (S i) y)=true)) β¨
+ βy. i < y β (termb i y (h (S i) y)=false).
+
+lemma eventually_0: βh,u.βnu.βx. nu < x β
+ max_{i β [0,u[ | eqb (min_input h i x) x} (out i x (h (S i) x)) = 0.
+#h #u elim u
+ [%{0} normalize //
+ |#u0 * #nu0 #Hind cases (ax1 h u0)
+ [* #x0 * #leu0x0 #Hx0 %{(max nu0 x0)}
+ #x #Hx >bigop_Sfalse
+ [>(minus_n_O u0) @Hind @(le_to_lt_to_lt β¦ Hx) /2 by le_maxl/
+ |@not_eq_to_eqb_false % #Hf @(absurd (x β€ x0))
+ [<Hf @true_to_le_min //
+ |@lt_to_not_le @(le_to_lt_to_lt β¦ Hx) /2 by le_maxl/
+ ]
+ ]
+ |#H %{(max u0 nu0)} #x #Hx >bigop_Sfalse
+ [>(minus_n_O u0) @Hind @(le_to_lt_to_lt β¦ Hx) @le_maxr //
+ |@not_eq_to_eqb_false >min_input_def
+ >(min_not_exists (Ξ»y.(termb (u0+0) y (h (S (u0+0)) y))))
+ [<plus_n_O <plus_n_Sm <plus_minus_m_m
+ [% #H1 /2/
+ |@lt_to_le @(le_to_lt_to_lt β¦ Hx) @le_maxl //
+ ]
+ |/2 by /
+ ]
+ ]
+ ]
+ ]
+qed.
+
+definition almost_equal β Ξ»f,g:nat β nat. βnu.βx. nu < x β f x = g x.
+
+definition almost_equal1 β Ξ»f,g:nat β nat. Β¬ βnu.βx. nu < x β§ f x β g x.
+
+interpretation "almost equal" 'napart f g = (almost_equal f g).
+
+lemma condition_1: βh,u.g h 0 β g h u.
+#h #u cases (eventually_0 h u) #nu #H %{(max u nu)} #x #Hx @(eq_f ?? S)
+>(bigop_sumI 0 u x (Ξ»i:β.eqb (min_input h i x) x) nat 0 MaxA)
+ [>H // @(le_to_lt_to_lt β¦Hx) /2 by le_maxl/
+ |@lt_to_le @(le_to_lt_to_lt β¦Hx) /2 by le_maxr/
+ |//
+ ]
+qed. *)
+
+lemma max_neq0 : βa,b. max a b β 0 β a β 0 β¨ b β 0.
+#a #b whd in match (max a b); cases (true_or_false (leb a b)) #Hcase >Hcase
+ [#H %2 @H | #H %1 @H]
+qed.
+
+definition almost_equal β Ξ»f,g:nat β nat. Β¬ βnu.βx. nu < x β§ f x β g x.
+interpretation "almost equal" 'napart f g = (almost_equal f g).
+
+lemma eventually_cancelled: βh,u.Β¬βnu.βx. nu < x β§
+ max_{i β [0,u[ | eqb (min_input h i x) x} (out i x (h (S i) x)) β 0.
+#h #u elim u
+ [normalize % #H cases (H u) #x * #_ * #H1 @H1 //
+ |#u0 @not_to_not #Hind #nu cases (Hind nu) #x * #ltx
+ cases (true_or_false (eqb (min_input h (u0+O) x) x)) #Hcase
+ [>bigop_Strue [2:@Hcase] #Hmax cases (max_neq0 β¦ Hmax) -Hmax
+ [2: #H %{x} % // <minus_n_O @H]
+ #Hneq0 (* if x is not enough we retry with nu=x *)
+ cases (Hind x) #x1 * #ltx1
+ >bigop_Sfalse
+ [#H %{x1} % [@transitive_lt //| <minus_n_O @H]
+ |@not_eq_to_eqb_false >(le_to_min_input β¦ (eqb_true_to_eq β¦ Hcase))
+ [@lt_to_not_eq @ltx1 | @lt_to_le @ltx1]
+ ]
+ |>bigop_Sfalse [2:@Hcase] #H %{x} % // <minus_n_O @H
+ ]
+ ]
+qed.
+
+lemma condition_1: βh,u.g h 0 β g h u.
+#h #u @(not_to_not β¦ (eventually_cancelled h u))
+#H #nu cases (H (max u nu)) #x * #ltx #Hdiff
+%{x} % [@(le_to_lt_to_lt β¦ ltx) @(le_maxr β¦ (le_n β¦))] @(not_to_not β¦ Hdiff)
+#H @(eq_f ?? S) >(bigop_sumI 0 u x (Ξ»i:β.eqb (min_input h i x) x) nat 0 MaxA)
+ [>H // |@lt_to_le @(le_to_lt_to_lt β¦ltx) /2 by le_maxr/ |//]
+qed.
+
+(******************************** Condition 2 *********************************)
+definition total β Ξ»f.Ξ»x:nat. Some nat (f x).
+
+lemma exists_to_exists_min: βh,i. (βx. i < x β§ {i β x} β h (S i) x) β βy. min_input h i y = y.
+#h #i * #x * #ltix #Hx %{(min_input h i x)} @min_spec_to_min @found //
+ [@(f_min_true (Ξ»y:β.termb i y (h (S i) y))) %{x} % [% // | @term_to_termb_true //]
+ |#y #leiy #lty @(lt_min_to_false ????? lty) //
+ ]
+qed.
+
+lemma condition_2: βh,i. code_for (total (g h 0)) i β Β¬βx. i<x β§ {i β x} β h (S i) x.
+#h #i whd in β’(%β?); #H % #H1 cases (exists_to_exists_min β¦ H1) #y #Hminy
+lapply (g_lt β¦ Hminy)
+lapply (min_input_to_terminate β¦ Hminy) * #r #termy
+cases (H y) -H #ny #Hy
+cut (r = g h 0 y) [@(unique_U β¦ ny β¦ termy) @Hy //] #Hr
+whd in match (out ???); >termy >Hr
+#H @(absurd ? H) @le_to_not_lt @le_n
+qed.
+
+
+(********************** complexity ***********************)
+
+(* We assume operations have a minimal structural complexity MSC.
+For instance, for time complexity, MSC is equal to the size of input.
+For space complexity, MSC is typically 0, since we only measure the
+space required in addition to dimension of the input. *)
+
+axiom MSC : nat β nat.
+axiom MSC_le: βn. MSC n β€ n.
+axiom monotonic_MSC: monotonic ? le MSC.
+axiom MSC_pair: βa,b. MSC β©a,bβͺ β€ MSC a + MSC b.
+
+(* C s i means i is running in O(s) *)
+
+definition C β Ξ»s,i.βc.βa.βx.a β€ x β βy.
+ U i x (c*(s x)) = Some ? y.
+
+(* C f s means f β O(s) where MSC βO(s) *)
+definition CF β Ξ»s,f.O s MSC β§ βi.code_for (total f) i β§ C s i.
+
+lemma ext_CF : βf,g,s. (βn. f n = g n) β CF s f β CF s g.
+#f #g #s #Hext * #HO * #i * #Hcode #HC % // %{i} %
+ [#x cases (Hcode x) #a #H %{a} whd in match (total ??); <Hext @H | //]
+qed.
+
+(* lemma ext_CF_total : βf,g,s. (βn. f n = g n) β CF s (total f) β CF s (total g).
+#f #g #s #Hext * #HO * #i * #Hcode #HC % // %{i} % [2:@HC]
+#x cases (Hcode x) #a #H %{a} #m #leam >(H m leam) normalize @eq_f @Hext
+qed. *)
+
+lemma monotonic_CF: βs1,s2,f.(βx. s1 x β€ s2 x) β CF s1 f β CF s2 f.
+#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
+ [cases HO #c * #a -HO #HO %{c} %{a} #n #lean @(transitive_le β¦ (HO n lean))
+ @le_times //
+ |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1 %{c} %{a} #n #lean
+ cases(Hs1 n lean) #y #Hy %{y} @(monotonic_U β¦Hy) @le_times //
+ ]
+qed.
+
+lemma O_to_CF: βs1,s2,f.O s2 s1 β CF s1 f β CF s2 f.
+#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
+ [@(O_trans β¦ H) //
+ |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1
+ cases H #c1 * #a1 #Ha1 %{(c*c1)} %{(a+a1)} #n #lean
+ cases(Hs1 n ?) [2:@(transitive_le β¦ lean) //] #y #Hy %{y} @(monotonic_U β¦Hy)
+ >associative_times @le_times // @Ha1 @(transitive_le β¦ lean) //
+ ]
+qed.
+
+lemma timesc_CF: βs,f,c.CF (Ξ»x.c*s x) f β CF s f.
+#s #f #c @O_to_CF @O_times_c
+qed.
+
+(********************************* composition ********************************)
+axiom CF_comp: βf,g,sf,sg,sh. CF sg g β CF sf f β
+ O sh (Ξ»x. sg x + sf (g x)) β CF sh (f β g).
+
+lemma CF_comp_ext: βf,g,h,sh,sf,sg. CF sg g β CF sf f β
+ (βx.f(g x) = h x) β O sh (Ξ»x. sg x + sf (g x)) β CF sh h.
+#f #g #h #sh #sf #sg #Hg #Hf #Heq #H @(ext_CF (f β g))
+ [#n normalize @Heq | @(CF_comp β¦ H) //]
+qed.
+
+(*
+lemma CF_comp1: βf,g,s. CF s (total g) β CF s (total f) β
+ CF s (total (f β g)).
+#f #g #s #Hg #Hf @(timesc_CF β¦ 2) @(monotonic_CF β¦ (CF_comp β¦ Hg Hf))
+*)
+
+(*
+axiom CF_comp_ext2: βf,g,h,sf,sh. CF sh (total g) β CF sf (total f) β
+ (βx.f(g x) = h x) β
+ (βx. sf (g x) β€ sh x) β CF sh (total h).
+
+lemma main_MSC: βh,f. CF h f β O h (Ξ»x.MSC (f x)).
+
+axiom CF_S: CF MSC S.
+axiom CF_fst: CF MSC fst.
+axiom CF_snd: CF MSC snd.
+
+lemma CF_compS: βh,f. CF h f β CF h (S β f).
+#h #f #Hf @(CF_comp β¦ Hf CF_S) @O_plus // @main_MSC //
+qed.
+
+lemma CF_comp_fst: βh,f. CF h (total f) β CF h (total (fst β f)).
+#h #f #Hf @(CF_comp β¦ Hf CF_fst) @O_plus // @main_MSC //
+qed.
+
+lemma CF_comp_snd: βh,f. CF h (total f) β CF h (total (snd β f)).
+#h #f #Hf @(CF_comp β¦ Hf CF_snd) @O_plus // @main_MSC //
+qed. *)
+
+definition id β Ξ»x:nat.x.
+
+axiom CF_id: CF MSC id.
+axiom CF_compS: βh,f. CF h f β CF h (S β f).
+axiom CF_comp_fst: βh,f. CF h f β CF h (fst β f).
+axiom CF_comp_snd: βh,f. CF h f β CF h (snd β f).
+axiom CF_comp_pair: βh,f,g. CF h f β CF h g β CF h (Ξ»x. β©f x,g xβͺ).
+
+lemma CF_fst: CF MSC fst.
+@(ext_CF (fst β id)) [#n //] @(CF_comp_fst β¦ CF_id)
+qed.
+
+lemma CF_snd: CF MSC snd.
+@(ext_CF (snd β id)) [#n //] @(CF_comp_snd β¦ CF_id)
+qed.
+
+(************************************** eqb ***********************************)
+(* definition btotal β
+ Ξ»f.Ξ»x:nat. match f x with [true β Some ? 0 |false β Some ? 1]. *)
+
+axiom CF_eqb: βh,f,g.
+ CF h f β CF h g β CF h (Ξ»x.eqb (f x) (g x)).
+
+(*
+axiom eqb_compl2: βh,f,g.
+ CF2 h (total2 f) β CF2 h (total2 g) β
+ CF2 h (btotal2 (Ξ»x1,x2.eqb (f x1 x2) (g x1 x2))).
+
+axiom eqb_min_input_compl:βh,x.
+ CF (Ξ»i.β_{y β [S i,S x[ }(h i y))
+ (btotal (Ξ»i.eqb (min_input h i x) x)). *)
+(*********************************** maximum **********************************)
+
+axiom CF_max: βa,b.βp:nat βbool.βf,ha,hb,hp,hf,s.
+ CF ha a β CF hb b β CF hp p β CF hf f β
+ O s (Ξ»x.ha x + hb x + β_{i β[a x ,b x[ }(hp β©i,xβͺ + hf β©i,xβͺ)) β
+ CF s (Ξ»x.max_{i β[a x,b x[ | p β©i,xβͺ }(f β©i,xβͺ)).
+
+(******************************** minimization ********************************)
+
+axiom CF_mu: βa,b.βf:nat βbool.βsa,sb,sf,s.
+ CF sa a β CF sb b β CF sf f β
+ O s (Ξ»x.sa x + sb x + β_{i β[a x ,S(b x)[ }(sf β©i,xβͺ)) β
+ CF s (Ξ»x.ΞΌ_{i β[a x,b x] }(f β©i,xβͺ)).
+
+(****************************** constructibility ******************************)
+
+definition constructible β Ξ»s. CF s s.
+
+lemma constr_comp : βs1,s2. constructible s1 β constructible s2 β
+ (βx. x β€ s2 x) β constructible (s2 β s1).
+#s1 #s2 #Hs1 #Hs2 #Hle @(CF_comp β¦ Hs1 Hs2) @O_plus @le_to_O #x [@Hle | //]
+qed.
+
+lemma ext_constr: βs1,s2. (βx.s1 x = s2 x) β
+ constructible s1 β constructible s2.
+#s1 #s2 #Hext #Hs1 @(ext_CF β¦ Hext) @(monotonic_CF β¦ Hs1) #x >Hext //
+qed.
+
+(********************************* simulation *********************************)
+
+axiom sU : nat β nat.
+
+axiom monotonic_sU: βi1,i2,x1,x2,s1,s2. i1 β€ i2 β x1 β€ x2 β s1 β€ s2 β
+ sU β©i1,β©x1,s1βͺβͺ β€ sU β©i2,β©x2,s2βͺβͺ.
+
+lemma monotonic_sU_aux : βx1,x2. fst x1 β€ fst x2 β fst (snd x1) β€ fst (snd x2) β
+snd (snd x1) β€ snd (snd x2) β sU x1 β€ sU x2.
+#x1 #x2 cases (surj_pair x1) #a1 * #y #eqx1 >eqx1 -eqx1 cases (surj_pair y)
+#b1 * #c1 #eqy >eqy -eqy
+cases (surj_pair x2) #a2 * #y2 #eqx2 >eqx2 -eqx2 cases (surj_pair y2)
+#b2 * #c2 #eqy2 >eqy2 -eqy2 >fst_pair >snd_pair >fst_pair >snd_pair
+>fst_pair >snd_pair >fst_pair >snd_pair @monotonic_sU
+qed.
+
+axiom sU_le: βi,x,s. s β€ sU β©i,β©x,sβͺβͺ.
+axiom sU_le_i: βi,x,s. MSC i β€ sU β©i,β©x,sβͺβͺ.
+axiom sU_le_x: βi,x,s. MSC x β€ sU β©i,β©x,sβͺβͺ.
+
+definition pU_unary β Ξ»p. pU (fst p) (fst (snd p)) (snd (snd p)).
+
+axiom CF_U : CF sU pU_unary.
+
+definition termb_unary β Ξ»x:β.termb (fst x) (fst (snd x)) (snd (snd x)).
+definition out_unary β Ξ»x:β.out (fst x) (fst (snd x)) (snd (snd x)).
+
+lemma CF_termb: CF sU termb_unary.
+@(ext_CF (fst β pU_unary)) [2: @CF_comp_fst @CF_U]
+#n whd in β’ (??%?); whd in β’ (??(?%)?); >fst_pair %
+qed.
+
+lemma CF_out: CF sU out_unary.
+@(ext_CF (snd β pU_unary)) [2: @CF_comp_snd @CF_U]
+#n whd in β’ (??%?); whd in β’ (??(?%)?); >snd_pair %
+qed.
+
+(*
+lemma CF_termb_comp: βf.CF (sU β f) (termb_unary β f).
+#f @(CF_comp β¦ CF_termb) *)
+
+(******************** complexity of g ********************)
+
+definition unary_g β Ξ»h.Ξ»ux. g h (fst ux) (snd ux).
+definition auxg β
+ Ξ»h,ux. max_{i β[fst ux,snd ux[ | eqb (min_input h i (snd ux)) (snd ux)}
+ (out i (snd ux) (h (S i) (snd ux))).
+
+lemma compl_g1 : βh,s. CF s (auxg h) β CF s (unary_g h).
+#h #s #H1 @(CF_compS ? (auxg h) H1)
+qed.
+
+definition aux1g β
+ Ξ»h,ux. max_{i β[fst ux,snd ux[ | (Ξ»p. eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β©i,uxβͺ}
+ ((Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β©i,uxβͺ).
+
+lemma eq_aux : βh,x.aux1g h x = auxg h x.
+#h #x @same_bigop
+ [#n #_ >fst_pair >snd_pair // |#n #_ #_ >fst_pair >snd_pair //]
+qed.
+
+lemma compl_g2 : βh,s1,s2,s.
+ CF s1
+ (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β
+ CF s2
+ (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β
+ O s (Ξ»x.MSC x + β_{i β[fst x ,snd x[ }(s1 β©i,xβͺ+s2 β©i,xβͺ)) β
+ CF s (auxg h).
+#h #s1 #s2 #s #Hs1 #Hs2 #HO @(ext_CF (aux1g h))
+ [#n whd in β’ (??%%); @eq_aux]
+@(CF_max β¦ CF_fst CF_snd Hs1 Hs2 β¦) @(O_trans β¦ HO)
+@O_plus [@O_plus @O_plus_l // | @O_plus_r //]
+qed.
+
+lemma compl_g3 : βh,s.
+ CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))) β
+ CF s (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))).
+#h #s #H @(CF_eqb β¦ H) @(CF_comp β¦ CF_snd CF_snd) @(O_trans β¦ (proj1 β¦ H))
+@O_plus // %{1} %{0} #n #_ >commutative_times <times_n_1 @monotonic_MSC //
+qed.
+
+definition min_input_aux β Ξ»h,p.
+ ΞΌ_{y β [S (fst p),snd (snd p)] }
+ ((Ξ»x.termb (fst (snd x)) (fst x) (h (S (fst (snd x))) (fst x))) β©y,pβͺ).
+
+lemma min_input_eq : βh,p.
+ min_input_aux h p =
+ min_input h (fst p) (snd (snd p)).
+#h #p >min_input_def whd in β’ (??%?); >minus_S_S @min_f_g #i #_ #_
+whd in β’ (??%%); >fst_pair >snd_pair //
+qed.
+
+definition termb_aux β Ξ»h.
+ termb_unary β Ξ»p.β©fst (snd p),β©fst p,h (S (fst (snd p))) (fst p)βͺβͺ.
+
+(*
+lemma termb_aux : βh,p.
+ (Ξ»x:β.termb (fst x) (fst (snd x)) (snd (snd x)))
+ β©fst (snd p),β©fst p,h (S (fst (snd p))) (fst p)βͺβͺ =
+ termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)) .
+#h #p normalize >fst_pair >snd_pair >fst_pair >snd_pair //
+qed. *)
+
+lemma compl_g4 : βh,s1,s.
+ (CF s1
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
+ (O s (Ξ»x.MSC x + β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ))) β
+ CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #s1 #s #Hs1 #HO @(ext_CF (min_input_aux h))
+ [#n whd in β’ (??%%); @min_input_eq]
+@(CF_mu β¦ MSC MSC β¦ Hs1)
+ [@CF_compS @CF_fst
+ |@CF_comp_snd @CF_snd
+ |@(O_trans β¦ HO) @O_plus [@O_plus @O_plus_l // | @O_plus_r //]
+(* @(ext_CF (btotal (termb_aux h)))
+ [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
+@(CF_compb β¦ CF_termb) *)
+qed.
+
+(************************* a couple of technical lemmas ***********************)
+lemma minus_to_0: βa,b. a β€ b β minus a b = 0.
+#a elim a // #n #Hind *
+ [#H @False_ind /2 by absurd/ | #b normalize #H @Hind @le_S_S_to_le /2/]
+qed.
+
+lemma sigma_bound: βh,a,b. monotonic nat le h β
+ β_{i β [a,S b[ }(h i) β€ (S b-a)*h b.
+#h #a #b #H cases (decidable_le a b)
+ [#leab cut (b = pred (S b - a + a))
+ [<plus_minus_m_m // @le_S //] #Hb >Hb in match (h b);
+ generalize in match (S b -a);
+ #n elim n
+ [//
+ |#m #Hind >bigop_Strue [2://] @le_plus
+ [@H @le_n |@(transitive_le β¦ Hind) @le_times [//] @H //]
+ ]
+ |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
+ cut (S b -a = 0) [@minus_to_0 //] #Hcut >Hcut //
+ ]
+qed.
+
+lemma sigma_bound_decr: βh,a,b. (βa1,a2. a1 β€ a2 β a2 < b β h a2 β€ h a1) β
+ β_{i β [a,b[ }(h i) β€ (b-a)*h a.
+#h #a #b #H cases (decidable_le a b)
+ [#leab cut ((b -a) +a β€ b) [/2 by le_minus_to_plus_r/] generalize in match (b -a);
+ #n elim n
+ [//
+ |#m #Hind >bigop_Strue [2://] #Hm
+ cut (m+a β€ b) [@(transitive_le β¦ Hm) //] #Hm1
+ @le_plus [@H // |@(transitive_le β¦ (Hind Hm1)) //]
+ ]
+ |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
+ cut (b -a = 0) [@minus_to_0 @lt_to_le @ltba] #Hcut >Hcut //
+ ]
+qed.
+
+lemma coroll: βs1:natβnat. (βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
+O (Ξ»x.(snd (snd x)-fst x)*(s1 β©snd (snd x),xβͺ))
+ (Ξ»x.β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ)).
+#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
+@(transitive_le β¦ (sigma_bound β¦)) [@Hs1|>minus_S_S //]
+qed.
+
+lemma coroll2: βs1:natβnat. (βn,a,b. a β€ b β b < snd n β s1 β©b,nβͺ β€ s1 β©a,nβͺ) β
+O (Ξ»x.(snd x - fst x)*s1 β©fst x,xβͺ) (Ξ»x.β_{i β[fst x,snd x[ }(s1 β©i,xβͺ)).
+#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
+@(transitive_le β¦ (sigma_bound_decr β¦)) [2://] @Hs1
+qed.
+
+lemma compl_g5 : βh,s1.(βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
+ (CF s1
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
+ CF (Ξ»x.MSC x + (snd (snd x)-fst x)*s1 β©snd (snd x),xβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #s1 #Hmono #Hs1 @(compl_g4 β¦ Hs1) @O_plus
+[@O_plus_l // |@O_plus_r @coroll @Hmono]
+qed.
+
+(*
+axiom compl_g6: βh.
+ (* constructible (Ξ»x. h (fst x) (snd x)) β *)
+ (CF (Ξ»x. max (MSC x) (sU β©fst (snd x),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ))
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))).
+*)
+
+lemma compl_g6: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (CF (Ξ»x. sU β©max (fst (snd x)) (snd (snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ)
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))).
+#h #hconstr @(ext_CF (termb_aux h))
+ [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
+@(CF_comp β¦ (Ξ»x.MSC x + h (S (fst (snd x))) (fst x)) β¦ CF_termb)
+ [@CF_comp_pair
+ [@CF_comp_fst @(monotonic_CF β¦ CF_snd) #x //
+ |@CF_comp_pair
+ [@(monotonic_CF β¦ CF_fst) #x //
+ |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst (snd x)),fst xβͺ)))
+ [#n normalize >fst_pair >snd_pair %]
+ @(CF_comp β¦ MSC β¦hconstr)
+ [@CF_comp_pair [@CF_compS @CF_comp_fst // |//]
+ |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
+ ]
+ ]
+ ]
+ |@O_plus
+ [@O_plus
+ [@(O_trans β¦ (Ξ»x.MSC (fst x) + MSC (max (fst (snd x)) (snd (snd x)))))
+ [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ >distributive_times_plus @le_plus [//]
+ cases (surj_pair b) #c * #d #eqb >eqb
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ whd in β’ (??%); @le_plus
+ [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
+ |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
+ ]
+ |@O_plus [@le_to_O #x @sU_le_x |@le_to_O #x @sU_le_i]
+ ]
+ |@le_to_O #n @sU_le
+ ]
+ |@le_to_O #x @monotonic_sU // @(le_maxl β¦ (le_n β¦)) ]
+ ]
+qed.
+
+(* definition faux1 β Ξ»h.
+ (Ξ»x.MSC x + (snd (snd x)-fst x)*(Ξ»x.sU β©fst (snd x),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ) β©snd (snd x),xβͺ).
+
+(* complexity of min_input *)
+lemma compl_g7: βh.
+ (βx.MSC xβ€h (S (fst (snd x))) (fst x)) β
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ CF (Ξ»x.MSC x + (snd (snd x)-fst x)*sU β©fst x,β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #hle #hcostr #hmono @(monotonic_CF β¦ (faux1 h))
+ [#n normalize >fst_pair >snd_pair //]
+@compl_g5 [2:@(compl_g6 h hcostr)] #n #x #y #lexy >fst_pair >snd_pair
+>fst_pair >snd_pair @monotonic_sU // @hmono @lexy
+qed.*)
+
+definition big : nat βnat β Ξ»x.
+ let m β max (fst x) (snd x) in β©m,mβͺ.
+
+lemma big_def : βa,b. big β©a,bβͺ = β©max a b,max a bβͺ.
+#a #b normalize >fst_pair >snd_pair // qed.
+
+lemma le_big : βx. x β€ big x.
+#x cases (surj_pair x) #a * #b #eqx >eqx @le_pair >fst_pair >snd_pair
+[@(le_maxl β¦ (le_n β¦)) | @(le_maxr β¦ (le_n β¦))]
+qed.
+
+definition faux2 β Ξ»h.
+ (Ξ»x.MSC x + (snd (snd x)-fst x)*
+ (Ξ»x.sU β©max (fst(snd x)) (snd(snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ) β©snd (snd x),xβͺ).
+
+(* proviamo con x *)
+lemma compl_g7: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ CF (Ξ»x.MSC x + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #hcostr #hmono @(monotonic_CF β¦ (faux2 h))
+ [#n normalize >fst_pair >snd_pair //]
+@compl_g5 [2:@(compl_g6 h hcostr)] #n #x #y #lexy >fst_pair >snd_pair
+>fst_pair >snd_pair @monotonic_sU // @hmono @lexy
+qed.
+
+(* proviamo con x *)
+lemma compl_g71: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ CF (Ξ»x.MSC (big x) + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #hcostr #hmono @(monotonic_CF β¦ (compl_g7 h hcostr hmono)) #x
+@le_plus [@monotonic_MSC //]
+cases (decidable_le (fst x) (snd(snd x)))
+ [#Hle @le_times // @monotonic_sU
+ |#Hlt >(minus_to_0 β¦ (lt_to_le β¦ )) [// | @not_le_to_lt @Hlt]
+ ]
+qed.
+
+(*
+axiom compl_g8: βh.
+ CF (Ξ»x. sU β©fst x,β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))). *)
+
+definition out_aux β Ξ»h.
+ out_unary β Ξ»p.β©fst p,β©snd(snd p),h (S (fst p)) (snd (snd p))βͺβͺ.
+
+lemma compl_g8: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (CF (Ξ»x. sU β©max (fst x) (snd x),β©snd(snd x),h (S (fst x)) (snd(snd x))βͺβͺ)
+ (Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p))))).
+#h #hconstr @(ext_CF (out_aux h))
+ [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
+@(CF_comp β¦ (Ξ»x.h (S (fst x)) (snd(snd x)) + MSC x) β¦ CF_out)
+ [@CF_comp_pair
+ [@(monotonic_CF β¦ CF_fst) #x //
+ |@CF_comp_pair
+ [@CF_comp_snd @(monotonic_CF β¦ CF_snd) #x //
+ |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst x),snd(snd x)βͺ)))
+ [#n normalize >fst_pair >snd_pair %]
+ @(CF_comp β¦ MSC β¦hconstr)
+ [@CF_comp_pair [@CF_compS // | @CF_comp_snd // ]
+ |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
+ ]
+ ]
+ ]
+ |@O_plus
+ [@O_plus
+ [@le_to_O #n @sU_le
+ |@(O_trans β¦ (Ξ»x.MSC (max (fst x) (snd x))))
+ [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ whd in β’ (??%); @le_plus
+ [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
+ |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
+ ]
+ |@le_to_O #x @(transitive_le ???? (sU_le_i β¦ )) //
+ ]
+ ]
+ |@le_to_O #x @monotonic_sU [@(le_maxl β¦ (le_n β¦))|//|//]
+ ]
+qed.
+
+(*
+lemma compl_g81: βh.
+ (βx.MSC xβ€h (S (fst x)) (snd(snd x))) β
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ CF (Ξ»x. sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))).
+#h #hle #hconstr @(monotonic_CF ???? (compl_g8 h hle hconstr)) #x @monotonic_sU // @(le_maxl β¦ (le_n β¦ ))
+qed. *)
+
+(* axiom daemon : False. *)
+
+lemma compl_g9 : βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
+ CF (Ξ»x. (S (snd x-fst x))*MSC β©x,xβͺ +
+ (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ)
+ (auxg h).
+#h #hconstr #hmono #hantimono
+@(compl_g2 h ??? (compl_g3 β¦ (compl_g71 h hconstr hmono)) (compl_g8 h hconstr))
+@O_plus
+ [@O_plus_l @le_to_O #x >(times_n_1 (MSC x)) >commutative_times @le_times
+ [// | @monotonic_MSC // ]]
+@(O_trans β¦ (coroll2 ??))
+ [#n #a #b #leab #ltb >fst_pair >fst_pair >snd_pair >snd_pair
+ cut (b β€ n) [@(transitive_le β¦ (le_snd β¦)) @lt_to_le //] #lebn
+ cut (max a n = n)
+ [normalize >le_to_leb_true [//|@(transitive_le β¦ leab lebn)]] #maxa
+ cut (max b n = n) [normalize >le_to_leb_true //] #maxb
+ @le_plus
+ [@le_plus [>big_def >big_def >maxa >maxb //]
+ @le_times
+ [/2 by monotonic_le_minus_r/
+ |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
+ ]
+ |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
+ ]
+ |@le_to_O #n >fst_pair >snd_pair
+ cut (max (fst n) n = n) [normalize >le_to_leb_true //] #Hmax >Hmax
+ >associative_plus >distributive_times_plus
+ @le_plus [@le_times [@le_S // |>big_def >Hmax //] |//]
+ ]
+qed.
+
+definition sg β Ξ»h,x.
+ (S (snd x-fst x))*MSC β©x,xβͺ + (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ.
+
+lemma sg_def : βh,a,b.
+ sg h β©a,bβͺ = (S (b-a))*MSC β©β©a,bβͺ,β©a,bβͺβͺ +
+ (b-a)*(S(b-a))*sU β©β©a,bβͺ,β©b,h (S a) bβͺβͺ.
+#h #a #b whd in β’ (??%?); >fst_pair >snd_pair //
+qed.
+
+lemma compl_g11 : βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
+ CF (sg h) (unary_g h).
+#h #hconstr #Hm #Ham @compl_g1 @(compl_g9 h hconstr Hm Ham)
+qed.
+
+(**************************** closing the argument ****************************)
+
+let rec h_of_aux (r:nat βnat) (c,d,b:nat) on d : nat β
+ match d with
+ [ O β c (* MSC β©β©b,bβͺ,β©b,bβͺβͺ *)
+ | S d1 β (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
+ d*(S d)*sU β©β©b-d,bβͺ,β©b,r (h_of_aux r c d1 b)βͺβͺ].
+
+lemma h_of_aux_O: βr,c,b.
+ h_of_aux r c O b = c.
+// qed.
+
+lemma h_of_aux_S : βr,c,d,b.
+ h_of_aux r c (S d) b =
+ (S (S d))*(MSC β©β©b-(S d),bβͺ,β©b-(S d),bβͺβͺ) +
+ (S d)*(S (S d))*sU β©β©b-(S d),bβͺ,β©b,r(h_of_aux r c d b)βͺβͺ.
+// qed.
+
+definition h_of β Ξ»r,p.
+ let m β max (fst p) (snd p) in
+ h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (snd p - fst p) (snd p).
+
+lemma h_of_O: βr,a,b. b β€ a β
+ h_of r β©a,bβͺ = let m β max a b in MSC β©β©m,mβͺ,β©m,mβͺβͺ.
+#r #a #b #Hle normalize >fst_pair >snd_pair >(minus_to_0 β¦ Hle) //
+qed.
+
+lemma h_of_def: βr,a,b.h_of r β©a,bβͺ =
+ let m β max a b in
+ h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (b - a) b.
+#r #a #b normalize >fst_pair >snd_pair //
+qed.
+
+lemma mono_h_of_aux: βr.(βx. x β€ r x) β monotonic ? le r β
+ βd,d1,c,c1,b,b1.c β€ c1 β d β€ d1 β b β€ b1 β
+ h_of_aux r c d b β€ h_of_aux r c1 d1 b1.
+#r #Hr #monor #d #d1 lapply d -d elim d1
+ [#d #c #c1 #b #b1 #Hc #Hd @(le_n_O_elim ? Hd) #leb
+ >h_of_aux_O >h_of_aux_O //
+ |#m #Hind #d #c #c1 #b #b1 #lec #led #leb cases (le_to_or_lt_eq β¦ led)
+ [#ltd @(transitive_le β¦ (Hind β¦ lec ? leb)) [@le_S_S_to_le @ltd]
+ >h_of_aux_S @(transitive_le ???? (le_plus_n β¦))
+ >(times_n_1 (h_of_aux r c1 m b1)) in β’ (?%?);
+ >commutative_times @le_times [//|@(transitive_le β¦ (Hr ?)) @sU_le]
+ |#Hd >Hd >h_of_aux_S >h_of_aux_S
+ cut (b-S m β€ b1 - S m) [/2 by monotonic_le_minus_l/] #Hb1
+ @le_plus [@le_times //]
+ [@monotonic_MSC @le_pair @le_pair //
+ |@le_times [//] @monotonic_sU
+ [@le_pair // |// |@monor @Hind //]
+ ]
+ ]
+ ]
+qed.
+
+lemma mono_h_of2: βr.(βx. x β€ r x) β monotonic ? le r β
+ βi,b,b1. b β€ b1 β h_of r β©i,bβͺ β€ h_of r β©i,b1βͺ.
+#r #Hr #Hmono #i #a #b #leab >h_of_def >h_of_def
+cut (max i a β€ max i b)
+ [@to_max
+ [@(le_maxl β¦ (le_n β¦))|@(transitive_le β¦ leab) @(le_maxr β¦ (le_n β¦))]]
+#Hmax @(mono_h_of_aux r Hr Hmono)
+ [@monotonic_MSC @le_pair @le_pair @Hmax |/2 by monotonic_le_minus_l/ |@leab]
+qed.
+
+axiom h_of_constr : βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ constructible (h_of r).
+
+lemma speed_compl: βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ CF (h_of r) (unary_g (Ξ»i,x. r(h_of r β©i,xβͺ))).
+#r #Hr #Hmono #Hconstr @(monotonic_CF β¦ (compl_g11 β¦))
+ [#x cases (surj_pair x) #a * #b #eqx >eqx
+ >sg_def cases (decidable_le b a)
+ [#leba >(minus_to_0 β¦ leba) normalize in β’ (?%?);
+ <plus_n_O <plus_n_O >h_of_def
+ cut (max a b = a)
+ [normalize cases (le_to_or_lt_eq β¦ leba)
+ [#ltba >(lt_to_leb_false β¦ ltba) %
+ |#eqba <eqba >(le_to_leb_true β¦ (le_n ?)) % ]]
+ #Hmax >Hmax normalize >(minus_to_0 β¦ leba) normalize
+ @monotonic_MSC @le_pair @le_pair //
+ |#ltab >h_of_def >h_of_def
+ cut (max a b = b)
+ [normalize >(le_to_leb_true β¦ ) [%] @lt_to_le @not_le_to_lt @ltab]
+ #Hmax >Hmax
+ cut (max (S a) b = b)
+ [whd in β’ (??%?); >(le_to_leb_true β¦ ) [%] @not_le_to_lt @ltab]
+ #Hmax1 >Hmax1
+ cut (βd.b - a = S d)
+ [%{(pred(b-a))} >S_pred [//] @lt_plus_to_minus_r @not_le_to_lt @ltab]
+ * #d #eqd >eqd
+ cut (b-S a = d) [//] #eqd1 >eqd1 >h_of_aux_S >eqd1
+ cut (b - S d = a)
+ [@plus_to_minus >commutative_plus @minus_to_plus
+ [@lt_to_le @not_le_to_lt // | //]] #eqd2 >eqd2
+ normalize //
+ ]
+ |#n #a #b #leab #lebn >h_of_def >h_of_def
+ cut (max a n = n)
+ [normalize >le_to_leb_true [%|@(transitive_le β¦ leab lebn)]] #Hmaxa
+ cut (max b n = n)
+ [normalize >(le_to_leb_true β¦ lebn) %] #Hmaxb
+ >Hmaxa >Hmaxb @Hmono @(mono_h_of_aux r β¦ Hr Hmono) // /2 by monotonic_le_minus_r/
+ |#n #a #b #leab @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ leab)
+ |@(constr_comp β¦ Hconstr Hr) @(ext_constr (h_of r))
+ [#x cases (surj_pair x) #a * #b #eqx >eqx >fst_pair >snd_pair //]
+ @(h_of_constr r Hr Hmono Hconstr)
+ ]
+qed.
+
+(*
+lemma unary_g_def : βh,i,x. g h i x = unary_g h β©i,xβͺ.
+#h #i #x whd in β’ (???%); >fst_pair >snd_pair %
+qed. *)
+
+(* smn *)
+axiom smn: βf,s. CF s f β βx. CF (Ξ»y.s β©x,yβͺ) (Ξ»y.f β©x,yβͺ).
+
+lemma speed_compl_i: βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βi. CF (Ξ»x.h_of r β©i,xβͺ) (Ξ»x.g (Ξ»i,x. r(h_of r β©i,xβͺ)) i x).
+#r #Hr #Hmono #Hconstr #i
+@(ext_CF (Ξ»x.unary_g (Ξ»i,x. r(h_of r β©i,xβͺ)) β©i,xβͺ))
+ [#n whd in β’ (??%%); @eq_f @sym_eq >fst_pair >snd_pair %]
+@smn @(ext_CF β¦ (speed_compl r Hr Hmono Hconstr)) #n //
+qed.
+
+theorem pseudo_speedup:
+ βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§ O sf (r β sg).
+(* βm,a.βn. aβ€n β r(sg a) < m * sf n. *)
+#r #Hr #Hmono #Hconstr
+(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
+#Hcodei #HCi
+(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
+(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
+%{(Ξ»x. h_of r β©S i,xβͺ)}
+lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
+%[%[@condition_1 |@Hg]
+ |cases Hg #H1 * #j * #Hcodej #HCj
+ lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
+ cases HCi #m * #a #Ha %{m} %{(max (S i) a)} #n #ltin @lt_to_le @not_le_to_lt
+ @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf %{n} %
+ [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
+ cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
+ #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf) //
+ ]
+qed.
+
+theorem pseudo_speedup':
+ βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§
+ (* Β¬ O (r β sg) sf. *)
+ βm,a.βn. aβ€n β r(sg a) < m * sf n.
+#r #Hr #Hmono #Hconstr
+(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
+#Hcodei #HCi
+(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
+(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
+%{(Ξ»x. h_of r β©S i,xβͺ)}
+lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
+%[%[@condition_1 |@Hg]
+ |cases Hg #H1 * #j * #Hcodej #HCj
+ lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
+ cases HCi #m * #a #Ha
+ %{m} %{(max (S i) a)} #n #ltin @not_le_to_lt @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf
+ %{n} % [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
+ cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
+ #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf)
+ @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ ltin)
+ ]
+qed.
+
--- /dev/null
+include "basics/types.ma".
+include "arithmetics/minimization.ma".
+include "arithmetics/bigops.ma".
+include "arithmetics/sigma_pi.ma".
+include "arithmetics/bounded_quantifiers.ma".
+include "reverse_complexity/big_O.ma".
+include "basics/core_notation/napart_2.ma".
+
+(************************* notation for minimization *****************************)
+notation "ΞΌ_{ ident i < n } p"
+ with precedence 80 for @{min $n 0 (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β€ n } p"
+ with precedence 80 for @{min (S $n) 0 (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β [a,b[ } p"
+ with precedence 80 for @{min ($b-$a) $a (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β [a,b] } p"
+ with precedence 80 for @{min (S $b-$a) $a (Ξ»${ident i}.$p)}.
+
+(************************************ MAX *************************************)
+notation "Max_{ ident i < n | p } f"
+ with precedence 80
+for @{'bigop $n max 0 (Ξ»${ident i}. $p) (Ξ»${ident i}. $f)}.
+
+notation "Max_{ ident i < n } f"
+ with precedence 80
+for @{'bigop $n max 0 (Ξ»${ident i}.true) (Ξ»${ident i}. $f)}.
+
+notation "Max_{ ident j β [a,b[ } f"
+ with precedence 80
+for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.true) (${ident j}+$a)))
+ (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
+
+notation "Max_{ ident j β [a,b[ | p } f"
+ with precedence 80
+for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.$p) (${ident j}+$a)))
+ (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
+
+lemma Max_assoc: βa,b,c. max (max a b) c = max a (max b c).
+#a #b #c normalize cases (true_or_false (leb a b)) #leab >leab normalize
+ [cases (true_or_false (leb b c )) #lebc >lebc normalize
+ [>(le_to_leb_true a c) // @(transitive_le ? b) @leb_true_to_le //
+ |>leab //
+ ]
+ |cases (true_or_false (leb b c )) #lebc >lebc normalize //
+ >leab normalize >(not_le_to_leb_false a c) // @lt_to_not_le
+ @(transitive_lt ? b) @not_le_to_lt @leb_false_to_not_le //
+ ]
+qed.
+
+lemma Max0 : βn. max 0 n = n.
+// qed.
+
+lemma Max0r : βn. max n 0 = n.
+#n >commutative_max //
+qed.
+
+definition MaxA β
+ mk_Aop nat 0 max Max0 Max0r (Ξ»a,b,c.sym_eq β¦ (Max_assoc a b c)).
+
+definition MaxAC β mk_ACop nat 0 MaxA commutative_max.
+
+lemma le_Max: βf,p,n,a. a < n β p a = true β
+ f a β€ Max_{i < n | p i}(f i).
+#f #p #n #a #ltan #pa
+>(bigop_diff p ? 0 MaxAC f a n) // @(le_maxl β¦ (le_n ?))
+qed.
+
+lemma le_MaxI: βf,p,n,m,a. m β€ a β a < n β p a = true β
+ f a β€ Max_{i β [m,n[ | p i}(f i).
+#f #p #n #m #a #lema #ltan #pa
+>(bigop_diff ? ? 0 MaxAC (Ξ»i.f (i+m)) (a-m) (n-m))
+ [<plus_minus_m_m // @(le_maxl β¦ (le_n ?))
+ |<plus_minus_m_m //
+ |/2 by monotonic_lt_minus_l/
+ ]
+qed.
+
+lemma Max_le: βf,p,n,b.
+ (βa.a < n β p a = true β f a β€ b) β Max_{i < n | p i}(f i) β€ b.
+#f #p #n elim n #b #H //
+#b0 #H1 cases (true_or_false (p b)) #Hb
+ [>bigop_Strue [2:@Hb] @to_max [@H1 // | @H #a #ltab #pa @H1 // @le_S //]
+ |>bigop_Sfalse [2:@Hb] @H #a #ltab #pa @H1 // @le_S //
+ ]
+qed.
+
+(********************************** pairing ***********************************)
+axiom pair: nat β nat β nat.
+axiom fst : nat β nat.
+axiom snd : nat β nat.
+
+interpretation "abstract pair" 'pair f g = (pair f g).
+
+axiom fst_pair: βa,b. fst β©a,bβͺ = a.
+axiom snd_pair: βa,b. snd β©a,bβͺ = b.
+axiom surj_pair: βx. βa,b. x = β©a,bβͺ.
+
+axiom le_fst : βp. fst p β€ p.
+axiom le_snd : βp. snd p β€ p.
+axiom le_pair: βa,a1,b,b1. a β€ a1 β b β€ b1 β β©a,bβͺ β€ β©a1,b1βͺ.
+
+(************************************* U **************************************)
+axiom U: nat β nat βnat β option nat.
+
+axiom monotonic_U: βi,x,n,m,y.n β€m β
+ U i x n = Some ? y β U i x m = Some ? y.
+
+lemma unique_U: βi,x,n,m,yn,ym.
+ U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
+#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
+ [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
+ |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
+ >Hn #HS destruct (HS) //
+ ]
+qed.
+
+definition code_for β Ξ»f,i.βx.
+ βn.βm. n β€ m β U i x m = f x.
+
+definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
+
+notation "{i β x} β r" with precedence 60 for @{terminate $i $x $r}.
+
+lemma terminate_dec: βi,x,n. {i β x} β n β¨ Β¬ {i β x} β n.
+#i #x #n normalize cases (U i x n)
+ [%2 % * #y #H destruct|#y %1 %{y} //]
+qed.
+
+lemma monotonic_terminate: βi,x,n,m.
+ n β€ m β {i β x} β n β {i β x} β m.
+#i #x #n #m #lenm * #z #H %{z} @(monotonic_U β¦ H) //
+qed.
+
+definition termb β Ξ»i,x,t.
+ match U i x t with [None β false |Some y β true].
+
+lemma termb_true_to_term: βi,x,t. termb i x t = true β {i β x} β t.
+#i #x #t normalize cases (U i x t) normalize [#H destruct | #y #_ %{y} //]
+qed.
+
+lemma term_to_termb_true: βi,x,t. {i β x} β t β termb i x t = true.
+#i #x #t * #y #H normalize >H //
+qed.
+
+definition out β Ξ»i,x,r.
+ match U i x r with [ None β 0 | Some z β z].
+
+definition bool_to_nat: bool β nat β
+ Ξ»b. match b with [true β 1 | false β 0].
+
+coercion bool_to_nat.
+
+definition pU : nat β nat β nat β nat β Ξ»i,x,r.β©termb i x r,out i x rβͺ.
+
+lemma pU_vs_U_Some : βi,x,r,y. pU i x r = β©1,yβͺ β U i x r = Some ? y.
+#i #x #r #y % normalize
+ [cases (U i x r) normalize
+ [#H cut (0=1) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H @H]
+ #H1 destruct
+ |#a #H cut (a=y) [lapply (eq_f β¦ snd β¦ H) >snd_pair >snd_pair #H1 @H1]
+ #H1 //
+ ]
+ |#H >H //]
+qed.
+
+lemma pU_vs_U_None : βi,x,r. pU i x r = β©0,0βͺ β U i x r = None ?.
+#i #x #r % normalize
+ [cases (U i x r) normalize //
+ #a #H cut (1=0) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H1 @H1]
+ #H1 destruct
+ |#H >H //]
+qed.
+
+lemma fst_pU: βi,x,r. fst (pU i x r) = termb i x r.
+#i #x #r normalize cases (U i x r) normalize >fst_pair //
+qed.
+
+lemma snd_pU: βi,x,r. snd (pU i x r) = out i x r.
+#i #x #r normalize cases (U i x r) normalize >snd_pair //
+qed.
+
+(********************************* the speedup ********************************)
+
+definition min_input β Ξ»h,i,x. ΞΌ_{y β [S i,x] } (termb i y (h (S i) y)).
+
+lemma min_input_def : βh,i,x.
+ min_input h i x = min (x -i) (S i) (Ξ»y.termb i y (h (S i) y)).
+// qed.
+
+lemma min_input_i: βh,i,x. x β€ i β min_input h i x = S i.
+#h #i #x #lexi >min_input_def
+cut (x - i = 0) [@sym_eq /2 by eq_minus_O/] #Hcut //
+qed.
+
+lemma min_input_to_terminate: βh,i,x.
+ min_input h i x = x β {i β x} β (h (S i) x).
+#h #i #x #Hminx
+cases (decidable_le (S i) x) #Hix
+ [cases (true_or_false (termb i x (h (S i) x))) #Hcase
+ [@termb_true_to_term //
+ |<Hminx in Hcase; #H lapply (fmin_false (Ξ»x.termb i x (h (S i) x)) (x-i) (S i) H)
+ >min_input_def in Hminx; #Hminx >Hminx in β’ (%β?);
+ <plus_n_Sm <plus_minus_m_m [2: @lt_to_le //]
+ #Habs @False_ind /2/
+ ]
+ |@False_ind >min_input_i in Hminx;
+ [#eqix >eqix in Hix; * /2/ | @le_S_S_to_le @not_le_to_lt //]
+ ]
+qed.
+
+lemma min_input_to_lt: βh,i,x.
+ min_input h i x = x β i < x.
+#h #i #x #Hminx cases (decidable_le (S i) x) //
+#ltxi @False_ind >min_input_i in Hminx;
+ [#eqix >eqix in ltxi; * /2/ | @le_S_S_to_le @not_le_to_lt //]
+qed.
+
+lemma le_to_min_input: βh,i,x,x1. x β€ x1 β
+ min_input h i x = x β min_input h i x1 = x.
+#h #i #x #x1 #lex #Hminx @(min_exists β¦ (le_S_S β¦ lex))
+ [@(fmin_true β¦ (sym_eq β¦ Hminx)) //
+ |@(min_input_to_lt β¦ Hminx)
+ |#j #H1 <Hminx @lt_min_to_false //
+ |@plus_minus_m_m @le_S_S @(transitive_le β¦ lex) @lt_to_le
+ @(min_input_to_lt β¦ Hminx)
+ ]
+qed.
+
+definition g β Ξ»h,u,x.
+ S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
+
+lemma g_def : βh,u,x. g h u x =
+ S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
+// qed.
+
+lemma le_u_to_g_1 : βh,u,x. x β€ u β g h u x = 1.
+#h #u #x #lexu >g_def cut (x-u = 0) [/2 by minus_le_minus_minus_comm/]
+#eq0 >eq0 normalize // qed.
+
+lemma g_lt : βh,i,x. min_input h i x = x β
+ out i x (h (S i) x) < g h 0 x.
+#h #i #x #H @le_S_S @(le_MaxI β¦ i) /2 by min_input_to_lt/
+qed.
+
+lemma max_neq0 : βa,b. max a b β 0 β a β 0 β¨ b β 0.
+#a #b whd in match (max a b); cases (true_or_false (leb a b)) #Hcase >Hcase
+ [#H %2 @H | #H %1 @H]
+qed.
+
+definition almost_equal β Ξ»f,g:nat β nat. Β¬ βnu.βx. nu < x β§ f x β g x.
+interpretation "almost equal" 'napart f g = (almost_equal f g).
+
+lemma eventually_cancelled: βh,u.Β¬βnu.βx. nu < x β§
+ max_{i β [0,u[ | eqb (min_input h i x) x} (out i x (h (S i) x)) β 0.
+#h #u elim u
+ [normalize % #H cases (H u) #x * #_ * #H1 @H1 //
+ |#u0 @not_to_not #Hind #nu cases (Hind nu) #x * #ltx
+ cases (true_or_false (eqb (min_input h (u0+O) x) x)) #Hcase
+ [>bigop_Strue [2:@Hcase] #Hmax cases (max_neq0 β¦ Hmax) -Hmax
+ [2: #H %{x} % // <minus_n_O @H]
+ #Hneq0 (* if x is not enough we retry with nu=x *)
+ cases (Hind x) #x1 * #ltx1
+ >bigop_Sfalse
+ [#H %{x1} % [@transitive_lt //| <minus_n_O @H]
+ |@not_eq_to_eqb_false >(le_to_min_input β¦ (eqb_true_to_eq β¦ Hcase))
+ [@lt_to_not_eq @ltx1 | @lt_to_le @ltx1]
+ ]
+ |>bigop_Sfalse [2:@Hcase] #H %{x} % // <minus_n_O @H
+ ]
+ ]
+qed.
+
+lemma condition_1: βh,u.g h 0 β g h u.
+#h #u @(not_to_not β¦ (eventually_cancelled h u))
+#H #nu cases (H (max u nu)) #x * #ltx #Hdiff
+%{x} % [@(le_to_lt_to_lt β¦ ltx) @(le_maxr β¦ (le_n β¦))] @(not_to_not β¦ Hdiff)
+#H @(eq_f ?? S) >(bigop_sumI 0 u x (Ξ»i:β.eqb (min_input h i x) x) nat 0 MaxA)
+ [>H // |@lt_to_le @(le_to_lt_to_lt β¦ltx) /2 by le_maxr/ |//]
+qed.
+
+(******************************** Condition 2 *********************************)
+definition total β Ξ»f.Ξ»x:nat. Some nat (f x).
+
+lemma exists_to_exists_min: βh,i. (βx. i < x β§ {i β x} β h (S i) x) β βy. min_input h i y = y.
+#h #i * #x * #ltix #Hx %{(min_input h i x)} @min_spec_to_min @found //
+ [@(f_min_true (Ξ»y:β.termb i y (h (S i) y))) %{x} % [% // | @term_to_termb_true //]
+ |#y #leiy #lty @(lt_min_to_false ????? lty) //
+ ]
+qed.
+
+lemma condition_2: βh,i. code_for (total (g h 0)) i β Β¬βx. i<x β§ {i β x} β h (S i) x.
+#h #i whd in β’(%β?); #H % #H1 cases (exists_to_exists_min β¦ H1) #y #Hminy
+lapply (g_lt β¦ Hminy)
+lapply (min_input_to_terminate β¦ Hminy) * #r #termy
+cases (H y) -H #ny #Hy
+cut (r = g h 0 y) [@(unique_U β¦ ny β¦ termy) @Hy //] #Hr
+whd in match (out ???); >termy >Hr
+#H @(absurd ? H) @le_to_not_lt @le_n
+qed.
+
+
+(********************************* complexity *********************************)
+
+(* We assume operations have a minimal structural complexity MSC.
+For instance, for time complexity, MSC is equal to the size of input.
+For space complexity, MSC is typically 0, since we only measure the
+space required in addition to dimension of the input. *)
+
+axiom MSC : nat β nat.
+axiom MSC_le: βn. MSC n β€ n.
+axiom monotonic_MSC: monotonic ? le MSC.
+axiom MSC_pair: βa,b. MSC β©a,bβͺ β€ MSC a + MSC b.
+
+(* C s i means i is running in O(s) *)
+
+definition C β Ξ»s,i.βc.βa.βx.a β€ x β βy.
+ U i x (c*(s x)) = Some ? y.
+
+(* C f s means f β O(s) where MSC βO(s) *)
+definition CF β Ξ»s,f.O s MSC β§ βi.code_for (total f) i β§ C s i.
+
+lemma ext_CF : βf,g,s. (βn. f n = g n) β CF s f β CF s g.
+#f #g #s #Hext * #HO * #i * #Hcode #HC % // %{i} %
+ [#x cases (Hcode x) #a #H %{a} whd in match (total ??); <Hext @H | //]
+qed.
+
+lemma monotonic_CF: βs1,s2,f.(βx. s1 x β€ s2 x) β CF s1 f β CF s2 f.
+#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
+ [cases HO #c * #a -HO #HO %{c} %{a} #n #lean @(transitive_le β¦ (HO n lean))
+ @le_times //
+ |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1 %{c} %{a} #n #lean
+ cases(Hs1 n lean) #y #Hy %{y} @(monotonic_U β¦Hy) @le_times //
+ ]
+qed.
+
+lemma O_to_CF: βs1,s2,f.O s2 s1 β CF s1 f β CF s2 f.
+#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
+ [@(O_trans β¦ H) //
+ |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1
+ cases H #c1 * #a1 #Ha1 %{(c*c1)} %{(a+a1)} #n #lean
+ cases(Hs1 n ?) [2:@(transitive_le β¦ lean) //] #y #Hy %{y} @(monotonic_U β¦Hy)
+ >associative_times @le_times // @Ha1 @(transitive_le β¦ lean) //
+ ]
+qed.
+
+lemma timesc_CF: βs,f,c.CF (Ξ»x.c*s x) f β CF s f.
+#s #f #c @O_to_CF @O_times_c
+qed.
+
+(********************************* composition ********************************)
+axiom CF_comp: βf,g,sf,sg,sh. CF sg g β CF sf f β
+ O sh (Ξ»x. sg x + sf (g x)) β CF sh (f β g).
+
+lemma CF_comp_ext: βf,g,h,sh,sf,sg. CF sg g β CF sf f β
+ (βx.f(g x) = h x) β O sh (Ξ»x. sg x + sf (g x)) β CF sh h.
+#f #g #h #sh #sf #sg #Hg #Hf #Heq #H @(ext_CF (f β g))
+ [#n normalize @Heq | @(CF_comp β¦ H) //]
+qed.
+
+
+(**************************** primitive operations*****************************)
+
+definition id β Ξ»x:nat.x.
+
+axiom CF_id: CF MSC id.
+axiom CF_compS: βh,f. CF h f β CF h (S β f).
+axiom CF_comp_fst: βh,f. CF h f β CF h (fst β f).
+axiom CF_comp_snd: βh,f. CF h f β CF h (snd β f).
+axiom CF_comp_pair: βh,f,g. CF h f β CF h g β CF h (Ξ»x. β©f x,g xβͺ).
+
+lemma CF_fst: CF MSC fst.
+@(ext_CF (fst β id)) [#n //] @(CF_comp_fst β¦ CF_id)
+qed.
+
+lemma CF_snd: CF MSC snd.
+@(ext_CF (snd β id)) [#n //] @(CF_comp_snd β¦ CF_id)
+qed.
+
+(************************************** eqb ***********************************)
+
+axiom CF_eqb: βh,f,g.
+ CF h f β CF h g β CF h (Ξ»x.eqb (f x) (g x)).
+
+(*********************************** maximum **********************************)
+
+axiom CF_max: βa,b.βp:nat βbool.βf,ha,hb,hp,hf,s.
+ CF ha a β CF hb b β CF hp p β CF hf f β
+ O s (Ξ»x.ha x + hb x + β_{i β[a x ,b x[ }(hp β©i,xβͺ + hf β©i,xβͺ)) β
+ CF s (Ξ»x.max_{i β[a x,b x[ | p β©i,xβͺ }(f β©i,xβͺ)).
+
+(******************************** minimization ********************************)
+
+axiom CF_mu: βa,b.βf:nat βbool.βsa,sb,sf,s.
+ CF sa a β CF sb b β CF sf f β
+ O s (Ξ»x.sa x + sb x + β_{i β[a x ,S(b x)[ }(sf β©i,xβͺ)) β
+ CF s (Ξ»x.ΞΌ_{i β[a x,b x] }(f β©i,xβͺ)).
+
+(************************************* smn ************************************)
+axiom smn: βf,s. CF s f β βx. CF (Ξ»y.s β©x,yβͺ) (Ξ»y.f β©x,yβͺ).
+
+(****************************** constructibility ******************************)
+
+definition constructible β Ξ»s. CF s s.
+
+lemma constr_comp : βs1,s2. constructible s1 β constructible s2 β
+ (βx. x β€ s2 x) β constructible (s2 β s1).
+#s1 #s2 #Hs1 #Hs2 #Hle @(CF_comp β¦ Hs1 Hs2) @O_plus @le_to_O #x [@Hle | //]
+qed.
+
+lemma ext_constr: βs1,s2. (βx.s1 x = s2 x) β
+ constructible s1 β constructible s2.
+#s1 #s2 #Hext #Hs1 @(ext_CF β¦ Hext) @(monotonic_CF β¦ Hs1) #x >Hext //
+qed.
+
+(********************************* simulation *********************************)
+
+axiom sU : nat β nat.
+
+axiom monotonic_sU: βi1,i2,x1,x2,s1,s2. i1 β€ i2 β x1 β€ x2 β s1 β€ s2 β
+ sU β©i1,β©x1,s1βͺβͺ β€ sU β©i2,β©x2,s2βͺβͺ.
+
+lemma monotonic_sU_aux : βx1,x2. fst x1 β€ fst x2 β fst (snd x1) β€ fst (snd x2) β
+snd (snd x1) β€ snd (snd x2) β sU x1 β€ sU x2.
+#x1 #x2 cases (surj_pair x1) #a1 * #y #eqx1 >eqx1 -eqx1 cases (surj_pair y)
+#b1 * #c1 #eqy >eqy -eqy
+cases (surj_pair x2) #a2 * #y2 #eqx2 >eqx2 -eqx2 cases (surj_pair y2)
+#b2 * #c2 #eqy2 >eqy2 -eqy2 >fst_pair >snd_pair >fst_pair >snd_pair
+>fst_pair >snd_pair >fst_pair >snd_pair @monotonic_sU
+qed.
+
+axiom sU_le: βi,x,s. s β€ sU β©i,β©x,sβͺβͺ.
+axiom sU_le_i: βi,x,s. MSC i β€ sU β©i,β©x,sβͺβͺ.
+axiom sU_le_x: βi,x,s. MSC x β€ sU β©i,β©x,sβͺβͺ.
+
+definition pU_unary β Ξ»p. pU (fst p) (fst (snd p)) (snd (snd p)).
+
+axiom CF_U : CF sU pU_unary.
+
+definition termb_unary β Ξ»x:β.termb (fst x) (fst (snd x)) (snd (snd x)).
+definition out_unary β Ξ»x:β.out (fst x) (fst (snd x)) (snd (snd x)).
+
+lemma CF_termb: CF sU termb_unary.
+@(ext_CF (fst β pU_unary)) [2: @CF_comp_fst @CF_U]
+#n whd in β’ (??%?); whd in β’ (??(?%)?); >fst_pair %
+qed.
+
+lemma CF_out: CF sU out_unary.
+@(ext_CF (snd β pU_unary)) [2: @CF_comp_snd @CF_U]
+#n whd in β’ (??%?); whd in β’ (??(?%)?); >snd_pair %
+qed.
+
+
+(******************** complexity of g ********************)
+
+definition unary_g β Ξ»h.Ξ»ux. g h (fst ux) (snd ux).
+definition auxg β
+ Ξ»h,ux. max_{i β[fst ux,snd ux[ | eqb (min_input h i (snd ux)) (snd ux)}
+ (out i (snd ux) (h (S i) (snd ux))).
+
+lemma compl_g1 : βh,s. CF s (auxg h) β CF s (unary_g h).
+#h #s #H1 @(CF_compS ? (auxg h) H1)
+qed.
+
+definition aux1g β
+ Ξ»h,ux. max_{i β[fst ux,snd ux[ | (Ξ»p. eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β©i,uxβͺ}
+ ((Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β©i,uxβͺ).
+
+lemma eq_aux : βh,x.aux1g h x = auxg h x.
+#h #x @same_bigop
+ [#n #_ >fst_pair >snd_pair // |#n #_ #_ >fst_pair >snd_pair //]
+qed.
+
+lemma compl_g2 : βh,s1,s2,s.
+ CF s1
+ (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β
+ CF s2
+ (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β
+ O s (Ξ»x.MSC x + β_{i β[fst x ,snd x[ }(s1 β©i,xβͺ+s2 β©i,xβͺ)) β
+ CF s (auxg h).
+#h #s1 #s2 #s #Hs1 #Hs2 #HO @(ext_CF (aux1g h))
+ [#n whd in β’ (??%%); @eq_aux]
+@(CF_max β¦ CF_fst CF_snd Hs1 Hs2 β¦) @(O_trans β¦ HO)
+@O_plus [@O_plus @O_plus_l // | @O_plus_r //]
+qed.
+
+lemma compl_g3 : βh,s.
+ CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))) β
+ CF s (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))).
+#h #s #H @(CF_eqb β¦ H) @(CF_comp β¦ CF_snd CF_snd) @(O_trans β¦ (proj1 β¦ H))
+@O_plus // %{1} %{0} #n #_ >commutative_times <times_n_1 @monotonic_MSC //
+qed.
+
+definition min_input_aux β Ξ»h,p.
+ ΞΌ_{y β [S (fst p),snd (snd p)] }
+ ((Ξ»x.termb (fst (snd x)) (fst x) (h (S (fst (snd x))) (fst x))) β©y,pβͺ).
+
+lemma min_input_eq : βh,p.
+ min_input_aux h p =
+ min_input h (fst p) (snd (snd p)).
+#h #p >min_input_def whd in β’ (??%?); >minus_S_S @min_f_g #i #_ #_
+whd in β’ (??%%); >fst_pair >snd_pair //
+qed.
+
+definition termb_aux β Ξ»h.
+ termb_unary β Ξ»p.β©fst (snd p),β©fst p,h (S (fst (snd p))) (fst p)βͺβͺ.
+
+lemma compl_g4 : βh,s1,s.
+ (CF s1
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
+ (O s (Ξ»x.MSC x + β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ))) β
+ CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #s1 #s #Hs1 #HO @(ext_CF (min_input_aux h))
+ [#n whd in β’ (??%%); @min_input_eq]
+@(CF_mu β¦ MSC MSC β¦ Hs1)
+ [@CF_compS @CF_fst
+ |@CF_comp_snd @CF_snd
+ |@(O_trans β¦ HO) @O_plus [@O_plus @O_plus_l // | @O_plus_r //]
+qed.
+
+(************************* a couple of technical lemmas ***********************)
+lemma minus_to_0: βa,b. a β€ b β minus a b = 0.
+#a elim a // #n #Hind *
+ [#H @False_ind /2 by absurd/ | #b normalize #H @Hind @le_S_S_to_le /2/]
+qed.
+
+lemma sigma_bound: βh,a,b. monotonic nat le h β
+ β_{i β [a,S b[ }(h i) β€ (S b-a)*h b.
+#h #a #b #H cases (decidable_le a b)
+ [#leab cut (b = pred (S b - a + a))
+ [<plus_minus_m_m // @le_S //] #Hb >Hb in match (h b);
+ generalize in match (S b -a);
+ #n elim n
+ [//
+ |#m #Hind >bigop_Strue [2://] @le_plus
+ [@H @le_n |@(transitive_le β¦ Hind) @le_times [//] @H //]
+ ]
+ |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
+ cut (S b -a = 0) [@minus_to_0 //] #Hcut >Hcut //
+ ]
+qed.
+
+lemma sigma_bound_decr: βh,a,b. (βa1,a2. a1 β€ a2 β a2 < b β h a2 β€ h a1) β
+ β_{i β [a,b[ }(h i) β€ (b-a)*h a.
+#h #a #b #H cases (decidable_le a b)
+ [#leab cut ((b -a) +a β€ b) [/2 by le_minus_to_plus_r/] generalize in match (b -a);
+ #n elim n
+ [//
+ |#m #Hind >bigop_Strue [2://] #Hm
+ cut (m+a β€ b) [@(transitive_le β¦ Hm) //] #Hm1
+ @le_plus [@H // |@(transitive_le β¦ (Hind Hm1)) //]
+ ]
+ |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
+ cut (b -a = 0) [@minus_to_0 @lt_to_le @ltba] #Hcut >Hcut //
+ ]
+qed.
+
+lemma coroll: βs1:natβnat. (βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
+O (Ξ»x.(snd (snd x)-fst x)*(s1 β©snd (snd x),xβͺ))
+ (Ξ»x.β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ)).
+#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
+@(transitive_le β¦ (sigma_bound β¦)) [@Hs1|>minus_S_S //]
+qed.
+
+lemma coroll2: βs1:natβnat. (βn,a,b. a β€ b β b < snd n β s1 β©b,nβͺ β€ s1 β©a,nβͺ) β
+O (Ξ»x.(snd x - fst x)*s1 β©fst x,xβͺ) (Ξ»x.β_{i β[fst x,snd x[ }(s1 β©i,xβͺ)).
+#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
+@(transitive_le β¦ (sigma_bound_decr β¦)) [2://] @Hs1
+qed.
+
+(**************************** end of technical lemmas *************************)
+
+lemma compl_g5 : βh,s1.(βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
+ (CF s1
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
+ CF (Ξ»x.MSC x + (snd (snd x)-fst x)*s1 β©snd (snd x),xβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #s1 #Hmono #Hs1 @(compl_g4 β¦ Hs1) @O_plus
+[@O_plus_l // |@O_plus_r @coroll @Hmono]
+qed.
+
+lemma compl_g6: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (CF (Ξ»x. sU β©max (fst (snd x)) (snd (snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ)
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))).
+#h #hconstr @(ext_CF (termb_aux h))
+ [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
+@(CF_comp β¦ (Ξ»x.MSC x + h (S (fst (snd x))) (fst x)) β¦ CF_termb)
+ [@CF_comp_pair
+ [@CF_comp_fst @(monotonic_CF β¦ CF_snd) #x //
+ |@CF_comp_pair
+ [@(monotonic_CF β¦ CF_fst) #x //
+ |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst (snd x)),fst xβͺ)))
+ [#n normalize >fst_pair >snd_pair %]
+ @(CF_comp β¦ MSC β¦hconstr)
+ [@CF_comp_pair [@CF_compS @CF_comp_fst // |//]
+ |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
+ ]
+ ]
+ ]
+ |@O_plus
+ [@O_plus
+ [@(O_trans β¦ (Ξ»x.MSC (fst x) + MSC (max (fst (snd x)) (snd (snd x)))))
+ [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ >distributive_times_plus @le_plus [//]
+ cases (surj_pair b) #c * #d #eqb >eqb
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ whd in β’ (??%); @le_plus
+ [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
+ |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
+ ]
+ |@O_plus [@le_to_O #x @sU_le_x |@le_to_O #x @sU_le_i]
+ ]
+ |@le_to_O #n @sU_le
+ ]
+ |@le_to_O #x @monotonic_sU // @(le_maxl β¦ (le_n β¦)) ]
+ ]
+qed.
+
+definition big : nat βnat β Ξ»x.
+ let m β max (fst x) (snd x) in β©m,mβͺ.
+
+lemma big_def : βa,b. big β©a,bβͺ = β©max a b,max a bβͺ.
+#a #b normalize >fst_pair >snd_pair // qed.
+
+lemma le_big : βx. x β€ big x.
+#x cases (surj_pair x) #a * #b #eqx >eqx @le_pair >fst_pair >snd_pair
+[@(le_maxl β¦ (le_n β¦)) | @(le_maxr β¦ (le_n β¦))]
+qed.
+
+definition faux2 β Ξ»h.
+ (Ξ»x.MSC x + (snd (snd x)-fst x)*
+ (Ξ»x.sU β©max (fst(snd x)) (snd(snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ) β©snd (snd x),xβͺ).
+
+lemma compl_g7: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ CF (Ξ»x.MSC x + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #hcostr #hmono @(monotonic_CF β¦ (faux2 h))
+ [#n normalize >fst_pair >snd_pair //]
+@compl_g5 [2:@(compl_g6 h hcostr)] #n #x #y #lexy >fst_pair >snd_pair
+>fst_pair >snd_pair @monotonic_sU // @hmono @lexy
+qed.
+
+lemma compl_g71: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ CF (Ξ»x.MSC (big x) + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #hcostr #hmono @(monotonic_CF β¦ (compl_g7 h hcostr hmono)) #x
+@le_plus [@monotonic_MSC //]
+cases (decidable_le (fst x) (snd(snd x)))
+ [#Hle @le_times // @monotonic_sU
+ |#Hlt >(minus_to_0 β¦ (lt_to_le β¦ )) [// | @not_le_to_lt @Hlt]
+ ]
+qed.
+
+definition out_aux β Ξ»h.
+ out_unary β Ξ»p.β©fst p,β©snd(snd p),h (S (fst p)) (snd (snd p))βͺβͺ.
+
+lemma compl_g8: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (CF (Ξ»x. sU β©max (fst x) (snd x),β©snd(snd x),h (S (fst x)) (snd(snd x))βͺβͺ)
+ (Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p))))).
+#h #hconstr @(ext_CF (out_aux h))
+ [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
+@(CF_comp β¦ (Ξ»x.h (S (fst x)) (snd(snd x)) + MSC x) β¦ CF_out)
+ [@CF_comp_pair
+ [@(monotonic_CF β¦ CF_fst) #x //
+ |@CF_comp_pair
+ [@CF_comp_snd @(monotonic_CF β¦ CF_snd) #x //
+ |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst x),snd(snd x)βͺ)))
+ [#n normalize >fst_pair >snd_pair %]
+ @(CF_comp β¦ MSC β¦hconstr)
+ [@CF_comp_pair [@CF_compS // | @CF_comp_snd // ]
+ |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
+ ]
+ ]
+ ]
+ |@O_plus
+ [@O_plus
+ [@le_to_O #n @sU_le
+ |@(O_trans β¦ (Ξ»x.MSC (max (fst x) (snd x))))
+ [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ whd in β’ (??%); @le_plus
+ [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
+ |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
+ ]
+ |@le_to_O #x @(transitive_le ???? (sU_le_i β¦ )) //
+ ]
+ ]
+ |@le_to_O #x @monotonic_sU [@(le_maxl β¦ (le_n β¦))|//|//]
+ ]
+qed.
+
+lemma compl_g9 : βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
+ CF (Ξ»x. (S (snd x-fst x))*MSC β©x,xβͺ +
+ (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ)
+ (auxg h).
+#h #hconstr #hmono #hantimono
+@(compl_g2 h ??? (compl_g3 β¦ (compl_g71 h hconstr hmono)) (compl_g8 h hconstr))
+@O_plus
+ [@O_plus_l @le_to_O #x >(times_n_1 (MSC x)) >commutative_times @le_times
+ [// | @monotonic_MSC // ]]
+@(O_trans β¦ (coroll2 ??))
+ [#n #a #b #leab #ltb >fst_pair >fst_pair >snd_pair >snd_pair
+ cut (b β€ n) [@(transitive_le β¦ (le_snd β¦)) @lt_to_le //] #lebn
+ cut (max a n = n)
+ [normalize >le_to_leb_true [//|@(transitive_le β¦ leab lebn)]] #maxa
+ cut (max b n = n) [normalize >le_to_leb_true //] #maxb
+ @le_plus
+ [@le_plus [>big_def >big_def >maxa >maxb //]
+ @le_times
+ [/2 by monotonic_le_minus_r/
+ |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
+ ]
+ |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
+ ]
+ |@le_to_O #n >fst_pair >snd_pair
+ cut (max (fst n) n = n) [normalize >le_to_leb_true //] #Hmax >Hmax
+ >associative_plus >distributive_times_plus
+ @le_plus [@le_times [@le_S // |>big_def >Hmax //] |//]
+ ]
+qed.
+
+definition sg β Ξ»h,x.
+ (S (snd x-fst x))*MSC β©x,xβͺ + (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ.
+
+lemma sg_def : βh,a,b.
+ sg h β©a,bβͺ = (S (b-a))*MSC β©β©a,bβͺ,β©a,bβͺβͺ +
+ (b-a)*(S(b-a))*sU β©β©a,bβͺ,β©b,h (S a) bβͺβͺ.
+#h #a #b whd in β’ (??%?); >fst_pair >snd_pair //
+qed.
+
+lemma compl_g11 : βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
+ CF (sg h) (unary_g h).
+#h #hconstr #Hm #Ham @compl_g1 @(compl_g9 h hconstr Hm Ham)
+qed.
+
+(**************************** closing the argument ****************************)
+
+let rec h_of_aux (r:nat βnat) (c,d,b:nat) on d : nat β
+ match d with
+ [ O β c
+ | S d1 β (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
+ d*(S d)*sU β©β©b-d,bβͺ,β©b,r (h_of_aux r c d1 b)βͺβͺ].
+
+lemma h_of_aux_O: βr,c,b.
+ h_of_aux r c O b = c.
+// qed.
+
+lemma h_of_aux_S : βr,c,d,b.
+ h_of_aux r c (S d) b =
+ (S (S d))*(MSC β©β©b-(S d),bβͺ,β©b-(S d),bβͺβͺ) +
+ (S d)*(S (S d))*sU β©β©b-(S d),bβͺ,β©b,r(h_of_aux r c d b)βͺβͺ.
+// qed.
+
+definition h_of β Ξ»r,p.
+ let m β max (fst p) (snd p) in
+ h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (snd p - fst p) (snd p).
+
+lemma h_of_O: βr,a,b. b β€ a β
+ h_of r β©a,bβͺ = let m β max a b in MSC β©β©m,mβͺ,β©m,mβͺβͺ.
+#r #a #b #Hle normalize >fst_pair >snd_pair >(minus_to_0 β¦ Hle) //
+qed.
+
+lemma h_of_def: βr,a,b.h_of r β©a,bβͺ =
+ let m β max a b in
+ h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (b - a) b.
+#r #a #b normalize >fst_pair >snd_pair //
+qed.
+
+lemma mono_h_of_aux: βr.(βx. x β€ r x) β monotonic ? le r β
+ βd,d1,c,c1,b,b1.c β€ c1 β d β€ d1 β b β€ b1 β
+ h_of_aux r c d b β€ h_of_aux r c1 d1 b1.
+#r #Hr #monor #d #d1 lapply d -d elim d1
+ [#d #c #c1 #b #b1 #Hc #Hd @(le_n_O_elim ? Hd) #leb
+ >h_of_aux_O >h_of_aux_O //
+ |#m #Hind #d #c #c1 #b #b1 #lec #led #leb cases (le_to_or_lt_eq β¦ led)
+ [#ltd @(transitive_le β¦ (Hind β¦ lec ? leb)) [@le_S_S_to_le @ltd]
+ >h_of_aux_S @(transitive_le ???? (le_plus_n β¦))
+ >(times_n_1 (h_of_aux r c1 m b1)) in β’ (?%?);
+ >commutative_times @le_times [//|@(transitive_le β¦ (Hr ?)) @sU_le]
+ |#Hd >Hd >h_of_aux_S >h_of_aux_S
+ cut (b-S m β€ b1 - S m) [/2 by monotonic_le_minus_l/] #Hb1
+ @le_plus [@le_times //]
+ [@monotonic_MSC @le_pair @le_pair //
+ |@le_times [//] @monotonic_sU
+ [@le_pair // |// |@monor @Hind //]
+ ]
+ ]
+ ]
+qed.
+
+lemma mono_h_of2: βr.(βx. x β€ r x) β monotonic ? le r β
+ βi,b,b1. b β€ b1 β h_of r β©i,bβͺ β€ h_of r β©i,b1βͺ.
+#r #Hr #Hmono #i #a #b #leab >h_of_def >h_of_def
+cut (max i a β€ max i b)
+ [@to_max
+ [@(le_maxl β¦ (le_n β¦))|@(transitive_le β¦ leab) @(le_maxr β¦ (le_n β¦))]]
+#Hmax @(mono_h_of_aux r Hr Hmono)
+ [@monotonic_MSC @le_pair @le_pair @Hmax |/2 by monotonic_le_minus_l/ |@leab]
+qed.
+
+axiom h_of_constr : βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ constructible (h_of r).
+
+lemma speed_compl: βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ CF (h_of r) (unary_g (Ξ»i,x. r(h_of r β©i,xβͺ))).
+#r #Hr #Hmono #Hconstr @(monotonic_CF β¦ (compl_g11 β¦))
+ [#x cases (surj_pair x) #a * #b #eqx >eqx
+ >sg_def cases (decidable_le b a)
+ [#leba >(minus_to_0 β¦ leba) normalize in β’ (?%?);
+ <plus_n_O <plus_n_O >h_of_def
+ cut (max a b = a)
+ [normalize cases (le_to_or_lt_eq β¦ leba)
+ [#ltba >(lt_to_leb_false β¦ ltba) %
+ |#eqba <eqba >(le_to_leb_true β¦ (le_n ?)) % ]]
+ #Hmax >Hmax normalize >(minus_to_0 β¦ leba) normalize
+ @monotonic_MSC @le_pair @le_pair //
+ |#ltab >h_of_def >h_of_def
+ cut (max a b = b)
+ [normalize >(le_to_leb_true β¦ ) [%] @lt_to_le @not_le_to_lt @ltab]
+ #Hmax >Hmax
+ cut (max (S a) b = b)
+ [whd in β’ (??%?); >(le_to_leb_true β¦ ) [%] @not_le_to_lt @ltab]
+ #Hmax1 >Hmax1
+ cut (βd.b - a = S d)
+ [%{(pred(b-a))} >S_pred [//] @lt_plus_to_minus_r @not_le_to_lt @ltab]
+ * #d #eqd >eqd
+ cut (b-S a = d) [//] #eqd1 >eqd1 >h_of_aux_S >eqd1
+ cut (b - S d = a)
+ [@plus_to_minus >commutative_plus @minus_to_plus
+ [@lt_to_le @not_le_to_lt // | //]] #eqd2 >eqd2
+ normalize //
+ ]
+ |#n #a #b #leab #lebn >h_of_def >h_of_def
+ cut (max a n = n)
+ [normalize >le_to_leb_true [%|@(transitive_le β¦ leab lebn)]] #Hmaxa
+ cut (max b n = n)
+ [normalize >(le_to_leb_true β¦ lebn) %] #Hmaxb
+ >Hmaxa >Hmaxb @Hmono @(mono_h_of_aux r β¦ Hr Hmono) // /2 by monotonic_le_minus_r/
+ |#n #a #b #leab @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ leab)
+ |@(constr_comp β¦ Hconstr Hr) @(ext_constr (h_of r))
+ [#x cases (surj_pair x) #a * #b #eqx >eqx >fst_pair >snd_pair //]
+ @(h_of_constr r Hr Hmono Hconstr)
+ ]
+qed.
+
+lemma speed_compl_i: βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βi. CF (Ξ»x.h_of r β©i,xβͺ) (Ξ»x.g (Ξ»i,x. r(h_of r β©i,xβͺ)) i x).
+#r #Hr #Hmono #Hconstr #i
+@(ext_CF (Ξ»x.unary_g (Ξ»i,x. r(h_of r β©i,xβͺ)) β©i,xβͺ))
+ [#n whd in β’ (??%%); @eq_f @sym_eq >fst_pair >snd_pair %]
+@smn @(ext_CF β¦ (speed_compl r Hr Hmono Hconstr)) #n //
+qed.
+
+(**************************** the speedup theorem *****************************)
+theorem pseudo_speedup:
+ βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§ O sf (r β sg).
+(* βm,a.βn. aβ€n β r(sg a) < m * sf n. *)
+#r #Hr #Hmono #Hconstr
+(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
+#Hcodei #HCi
+(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
+(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
+%{(Ξ»x. h_of r β©S i,xβͺ)}
+lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
+%[%[@condition_1 |@Hg]
+ |cases Hg #H1 * #j * #Hcodej #HCj
+ lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
+ cases HCi #m * #a #Ha %{m} %{(max (S i) a)} #n #ltin @lt_to_le @not_le_to_lt
+ @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf %{n} %
+ [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
+ cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
+ #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf) //
+ ]
+qed.
+
+theorem pseudo_speedup':
+ βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§
+ (* Β¬ O (r β sg) sf. *)
+ βm,a.βn. aβ€n β r(sg a) < m * sf n.
+#r #Hr #Hmono #Hconstr
+(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
+#Hcodei #HCi
+(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
+(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
+%{(Ξ»x. h_of r β©S i,xβͺ)}
+lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
+%[%[@condition_1 |@Hg]
+ |cases Hg #H1 * #j * #Hcodej #HCj
+ lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
+ cases HCi #m * #a #Ha
+ %{m} %{(max (S i) a)} #n #ltin @not_le_to_lt @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf
+ %{n} % [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
+ cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
+ #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf)
+ @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ ltin)
+ ]
+qed.
+
--- /dev/null
+include "basics/types.ma".
+include "arithmetics/minimization.ma".
+include "arithmetics/bigops.ma".
+include "arithmetics/sigma_pi.ma".
+include "arithmetics/bounded_quantifiers.ma".
+include "reverse_complexity/big_O.ma".
+include "basics/core_notation/napart_2.ma".
+
+(************************* notation for minimization *****************************)
+notation "ΞΌ_{ ident i < n } p"
+ with precedence 80 for @{min $n 0 (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β€ n } p"
+ with precedence 80 for @{min (S $n) 0 (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β [a,b[ } p"
+ with precedence 80 for @{min ($b-$a) $a (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β [a,b] } p"
+ with precedence 80 for @{min (S $b-$a) $a (Ξ»${ident i}.$p)}.
+
+(************************************ MAX *************************************)
+notation "Max_{ ident i < n | p } f"
+ with precedence 80
+for @{'bigop $n max 0 (Ξ»${ident i}. $p) (Ξ»${ident i}. $f)}.
+
+notation "Max_{ ident i < n } f"
+ with precedence 80
+for @{'bigop $n max 0 (Ξ»${ident i}.true) (Ξ»${ident i}. $f)}.
+
+notation "Max_{ ident j β [a,b[ } f"
+ with precedence 80
+for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.true) (${ident j}+$a)))
+ (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
+
+notation "Max_{ ident j β [a,b[ | p } f"
+ with precedence 80
+for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.$p) (${ident j}+$a)))
+ (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
+
+lemma Max_assoc: βa,b,c. max (max a b) c = max a (max b c).
+#a #b #c normalize cases (true_or_false (leb a b)) #leab >leab normalize
+ [cases (true_or_false (leb b c )) #lebc >lebc normalize
+ [>(le_to_leb_true a c) // @(transitive_le ? b) @leb_true_to_le //
+ |>leab //
+ ]
+ |cases (true_or_false (leb b c )) #lebc >lebc normalize //
+ >leab normalize >(not_le_to_leb_false a c) // @lt_to_not_le
+ @(transitive_lt ? b) @not_le_to_lt @leb_false_to_not_le //
+ ]
+qed.
+
+lemma Max0 : βn. max 0 n = n.
+// qed.
+
+lemma Max0r : βn. max n 0 = n.
+#n >commutative_max //
+qed.
+
+definition MaxA β
+ mk_Aop nat 0 max Max0 Max0r (Ξ»a,b,c.sym_eq β¦ (Max_assoc a b c)).
+
+definition MaxAC β mk_ACop nat 0 MaxA commutative_max.
+
+lemma le_Max: βf,p,n,a. a < n β p a = true β
+ f a β€ Max_{i < n | p i}(f i).
+#f #p #n #a #ltan #pa
+>(bigop_diff p ? 0 MaxAC f a n) // @(le_maxl β¦ (le_n ?))
+qed.
+
+lemma le_MaxI: βf,p,n,m,a. m β€ a β a < n β p a = true β
+ f a β€ Max_{i β [m,n[ | p i}(f i).
+#f #p #n #m #a #lema #ltan #pa
+>(bigop_diff ? ? 0 MaxAC (Ξ»i.f (i+m)) (a-m) (n-m))
+ [<plus_minus_m_m // @(le_maxl β¦ (le_n ?))
+ |<plus_minus_m_m //
+ |/2 by monotonic_lt_minus_l/
+ ]
+qed.
+
+lemma Max_le: βf,p,n,b.
+ (βa.a < n β p a = true β f a β€ b) β Max_{i < n | p i}(f i) β€ b.
+#f #p #n elim n #b #H //
+#b0 #H1 cases (true_or_false (p b)) #Hb
+ [>bigop_Strue [2:@Hb] @to_max [@H1 // | @H #a #ltab #pa @H1 // @le_S //]
+ |>bigop_Sfalse [2:@Hb] @H #a #ltab #pa @H1 // @le_S //
+ ]
+qed.
+
+(********************************** pairing ***********************************)
+axiom pair: nat β nat β nat.
+axiom fst : nat β nat.
+axiom snd : nat β nat.
+
+interpretation "abstract pair" 'pair f g = (pair f g).
+
+axiom fst_pair: βa,b. fst β©a,bβͺ = a.
+axiom snd_pair: βa,b. snd β©a,bβͺ = b.
+axiom surj_pair: βx. βa,b. x = β©a,bβͺ.
+
+axiom le_fst : βp. fst p β€ p.
+axiom le_snd : βp. snd p β€ p.
+axiom le_pair: βa,a1,b,b1. a β€ a1 β b β€ b1 β β©a,bβͺ β€ β©a1,b1βͺ.
+
+(************************************* U **************************************)
+axiom U: nat β nat βnat β option nat.
+
+axiom monotonic_U: βi,x,n,m,y.n β€m β
+ U i x n = Some ? y β U i x m = Some ? y.
+
+lemma unique_U: βi,x,n,m,yn,ym.
+ U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
+#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
+ [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
+ |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
+ >Hn #HS destruct (HS) //
+ ]
+qed.
+
+definition code_for β Ξ»f,i.βx.
+ βn.βm. n β€ m β U i x m = f x.
+
+definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
+
+notation "{i β x} β r" with precedence 60 for @{terminate $i $x $r}.
+
+lemma terminate_dec: βi,x,n. {i β x} β n β¨ Β¬ {i β x} β n.
+#i #x #n normalize cases (U i x n)
+ [%2 % * #y #H destruct|#y %1 %{y} //]
+qed.
+
+lemma monotonic_terminate: βi,x,n,m.
+ n β€ m β {i β x} β n β {i β x} β m.
+#i #x #n #m #lenm * #z #H %{z} @(monotonic_U β¦ H) //
+qed.
+
+definition termb β Ξ»i,x,t.
+ match U i x t with [None β false |Some y β true].
+
+lemma termb_true_to_term: βi,x,t. termb i x t = true β {i β x} β t.
+#i #x #t normalize cases (U i x t) normalize [#H destruct | #y #_ %{y} //]
+qed.
+
+lemma term_to_termb_true: βi,x,t. {i β x} β t β termb i x t = true.
+#i #x #t * #y #H normalize >H //
+qed.
+
+definition out β Ξ»i,x,r.
+ match U i x r with [ None β 0 | Some z β z].
+
+definition bool_to_nat: bool β nat β
+ Ξ»b. match b with [true β 1 | false β 0].
+
+coercion bool_to_nat.
+
+definition pU : nat β nat β nat β nat β Ξ»i,x,r.β©termb i x r,out i x rβͺ.
+
+lemma pU_vs_U_Some : βi,x,r,y. pU i x r = β©1,yβͺ β U i x r = Some ? y.
+#i #x #r #y % normalize
+ [cases (U i x r) normalize
+ [#H cut (0=1) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H @H]
+ #H1 destruct
+ |#a #H cut (a=y) [lapply (eq_f β¦ snd β¦ H) >snd_pair >snd_pair #H1 @H1]
+ #H1 //
+ ]
+ |#H >H //]
+qed.
+
+lemma pU_vs_U_None : βi,x,r. pU i x r = β©0,0βͺ β U i x r = None ?.
+#i #x #r % normalize
+ [cases (U i x r) normalize //
+ #a #H cut (1=0) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H1 @H1]
+ #H1 destruct
+ |#H >H //]
+qed.
+
+lemma fst_pU: βi,x,r. fst (pU i x r) = termb i x r.
+#i #x #r normalize cases (U i x r) normalize >fst_pair //
+qed.
+
+lemma snd_pU: βi,x,r. snd (pU i x r) = out i x r.
+#i #x #r normalize cases (U i x r) normalize >snd_pair //
+qed.
+
+(********************************* the speedup ********************************)
+
+definition min_input β Ξ»h,i,x. ΞΌ_{y β [S i,x] } (termb i y (h (S i) y)).
+
+lemma min_input_def : βh,i,x.
+ min_input h i x = min (x -i) (S i) (Ξ»y.termb i y (h (S i) y)).
+// qed.
+
+lemma min_input_i: βh,i,x. x β€ i β min_input h i x = S i.
+#h #i #x #lexi >min_input_def
+cut (x - i = 0) [@sym_eq /2 by eq_minus_O/] #Hcut //
+qed.
+
+lemma min_input_to_terminate: βh,i,x.
+ min_input h i x = x β {i β x} β (h (S i) x).
+#h #i #x #Hminx
+cases (decidable_le (S i) x) #Hix
+ [cases (true_or_false (termb i x (h (S i) x))) #Hcase
+ [@termb_true_to_term //
+ |<Hminx in Hcase; #H lapply (fmin_false (Ξ»x.termb i x (h (S i) x)) (x-i) (S i) H)
+ >min_input_def in Hminx; #Hminx >Hminx in β’ (%β?);
+ <plus_n_Sm <plus_minus_m_m [2: @lt_to_le //]
+ #Habs @False_ind /2/
+ ]
+ |@False_ind >min_input_i in Hminx;
+ [#eqix >eqix in Hix; * /2/ | @le_S_S_to_le @not_le_to_lt //]
+ ]
+qed.
+
+lemma min_input_to_lt: βh,i,x.
+ min_input h i x = x β i < x.
+#h #i #x #Hminx cases (decidable_le (S i) x) //
+#ltxi @False_ind >min_input_i in Hminx;
+ [#eqix >eqix in ltxi; * /2/ | @le_S_S_to_le @not_le_to_lt //]
+qed.
+
+lemma le_to_min_input: βh,i,x,x1. x β€ x1 β
+ min_input h i x = x β min_input h i x1 = x.
+#h #i #x #x1 #lex #Hminx @(min_exists β¦ (le_S_S β¦ lex))
+ [@(fmin_true β¦ (sym_eq β¦ Hminx)) //
+ |@(min_input_to_lt β¦ Hminx)
+ |#j #H1 <Hminx @lt_min_to_false //
+ |@plus_minus_m_m @le_S_S @(transitive_le β¦ lex) @lt_to_le
+ @(min_input_to_lt β¦ Hminx)
+ ]
+qed.
+
+definition g β Ξ»h,u,x.
+ S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
+
+lemma g_def : βh,u,x. g h u x =
+ S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
+// qed.
+
+lemma le_u_to_g_1 : βh,u,x. x β€ u β g h u x = 1.
+#h #u #x #lexu >g_def cut (x-u = 0) [/2 by minus_le_minus_minus_comm/]
+#eq0 >eq0 normalize // qed.
+
+lemma g_lt : βh,i,x. min_input h i x = x β
+ out i x (h (S i) x) < g h 0 x.
+#h #i #x #H @le_S_S @(le_MaxI β¦ i) /2 by min_input_to_lt/
+qed.
+
+lemma max_neq0 : βa,b. max a b β 0 β a β 0 β¨ b β 0.
+#a #b whd in match (max a b); cases (true_or_false (leb a b)) #Hcase >Hcase
+ [#H %2 @H | #H %1 @H]
+qed.
+
+definition almost_equal β Ξ»f,g:nat β nat. Β¬ βnu.βx. nu < x β§ f x β g x.
+interpretation "almost equal" 'napart f g = (almost_equal f g).
+
+lemma eventually_cancelled: βh,u.Β¬βnu.βx. nu < x β§
+ max_{i β [0,u[ | eqb (min_input h i x) x} (out i x (h (S i) x)) β 0.
+#h #u elim u
+ [normalize % #H cases (H u) #x * #_ * #H1 @H1 //
+ |#u0 @not_to_not #Hind #nu cases (Hind nu) #x * #ltx
+ cases (true_or_false (eqb (min_input h (u0+O) x) x)) #Hcase
+ [>bigop_Strue [2:@Hcase] #Hmax cases (max_neq0 β¦ Hmax) -Hmax
+ [2: #H %{x} % // <minus_n_O @H]
+ #Hneq0 (* if x is not enough we retry with nu=x *)
+ cases (Hind x) #x1 * #ltx1
+ >bigop_Sfalse
+ [#H %{x1} % [@transitive_lt //| <minus_n_O @H]
+ |@not_eq_to_eqb_false >(le_to_min_input β¦ (eqb_true_to_eq β¦ Hcase))
+ [@lt_to_not_eq @ltx1 | @lt_to_le @ltx1]
+ ]
+ |>bigop_Sfalse [2:@Hcase] #H %{x} % // <minus_n_O @H
+ ]
+ ]
+qed.
+
+lemma condition_1: βh,u.g h 0 β g h u.
+#h #u @(not_to_not β¦ (eventually_cancelled h u))
+#H #nu cases (H (max u nu)) #x * #ltx #Hdiff
+%{x} % [@(le_to_lt_to_lt β¦ ltx) @(le_maxr β¦ (le_n β¦))] @(not_to_not β¦ Hdiff)
+#H @(eq_f ?? S) >(bigop_sumI 0 u x (Ξ»i:β.eqb (min_input h i x) x) nat 0 MaxA)
+ [>H // |@lt_to_le @(le_to_lt_to_lt β¦ltx) /2 by le_maxr/ |//]
+qed.
+
+(******************************** Condition 2 *********************************)
+definition total β Ξ»f.Ξ»x:nat. Some nat (f x).
+
+lemma exists_to_exists_min: βh,i. (βx. i < x β§ {i β x} β h (S i) x) β βy. min_input h i y = y.
+#h #i * #x * #ltix #Hx %{(min_input h i x)} @min_spec_to_min @found //
+ [@(f_min_true (Ξ»y:β.termb i y (h (S i) y))) %{x} % [% // | @term_to_termb_true //]
+ |#y #leiy #lty @(lt_min_to_false ????? lty) //
+ ]
+qed.
+
+lemma condition_2: βh,i. code_for (total (g h 0)) i β Β¬βx. i<x β§ {i β x} β h (S i) x.
+#h #i whd in β’(%β?); #H % #H1 cases (exists_to_exists_min β¦ H1) #y #Hminy
+lapply (g_lt β¦ Hminy)
+lapply (min_input_to_terminate β¦ Hminy) * #r #termy
+cases (H y) -H #ny #Hy
+cut (r = g h 0 y) [@(unique_U β¦ ny β¦ termy) @Hy //] #Hr
+whd in match (out ???); >termy >Hr
+#H @(absurd ? H) @le_to_not_lt @le_n
+qed.
+
+
+(********************************* complexity *********************************)
+
+(* We assume operations have a minimal structural complexity MSC.
+For instance, for time complexity, MSC is equal to the size of input.
+For space complexity, MSC is typically 0, since we only measure the
+space required in addition to dimension of the input. *)
+
+axiom MSC : nat β nat.
+axiom MSC_le: βn. MSC n β€ n.
+axiom monotonic_MSC: monotonic ? le MSC.
+axiom MSC_pair: βa,b. MSC β©a,bβͺ β€ MSC a + MSC b.
+
+(* C s i means i is running in O(s) *)
+
+definition C β Ξ»s,i.βc.βa.βx.a β€ x β βy.
+ U i x (c*(s x)) = Some ? y.
+
+(* C f s means f β O(s) where MSC βO(s) *)
+definition CF β Ξ»s,f.O s MSC β§ βi.code_for (total f) i β§ C s i.
+
+lemma ext_CF : βf,g,s. (βn. f n = g n) β CF s f β CF s g.
+#f #g #s #Hext * #HO * #i * #Hcode #HC % // %{i} %
+ [#x cases (Hcode x) #a #H %{a} whd in match (total ??); <Hext @H | //]
+qed.
+
+lemma monotonic_CF: βs1,s2,f.(βx. s1 x β€ s2 x) β CF s1 f β CF s2 f.
+#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
+ [cases HO #c * #a -HO #HO %{c} %{a} #n #lean @(transitive_le β¦ (HO n lean))
+ @le_times //
+ |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1 %{c} %{a} #n #lean
+ cases(Hs1 n lean) #y #Hy %{y} @(monotonic_U β¦Hy) @le_times //
+ ]
+qed.
+
+lemma O_to_CF: βs1,s2,f.O s2 s1 β CF s1 f β CF s2 f.
+#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
+ [@(O_trans β¦ H) //
+ |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1
+ cases H #c1 * #a1 #Ha1 %{(c*c1)} %{(a+a1)} #n #lean
+ cases(Hs1 n ?) [2:@(transitive_le β¦ lean) //] #y #Hy %{y} @(monotonic_U β¦Hy)
+ >associative_times @le_times // @Ha1 @(transitive_le β¦ lean) //
+ ]
+qed.
+
+lemma timesc_CF: βs,f,c.CF (Ξ»x.c*s x) f β CF s f.
+#s #f #c @O_to_CF @O_times_c
+qed.
+
+(********************************* composition ********************************)
+axiom CF_comp: βf,g,sf,sg,sh. CF sg g β CF sf f β
+ O sh (Ξ»x. sg x + sf (g x)) β CF sh (f β g).
+
+lemma CF_comp_ext: βf,g,h,sh,sf,sg. CF sg g β CF sf f β
+ (βx.f(g x) = h x) β O sh (Ξ»x. sg x + sf (g x)) β CF sh h.
+#f #g #h #sh #sf #sg #Hg #Hf #Heq #H @(ext_CF (f β g))
+ [#n normalize @Heq | @(CF_comp β¦ H) //]
+qed.
+
+
+(**************************** primitive operations*****************************)
+
+definition id β Ξ»x:nat.x.
+
+axiom CF_id: CF MSC id.
+axiom CF_compS: βh,f. CF h f β CF h (S β f).
+axiom CF_comp_fst: βh,f. CF h f β CF h (fst β f).
+axiom CF_comp_snd: βh,f. CF h f β CF h (snd β f).
+axiom CF_comp_pair: βh,f,g. CF h f β CF h g β CF h (Ξ»x. β©f x,g xβͺ).
+
+lemma CF_fst: CF MSC fst.
+@(ext_CF (fst β id)) [#n //] @(CF_comp_fst β¦ CF_id)
+qed.
+
+lemma CF_snd: CF MSC snd.
+@(ext_CF (snd β id)) [#n //] @(CF_comp_snd β¦ CF_id)
+qed.
+
+(************************************** eqb ***********************************)
+
+axiom CF_eqb: βh,f,g.
+ CF h f β CF h g β CF h (Ξ»x.eqb (f x) (g x)).
+
+(*********************************** maximum **********************************)
+
+axiom CF_max: βa,b.βp:nat βbool.βf,ha,hb,hp,hf,s.
+ CF ha a β CF hb b β CF hp p β CF hf f β
+ O s (Ξ»x.ha x + hb x + β_{i β[a x ,b x[ }(hp β©i,xβͺ + hf β©i,xβͺ)) β
+ CF s (Ξ»x.max_{i β[a x,b x[ | p β©i,xβͺ }(f β©i,xβͺ)).
+
+(******************************** minimization ********************************)
+
+axiom CF_mu: βa,b.βf:nat βbool.βsa,sb,sf,s.
+ CF sa a β CF sb b β CF sf f β
+ O s (Ξ»x.sa x + sb x + β_{i β[a x ,S(b x)[ }(sf β©i,xβͺ)) β
+ CF s (Ξ»x.ΞΌ_{i β[a x,b x] }(f β©i,xβͺ)).
+
+(************************************* smn ************************************)
+axiom smn: βf,s. CF s f β βx. CF (Ξ»y.s β©x,yβͺ) (Ξ»y.f β©x,yβͺ).
+
+(****************************** constructibility ******************************)
+
+definition constructible β Ξ»s. CF s s.
+
+lemma constr_comp : βs1,s2. constructible s1 β constructible s2 β
+ (βx. x β€ s2 x) β constructible (s2 β s1).
+#s1 #s2 #Hs1 #Hs2 #Hle @(CF_comp β¦ Hs1 Hs2) @O_plus @le_to_O #x [@Hle | //]
+qed.
+
+lemma ext_constr: βs1,s2. (βx.s1 x = s2 x) β
+ constructible s1 β constructible s2.
+#s1 #s2 #Hext #Hs1 @(ext_CF β¦ Hext) @(monotonic_CF β¦ Hs1) #x >Hext //
+qed.
+
+(********************************* simulation *********************************)
+
+axiom sU : nat β nat.
+
+axiom monotonic_sU: βi1,i2,x1,x2,s1,s2. i1 β€ i2 β x1 β€ x2 β s1 β€ s2 β
+ sU β©i1,β©x1,s1βͺβͺ β€ sU β©i2,β©x2,s2βͺβͺ.
+
+lemma monotonic_sU_aux : βx1,x2. fst x1 β€ fst x2 β fst (snd x1) β€ fst (snd x2) β
+snd (snd x1) β€ snd (snd x2) β sU x1 β€ sU x2.
+#x1 #x2 cases (surj_pair x1) #a1 * #y #eqx1 >eqx1 -eqx1 cases (surj_pair y)
+#b1 * #c1 #eqy >eqy -eqy
+cases (surj_pair x2) #a2 * #y2 #eqx2 >eqx2 -eqx2 cases (surj_pair y2)
+#b2 * #c2 #eqy2 >eqy2 -eqy2 >fst_pair >snd_pair >fst_pair >snd_pair
+>fst_pair >snd_pair >fst_pair >snd_pair @monotonic_sU
+qed.
+
+axiom sU_le: βi,x,s. s β€ sU β©i,β©x,sβͺβͺ.
+axiom sU_le_i: βi,x,s. MSC i β€ sU β©i,β©x,sβͺβͺ.
+axiom sU_le_x: βi,x,s. MSC x β€ sU β©i,β©x,sβͺβͺ.
+
+definition pU_unary β Ξ»p. pU (fst p) (fst (snd p)) (snd (snd p)).
+
+axiom CF_U : CF sU pU_unary.
+
+definition termb_unary β Ξ»x:β.termb (fst x) (fst (snd x)) (snd (snd x)).
+definition out_unary β Ξ»x:β.out (fst x) (fst (snd x)) (snd (snd x)).
+
+lemma CF_termb: CF sU termb_unary.
+@(ext_CF (fst β pU_unary)) [2: @CF_comp_fst @CF_U]
+#n whd in β’ (??%?); whd in β’ (??(?%)?); >fst_pair %
+qed.
+
+lemma CF_out: CF sU out_unary.
+@(ext_CF (snd β pU_unary)) [2: @CF_comp_snd @CF_U]
+#n whd in β’ (??%?); whd in β’ (??(?%)?); >snd_pair %
+qed.
+
+
+(******************** complexity of g ********************)
+
+definition unary_g β Ξ»h.Ξ»ux. g h (fst ux) (snd ux).
+definition auxg β
+ Ξ»h,ux. max_{i β[fst ux,snd ux[ | eqb (min_input h i (snd ux)) (snd ux)}
+ (out i (snd ux) (h (S i) (snd ux))).
+
+lemma compl_g1 : βh,s. CF s (auxg h) β CF s (unary_g h).
+#h #s #H1 @(CF_compS ? (auxg h) H1)
+qed.
+
+definition aux1g β
+ Ξ»h,ux. max_{i β[fst ux,snd ux[ | (Ξ»p. eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β©i,uxβͺ}
+ ((Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β©i,uxβͺ).
+
+lemma eq_aux : βh,x.aux1g h x = auxg h x.
+#h #x @same_bigop
+ [#n #_ >fst_pair >snd_pair // |#n #_ #_ >fst_pair >snd_pair //]
+qed.
+
+lemma compl_g2 : βh,s1,s2,s.
+ CF s1
+ (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β
+ CF s2
+ (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β
+ O s (Ξ»x.MSC x + β_{i β[fst x ,snd x[ }(s1 β©i,xβͺ+s2 β©i,xβͺ)) β
+ CF s (auxg h).
+#h #s1 #s2 #s #Hs1 #Hs2 #HO @(ext_CF (aux1g h))
+ [#n whd in β’ (??%%); @eq_aux]
+@(CF_max β¦ CF_fst CF_snd Hs1 Hs2 β¦) @(O_trans β¦ HO)
+@O_plus [@O_plus @O_plus_l // | @O_plus_r //]
+qed.
+
+lemma compl_g3 : βh,s.
+ CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))) β
+ CF s (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))).
+#h #s #H @(CF_eqb β¦ H) @(CF_comp β¦ CF_snd CF_snd) @(O_trans β¦ (proj1 β¦ H))
+@O_plus // %{1} %{0} #n #_ >commutative_times <times_n_1 @monotonic_MSC //
+qed.
+
+definition min_input_aux β Ξ»h,p.
+ ΞΌ_{y β [S (fst p),snd (snd p)] }
+ ((Ξ»x.termb (fst (snd x)) (fst x) (h (S (fst (snd x))) (fst x))) β©y,pβͺ).
+
+lemma min_input_eq : βh,p.
+ min_input_aux h p =
+ min_input h (fst p) (snd (snd p)).
+#h #p >min_input_def whd in β’ (??%?); >minus_S_S @min_f_g #i #_ #_
+whd in β’ (??%%); >fst_pair >snd_pair //
+qed.
+
+definition termb_aux β Ξ»h.
+ termb_unary β Ξ»p.β©fst (snd p),β©fst p,h (S (fst (snd p))) (fst p)βͺβͺ.
+
+lemma compl_g4 : βh,s1,s.
+ (CF s1
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
+ (O s (Ξ»x.MSC x + β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ))) β
+ CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #s1 #s #Hs1 #HO @(ext_CF (min_input_aux h))
+ [#n whd in β’ (??%%); @min_input_eq]
+@(CF_mu β¦ MSC MSC β¦ Hs1)
+ [@CF_compS @CF_fst
+ |@CF_comp_snd @CF_snd
+ |@(O_trans β¦ HO) @O_plus [@O_plus @O_plus_l // | @O_plus_r //]
+qed.
+
+(************************* a couple of technical lemmas ***********************)
+lemma minus_to_0: βa,b. a β€ b β minus a b = 0.
+#a elim a // #n #Hind *
+ [#H @False_ind /2 by absurd/ | #b normalize #H @Hind @le_S_S_to_le /2/]
+qed.
+
+lemma sigma_bound: βh,a,b. monotonic nat le h β
+ β_{i β [a,S b[ }(h i) β€ (S b-a)*h b.
+#h #a #b #H cases (decidable_le a b)
+ [#leab cut (b = pred (S b - a + a))
+ [<plus_minus_m_m // @le_S //] #Hb >Hb in match (h b);
+ generalize in match (S b -a);
+ #n elim n
+ [//
+ |#m #Hind >bigop_Strue [2://] @le_plus
+ [@H @le_n |@(transitive_le β¦ Hind) @le_times [//] @H //]
+ ]
+ |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
+ cut (S b -a = 0) [@minus_to_0 //] #Hcut >Hcut //
+ ]
+qed.
+
+lemma sigma_bound_decr: βh,a,b. (βa1,a2. a1 β€ a2 β a2 < b β h a2 β€ h a1) β
+ β_{i β [a,b[ }(h i) β€ (b-a)*h a.
+#h #a #b #H cases (decidable_le a b)
+ [#leab cut ((b -a) +a β€ b) [/2 by le_minus_to_plus_r/] generalize in match (b -a);
+ #n elim n
+ [//
+ |#m #Hind >bigop_Strue [2://] #Hm
+ cut (m+a β€ b) [@(transitive_le β¦ Hm) //] #Hm1
+ @le_plus [@H // |@(transitive_le β¦ (Hind Hm1)) //]
+ ]
+ |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
+ cut (b -a = 0) [@minus_to_0 @lt_to_le @ltba] #Hcut >Hcut //
+ ]
+qed.
+
+lemma coroll: βs1:natβnat. (βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
+O (Ξ»x.(snd (snd x)-fst x)*(s1 β©snd (snd x),xβͺ))
+ (Ξ»x.β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ)).
+#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
+@(transitive_le β¦ (sigma_bound β¦)) [@Hs1|>minus_S_S //]
+qed.
+
+lemma coroll2: βs1:natβnat. (βn,a,b. a β€ b β b < snd n β s1 β©b,nβͺ β€ s1 β©a,nβͺ) β
+O (Ξ»x.(snd x - fst x)*s1 β©fst x,xβͺ) (Ξ»x.β_{i β[fst x,snd x[ }(s1 β©i,xβͺ)).
+#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
+@(transitive_le β¦ (sigma_bound_decr β¦)) [2://] @Hs1
+qed.
+
+(**************************** end of technical lemmas *************************)
+
+lemma compl_g5 : βh,s1.(βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
+ (CF s1
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
+ CF (Ξ»x.MSC x + (snd (snd x)-fst x)*s1 β©snd (snd x),xβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #s1 #Hmono #Hs1 @(compl_g4 β¦ Hs1) @O_plus
+[@O_plus_l // |@O_plus_r @coroll @Hmono]
+qed.
+
+lemma compl_g6: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (CF (Ξ»x. sU β©max (fst (snd x)) (snd (snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ)
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))).
+#h #hconstr @(ext_CF (termb_aux h))
+ [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
+@(CF_comp β¦ (Ξ»x.MSC x + h (S (fst (snd x))) (fst x)) β¦ CF_termb)
+ [@CF_comp_pair
+ [@CF_comp_fst @(monotonic_CF β¦ CF_snd) #x //
+ |@CF_comp_pair
+ [@(monotonic_CF β¦ CF_fst) #x //
+ |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst (snd x)),fst xβͺ)))
+ [#n normalize >fst_pair >snd_pair %]
+ @(CF_comp β¦ MSC β¦hconstr)
+ [@CF_comp_pair [@CF_compS @CF_comp_fst // |//]
+ |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
+ ]
+ ]
+ ]
+ |@O_plus
+ [@O_plus
+ [@(O_trans β¦ (Ξ»x.MSC (fst x) + MSC (max (fst (snd x)) (snd (snd x)))))
+ [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ >distributive_times_plus @le_plus [//]
+ cases (surj_pair b) #c * #d #eqb >eqb
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ whd in β’ (??%); @le_plus
+ [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
+ |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
+ ]
+ |@O_plus [@le_to_O #x @sU_le_x |@le_to_O #x @sU_le_i]
+ ]
+ |@le_to_O #n @sU_le
+ ]
+ |@le_to_O #x @monotonic_sU // @(le_maxl β¦ (le_n β¦)) ]
+ ]
+qed.
+
+definition big : nat βnat β Ξ»x.
+ let m β max (fst x) (snd x) in β©m,mβͺ.
+
+lemma big_def : βa,b. big β©a,bβͺ = β©max a b,max a bβͺ.
+#a #b normalize >fst_pair >snd_pair // qed.
+
+lemma le_big : βx. x β€ big x.
+#x cases (surj_pair x) #a * #b #eqx >eqx @le_pair >fst_pair >snd_pair
+[@(le_maxl β¦ (le_n β¦)) | @(le_maxr β¦ (le_n β¦))]
+qed.
+
+definition faux2 β Ξ»h.
+ (Ξ»x.MSC x + (snd (snd x)-fst x)*
+ (Ξ»x.sU β©max (fst(snd x)) (snd(snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ) β©snd (snd x),xβͺ).
+
+lemma compl_g7: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ CF (Ξ»x.MSC x + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #hcostr #hmono @(monotonic_CF β¦ (faux2 h))
+ [#n normalize >fst_pair >snd_pair //]
+@compl_g5 [2:@(compl_g6 h hcostr)] #n #x #y #lexy >fst_pair >snd_pair
+>fst_pair >snd_pair @monotonic_sU // @hmono @lexy
+qed.
+
+lemma compl_g71: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ CF (Ξ»x.MSC (big x) + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #hcostr #hmono @(monotonic_CF β¦ (compl_g7 h hcostr hmono)) #x
+@le_plus [@monotonic_MSC //]
+cases (decidable_le (fst x) (snd(snd x)))
+ [#Hle @le_times // @monotonic_sU
+ |#Hlt >(minus_to_0 β¦ (lt_to_le β¦ )) [// | @not_le_to_lt @Hlt]
+ ]
+qed.
+
+definition out_aux β Ξ»h.
+ out_unary β Ξ»p.β©fst p,β©snd(snd p),h (S (fst p)) (snd (snd p))βͺβͺ.
+
+lemma compl_g8: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (CF (Ξ»x. sU β©max (fst x) (snd x),β©snd(snd x),h (S (fst x)) (snd(snd x))βͺβͺ)
+ (Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p))))).
+#h #hconstr @(ext_CF (out_aux h))
+ [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
+@(CF_comp β¦ (Ξ»x.h (S (fst x)) (snd(snd x)) + MSC x) β¦ CF_out)
+ [@CF_comp_pair
+ [@(monotonic_CF β¦ CF_fst) #x //
+ |@CF_comp_pair
+ [@CF_comp_snd @(monotonic_CF β¦ CF_snd) #x //
+ |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst x),snd(snd x)βͺ)))
+ [#n normalize >fst_pair >snd_pair %]
+ @(CF_comp β¦ MSC β¦hconstr)
+ [@CF_comp_pair [@CF_compS // | @CF_comp_snd // ]
+ |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
+ ]
+ ]
+ ]
+ |@O_plus
+ [@O_plus
+ [@le_to_O #n @sU_le
+ |@(O_trans β¦ (Ξ»x.MSC (max (fst x) (snd x))))
+ [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ whd in β’ (??%); @le_plus
+ [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
+ |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
+ ]
+ |@le_to_O #x @(transitive_le ???? (sU_le_i β¦ )) //
+ ]
+ ]
+ |@le_to_O #x @monotonic_sU [@(le_maxl β¦ (le_n β¦))|//|//]
+ ]
+qed.
+
+lemma compl_g9 : βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
+ CF (Ξ»x. (S (snd x-fst x))*MSC β©x,xβͺ +
+ (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ)
+ (auxg h).
+#h #hconstr #hmono #hantimono
+@(compl_g2 h ??? (compl_g3 β¦ (compl_g71 h hconstr hmono)) (compl_g8 h hconstr))
+@O_plus
+ [@O_plus_l @le_to_O #x >(times_n_1 (MSC x)) >commutative_times @le_times
+ [// | @monotonic_MSC // ]]
+@(O_trans β¦ (coroll2 ??))
+ [#n #a #b #leab #ltb >fst_pair >fst_pair >snd_pair >snd_pair
+ cut (b β€ n) [@(transitive_le β¦ (le_snd β¦)) @lt_to_le //] #lebn
+ cut (max a n = n)
+ [normalize >le_to_leb_true [//|@(transitive_le β¦ leab lebn)]] #maxa
+ cut (max b n = n) [normalize >le_to_leb_true //] #maxb
+ @le_plus
+ [@le_plus [>big_def >big_def >maxa >maxb //]
+ @le_times
+ [/2 by monotonic_le_minus_r/
+ |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
+ ]
+ |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
+ ]
+ |@le_to_O #n >fst_pair >snd_pair
+ cut (max (fst n) n = n) [normalize >le_to_leb_true //] #Hmax >Hmax
+ >associative_plus >distributive_times_plus
+ @le_plus [@le_times [@le_S // |>big_def >Hmax //] |//]
+ ]
+qed.
+
+definition sg β Ξ»h,x.
+ (S (snd x-fst x))*MSC β©x,xβͺ + (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ.
+
+lemma sg_def : βh,a,b.
+ sg h β©a,bβͺ = (S (b-a))*MSC β©β©a,bβͺ,β©a,bβͺβͺ +
+ (b-a)*(S(b-a))*sU β©β©a,bβͺ,β©b,h (S a) bβͺβͺ.
+#h #a #b whd in β’ (??%?); >fst_pair >snd_pair //
+qed.
+
+lemma compl_g11 : βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
+ CF (sg h) (unary_g h).
+#h #hconstr #Hm #Ham @compl_g1 @(compl_g9 h hconstr Hm Ham)
+qed.
+
+(**************************** closing the argument ****************************)
+
+let rec h_of_aux (r:nat βnat) (c,d,b:nat) on d : nat β
+ match d with
+ [ O β c
+ | S d1 β (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
+ d*(S d)*sU β©β©b-d,bβͺ,β©b,r (h_of_aux r c d1 b)βͺβͺ].
+
+lemma h_of_aux_O: βr,c,b.
+ h_of_aux r c O b = c.
+// qed.
+
+lemma h_of_aux_S : βr,c,d,b.
+ h_of_aux r c (S d) b =
+ (S (S d))*(MSC β©β©b-(S d),bβͺ,β©b-(S d),bβͺβͺ) +
+ (S d)*(S (S d))*sU β©β©b-(S d),bβͺ,β©b,r(h_of_aux r c d b)βͺβͺ.
+// qed.
+
+definition h_of β Ξ»r,p.
+ let m β max (fst p) (snd p) in
+ h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (snd p - fst p) (snd p).
+
+lemma h_of_O: βr,a,b. b β€ a β
+ h_of r β©a,bβͺ = let m β max a b in MSC β©β©m,mβͺ,β©m,mβͺβͺ.
+#r #a #b #Hle normalize >fst_pair >snd_pair >(minus_to_0 β¦ Hle) //
+qed.
+
+lemma h_of_def: βr,a,b.h_of r β©a,bβͺ =
+ let m β max a b in
+ h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (b - a) b.
+#r #a #b normalize >fst_pair >snd_pair //
+qed.
+
+lemma mono_h_of_aux: βr.(βx. x β€ r x) β monotonic ? le r β
+ βd,d1,c,c1,b,b1.c β€ c1 β d β€ d1 β b β€ b1 β
+ h_of_aux r c d b β€ h_of_aux r c1 d1 b1.
+#r #Hr #monor #d #d1 lapply d -d elim d1
+ [#d #c #c1 #b #b1 #Hc #Hd @(le_n_O_elim ? Hd) #leb
+ >h_of_aux_O >h_of_aux_O //
+ |#m #Hind #d #c #c1 #b #b1 #lec #led #leb cases (le_to_or_lt_eq β¦ led)
+ [#ltd @(transitive_le β¦ (Hind β¦ lec ? leb)) [@le_S_S_to_le @ltd]
+ >h_of_aux_S @(transitive_le ???? (le_plus_n β¦))
+ >(times_n_1 (h_of_aux r c1 m b1)) in β’ (?%?);
+ >commutative_times @le_times [//|@(transitive_le β¦ (Hr ?)) @sU_le]
+ |#Hd >Hd >h_of_aux_S >h_of_aux_S
+ cut (b-S m β€ b1 - S m) [/2 by monotonic_le_minus_l/] #Hb1
+ @le_plus [@le_times //]
+ [@monotonic_MSC @le_pair @le_pair //
+ |@le_times [//] @monotonic_sU
+ [@le_pair // |// |@monor @Hind //]
+ ]
+ ]
+ ]
+qed.
+
+lemma mono_h_of2: βr.(βx. x β€ r x) β monotonic ? le r β
+ βi,b,b1. b β€ b1 β h_of r β©i,bβͺ β€ h_of r β©i,b1βͺ.
+#r #Hr #Hmono #i #a #b #leab >h_of_def >h_of_def
+cut (max i a β€ max i b)
+ [@to_max
+ [@(le_maxl β¦ (le_n β¦))|@(transitive_le β¦ leab) @(le_maxr β¦ (le_n β¦))]]
+#Hmax @(mono_h_of_aux r Hr Hmono)
+ [@monotonic_MSC @le_pair @le_pair @Hmax |/2 by monotonic_le_minus_l/ |@leab]
+qed.
+
+axiom h_of_constr : βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ constructible (h_of r).
+
+lemma speed_compl: βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ CF (h_of r) (unary_g (Ξ»i,x. r(h_of r β©i,xβͺ))).
+#r #Hr #Hmono #Hconstr @(monotonic_CF β¦ (compl_g11 β¦))
+ [#x cases (surj_pair x) #a * #b #eqx >eqx
+ >sg_def cases (decidable_le b a)
+ [#leba >(minus_to_0 β¦ leba) normalize in β’ (?%?);
+ <plus_n_O <plus_n_O >h_of_def
+ cut (max a b = a)
+ [normalize cases (le_to_or_lt_eq β¦ leba)
+ [#ltba >(lt_to_leb_false β¦ ltba) %
+ |#eqba <eqba >(le_to_leb_true β¦ (le_n ?)) % ]]
+ #Hmax >Hmax normalize >(minus_to_0 β¦ leba) normalize
+ @monotonic_MSC @le_pair @le_pair //
+ |#ltab >h_of_def >h_of_def
+ cut (max a b = b)
+ [normalize >(le_to_leb_true β¦ ) [%] @lt_to_le @not_le_to_lt @ltab]
+ #Hmax >Hmax
+ cut (max (S a) b = b)
+ [whd in β’ (??%?); >(le_to_leb_true β¦ ) [%] @not_le_to_lt @ltab]
+ #Hmax1 >Hmax1
+ cut (βd.b - a = S d)
+ [%{(pred(b-a))} >S_pred [//] @lt_plus_to_minus_r @not_le_to_lt @ltab]
+ * #d #eqd >eqd
+ cut (b-S a = d) [//] #eqd1 >eqd1 >h_of_aux_S >eqd1
+ cut (b - S d = a)
+ [@plus_to_minus >commutative_plus @minus_to_plus
+ [@lt_to_le @not_le_to_lt // | //]] #eqd2 >eqd2
+ normalize //
+ ]
+ |#n #a #b #leab #lebn >h_of_def >h_of_def
+ cut (max a n = n)
+ [normalize >le_to_leb_true [%|@(transitive_le β¦ leab lebn)]] #Hmaxa
+ cut (max b n = n)
+ [normalize >(le_to_leb_true β¦ lebn) %] #Hmaxb
+ >Hmaxa >Hmaxb @Hmono @(mono_h_of_aux r β¦ Hr Hmono) // /2 by monotonic_le_minus_r/
+ |#n #a #b #leab @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ leab)
+ |@(constr_comp β¦ Hconstr Hr) @(ext_constr (h_of r))
+ [#x cases (surj_pair x) #a * #b #eqx >eqx >fst_pair >snd_pair //]
+ @(h_of_constr r Hr Hmono Hconstr)
+ ]
+qed.
+
+lemma speed_compl_i: βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βi. CF (Ξ»x.h_of r β©i,xβͺ) (Ξ»x.g (Ξ»i,x. r(h_of r β©i,xβͺ)) i x).
+#r #Hr #Hmono #Hconstr #i
+@(ext_CF (Ξ»x.unary_g (Ξ»i,x. r(h_of r β©i,xβͺ)) β©i,xβͺ))
+ [#n whd in β’ (??%%); @eq_f @sym_eq >fst_pair >snd_pair %]
+@smn @(ext_CF β¦ (speed_compl r Hr Hmono Hconstr)) #n //
+qed.
+
+(**************************** the speedup theorem *****************************)
+theorem pseudo_speedup:
+ βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§ O sf (r β sg).
+(* βm,a.βn. aβ€n β r(sg a) < m * sf n. *)
+#r #Hr #Hmono #Hconstr
+(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
+#Hcodei #HCi
+(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
+(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
+%{(Ξ»x. h_of r β©S i,xβͺ)}
+lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
+%[%[@condition_1 |@Hg]
+ |cases Hg #H1 * #j * #Hcodej #HCj
+ lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
+ cases HCi #m * #a #Ha %{m} %{(max (S i) a)} #n #ltin @lt_to_le @not_le_to_lt
+ @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf %{n} %
+ [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
+ cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
+ #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf) //
+ ]
+qed.
+
+theorem pseudo_speedup':
+ βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§
+ (* Β¬ O (r β sg) sf. *)
+ βm,a.βn. aβ€n β r(sg a) < m * sf n.
+#r #Hr #Hmono #Hconstr
+(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
+#Hcodei #HCi
+(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
+(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
+%{(Ξ»x. h_of r β©S i,xβͺ)}
+lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
+%[%[@condition_1 |@Hg]
+ |cases Hg #H1 * #j * #Hcodej #HCj
+ lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
+ cases HCi #m * #a #Ha
+ %{m} %{(max (S i) a)} #n #ltin @not_le_to_lt @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf
+ %{n} % [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
+ cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
+ #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf)
+ @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ ltin)
+ ]
+qed.
+
--- /dev/null
+include "basics/types.ma".
+include "arithmetics/minimization.ma".
+include "arithmetics/bigops.ma".
+include "arithmetics/sigma_pi.ma".
+include "arithmetics/bounded_quantifiers.ma".
+include "reverse_complexity/big_O.ma".
+include "basics/core_notation/napart_2.ma".
+
+(************************* notation for minimization *****************************)
+notation "ΞΌ_{ ident i < n } p"
+ with precedence 80 for @{min $n 0 (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β€ n } p"
+ with precedence 80 for @{min (S $n) 0 (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β [a,b[ } p"
+ with precedence 80 for @{min ($b-$a) $a (Ξ»${ident i}.$p)}.
+
+notation "ΞΌ_{ ident i β [a,b] } p"
+ with precedence 80 for @{min (S $b-$a) $a (Ξ»${ident i}.$p)}.
+
+(************************************ MAX *************************************)
+notation "Max_{ ident i < n | p } f"
+ with precedence 80
+for @{'bigop $n max 0 (Ξ»${ident i}. $p) (Ξ»${ident i}. $f)}.
+
+notation "Max_{ ident i < n } f"
+ with precedence 80
+for @{'bigop $n max 0 (Ξ»${ident i}.true) (Ξ»${ident i}. $f)}.
+
+notation "Max_{ ident j β [a,b[ } f"
+ with precedence 80
+for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.true) (${ident j}+$a)))
+ (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
+
+notation "Max_{ ident j β [a,b[ | p } f"
+ with precedence 80
+for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.$p) (${ident j}+$a)))
+ (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
+
+lemma Max_assoc: βa,b,c. max (max a b) c = max a (max b c).
+#a #b #c normalize cases (true_or_false (leb a b)) #leab >leab normalize
+ [cases (true_or_false (leb b c )) #lebc >lebc normalize
+ [>(le_to_leb_true a c) // @(transitive_le ? b) @leb_true_to_le //
+ |>leab //
+ ]
+ |cases (true_or_false (leb b c )) #lebc >lebc normalize //
+ >leab normalize >(not_le_to_leb_false a c) // @lt_to_not_le
+ @(transitive_lt ? b) @not_le_to_lt @leb_false_to_not_le //
+ ]
+qed.
+
+lemma Max0 : βn. max 0 n = n.
+// qed.
+
+lemma Max0r : βn. max n 0 = n.
+#n >commutative_max //
+qed.
+
+definition MaxA β
+ mk_Aop nat 0 max Max0 Max0r (Ξ»a,b,c.sym_eq β¦ (Max_assoc a b c)).
+
+definition MaxAC β mk_ACop nat 0 MaxA commutative_max.
+
+lemma le_Max: βf,p,n,a. a < n β p a = true β
+ f a β€ Max_{i < n | p i}(f i).
+#f #p #n #a #ltan #pa
+>(bigop_diff p ? 0 MaxAC f a n) // @(le_maxl β¦ (le_n ?))
+qed.
+
+lemma le_MaxI: βf,p,n,m,a. m β€ a β a < n β p a = true β
+ f a β€ Max_{i β [m,n[ | p i}(f i).
+#f #p #n #m #a #lema #ltan #pa
+>(bigop_diff ? ? 0 MaxAC (Ξ»i.f (i+m)) (a-m) (n-m))
+ [<plus_minus_m_m // @(le_maxl β¦ (le_n ?))
+ |<plus_minus_m_m //
+ |/2 by monotonic_lt_minus_l/
+ ]
+qed.
+
+lemma Max_le: βf,p,n,b.
+ (βa.a < n β p a = true β f a β€ b) β Max_{i < n | p i}(f i) β€ b.
+#f #p #n elim n #b #H //
+#b0 #H1 cases (true_or_false (p b)) #Hb
+ [>bigop_Strue [2:@Hb] @to_max [@H1 // | @H #a #ltab #pa @H1 // @le_S //]
+ |>bigop_Sfalse [2:@Hb] @H #a #ltab #pa @H1 // @le_S //
+ ]
+qed.
+
+(********************************** pairing ***********************************)
+axiom pair: nat β nat β nat.
+axiom fst : nat β nat.
+axiom snd : nat β nat.
+
+interpretation "abstract pair" 'pair f g = (pair f g).
+
+axiom fst_pair: βa,b. fst β©a,bβͺ = a.
+axiom snd_pair: βa,b. snd β©a,bβͺ = b.
+axiom surj_pair: βx. βa,b. x = β©a,bβͺ.
+
+axiom le_fst : βp. fst p β€ p.
+axiom le_snd : βp. snd p β€ p.
+axiom le_pair: βa,a1,b,b1. a β€ a1 β b β€ b1 β β©a,bβͺ β€ β©a1,b1βͺ.
+
+(************************************* U **************************************)
+axiom U: nat β nat βnat β option nat.
+
+axiom monotonic_U: βi,x,n,m,y.n β€m β
+ U i x n = Some ? y β U i x m = Some ? y.
+
+lemma unique_U: βi,x,n,m,yn,ym.
+ U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
+#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
+ [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
+ |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
+ >Hn #HS destruct (HS) //
+ ]
+qed.
+
+definition code_for β Ξ»f,i.βx.
+ βn.βm. n β€ m β U i x m = f x.
+
+definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
+
+notation "{i β x} β r" with precedence 60 for @{terminate $i $x $r}.
+
+lemma terminate_dec: βi,x,n. {i β x} β n β¨ Β¬ {i β x} β n.
+#i #x #n normalize cases (U i x n)
+ [%2 % * #y #H destruct|#y %1 %{y} //]
+qed.
+
+lemma monotonic_terminate: βi,x,n,m.
+ n β€ m β {i β x} β n β {i β x} β m.
+#i #x #n #m #lenm * #z #H %{z} @(monotonic_U β¦ H) //
+qed.
+
+definition termb β Ξ»i,x,t.
+ match U i x t with [None β false |Some y β true].
+
+lemma termb_true_to_term: βi,x,t. termb i x t = true β {i β x} β t.
+#i #x #t normalize cases (U i x t) normalize [#H destruct | #y #_ %{y} //]
+qed.
+
+lemma term_to_termb_true: βi,x,t. {i β x} β t β termb i x t = true.
+#i #x #t * #y #H normalize >H //
+qed.
+
+definition out β Ξ»i,x,r.
+ match U i x r with [ None β 0 | Some z β z].
+
+definition bool_to_nat: bool β nat β
+ Ξ»b. match b with [true β 1 | false β 0].
+
+coercion bool_to_nat.
+
+definition pU : nat β nat β nat β nat β Ξ»i,x,r.β©termb i x r,out i x rβͺ.
+
+lemma pU_vs_U_Some : βi,x,r,y. pU i x r = β©1,yβͺ β U i x r = Some ? y.
+#i #x #r #y % normalize
+ [cases (U i x r) normalize
+ [#H cut (0=1) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H @H]
+ #H1 destruct
+ |#a #H cut (a=y) [lapply (eq_f β¦ snd β¦ H) >snd_pair >snd_pair #H1 @H1]
+ #H1 //
+ ]
+ |#H >H //]
+qed.
+
+lemma pU_vs_U_None : βi,x,r. pU i x r = β©0,0βͺ β U i x r = None ?.
+#i #x #r % normalize
+ [cases (U i x r) normalize //
+ #a #H cut (1=0) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H1 @H1]
+ #H1 destruct
+ |#H >H //]
+qed.
+
+lemma fst_pU: βi,x,r. fst (pU i x r) = termb i x r.
+#i #x #r normalize cases (U i x r) normalize >fst_pair //
+qed.
+
+lemma snd_pU: βi,x,r. snd (pU i x r) = out i x r.
+#i #x #r normalize cases (U i x r) normalize >snd_pair //
+qed.
+
+(********************************* the speedup ********************************)
+
+definition min_input β Ξ»h,i,x. ΞΌ_{y β [S i,x] } (termb i y (h (S i) y)).
+
+lemma min_input_def : βh,i,x.
+ min_input h i x = min (x -i) (S i) (Ξ»y.termb i y (h (S i) y)).
+// qed.
+
+lemma min_input_i: βh,i,x. x β€ i β min_input h i x = S i.
+#h #i #x #lexi >min_input_def
+cut (x - i = 0) [@sym_eq /2 by eq_minus_O/] #Hcut //
+qed.
+
+lemma min_input_to_terminate: βh,i,x.
+ min_input h i x = x β {i β x} β (h (S i) x).
+#h #i #x #Hminx
+cases (decidable_le (S i) x) #Hix
+ [cases (true_or_false (termb i x (h (S i) x))) #Hcase
+ [@termb_true_to_term //
+ |<Hminx in Hcase; #H lapply (fmin_false (Ξ»x.termb i x (h (S i) x)) (x-i) (S i) H)
+ >min_input_def in Hminx; #Hminx >Hminx in β’ (%β?);
+ <plus_n_Sm <plus_minus_m_m [2: @lt_to_le //]
+ #Habs @False_ind /2/
+ ]
+ |@False_ind >min_input_i in Hminx;
+ [#eqix >eqix in Hix; * /2/ | @le_S_S_to_le @not_le_to_lt //]
+ ]
+qed.
+
+lemma min_input_to_lt: βh,i,x.
+ min_input h i x = x β i < x.
+#h #i #x #Hminx cases (decidable_le (S i) x) //
+#ltxi @False_ind >min_input_i in Hminx;
+ [#eqix >eqix in ltxi; * /2/ | @le_S_S_to_le @not_le_to_lt //]
+qed.
+
+lemma le_to_min_input: βh,i,x,x1. x β€ x1 β
+ min_input h i x = x β min_input h i x1 = x.
+#h #i #x #x1 #lex #Hminx @(min_exists β¦ (le_S_S β¦ lex))
+ [@(fmin_true β¦ (sym_eq β¦ Hminx)) //
+ |@(min_input_to_lt β¦ Hminx)
+ |#j #H1 <Hminx @lt_min_to_false //
+ |@plus_minus_m_m @le_S_S @(transitive_le β¦ lex) @lt_to_le
+ @(min_input_to_lt β¦ Hminx)
+ ]
+qed.
+
+definition g β Ξ»h,u,x.
+ S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
+
+lemma g_def : βh,u,x. g h u x =
+ S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
+// qed.
+
+lemma le_u_to_g_1 : βh,u,x. x β€ u β g h u x = 1.
+#h #u #x #lexu >g_def cut (x-u = 0) [/2 by minus_le_minus_minus_comm/]
+#eq0 >eq0 normalize // qed.
+
+lemma g_lt : βh,i,x. min_input h i x = x β
+ out i x (h (S i) x) < g h 0 x.
+#h #i #x #H @le_S_S @(le_MaxI β¦ i) /2 by min_input_to_lt/
+qed.
+
+lemma max_neq0 : βa,b. max a b β 0 β a β 0 β¨ b β 0.
+#a #b whd in match (max a b); cases (true_or_false (leb a b)) #Hcase >Hcase
+ [#H %2 @H | #H %1 @H]
+qed.
+
+definition almost_equal β Ξ»f,g:nat β nat. Β¬ βnu.βx. nu < x β§ f x β g x.
+interpretation "almost equal" 'napart f g = (almost_equal f g).
+
+lemma eventually_cancelled: βh,u.Β¬βnu.βx. nu < x β§
+ max_{i β [0,u[ | eqb (min_input h i x) x} (out i x (h (S i) x)) β 0.
+#h #u elim u
+ [normalize % #H cases (H u) #x * #_ * #H1 @H1 //
+ |#u0 @not_to_not #Hind #nu cases (Hind nu) #x * #ltx
+ cases (true_or_false (eqb (min_input h (u0+O) x) x)) #Hcase
+ [>bigop_Strue [2:@Hcase] #Hmax cases (max_neq0 β¦ Hmax) -Hmax
+ [2: #H %{x} % // <minus_n_O @H]
+ #Hneq0 (* if x is not enough we retry with nu=x *)
+ cases (Hind x) #x1 * #ltx1
+ >bigop_Sfalse
+ [#H %{x1} % [@transitive_lt //| <minus_n_O @H]
+ |@not_eq_to_eqb_false >(le_to_min_input β¦ (eqb_true_to_eq β¦ Hcase))
+ [@lt_to_not_eq @ltx1 | @lt_to_le @ltx1]
+ ]
+ |>bigop_Sfalse [2:@Hcase] #H %{x} % // <minus_n_O @H
+ ]
+ ]
+qed.
+
+lemma condition_1: βh,u.g h 0 β g h u.
+#h #u @(not_to_not β¦ (eventually_cancelled h u))
+#H #nu cases (H (max u nu)) #x * #ltx #Hdiff
+%{x} % [@(le_to_lt_to_lt β¦ ltx) @(le_maxr β¦ (le_n β¦))] @(not_to_not β¦ Hdiff)
+#H @(eq_f ?? S) >(bigop_sumI 0 u x (Ξ»i:β.eqb (min_input h i x) x) nat 0 MaxA)
+ [>H // |@lt_to_le @(le_to_lt_to_lt β¦ltx) /2 by le_maxr/ |//]
+qed.
+
+(******************************** Condition 2 *********************************)
+definition total β Ξ»f.Ξ»x:nat. Some nat (f x).
+
+lemma exists_to_exists_min: βh,i. (βx. i < x β§ {i β x} β h (S i) x) β βy. min_input h i y = y.
+#h #i * #x * #ltix #Hx %{(min_input h i x)} @min_spec_to_min @found //
+ [@(f_min_true (Ξ»y:β.termb i y (h (S i) y))) %{x} % [% // | @term_to_termb_true //]
+ |#y #leiy #lty @(lt_min_to_false ????? lty) //
+ ]
+qed.
+
+lemma condition_2: βh,i. code_for (total (g h 0)) i β Β¬βx. i<x β§ {i β x} β h (S i) x.
+#h #i whd in β’(%β?); #H % #H1 cases (exists_to_exists_min β¦ H1) #y #Hminy
+lapply (g_lt β¦ Hminy)
+lapply (min_input_to_terminate β¦ Hminy) * #r #termy
+cases (H y) -H #ny #Hy
+cut (r = g h 0 y) [@(unique_U β¦ ny β¦ termy) @Hy //] #Hr
+whd in match (out ???); >termy >Hr
+#H @(absurd ? H) @le_to_not_lt @le_n
+qed.
+
+
+(********************************* complexity *********************************)
+
+(* We assume operations have a minimal structural complexity MSC.
+For instance, for time complexity, MSC is equal to the size of input.
+For space complexity, MSC is typically 0, since we only measure the
+space required in addition to dimension of the input. *)
+
+axiom MSC : nat β nat.
+axiom MSC_le: βn. MSC n β€ n.
+axiom monotonic_MSC: monotonic ? le MSC.
+axiom MSC_pair: βa,b. MSC β©a,bβͺ β€ MSC a + MSC b.
+
+(* C s i means i is running in O(s) *)
+
+definition C β Ξ»s,i.βc.βa.βx.a β€ x β βy.
+ U i x (c*(s x)) = Some ? y.
+
+(* C f s means f β O(s) where MSC βO(s) *)
+definition CF β Ξ»s,f.O s MSC β§ βi.code_for (total f) i β§ C s i.
+
+lemma ext_CF : βf,g,s. (βn. f n = g n) β CF s f β CF s g.
+#f #g #s #Hext * #HO * #i * #Hcode #HC % // %{i} %
+ [#x cases (Hcode x) #a #H %{a} whd in match (total ??); <Hext @H | //]
+qed.
+
+lemma monotonic_CF: βs1,s2,f.(βx. s1 x β€ s2 x) β CF s1 f β CF s2 f.
+#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
+ [cases HO #c * #a -HO #HO %{c} %{a} #n #lean @(transitive_le β¦ (HO n lean))
+ @le_times //
+ |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1 %{c} %{a} #n #lean
+ cases(Hs1 n lean) #y #Hy %{y} @(monotonic_U β¦Hy) @le_times //
+ ]
+qed.
+
+lemma O_to_CF: βs1,s2,f.O s2 s1 β CF s1 f β CF s2 f.
+#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
+ [@(O_trans β¦ H) //
+ |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1
+ cases H #c1 * #a1 #Ha1 %{(c*c1)} %{(a+a1)} #n #lean
+ cases(Hs1 n ?) [2:@(transitive_le β¦ lean) //] #y #Hy %{y} @(monotonic_U β¦Hy)
+ >associative_times @le_times // @Ha1 @(transitive_le β¦ lean) //
+ ]
+qed.
+
+lemma timesc_CF: βs,f,c.CF (Ξ»x.c*s x) f β CF s f.
+#s #f #c @O_to_CF @O_times_c
+qed.
+
+(********************************* composition ********************************)
+axiom CF_comp: βf,g,sf,sg,sh. CF sg g β CF sf f β
+ O sh (Ξ»x. sg x + sf (g x)) β CF sh (f β g).
+
+lemma CF_comp_ext: βf,g,h,sh,sf,sg. CF sg g β CF sf f β
+ (βx.f(g x) = h x) β O sh (Ξ»x. sg x + sf (g x)) β CF sh h.
+#f #g #h #sh #sf #sg #Hg #Hf #Heq #H @(ext_CF (f β g))
+ [#n normalize @Heq | @(CF_comp β¦ H) //]
+qed.
+
+(* primitve recursion *)
+
+let rec prim_rec (k,h:nat βnat) n m on n β
+ match n with
+ [ O β k m
+ | S a β h β©a,β©prim_rec k h a m, mβͺβͺ].
+
+lemma prim_rec_S: βk,h,n,m.
+ prim_rec k h (S n) m = h β©n,β©prim_rec k h n m, mβͺβͺ.
+// qed.
+
+definition unary_pr β Ξ»k,h,x. prim_rec k h (fst x) (snd x).
+
+let rec prim_rec_compl (k,h,sk,sh:nat βnat) n m on n β
+ match n with
+ [ O β sk m
+ | S a β prim_rec_compl k h sk sh a m + sh (prim_rec k h a m)].
+
+axiom CF_prim_rec: βk,h,sk,sh,sf. CF sk k β CF sh h β
+ O sf (unary_pr sk (Ξ»x. fst (snd x) + sh β©fst x,β©unary_pr k h β©fst x,snd (snd x)βͺ,snd (snd x)βͺβͺ))
+ β CF sf (unary_pr k h).
+
+(* falso ????
+lemma prim_rec_O: βk1,h1,k2,h2. O k1 k2 β O h1 h2 β
+ O (unary_pr k1 h1) (unary_pr k2 h2).
+#k1 #h1 #k2 #h2 #HO1 #HO2 whd *)
+
+
+(**************************** primitive operations*****************************)
+
+definition id β Ξ»x:nat.x.
+
+axiom CF_id: CF MSC id.
+axiom CF_compS: βh,f. CF h f β CF h (S β f).
+axiom CF_comp_fst: βh,f. CF h f β CF h (fst β f).
+axiom CF_comp_snd: βh,f. CF h f β CF h (snd β f).
+axiom CF_comp_pair: βh,f,g. CF h f β CF h g β CF h (Ξ»x. β©f x,g xβͺ).
+
+lemma CF_fst: CF MSC fst.
+@(ext_CF (fst β id)) [#n //] @(CF_comp_fst β¦ CF_id)
+qed.
+
+lemma CF_snd: CF MSC snd.
+@(ext_CF (snd β id)) [#n //] @(CF_comp_snd β¦ CF_id)
+qed.
+
+(************************************** eqb ***********************************)
+
+axiom CF_eqb: βh,f,g.
+ CF h f β CF h g β CF h (Ξ»x.eqb (f x) (g x)).
+
+(*********************************** maximum **********************************)
+
+axiom CF_max: βa,b.βp:nat βbool.βf,ha,hb,hp,hf,s.
+ CF ha a β CF hb b β CF hp p β CF hf f β
+ O s (Ξ»x.ha x + hb x + β_{i β[a x ,b x[ }(hp β©i,xβͺ + hf β©i,xβͺ)) β
+ CF s (Ξ»x.max_{i β[a x,b x[ | p β©i,xβͺ }(f β©i,xβͺ)).
+
+(******************************** minimization ********************************)
+
+axiom CF_mu: βa,b.βf:nat βbool.βsa,sb,sf,s.
+ CF sa a β CF sb b β CF sf f β
+ O s (Ξ»x.sa x + sb x + β_{i β[a x ,S(b x)[ }(sf β©i,xβͺ)) β
+ CF s (Ξ»x.ΞΌ_{i β[a x,b x] }(f β©i,xβͺ)).
+
+(************************************* smn ************************************)
+axiom smn: βf,s. CF s f β βx. CF (Ξ»y.s β©x,yβͺ) (Ξ»y.f β©x,yβͺ).
+
+(****************************** constructibility ******************************)
+
+definition constructible β Ξ»s. CF s s.
+
+lemma constr_comp : βs1,s2. constructible s1 β constructible s2 β
+ (βx. x β€ s2 x) β constructible (s2 β s1).
+#s1 #s2 #Hs1 #Hs2 #Hle @(CF_comp β¦ Hs1 Hs2) @O_plus @le_to_O #x [@Hle | //]
+qed.
+
+lemma ext_constr: βs1,s2. (βx.s1 x = s2 x) β
+ constructible s1 β constructible s2.
+#s1 #s2 #Hext #Hs1 @(ext_CF β¦ Hext) @(monotonic_CF β¦ Hs1) #x >Hext //
+qed.
+
+lemma constr_prim_rec: βs1,s2. constructible s1 β constructible s2 β
+ (βn,r,m. 2 * r β€ s2 β©n,β©r,mβͺβͺ) β constructible (unary_pr s1 s2).
+#s1 #s2 #Hs1 #Hs2 #Hincr @(CF_prim_rec β¦ Hs1 Hs2) whd %{2} %{0}
+#x #_ lapply (surj_pair x) * #a * #b #eqx >eqx whd in match (unary_pr ???);
+>fst_pair >snd_pair
+whd in match (unary_pr ???); >fst_pair >snd_pair elim a
+ [normalize //
+ |#n #Hind >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair
+ >prim_rec_S @transitive_le [| @(monotonic_le_plus_l β¦ Hind)]
+ @transitive_le [| @(monotonic_le_plus_l β¦ (Hincr n ? b))]
+ whd in match (unary_pr ???); >fst_pair >snd_pair //
+ ]
+qed.
+
+(********************************* simulation *********************************)
+
+axiom sU : nat β nat.
+
+axiom monotonic_sU: βi1,i2,x1,x2,s1,s2. i1 β€ i2 β x1 β€ x2 β s1 β€ s2 β
+ sU β©i1,β©x1,s1βͺβͺ β€ sU β©i2,β©x2,s2βͺβͺ.
+
+lemma monotonic_sU_aux : βx1,x2. fst x1 β€ fst x2 β fst (snd x1) β€ fst (snd x2) β
+snd (snd x1) β€ snd (snd x2) β sU x1 β€ sU x2.
+#x1 #x2 cases (surj_pair x1) #a1 * #y #eqx1 >eqx1 -eqx1 cases (surj_pair y)
+#b1 * #c1 #eqy >eqy -eqy
+cases (surj_pair x2) #a2 * #y2 #eqx2 >eqx2 -eqx2 cases (surj_pair y2)
+#b2 * #c2 #eqy2 >eqy2 -eqy2 >fst_pair >snd_pair >fst_pair >snd_pair
+>fst_pair >snd_pair >fst_pair >snd_pair @monotonic_sU
+qed.
+
+axiom sU_le: βi,x,s. s β€ sU β©i,β©x,sβͺβͺ.
+axiom sU_le_i: βi,x,s. MSC i β€ sU β©i,β©x,sβͺβͺ.
+axiom sU_le_x: βi,x,s. MSC x β€ sU β©i,β©x,sβͺβͺ.
+
+definition pU_unary β Ξ»p. pU (fst p) (fst (snd p)) (snd (snd p)).
+
+axiom CF_U : CF sU pU_unary.
+
+definition termb_unary β Ξ»x:β.termb (fst x) (fst (snd x)) (snd (snd x)).
+definition out_unary β Ξ»x:β.out (fst x) (fst (snd x)) (snd (snd x)).
+
+lemma CF_termb: CF sU termb_unary.
+@(ext_CF (fst β pU_unary)) [2: @CF_comp_fst @CF_U]
+#n whd in β’ (??%?); whd in β’ (??(?%)?); >fst_pair %
+qed.
+
+lemma CF_out: CF sU out_unary.
+@(ext_CF (snd β pU_unary)) [2: @CF_comp_snd @CF_U]
+#n whd in β’ (??%?); whd in β’ (??(?%)?); >snd_pair %
+qed.
+
+
+(******************** complexity of g ********************)
+
+definition unary_g β Ξ»h.Ξ»ux. g h (fst ux) (snd ux).
+definition auxg β
+ Ξ»h,ux. max_{i β[fst ux,snd ux[ | eqb (min_input h i (snd ux)) (snd ux)}
+ (out i (snd ux) (h (S i) (snd ux))).
+
+lemma compl_g1 : βh,s. CF s (auxg h) β CF s (unary_g h).
+#h #s #H1 @(CF_compS ? (auxg h) H1)
+qed.
+
+definition aux1g β
+ Ξ»h,ux. max_{i β[fst ux,snd ux[ | (Ξ»p. eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β©i,uxβͺ}
+ ((Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β©i,uxβͺ).
+
+lemma eq_aux : βh,x.aux1g h x = auxg h x.
+#h #x @same_bigop
+ [#n #_ >fst_pair >snd_pair // |#n #_ #_ >fst_pair >snd_pair //]
+qed.
+
+lemma compl_g2 : βh,s1,s2,s.
+ CF s1
+ (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β
+ CF s2
+ (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β
+ O s (Ξ»x.MSC x + β_{i β[fst x ,snd x[ }(s1 β©i,xβͺ+s2 β©i,xβͺ)) β
+ CF s (auxg h).
+#h #s1 #s2 #s #Hs1 #Hs2 #HO @(ext_CF (aux1g h))
+ [#n whd in β’ (??%%); @eq_aux]
+@(CF_max β¦ CF_fst CF_snd Hs1 Hs2 β¦) @(O_trans β¦ HO)
+@O_plus [@O_plus @O_plus_l // | @O_plus_r //]
+qed.
+
+lemma compl_g3 : βh,s.
+ CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))) β
+ CF s (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))).
+#h #s #H @(CF_eqb β¦ H) @(CF_comp β¦ CF_snd CF_snd) @(O_trans β¦ (proj1 β¦ H))
+@O_plus // %{1} %{0} #n #_ >commutative_times <times_n_1 @monotonic_MSC //
+qed.
+
+definition min_input_aux β Ξ»h,p.
+ ΞΌ_{y β [S (fst p),snd (snd p)] }
+ ((Ξ»x.termb (fst (snd x)) (fst x) (h (S (fst (snd x))) (fst x))) β©y,pβͺ).
+
+lemma min_input_eq : βh,p.
+ min_input_aux h p =
+ min_input h (fst p) (snd (snd p)).
+#h #p >min_input_def whd in β’ (??%?); >minus_S_S @min_f_g #i #_ #_
+whd in β’ (??%%); >fst_pair >snd_pair //
+qed.
+
+definition termb_aux β Ξ»h.
+ termb_unary β Ξ»p.β©fst (snd p),β©fst p,h (S (fst (snd p))) (fst p)βͺβͺ.
+
+lemma compl_g4 : βh,s1,s.
+ (CF s1
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
+ (O s (Ξ»x.MSC x + β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ))) β
+ CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #s1 #s #Hs1 #HO @(ext_CF (min_input_aux h))
+ [#n whd in β’ (??%%); @min_input_eq]
+@(CF_mu β¦ MSC MSC β¦ Hs1)
+ [@CF_compS @CF_fst
+ |@CF_comp_snd @CF_snd
+ |@(O_trans β¦ HO) @O_plus [@O_plus @O_plus_l // | @O_plus_r //]
+qed.
+
+(************************* a couple of technical lemmas ***********************)
+lemma minus_to_0: βa,b. a β€ b β minus a b = 0.
+#a elim a // #n #Hind *
+ [#H @False_ind /2 by absurd/ | #b normalize #H @Hind @le_S_S_to_le /2/]
+qed.
+
+lemma sigma_bound: βh,a,b. monotonic nat le h β
+ β_{i β [a,S b[ }(h i) β€ (S b-a)*h b.
+#h #a #b #H cases (decidable_le a b)
+ [#leab cut (b = pred (S b - a + a))
+ [<plus_minus_m_m // @le_S //] #Hb >Hb in match (h b);
+ generalize in match (S b -a);
+ #n elim n
+ [//
+ |#m #Hind >bigop_Strue [2://] @le_plus
+ [@H @le_n |@(transitive_le β¦ Hind) @le_times [//] @H //]
+ ]
+ |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
+ cut (S b -a = 0) [@minus_to_0 //] #Hcut >Hcut //
+ ]
+qed.
+
+lemma sigma_bound_decr: βh,a,b. (βa1,a2. a1 β€ a2 β a2 < b β h a2 β€ h a1) β
+ β_{i β [a,b[ }(h i) β€ (b-a)*h a.
+#h #a #b #H cases (decidable_le a b)
+ [#leab cut ((b -a) +a β€ b) [/2 by le_minus_to_plus_r/] generalize in match (b -a);
+ #n elim n
+ [//
+ |#m #Hind >bigop_Strue [2://] #Hm
+ cut (m+a β€ b) [@(transitive_le β¦ Hm) //] #Hm1
+ @le_plus [@H // |@(transitive_le β¦ (Hind Hm1)) //]
+ ]
+ |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
+ cut (b -a = 0) [@minus_to_0 @lt_to_le @ltba] #Hcut >Hcut //
+ ]
+qed.
+
+lemma coroll: βs1:natβnat. (βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
+O (Ξ»x.(snd (snd x)-fst x)*(s1 β©snd (snd x),xβͺ))
+ (Ξ»x.β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ)).
+#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
+@(transitive_le β¦ (sigma_bound β¦)) [@Hs1|>minus_S_S //]
+qed.
+
+lemma coroll2: βs1:natβnat. (βn,a,b. a β€ b β b < snd n β s1 β©b,nβͺ β€ s1 β©a,nβͺ) β
+O (Ξ»x.(snd x - fst x)*s1 β©fst x,xβͺ) (Ξ»x.β_{i β[fst x,snd x[ }(s1 β©i,xβͺ)).
+#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
+@(transitive_le β¦ (sigma_bound_decr β¦)) [2://] @Hs1
+qed.
+
+(**************************** end of technical lemmas *************************)
+
+lemma compl_g5 : βh,s1.(βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
+ (CF s1
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
+ CF (Ξ»x.MSC x + (snd (snd x)-fst x)*s1 β©snd (snd x),xβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #s1 #Hmono #Hs1 @(compl_g4 β¦ Hs1) @O_plus
+[@O_plus_l // |@O_plus_r @coroll @Hmono]
+qed.
+
+lemma compl_g6: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (CF (Ξ»x. sU β©max (fst (snd x)) (snd (snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ)
+ (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))).
+#h #hconstr @(ext_CF (termb_aux h))
+ [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
+@(CF_comp β¦ (Ξ»x.MSC x + h (S (fst (snd x))) (fst x)) β¦ CF_termb)
+ [@CF_comp_pair
+ [@CF_comp_fst @(monotonic_CF β¦ CF_snd) #x //
+ |@CF_comp_pair
+ [@(monotonic_CF β¦ CF_fst) #x //
+ |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst (snd x)),fst xβͺ)))
+ [#n normalize >fst_pair >snd_pair %]
+ @(CF_comp β¦ MSC β¦hconstr)
+ [@CF_comp_pair [@CF_compS @CF_comp_fst // |//]
+ |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
+ ]
+ ]
+ ]
+ |@O_plus
+ [@O_plus
+ [@(O_trans β¦ (Ξ»x.MSC (fst x) + MSC (max (fst (snd x)) (snd (snd x)))))
+ [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ >distributive_times_plus @le_plus [//]
+ cases (surj_pair b) #c * #d #eqb >eqb
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ whd in β’ (??%); @le_plus
+ [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
+ |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
+ ]
+ |@O_plus [@le_to_O #x @sU_le_x |@le_to_O #x @sU_le_i]
+ ]
+ |@le_to_O #n @sU_le
+ ]
+ |@le_to_O #x @monotonic_sU // @(le_maxl β¦ (le_n β¦)) ]
+ ]
+qed.
+
+definition big : nat βnat β Ξ»x.
+ let m β max (fst x) (snd x) in β©m,mβͺ.
+
+lemma big_def : βa,b. big β©a,bβͺ = β©max a b,max a bβͺ.
+#a #b normalize >fst_pair >snd_pair // qed.
+
+lemma le_big : βx. x β€ big x.
+#x cases (surj_pair x) #a * #b #eqx >eqx @le_pair >fst_pair >snd_pair
+[@(le_maxl β¦ (le_n β¦)) | @(le_maxr β¦ (le_n β¦))]
+qed.
+
+definition faux2 β Ξ»h.
+ (Ξ»x.MSC x + (snd (snd x)-fst x)*
+ (Ξ»x.sU β©max (fst(snd x)) (snd(snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ) β©snd (snd x),xβͺ).
+
+lemma compl_g7: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ CF (Ξ»x.MSC x + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #hcostr #hmono @(monotonic_CF β¦ (faux2 h))
+ [#n normalize >fst_pair >snd_pair //]
+@compl_g5 [2:@(compl_g6 h hcostr)] #n #x #y #lexy >fst_pair >snd_pair
+>fst_pair >snd_pair @monotonic_sU // @hmono @lexy
+qed.
+
+lemma compl_g71: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ CF (Ξ»x.MSC (big x) + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
+ (Ξ»p:β.min_input h (fst p) (snd (snd p))).
+#h #hcostr #hmono @(monotonic_CF β¦ (compl_g7 h hcostr hmono)) #x
+@le_plus [@monotonic_MSC //]
+cases (decidable_le (fst x) (snd(snd x)))
+ [#Hle @le_times // @monotonic_sU
+ |#Hlt >(minus_to_0 β¦ (lt_to_le β¦ )) [// | @not_le_to_lt @Hlt]
+ ]
+qed.
+
+definition out_aux β Ξ»h.
+ out_unary β Ξ»p.β©fst p,β©snd(snd p),h (S (fst p)) (snd (snd p))βͺβͺ.
+
+lemma compl_g8: βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (CF (Ξ»x. sU β©max (fst x) (snd x),β©snd(snd x),h (S (fst x)) (snd(snd x))βͺβͺ)
+ (Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p))))).
+#h #hconstr @(ext_CF (out_aux h))
+ [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
+@(CF_comp β¦ (Ξ»x.h (S (fst x)) (snd(snd x)) + MSC x) β¦ CF_out)
+ [@CF_comp_pair
+ [@(monotonic_CF β¦ CF_fst) #x //
+ |@CF_comp_pair
+ [@CF_comp_snd @(monotonic_CF β¦ CF_snd) #x //
+ |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst x),snd(snd x)βͺ)))
+ [#n normalize >fst_pair >snd_pair %]
+ @(CF_comp β¦ MSC β¦hconstr)
+ [@CF_comp_pair [@CF_compS // | @CF_comp_snd // ]
+ |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
+ ]
+ ]
+ ]
+ |@O_plus
+ [@O_plus
+ [@le_to_O #n @sU_le
+ |@(O_trans β¦ (Ξ»x.MSC (max (fst x) (snd x))))
+ [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
+ >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
+ whd in β’ (??%); @le_plus
+ [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
+ |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
+ ]
+ |@le_to_O #x @(transitive_le ???? (sU_le_i β¦ )) //
+ ]
+ ]
+ |@le_to_O #x @monotonic_sU [@(le_maxl β¦ (le_n β¦))|//|//]
+ ]
+qed.
+
+lemma compl_g9 : βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
+ CF (Ξ»x. (S (snd x-fst x))*MSC β©x,xβͺ +
+ (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ)
+ (auxg h).
+#h #hconstr #hmono #hantimono
+@(compl_g2 h ??? (compl_g3 β¦ (compl_g71 h hconstr hmono)) (compl_g8 h hconstr))
+@O_plus
+ [@O_plus_l @le_to_O #x >(times_n_1 (MSC x)) >commutative_times @le_times
+ [// | @monotonic_MSC // ]]
+@(O_trans β¦ (coroll2 ??))
+ [#n #a #b #leab #ltb >fst_pair >fst_pair >snd_pair >snd_pair
+ cut (b β€ n) [@(transitive_le β¦ (le_snd β¦)) @lt_to_le //] #lebn
+ cut (max a n = n)
+ [normalize >le_to_leb_true [//|@(transitive_le β¦ leab lebn)]] #maxa
+ cut (max b n = n) [normalize >le_to_leb_true //] #maxb
+ @le_plus
+ [@le_plus [>big_def >big_def >maxa >maxb //]
+ @le_times
+ [/2 by monotonic_le_minus_r/
+ |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
+ ]
+ |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
+ ]
+ |@le_to_O #n >fst_pair >snd_pair
+ cut (max (fst n) n = n) [normalize >le_to_leb_true //] #Hmax >Hmax
+ >associative_plus >distributive_times_plus
+ @le_plus [@le_times [@le_S // |>big_def >Hmax //] |//]
+ ]
+qed.
+
+definition sg β Ξ»h,x.
+ (S (snd x-fst x))*MSC β©x,xβͺ + (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ.
+
+lemma sg_def : βh,a,b.
+ sg h β©a,bβͺ = (S (b-a))*MSC β©β©a,bβͺ,β©a,bβͺβͺ +
+ (b-a)*(S(b-a))*sU β©β©a,bβͺ,β©b,h (S a) bβͺβͺ.
+#h #a #b whd in β’ (??%?); >fst_pair >snd_pair //
+qed.
+
+lemma compl_g11 : βh.
+ constructible (Ξ»x. h (fst x) (snd x)) β
+ (βn. monotonic ? le (h n)) β
+ (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
+ CF (sg h) (unary_g h).
+#h #hconstr #Hm #Ham @compl_g1 @(compl_g9 h hconstr Hm Ham)
+qed.
+
+(**************************** closing the argument ****************************)
+
+let rec h_of_aux (r:nat βnat) (c,d,b:nat) on d : nat β
+ match d with
+ [ O β c
+ | S d1 β (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
+ d*(S d)*sU β©β©b-d,bβͺ,β©b,r (h_of_aux r c d1 b)βͺβͺ].
+
+lemma h_of_aux_O: βr,c,b.
+ h_of_aux r c O b = c.
+// qed.
+
+lemma h_of_aux_S : βr,c,d,b.
+ h_of_aux r c (S d) b =
+ (S (S d))*(MSC β©β©b-(S d),bβͺ,β©b-(S d),bβͺβͺ) +
+ (S d)*(S (S d))*sU β©β©b-(S d),bβͺ,β©b,r(h_of_aux r c d b)βͺβͺ.
+// qed.
+
+lemma h_of_aux_prim_rec : βr,c,n,b. h_of_aux r c n b =
+ prim_rec (Ξ»x.c)
+ (Ξ»x.let d β S(fst x) in
+ let b β snd (snd x) in
+ (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
+ d*(S d)*sU β©β©b-d,bβͺ,β©b,r (fst (snd x))βͺβͺ) n b.
+#r #c #n #b elim n
+ [>h_of_aux_O normalize //
+ |#n1 #Hind >h_of_aux_S >prim_rec_S >snd_pair >snd_pair >fst_pair
+ >fst_pair <Hind //
+ ]
+qed.
+
+lemma h_of_aux_constr :
+βr,c. constructible (Ξ»x.h_of_aux r c (fst x) (snd x)).
+#r #c
+ @(ext_constr β¦
+ (unary_pr (Ξ»x.c)
+ (Ξ»x.let d β S(fst x) in
+ let b β snd (snd x) in
+ (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
+ d*(S d)*sU β©β©b-d,bβͺ,β©b,r (fst (snd x))βͺβͺ)))
+ [#n @sym_eq whd in match (unary_pr ???); @h_of_aux_prim_rec
+ |@constr_prim_rec
+
+definition h_of β Ξ»r,p.
+ let m β max (fst p) (snd p) in
+ h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (snd p - fst p) (snd p).
+
+lemma h_of_O: βr,a,b. b β€ a β
+ h_of r β©a,bβͺ = let m β max a b in MSC β©β©m,mβͺ,β©m,mβͺβͺ.
+#r #a #b #Hle normalize >fst_pair >snd_pair >(minus_to_0 β¦ Hle) //
+qed.
+
+lemma h_of_def: βr,a,b.h_of r β©a,bβͺ =
+ let m β max a b in
+ h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (b - a) b.
+#r #a #b normalize >fst_pair >snd_pair //
+qed.
+
+lemma mono_h_of_aux: βr.(βx. x β€ r x) β monotonic ? le r β
+ βd,d1,c,c1,b,b1.c β€ c1 β d β€ d1 β b β€ b1 β
+ h_of_aux r c d b β€ h_of_aux r c1 d1 b1.
+#r #Hr #monor #d #d1 lapply d -d elim d1
+ [#d #c #c1 #b #b1 #Hc #Hd @(le_n_O_elim ? Hd) #leb
+ >h_of_aux_O >h_of_aux_O //
+ |#m #Hind #d #c #c1 #b #b1 #lec #led #leb cases (le_to_or_lt_eq β¦ led)
+ [#ltd @(transitive_le β¦ (Hind β¦ lec ? leb)) [@le_S_S_to_le @ltd]
+ >h_of_aux_S @(transitive_le ???? (le_plus_n β¦))
+ >(times_n_1 (h_of_aux r c1 m b1)) in β’ (?%?);
+ >commutative_times @le_times [//|@(transitive_le β¦ (Hr ?)) @sU_le]
+ |#Hd >Hd >h_of_aux_S >h_of_aux_S
+ cut (b-S m β€ b1 - S m) [/2 by monotonic_le_minus_l/] #Hb1
+ @le_plus [@le_times //]
+ [@monotonic_MSC @le_pair @le_pair //
+ |@le_times [//] @monotonic_sU
+ [@le_pair // |// |@monor @Hind //]
+ ]
+ ]
+ ]
+qed.
+
+lemma mono_h_of2: βr.(βx. x β€ r x) β monotonic ? le r β
+ βi,b,b1. b β€ b1 β h_of r β©i,bβͺ β€ h_of r β©i,b1βͺ.
+#r #Hr #Hmono #i #a #b #leab >h_of_def >h_of_def
+cut (max i a β€ max i b)
+ [@to_max
+ [@(le_maxl β¦ (le_n β¦))|@(transitive_le β¦ leab) @(le_maxr β¦ (le_n β¦))]]
+#Hmax @(mono_h_of_aux r Hr Hmono)
+ [@monotonic_MSC @le_pair @le_pair @Hmax |/2 by monotonic_le_minus_l/ |@leab]
+qed.
+
+axiom h_of_constr : βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ constructible (h_of r).
+
+lemma speed_compl: βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ CF (h_of r) (unary_g (Ξ»i,x. r(h_of r β©i,xβͺ))).
+#r #Hr #Hmono #Hconstr @(monotonic_CF β¦ (compl_g11 β¦))
+ [#x cases (surj_pair x) #a * #b #eqx >eqx
+ >sg_def cases (decidable_le b a)
+ [#leba >(minus_to_0 β¦ leba) normalize in β’ (?%?);
+ <plus_n_O <plus_n_O >h_of_def
+ cut (max a b = a)
+ [normalize cases (le_to_or_lt_eq β¦ leba)
+ [#ltba >(lt_to_leb_false β¦ ltba) %
+ |#eqba <eqba >(le_to_leb_true β¦ (le_n ?)) % ]]
+ #Hmax >Hmax normalize >(minus_to_0 β¦ leba) normalize
+ @monotonic_MSC @le_pair @le_pair //
+ |#ltab >h_of_def >h_of_def
+ cut (max a b = b)
+ [normalize >(le_to_leb_true β¦ ) [%] @lt_to_le @not_le_to_lt @ltab]
+ #Hmax >Hmax
+ cut (max (S a) b = b)
+ [whd in β’ (??%?); >(le_to_leb_true β¦ ) [%] @not_le_to_lt @ltab]
+ #Hmax1 >Hmax1
+ cut (βd.b - a = S d)
+ [%{(pred(b-a))} >S_pred [//] @lt_plus_to_minus_r @not_le_to_lt @ltab]
+ * #d #eqd >eqd
+ cut (b-S a = d) [//] #eqd1 >eqd1 >h_of_aux_S >eqd1
+ cut (b - S d = a)
+ [@plus_to_minus >commutative_plus @minus_to_plus
+ [@lt_to_le @not_le_to_lt // | //]] #eqd2 >eqd2
+ normalize //
+ ]
+ |#n #a #b #leab #lebn >h_of_def >h_of_def
+ cut (max a n = n)
+ [normalize >le_to_leb_true [%|@(transitive_le β¦ leab lebn)]] #Hmaxa
+ cut (max b n = n)
+ [normalize >(le_to_leb_true β¦ lebn) %] #Hmaxb
+ >Hmaxa >Hmaxb @Hmono @(mono_h_of_aux r β¦ Hr Hmono) // /2 by monotonic_le_minus_r/
+ |#n #a #b #leab @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ leab)
+ |@(constr_comp β¦ Hconstr Hr) @(ext_constr (h_of r))
+ [#x cases (surj_pair x) #a * #b #eqx >eqx >fst_pair >snd_pair //]
+ @(h_of_constr r Hr Hmono Hconstr)
+ ]
+qed.
+
+lemma speed_compl_i: βr:nat βnat.
+ (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βi. CF (Ξ»x.h_of r β©i,xβͺ) (Ξ»x.g (Ξ»i,x. r(h_of r β©i,xβͺ)) i x).
+#r #Hr #Hmono #Hconstr #i
+@(ext_CF (Ξ»x.unary_g (Ξ»i,x. r(h_of r β©i,xβͺ)) β©i,xβͺ))
+ [#n whd in β’ (??%%); @eq_f @sym_eq >fst_pair >snd_pair %]
+@smn @(ext_CF β¦ (speed_compl r Hr Hmono Hconstr)) #n //
+qed.
+
+(**************************** the speedup theorem *****************************)
+theorem pseudo_speedup:
+ βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§ O sf (r β sg).
+(* βm,a.βn. aβ€n β r(sg a) < m * sf n. *)
+#r #Hr #Hmono #Hconstr
+(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
+#Hcodei #HCi
+(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
+(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
+%{(Ξ»x. h_of r β©S i,xβͺ)}
+lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
+%[%[@condition_1 |@Hg]
+ |cases Hg #H1 * #j * #Hcodej #HCj
+ lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
+ cases HCi #m * #a #Ha %{m} %{(max (S i) a)} #n #ltin @lt_to_le @not_le_to_lt
+ @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf %{n} %
+ [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
+ cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
+ #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf) //
+ ]
+qed.
+
+theorem pseudo_speedup':
+ βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
+ βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§
+ (* Β¬ O (r β sg) sf. *)
+ βm,a.βn. aβ€n β r(sg a) < m * sf n.
+#r #Hr #Hmono #Hconstr
+(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
+#Hcodei #HCi
+(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
+%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
+(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
+%{(Ξ»x. h_of r β©S i,xβͺ)}
+lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
+%[%[@condition_1 |@Hg]
+ |cases Hg #H1 * #j * #Hcodej #HCj
+ lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
+ cases HCi #m * #a #Ha
+ %{m} %{(max (S i) a)} #n #ltin @not_le_to_lt @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf
+ %{n} % [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
+ cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
+ #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf)
+ @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ ltin)
+ ]
+qed.
+
--- /dev/null
+include "turing/auxiliary_machines1.ma".
+include "turing/multi_to_mono/shift_trace_machines.ma".
+
+(******************************************************************************)
+(* mtiL: complete move L for tape i. We reaching the left border of trace i, *)
+(* add a blank if there is no more tape, then move the i-trace and finally *)
+(* come back to the head position. *)
+(******************************************************************************)
+
+(* we say that a tape is regular if for any trace after the first blank we
+ only have other blanks *)
+
+definition all_blanks_in β Ξ»sig,l.
+ βx. mem ? x l β x = blank sig.
+
+definition regular_i β Ξ»sig,n.Ξ»l:list (multi_sig sig n).Ξ»i.
+ all_blanks_in ? (after_blank ? (trace sig n i l)).
+
+definition regular_trace β Ξ»sig,n,a.Ξ»ls,rs:list (multi_sig sig n).Ξ»i.
+ Or (And (regular_i sig n (a::ls) i) (regular_i sig n rs i))
+ (And (regular_i sig n ls i) (regular_i sig n (a::rs) i)).
+
+axiom regular_tail: βsig,n,l,i.
+ regular_i sig n l i β regular_i sig n (tail ? l) i.
+
+axiom regular_extend: βsig,n,l,i.
+ regular_i sig n l i β regular_i sig n (l@[all_blank sig n]) i.
+
+axiom all_blank_after_blank: βsig,n,l1,b,l2,i.
+ nth i ? (vec β¦ b) (blank ?) = blank ? β
+ regular_i sig n (l1@b::l2) i β all_blanks_in ? (trace sig n i l2).
+
+lemma regular_trace_extl: βsig,n,a,ls,rs,i.
+ regular_trace sig n a ls rs i β
+ regular_trace sig n a (ls@[all_blank sig n]) rs i.
+#sig #n #a #ls #rs #i *
+ [* #H1 #H2 % % // @(regular_extend β¦ H1)
+ |* #H1 #H2 %2 % // @(regular_extend β¦ H1)
+ ]
+qed.
+
+lemma regular_cons_hd_rs: βsig,n.βa:multi_sig sig n.βls,rs1,rs2,i.
+ regular_trace sig n a ls (rs1@rs2) i β
+ regular_trace sig n a ls (rs1@((hd ? rs2 (all_blank β¦))::(tail ? rs2))) i.
+#sig #n #a #ls #rs1 #rs2 #i cases rs2 [2: #b #tl #H @H]
+*[* #H1 >append_nil #H2 %1 %
+ [@H1 | whd in match (hd ???); @(regular_extend β¦ rs1) //]
+ |* #H1 >append_nil #H2 %2 %
+ [@H1 | whd in match (hd ???); @(regular_extend β¦ (a::rs1)) //]
+ ]
+qed.
+
+lemma eq_trace_to_regular : βsig,n.βa1,a2:multi_sig sig n.βls1,ls2,rs1,rs2,i.
+ nth i ? (vec β¦ a1) (blank ?) = nth i ? (vec β¦ a2) (blank ?) β
+ trace sig n i ls1 = trace sig n i ls2 β
+ trace sig n i rs1 = trace sig n i rs2 β
+ regular_trace sig n a1 ls1 rs1 i β
+ regular_trace sig n a2 ls2 rs2 i.
+#sig #n #a1 #a2 #ls1 #ls2 #rs1 #rs2 #i #H1 #H2 #H3 #H4
+whd in match (regular_trace ??????); whd in match (regular_i ????);
+whd in match (regular_i ?? rs2 ?); whd in match (regular_i ?? ls2 ?);
+whd in match (regular_i ?? (a2::rs2) ?); whd in match (trace ????);
+<trace_def whd in match (trace ??? (a2::rs2)); <trace_def
+<H1 <H2 <H3 @H4
+qed.
+
+(******************************* move_to_blank_L ******************************)
+(* we compose machines together to reduce the number of output cases, and
+ improve semantics *)
+
+definition move_to_blank_L β Ξ»sig,n,i.
+ (move_until ? L (no_blank sig n i)) Β· extend ? (all_blank sig n).
+
+(*
+definition R_move_to_blank_L β Ξ»sig,n,i,t1,t2.
+(current ? t1 = None ? β
+ t2 = midtape (multi_sig sig n) (left ? t1) (all_blank β¦) (right ? t1)) β§
+βls,a,rs.t1 = midtape ? ls a rs β
+ ((no_blank sig n i a = false) β§ t2 = t1) β¨
+ (βb,ls1,ls2.
+ (no_blank sig n i b = false) β§
+ (βj.j β€n β to_blank_i ?? j (ls1@b::ls2) = to_blank_i ?? j ls) β§
+ t2 = midtape ? ls2 b ((reverse ? (a::ls1))@rs)).
+*)
+
+definition R_move_to_blank_L β Ξ»sig,n,i,t1,t2.
+(current ? t1 = None ? β
+ t2 = midtape (multi_sig sig n) (left ? t1) (all_blank β¦) (right ? t1)) β§
+βls,a,rs.
+ t1 = midtape (multi_sig sig n) ls a rs β
+ regular_i sig n (a::ls) i β
+ (βj. j β i β regular_trace β¦ a ls rs j) β
+ (βb,ls1,ls2.
+ (regular_i sig n (ls1@b::ls2) i) β§
+ (βj. j β i β regular_trace β¦
+ (hd ? (ls1@b::ls2) (all_blank β¦)) (tail ? (ls1@b::ls2)) rs j) β§
+ (no_blank sig n i b = false) β§
+ (hd (multi_sig sig n) (ls1@[b]) (all_blank β¦) = a) β§ (* not implied by the next fact *)
+ (βj.j β€n β to_blank_i ?? j (ls1@b::ls2) = to_blank_i ?? j (a::ls)) β§
+ t2 = midtape ? ls2 b ((reverse ? ls1)@rs)).
+
+theorem sem_move_to_blank_L: βsig,n,i.
+ move_to_blank_L sig n i β¨ R_move_to_blank_L sig n i.
+#sig #n #i
+@(sem_seq_app ??????
+ (ssem_move_until_L ? (no_blank sig n i)) (sem_extend ? (all_blank sig n)))
+#tin #tout * #t1 * * #Ht1a #Ht1b * #Ht2a #Ht2b %
+ [#Hcur >(Ht1a Hcur) in Ht2a; /2 by /
+ |#ls #a #rs #Htin #Hreg #Hreg2 -Ht1a cases (Ht1b β¦ Htin)
+ [* #Hnb #Ht1 -Ht1b -Ht2a >Ht1 in Ht2b; >Htin #H
+ %{a} %{[ ]} %{ls}
+ %[%[%[%[%[@Hreg|@Hreg2]|@Hnb]|//]|//]|@H normalize % #H1 destruct (H1)]
+ |*
+ [(* we find the blank *)
+ * #ls1 * #b * #ls2 * * * #H1 #H2 #H3 #Ht1
+ >Ht1 in Ht2b; #Hout -Ht1b
+ %{b} %{(a::ls1)} %{ls2}
+ %[%[%[%[%[>H1 in Hreg; #H @H
+ |#j #jneqi whd in match (hd ???); whd in match (tail ??);
+ <H1 @(Hreg2 j jneqi)]|@H2] |//]|>H1 //]
+ |@Hout normalize % normalize #H destruct (H)
+ ]
+ |* #b * #lss * * #H1 #H2 #Ht1 -Ht1b >Ht1 in Ht2a;
+ whd in match (left ??); whd in match (right ??); #Hout
+ %{(all_blank β¦)} %{(lss@[b])} %{[]}
+ %[%[%[%[%[<H2 @regular_extend //
+ |<H2 #j #jneqi whd in match (hd ???); whd in match (tail ??);
+ @regular_trace_extl @Hreg2 //]
+ |whd in match (no_blank ????); >blank_all_blank //]
+ |<H2 //]
+ |#j #lejn <H2 @sym_eq @to_blank_i_ext]
+ |>reverse_append >reverse_single @Hout normalize //
+ ]
+ ]
+ ]
+qed.
+
+(******************************************************************************)
+
+definition shift_i_L β Ξ»sig,n,i.
+ ncombf_r (multi_sig β¦) (shift_i sig n i) (all_blank sig n) Β·
+ mti sig n i Β·
+ extend ? (all_blank sig n).
+
+definition R_shift_i_L β Ξ»sig,n,i,t1,t2.
+ (βa,ls,rs.
+ t1 = midtape ? ls a rs β
+ ((βrs1,b,rs2,a1,rss.
+ rs = rs1@b::rs2 β§
+ nth i ? (vec β¦ b) (blank ?) = (blank ?) β§
+ (βx. mem ? x rs1 β nth i ? (vec β¦ x) (blank ?) β (blank ?)) β§
+ shift_l sig n i (a::rs1) (a1::rss) β§
+ t2 = midtape (multi_sig sig n) ((reverse ? (a1::rss))@ls) b rs2) β¨
+ (βb,rss.
+ (βx. mem ? x rs β nth i ? (vec β¦ x) (blank ?) β (blank ?)) β§
+ shift_l sig n i (a::rs) (rss@[b]) β§
+ t2 = midtape (multi_sig sig n)
+ ((reverse ? (rss@[b]))@ls) (all_blank sig n) [ ]))).
+
+definition R_shift_i_L_new β Ξ»sig,n,i,t1,t2.
+ (βa,ls,rs.
+ t1 = midtape ? ls a rs β
+ βrs1,b,rs2,rss.
+ b = hd ? rs2 (all_blank sig n) β§
+ nth i ? (vec β¦ b) (blank ?) = (blank ?) β§
+ rs = rs1@rs2 β§
+ (βx. mem ? x rs1 β nth i ? (vec β¦ x) (blank ?) β (blank ?)) β§
+ shift_l sig n i (a::rs1) rss β§
+ t2 = midtape (multi_sig sig n) ((reverse ? rss)@ls) b (tail ? rs2)).
+
+theorem sem_shift_i_L: βsig,n,i. shift_i_L sig n i β¨ R_shift_i_L sig n i.
+#sig #n #i
+@(sem_seq_app ??????
+ (sem_ncombf_r (multi_sig sig n) (shift_i sig n i)(all_blank sig n))
+ (sem_seq ????? (ssem_mti sig n i)
+ (sem_extend ? (all_blank sig n))))
+#tin #tout * #t1 * * #Ht1a #Ht1b * #t2 * * #Ht2a #Ht2b * #Htout1 #Htout2
+#a #ls #rs cases rs
+ [#Htin %2 %{(shift_i sig n i a (all_blank sig n))} %{[ ]}
+ %[%[#x @False_ind | @daemon]
+ |lapply (Ht1a β¦ Htin) -Ht1a -Ht1b #Ht1
+ lapply (Ht2a β¦ Ht1) -Ht2a -Ht2b #Ht2 >Ht2 in Htout1;
+ >Ht1 whd in match (left ??); whd in match (right ??); #Htout @Htout //
+ ]
+ |#a1 #rs1 #Htin
+ lapply (Ht1b β¦ Htin) -Ht1a -Ht1b #Ht1
+ lapply (Ht2b β¦ Ht1) -Ht2a -Ht2b *
+ [(* a1 is blank *) * #H1 #H2 %1
+ %{[ ]} %{a1} %{rs1} %{(shift_i sig n i a a1)} %{[ ]}
+ %[%[%[%[// |//] |#x @False_ind] | @daemon]
+ |>Htout2 [>H2 >reverse_single @Ht1 |>H2 >Ht1 normalize % #H destruct (H)]
+ ]
+ |*
+ [* #rs10 * #b * #rs2 * #rss * * * * #H1 #H2 #H3 #H4
+ #Ht2 %1
+ %{(a1::rs10)} %{b} %{rs2} %{(shift_i sig n i a a1)} %{rss}
+ %[%[%[%[>H1 //|//] |@H3] |@daemon ]
+ |>reverse_cons >associative_append
+ >H2 in Htout2; #Htout >Htout [@Ht2| >Ht2 normalize % #H destruct (H)]
+ ]
+ |* #b * #rss * * #H1 #H2
+ #Ht2 %2
+ %{(shift_i sig n i b (all_blank sig n))} %{(shift_i sig n i a a1::rss)}
+ %[%[@H1 |@daemon ]
+ |>Ht2 in Htout1; #Htout >Htout //
+ whd in match (left ??); whd in match (right ??);
+ >reverse_append >reverse_single >associative_append >reverse_cons
+ >associative_append //
+ ]
+ ]
+ ]
+ ]
+qed.
+
+theorem sem_shift_i_L_new: βsig,n,i.
+ shift_i_L sig n i β¨ R_shift_i_L_new sig n i.
+#sig #n #i
+@(Realize_to_Realize β¦ (sem_shift_i_L sig n i))
+#t1 #t2 #H #a #ls #rs #Ht1 lapply (H a ls rs Ht1) *
+ [* #rs1 * #b * #rs2 * #a1 * #rss * * * * #H1 #H2 #H3 #H4 #Ht2
+ %{rs1} %{b} %{(b::rs2)} %{(a1::rss)}
+ %[%[%[%[%[//|@H2]|@H1]|@H3]|@H4] | whd in match (tail ??); @Ht2]
+ |* #b * #rss * * #H1 #H2 #Ht2
+ %{rs} %{(all_blank sig n)} %{[]} %{(rss@[b])}
+ %[%[%[%[%[//|@blank_all_blank]|//]|@H1]|@H2] | whd in match (tail ??); @Ht2]
+ ]
+qed.
+
+
+(*******************************************************************************
+The following machine implements a full move of for a trace: we reach the left
+border, shift the i-th trace and come back to the head position. *)
+
+(* this exclude the possibility that traces do not overlap: the head must
+remain inside all traces *)
+
+definition mtiL β Ξ»sig,n,i.
+ move_to_blank_L sig n i Β·
+ shift_i_L sig n i Β·
+ move_until ? L (no_head sig n).
+
+definition Rmtil β Ξ»sig,n,i,t1,t2.
+ βls,a,rs.
+ t1 = midtape (multi_sig sig n) ls a rs β
+ nth n ? (vec β¦ a) (blank ?) = head ? β
+ (βi.regular_trace sig n a ls rs i) β
+ (* next: we cannot be on rightof on trace i *)
+ (nth i ? (vec β¦ a) (blank ?) = (blank ?)
+ β nth i ? (vec β¦ (hd ? rs (all_blank β¦))) (blank ?) β (blank ?)) β
+ no_head_in β¦ ls β
+ no_head_in β¦ rs β
+ (βls1,a1,rs1.
+ t2 = midtape (multi_sig β¦) ls1 a1 rs1 β§
+ (βi.regular_trace β¦ a1 ls1 rs1 i) β§
+ (βj. j β€ n β j β i β to_blank_i ? n j (a1::ls1) = to_blank_i ? n j (a::ls)) β§
+ (βj. j β€ n β j β i β to_blank_i ? n j rs1 = to_blank_i ? n j rs) β§
+ (to_blank_i ? n i ls1 = to_blank_i ? n i (a::ls)) β§
+ (to_blank_i ? n i (a1::rs1)) = to_blank_i ? n i rs).
+
+theorem sem_Rmtil: βsig,n,i. i < n β mtiL sig n i β¨ Rmtil sig n i.
+#sig #n #i #lt_in
+@(sem_seq_app ??????
+ (sem_move_to_blank_L β¦ )
+ (sem_seq ????? (sem_shift_i_L_new β¦)
+ (ssem_move_until_L ? (no_head sig n))))
+#tin #tout * #t1 * * #_ #Ht1 * #t2 * #Ht2 * #_ #Htout
+(* we start looking into Rmitl *)
+#ls #a #rs #Htin (* tin is a midtape *)
+#Hhead #Hreg #no_rightof #Hnohead_ls #Hnohead_rs
+cut (regular_i sig n (a::ls) i)
+ [cases (Hreg i) * //
+ cases (true_or_false (nth i ? (vec β¦ a) (blank ?) == (blank ?))) #Htest
+ [#_ @daemon (* absurd, since hd rs non e' blank *)
+ |#H #_ @daemon]] #Hreg1
+lapply (Ht1 β¦ Htin Hreg1 ?) [#j #_ @Hreg] -Ht1 -Htin
+* #b * #ls1 * #ls2 * * * * * #reg_ls1_i #reg_ls1_j #Hno_blankb #Hhead #Hls1 #Ht1
+lapply (Ht2 β¦ Ht1) -Ht2 -Ht1
+* #rs1 * #b0 * #rs2 * #rss * * * * * #Hb0 #Hb0blank #Hrs1 #Hrs1b #Hrss #Ht2
+(* we need to recover the position of the head of the emulated machine
+ that is the head of ls1. This is somewhere inside rs1 *)
+cut (βrs11. rs1 = (reverse ? ls1)@rs11)
+ [cut (ls1 = [ ] β¨ βaa,tlls1. ls1 = aa::tlls1)
+ [cases ls1 [%1 // | #aa #tlls1 %2 %{aa} %{tlls1} //]] *
+ [#H1ls1 %{rs1} >H1ls1 //
+ |* #aa * #tlls1 #H1ls1 >H1ls1 in Hrs1;
+ cut (aa = a) [>H1ls1 in Hls1; #H @(to_blank_hd β¦ H)] #eqaa >eqaa
+ #Hrs1_aux cases (compare_append β¦ (sym_eq β¦ Hrs1_aux)) #l *
+ [* #H1 #H2 %{l} @H1
+ |(* this is absurd : if l is empty, the case is as before.
+ if l is not empty then it must start with a blank, since it is the
+ first character in rs2. But in this case we would have a blank
+ inside ls1=a::tls1 that is absurd *)
+ @daemon
+ ]]]
+ * #rs11 #H1
+cut (rs = rs11@rs2)
+ [@(injective_append_l β¦ (reverse β¦ ls1)) >Hrs1 <associative_append <H1 //] #H2
+lapply (Htout β¦ Ht2) -Htout -Ht2 *
+ [(* the current character on trace i holds the head-mark.
+ The case is absurd, since b0 is the head of rs2, that is a sublist of rs,
+ and the head-mark is not in rs *)
+ * #H3 @False_ind @(absurd (nth n ? (vec β¦ b0) (blank sig) = head ?))
+ [@(\P ?) @injective_notb @H3 ]
+ @Hnohead_rs >H2 >trace_append @mem_append_l2
+ lapply Hb0 cases rs2
+ [whd in match (hd ???); #H >H in H3; whd in match (no_head ???);
+ >all_blank_n normalize -H #H destruct (H); @False_ind
+ |#c #r #H4 %1 >H4 //
+ ]
+ |*
+ [(* we reach the head position *)
+ (* cut (trace sig n j (a1::ls20)=trace sig n j (ls1@b::ls2)) *)
+ * #ls10 * #a1 * #ls20 * * * #Hls20 #Ha1 #Hnh #Htout
+ cut (βj.j β i β
+ trace sig n j (reverse (multi_sig sig n) rs1@b::ls2) =
+ trace sig n j (ls10@a1::ls20))
+ [#j #ineqj >append_cons <reverse_cons >trace_def <map_append <reverse_map
+ lapply (trace_shift_neq β¦lt_in ? (sym_not_eq β¦ ineqj) β¦ Hrss) [//] #Htr
+ <(trace_def β¦ (b::rs1)) <Htr >reverse_map >map_append @eq_f @Hls20 ]
+ #Htracej
+ cut (trace sig n i (reverse (multi_sig sig n) (rs1@[b0])@ls2) =
+ trace sig n i (ls10@a1::ls20))
+ [>trace_def <map_append <reverse_map <map_append <(trace_def β¦ [b0])
+ cut (trace sig n i [b0] = [blank ?]) [@daemon] #Hcut >Hcut
+ lapply (trace_shift β¦ lt_in β¦ Hrss) [//] whd in match (tail ??); #Htr <Htr
+ >reverse_map >map_append <trace_def <Hls20 %
+ ]
+ #Htracei
+ cut (βj. j β i β
+ (trace sig n j (reverse (multi_sig sig n) rs11) = trace sig n j ls10) β§
+ (trace sig n j (ls1@b::ls2) = trace sig n j (a1::ls20)))
+ [@daemon (* si fa
+ #j #ineqj @(first_P_to_eq ? (Ξ»x. x β head ?))
+ [lapply (Htracej β¦ ineqj) >trace_def in β’ (%β?); <map_append
+ >trace_def in β’ (%β?); <map_append #H @H
+ | *) ] #H2
+ cut ((trace sig n i (b0::reverse ? rs11) = trace sig n i (ls10@[a1])) β§
+ (trace sig n i (ls1@ls2) = trace sig n i ls20))
+ [>H1 in Htracei; >reverse_append >reverse_single >reverse_append
+ >reverse_reverse >associative_append >associative_append
+ @daemon
+ ] #H3
+ cut (βj. j β i β
+ trace sig n j (reverse (multi_sig sig n) ls10@rs2) = trace sig n j rs)
+ [#j #jneqi @(injective_append_l β¦ (trace sig n j (reverse ? ls1)))
+ >map_append >map_append >Hrs1 >H1 >associative_append
+ <map_append <map_append in β’ (???%); @eq_f
+ <map_append <map_append @eq_f2 // @sym_eq
+ <(reverse_reverse β¦ rs11) <reverse_map <reverse_map in β’ (???%);
+ @eq_f @(proj1 β¦ (H2 j jneqi))] #Hrs_j
+ %{ls20} %{a1} %{(reverse ? (b0::ls10)@tail (multi_sig sig n) rs2)}
+ %[%[%[%[%[@Htout
+ |#j cases (decidable_eq_nat j i)
+ [#eqji >eqji (* by cases wether a1 is blank *)
+ @daemon
+ |#jneqi lapply (reg_ls1_j β¦ jneqi) #H4
+ >reverse_cons >associative_append >Hb0 @regular_cons_hd_rs
+ @(eq_trace_to_regular β¦ H4)
+ [<hd_trace >(proj2 β¦ (H2 β¦ jneqi)) >hd_trace %
+ |<tail_trace >(proj2 β¦ (H2 β¦ jneqi)) >tail_trace %
+ |@sym_eq @Hrs_j //
+ ]
+ ]]
+ |#j #lejn #jneqi <(Hls1 β¦ lejn)
+ >to_blank_i_def >to_blank_i_def @eq_f @sym_eq @(proj2 β¦ (H2 j jneqi))]
+ |#j #lejn #jneqi >reverse_cons >associative_append >Hb0
+ <to_blank_hd_cons >to_blank_i_def >to_blank_i_def @eq_f @Hrs_j //]
+ |<(Hls1 i) [2:@lt_to_le //]
+ lapply (all_blank_after_blank β¦ reg_ls1_i)
+ [@(\P ?) @daemon] #allb_ls2
+ whd in match (to_blank_i ????); <(proj2 β¦ H3)
+ @daemon ]
+ |>reverse_cons >associative_append
+ cut (to_blank_i sig n i rs = to_blank_i sig n i (rs11@[b0])) [@daemon]
+ #Hcut >Hcut >(to_blank_i_chop β¦ b0 (a1::reverse β¦ls10)) [2: @Hb0blank]
+ >to_blank_i_def >to_blank_i_def @eq_f
+ >trace_def >trace_def @injective_reverse >reverse_map >reverse_cons
+ >reverse_reverse >reverse_map >reverse_append >reverse_single @sym_eq
+ @(proj1 β¦ H3)
+ ]
+ |(*we do not find the head: this is absurd *)
+ * #b1 * #lss * * #H2 @False_ind
+ cut (βx0. mem ? x0 (trace sig n n (b0::reverse ? rss@ls2)) β x0 β head ?)
+ [@daemon] -H2 #H2
+ lapply (trace_shift_neq sig n i n β¦ lt_in β¦ Hrss)
+ [@lt_to_not_eq @lt_in | // ]
+ #H3 @(absurd
+ (nth n ? (vec β¦ (hd ? (ls1@[b]) (all_blank sig n))) (blank ?) = head ?))
+ [>Hhead //
+ |@H2 >trace_def %2 <map_append @mem_append_l1 <reverse_map <trace_def
+ >H3 >H1 >trace_def >reverse_map >reverse_cons >reverse_append
+ >reverse_reverse >associative_append <map_append @mem_append_l2
+ cases ls1 [%1 % |#x #ll %1 %]
+ ]
+ ]
+ ]
+qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basics/lists/list.ma".
-
-axiom alpha : Type[0].
-notation "πΈ" non associative with precedence 90 for @{'alphabet}.
-interpretation "set of names" 'alphabet = alpha.
-
-inductive tp : Type[0] β
-| top : tp
-| arr : tp β tp β tp.
-inductive tm : Type[0] β
-| var : nat β tm
-| par : πΈ β tm
-| abs : tp β tm β tm
-| app : tm β tm β tm.
-
-let rec Nth T n (l:list T) on n β
- match l with
- [ nil β None ?
- | cons hd tl β match n with
- [ O β Some ? hd
- | S n0 β Nth T n0 tl ] ].
-
-inductive judg : list tp β tm β tp β Prop β
-| t_var : βg,n,t.Nth ? n g = Some ? t β judg g (var n) t
-| t_app : βg,m,n,t,u.judg g m (arr t u) β judg g n t β judg g (app m n) u
-| t_abs : βg,t,m,u.judg (t::g) m u β judg g (abs t m) (arr t u).
-
-definition Env := list (πΈ Γ tp).
-
-axiom vclose_env : Env β list tp.
-axiom vclose_tm : Env β tm β tm.
-axiom Lam : πΈ β tp β tm β tm.
-definition Judg β Ξ»G,M,T.judg (vclose_env G) (vclose_tm G M) T.
-definition dom β Ξ»G:Env.map ?? (fst ??) G.
-
-definition sctx β πΈ Γ tm.
-axiom swap_tm : πΈ β πΈ β tm β tm.
-definition sctx_app : sctx β πΈ β tm β Ξ»M0,Y.let β©X,Mβͺ β M0 in swap_tm X Y M.
-
-axiom in_list : βA:Type[0].A β list A β Prop.
-interpretation "list membership" 'mem x l = (in_list ? x l).
-interpretation "list non-membership" 'notmem x l = (Not (in_list ? x l)).
-
-axiom in_Env : πΈ Γ tp β Env β Prop.
-notation "X β G" non associative with precedence 45 for @{'lefttriangle $X $G}.
-interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
-
-let rec FV M β match M with
- [ par X β [X]
- | app M1 M2 β FV M1@FV M2
- | abs T M0 β FV M0
- | _ β [ ] ].
-
-(* axiom Lookup : πΈ β Env β option tp. *)
-
-(* forma alto livello del judgment
- t_abs* : βG,T,X,M,U.
- (βY β supp(M).Judg (β©Y,Tβͺ::G) (M[Y]) U) β
- Judg G (Lam X T (M[X])) (arr T U) *)
-
-(* prima dimostrare, poi perfezionare gli assiomi, poi dimostrarli *)
-
-axiom Judg_ind : βP:Env β tm β tp β Prop.
- (βX,G,T.β©X,Tβͺ β G β P G (par X) T) β
- (βG,M,N,T,U.
- Judg G M (arr T U) β Judg G N T β
- P G M (arr T U) β P G N T β P G (app M N) U) β
- (βG,T1,T2,X,M1.
- (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β Judg (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
- (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β P (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
- P G (Lam X T1 (sctx_app M1 X)) (arr T1 T2)) β
- βG,M,T.Judg G M T β P G M T.
-
-axiom t_par : βX,G,T.β©X,Tβͺ β G β Judg G (par X) T.
-axiom t_app2 : βG,M,N,T,U.Judg G M (arr T U) β Judg G N T β Judg G (app M N) U.
-axiom t_Lam : βG,X,M,T,U.Judg (β©X,Tβͺ::G) M U β Judg G (Lam X T M) (arr T U).
-
-definition subenv β Ξ»G1,G2.βx.x β G1 β x β G2.
-interpretation "subenv" 'subseteq G1 G2 = (subenv G1 G2).
-
-axiom daemon : βP:Prop.P.
-
-theorem weakening : βG1,G2,M,T.G1 β G2 β Judg G1 M T β Judg G2 M T.
-#G1 #G2 #M #T #Hsub #HJ lapply Hsub lapply G2 -G2 change with (βG2.?)
-@(Judg_ind β¦ HJ)
-[ #X #G #T0 #Hin #G2 #Hsub @t_par @Hsub //
-| #G #M0 #N #T0 #U #HM0 #HN #IH1 #IH2 #G2 #Hsub @t_app2
- [| @IH1 // | @IH2 // ]
-| #G #T1 #T2 #X #M1 #HM1 #IH #G2 #Hsub @t_Lam @IH
- [ (* trivial property of Lam *) @daemon
- | (* trivial property of subenv *) @daemon ]
-]
-qed.
-
-(* Serve un tipo Tm per i termini localmente chiusi e i suoi principi di induzione e
- ricorsione *)
\ No newline at end of file
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "binding/names.ma".
-
-(* permutations *)
-definition finite_perm : βX:Nset.(X β X) β Prop β
- Ξ»X,f.injective X X f β§ surjective X X f β§ βl.βx.x β l β f x = x.
-
-(* maps a permutation to a list of parameters *)
-definition Pi_list : βX:Nset.(X β X) β list X β list X β
- Ξ»X,p,xl.map ?? (Ξ»x.p x) xl.
-
-interpretation "permutation of X list" 'middot p x = (Pi_list p x).
-
-definition swap : βN:Nset.N β N β N β N β
- Ξ»N,u,v,x.match (x == u) with
- [true β v
- |false β match (x == v) with
- [true β u
- |false β x]].
-
-axiom swap_right : βN,x,y.swap N x y y = x.
-(*
-#N x y;nnormalize;nrewrite > (p_eqb3 ? y y β¦);//;
-nlapply (refl ? (y β x));ncases (y β x) in β’ (???% β %);nnormalize;//;
-#H1;napply p_eqb1;//;
-nqed.
-*)
-
-axiom swap_left : βN,x,y.swap N x y x = y.
-(*
-#N x y;nnormalize;nrewrite > (p_eqb3 ? x x β¦);//;
-nqed.
-*)
-
-axiom swap_other : βN,x,y,z.x β z β y β z β swap N x y z = z.
-(*
-#N x y z H1 H2;nnormalize;nrewrite > (p_eqb4 β¦);
-##[nrewrite > (p_eqb4 β¦);//;@;ncases H2;/2/;
-##|@;ncases H1;/2/
-##]
-nqed.
-*)
-
-axiom swap_inv : βN,x,y,z.swap N x y (swap N x y z) = z.
-(*
-#N x y z;nlapply (refl ? (x β z));ncases (x β z) in β’ (???% β ?);#H1
-##[nrewrite > (p_eqb1 β¦ H1);nrewrite > (swap_left β¦);//;
-##|nlapply (refl ? (y β z));ncases (y β z) in β’ (???% β ?);#H2
- ##[nrewrite > (p_eqb1 β¦ H2);nrewrite > (swap_right β¦);//;
- ##|nrewrite > (swap_other β¦) in β’ (??(????%)?);/2/;
- nrewrite > (swap_other β¦);/2/;
- ##]
-##]
-nqed.
-*)
-
-axiom swap_fp : βN,x1,x2.finite_perm ? (swap N x1 x2).
-(*
-#N x1 x2;@
-##[@
- ##[nwhd;#xa xb;nnormalize;nlapply (refl ? (xa β x1));
- ncases (xa β x1) in β’ (???% β %);#H1
- ##[nrewrite > (p_eqb1 β¦ H1);nlapply (refl ? (xb β x1));
- ncases (xb β x1) in β’ (???% β %);#H2
- ##[nrewrite > (p_eqb1 β¦ H2);//
- ##|nlapply (refl ? (xb β x2));
- ncases (xb β x2) in β’ (???% β %);#H3
- ##[nnormalize;#H4;nrewrite > H4 in H3;
- #H3;nrewrite > H3 in H2;#H2;ndestruct (H2)
- ##|nnormalize;#H4;nrewrite > H4 in H3;
- nrewrite > (p_eqb3 β¦);//;#H5;ndestruct (H5)
- ##]
- ##]
- ##|nlapply (refl ? (xa β x2));
- ncases (xa β x2) in β’ (???% β %);#H2
- ##[nrewrite > (p_eqb1 β¦ H2);nlapply (refl ? (xb β x1));
- ncases (xb β x1) in β’ (???% β %);#H3
- ##[nnormalize;#H4;nrewrite > H4 in H3;
- #H3;nrewrite > (p_eqb1 β¦ H3);@
- ##|nnormalize;nlapply (refl ? (xb β x2));
- ncases (xb β x2) in β’ (???% β %);#H4
- ##[nrewrite > (p_eqb1 β¦ H4);//
- ##|nnormalize;#H5;nrewrite > H5 in H3;
- nrewrite > (p_eqb3 β¦);//;#H6;ndestruct (H6);
- ##]
- ##]
- ##|nnormalize;nlapply (refl ? (xb β x1));
- ncases (xb β x1) in β’ (???% β %);#H3
- ##[nnormalize;#H4;nrewrite > H4 in H2;nrewrite > (p_eqb3 β¦);//;
- #H5;ndestruct (H5)
- ##|nlapply (refl ? (xb β x2));
- ncases (xb β x2) in β’ (???% β %);#H4
- ##[nnormalize;#H5;nrewrite > H5 in H1;nrewrite > (p_eqb3 β¦);//;
- #H6;ndestruct (H6)
- ##|nnormalize;//
- ##]
- ##]
- ##]
- ##]
- ##|nwhd;#z;nnormalize;nlapply (refl ? (z β x1));
- ncases (z β x1) in β’ (???% β %);#H1
- ##[nlapply (refl ? (z β x2));
- ncases (z β x2) in β’ (???% β %);#H2
- ##[@ z;nrewrite > H1;nrewrite > H2;napply p_eqb1;//
- ##|@ x2;nrewrite > (p_eqb4 β¦);
- ##[nrewrite > (p_eqb3 β¦);//;
- nnormalize;napply p_eqb1;//
- ##|nrewrite < (p_eqb1 β¦ H1);@;#H3;nrewrite > H3 in H2;
- nrewrite > (p_eqb3 β¦);//;#H2;ndestruct (H2)
- ##]
- ##]
- ##|nlapply (refl ? (z β x2));
- ncases (z β x2) in β’ (???% β %);#H2
- ##[@ x1;nrewrite > (p_eqb3 β¦);//;
- napply p_eqb1;nnormalize;//
- ##|@ z;nrewrite > H1;nrewrite > H2;@;
- ##]
- ##]
- ##]
-##|@ [x1;x2];#x0 H1;nrewrite > (swap_other β¦)
- ##[@
- ##|@;#H2;nrewrite > H2 in H1;*;#H3;napply H3;/2/;
- ##|@;#H2;nrewrite > H2 in H1;*;#H3;napply H3;//;
- ##]
-##]
-nqed.
-*)
-
-axiom inj_swap : βN,u,v.injective ?? (swap N u v).
-(*
-#N u v;ncases (swap_fp N u v);*;#H1 H2 H3;//;
-nqed.
-*)
-
-axiom surj_swap : βN,u,v.surjective ?? (swap N u v).
-(*
-#N u v;ncases (swap_fp N u v);*;#H1 H2 H3;//;
-nqed.
-*)
-
-axiom finite_swap : βN,u,v.βl.βx.x β l β swap N u v x = x.
-(*
-#N u v;ncases (swap_fp N u v);*;#H1 H2 H3;//;
-nqed.
-*)
-
-(* swaps two lists of parameters
-definition Pi_swap_list : βxl,xl':list X.X β X β
- Ξ»xl,xl',x.foldr2 ??? (Ξ»u,v,r.swap ? u v r) x xl xl'.
-
-nlemma fp_swap_list :
- βxl,xl'.finite_perm ? (Pi_swap_list xl xl').
-#xl xl';@
-##[@;
- ##[ngeneralize in match xl';nelim xl
- ##[nnormalize;//;
- ##|#x0 xl0;#IH xl'';nelim xl''
- ##[nnormalize;//
- ##|#x1 xl1 IH1 y0 y1;nchange in β’ (??%% β ?) with (swap ????);
- #H1;nlapply (inj_swap β¦ H1);#H2;
- nlapply (IH β¦ H2);//
- ##]
- ##]
- ##|ngeneralize in match xl';nelim xl
- ##[nnormalize;#_;#z;@z;@
- ##|#x' xl0 IH xl'';nelim xl''
- ##[nnormalize;#z;@z;@
- ##|#x1 xl1 IH1 z;
- nchange in β’ (??(Ξ»_.???%)) with (swap ????);
- ncases (surj_swap X x' x1 z);#x2 H1;
- ncases (IH xl1 x2);#x3 H2;@ x3;
- nrewrite < H2;napply H1
- ##]
- ##]
- ##]
-##|ngeneralize in match xl';nelim xl
- ##[#;@ [];#;@
- ##|#x0 xl0 IH xl'';ncases xl''
- ##[@ [];#;@
- ##|#x1 xl1;ncases (IH xl1);#xl2 H1;
- ncases (finite_swap X x0 x1);#xl3 H2;
- @ (xl2@xl3);#x2 H3;
- nchange in β’ (??%?) with (swap ????);
- nrewrite > (H1 β¦);
- ##[nrewrite > (H2 β¦);//;@;#H4;ncases H3;#H5;napply H5;
- napply in_list_to_in_list_append_r;//
- ##|@;#H4;ncases H3;#H5;napply H5;
- napply in_list_to_in_list_append_l;//
- ##]
- ##]
- ##]
-##]
-nqed.
-
-(* the 'reverse' swap of lists of parameters
- composing Pi_swap_list and Pi_swap_list_r yields the identity function
- (see the Pi_swap_list_inv lemma) *)
-ndefinition Pi_swap_list_r : βxl,xl':list X. Pi β
- Ξ»xl,xl',x.foldl2 ??? (Ξ»r,u,v.swap ? u v r ) x xl xl'.
-
-nlemma fp_swap_list_r :
- βxl,xl'.finite_perm ? (Pi_swap_list_r xl xl').
-#xl xl';@
-##[@;
- ##[ngeneralize in match xl';nelim xl
- ##[nnormalize;//;
- ##|#x0 xl0;#IH xl'';nelim xl''
- ##[nnormalize;//
- ##|#x1 xl1 IH1 y0 y1;nwhd in β’ (??%% β ?);
- #H1;nlapply (IH β¦ H1);#H2;
- napply (inj_swap β¦ H2);
- ##]
- ##]
- ##|ngeneralize in match xl';nelim xl
- ##[nnormalize;#_;#z;@z;@
- ##|#x' xl0 IH xl'';nelim xl''
- ##[nnormalize;#z;@z;@
- ##|#x1 xl1 IH1 z;nwhd in β’ (??(Ξ»_.???%));
- ncases (IH xl1 z);#x2 H1;
- ncases (surj_swap X x' x1 x2);#x3 H2;
- @ x3;nrewrite < H2;napply H1;
- ##]
- ##]
- ##]
-##|ngeneralize in match xl';nelim xl
- ##[#;@ [];#;@
- ##|#x0 xl0 IH xl'';ncases xl''
- ##[@ [];#;@
- ##|#x1 xl1;
- ncases (IH xl1);#xl2 H1;
- ncases (finite_swap X x0 x1);#xl3 H2;
- @ (xl2@xl3);#x2 H3;nwhd in β’ (??%?);
- nrewrite > (H2 β¦);
- ##[nrewrite > (H1 β¦);//;@;#H4;ncases H3;#H5;napply H5;
- napply in_list_to_in_list_append_l;//
- ##|@;#H4;ncases H3;#H5;napply H5;
- napply in_list_to_in_list_append_r;//
- ##]
- ##]
- ##]
-##]
-nqed.
-
-nlemma Pi_swap_list_inv :
- βxl1,xl2,x.
- Pi_swap_list xl1 xl2 (Pi_swap_list_r xl1 xl2 x) = x.
-#xl;nelim xl
-##[#;@
-##|#x1 xl1 IH xl';ncases xl'
- ##[#;@
- ##|#x2 xl2;#x;
- nchange in β’ (??%?) with
- (swap ??? (Pi_swap_list ??
- (Pi_swap_list_r ?? (swap ????))));
- nrewrite > (IH xl2 ?);napply swap_inv;
- ##]
-##]
-nqed.
-
-nlemma Pi_swap_list_fresh :
- βx,xl1,xl2.x β xl1 β x β xl2 β Pi_swap_list xl1 xl2 x = x.
-#x xl1;nelim xl1
-##[#;@
-##|#x3 xl3 IH xl2' H1;ncases xl2'
- ##[#;@
- ##|#x4 xl4 H2;ncut (x β xl3 β§ x β xl4);
- ##[@
- ##[@;#H3;ncases H1;#H4;napply H4;/2/;
- ##|@;#H3;ncases H2;#H4;napply H4;/2/
- ##]
- ##] *; #H1' H2';
- nchange in β’ (??%?) with (swap ????);
- nrewrite > (swap_other β¦)
- ##[napply IH;//;
- ##|nchange in β’ (?(???%)) with (Pi_swap_list ???);
- nrewrite > (IH β¦);//;@;#H3;ncases H2;#H4;napply H4;//;
- ##|nchange in β’ (?(???%)) with (Pi_swap_list ???);
- nrewrite > (IH β¦);//;@;#H3;ncases H1;#H4;napply H4;//
- ##]
- ##]
-##]
-nqed.
-*)
\ No newline at end of file
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basics/lists/list.ma".
-include "basics/deqsets.ma".
-include "binding/names.ma".
-include "binding/fp.ma".
-
-axiom alpha : Nset.
-notation "πΈ" non associative with precedence 90 for @{'alphabet}.
-interpretation "set of names" 'alphabet = alpha.
-
-inductive tp : Type[0] β
-| top : tp
-| arr : tp β tp β tp.
-inductive pretm : Type[0] β
-| var : nat β pretm
-| par : πΈ β pretm
-| abs : tp β pretm β pretm
-| app : pretm β pretm β pretm.
-
-let rec Nth T n (l:list T) on n β
- match l with
- [ nil β None ?
- | cons hd tl β match n with
- [ O β Some ? hd
- | S n0 β Nth T n0 tl ] ].
-
-let rec vclose_tm_aux u x k β match u with
- [ var n β if (leb k n) then var (S n) else u
- | par x0 β if (x0 == x) then (var k) else u
- | app v1 v2 β app (vclose_tm_aux v1 x k) (vclose_tm_aux v2 x k)
- | abs s v β abs s (vclose_tm_aux v x (S k)) ].
-definition vclose_tm β Ξ»u,x.vclose_tm_aux u x O.
-
-definition vopen_var β Ξ»n,x,k.match eqb n k with
- [ true β par x
- | false β match leb n k with
- [ true β var n
- | false β var (pred n) ] ].
-
-let rec vopen_tm_aux u x k β match u with
- [ var n β vopen_var n x k
- | par x0 β u
- | app v1 v2 β app (vopen_tm_aux v1 x k) (vopen_tm_aux v2 x k)
- | abs s v β abs s (vopen_tm_aux v x (S k)) ].
-definition vopen_tm β Ξ»u,x.vopen_tm_aux u x O.
-
-let rec FV u β match u with
- [ par x β [x]
- | app v1 v2 β FV v1@FV v2
- | abs s v β FV v
- | _ β [ ] ].
-
-definition lam β Ξ»x,s,u.abs s (vclose_tm u x).
-
-let rec Pi_map_tm p u on u β match u with
-[ par x β par (p x)
-| var _ β u
-| app v1 v2 β app (Pi_map_tm p v1) (Pi_map_tm p v2)
-| abs s v β abs s (Pi_map_tm p v) ].
-
-interpretation "permutation of tm" 'middot p x = (Pi_map_tm p x).
-
-notation "hvbox(uβxβ)"
- with precedence 45
- for @{ 'open $u $x }.
-
-(*
-notation "hvbox(uβxβ)"
- with precedence 45
- for @{ 'open $u $x }.
-notation "β΄ u β΅ x" non associative with precedence 90 for @{ 'open $u $x }.
-*)
-interpretation "ln term variable open" 'open u x = (vopen_tm u x).
-notation < "hvbox(Ξ½ x break . u)"
- with precedence 20
-for @{'nu $x $u }.
-notation > "Ξ½ list1 x sep , . term 19 u" with precedence 20
- for ${ fold right @{$u} rec acc @{'nu $x $acc)} }.
-interpretation "ln term variable close" 'nu x u = (vclose_tm u x).
-
-let rec tm_height u β match u with
-[ app v1 v2 β S (max (tm_height v1) (tm_height v2))
-| abs s v β S (tm_height v)
-| _ β O ].
-
-theorem le_n_O_rect_Type0 : βn:nat. n β€ O β βP: nat βType[0]. P O β P n.
-#n (cases n) // #a #abs cases (?:False) /2/ qed.
-
-theorem nat_rect_Type0_1 : βn:nat.βP:nat β Type[0].
-(βm.(βp. p < m β P p) β P m) β P n.
-#n #P #H
-cut (βq:nat. q β€ n β P q) /2/
-(elim n)
- [#q #HleO (* applica male *)
- @(le_n_O_rect_Type0 ? HleO)
- @H #p #ltpO cases (?:False) /2/ (* 3 *)
- |#p #Hind #q #HleS
- @H #a #lta @Hind @le_S_S_to_le /2/
- ]
-qed.
-
-lemma leb_false_to_lt : βn,m. leb n m = false β m < n.
-#n elim n
-[ #m normalize #H destruct(H)
-| #n0 #IH * // #m normalize #H @le_S_S @IH // ]
-qed.
-
-lemma nominal_eta_aux : βx,u.x β FV u β βk.vclose_tm_aux (vopen_tm_aux u x k) x k = u.
-#x #u elim u
-[ #n #_ #k normalize cases (decidable_eq_nat n k) #Hnk
- [ >Hnk >eqb_n_n normalize >(\b ?) //
- | >(not_eq_to_eqb_false β¦ Hnk) normalize cases (true_or_false (leb n k)) #Hleb
- [ >Hleb normalize >(?:leb k n = false) //
- @lt_to_leb_false @not_eq_to_le_to_lt /2/
- | >Hleb normalize >(?:leb k (pred n) = true) normalize
- [ cases (leb_false_to_lt β¦ Hleb) //
- | @le_to_leb_true cases (leb_false_to_lt β¦ Hleb) normalize /2/ ] ] ]
-| #y normalize #Hy >(\bf ?) // @(not_to_not β¦ Hy) //
-| #s #v #IH normalize #Hv #k >IH // @Hv
-| #v1 #v2 #IH1 #IH2 normalize #Hv1v2 #k
- >IH1 [ >IH2 // | @(not_to_not β¦ Hv1v2) @in_list_to_in_list_append_l ]
- @(not_to_not β¦ Hv1v2) @in_list_to_in_list_append_r ]
-qed.
-
-corollary nominal_eta : βx,u.x β FV u β (Ξ½x.uβxβ) = u.
-#x #u #Hu @nominal_eta_aux //
-qed.
-
-lemma eq_height_vopen_aux : βv,x,k.tm_height (vopen_tm_aux v x k) = tm_height v.
-#v #x elim v
-[ #n #k normalize cases (eqb n k) // cases (leb n k) //
-| #u #k %
-| #s #u #IH #k normalize >IH %
-| #u1 #u2 #IH1 #IH2 #k normalize >IH1 >IH2 % ]
-qed.
-
-corollary eq_height_vopen : βv,x.tm_height (vβxβ) = tm_height v.
-#v #x @eq_height_vopen_aux
-qed.
-
-theorem pretm_ind_plus_aux :
- βP:pretm β Type[0].
- (βx:πΈ.P (par x)) β
- (βn:β.P (var n)) β
- (βv1,v2. P v1 β P v2 β P (app v1 v2)) β
- βC:list πΈ.
- (βx,s,v.x β FV v β x β C β P (vβxβ) β P (lam x s (vβxβ))) β
- βn,u.tm_height u β€ n β P u.
-#P #Hpar #Hvar #Happ #C #Hlam #n change with ((Ξ»n.?) n); @(nat_rect_Type0_1 n ??)
-#m cases m
-[ #_ * /2/
- [ normalize #s #v #Hfalse cases (?:False) cases (not_le_Sn_O (tm_height v)) /2/
- | #v1 #v2 whd in β’ (?%?β?); #Hfalse cases (?:False) cases (not_le_Sn_O (max ??))
- [ #H @H @Hfalse|*:skip] ] ]
--m #m #IH * /2/
-[ #s #v whd in β’ (?%?β?); #Hv
- lapply (p_fresh β¦ (C@FV v)) letin y β (N_fresh β¦ (C@FV v)) #Hy
- >(?:abs s v = lam y s (vβyβ))
- [| whd in β’ (???%); >nominal_eta // @(not_to_not β¦ Hy) @in_list_to_in_list_append_r ]
- @Hlam
- [ @(not_to_not β¦ Hy) @in_list_to_in_list_append_r
- | @(not_to_not β¦ Hy) @in_list_to_in_list_append_l ]
- @IH [| @Hv | >eq_height_vopen % ]
-| #v1 #v2 whd in β’ (?%?β?); #Hv @Happ
- [ @IH [| @Hv | @le_max_1 ] | @IH [| @Hv | @le_max_2 ] ] ]
-qed.
-
-corollary pretm_ind_plus :
- βP:pretm β Type[0].
- (βx:πΈ.P (par x)) β
- (βn:β.P (var n)) β
- (βv1,v2. P v1 β P v2 β P (app v1 v2)) β
- βC:list πΈ.
- (βx,s,v.x β FV v β x β C β P (vβxβ) β P (lam x s (vβxβ))) β
- βu.P u.
-#P #Hpar #Hvar #Happ #C #Hlam #u @pretm_ind_plus_aux /2/
-qed.
-
-(* maps a permutation to a list of terms *)
-definition Pi_map_list : (πΈ β πΈ) β list πΈ β list πΈ β map πΈ πΈ .
-
-(* interpretation "permutation of name list" 'middot p x = (Pi_map_list p x).*)
-
-(*
-inductive tm : pretm β Prop β
-| tm_par : βx:πΈ.tm (par x)
-| tm_app : βu,v.tm u β tm v β tm (app u v)
-| tm_lam : βx,s,u.tm u β tm (lam x s u).
-
-inductive ctx_aux : nat β pretm β Prop β
-| ctx_var : βn,k.n < k β ctx_aux k (var n)
-| ctx_par : βx,k.ctx_aux k (par x)
-| ctx_app : βu,v,k.ctx_aux k u β ctx_aux k v β ctx_aux k (app u v)
-(* Γ¨ sostituibile da ctx_lam ? *)
-| ctx_abs : βs,u.ctx_aux (S k) u β ctx_aux k (abs s u).
-*)
-
-inductive tm_or_ctx (k:nat) : pretm β Type[0] β
-| toc_var : βn.n < k β tm_or_ctx k (var n)
-| toc_par : βx.tm_or_ctx k (par x)
-| toc_app : βu,v.tm_or_ctx k u β tm_or_ctx k v β tm_or_ctx k (app u v)
-| toc_lam : βx,s,u.tm_or_ctx k u β tm_or_ctx k (lam x s u).
-
-definition tm β Ξ»t.tm_or_ctx O t.
-definition ctx β Ξ»t.tm_or_ctx 1 t.
-
-definition check_tm β Ξ»u,k.
- pretm_ind_plus ?
- (Ξ»_.true)
- (Ξ»n.leb (S n) k)
- (Ξ»v1,v2,rv1,rv2.rv1 β§ rv2)
- [] (Ξ»x,s,v,px,pC,rv.rv)
- u.
-
-axiom pretm_ind_plus_app : βP,u,v,C,H1,H2,H3,H4.
- pretm_ind_plus P H1 H2 H3 C H4 (app u v) =
- H3 u v (pretm_ind_plus P H1 H2 H3 C H4 u) (pretm_ind_plus P H1 H2 H3 C H4 v).
-
-axiom pretm_ind_plus_lam : βP,x,s,u,C,px,pC,H1,H2,H3,H4.
- pretm_ind_plus P H1 H2 H3 C H4 (lam x s (uβxβ)) =
- H4 x s u px pC (pretm_ind_plus P H1 H2 H3 C H4 (uβxβ)).
-
-record TM : Type[0] β {
- pretm_of_TM :> pretm;
- tm_of_TM : check_tm pretm_of_TM O = true
-}.
-
-record CTX : Type[0] β {
- pretm_of_CTX :> pretm;
- ctx_of_CTX : check_tm pretm_of_CTX 1 = true
-}.
-
-inductive tm2 : pretm β Type[0] β
-| tm_par : βx.tm2 (par x)
-| tm_app : βu,v.tm2 u β tm2 v β tm2 (app u v)
-| tm_lam : βx,s,u.x β FV u β (βy.y β FV u β tm2 (uβyβ)) β tm2 (lam x s (uβxβ)).
-
-(*
-inductive tm' : pretm β Prop β
-| tm_par : βx.tm' (par x)
-| tm_app : βu,v.tm' u β tm' v β tm' (app u v)
-| tm_lam : βx,s,u,C.x β FV u β x β C β (βy.y β FV u β tm' (β΄uβ΅y)) β tm' (lam x s (β΄uβ΅x)).
-*)
-
-lemma pi_vclose_tm :
- βz1,z2,x,u.swap πΈ z1 z2Β·(Ξ½x.u) = (Ξ½ swap ? z1 z2 x.swap πΈ z1 z2 Β· u).
-#z1 #z2 #x #u
-change with (vclose_tm_aux ???) in match (vclose_tm ??);
-change with (vclose_tm_aux ???) in β’ (???%); lapply O elim u normalize //
-[ #n #k cases (leb k n) normalize %
-| #x0 #k cases (true_or_false (x0==z1)) #H1 >H1 normalize
- [ cases (true_or_false (x0==x)) #H2 >H2 normalize
- [ <(\P H2) >H1 normalize >(\b (refl ? z2)) %
- | >H1 normalize cases (true_or_false (x==z1)) #H3 >H3 normalize
- [ >(\P H3) in H2; >H1 #Hfalse destruct (Hfalse)
- | cases (true_or_false (x==z2)) #H4 >H4 normalize
- [ cases (true_or_false (z2==z1)) #H5 >H5 normalize //
- >(\P H5) in H4; >H3 #Hfalse destruct (Hfalse)
- | >(\bf ?) // @sym_not_eq @(\Pf H4) ]
- ]
- ]
- | cases (true_or_false (x0==x)) #H2 >H2 normalize
- [ <(\P H2) >H1 normalize >(\b (refl ??)) %
- | >H1 normalize cases (true_or_false (x==z1)) #H3 >H3 normalize
- [ cases (true_or_false (x0==z2)) #H4 >H4 normalize
- [ cases (true_or_false (z1==z2)) #H5 >H5 normalize //
- <(\P H5) in H4; <(\P H3) >H2 #Hfalse destruct (Hfalse)
- | >H4 % ]
- | cases (true_or_false (x0==z2)) #H4 >H4 normalize
- [ cases (true_or_false (x==z2)) #H5 >H5 normalize
- [ <(\P H5) in H4; >H2 #Hfalse destruct (Hfalse)
- | >(\bf ?) // @sym_not_eq @(\Pf H3) ]
- | cases (true_or_false (x==z2)) #H5 >H5 normalize
- [ >H1 %
- | >H2 % ]
- ]
- ]
- ]
- ]
-]
-qed.
-
-lemma pi_vopen_tm :
- βz1,z2,x,u.swap πΈ z1 z2Β·(uβxβ) = (swap πΈ z1 z2 Β· uβswap πΈ z1 z2 xβ).
-#z1 #z2 #x #u
-change with (vopen_tm_aux ???) in match (vopen_tm ??);
-change with (vopen_tm_aux ???) in β’ (???%); lapply O elim u normalize //
-#n #k cases (true_or_false (eqb n k)) #H1 >H1 normalize //
-cases (true_or_false (leb n k)) #H2 >H2 normalize //
-qed.
-
-lemma pi_lam :
- βz1,z2,x,s,u.swap πΈ z1 z2 Β· lam x s u = lam (swap πΈ z1 z2 x) s (swap πΈ z1 z2 Β· u).
-#z1 #z2 #x #s #u whd in β’ (???%); <(pi_vclose_tm β¦) %
-qed.
-
-lemma eqv_FV : βz1,z2,u.FV (swap πΈ z1 z2 Β· u) = Pi_map_list (swap πΈ z1 z2) (FV u).
-#z1 #z2 #u elim u //
-[ #s #v normalize //
-| #v1 #v2 normalize /2/ ]
-qed.
-
-lemma swap_inv_tm : βz1,z2,u.swap πΈ z1 z2 Β· (swap πΈ z1 z2 Β· u) = u.
-#z1 #z2 #u elim u [1,3,4:normalize //]
-#x whd in β’ (??%?); >swap_inv %
-qed.
-
-lemma eqv_in_list : βx,l,z1,z2.x β l β swap πΈ z1 z2 x β Pi_map_list (swap πΈ z1 z2) l.
-#x #l #z1 #z2 #Hin elim Hin
-[ #x0 #l0 %
-| #x1 #x2 #l0 #Hin #IH %2 @IH ]
-qed.
-
-lemma eqv_tm2 : βu.tm2 u β βz1,z2.tm2 ((swap ? z1 z2)Β·u).
-#u #Hu #z1 #z2 letin p β (swap ? z1 z2) elim Hu /2/
-#x #s #v #Hx #Hv #IH >pi_lam >pi_vopen_tm %3
-[ @(not_to_not β¦ Hx) -Hx #Hx
- <(swap_inv ? z1 z2 x) <(swap_inv_tm z1 z2 v) >eqv_FV @eqv_in_list //
-| #y #Hy <(swap_inv ? z1 z2 y)
- <pi_vopen_tm @IH @(not_to_not β¦ Hy) -Hy #Hy <(swap_inv ? z1 z2 y)
- >eqv_FV @eqv_in_list //
-]
-qed.
-
-lemma vclose_vopen_aux : βx,u,k.vopen_tm_aux (vclose_tm_aux u x k) x k = u.
-#x #u elim u normalize //
-[ #n #k cases (true_or_false (leb k n)) #H >H whd in β’ (??%?);
- [ cases (true_or_false (eqb (S n) k)) #H1 >H1
- [ <(eqb_true_to_eq β¦ H1) in H; #H lapply (leb_true_to_le β¦ H) -H #H
- cases (le_to_not_lt β¦ H) -H #H cases (H ?) %
- | whd in β’ (??%?); >lt_to_leb_false // @le_S_S /2/ ]
- | cases (true_or_false (eqb n k)) #H1 >H1 normalize
- [ >(eqb_true_to_eq β¦ H1) in H; #H lapply (leb_false_to_not_le β¦ H) -H
- * #H cases (H ?) %
- | >le_to_leb_true // @not_lt_to_le % #H2 >le_to_leb_true in H;
- [ #H destruct (H) | /2/ ]
- ]
- ]
-| #x0 #k cases (true_or_false (x0==x)) #H1 >H1 normalize // >(\P H1) >eqb_n_n % ]
-qed.
-
-lemma vclose_vopen : βx,u.((Ξ½x.u)βxβ) = u. #x #u @vclose_vopen_aux
-qed.
-
-(*
-theorem tm_to_tm : βt.tm' t β tm t.
-#t #H elim H
-*)
-
-lemma in_list_singleton : βT.βt1,t2:T.t1 β [t2] β t1 = t2.
-#T #t1 #t2 #H @(in_list_inv_ind ??? H) /2/
-qed.
-
-lemma fresh_vclose_tm_aux : βu,x,k.x β FV (vclose_tm_aux u x k).
-#u #x elim u //
-[ #n #k normalize cases (leb k n) normalize //
-| #x0 #k normalize cases (true_or_false (x0==x)) #H >H normalize //
- lapply (\Pf H) @not_to_not #Hin >(in_list_singleton ??? Hin) %
-| #v1 #v2 #IH1 #IH2 #k normalize % #Hin cases (in_list_append_to_or_in_list ???? Hin) /2/ ]
-qed.
-
-lemma fresh_vclose_tm : βu,x.x β FV (Ξ½x.u). //
-qed.
-
-lemma check_tm_true_to_toc : βu,k.check_tm u k = true β tm_or_ctx k u.
-#u @(pretm_ind_plus ???? [ ] ? u)
-[ #x #k #_ %2
-| #n #k change with (leb (S n) k) in β’ (??%?β?); #H % @leb_true_to_le //
-| #v1 #v2 #rv1 #rv2 #k change with (pretm_ind_plus ???????) in β’ (??%?β?);
- >pretm_ind_plus_app #H cases (andb_true ?? H) -H #Hv1 #Hv2 %3
- [ @rv1 @Hv1 | @rv2 @Hv2 ]
-| #x #s #v #Hx #_ #rv #k change with (pretm_ind_plus ???????) in β’ (??%?β?);
- >pretm_ind_plus_lam // #Hv %4 @rv @Hv ]
-qed.
-
-lemma toc_to_check_tm_true : βu,k.tm_or_ctx k u β check_tm u k = true.
-#u #k #Hu elim Hu //
-[ #n #Hn change with (leb (S n) k) in β’ (??%?); @le_to_leb_true @Hn
-| #v1 #v2 #Hv1 #Hv2 #IH1 #IH2 change with (pretm_ind_plus ???????) in β’ (??%?);
- >pretm_ind_plus_app change with (check_tm v1 k β§ check_tm v2 k) in β’ (??%?); /2/
-| #x #s #v #Hv #IH <(vclose_vopen x v) change with (pretm_ind_plus ???????) in β’ (??%?);
- >pretm_ind_plus_lam [| // | @fresh_vclose_tm ] >(vclose_vopen x v) @IH ]
-qed.
-
-lemma fresh_swap_tm : βz1,z2,u.z1 β FV u β z2 β FV u β swap πΈ z1 z2 Β· u = u.
-#z1 #z2 #u elim u
-[2: normalize in β’ (?β%β%β?); #x #Hz1 #Hz2 whd in β’ (??%?); >swap_other //
- [ @(not_to_not β¦ Hz2) | @(not_to_not β¦ Hz1) ] //
-|1: //
-| #s #v #IH normalize #Hz1 #Hz2 >IH // [@Hz2|@Hz1]
-| #v1 #v2 #IH1 #IH2 normalize #Hz1 #Hz2
- >IH1 [| @(not_to_not β¦ Hz2) @in_list_to_in_list_append_l | @(not_to_not β¦ Hz1) @in_list_to_in_list_append_l ]
- >IH2 // [@(not_to_not β¦ Hz2) @in_list_to_in_list_append_r | @(not_to_not β¦ Hz1) @in_list_to_in_list_append_r ]
-]
-qed.
-
-theorem tm_to_tm2 : βu.tm u β tm2 u.
-#t #Ht elim Ht
-[ #n #Hn cases (not_le_Sn_O n) #Hfalse cases (Hfalse Hn)
-| @tm_par
-| #u #v #Hu #Hv @tm_app
-| #x #s #u #Hu #IHu <(vclose_vopen x u) @tm_lam
- [ @fresh_vclose_tm
- | #y #Hy <(fresh_swap_tm x y (Ξ½x.u)) /2/ @fresh_vclose_tm ]
-]
-qed.
-
-theorem tm2_to_tm : βu.tm2 u β tm u.
-#u #pu elim pu /2/ #x #s #v #Hx #Hv #IH %4 @IH //
-qed.
-
-(* define PAR APP LAM *)
-definition PAR β Ξ»x.mk_TM (par x) ?. // qed.
-definition APP β Ξ»u,v:TM.mk_TM (app u v) ?.
-change with (pretm_ind_plus ???????) in match (check_tm ??); >pretm_ind_plus_app
-change with (check_tm ??) in match (pretm_ind_plus ???????); change with (check_tm ??) in match (pretm_ind_plus ???????) in β’ (??(??%)?);
-@andb_elim >(tm_of_TM u) >(tm_of_TM v) % qed.
-definition LAM β Ξ»x,s.Ξ»u:TM.mk_TM (lam x s u) ?.
-change with (pretm_ind_plus ???????) in match (check_tm ??); <(vclose_vopen x u)
->pretm_ind_plus_lam [| // | @fresh_vclose_tm ]
-change with (check_tm ??) in match (pretm_ind_plus ???????); >vclose_vopen
-@(tm_of_TM u) qed.
-
-axiom vopen_tm_down : βu,x,k.tm_or_ctx (S k) u β tm_or_ctx k (uβxβ).
-(* needs true_plus_false
-
-#u #x #k #Hu elim Hu
-[ #n #Hn normalize cases (true_or_false (eqb n O)) #H >H [%2]
- normalize >(?: leb n O = false) [|cases n in H; // >eqb_n_n #H destruct (H) ]
- normalize lapply Hn cases n in H; normalize [ #Hfalse destruct (Hfalse) ]
- #n0 #_ #Hn0 % @le_S_S_to_le //
-| #x0 %2
-| #v1 #v2 #Hv1 #Hv2 #IH1 #IH2 %3 //
-| #x0 #s #v #Hv #IH normalize @daemon
-]
-qed.
-*)
-
-definition vopen_TM β Ξ»u:CTX.Ξ»x.mk_TM (uβxβ) ?.
-@toc_to_check_tm_true @vopen_tm_down @check_tm_true_to_toc @ctx_of_CTX qed.
-
-axiom vclose_tm_up : βu,x,k.tm_or_ctx k u β tm_or_ctx (S k) (Ξ½x.u).
-
-definition vclose_TM β Ξ»u:TM.Ξ»x.mk_CTX (Ξ½x.u) ?.
-@toc_to_check_tm_true @vclose_tm_up @check_tm_true_to_toc @tm_of_TM qed.
-
-interpretation "ln wf term variable open" 'open u x = (vopen_TM u x).
-interpretation "ln wf term variable close" 'nu x u = (vclose_TM u x).
-
-theorem tm_alpha : βx,y,s,u.x β FV u β y β FV u β lam x s (uβxβ) = lam y s (uβyβ).
-#x #y #s #u #Hx #Hy whd in β’ (??%%); @eq_f >nominal_eta // >nominal_eta //
-qed.
-
-lemma TM_to_tm2 : βu:TM.tm2 u.
-#u @tm_to_tm2 @check_tm_true_to_toc @tm_of_TM qed.
-
-theorem TM_ind_plus_weak :
- βP:pretm β Type[0].
- (βx:πΈ.P (PAR x)) β
- (βv1,v2:TM.P v1 β P v2 β P (APP v1 v2)) β
- βC:list πΈ.
- (βx,s.βv:CTX.x β FV v β x β C β
- (βy.y β FV v β P (vβyβ)) β P (LAM x s (vβxβ))) β
- βu:TM.P u.
-#P #Hpar #Happ #C #Hlam #u elim (TM_to_tm2 u) //
-[ #v1 #v2 #pv1 #pv2 #IH1 #IH2 @(Happ (mk_TM β¦) (mk_TM β¦) IH1 IH2)
- @toc_to_check_tm_true @tm2_to_tm //
-| #x #s #v #Hx #pv #IH
- lapply (p_fresh β¦ (C@FV v)) letin x0 β (N_fresh β¦ (C@FV v)) #Hx0
- >(?:lam x s (vβxβ) = lam x0 s (vβx0β))
- [|@tm_alpha // @(not_to_not β¦ Hx0) @in_list_to_in_list_append_r ]
- @(Hlam x0 s (mk_CTX v ?) ??)
- [ <(nominal_eta β¦ Hx) @toc_to_check_tm_true @vclose_tm_up @tm2_to_tm @pv //
- | @(not_to_not β¦ Hx0) @in_list_to_in_list_append_r
- | @(not_to_not β¦ Hx0) @in_list_to_in_list_append_l
- | @IH ]
-]
-qed.
-
-lemma eq_mk_TM : βu,v.u = v β βpu,pv.mk_TM u pu = mk_TM v pv.
-#u #v #Heq >Heq #pu #pv %
-qed.
-
-lemma eq_P : βT:Type[0].βt1,t2:T.t1 = t2 β βP:T β Type[0].P t1 β P t2. // qed.
-
-theorem TM_ind_plus :
- βP:TM β Type[0].
- (βx:πΈ.P (PAR x)) β
- (βv1,v2:TM.P v1 β P v2 β P (APP v1 v2)) β
- βC:list πΈ.
- (βx,s.βv:CTX.x β FV v β x β C β
- (βy.y β FV v β P (vβyβ)) β P (LAM x s (vβxβ))) β
- βu:TM.P u.
-#P #Hpar #Happ #C #Hlam * #u #pu
->(?:mk_TM u pu =
- mk_TM u (toc_to_check_tm_true β¦ (tm2_to_tm β¦ (tm_to_tm2 β¦ (check_tm_true_to_toc β¦ pu))))) [|%]
-elim (tm_to_tm2 u ?) //
-[ #v1 #v2 #pv1 #pv2 #IH1 #IH2 @(Happ (mk_TM β¦) (mk_TM β¦) IH1 IH2)
-| #x #s #v #Hx #pv #IH
- lapply (p_fresh β¦ (C@FV v)) letin x0 β (N_fresh β¦ (C@FV v)) #Hx0
- lapply (Hlam x0 s (mk_CTX v ?) ???)
- [2: @(not_to_not β¦ Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_l @Hx0
- |4: @toc_to_check_tm_true <(nominal_eta x v) // @vclose_tm_up @tm2_to_tm @pv //
- | #y #Hy whd in match (vopen_TM ??);
- >(?:mk_TM (vβyβ) ? = mk_TM (vβyβ) (toc_to_check_tm_true (vβyβ) O (tm2_to_tm (vβyβ) (pv y Hy))))
- [@IH|%]
- | @(not_to_not β¦ Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_r @Hx0
- | @eq_P @eq_mk_TM whd in match (vopen_TM ??); @tm_alpha // @(not_to_not β¦ Hx0) @in_list_to_in_list_append_r ]
-]
-qed.
-
-notation
-"hvbox('nominal' u 'return' out 'with'
- [ 'xpar' ident x β f1
- | 'xapp' ident v1 ident v2 ident recv1 ident recv2 β f2
- | 'xlam' β¨ident y # Cβ© ident s ident w ident py1 ident py2 ident recw β f3 ])"
-with precedence 48
-for @{ TM_ind_plus $out (Ξ»${ident x}:?.$f1)
- (Ξ»${ident v1}:?.Ξ»${ident v2}:?.Ξ»${ident recv1}:?.Ξ»${ident recv2}:?.$f2)
- $C (Ξ»${ident y}:?.Ξ»${ident s}:?.Ξ»${ident w}:?.Ξ»${ident py1}:?.Ξ»${ident py2}:?.Ξ»${ident recw}:?.$f3)
- $u }.
-
-(* include "basics/jmeq.ma".*)
-
-definition subst β (Ξ»u:TM.Ξ»x,v.
- nominal u return (Ξ»_.TM) with
- [ xpar x0 β match x == x0 with [ true β v | false β PAR x0 ] (* u instead of PAR x0 does not work, u stays the same at every rec call! *)
- | xapp v1 v2 recv1 recv2 β APP recv1 recv2
- | xlam β¨y # x::FV vβ© s w py1 py2 recw β LAM y s (recw y py1) ]).
-
-lemma subst_def : βu,x,v.subst u x v =
- nominal u return (Ξ»_.TM) with
- [ xpar x0 β match x == x0 with [ true β v | false β PAR x0 ]
- | xapp v1 v2 recv1 recv2 β APP recv1 recv2
- | xlam β¨y # x::FV vβ© s w py1 py2 recw β LAM y s (recw y py1) ]. //
-qed.
-
-axiom TM_ind_plus_LAM :
- βx,s,u,out,f1,f2,C,f3,Hx1,Hx2.
- TM_ind_plus out f1 f2 C f3 (LAM x s (uβxβ)) =
- f3 x s u Hx1 Hx2 (Ξ»y,Hy.TM_ind_plus ? f1 f2 C f3 ?).
-
-axiom TM_ind_plus_APP :
- βu1,u2,out,f1,f2,C,f3.
- TM_ind_plus out f1 f2 C f3 (APP u1 u2) =
- f2 u1 u2 (TM_ind_plus out f1 f2 C f3 ?) (TM_ind_plus out f1 f2 C f3 ?).
-
-lemma eq_mk_CTX : βu,v.u = v β βpu,pv.mk_CTX u pu = mk_CTX v pv.
-#u #v #Heq >Heq #pu #pv %
-qed.
-
-lemma vclose_vopen_TM : βx.βu:TM.((Ξ½x.u)βxβ) = u.
-#x * #u #pu @eq_mk_TM @vclose_vopen qed.
-
-lemma nominal_eta_CTX : βx.βu:CTX.x β FV u β (Ξ½x.(uβxβ)) = u.
-#x * #u #pu #Hx @eq_mk_CTX @nominal_eta // qed.
-
-theorem TM_alpha : βx,y,s.βu:CTX.x β FV u β y β FV u β LAM x s (uβxβ) = LAM y s (uβyβ).
-#x #y #s #u #Hx #Hy @eq_mk_TM @tm_alpha // qed.
-
-axiom in_vopen_CTX : βx,y.βv:CTX.x β FV (vβyβ) β x = y β¨ x β FV v.
-
-theorem subst_fresh : βu,v:TM.βx.x β FV u β subst u x v = u.
-#u #v #x @(TM_ind_plus β¦ (x::FV v) β¦ u)
-[ #x0 normalize in β’ (%β?); #Hx normalize in β’ (??%?);
- >(\bf ?) [| @(not_to_not β¦ Hx) #Heq >Heq % ] %
-| #u1 #u2 #IH1 #IH2 normalize in β’ (%β?); #Hx
- >subst_def >TM_ind_plus_APP @eq_mk_TM @eq_f2 @eq_f
- [ <subst_def @IH1 @(not_to_not β¦ Hx) @in_list_to_in_list_append_l
- | <subst_def @IH2 @(not_to_not β¦ Hx) @in_list_to_in_list_append_r ]
-| #x0 #s #v0 #Hx0 #HC #IH #Hx >subst_def >TM_ind_plus_LAM [|@HC|@Hx0]
- @eq_f <subst_def @IH // @(not_to_not β¦ Hx) -Hx #Hx
- change with (FV (Ξ½x0.(v0βx0β))) in β’ (???%); >nominal_eta_CTX //
- cases (in_vopen_CTX β¦ Hx) // #Heq >Heq in HC; * #HC @False_ind @HC %
-]
-qed.
-
-example subst_LAM_same : βx,s,u,v. subst (LAM x s u) x v = LAM x s u.
-#x #s #u #v >subst_def <(vclose_vopen_TM x u)
-lapply (p_fresh β¦ (FV (Ξ½x.u)@x::FV v)) letin x0 β (N_fresh β¦ (FV (Ξ½x.u)@x::FV v)) #Hx0
->(TM_alpha x x0)
-[| @(not_to_not β¦ Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_l @Hx0 | @fresh_vclose_tm ]
->TM_ind_plus_LAM [| @(not_to_not β¦ Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_r @Hx0 | @(not_to_not β¦ Hx0) -Hx0 #Hx0 @in_list_to_in_list_append_l @Hx0 ]
-@eq_f change with (subst ((Ξ½x.u)βx0β) x v) in β’ (??%?); @subst_fresh
-@(not_to_not β¦ Hx0) #Hx0' cases (in_vopen_CTX β¦ Hx0')
-[ #Heq >Heq @in_list_to_in_list_append_r %
-| #Hfalse @False_ind cases (fresh_vclose_tm u x) #H @H @Hfalse ]
-qed.
-
-(*
-notation > "Ξ ident x. ident T [ident x] β¦ P"
- with precedence 48 for @{'foo (Ξ»${ident x}.Ξ»${ident T}.$P)}.
-
-notation < "Ξ ident x. ident T [ident x] β¦ P"
- with precedence 48 for @{'foo (Ξ»${ident x}:$Q.Ξ»${ident T}:$R.$P)}.
-*)
-
-(*
-notation
-"hvbox('nominal' u 'with'
- [ 'xpar' ident x β f1
- | 'xapp' ident v1 ident v2 β f2
- | 'xlam' ident x # C s w β f3 ])"
-with precedence 48
-for @{ tm2_ind_plus ? (Ξ»${ident x}:$Tx.$f1)
- (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
- $C (Ξ»${ident x}:$Tx.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
-*)
-
-(*
-notation
-"hvbox('nominal' u 'with'
- [ 'xpar' ident x ^ f1
- | 'xapp' ident v1 ident v2 ^ f2 ])"
-(* | 'xlam' ident x # C s w ^ f3 ]) *)
-with precedence 48
-for @{ tm2_ind_plus ? (Ξ»${ident x}:$Tx.$f1)
- (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
- $C (Ξ»${ident x}:$Tx.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
-*)
-notation
-"hvbox('nominal' u 'with'
- [ 'xpar' ident x ^ f1
- | 'xapp' ident v1 ident v2 ^ f2 ])"
-with precedence 48
-for @{ tm2_ind_plus ? (Ξ»${ident x}:?.$f1)
- (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
- $C (Ξ»${ident x}:?.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
-
-axiom in_Env : πΈ Γ tp β Env β Prop.
-notation "X β G" non associative with precedence 45 for @{'lefttriangle $X $G}.
-interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
-
-
-
-inductive judg : list tp β tm β tp β Prop β
-| t_var : βg,n,t.Nth ? n g = Some ? t β judg g (var n) t
-| t_app : βg,m,n,t,u.judg g m (arr t u) β judg g n t β judg g (app m n) u
-| t_abs : βg,t,m,u.judg (t::g) m u β judg g (abs t m) (arr t u).
-
-definition Env := list (πΈ Γ tp).
-
-axiom vclose_env : Env β list tp.
-axiom vclose_tm : Env β tm β tm.
-axiom Lam : πΈ β tp β tm β tm.
-definition Judg β Ξ»G,M,T.judg (vclose_env G) (vclose_tm G M) T.
-definition dom β Ξ»G:Env.map ?? (fst ??) G.
-
-definition sctx β πΈ Γ tm.
-axiom swap_tm : πΈ β πΈ β tm β tm.
-definition sctx_app : sctx β πΈ β tm β Ξ»M0,Y.let β©X,Mβͺ β M0 in swap_tm X Y M.
-
-axiom in_list : βA:Type[0].A β list A β Prop.
-interpretation "list membership" 'mem x l = (in_list ? x l).
-interpretation "list non-membership" 'notmem x l = (Not (in_list ? x l)).
-
-axiom in_Env : πΈ Γ tp β Env β Prop.
-notation "X β G" non associative with precedence 45 for @{'lefttriangle $X $G}.
-interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
-
-(* axiom Lookup : πΈ β Env β option tp. *)
-
-(* forma alto livello del judgment
- t_abs* : βG,T,X,M,U.
- (βY β supp(M).Judg (β©Y,Tβͺ::G) (M[Y]) U) β
- Judg G (Lam X T (M[X])) (arr T U) *)
-
-(* prima dimostrare, poi perfezionare gli assiomi, poi dimostrarli *)
-
-axiom Judg_ind : βP:Env β tm β tp β Prop.
- (βX,G,T.β©X,Tβͺ β G β P G (par X) T) β
- (βG,M,N,T,U.
- Judg G M (arr T U) β Judg G N T β
- P G M (arr T U) β P G N T β P G (app M N) U) β
- (βG,T1,T2,X,M1.
- (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β Judg (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
- (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β P (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
- P G (Lam X T1 (sctx_app M1 X)) (arr T1 T2)) β
- βG,M,T.Judg G M T β P G M T.
-
-axiom t_par : βX,G,T.β©X,Tβͺ β G β Judg G (par X) T.
-axiom t_app2 : βG,M,N,T,U.Judg G M (arr T U) β Judg G N T β Judg G (app M N) U.
-axiom t_Lam : βG,X,M,T,U.Judg (β©X,Tβͺ::G) M U β Judg G (Lam X T M) (arr T U).
-
-definition subenv β Ξ»G1,G2.βx.x β G1 β x β G2.
-interpretation "subenv" 'subseteq G1 G2 = (subenv G1 G2).
-
-axiom daemon : βP:Prop.P.
-
-theorem weakening : βG1,G2,M,T.G1 β G2 β Judg G1 M T β Judg G2 M T.
-#G1 #G2 #M #T #Hsub #HJ lapply Hsub lapply G2 -G2 change with (βG2.?)
-@(Judg_ind β¦ HJ)
-[ #X #G #T0 #Hin #G2 #Hsub @t_par @Hsub //
-| #G #M0 #N #T0 #U #HM0 #HN #IH1 #IH2 #G2 #Hsub @t_app2
- [| @IH1 // | @IH2 // ]
-| #G #T1 #T2 #X #M1 #HM1 #IH #G2 #Hsub @t_Lam @IH
- [ (* trivial property of Lam *) @daemon
- | (* trivial property of subenv *) @daemon ]
-]
-qed.
-
-(* Serve un tipo Tm per i termini localmente chiusi e i suoi principi di induzione e
- ricorsione *)
\ No newline at end of file
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basics/lists/list.ma".
-include "basics/deqsets.ma".
-include "binding/names.ma".
-include "binding/fp.ma".
-
-definition alpha : Nset β X. check alpha
-notation "πΈ" non associative with precedence 90 for @{'alphabet}.
-interpretation "set of names" 'alphabet = alpha.
-
-inductive tp : Type[0] β
-| top : tp
-| arr : tp β tp β tp.
-inductive pretm : Type[0] β
-| var : nat β pretm
-| par : πΈ β pretm
-| abs : tp β pretm β pretm
-| app : pretm β pretm β pretm.
-
-let rec Nth T n (l:list T) on n β
- match l with
- [ nil β None ?
- | cons hd tl β match n with
- [ O β Some ? hd
- | S n0 β Nth T n0 tl ] ].
-
-let rec vclose_tm_aux u x k β match u with
- [ var n β if (leb k n) then var (S n) else u
- | par x0 β if (x0 == x) then (var k) else u
- | app v1 v2 β app (vclose_tm_aux v1 x k) (vclose_tm_aux v2 x k)
- | abs s v β abs s (vclose_tm_aux v x (S k)) ].
-definition vclose_tm β Ξ»u,x.vclose_tm_aux u x O.
-
-definition vopen_var β Ξ»n,x,k.match eqb n k with
- [ true β par x
- | false β match leb n k with
- [ true β var n
- | false β var (pred n) ] ].
-
-let rec vopen_tm_aux u x k β match u with
- [ var n β vopen_var n x k
- | par x0 β u
- | app v1 v2 β app (vopen_tm_aux v1 x k) (vopen_tm_aux v2 x k)
- | abs s v β abs s (vopen_tm_aux v x (S k)) ].
-definition vopen_tm β Ξ»u,x.vopen_tm_aux u x O.
-
-let rec FV u β match u with
- [ par x β [x]
- | app v1 v2 β FV v1@FV v2
- | abs s v β FV v
- | _ β [ ] ].
-
-definition lam β Ξ»x,s,u.abs s (vclose_tm u x).
-
-let rec Pi_map_tm p u on u β match u with
-[ par x β par (p x)
-| var _ β u
-| app v1 v2 β app (Pi_map_tm p v1) (Pi_map_tm p v2)
-| abs s v β abs s (Pi_map_tm p v) ].
-
-interpretation "permutation of tm" 'middot p x = (Pi_map_tm p x).
-
-notation "hvbox(uβxβ)"
- with precedence 45
- for @{ 'open $u $x }.
-
-(*
-notation "hvbox(uβxβ)"
- with precedence 45
- for @{ 'open $u $x }.
-notation "β΄ u β΅ x" non associative with precedence 90 for @{ 'open $u $x }.
-*)
-interpretation "ln term variable open" 'open u x = (vopen_tm u x).
-notation < "hvbox(Ξ½ x break . u)"
- with precedence 20
-for @{'nu $x $u }.
-notation > "Ξ½ list1 x sep , . term 19 u" with precedence 20
- for ${ fold right @{$u} rec acc @{'nu $x $acc)} }.
-interpretation "ln term variable close" 'nu x u = (vclose_tm u x).
-
-let rec tm_height u β match u with
-[ app v1 v2 β S (max (tm_height v1) (tm_height v2))
-| abs s v β S (tm_height v)
-| _ β O ].
-
-theorem le_n_O_rect_Type0 : βn:nat. n β€ O β βP: nat βType[0]. P O β P n.
-#n (cases n) // #a #abs cases (?:False) /2/ qed.
-
-theorem nat_rect_Type0_1 : βn:nat.βP:nat β Type[0].
-(βm.(βp. p < m β P p) β P m) β P n.
-#n #P #H
-cut (βq:nat. q β€ n β P q) /2/
-(elim n)
- [#q #HleO (* applica male *)
- @(le_n_O_rect_Type0 ? HleO)
- @H #p #ltpO cases (?:False) /2/ (* 3 *)
- |#p #Hind #q #HleS
- @H #a #lta @Hind @le_S_S_to_le /2/
- ]
-qed.
-
-lemma leb_false_to_lt : βn,m. leb n m = false β m < n.
-#n elim n
-[ #m normalize #H destruct(H)
-| #n0 #IH * // #m normalize #H @le_S_S @IH // ]
-qed.
-
-lemma nominal_eta_aux : βx,u.x β FV u β βk.vclose_tm_aux (vopen_tm_aux u x k) x k = u.
-#x #u elim u
-[ #n #_ #k normalize cases (decidable_eq_nat n k) #Hnk
- [ >Hnk >eqb_n_n whd in β’ (??%?); >(\b ?) //
- | >(not_eq_to_eqb_false β¦ Hnk) normalize cases (true_or_false (leb n k)) #Hleb
- [ >Hleb normalize >(?:leb k n = false) //
- @lt_to_leb_false @not_eq_to_le_to_lt /2/
- | >Hleb normalize >(?:leb k (pred n) = true) normalize
- [ cases (leb_false_to_lt β¦ Hleb) //
- | @le_to_leb_true cases (leb_false_to_lt β¦ Hleb) normalize /2/ ] ] ]
-| #y normalize in β’ (%β?β?); #Hy whd in β’ (?β??%?); >(\bf ?) // @(not_to_not β¦ Hy) //
-| #s #v #IH normalize #Hv #k >IH // @Hv
-| #v1 #v2 #IH1 #IH2 normalize #Hv1v2 #k
- >IH1 [ >IH2 // | @(not_to_not β¦ Hv1v2) @in_list_to_in_list_append_l ]
- @(not_to_not β¦ Hv1v2) @in_list_to_in_list_append_r ]
-qed.
-
-corollary nominal_eta : βx,u.x β FV u β (Ξ½x.uβxβ) = u.
-#x #u #Hu @nominal_eta_aux //
-qed.
-
-lemma eq_height_vopen_aux : βv,x,k.tm_height (vopen_tm_aux v x k) = tm_height v.
-#v #x elim v
-[ #n #k normalize cases (eqb n k) // cases (leb n k) //
-| #u #k %
-| #s #u #IH #k normalize >IH %
-| #u1 #u2 #IH1 #IH2 #k normalize >IH1 >IH2 % ]
-qed.
-
-corollary eq_height_vopen : βv,x.tm_height (vβxβ) = tm_height v.
-#v #x @eq_height_vopen_aux
-qed.
-
-theorem pretm_ind_plus_aux :
- βP:pretm β Type[0].
- (βx:πΈ.P (par x)) β
- (βn:β.P (var n)) β
- (βv1,v2. P v1 β P v2 β P (app v1 v2)) β
- βC:list πΈ.
- (βx,s,v.x β FV v β x β C β P (vβxβ) β P (lam x s (vβxβ))) β
- βn,u.tm_height u β€ n β P u.
-#P #Hpar #Hvar #Happ #C #Hlam #n change with ((Ξ»n.?) n); @(nat_rect_Type0_1 n ??)
-#m cases m
-[ #_ * /2/
- [ normalize #s #v #Hfalse cases (?:False) cases (not_le_Sn_O (tm_height v)) /2/
- | #v1 #v2 whd in β’ (?%?β?); #Hfalse cases (?:False) cases (not_le_Sn_O (S (max ??))) /2/ ] ]
--m #m #IH * /2/
-[ #s #v whd in β’ (?%?β?); #Hv
- lapply (p_fresh β¦ (C@FV v)) letin y β (N_fresh β¦ (C@FV v)) #Hy
- >(?:abs s v = lam y s (vβyβ))
- [| whd in β’ (???%); >nominal_eta // @(not_to_not β¦ Hy) @in_list_to_in_list_append_r ]
- @Hlam
- [ @(not_to_not β¦ Hy) @in_list_to_in_list_append_r
- | @(not_to_not β¦ Hy) @in_list_to_in_list_append_l ]
- @IH [| @Hv | >eq_height_vopen % ]
-| #v1 #v2 whd in β’ (?%?β?); #Hv @Happ
- [ @IH [| @Hv | // ] | @IH [| @Hv | // ] ] ]
-qed.
-
-corollary pretm_ind_plus :
- βP:pretm β Type[0].
- (βx:πΈ.P (par x)) β
- (βn:β.P (var n)) β
- (βv1,v2. P v1 β P v2 β P (app v1 v2)) β
- βC:list πΈ.
- (βx,s,v.x β FV v β x β C β P (vβxβ) β P (lam x s (vβxβ))) β
- βu.P u.
-#P #Hpar #Hvar #Happ #C #Hlam #u @pretm_ind_plus_aux /2/
-qed.
-
-(* maps a permutation to a list of terms *)
-definition Pi_map_list : (πΈ β πΈ) β list πΈ β list πΈ β map πΈ πΈ .
-
-(* interpretation "permutation of name list" 'middot p x = (Pi_map_list p x).*)
-
-(*
-inductive tm : pretm β Prop β
-| tm_par : βx:πΈ.tm (par x)
-| tm_app : βu,v.tm u β tm v β tm (app u v)
-| tm_lam : βx,s,u.tm u β tm (lam x s u).
-
-inductive ctx_aux : nat β pretm β Prop β
-| ctx_var : βn,k.n < k β ctx_aux k (var n)
-| ctx_par : βx,k.ctx_aux k (par x)
-| ctx_app : βu,v,k.ctx_aux k u β ctx_aux k v β ctx_aux k (app u v)
-(* Γ¨ sostituibile da ctx_lam ? *)
-| ctx_abs : βs,u.ctx_aux (S k) u β ctx_aux k (abs s u).
-*)
-
-inductive tm_or_ctx (k:nat) : pretm β Type[0] β
-| toc_var : βn.n < k β tm_or_ctx k (var n)
-| toc_par : βx.tm_or_ctx k (par x)
-| toc_app : βu,v.tm_or_ctx k u β tm_or_ctx k v β tm_or_ctx k (app u v)
-| toc_lam : βx,s,u.tm_or_ctx k u β tm_or_ctx k (lam x s u).
-
-definition tm β Ξ»t.tm_or_ctx O t.
-definition ctx β Ξ»t.tm_or_ctx 1 t.
-
-record TM : Type[0] β {
- pretm_of_TM :> pretm;
- tm_of_TM : tm pretm_of_TM
-}.
-
-record CTX : Type[0] β {
- pretm_of_CTX :> pretm;
- ctx_of_CTX : ctx pretm_of_CTX
-}.
-
-inductive tm2 : pretm β Type[0] β
-| tm_par : βx.tm2 (par x)
-| tm_app : βu,v.tm2 u β tm2 v β tm2 (app u v)
-| tm_lam : βx,s,u.x β FV u β (βy.y β FV u β tm2 (uβyβ)) β tm2 (lam x s (uβxβ)).
-
-(*
-inductive tm' : pretm β Prop β
-| tm_par : βx.tm' (par x)
-| tm_app : βu,v.tm' u β tm' v β tm' (app u v)
-| tm_lam : βx,s,u,C.x β FV u β x β C β (βy.y β FV u β tm' (β΄uβ΅y)) β tm' (lam x s (β΄uβ΅x)).
-*)
-
-axiom swap_inj : βN.βz1,z2,x,y.swap N z1 z2 x = swap N z1 z2 y β x = y.
-
-lemma pi_vclose_tm :
- βz1,z2,x,u.swap πΈ z1 z2Β·(Ξ½x.u) = (Ξ½ swap ? z1 z2 x.swap πΈ z1 z2 Β· u).
-#z1 #z2 #x #u
-change with (vclose_tm_aux ???) in match (vclose_tm ??);
-change with (vclose_tm_aux ???) in β’ (???%); lapply O elim u
-[3:whd in β’ (?β?β(?β ??%%)β?β??%%); //
-|4:whd in β’ (?β?β(?β??%%)β(?β??%%)β?β??%%); //
-| #n #k whd in β’ (??(??%)%); cases (leb k n) normalize %
-| #x0 #k cases (true_or_false (x0==z1)) #H1 >H1 whd in β’ (??%%);
- [ cases (true_or_false (x0==x)) #H2 >H2 whd in β’ (??(??%)%);
- [ <(\P H2) >H1 whd in β’ (??(??%)%); >(\b ?) // >(\b ?) //
- | >H2 whd in match (swap ????); >H1
- whd in match (if false then var k else ?);
- whd in match (if true then z2 else ?); >(\bf ?)
- [ >(\P H1) >swap_left %
- | <(swap_inv ? z1 z2 z2) in β’ (?(??%?)); % #H3
- lapply (swap_inj β¦ H3) >swap_right #H4 <H4 in H2; >H1 #H destruct (H) ]
- ]
- | >(?:(swap ? z1 z2 x0 == swap ? z1 z2 x) = (x0 == x))
- [| cases (true_or_false (x0==x)) #H2 >H2
- [ >(\P H2) @(\b ?) %
- | @(\bf ?) % #H >(swap_inj β¦ H) in H2; >(\b ?) // #H0 destruct (H0) ] ]
- cases (true_or_false (x0==x)) #H2 >H2 whd in β’ (??(??%)%);
- [ <(\P H2) >H1 >(\b (refl ??)) %
- | >H1 >H2 % ]
- ]
- ]
-qed.
-
-lemma pi_vopen_tm :
- βz1,z2,x,u.swap πΈ z1 z2Β·(uβxβ) = (swap πΈ z1 z2 Β· uβswap πΈ z1 z2 xβ).
-#z1 #z2 #x #u
-change with (vopen_tm_aux ???) in match (vopen_tm ??);
-change with (vopen_tm_aux ???) in β’ (???%); lapply O elim u //
-[2: #s #v whd in β’ ((?β??%%)β?β??%%); //
-|3: #v1 #v2 whd in β’ ((?β??%%)β(?β??%%)β?β??%%); /2/ ]
-#n #k whd in β’ (??(??%)%); cases (true_or_false (eqb n k)) #H1 >H1 //
-cases (true_or_false (leb n k)) #H2 >H2 normalize //
-qed.
-
-lemma pi_lam :
- βz1,z2,x,s,u.swap πΈ z1 z2 Β· lam x s u = lam (swap πΈ z1 z2 x) s (swap πΈ z1 z2 Β· u).
-#z1 #z2 #x #s #u whd in β’ (???%); <(pi_vclose_tm β¦) %
-qed.
-
-lemma eqv_FV : βz1,z2,u.FV (swap πΈ z1 z2 Β· u) = Pi_map_list (swap πΈ z1 z2) (FV u).
-#z1 #z2 #u elim u //
-[ #s #v #H @H
-| #v1 #v2 whd in β’ (??%%β??%%β??%%); #H1 #H2 >H1 >H2
- whd in β’ (???(????%)); /2/ ]
-qed.
-
-lemma swap_inv_tm : βz1,z2,u.swap πΈ z1 z2 Β· (swap πΈ z1 z2 Β· u) = u.
-#z1 #z2 #u elim u
-[1: #n %
-|3: #s #v whd in β’ (?β??%%); //
-|4: #v1 #v2 #Hv1 #Hv2 whd in β’ (??%%); // ]
-#x whd in β’ (??%?); >swap_inv %
-qed.
-
-lemma eqv_in_list : βx,l,z1,z2.x β l β swap πΈ z1 z2 x β Pi_map_list (swap πΈ z1 z2) l.
-#x #l #z1 #z2 #Hin elim Hin
-[ #x0 #l0 %
-| #x1 #x2 #l0 #Hin #IH %2 @IH ]
-qed.
-
-lemma eqv_tm2 : βu.tm2 u β βz1,z2.tm2 ((swap ? z1 z2)Β·u).
-#u #Hu #z1 #z2 letin p β (swap ? z1 z2) elim Hu /2/
-#x #s #v #Hx #Hv #IH >pi_lam >pi_vopen_tm %3
-[ @(not_to_not β¦ Hx) -Hx #Hx
- <(swap_inv ? z1 z2 x) <(swap_inv_tm z1 z2 v) >eqv_FV @eqv_in_list //
-| #y #Hy <(swap_inv ? z1 z2 y)
- <pi_vopen_tm @IH @(not_to_not β¦ Hy) -Hy #Hy <(swap_inv ? z1 z2 y)
- >eqv_FV @eqv_in_list //
-]
-qed.
-
-lemma vclose_vopen_aux : βx,u,k.vopen_tm_aux (vclose_tm_aux u x k) x k = u.
-#x #u elim u [1,3,4:normalize //]
-[ #n #k cases (true_or_false (leb k n)) #H >H whd in β’ (??%?);
- [ cases (true_or_false (eqb (S n) k)) #H1 >H1
- [ <(eqb_true_to_eq β¦ H1) in H; #H lapply (leb_true_to_le β¦ H) -H #H
- cases (le_to_not_lt β¦ H) -H #H cases (H ?) %
- | whd in β’ (??%?); >lt_to_leb_false // @le_S_S /2/ ]
- | cases (true_or_false (eqb n k)) #H1 >H1 normalize
- [ >(eqb_true_to_eq β¦ H1) in H; #H lapply (leb_false_to_not_le β¦ H) -H
- * #H cases (H ?) %
- | >le_to_leb_true // @not_lt_to_le % #H2 >le_to_leb_true in H;
- [ #H destruct (H) | /2/ ]
- ]
- ]
-| #x0 #k whd in β’ (??(?%??)?); cases (true_or_false (x0==x))
- #H1 >H1 normalize // >(\P H1) >eqb_n_n % ]
-qed.
-
-lemma vclose_vopen : βx,u.((Ξ½x.u)βxβ) = u. #x #u @vclose_vopen_aux
-qed.
-
-(*
-theorem tm_to_tm : βt.tm' t β tm t.
-#t #H elim H
-*)
-
-lemma in_list_singleton : βT.βt1,t2:T.t1 β [t2] β t1 = t2.
-#T #t1 #t2 #H @(in_list_inv_ind ??? H) /2/
-qed.
-
-lemma fresh_vclose_tm_aux : βu,x,k.x β FV (vclose_tm_aux u x k).
-#u #x elim u //
-[ #n #k normalize cases (leb k n) normalize //
-| #x0 #k whd in β’ (?(???(?%))); cases (true_or_false (x0==x)) #H >H normalize //
- lapply (\Pf H) @not_to_not #Hin >(in_list_singleton ??? Hin) %
-| #v1 #v2 #IH1 #IH2 #k normalize % #Hin cases (in_list_append_to_or_in_list ???? Hin) -Hin #Hin
- [ cases (IH1 k) -IH1 #IH1 @IH1 @Hin | cases (IH2 k) -IH2 #IH2 @IH2 @Hin ]
-qed.
-
-lemma fresh_vclose_tm : βu,x.x β FV (Ξ½x.u). //
-qed.
-
-lemma fresh_swap_tm : βz1,z2,u.z1 β FV u β z2 β FV u β swap πΈ z1 z2 Β· u = u.
-#z1 #z2 #u elim u
-[2: normalize in β’ (?β%β%β?); #x #Hz1 #Hz2 whd in β’ (??%?); >swap_other //
- [ @(not_to_not β¦ Hz2) | @(not_to_not β¦ Hz1) ] //
-|1: //
-| #s #v #IH normalize #Hz1 #Hz2 >IH // [@Hz2|@Hz1]
-| #v1 #v2 #IH1 #IH2 normalize #Hz1 #Hz2
- >IH1 [| @(not_to_not β¦ Hz2) @in_list_to_in_list_append_l | @(not_to_not β¦ Hz1) @in_list_to_in_list_append_l ]
- >IH2 // [@(not_to_not β¦ Hz2) @in_list_to_in_list_append_r | @(not_to_not β¦ Hz1) @in_list_to_in_list_append_r ]
-]
-qed.
-
-theorem tm_to_tm2 : βu.tm u β tm2 u.
-#t #Ht elim Ht
-[ #n #Hn cases (not_le_Sn_O n) #Hfalse cases (Hfalse Hn)
-| @tm_par
-| #u #v #Hu #Hv @tm_app
-| #x #s #u #Hu #IHu <(vclose_vopen x u) @tm_lam
- [ @fresh_vclose_tm
- | #y #Hy <(fresh_swap_tm x y (Ξ½x.u)) /2/ @fresh_vclose_tm ]
-]
-qed.
-
-theorem tm2_to_tm : βu.tm2 u β tm u.
-#u #pu elim pu /2/ #x #s #v #Hx #Hv #IH %4 @IH //
-qed.
-
-definition PAR β Ξ»x.mk_TM (par x) ?. // qed.
-definition APP β Ξ»u,v:TM.mk_TM (app u v) ?./2/ qed.
-definition LAM β Ξ»x,s.Ξ»u:TM.mk_TM (lam x s u) ?./2/ qed.
-
-axiom vopen_tm_down : βu,x,k.tm_or_ctx (S k) u β tm_or_ctx k (uβxβ).
-(* needs true_plus_false
-
-#u #x #k #Hu elim Hu
-[ #n #Hn normalize cases (true_or_false (eqb n O)) #H >H [%2]
- normalize >(?: leb n O = false) [|cases n in H; // >eqb_n_n #H destruct (H) ]
- normalize lapply Hn cases n in H; normalize [ #Hfalse destruct (Hfalse) ]
- #n0 #_ #Hn0 % @le_S_S_to_le //
-| #x0 %2
-| #v1 #v2 #Hv1 #Hv2 #IH1 #IH2 %3 //
-| #x0 #s #v #Hv #IH normalize @daemon
-]
-qed.
-*)
-
-definition vopen_TM β Ξ»u:CTX.Ξ»x.mk_TM (uβxβ) (vopen_tm_down β¦). @ctx_of_CTX qed.
-
-axiom vclose_tm_up : βu,x,k.tm_or_ctx k u β tm_or_ctx (S k) (Ξ½x.u).
-
-definition vclose_TM β Ξ»u:TM.Ξ»x.mk_CTX (Ξ½x.u) (vclose_tm_up β¦). @tm_of_TM qed.
-
-interpretation "ln wf term variable open" 'open u x = (vopen_TM u x).
-interpretation "ln wf term variable close" 'nu x u = (vclose_TM u x).
-
-theorem tm_alpha : βx,y,s,u.x β FV u β y β FV u β lam x s (uβxβ) = lam y s (uβyβ).
-#x #y #s #u #Hx #Hy whd in β’ (??%%); @eq_f >nominal_eta // >nominal_eta //
-qed.
-
-theorem TM_ind_plus :
-(* non si puΓ² dare il principio in modo dipendente (almeno utilizzando tm2)
- la "prova" purtroppo Γ¨ in Type e non si puΓ² garantire che sia esattamente
- quella che ci aspetteremmo
- *)
- βP:pretm β Type[0].
- (βx:πΈ.P (PAR x)) β
- (βv1,v2:TM.P v1 β P v2 β P (APP v1 v2)) β
- βC:list πΈ.
- (βx,s.βv:CTX.x β FV v β x β C β
- (βy.y β FV v β P (vβyβ)) β P (LAM x s (vβxβ))) β
- βu:TM.P u.
-#P #Hpar #Happ #C #Hlam * #u #pu elim (tm_to_tm2 u pu) //
-[ #v1 #v2 #pv1 #pv2 #IH1 #IH2 @(Happ (mk_TM β¦) (mk_TM β¦)) /2/
-| #x #s #v #Hx #pv #IH
- lapply (p_fresh β¦ (C@FV v)) letin x0 β (N_fresh β¦ (C@FV v)) #Hx0
- >(?:lam x s (vβxβ) = lam x0 s (vβx0β))
- [|@tm_alpha // @(not_to_not β¦ Hx0) @in_list_to_in_list_append_r ]
- @(Hlam x0 s (mk_CTX v ?) ??)
- [ <(nominal_eta β¦ Hx) @vclose_tm_up @tm2_to_tm @pv //
- | @(not_to_not β¦ Hx0) @in_list_to_in_list_append_r
- | @(not_to_not β¦ Hx0) @in_list_to_in_list_append_l
- | @IH ]
-]
-qed.
-
-notation
-"hvbox('nominal' u 'return' out 'with'
- [ 'xpar' ident x β f1
- | 'xapp' ident v1 ident v2 ident recv1 ident recv2 β f2
- | 'xlam' β¨ident y # Cβ© ident s ident w ident py1 ident py2 ident recw β f3 ])"
-with precedence 48
-for @{ TM_ind_plus $out (Ξ»${ident x}:?.$f1)
- (Ξ»${ident v1}:?.Ξ»${ident v2}:?.Ξ»${ident recv1}:?.Ξ»${ident recv2}:?.$f2)
- $C (Ξ»${ident y}:?.Ξ»${ident s}:?.Ξ»${ident w}:?.Ξ»${ident py1}:?.Ξ»${ident py2}:?.Ξ»${ident recw}:?.$f3)
- $u }.
-
-(* include "basics/jmeq.ma".*)
-
-definition subst β (Ξ»u:TM.Ξ»x,v.
- nominal u return (Ξ»_.TM) with
- [ xpar x0 β match x == x0 with [ true β v | false β u ]
- | xapp v1 v2 recv1 recv2 β APP recv1 recv2
- | xlam β¨y # x::FV vβ© s w py1 py2 recw β LAM y s (recw y py1) ]).
-
-lemma fasfd : βs,v. pretm_of_TM (subst (LAM O s (PAR 1)) O v) = pretm_of_TM (LAM O s (PAR 1)).
-#s #v normalize in β’ (??%?);
-
-
-theorem tm2_ind_plus :
-(* non si puΓ² dare il principio in modo dipendente (almeno utilizzando tm2) *)
- βP:pretm β Type[0].
- (βx:πΈ.P (par x)) β
- (βv1,v2.tm2 v1 β tm2 v2 β P v1 β P v2 β P (app v1 v2)) β
- βC:list πΈ.
- (βx,s,v.x β FV v β x β C β (βy.y β FV v β tm2 (vβyβ)) β
- (βy.y β FV v β P (vβyβ)) β P (lam x s (vβxβ))) β
- βu.tm2 u β P u.
-#P #Hpar #Happ #C #Hlam #u #pu elim pu /2/
-#x #s #v #px #pv #IH
-lapply (p_fresh β¦ (C@FV v)) letin y β (N_fresh β¦ (C@FV v)) #Hy
->(?:lam x s (vβxβ) = lam y s (vβyβ)) [| @tm_alpha // @(not_to_not β¦ Hy) @in_list_to_in_list_append_r ]
-@Hlam /2/ lapply Hy -Hy @not_to_not #Hy
-[ @in_list_to_in_list_append_r @Hy | @in_list_to_in_list_append_l @Hy ]
-qed.
-
-definition check_tm β
- Ξ»u.pretm_ind_plus ? (Ξ»_.true) (Ξ»_.false)
- (Ξ»v1,v2,r1,r2.r1 β§ r2) [ ] (Ξ»x,s,v,pv1,pv2,rv.rv) u.
-
-(*
-lemma check_tm_complete : βu.tm u β check_tm u = true.
-#u #pu @(tm2_ind_plus β¦ [ ] β¦ (tm_to_tm2 ? pu)) //
-[ #v1 #v2 #pv1 #pv2 #IH1 #IH2
-| #x #s #v #Hx1 #Hx2 #Hv #IH
-*)
-
-notation
-"hvbox('nominal' u 'return' out 'with'
- [ 'xpar' ident x β f1
- | 'xapp' ident v1 ident v2 ident pv1 ident pv2 ident recv1 ident recv2 β f2
- | 'xlam' β¨ident y # Cβ© ident s ident w ident py1 ident py2 ident pw ident recw β f3 ])"
-with precedence 48
-for @{ tm2_ind_plus $out (Ξ»${ident x}:?.$f1)
- (Ξ»${ident v1}:?.Ξ»${ident v2}:?.Ξ»${ident pv1}:?.Ξ»${ident pv2}:?.Ξ»${ident recv1}:?.Ξ»${ident recv2}:?.$f2)
- $C (Ξ»${ident y}:?.Ξ»${ident s}:?.Ξ»${ident w}:?.Ξ»${ident py1}:?.Ξ»${ident py2}:?.Ξ»${ident pw}:?.Ξ»${ident recw}:?.$f3)
- ? (tm_to_tm2 ? $u) }.
-(* notation
-"hvbox('nominal' u 'with'
- [ 'xlam' ident x # C ident s ident w β f3 ])"
-with precedence 48
-for @{ tm2_ind_plus ???
- $C (Ξ»${ident x}:?.Ξ»${ident s}:?.Ξ»${ident w}:?.Ξ»${ident py1}:?.Ξ»${ident py2}:?.
- Ξ»${ident pw}:?.Ξ»${ident recw}:?.$f3) $u (tm_to_tm2 ??) }.
-*)
-
-
-definition subst β (Ξ»u.Ξ»pu:tm u.Ξ»x,v.
- nominal pu return (Ξ»_.pretm) with
- [ xpar x0 β match x == x0 with [ true β v | false β u ]
- | xapp v1 v2 pv1 pv2 recv1 recv2 β app recv1 recv2
- | xlam β¨y # x::FV vβ© s w py1 py2 pw recw β lam y s (recw y py1) ]).
-
-lemma fasfd : βx,s,u,p1,v. subst (lam x s u) p1 x v = lam x s u.
-#x #s #u #p1 #v
-
-
-definition subst β Ξ»u.Ξ»pu:tm u.Ξ»x,y.
- tm2_ind_plus ?
- (* par x0 *) (Ξ»x0.match x == x0 with [ true β v | false β u ])
- (* app v1 v2 *) (Ξ»v1,v2,pv1,pv2,recv1,recv2.app recv1 recv2)
- (* lam y#(x::FV v) s w *) (x::FV v) (Ξ»y,s,w,py1,py2,pw,recw.lam y s (recw y py1))
- u (tm_to_tm2 β¦ pu).
-check subst
-definition subst β Ξ»u.Ξ»pu:tm u.Ξ»x,v.
- nominal u with
- [ xlam y # (x::FV v) s w ^ ? ].
-
-(*
-notation > "Ξ ident x. ident T [ident x] β¦ P"
- with precedence 48 for @{'foo (Ξ»${ident x}.Ξ»${ident T}.$P)}.
-
-notation < "Ξ ident x. ident T [ident x] β¦ P"
- with precedence 48 for @{'foo (Ξ»${ident x}:$Q.Ξ»${ident T}:$R.$P)}.
-*)
-
-(*
-notation
-"hvbox('nominal' u 'with'
- [ 'xpar' ident x β f1
- | 'xapp' ident v1 ident v2 β f2
- | 'xlam' ident x # C s w β f3 ])"
-with precedence 48
-for @{ tm2_ind_plus ? (Ξ»${ident x}:$Tx.$f1)
- (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
- $C (Ξ»${ident x}:$Tx.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
-*)
-
-(*
-notation
-"hvbox('nominal' u 'with'
- [ 'xpar' ident x ^ f1
- | 'xapp' ident v1 ident v2 ^ f2 ])"
-(* | 'xlam' ident x # C s w ^ f3 ]) *)
-with precedence 48
-for @{ tm2_ind_plus ? (Ξ»${ident x}:$Tx.$f1)
- (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
- $C (Ξ»${ident x}:$Tx.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
-*)
-notation
-"hvbox('nominal' u 'with'
- [ 'xpar' ident x ^ f1
- | 'xapp' ident v1 ident v2 ^ f2 ])"
-with precedence 48
-for @{ tm2_ind_plus ? (Ξ»${ident x}:?.$f1)
- (Ξ»${ident v1}:$Tv1.Ξ»${ident v2}:$Tv2.Ξ»${ident pv1}:$Tpv1.Ξ»${ident pv2}:$Tpv2.Ξ»${ident recv1}:$Trv1.Ξ»${ident recv2}:$Trv2.$f2)
- $C (Ξ»${ident x}:?.Ξ»${ident s}:$Ts.Ξ»${ident w}:$Tw.Ξ»${ident py1}:$Tpy1.Ξ»${ident py2}:$Tpy2.Ξ»${ident pw}:$Tpw.Ξ»${ident recw}:$Trw.$f3) $u (tm_to_tm2 ??) }.
-
-
-definition subst β Ξ»u.Ξ»pu:tm u.Ξ»x,v.
- nominal u with
- [ xpar x0 ^ match x == x0 with [ true β v | false β u ]
- | xapp v1 v2 ^ ? ].
- | xlam y # (x::FV v) s w ^ ? ].
-
-
- (* par x0 *) (Ξ»x0.match x == x0 with [ true β v | false β u ])
- (* app v1 v2 *) (Ξ»v1,v2,pv1,pv2,recv1,recv2.app recv1 recv2)
- (* lam y#(x::FV v) s w *) (x::FV v) (Ξ»y,s,w,py1,py2,pw,recw.lam y s (recw y py1))
- u (tm_to_tm2 β¦ pu).
-
-
-*)
-definition subst β Ξ»u.Ξ»pu:tm u.Ξ»x,v.
- tm2_ind_plus ?
- (* par x0 *) (Ξ»x0.match x == x0 with [ true β v | false β u ])
- (* app v1 v2 *) (Ξ»v1,v2,pv1,pv2,recv1,recv2.app recv1 recv2)
- (* lam y#(x::FV v) s w *) (x::FV v) (Ξ»y,s,w,py1,py2,pw,recw.lam y s (recw y py1))
- u (tm_to_tm2 β¦ pu).
-
-check subst
-
-
-axiom in_Env : πΈ Γ tp β Env β Prop.
-notation "X β G" non associative with precedence 45 for @{'lefttriangle $X $G}.
-interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
-
-
-
-inductive judg : list tp β tm β tp β Prop β
-| t_var : βg,n,t.Nth ? n g = Some ? t β judg g (var n) t
-| t_app : βg,m,n,t,u.judg g m (arr t u) β judg g n t β judg g (app m n) u
-| t_abs : βg,t,m,u.judg (t::g) m u β judg g (abs t m) (arr t u).
-
-definition Env := list (πΈ Γ tp).
-
-axiom vclose_env : Env β list tp.
-axiom vclose_tm : Env β tm β tm.
-axiom Lam : πΈ β tp β tm β tm.
-definition Judg β Ξ»G,M,T.judg (vclose_env G) (vclose_tm G M) T.
-definition dom β Ξ»G:Env.map ?? (fst ??) G.
-
-definition sctx β πΈ Γ tm.
-axiom swap_tm : πΈ β πΈ β tm β tm.
-definition sctx_app : sctx β πΈ β tm β Ξ»M0,Y.let β©X,Mβͺ β M0 in swap_tm X Y M.
-
-axiom in_list : βA:Type[0].A β list A β Prop.
-interpretation "list membership" 'mem x l = (in_list ? x l).
-interpretation "list non-membership" 'notmem x l = (Not (in_list ? x l)).
-
-axiom in_Env : πΈ Γ tp β Env β Prop.
-notation "X β G" non associative with precedence 45 for @{'lefttriangle $X $G}.
-interpretation "Env membership" 'lefttriangle x l = (in_Env x l).
-
-let rec FV M β match M with
- [ par X β [X]
- | app M1 M2 β FV M1@FV M2
- | abs T M0 β FV M0
- | _ β [ ] ].
-
-(* axiom Lookup : πΈ β Env β option tp. *)
-
-(* forma alto livello del judgment
- t_abs* : βG,T,X,M,U.
- (βY β supp(M).Judg (β©Y,Tβͺ::G) (M[Y]) U) β
- Judg G (Lam X T (M[X])) (arr T U) *)
-
-(* prima dimostrare, poi perfezionare gli assiomi, poi dimostrarli *)
-
-axiom Judg_ind : βP:Env β tm β tp β Prop.
- (βX,G,T.β©X,Tβͺ β G β P G (par X) T) β
- (βG,M,N,T,U.
- Judg G M (arr T U) β Judg G N T β
- P G M (arr T U) β P G N T β P G (app M N) U) β
- (βG,T1,T2,X,M1.
- (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β Judg (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
- (βY.Y β (FV (Lam X T1 (sctx_app M1 X))) β P (β©Y,T1βͺ::G) (sctx_app M1 Y) T2) β
- P G (Lam X T1 (sctx_app M1 X)) (arr T1 T2)) β
- βG,M,T.Judg G M T β P G M T.
-
-axiom t_par : βX,G,T.β©X,Tβͺ β G β Judg G (par X) T.
-axiom t_app2 : βG,M,N,T,U.Judg G M (arr T U) β Judg G N T β Judg G (app M N) U.
-axiom t_Lam : βG,X,M,T,U.Judg (β©X,Tβͺ::G) M U β Judg G (Lam X T M) (arr T U).
-
-definition subenv β Ξ»G1,G2.βx.x β G1 β x β G2.
-interpretation "subenv" 'subseteq G1 G2 = (subenv G1 G2).
-
-axiom daemon : βP:Prop.P.
-
-theorem weakening : βG1,G2,M,T.G1 β G2 β Judg G1 M T β Judg G2 M T.
-#G1 #G2 #M #T #Hsub #HJ lapply Hsub lapply G2 -G2 change with (βG2.?)
-@(Judg_ind β¦ HJ)
-[ #X #G #T0 #Hin #G2 #Hsub @t_par @Hsub //
-| #G #M0 #N #T0 #U #HM0 #HN #IH1 #IH2 #G2 #Hsub @t_app2
- [| @IH1 // | @IH2 // ]
-| #G #T1 #T2 #X #M1 #HM1 #IH #G2 #Hsub @t_Lam @IH
- [ (* trivial property of Lam *) @daemon
- | (* trivial property of subenv *) @daemon ]
-]
-qed.
-
-(* Serve un tipo Tm per i termini localmente chiusi e i suoi principi di induzione e
- ricorsione *)
\ No newline at end of file
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.cs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "basics/logic.ma".
-include "basics/lists/in.ma".
-include "basics/types.ma".
-
-(*interpretation "list membership" 'mem x l = (in_list ? x l).*)
-
-record Nset : Type[1] β
-{
- (* carrier is specified as a coercion: when an object X of type Nset is
- given, but something of type Type is expected, Matita will insert a
- hidden coercion: the user sees "X", but really means "carrier X" *)
- carrier :> DeqSet;
- N_fresh : list carrier β carrier;
- p_fresh : βl.N_fresh l β l
-}.
-
-definition maxlist β
- Ξ»l.foldr ?? (Ξ»x,acc.max x acc) 0 l.
-
-definition natfresh β Ξ»l.S (maxlist l).
-
-lemma le_max_1 : βx,y.x β€ max x y. /2/
-qed.
-
-lemma le_max_2 : βx,y.y β€ max x y. /2/
-qed.
-
-lemma le_maxlist : βl,x.x β l β x β€ maxlist l.
-#l elim l
-[#x #Hx @False_ind cases (not_in_list_nil ? x) #H1 /2/
-|#y #tl #IH #x #H1 change with (max ??) in β’ (??%);
- cases (in_list_cons_case ???? H1);#H2;
- [ >H2 @le_max_1
- | whd in β’ (??%); lapply (refl ? (leb y (maxlist tl)));
- cases (leb y (maxlist tl)) in β’ (???% β %);#H3
- [ @IH //
- | lapply (IH ? H2) #H4
- lapply (leb_false_to_not_le β¦ H3) #H5
- lapply (not_le_to_lt β¦ H5) #H6
- @(transitive_le β¦ H4)
- @(transitive_le β¦ H6) %2 %
- ]
- ]
-]
-qed.
-
-(* prove freshness for nat *)
-lemma lt_l_natfresh_l : βl,x.x β l β x < natfresh l.
-#l #x #H1 @le_S_S /2/
-qed.
-
-(*naxiom p_Xfresh : βl.βx:Xcarr.x β l β x β ntm (Xfresh l) β§ x β ntp (Xfresh l).*)
-lemma p_natfresh : βl.natfresh l β l.
-#l % #H1 lapply (lt_l_natfresh_l β¦ H1) #H2
-cases (lt_to_not_eq β¦ H2) #H3 @H3 %
-qed.
-
-include "basics/finset.ma".
-
-definition X : Nset β mk_Nset DeqNat β¦.
-[ @natfresh
-| @p_natfresh
-]
-qed.
\ No newline at end of file
+++ /dev/null
-(*
- ||M|| This file is part of HELM, an Hypertextual, Electronic
- ||A|| Library of Mathematics, developed at the Computer Science
- ||T|| Department of the University of Bologna, Italy.
- ||I||
- ||T||
- ||A|| This file is distributed under the terms of the
- \ / GNU General Public License Version 2
- \ /
- V_______________________________________________________________ *)
-
-include "finite_lambda/reduction.ma".
-
-
-axiom canonical_to_T: βO,D.βM:T O D.βty.(* type_of M ty β *)
- βa:FinSet_of_FType O D ty. star ? (red O D) M (to_T O D ty a).
-
-axiom normal_to_T: βO,D,M,ty,a. red O D (to_T O D ty a) M β False.
-
-axiom red_closed: βO,D,M,M1.
- is_closed O D 0 M β red O D M M1 β is_closed O D 0 M1.
-
-lemma critical: βO,D,ty,M,N.
- βM3:T O D
- .star (T O D) (red O D) (subst O D M 0 N) M3
- β§star (T O D) (red O D)
- (App O D
- (Vec O D ty
- (map (FinSet_of_FType O D ty) (T O D)
- (Ξ»a0:FinSet_of_FType O D ty.subst O D M 0 (to_T O D ty a0))
- (enum (FinSet_of_FType O D ty)))) N) M3.
-#O #D #ty #M #N
-lapply (canonical_to_T O D N ty) * #a #Ha
-%{(subst O D M 0 (to_T O D ty a))} (* CR-term *)
-%[@red_star_subst @Ha
- |@trans_star [|@(star_red_appr β¦ Ha)] @R_to_star @riota
- lapply (enum_complete (FinSet_of_FType O D ty) a)
- elim (enum (FinSet_of_FType O D ty))
- [normalize #H1 destruct (H1)
- |#hd #tl #Hind #H cases (orb_true_l β¦ H) -H #Hcase
- [normalize >Hcase >(\P Hcase) //
- |normalize cases (true_or_false (a==hd)) #Hcase1
- [normalize >Hcase1 >(\P Hcase1) // |>Hcase1 @Hind @Hcase]
- ]
- ]
- ]
-qed.
-
-lemma critical2: βO,D,ty,a,M,M1,M2,v.
- red O D (Vec O D ty v) M β
- red O D (App O D (Vec O D ty v) (to_T O D ty a)) M1 β
- assoc (FinSet_of_FType O D ty) (T O D) a (enum (FinSet_of_FType O D ty)) v
- =Some (T O D) M2 β
- βM3:T O D
- .star (T O D) (red O D) M2 M3
- β§star (T O D) (red O D) (App O D M (to_T O D ty a)) M3.
-#O #D #ty #a #M #M1 #M2 #v #redM #redM1 #Ha lapply (red_vec β¦ redM) -redM
-* #N * #N1 * #v1 * #v2 * * #Hred1 #Hv #HM0 >HM0 -HM0 >Hv in Ha; #Ha
-cases (same_assoc β¦ a (enum (FinSet_of_FType O D ty)) v1 v2 N N1)
- [* >Ha -Ha #H1 destruct (H1) #Ha
- %{N1} (* CR-term *) % [@R_to_star //|@R_to_star @(riota β¦ Ha)]
- |#Ha1 %{M2} (* CR-term *) % [// | @R_to_star @riota <Ha1 @Ha]
- ]
-qed.
-
-
-lemma critical3: βO,D,ty,M1,M2. red O D M1 M2 β
- βM3:T O D.star (T O D) (red O D) (Lambda O D ty M2) M3
- β§star (T O D) (red O D)
- (Vec O D ty
- (map (FinSet_of_FType O D ty) (T O D)
- (Ξ»a:FinSet_of_FType O D ty.subst O D M1 0 (to_T O D ty a))
- (enum (FinSet_of_FType O D ty)))) M3.
-#O #D #ty #M1 #M2 #Hred
- %{(Vec O D ty
- (map (FinSet_of_FType O D ty) (T O D)
- (Ξ»a:FinSet_of_FType O D ty.subst O D M2 0 (to_T O D ty a))
- (enum (FinSet_of_FType O D ty))))} (* CR-term *) %
- [@R_to_star @rmem
- |@star_red_vec2 [>length_map >length_map //] #n #M0
- cases (true_or_false (leb (|enum (FinSet_of_FType O D ty)|) n)) #Hcase
- [>nth_to_default [2:>length_map @(leb_true_to_le β¦ Hcase)]
- >nth_to_default [2:>length_map @(leb_true_to_le β¦ Hcase)] //
- |cut (n < |enum (FinSet_of_FType O D ty)|)
- [@not_le_to_lt @leb_false_to_not_le @Hcase] #Hlt
- cut (βa:FinSet_of_FType O D ty.True)
- [lapply Hlt lapply (enum_complete (FinSet_of_FType O D ty))
- cases (enum (FinSet_of_FType O D ty))
- [#_ normalize #H @False_ind @(absurd β¦ H) @lt_to_not_le //
- |#a #l #_ #_ %{a} //
- ]
- ] * #a #_
- >(nth_map ?????? a Hlt) >(nth_map ?????? a Hlt) #_
- @red_star_subst2 //
- ]
- ]
-qed.
-
-(* we need to proceed by structural induction on the term and then
-by inversion on the two redexes. The problem are the moves in a
-same subterm, since we need an induction hypothesis, there *)
-
-lemma local_confluence: βO,D,M,M1,M2. red O D M M1 β red O D M M2 β
-βM3. star ? (red O D) M1 M3 β§ star ? (red O D) M2 M3.
-#O #D #M @(T_elim β¦ M)
- [#o #a #M1 #M2 #H elim(red_val ????? H)
- |#n #M1 #M2 #H elim(red_rel ???? H)
- |(* app : this is the interesting case *)
- #P #Q #HindP #HindQ
- #M1 #M2 #H1 inversion H1 -H1
- [(* right redex is beta *)
- #ty #Q #N #Hc #HM >HM -HM #HM1 >HM1 - HM1 #Hl inversion Hl
- [#ty1 #Q1 #N1 #Hc1 #H1 destruct (H1) #H_
- %{(subst O D Q1 0 N1)} (* CR-term *) /2/
- |#ty #v #a #M0 #_ #H1 destruct (H1) (* vacuous *)
- |#M0 #M10 #N0 #redM0 #_ #H1 destruct (H1) #_ cases (red_lambda β¦ redM0)
- [* #Q1 * #redQ #HM10 >HM10
- %{(subst O D Q1 0 N0)} (* CR-term *) %
- [@red_star_subst2 //|@R_to_star @rbeta @Hc]
- |#HM1 >HM1 @critical
- ]
- |#M0 #N0 #N1 #redN0N1 #_ #H1 destruct (H1) #HM2
- %{(subst O D Q 0 N1)} (* CR-term *)
- %[@red_star_subst @R_to_star //|@R_to_star @rbeta @(red_closed β¦ Hc) //]
- |#ty1 #N0 #N1 #_ #_ #H1 destruct (H1) (* vacuous *)
- |#ty1 #M0 #H1 destruct (H1) (* vacuous *)
- |#ty1 #N0 #N1 #v #v1 #_ #_ #H1 destruct (H1) (* vacuous *)
- ]
- |(* right redex is iota *)#ty #v #a #M3 #Ha #_ #_ #Hl inversion Hl
- [#P1 #M1 #N1 #_ #H1 destruct (H1) (* vacuous *)
- |#ty1 #v1 #a1 #M4 #Ha1 #H1 destruct (H1) -H1 #HM4 >(inj_to_T β¦ e0) in Ha;
- >Ha1 #H1 destruct (H1) %{M3} (* CR-term *) /2/
- |#M0 #M10 #N0 #redM0 #_ #H1 destruct (H1) #HM2 @(critical2 β¦ redM0 Hl Ha)
- |#M0 #N0 #N1 #redN0N1 #_ #H1 destruct (H1) elim (normal_to_T β¦ redN0N1)
- |#ty1 #N0 #N1 #_ #_ #H1 destruct (H1) (* vacuous *)
- |#ty1 #M0 #H1 destruct (H1) (* vacuous *)
- |#ty1 #N0 #N1 #v #v1 #_ #_ #H1 destruct (H1) (* vacuous *)
- ]
- |(* right redex is appl *)#M3 #M4 #N #redM3M4 #_ #H1 destruct (H1) #_
- #Hl inversion Hl
- [#ty1 #M1 #N1 #Hc #H1 destruct (H1) #HM2 lapply (red_lambda β¦ redM3M4) *
- [* #M3 * #H1 #H2 >H2 %{(subst O D M3 0 N1)} %
- [@R_to_star @rbeta @Hc|@red_star_subst2 // ]
- |#H >H -H lapply (critical O D ty1 M1 N1) * #M3 * #H1 #H2
- %{M3} /2/
- ]
- |#ty1 #v1 #a1 #M4 #Ha1 #H1 #H2 destruct
- lapply (critical2 β¦ redM3M4 Hl Ha1) * #M3 * #H1 #H2 %{M3} /2/
- |#M0 #M10 #N0 #redM0 #_ #H1 destruct (H1) #HM2
- lapply (HindP β¦ redM0 redM3M4) * #M3 * #H1 #H2
- %{(App O D M3 N0)} (* CR-term *) % [@star_red_appl //|@star_red_appl //]
- |#M0 #N0 #N1 #redN0N1 #_ #H1 destruct (H1) #_
- %{(App O D M4 N1)} % @R_to_star [@rappr //|@rappl //]
- |#ty1 #N0 #N1 #_ #_ #H1 destruct (H1) (* vacuous *)
- |#ty1 #M0 #H1 destruct (H1) (* vacuous *)
- |#ty1 #N0 #N1 #v #v1 #_ #_ #H1 destruct (H1) (* vacuous *)
- ]
- |(* right redex is appr *)#M3 #N #N1 #redN #_ #H1 destruct (H1) #_
- #Hl inversion Hl
- [#ty1 #M0 #N0 #Hc #H1 destruct (H1) #HM2
- %{(subst O D M0 0 N1)} (* CR-term *) %
- [@R_to_star @rbeta @(red_closed β¦ Hc) //|@red_star_subst @R_to_star // ]
- |#ty1 #v1 #a1 #M4 #Ha1 #H1 #H2 destruct (H1) elim (normal_to_T β¦ redN)
- |#M0 #M10 #N0 #redM0 #_ #H1 destruct (H1) #HM2
- %{(App O D M10 N1)} (* CR-term *) % @R_to_star [@rappl //|@rappr //]
- |#M0 #N0 #N10 #redN0 #_ #H1 destruct (H1) #_
- lapply (HindQ β¦ redN0 redN) * #M3 * #H1 #H2
- %{(App O D M0 M3)} (* CR-term *) % [@star_red_appr //|@star_red_appr //]
- |#ty1 #N0 #N1 #_ #_ #H1 destruct (H1) (* vacuous *)
- |#ty1 #M0 #H1 destruct (H1) (* vacuous *)
- |#ty1 #N0 #N1 #v #v1 #_ #_ #H1 destruct (H1) (* vacuous *)
- ]
- |(* right redex is rlam *) #ty #N0 #N1 #_ #_ #H1 destruct (H1) (* vacuous *)
- |(* right redex is rmem *) #ty #M0 #H1 destruct (H1) (* vacuous *)
- |(* right redex is vec *) #ty #N #N1 #v #v1 #_ #_
- #H1 destruct (H1) (* vacuous *)
- ]
- |#ty #M1 #Hind #M2 #M3 #H1 #H2 (* this case is not trivial any more *)
- lapply (red_lambda β¦ H1) *
- [* #M4 * #H3 #H4 >H4 lapply (red_lambda β¦ H2) *
- [* #M5 * #H5 #H6 >H6 lapply(Hind β¦ H3 H5) * #M6 * #H7 #H8
- %{(Lambda O D ty M6)} (* CR-term *) % @star_red_lambda //
- |#H5 >H5 @critical3 //
- ]
- |#HM2 >HM2 lapply (red_lambda β¦ H2) *
- [* #M4 * #Hred #HM3 >HM3 lapply (critical3 β¦ ty ?? Hred) * #M5
- * #H3 #H4 %{M5} (* CR-term *) % //
- |#HM3 >HM3 %{M3} (* CR-term *) % //
- ]
- ]
- |#ty #v1 #Hind #M1 #M2 #H1 #H2
- lapply (red_vec β¦ H1) * #N11 * #N12 * #v11 * #v12 * * #redN11 #Hv1 #HM1
- lapply (red_vec β¦ H2) * #N21* #N22 * #v21 * #v22 * * #redN21 #Hv2 #HM2
- >Hv1 in Hv2; #Hvv lapply (compare_append β¦ Hvv) -Hvv *
- (* we must proceed by cases on the list *) * normalize
- [(* N11 = N21 *) *
- [>append_nil * #Hl1 #Hl2 destruct lapply(Hind N11 β¦ redN11 redN21)
- [@mem_append_l2 %1 //]
- * #M3 * #HM31 #HM32
- %{(Vec O D ty (v21@M3::v12))} (* CR-term *)
- % [@star_red_vec //|@star_red_vec //]
- |>append_nil * #Hl1 #Hl2 destruct lapply(Hind N21 β¦ redN21 redN11)
- [@mem_append_l2 %1 //]
- * #M3 * #HM31 #HM32
- %{(Vec O D ty (v11@M3::v22))} (* CR-term *)
- % [@star_red_vec //|@star_red_vec //]
- ]
- |(* N11 β N21 *) -Hind #P #l *
- [* #Hv11 #Hv22 destruct
- %{((Vec O D ty ((v21@N22::l)@N12::v12)))} (* CR-term *) % @R_to_star
- [>associative_append >associative_append normalize @rvec //
- |>append_cons <associative_append <append_cons in β’ (???%?); @rvec //
- ]
- |* #Hv11 #Hv22 destruct
- %{((Vec O D ty ((v11@N12::l)@N22::v22)))} (* CR-term *) % @R_to_star
- [>append_cons <associative_append <append_cons in β’ (???%?); @rvec //
- |>associative_append >associative_append normalize @rvec //
- ]
- ]
- ]
- ]
-qed.
-
-
-
-
+++ /dev/null
-(*
- ||M|| This file is part of HELM, an Hypertextual, Electronic
- ||A|| Library of Mathematics, developed at the Computer Science
- ||T|| Department of the University of Bologna, Italy.
- ||I||
- ||T||
- ||A|| This file is distributed under the terms of the
- \ / GNU General Public License Version 2
- \ /
- V_______________________________________________________________ *)
-
-include "finite_lambda/terms_and_types.ma".
-
-(* some auxiliary lemmas *)
-
-lemma nth_to_default: βA,l,n,d.
- |l| β€ n β nth n A l d = d.
-#A #l elim l [//] #a #tl #Hind #n cases n
- [#d normalize #H @False_ind @(absurd β¦ H) @lt_to_not_le //
- |#m #d normalize #H @Hind @le_S_S_to_le @H
- ]
-qed.
-
-lemma mem_nth: βA,l,n,d.
- n < |l| β mem ? (nth n A l d) l.
-#A #l elim l
- [#n #d normalize #H @False_ind @(absurd β¦ H) @lt_to_not_le //
- |#a #tl #Hind * normalize
- [#_ #_ %1 //| #m #d #HSS %2 @Hind @le_S_S_to_le @HSS]
- ]
-qed.
-
-lemma nth_map: βA,B,l,f,n,d1,d2.
- n < |l| β nth n B (map β¦ f l) d1 = f (nth n A l d2).
-#n #B #l #f elim l
- [#m #d1 #d2 normalize #H @False_ind @(absurd β¦ H) @lt_to_not_le //
- |#a #tl #Hind #m #d1 #d2 cases m normalize //
- #m1 #H @Hind @le_S_S_to_le @H
- ]
-qed.
-
-
-
-(* end of auxiliary lemmas *)
-
-let rec to_T O D ty on ty: FinSet_of_FType O D ty β T O D β
- match ty return (Ξ»ty.FinSet_of_FType O D ty β T O D) with
- [atom o β Ξ»a.Val O D o a
- |arrow ty1 ty2 β Ξ»a:FinFun ??.Vec O D ty1
- (map ((FinSet_of_FType O D ty1)Γ(FinSet_of_FType O D ty2))
- (T O D) (Ξ»p.to_T O D ty2 (snd β¦ p)) (pi1 β¦ a))
- ]
-.
-
-lemma is_closed_to_T: βO,D,ty,a. is_closed O D 0 (to_T O D ty a).
-#O #D #ty elim ty //
-#ty1 #ty2 #Hind1 #Hind2 #a normalize @cvec #m #Hmem
-lapply (mem_map ????? Hmem) * #a1 * #H1 #H2 <H2 @Hind2
-qed.
-
-axiom inj_to_T: βO,D,ty,a1,a2. to_T O D ty a1 = to_T O D ty a2 β a1 = a2.
-(* complicata
-#O #D #ty elim ty
- [#o normalize #a1 #a2 #H destruct //
- |#ty1 #ty2 #Hind1 #Hind2 * #l1 #Hl1 * #l2 #Hl2 normalize #H destruct -H
- cut (l1=l2) [2: #H generalize in match Hl1; >H //] -Hl1 -Hl2
- lapply e0 -e0 lapply l2 -l2 elim l1
- [#l2 cases l2 normalize [// |#a1 #tl1 #H destruct]
- |#a1 #tl1 #Hind #l2 cases l2
- [normalize #H destruct
- |#a2 #tl2 normalize #H @eq_f2
- [@Hind2 *)
-
-let rec assoc (A:FinSet) (B:Type[0]) (a:A) l1 l2 on l1 : option B β
- match l1 with
- [ nil β None ?
- | cons hd1 tl1 β match l2 with
- [ nil β None ?
- | cons hd2 tl2 β if a==hd1 then Some ? hd2 else assoc A B a tl1 tl2
- ]
- ].
-
-lemma same_assoc: βA,B,a,l1,v1,v2,N,N1.
- assoc A B a l1 (v1@N::v2) = Some ? N β§ assoc A B a l1 (v1@N1::v2) = Some ? N1
- β¨ assoc A B a l1 (v1@N::v2) = assoc A B a l1 (v1@N1::v2).
-#A #B #a #l1 #v1 #v2 #N #N1 lapply v1 -v1 elim l1
- [#v1 %2 // |#hd #tl #Hind * normalize cases (a==hd) normalize /3/]
-qed.
-
-lemma assoc_to_mem: βA,B,a,l1,l2,b.
- assoc A B a l1 l2 = Some ? b β mem ? b l2.
-#A #B #a #l1 elim l1
- [#l2 #b normalize #H destruct
- |#hd1 #tl1 #Hind *
- [#b normalize #H destruct
- |#hd2 #tl2 #b normalize cases (a==hd1) normalize
- [#H %1 destruct //|#H %2 @Hind @H]
- ]
- ]
-qed.
-
-lemma assoc_to_mem2: βA,B,a,l1,l2,b.
- assoc A B a l1 l2 = Some ? b β βl21,l22.l2=l21@b::l22.
-#A #B #a #l1 elim l1
- [#l2 #b normalize #H destruct
- |#hd1 #tl1 #Hind *
- [#b normalize #H destruct
- |#hd2 #tl2 #b normalize cases (a==hd1) normalize
- [#H %{[]} %{tl2} destruct //
- |#H lapply (Hind β¦ H) * #la * #lb #H1
- %{(hd2::la)} %{lb} >H1 //]
- ]
- ]
-qed.
-
-lemma assoc_map: βA,B,C,a,l1,l2,f,b.
- assoc A B a l1 l2 = Some ? b β assoc A C a l1 (map ?? f l2) = Some ? (f b).
-#A #B #C #a #l1 elim l1
- [#l2 #f #b normalize #H destruct
- |#hd1 #tl1 #Hind *
- [#f #b normalize #H destruct
- |#hd2 #tl2 #f #b normalize cases (a==hd1) normalize
- [#H destruct // |#H @(Hind β¦ H)]
- ]
- ]
-qed.
-
-(*************************** One step reduction *******************************)
-
-inductive red (O:Type[0]) (D:OβFinSet) : T O D βT O D β Prop β
- | (* we only allow beta on closed arguments *)
- rbeta: βP,M,N. is_closed O D 0 N β
- red O D (App O D (Lambda O D P M) N) (subst O D M 0 N)
- | riota: βty,v,a,M.
- assoc ?? a (enum (FinSet_of_FType O D ty)) v = Some ? M β
- red O D (App O D (Vec O D ty v) (to_T O D ty a)) M
- | rappl: βM,M1,N. red O D M M1 β red O D (App O D M N) (App O D M1 N)
- | rappr: βM,N,N1. red O D N N1 β red O D (App O D M N) (App O D M N1)
- | rlam: βty,N,N1. red O D N N1 β red O D (Lambda O D ty N) (Lambda O D ty N1)
- | rmem: βty,M. red O D (Lambda O D ty M)
- (Vec O D ty (map ?? (Ξ»a. subst O D M 0 (to_T O D ty a))
- (enum (FinSet_of_FType O D ty))))
- | rvec: βty,N,N1,v,v1. red O D N N1 β
- red O D (Vec O D ty (v@N::v1)) (Vec O D ty (v@N1::v1)).
-
-(*********************************** inversion ********************************)
-lemma red_vec: βO,D,ty,v,M.
- red O D (Vec O D ty v) M β βN,N1,v1,v2.
- red O D N N1 β§ v = v1@N::v2 β§ M = Vec O D ty (v1@N1::v2).
-#O #D #ty #v #M #Hred inversion Hred
- [#ty1 #M0 #N #Hc #H destruct
- |#ty1 #v1 #a #M0 #_ #H destruct
- |#M0 #M1 #N #_ #_ #H destruct
- |#M0 #M1 #N #_ #_ #H destruct
- |#ty1 #M #M1 #_ #_ #H destruct
- |#ty1 #M0 #H destruct
- |#ty1 #N #N1 #v1 #v2 #Hred1 #_ #H destruct #_ %{N} %{N1} %{v1} %{v2} /3/
- ]
-qed.
-
-lemma red_lambda: βO,D,ty,M,N.
- red O D (Lambda O D ty M) N β
- (βM1. red O D M M1 β§ N = (Lambda O D ty M1)) β¨
- N = Vec O D ty (map ?? (Ξ»a. subst O D M 0 (to_T O D ty a))
- (enum (FinSet_of_FType O D ty))).
-#O #D #ty #M #N #Hred inversion Hred
- [#ty1 #M0 #N #Hc #H destruct
- |#ty1 #v1 #a #M0 #_ #H destruct
- |#M0 #M1 #N #_ #_ #H destruct
- |#M0 #M1 #N #_ #_ #H destruct
- |#ty1 #P #P1 #redP #_ #H #H1 destruct %1 %{P1} % //
- |#ty1 #M0 #H destruct #_ %2 //
- |#ty1 #N #N1 #v1 #v2 #Hred1 #_ #H destruct
- ]
-qed.
-
-lemma red_val: βO,D,ty,a,N.
- red O D (Val O D ty a) N β False.
-#O #D #ty #M #N #Hred inversion Hred
- [#ty1 #M0 #N #Hc #H destruct
- |#ty1 #v1 #a #M0 #_ #H destruct
- |#M0 #M1 #N #_ #_ #H destruct
- |#M0 #M1 #N #_ #_ #H destruct
- |#ty1 #N1 #N2 #_ #_ #H destruct
- |#ty1 #M0 #H destruct #_
- |#ty1 #N #N1 #v1 #v2 #Hred1 #_ #H destruct
- ]
-qed.
-
-lemma red_rel: βO,D,n,N.
- red O D (Rel O D n) N β False.
-#O #D #n #N #Hred inversion Hred
- [#ty1 #M0 #N #Hc #H destruct
- |#ty1 #v1 #a #M0 #_ #H destruct
- |#M0 #M1 #N #_ #_ #H destruct
- |#M0 #M1 #N #_ #_ #H destruct
- |#ty1 #N1 #N2 #_ #_ #H destruct
- |#ty1 #M0 #H destruct #_
- |#ty1 #N #N1 #v1 #v2 #Hred1 #_ #H destruct
- ]
-qed.
-
-(*************************** multi step reduction *****************************)
-lemma star_red_appl: βO,D,M,M1,N. star ? (red O D) M M1 β
- star ? (red O D) (App O D M N) (App O D M1 N).
-#O #D #M #N #N1 #H elim H //
-#P #Q #Hind #HPQ #Happ %1[|@Happ] @rappl @HPQ
-qed.
-
-lemma star_red_appr: βO,D,M,N,N1. star ? (red O D) N N1 β
- star ? (red O D) (App O D M N) (App O D M N1).
-#O #D #M #N #N1 #H elim H //
-#P #Q #Hind #HPQ #Happ %1[|@Happ] @rappr @HPQ
-qed.
-
-lemma star_red_vec: βO,D,ty,N,N1,v1,v2. star ? (red O D) N N1 β
- star ? (red O D) (Vec O D ty (v1@N::v2)) (Vec O D ty (v1@N1::v2)).
-#O #D #ty #N #N1 #v1 #v2 #H elim H //
-#P #Q #Hind #HPQ #Hvec %1[|@Hvec] @rvec @HPQ
-qed.
-
-lemma star_red_vec1: βO,D,ty,v1,v2,v. |v1| = |v2| β
- (βn,M. n < |v1| β star ? (red O D) (nth n ? v1 M) (nth n ? v2 M)) β
- star ? (red O D) (Vec O D ty (v@v1)) (Vec O D ty (v@v2)).
-#O #D #ty #v1 elim v1
- [#v2 #v normalize #Hv2 >(lenght_to_nil β¦ (sym_eq β¦ Hv2)) normalize //
- |#N1 #tl1 #Hind * [normalize #v #H destruct] #N2 #tl2 #v normalize #HS
- #H @(trans_star β¦ (Vec O D ty (v@N2::tl1)))
- [@star_red_vec @(H 0 N1) @le_S_S //
- |>append_cons >(append_cons ??? tl2) @(Hind⦠(injective_S ⦠HS))
- #n #M #H1 @(H (S n)) @le_S_S @H1
- ]
- ]
-qed.
-
-lemma star_red_vec2: βO,D,ty,v1,v2. |v1| = |v2| β
- (βn,M. n < |v1| β star ? (red O D) (nth n ? v1 M) (nth n ? v2 M)) β
- star ? (red O D) (Vec O D ty v1) (Vec O D ty v2).
-#O #D #ty #v1 #v2 @(star_red_vec1 β¦ [ ])
-qed.
-
-lemma star_red_lambda: βO,D,ty,N,N1. star ? (red O D) N N1 β
- star ? (red O D) (Lambda O D ty N) (Lambda O D ty N1).
-#O #D #ty #N #N1 #H elim H //
-#P #Q #Hind #HPQ #Hlam %1[|@Hlam] @rlam @HPQ
-qed.
-
-(************************ reduction and substitution **************************)
-
-lemma red_star_subst : βO,D,M,N,N1,i.
- star ? (red O D) N N1 β star ? (red O D) (subst O D M i N) (subst O D M i N1).
-#O #D #M #N #N1 #i #Hred lapply i -i @(T_elim β¦ M) normalize
- [#o #a #i //
- |#i #n cases (leb n i) normalize // cases (eqb n i) normalize //
- |#P #Q #HindP #HindQ #n normalize
- @(trans_star β¦ (App O D (subst O D P n N1) (subst O D Q n N)))
- [@star_red_appl @HindP |@star_red_appr @HindQ]
- |#ty #P #HindP #i @star_red_lambda @HindP
- |#ty #v #Hindv #i @star_red_vec2 [>length_map >length_map //]
- #j #Q inversion v [#_ normalize //] #a #tl #_ #Hv
- cases (true_or_false (leb (S j) (|a::tl|))) #Hcase
- [lapply (leb_true_to_le β¦ Hcase) -Hcase #Hcase
- >(nth_map ?????? a Hcase) >(nth_map ?????? a Hcase) #_ @Hindv >Hv @mem_nth //
- |>nth_to_default
- [2:>length_map @le_S_S_to_le @not_le_to_lt @leb_false_to_not_le //]
- >nth_to_default
- [2:>length_map @le_S_S_to_le @not_le_to_lt @leb_false_to_not_le //] //
- ]
- ]
-qed.
-
-lemma red_star_subst2 : βO,D,M,M1,N,i. is_closed O D 0 N β
- red O D M M1 β star ? (red O D) (subst O D M i N) (subst O D M1 i N).
-#O #D #M #M1 #N #i #HNc #Hred lapply i -i elim Hred
- [#ty #P #Q #HQc #i normalize @starl_to_star @sstepl
- [|@rbeta >(subst_closed β¦ HQc) //] >(subst_closed β¦ HQc) //
- lapply (subst_lemma ?? P ?? i 0 (is_closed_mono β¦ HQc) HNc) //
- <plus_n_Sm <plus_n_O #H <H //
- |#ty #v #a #P #HP #i normalize >(subst_closed β¦ (le_O_n β¦)) //
- @R_to_star @riota @assoc_map @HP
- |#P #P1 #Q #Hred #Hind #i normalize @star_red_appl @Hind
- |#P #P1 #Q #Hred #Hind #i normalize @star_red_appr @Hind
- |#ty #P #P1 #Hred #Hind #i normalize @star_red_lambda @Hind
- |#ty #P #i normalize @starl_to_star @sstepl [|@rmem]
- @star_to_starl @star_red_vec2 [>length_map >length_map >length_map //]
- #n #Q >length_map #H
- cut (βa:(FinSet_of_FType O D ty).True)
- [lapply H -H lapply (enum_complete (FinSet_of_FType O D ty))
- cases (enum (FinSet_of_FType O D ty))
- [#x normalize #H @False_ind @(absurd β¦ H) @lt_to_not_le //
- |#x #l #_ #_ %{x} //
- ]
- ] * #a #_
- >(nth_map ?????? a H) >(nth_map ?????? Q) [2:>length_map @H]
- >(nth_map ?????? a H)
- lapply (subst_lemma O D P (to_T O D ty
- (nth n (FinSet_of_FType O D ty) (enum (FinSet_of_FType O D ty)) a))
- N i 0 (is_closed_mono β¦ (is_closed_to_T β¦)) HNc) // <plus_n_O #H1 >H1
- <plus_n_Sm <plus_n_O //
- |#ty #P #Q #v #v1 #Hred #Hind #n normalize
- <map_append <map_append @star_red_vec @Hind
- ]
-qed.
-
-
-
-
-
+++ /dev/null
-(*
- ||M|| This file is part of HELM, an Hypertextual, Electronic
- ||A|| Library of Mathematics, developed at the Computer Science
- ||T|| Department of the University of Bologna, Italy.
- ||I||
- ||T||
- ||A|| This file is distributed under the terms of the
- \ / GNU General Public License Version 2
- \ /
- V_______________________________________________________________ *)
-
-include "basics/finset.ma".
-include "basics/star.ma".
-
-
-inductive FType (O:Type[0]): Type[0] β
- | atom : O β FType O
- | arrow : FType O β FType O β FType O.
-
-inductive T (O:Type[0]) (D:O β FinSet): Type[0] β
- | Val: βo:O.carr (D o) β T O D (* a value in a finset *)
- | Rel: nat β T O D (* DB index, base is 0 *)
- | App: T O D β T O D β T O D (* function, argument *)
- | Lambda: FType O β T O D β T O D (* type, body *)
- | Vec: FType O β list (T O D) β T O D (* type, body *)
-.
-
-let rec FinSet_of_FType O (D:OβFinSet) (ty:FType O) on ty : FinSet β
- match ty with
- [atom o β D o
- |arrow ty1 ty2 β FinFun (FinSet_of_FType O D ty1) (FinSet_of_FType O D ty2)
- ].
-
-(* size *)
-
-let rec size O D (M:T O D) on M β
-match M with
- [Val o a β 1
- |Rel n β 1
- |App P Q β size O D P + size O D Q + 1
- |Lambda Ty P β size O D P + 1
- |Vec Ty v β foldr ?? (Ξ»x,a. size O D x + a) 0 v +1
- ]
-.
-
-(* axiom pos_size: βM. 1 β€ size M. *)
-
-theorem Telim_size: βO,D.βP: T O D β Prop.
- (βM. (βN. size O D N < size O D M β P N) β P M) β βM. P M.
-#O #D #P #H #M (cut (βp,N. size O D N = p β P N))
- [2: /2/]
-#p @(nat_elim1 p) #m #H1 #N #sizeN @H #N0 #Hlt @(H1 (size O D N0)) //
-qed.
-
-lemma T_elim:
- βO: Type[0].βD:OβFinSet.βP:T O DβProp.
- (βo:O.βx:D o.P (Val O D o x)) β
- (βn:β.P(Rel O D n)) β
- (βm,n:T O D.P mβP nβP (App O D m n)) β
- (βTy:FType O.βm:T O D.P mβP(Lambda O D Ty m)) β
- (βTy:FType O.βv:list (T O D).
- (βx:T O D. mem ? x v β P x) β P(Vec O D Ty v)) β
- βx:T O D.P x.
-#O #D #P #Hval #Hrel #Happ #Hlam #Hvec @Telim_size #x cases x //
- [ (* app *) #m #n #Hind @Happ @Hind // /2 by le_minus_to_plus/
- | (* lam *) #ty #m #Hind @Hlam @Hind normalize //
- | (* vec *) #ty #v #Hind @Hvec #x lapply Hind elim v
- [#Hind normalize *
- |#hd #tl #Hind1 #Hind2 *
- [#Hx >Hx @Hind2 normalize //
- |@Hind1 #N #H @Hind2 @(lt_to_le_to_lt β¦ H) normalize //
- ]
- ]
- ]
-qed.
-
-(* since we only consider beta reduction with closed arguments we could avoid
-lifting. We define it for the sake of generality *)
-
-(* arguments: k is the nesting depth (starts from 0), p is the lift
-let rec lift O D t k p on t β
- match t with
- [ Val o a β Val O D o a
- | Rel n β if (leb k n) then Rel O D (n+p) else Rel O D n
- | App m n β App O D (lift O D m k p) (lift O D n k p)
- | Lambda Ty n β Lambda O D Ty (lift O D n (S k) p)
- | Vec Ty v β Vec O D Ty (map ?? (Ξ»x. lift O D x k p) v)
- ].
-
-notation "β ^ n ( M )" non associative with precedence 40 for @{'Lift 0 $n $M}.
-notation "β _ k ^ n ( M )" non associative with precedence 40 for @{'Lift $n $k $M}.
-
-interpretation "Lift" 'Lift n k M = (lift ?? M k n).
-
-let rec subst O D t k s on t β
- match t with
- [ Val o a β Val O D o a
- | Rel n β if (leb k n) then
- (if (eqb k n) then lift O D s 0 n else Rel O D (n-1))
- else(Rel O D n)
- | App m n β App O D (subst O D m k s) (subst O D n k s)
- | Lambda T n β Lambda O D T (subst O D n (S k) s)
- | Vec T v β Vec O D T (map ?? (Ξ»x. subst O D x k s) v)
- ].
-*)
-
-(* simplified version of subst, assuming the argument s is closed *)
-
-let rec subst O D t k s on t β
- match t with
- [ Val o a β Val O D o a
- | Rel n β if (leb k n) then
- (if (eqb k n) then (* lift O D s 0 n*) s else Rel O D (n-1))
- else(Rel O D n)
- | App m n β App O D (subst O D m k s) (subst O D n k s)
- | Lambda T n β Lambda O D T (subst O D n (S k) s)
- | Vec T v β Vec O D T (map ?? (Ξ»x. subst O D x k s) v)
- ].
-(* notation "hvbox(M break [ k β N ])"
- non associative with precedence 90
- for @{'Subst1 $M $k $N}. *)
-
-interpretation "Subst" 'Subst1 M k N = (subst M k N).
-
-(*
-lemma subst_rel1: βO,D,A.βk,i. i < k β
- (Rel O D i) [k β A] = Rel O D i.
-#A #k #i normalize #ltik >(lt_to_leb_false β¦ ltik) //
-qed.
-
-lemma subst_rel2: βO,D, A.βk.
- (Rel k) [k β A] = lift A 0 k.
-#A #k normalize >(le_to_leb_true k k) // >(eq_to_eqb_true β¦ (refl β¦)) //
-qed.
-
-lemma subst_rel3: βA.βk,i. k < i β
- (Rel i) [k β A] = Rel (i-1).
-#A #k #i normalize #ltik >(le_to_leb_true k i) /2/
->(not_eq_to_eqb_false k i) // @lt_to_not_eq //
-qed. *)
-
-
-(* closed terms ????
-let rec closed_k O D (t: T O D) k on t β
- match t with
- [ Val o a β True
- | Rel n β n < k
- | App m n β (closed_k O D m k) β§ (closed_k O D n k)
- | Lambda T n β closed_k O D n (k+1)
- | Vec T v β closed_list O D v k
- ]
-
-and closed_list O D (l: list (T O D)) k on l β
- match l with
- [ nil β True
- | cons hd tl β closed_k O D hd k β§ closed_list O D tl k
- ]
-. *)
-
-inductive is_closed (O:Type[0]) (D:OβFinSet): nat β T O D β Prop β
-| cval : βk,o,a.is_closed O D k (Val O D o a)
-| crel : βk,n. n < k β is_closed O D k (Rel O D n)
-| capp : βk,m,n. is_closed O D k m β is_closed O D k n β
- is_closed O D k (App O D m n)
-| clam : βT,k,m. is_closed O D (S k) m β is_closed O D k (Lambda O D T m)
-| cvec: βT,k,v. (βm. mem ? m v β is_closed O D k m) β
- is_closed O D k (Vec O D T v).
-
-lemma is_closed_rel: βO,D,n,k.
- is_closed O D k (Rel O D n) β n < k.
-#O #D #n #k #H inversion H
- [#k0 #o #a #eqk #H destruct
- |#k0 #n0 #ltn0 #eqk #H destruct //
- |#k0 #M #N #_ #_ #_ #_ #_ #H destruct
- |#T #k0 #M #_ #_ #_ #H destruct
- |#T #k0 #v #_ #_ #_ #H destruct
- ]
-qed.
-
-lemma is_closed_app: βO,D,k,M, N.
- is_closed O D k (App O D M N) β is_closed O D k M β§ is_closed O D k N.
-#O #D #k #M #N #H inversion H
- [#k0 #o #a #eqk #H destruct
- |#k0 #n0 #ltn0 #eqk #H destruct
- |#k0 #M1 #N1 #HM #HN #_ #_ #_ #H1 destruct % //
- |#T #k0 #M #_ #_ #_ #H destruct
- |#T #k0 #v #_ #_ #_ #H destruct
- ]
-qed.
-
-lemma is_closed_lam: βO,D,k,ty,M.
- is_closed O D k (Lambda O D ty M) β is_closed O D (S k) M.
-#O #D #k #ty #M #H inversion H
- [#k0 #o #a #eqk #H destruct
- |#k0 #n0 #ltn0 #eqk #H destruct
- |#k0 #M1 #N1 #HM #HN #_ #_ #_ #H1 destruct
- |#T #k0 #M1 #HM1 #_ #_ #H1 destruct //
- |#T #k0 #v #_ #_ #_ #H destruct
- ]
-qed.
-
-lemma is_closed_vec: βO,D,k,ty,v.
- is_closed O D k (Vec O D ty v) β βm. mem ? m v β is_closed O D k m.
-#O #D #k #ty #M #H inversion H
- [#k0 #o #a #eqk #H destruct
- |#k0 #n0 #ltn0 #eqk #H destruct
- |#k0 #M1 #N1 #HM #HN #_ #_ #_ #H1 destruct
- |#T #k0 #M1 #HM1 #_ #_ #H1 destruct
- |#T #k0 #v #Hv #_ #_ #H1 destruct @Hv
- ]
-qed.
-
-lemma is_closed_S: βO,D,M,m.
- is_closed O D m M β is_closed O D (S m) M.
-#O #D #M #m #H elim H //
- [#k #n0 #Hlt @crel @le_S //
- |#k #P #Q #HP #HC #H1 #H2 @capp //
- |#ty #k #P #HP #H1 @clam //
- |#ty #k #v #Hind #Hv @cvec @Hv
- ]
-qed.
-
-lemma is_closed_mono: βO,D,M,m,n. m β€ n β
- is_closed O D m M β is_closed O D n M.
-#O #D #M #m #n #lemn elim lemn // #i #j #H #H1 @is_closed_S @H @H1
-qed.
-
-
-(*** properties of lift and subst ***)
-
-(*
-lemma lift_0: βO,D.βt:T O D.βk. lift O D t k 0 = t.
-#O #D #t @(T_elim β¦ t) normalize //
- [#n #k cases (leb k n) normalize //
- |#o #v #Hind #k @eq_f lapply Hind -Hind elim v //
- #hd #tl #Hind #Hind1 normalize @eq_f2
- [@Hind1 %1 //|@Hind #x #Hx @Hind1 %2 //]
- ]
-qed.
-
-lemma lift_closed: βO,D.βt:T O D.βk,p.
- is_closed O D k t β lift O D t k p = t.
-#O #D #t @(T_elim β¦ t) normalize //
- [#n #k #p #H >(not_le_to_leb_false β¦ (lt_to_not_le β¦ (is_closed_rel β¦ H))) //
- |#M #N #HindM #HindN #k #p #H lapply (is_closed_app β¦ H) * #HcM #HcN
- >(HindM β¦ HcM) >(HindN β¦ HcN) //
- |#ty #M #HindM #k #p #H lapply (is_closed_lam β¦ H) -H #H >(HindM β¦ H) //
- |#ty #v #HindM #k #p #H lapply (is_closed_vec β¦ H) -H #H @eq_f
- cut (βm. mem ? m v β lift O D m k p = m)
- [#m #Hmem @HindM [@Hmem | @H @Hmem]] -HindM
- elim v // #a #tl #Hind #H1 normalize @eq_f2
- [@H1 %1 //|@Hind #m #Hmem @H1 %2 @Hmem]
- ]
-qed.
-
-*)
-
-lemma subst_closed: βO,D,M,N,k,i. k β€ i β
- is_closed O D k M β subst O D M i N = M.
-#O #D #M @(T_elim β¦ M)
- [#o #a normalize //
- |#n #N #k #j #Hlt #Hc lapply (is_closed_rel β¦ Hc) #Hnk normalize
- >not_le_to_leb_false [2:@lt_to_not_le @(lt_to_le_to_lt β¦ Hnk Hlt)] //
- |#P #Q #HindP #HindQ #N #k #i #ltki #Hc lapply (is_closed_app β¦ Hc) *
- #HcP #HcQ normalize >(HindP β¦ ltki HcP) >(HindQ β¦ ltki HcQ) //
- |#ty #P #HindP #N #k #i #ltki #Hc lapply (is_closed_lam β¦ Hc)
- #HcP normalize >(HindP β¦ HcP) // @le_S_S @ltki
- |#ty #v #Hindv #N #k #i #ltki #Hc lapply (is_closed_vec β¦ Hc)
- #Hcv normalize @eq_f
- cut (βm:T O D.mem (T O D) m vβ subst O D m i N=m)
- [#m #Hmem @(Hindv β¦ Hmem N β¦ ltki) @Hcv @Hmem]
- elim v // #a #tl #Hind #H normalize @eq_f2
- [@H %1 //| @Hind #Hmem #Htl @H %2 @Htl]
- ]
-qed.
-
-lemma subst_lemma: βO,D,A,B,C,k,i. is_closed O D k B β is_closed O D i C β
- subst O D (subst O D A i B) (k+i) C =
- subst O D (subst O D A (k+S i) C) i B.
-#O #D #A #B #C #k @(T_elim β¦ A) normalize
- [//
- |#n #i #HBc #HCc @(leb_elim i n) #Hle
- [@(eqb_elim i n) #eqni
- [<eqni >(lt_to_leb_false (k+(S i)) i) // normalize
- >(subst_closed β¦ HBc) // >le_to_leb_true // >eq_to_eqb_true //
- |(cut (i < n))
- [cases (le_to_or_lt_eq β¦ Hle) // #eqin @False_ind /2/] #ltin
- (cut (0 < n)) [@(le_to_lt_to_lt β¦ ltin) //] #posn
- normalize @(leb_elim (k+i) (n-1)) #nk
- [@(eqb_elim (k+i) (n-1)) #H normalize
- [cut (k+(S i) = n); [/2 by S_pred/] #H1
- >(le_to_leb_true (k+(S i)) n) /2/
- >(eq_to_eqb_true β¦ H1) normalize >(subst_closed β¦ HCc) //
- |(cut (k+i < n-1)) [@not_eq_to_le_to_lt; //] #Hlt
- >(le_to_leb_true (k+(S i)) n) normalize
- [>(not_eq_to_eqb_false (k+(S i)) n) normalize
- [>le_to_leb_true [2:@lt_to_le @(le_to_lt_to_lt β¦ Hlt) //]
- >not_eq_to_eqb_false // @lt_to_not_eq @(le_to_lt_to_lt β¦ Hlt) //
- |@(not_to_not β¦ H) #Hn /2 by plus_minus/
- ]
- |<plus_n_Sm @(lt_to_le_to_lt β¦ Hlt) //
- ]
- ]
- |>(not_le_to_leb_false (k+(S i)) n) normalize
- [>(le_to_leb_true β¦ Hle) >(not_eq_to_eqb_false β¦ eqni) //
- |@(not_to_not β¦ nk) #H @le_plus_to_minus_r //
- ]
- ]
- ]
- |(cut (n < k+i)) [@(lt_to_le_to_lt ? i) /2 by not_le_to_lt/] #ltn
- >not_le_to_leb_false [2: @lt_to_not_le @(transitive_lt β¦ltn) //] normalize
- >not_le_to_leb_false [2: @lt_to_not_le //] normalize
- >(not_le_to_leb_false β¦ Hle) //
- ]
- |#M #N #HindM #HindN #i #HBC #HCc @eq_f2 [@HindM // |@HindN //]
- |#ty #M #HindM #i #HBC #HCc @eq_f >plus_n_Sm >plus_n_Sm @HindM //
- @is_closed_S //
- |#ty #v #Hindv #i #HBC #HCc @eq_f
- cut (βm.mem ? m v β subst O D (subst O D m i B) (k+i) C =
- subst O D (subst O D m (k+S i) C) i B)
- [#m #Hmem @Hindv //] -Hindv elim v normalize [//]
- #a #tl #Hind #H @eq_f2 [@H %1 // | @Hind #m #Hmem @H %2 //]
- ]
-qed.
-
-
+++ /dev/null
-(*
- ||M|| This file is part of HELM, an Hypertextual, Electronic
- ||A|| Library of Mathematics, developed at the Computer Science
- ||T|| Department of the University of Bologna, Italy.
- ||I||
- ||T||
- ||A|| This file is distributed under the terms of the
- \ / GNU General Public License Version 2
- \ /
- V_______________________________________________________________ *)
-
-include "finite_lambda/reduction.ma".
-
-
-(****************************************************************)
-
-inductive TJ (O: Type[0]) (D:O β FinSet): list (FType O) β T O D β FType O β Prop β
- | tval: βG,o,a. TJ O D G (Val O D o a) (atom O o)
- | trel: βG1,ty,G2,n. length ? G1 = n β TJ O D (G1@ty::G2) (Rel O D n) ty
- | tapp: βG,M,N,ty1,ty2. TJ O D G M (arrow O ty1 ty2) β TJ O D G N ty1 β
- TJ O D G (App O D M N) ty2
- | tlambda: βG,M,ty1,ty2. TJ O D (ty1::G) M ty2 β
- TJ O D G (Lambda O D ty1 M) (arrow O ty1 ty2)
- | tvec: βG,v,ty1,ty2.
- (|v| = |enum (FinSet_of_FType O D ty1)|) β
- (βM. mem ? M v β TJ O D G M ty2) β
- TJ O D G (Vec O D ty1 v) (arrow O ty1 ty2).
-
-lemma wt_to_T: βO,D,G,ty,a.TJ O D G (to_T O D ty a) ty.
-#O #D #G #ty elim ty
- [#o #a normalize @tval
- |#ty1 #ty2 #Hind1 #Hind2 normalize * #v #Hv @tvec
- [<Hv >length_map >length_map //
- |#M elim v
- [normalize @False_ind |#a #v1 #Hind3 * [#eqM >eqM @Hind2 |@Hind3]]
- ]
- ]
-qed.
-
-lemma inv_rel: βO,D,G,n,ty.
- TJ O D G (Rel O D n) ty β βG1,G2.|G1|=nβ§G=G1@ty::G2.
-#O #D #G #n #ty #Hrel inversion Hrel
- [#G1 #o #a #_ #H destruct
- |#G1 #ty1 #G2 #n1 #H1 #H2 #H3 #H4 destruct %{G1} %{G2} /2/
- |#G1 #M0 #N #ty1 #ty2 #_ #_ #_ #_ #_ #H destruct
- |#G1 #M0 #ty4 #ty5 #HM0 #_ #_ #H #H1 destruct
- |#G1 #v #ty3 #ty4 #_ #_ #_ #_ #H destruct
- ]
-qed.
-
-lemma inv_tlambda: βO,D,G,M,ty1,ty2,ty3.
- TJ O D G (Lambda O D ty1 M) (arrow O ty2 ty3) β
- ty1 = ty2 β§ TJ O D (ty2::G) M ty3.
-#O #D #G #M #ty1 #ty2 #ty3 #Hlam inversion Hlam
- [#G1 #o #a #_ #H destruct
- |#G1 #ty #G2 #n #_ #_ #H destruct
- |#G1 #M0 #N #ty1 #ty2 #_ #_ #_ #_ #_ #H destruct
- |#G1 #M0 #ty4 #ty5 #HM0 #_ #_ #H #H1 destruct % //
- |#G1 #v #ty3 #ty4 #_ #_ #_ #_ #H destruct
- ]
-qed.
-
-lemma inv_tvec: βO,D,G,v,ty1,ty2,ty3.
- TJ O D G (Vec O D ty1 v) (arrow O ty2 ty3) β
- (|v| = |enum (FinSet_of_FType O D ty1)|) β§
- (βM. mem ? M v β TJ O D G M ty3).
-#O #D #G #v #ty1 #ty2 #ty3 #Hvec inversion Hvec
- [#G #o #a #_ #H destruct
- |#G1 #ty #G2 #n #_ #_ #H destruct
- |#G1 #M0 #N #ty1 #ty2 #_ #_ #_ #_ #_ #H destruct
- |#G1 #M0 #ty4 #ty5 #HM0 #_ #_ #H #H1 destruct
- |#G1 #v1 #ty4 #ty5 #Hv #Hmem #_ #_ #H #H1 destruct % // @Hmem
- ]
-qed.
-
-(* could be generalized *)
-lemma weak_rel: βO,D,G1,G2,ty1,ty2,n. length ? G1 < n β
- TJ O D (G1@G2) (Rel O D n) ty1 β
- TJ O D (G1@ty2::G2) (Rel O D (S n)) ty1.
-#O #D #G1 #G2 #ty1 #ty2 #n #HG1 #Hrel lapply (inv_rel β¦ Hrel)
-* #G3 * #G4 * #H1 #H2 lapply (compare_append β¦ H2)
-* #G5 *
- [* #H3 @False_ind >H3 in HG1; >length_append >H1 #H4
- @(absurd β¦ H4) @le_to_not_lt //
- |* #H3 #H4 >H4 >append_cons <associative_append @trel
- >length_append >length_append <H1 >H3 >length_append normalize
- >plus_n_Sm >associative_plus @eq_f //
- ]
-qed.
-
-lemma strength_rel: βO,D,G1,G2,ty1,ty2,n. length ? G1 < n β
- TJ O D (G1@ty2::G2) (Rel O D n) ty1 β
- TJ O D (G1@G2) (Rel O D (n-1)) ty1.
-#O #D #G1 #G2 #ty1 #ty2 #n #HG1 #Hrel lapply (inv_rel β¦ Hrel)
-* #G3 * #G4 * #H1 #H2 lapply (compare_append β¦ H2)
-* #G5 *
- [* #H3 @False_ind >H3 in HG1; >length_append >H1 #H4
- @(absurd β¦ H4) @le_to_not_lt //
- |lapply G5 -G5 *
- [>append_nil normalize * #H3 #H4 destruct @False_ind @(absurd β¦ HG1)
- @le_to_not_lt //
- |#ty3 #G5 * #H3 normalize #H4 destruct (H4) <associative_append @trel
- <H1 >H3 >length_append >length_append normalize <plus_minus_associative //
- ]
- ]
-qed.
-
-lemma no_matter: βO,D,G,N,tyN.
- TJ O D G N tyN β βG1,G2,G3.G=G1@G2 β is_closed O D (|G1|) N β
- TJ O D (G1@G3) N tyN.
-#O #D #G #N #tyN #HN elim HN -HN -tyN -N -G
- [#G #o #a #G1 #G2 #G3 #_ #_ @tval
- |#G #ty #G2 #n #HG #G3 #G4 #G5 #H #HNC normalize
- lapply (is_closed_rel β¦ HNC) #Hlt lapply (compare_append β¦ H) * #G6 *
- [* #H1 @False_ind @(absurd ? Hlt) @le_to_not_lt <HG >H1 >length_append //
- |* cases G6
- [>append_nil normalize #H1 @False_ind
- @(absurd ? Hlt) @le_to_not_lt <HG >H1 //
- |#ty1 #G7 #H1 normalize #H2 destruct >associative_append @trel //
- ]
- ]
- |#G #M #N #ty1 #ty2 #HM #HN #HindM #HindN #G1 #G2 #G3
- #Heq #Hc lapply (is_closed_app β¦ Hc) -Hc * #HMc #HNc
- @(tapp β¦ (HindM β¦ Heq HMc) (HindN β¦ Heq HNc))
- |#G #M #ty1 #ty2 #HM #HindM #G1 #G2 #G3 #Heq #Hc
- lapply (is_closed_lam β¦ Hc) -Hc #HMc
- @tlambda @(HindM (ty1::G1) G2) [>Heq // |@HMc]
- |#G #v #ty1 #ty2 #Hlen #Hv #Hind #G1 #G2 #G3 #H1 #Hc @tvec
- [>length_map //
- |#M #Hmem @Hind // lapply (is_closed_vec β¦ Hc) #Hvc @Hvc //
- ]
- ]
-qed.
-
-lemma nth_spec: βA,a,d,l1,l2,n. |l1| = n β nth n A (l1@a::l2) d = a.
-#A #a #d #l1 elim l1 normalize
- [#l2 #n #Hn <Hn //
- |#b #tl #Hind #l2 #m #Hm <Hm normalize @Hind //
- ]
-qed.
-
-lemma wt_subst_gen: βO,D,G,M,tyM.
- TJ O D G M tyM β
- βG1,G2,N,tyN.G=(G1@tyN::G2) β
- TJ O D G2 N tyN β is_closed O D 0 N β
- TJ O D (G1@G2) (subst O D M (|G1|) N) tyM.
-#O #D #G #M #tyM #HM elim HM -HM -tyM -M -G
- [#G #o #a #G1 #G2 #N #tyN #_ #HG #_ normalize @tval
- |#G #ty #G2 #n #Hlen #G21 #G22 #N #tyN #HG #HN #HNc
- normalize cases (true_or_false (leb (|G21|) n))
- [#H >H cases (le_to_or_lt_eq β¦ (leb_true_to_le β¦ H))
- [#ltn >(not_eq_to_eqb_false β¦ (lt_to_not_eq β¦ ltn)) normalize
- lapply (compare_append β¦ HG) * #G3 *
- [* #HG1 #HG2 @(strength_rel β¦ tyN β¦ ltn) <HG @trel @Hlen
- |* #HG >HG in ltn; >length_append #ltn @False_ind
- @(absurd β¦ ltn) @le_to_not_lt >Hlen //
- ]
- |#HG21 >(eq_to_eqb_true β¦ HG21)
- cut (ty = tyN)
- [<(nth_spec ? ty ty ? G2 β¦ Hlen) >HG @nth_spec @HG21] #Hty >Hty
- normalize <HG21 @(no_matter ????? HN []) //
- ]
- |#H >H normalize lapply (compare_append β¦ HG) * #G3 *
- [* #H1 @False_ind @(absurd ? Hlen) @sym_not_eq @lt_to_not_eq >H1
- >length_append @(lt_to_le_to_lt n (|G21|)) // @not_le_to_lt
- @(leb_false_to_not_le β¦ H)
- |cases G3
- [>append_nil * #H1 @False_ind @(absurd ? Hlen) <H1 @sym_not_eq
- @lt_to_not_eq @not_le_to_lt @(leb_false_to_not_le β¦ H)
- |#ty2 #G4 * #H1 normalize #H2 destruct >associative_append @trel //
- ]
- ]
- ]
- |#G #M #N #ty1 #ty2 #HM #HN #HindM #HindN #G1 #G2 #N0 #tyN0 #eqG
- #HN0 #Hc normalize @(tapp β¦ ty1)
- [@(HindM β¦ eqG HN0 Hc) |@(HindN β¦ eqG HN0 Hc)]
- |#G #M #ty1 #ty2 #HM #HindM #G1 #G2 #N0 #tyN0 #eqG
- #HN0 #Hc normalize @(tlambda β¦ ty1) @(HindM (ty1::G1) β¦ HN0) // >eqG //
- |#G #v #ty1 #ty2 #Hlen #Hv #Hind #G1 #G2 #N0 #tyN0 #eqG
- #HN0 #Hc normalize @(tvec β¦ ty1)
- [>length_map @Hlen
- |#M #Hmem lapply (mem_map ????? Hmem) * #a * -Hmem #Hmem #eqM <eqM
- @(Hind β¦ Hmem β¦ eqG HN0 Hc)
- ]
- ]
-qed.
-
-lemma wt_subst: βO,D,M,N,G,ty1,ty2.
- TJ O D (ty1::G) M ty2 β
- TJ O D G N ty1 β is_closed O D 0 N β
- TJ O D G (subst O D M 0 N) ty2.
-#O #D #M #N #G #ty1 #ty2 #HM #HN #Hc @(wt_subst_gen β¦(ty1::G) β¦ [ ] β¦ HN) //
-qed.
-
-lemma subject_reduction: βO,D,M,M1,G,ty.
- TJ O D G M ty β red O D M M1 β TJ O D G M1 ty.
-#O #D #M #M1 #G #ty #HM lapply M1 -M1 elim HM -HM -ty -G -M
- [#G #o #a #M1 #Hval elim (red_val ????? Hval)
- |#G #ty #G1 #n #_ #M1 #Hrel elim (red_rel ???? Hrel)
- |#G #M #N #ty1 #ty2 #HM #HN #HindM #HindN #M1 #Hred inversion Hred
- [#P #M0 #N0 #Hc #H1 destruct (H1) #HM1 @(wt_subst β¦ HN) //
- @(proj2 β¦ (inv_tlambda β¦ HM))
- |#ty #v #a #M0 #Ha #H1 #H2 destruct @(proj2 β¦ (inv_tvec β¦ HM))
- @(assoc_to_mem β¦ Ha)
- |#M2 #M3 #N0 #Hredl #_ #H1 destruct (H1) #eqM1 @(tapp β¦ HN) @HindM @Hredl
- |#M2 #M3 #N0 #Hredr #_ #H1 destruct (H1) #eqM1 @(tapp β¦ HM) @HindN @Hredr
- |#ty #N0 #N1 #_ #_ #H1 destruct (H1)
- |#ty #M0 #H1 destruct (H1)
- |#ty #N0 #N1 #v #v1 #_ #_ #H1 destruct (H1)
- ]
- |#G #P #ty1 #ty2 #HP #Hind #M1 #Hred lapply(red_lambda ????? Hred) *
- [* #P1 * #HredP #HM1 >HM1 @tlambda @Hind //
- |#HM1 >HM1 @tvec // #N #HN lapply(mem_map ????? HN)
- * #a * #mema #eqN <eqN -eqN @(wt_subst β¦HP) // @wt_to_T
- ]
- |#G #v #ty1 #ty2 #Hlen #Hv #Hind #M1 #Hred lapply(red_vec ????? Hred)
- * #N * #N1 * #v1 * #v2 * * #H1 #H2 #H3 >H3 @tvec
- [<Hlen >H2 >length_append >length_append @eq_f //
- |#M2 #Hmem cases (mem_append ???? Hmem) -Hmem #Hmem
- [@Hv >H2 @mem_append_l1 //
- |cases Hmem
- [#HM2 >HM2 -HM2 @(Hind N β¦ H1) >H2 @mem_append_l2 %1 //
- |-Hmem #Hmem @Hv >H2 @mem_append_l2 %2 //
- ]
- ]
- ]
- ]
-qed.
-
+++ /dev/null
-
-include "arithmetics/nat.ma".
-include "basics/sets.ma".
-
-(******************************** big O notation ******************************)
-
-(* O f g means g β O(f) *)
-definition O: relation (natβnat) β
- Ξ»f,g. βc.βn0.βn. n0 β€ n β g n β€ c* (f n).
-
-lemma O_refl: βs. O s s.
-#s %{1} %{0} #n #_ >commutative_times <times_n_1 @le_n qed.
-
-lemma O_trans: βs1,s2,s3. O s2 s1 β O s3 s2 β O s3 s1.
-#s1 #s2 #s3 * #c1 * #n1 #H1 * #c2 * # n2 #H2 %{(c1*c2)}
-%{(max n1 n2)} #n #Hmax
-@(transitive_le β¦ (H1 ??)) [@(le_maxl β¦ Hmax)]
->associative_times @le_times [//|@H2 @(le_maxr β¦ Hmax)]
-qed.
-
-lemma sub_O_to_O: βs1,s2. O s1 β O s2 β O s2 s1.
-#s1 #s2 #H @H // qed.
-
-lemma O_to_sub_O: βs1,s2. O s2 s1 β O s1 β O s2.
-#s1 #s2 #H #g #Hg @(O_trans β¦ H) // qed.
-
-lemma le_to_O: βs1,s2. (βx.s1 x β€ s2 x) β O s2 s1.
-#s1 #s2 #Hle %{1} %{0} #n #_ normalize <plus_n_O @Hle
-qed.
-
-definition sum_f β Ξ»f,g:natβnat.Ξ»n.f n + g n.
-interpretation "function sum" 'plus f g = (sum_f f g).
-
-lemma O_plus: βf,g,s. O s f β O s g β O s (f+g).
-#f #g #s * #cf * #nf #Hf * #cg * #ng #Hg
-%{(cf+cg)} %{(max nf ng)} #n #Hmax normalize
->distributive_times_plus_r @le_plus
- [@Hf @(le_maxl β¦ Hmax) |@Hg @(le_maxr β¦ Hmax) ]
-qed.
-
-lemma O_plus_l: βf,s1,s2. O s1 f β O (s1+s2) f.
-#f #s1 #s2 * #c * #a #Os1f %{c} %{a} #n #lean
-@(transitive_le β¦ (Os1f n lean)) @le_times //
-qed.
-
-lemma O_plus_r: βf,s1,s2. O s2 f β O (s1+s2) f.
-#f #s1 #s2 * #c * #a #Os1f %{c} %{a} #n #lean
-@(transitive_le β¦ (Os1f n lean)) @le_times //
-qed.
-
-lemma O_absorbl: βf,g,s. O s f β O f g β O s (g+f).
-#f #g #s #Osf #Ofg @(O_plus β¦ Osf) @(O_trans β¦ Osf) //
-qed.
-
-lemma O_absorbr: βf,g,s. O s f β O f g β O s (f+g).
-#f #g #s #Osf #Ofg @(O_plus β¦ Osf) @(O_trans β¦ Osf) //
-qed.
-
-lemma O_times_c: βf,c. O f (Ξ»x:β.c*f x).
-#f #c %{c} %{0} //
-qed.
-
-lemma O_ext2: βf,g,s. O s f β (βx.f x = g x) β O s g.
-#f #g #s * #c * #a #Osf #eqfg %{c} %{a} #n #lean <eqfg @Osf //
-qed.
-
-
-definition not_O β Ξ»f,g.βc,n0.βn. n0 β€ n β§ c* (f n) < g n .
-
-(* this is the only classical result *)
-axiom not_O_def: βf,g. Β¬ O f g β not_O f g.
-
-(******************************* small O notation *****************************)
-
-(* o f g means g β o(f) *)
-definition o: relation (natβnat) β
- Ξ»f,g.βc.βn0.βn. n0 β€ n β c * (g n) < f n.
-
-lemma o_irrefl: βs. Β¬ o s s.
-#s % #oss cases (oss 1) #n0 #H @(absurd ? (le_n (s n0)))
-@lt_to_not_le >(times_n_1 (s n0)) in β’ (?%?); >commutative_times @H //
-qed.
-
-lemma o_trans: βs1,s2,s3. o s2 s1 β o s3 s2 β o s3 s1.
-#s1 #s2 #s3 #H1 #H2 #c cases (H1 c) #n1 -H1 #H1 cases (H2 1) #n2 -H2 #H2
-%{(max n1 n2)} #n #Hmax
-@(transitive_lt β¦ (H1 ??)) [@(le_maxl β¦ Hmax)]
->(times_n_1 (s2 n)) in β’ (?%?); >commutative_times @H2 @(le_maxr β¦ Hmax)
-qed.
+++ /dev/null
-
-include "arithmetics/minimization.ma".
-include "arithmetics/bigops.ma".
-include "arithmetics/pidgeon_hole.ma".
-include "arithmetics/iteration.ma".
-
-(************************** notation for miminimization ***********************)
-
-(* an alternative defintion of minimization
-definition Min β Ξ»a,f.
- \big[min,a]_{i < a | f i} i. *)
-
-notation "ΞΌ_{ ident i < n } p"
- with precedence 80 for @{min $n 0 (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β€ n } p"
- with precedence 80 for @{min (S $n) 0 (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β [a,b] } p"
- with precedence 80 for @{min (S $b-$a) $a (Ξ»${ident i}.$p)}.
-
-lemma f_min_true: βf,a,b.
- (βi. a β€ i β§ i β€ b β§ f i = true) β f (ΞΌ_{i β[a,b]} (f i)) = true.
-#f #a #b * #i * * #Hil #Hir #Hfi @(f_min_true β¦ (Ξ»x. f x)) <plus_minus_m_m
- [%{i} % // % [@Hil |@le_S_S @Hir]|@le_S @(transitive_le β¦ Hil Hir)]
-qed.
-
-lemma min_up: βf,a,b.
- (βi. a β€ i β§ i β€ b β§ f i = true) β ΞΌ_{i β[a,b]}(f i) β€ b.
-#f #a #b * #i * * #Hil #Hir #Hfi @le_S_S_to_le
-cut ((S b) = S b - a + a) [@plus_minus_m_m @le_S @(transitive_le β¦ Hil Hir)]
-#Hcut >Hcut in β’ (??%); @lt_min %{i} % // % [@Hil |<Hcut @le_S_S @Hir]
-qed.
-
-(*************************** Kleene's predicate *******************************)
-
-axiom U: nat β nat βnat β option nat.
-
-axiom monotonic_U: βi,x,n,m,y.n β€m β
- U i x n = Some ? y β U i x m = Some ? y.
-
-lemma unique_U: βi,x,n,m,yn,ym.
- U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
-#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
- [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
- |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
- >Hn #HS destruct (HS) //
- ]
-qed.
-
-definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
-
-notation "β©i,xβͺ β r" with precedence 60 for @{terminate $i $x $r}.
-
-lemma terminate_dec: βi,x,n. β©i,xβͺ β n β¨ Β¬ β©i,xβͺ β n.
-#i #x #n normalize cases (U i x n)
- [%2 % * #y #H destruct|#y %1 %{y} //]
-qed.
-
-definition termb β Ξ»i,x,t.
- match U i x t with [None β false |Some y β true].
-
-lemma termb_true_to_term: βi,x,t. termb i x t = true β β©i,xβͺ β t.
-#i #x #t normalize cases (U i x t) normalize [#H destruct | #y #_ %{y} //]
-qed.
-
-lemma term_to_termb_true: βi,x,t. β©i,xβͺ β t β termb i x t = true.
-#i #x #t * #y #H normalize >H //
-qed.
-
-lemma decidable_test : βn,x,r,r1.
- (βi. i < n β β©i,xβͺ β r β¨ Β¬ β©i,xβͺ β r1) β¨
- (βi. i < n β§ (Β¬ β©i,xβͺ β r β§ β©i,xβͺ β r1)).
-#n #x #r1 #r2
- cut (βi0.decidable ((β©i0,xβͺβr1) β¨ Β¬ β©i0,xβͺ β r2))
- [#j @decidable_or [@terminate_dec |@decidable_not @terminate_dec ]] #Hdec
- cases(decidable_forall ? Hdec n)
- [#H %1 @H
- |#H %2 cases (not_forall_to_exists β¦ Hdec H) #j * #leji #Hj
- %{j} % // %
- [@(not_to_not β¦ Hj) #H %1 @H
- |cases (terminate_dec j x r2) // #H @False_ind cases Hj -Hj #Hj
- @Hj %2 @H
- ]
-qed.
-
-(**************************** the gap theorem *********************************)
-definition gapP β Ξ»n,x,g,r. βi. i < n β β©i,xβͺ β r β¨ Β¬ β©i,xβͺ β g r.
-
-lemma gapP_def : βn,x,g,r.
- gapP n x g r = βi. i < n β β©i,xβͺ β r β¨ Β¬ β©i,xβͺ β g r.
-// qed.
-
-lemma upper_bound_aux: βg,b,n,x. (βx. x β€ g x) β βk.
- (βj.j < k β§
- (βi. i < n β β©i,xβͺ β g^j b β¨ Β¬ β©i,xβͺ β g^(S j) b)) β¨
- βl. |l| = k β§ unique ? l β§ βi. i β l β i < n β§ β©i,xβͺ β g^k b .
-#g#b #n #x #Hg #k elim k
- [%2 %{([])} normalize % [% //|#x @False_ind]
- |#k0 *
- [* #j * #lej #H %1 %{j} % [@le_S // | @H ]
- |* #l * * #Hlen #Hunique #Hterm
- cases (decidable_test n x (g^k0 b) (g^(S k0) b))
- [#Hcase %1 %{k0} % [@le_n | @Hcase]
- |* #j * #ltjn * #H1 #H2 %2
- %{(j::l)} %
- [ % [normalize @eq_f @Hlen] whd % // % #H3
- @(absurd ?? H1) @(proj2 β¦ (Hterm β¦)) @H3
- |#x *
- [#eqxj >eqxj % //
- |#Hmemx cases(Hterm β¦ Hmemx) #lexn * #y #HU
- % [@lexn] %{y} @(monotonic_U ?????? HU) @Hg
- ]
- ]
- ]
- ]
- ]
-qed.
-
-lemma upper_bound: βg,b,n,x. (βx. x β€ g x) β βr.
- (* b β€ r β§ r β€ g^n b β§ βi. i < n β β©i,xβͺ β r β¨ Β¬ β©i,xβͺ β g r. *)
- b β€ r β§ r β€ g^n b β§ gapP n x g r.
-#g #b #n #x #Hg
-cases (upper_bound_aux g b n x Hg n)
- [* #j * #Hj #H %{(g^j b)} % [2: @H] % [@le_iter //]
- @monotonic_iter2 // @lt_to_le //
- |* #l * * #Hlen #Hunique #Hterm %{(g^n b)} %
- [% [@le_iter // |@le_n]]
- #i #lein %1 @(proj2 β¦ (Hterm ??))
- @(eq_length_to_mem_all β¦ Hlen Hunique β¦ lein)
- #x #memx @(proj1 β¦ (Hterm ??)) //
- ]
-qed.
-
-definition gapb β Ξ»n,x,g,r.
- \big[andb,true]_{i < n} ((termb i x r) β¨ Β¬(termb i x (g r))).
-
-lemma gapb_def : βn,x,g,r. gapb n x g r =
- \big[andb,true]_{i < n} ((termb i x r) β¨ Β¬(termb i x (g r))).
-// qed.
-
-lemma gapb_true_to_gapP : βn,x,g,r.
- gapb n x g r = true β βi. i < n β β©i,xβͺ β r β¨ Β¬(β©i,xβͺ β (g r)).
-#n #x #g #r elim n
- [>gapb_def >bigop_Strue //
- #H #i #lti0 @False_ind @(absurd β¦ lti0) @le_to_not_lt //
- |#m #Hind >gapb_def >bigop_Strue //
- #H #i #leSm cases (le_to_or_lt_eq β¦ leSm)
- [#lem @Hind [@(andb_true_r β¦ H)|@le_S_S_to_le @lem]
- |#eqi >(injective_S β¦ eqi) lapply (andb_true_l β¦ H) -H #H cases (orb_true_l β¦ H) -H
- [#H %1 @termb_true_to_term //
- |#H %2 % #H1 >(term_to_termb_true β¦ H1) in H; normalize #H destruct
- ]
- ]
- ]
-qed.
-
-lemma gapP_to_gapb_true : βn,x,g,r.
- (βi. i < n β β©i,xβͺ β r β¨ Β¬(β©i,xβͺ β (g r))) β gapb n x g r = true.
-#n #x #g #r elim n //
-#m #Hind #H >gapb_def >bigop_Strue // @true_to_andb_true
- [cases (H m (le_n β¦))
- [#H2 @orb_true_r1 @term_to_termb_true //
- |#H2 @orb_true_r2 @sym_eq @noteq_to_eqnot @sym_not_eq
- @(not_to_not β¦ H2) @termb_true_to_term
- ]
- |@Hind #i0 #lei0 @H @le_S //
- ]
-qed.
-
-
-(* the gap function *)
-let rec gap g n on n β
- match n with
- [ O β 1
- | S m β let b β gap g m in ΞΌ_{i β [b,g^n b]} (gapb n n g i)
- ].
-
-lemma gapS: βg,m.
- gap g (S m) =
- (let b β gap g m in
- ΞΌ_{i β [b,g^(S m) b]} (gapb (S m) (S m) g i)).
-// qed.
-
-lemma upper_bound_gapb: βg,m. (βx. x β€ g x) β
- βr:β.gap g m β€ r β§ r β€ g^(S m) (gap g m) β§ gapb (S m) (S m) g r = true.
-#g #m #leg
-lapply (upper_bound g (gap g m) (S m) (S m) leg) * #r * *
-#H1 #H2 #H3 %{r} %
- [% // |@gapP_to_gapb_true @H3]
-qed.
-
-lemma gapS_true: βg,m. (βx. x β€g x) β gapb (S m) (S m) g (gap g (S m)) = true.
-#g #m #leg @(f_min_true (gapb (S m) (S m) g)) @upper_bound_gapb //
-qed.
-
-theorem gap_theorem: βg,i.(βx. x β€ g x)ββk.βn.k < n β
- β©i,nβͺ β (gap g n) β¨ Β¬ β©i,nβͺ β (g (gap g n)).
-#g #i #leg %{i} *
- [#lti0 @False_ind @(absurd ?? (not_le_Sn_O i) ) //
- |#m #leim lapply (gapS_true g m leg) #H
- @(gapb_true_to_gapP β¦ H) //
- ]
-qed.
-
-(* an upper bound *)
-
-let rec sigma n β
- match n with
- [ O β 0 | S m β n + sigma m ].
-
-lemma gap_bound: βg. (βx. x β€ g x) β (monotonic ? le g) β
- βn.gap g n β€ g^(sigma n) 1.
-#g #leg #gmono #n elim n
- [normalize //
- |#m #Hind >gapS @(transitive_le ? (g^(S m) (gap g m)))
- [@min_up @upper_bound_gapb //
- |@(transitive_le ? (g^(S m) (g^(sigma m) 1)))
- [@monotonic_iter // |>iter_iter >commutative_plus @le_n
- ]
- ]
-qed.
-
-lemma gap_bound2: βg. (βx. x β€ g x) β (monotonic ? le g) β
- βn.gap g n β€ g^(n*n) 1.
-#g #leg #gmono #n elim n
- [normalize //
- |#m #Hind >gapS @(transitive_le ? (g^(S m) (gap g m)))
- [@min_up @upper_bound_gapb //
- |@(transitive_le ? (g^(S m) (g^(m*m) 1)))
- [@monotonic_iter //
- |>iter_iter @monotonic_iter2 [@leg | normalize <plus_n_Sm @le_S_S //
- ]
- ]
-qed.
-
-(*
-axiom universal: βu.βi,x,y.
- βn. U u β©i,xβͺ n = Some y β βm.U i x m = Some y. *)
-
-
-
-
-
-
-
-
-
-
-
-
+++ /dev/null
-
-include "arithmetics/nat.ma".
-include "arithmetics/log.ma".
-(* include "arithmetics/ord.ma". *)
-include "arithmetics/bigops.ma".
-include "arithmetics/bounded_quantifiers.ma".
-include "arithmetics/pidgeon_hole.ma".
-include "basics/sets.ma".
-include "basics/types.ma".
-
-(************************************ MAX *************************************)
-notation "Max_{ ident i < n | p } f"
- with precedence 80
-for @{'bigop $n max 0 (Ξ»${ident i}. $p) (Ξ»${ident i}. $f)}.
-
-notation "Max_{ ident i < n } f"
- with precedence 80
-for @{'bigop $n max 0 (Ξ»${ident i}.true) (Ξ»${ident i}. $f)}.
-
-notation "Max_{ ident j β [a,b[ } f"
- with precedence 80
-for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.true) (${ident j}+$a)))
- (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
-
-notation "Max_{ ident j β [a,b[ | p } f"
- with precedence 80
-for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.$p) (${ident j}+$a)))
- (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
-
-lemma Max_assoc: βa,b,c. max (max a b) c = max a (max b c).
-#a #b #c normalize cases (true_or_false (leb a b)) #leab >leab normalize
- [cases (true_or_false (leb b c )) #lebc >lebc normalize
- [>(le_to_leb_true a c) // @(transitive_le ? b) @leb_true_to_le //
- |>leab //
- ]
- |cases (true_or_false (leb b c )) #lebc >lebc normalize //
- >leab normalize >(not_le_to_leb_false a c) // @lt_to_not_le
- @(transitive_lt ? b) @not_le_to_lt @leb_false_to_not_le //
- ]
-qed.
-
-lemma Max0 : βn. max 0 n = n.
-// qed.
-
-lemma Max0r : βn. max n 0 = n.
-#n >commutative_max //
-qed.
-
-definition MaxA β
- mk_Aop nat 0 max Max0 Max0r (Ξ»a,b,c.sym_eq β¦ (Max_assoc a b c)).
-
-definition MaxAC β mk_ACop nat 0 MaxA commutative_max.
-
-lemma le_Max: βf,p,n,a. a < n β p a = true β
- f a β€ Max_{i < n | p i}(f i).
-#f #p #n #a #ltan #pa
->(bigop_diff p ? 0 MaxAC f a n) // @(le_maxl β¦ (le_n ?))
-qed.
-
-lemma Max_le: βf,p,n,b.
- (βa.a < n β p a = true β f a β€ b) β Max_{i < n | p i}(f i) β€ b.
-#f #p #n elim n #b #H //
-#b0 #H1 cases (true_or_false (p b)) #Hb
- [>bigop_Strue [2:@Hb] @to_max [@H1 // | @H #a #ltab #pa @H1 // @le_S //]
- |>bigop_Sfalse [2:@Hb] @H #a #ltab #pa @H1 // @le_S //
- ]
-qed.
-
-(******************************** big O notation ******************************)
-
-(* O f g means g β O(f) *)
-definition O: relation (natβnat) β
- Ξ»f,g. βc.βn0.βn. n0 β€ n β g n β€ c* (f n).
-
-lemma O_refl: βs. O s s.
-#s %{1} %{0} #n #_ >commutative_times <times_n_1 @le_n qed.
-
-lemma O_trans: βs1,s2,s3. O s2 s1 β O s3 s2 β O s3 s1.
-#s1 #s2 #s3 * #c1 * #n1 #H1 * #c2 * # n2 #H2 %{(c1*c2)}
-%{(max n1 n2)} #n #Hmax
-@(transitive_le β¦ (H1 ??)) [@(le_maxl β¦ Hmax)]
->associative_times @le_times [//|@H2 @(le_maxr β¦ Hmax)]
-qed.
-
-lemma sub_O_to_O: βs1,s2. O s1 β O s2 β O s2 s1.
-#s1 #s2 #H @H // qed.
-
-lemma O_to_sub_O: βs1,s2. O s2 s1 β O s1 β O s2.
-#s1 #s2 #H #g #Hg @(O_trans β¦ H) // qed.
-
-definition sum_f β Ξ»f,g:natβnat.Ξ»n.f n + g n.
-interpretation "function sum" 'plus f g = (sum_f f g).
-
-lemma O_plus: βf,g,s. O s f β O s g β O s (f+g).
-#f #g #s * #cf * #nf #Hf * #cg * #ng #Hg
-%{(cf+cg)} %{(max nf ng)} #n #Hmax normalize
->distributive_times_plus_r @le_plus
- [@Hf @(le_maxl β¦ Hmax) |@Hg @(le_maxr β¦ Hmax) ]
-qed.
-
-lemma O_plus_l: βf,s1,s2. O s1 f β O (s1+s2) f.
-#f #s1 #s2 * #c * #a #Os1f %{c} %{a} #n #lean
-@(transitive_le β¦ (Os1f n lean)) @le_times //
-qed.
-
-lemma O_plus_r: βf,s1,s2. O s2 f β O (s1+s2) f.
-#f #s1 #s2 * #c * #a #Os1f %{c} %{a} #n #lean
-@(transitive_le β¦ (Os1f n lean)) @le_times //
-qed.
-
-lemma O_absorbl: βf,g,s. O s f β O f g β O s (g+f).
-#f #g #s #Osf #Ofg @(O_plus β¦ Osf) @(O_trans β¦ Osf) //
-qed.
-
-lemma O_absorbr: βf,g,s. O s f β O f g β O s (f+g).
-#f #g #s #Osf #Ofg @(O_plus β¦ Osf) @(O_trans β¦ Osf) //
-qed.
-
-(*
-lemma O_ff: βf,s. O s f β O s (f+f).
-#f #s #Osf /2/
-qed. *)
-
-lemma O_ext2: βf,g,s. O s f β (βx.f x = g x) β O s g.
-#f #g #s * #c * #a #Osf #eqfg %{c} %{a} #n #lean <eqfg @Osf //
-qed.
-
-
-definition not_O β Ξ»f,g.βc,n0.βn. n0 β€ n β§ c* (f n) < g n .
-
-(* this is the only classical result *)
-axiom not_O_def: βf,g. Β¬ O f g β not_O f g.
-
-(******************************* small O notation *****************************)
-
-(* o f g means g β o(f) *)
-definition o: relation (natβnat) β
- Ξ»f,g.βc.βn0.βn. n0 β€ n β c * (g n) < f n.
-
-lemma o_irrefl: βs. Β¬ o s s.
-#s % #oss cases (oss 1) #n0 #H @(absurd ? (le_n (s n0)))
-@lt_to_not_le >(times_n_1 (s n0)) in β’ (?%?); >commutative_times @H //
-qed.
-
-lemma o_trans: βs1,s2,s3. o s2 s1 β o s3 s2 β o s3 s1.
-#s1 #s2 #s3 #H1 #H2 #c cases (H1 c) #n1 -H1 #H1 cases (H2 1) #n2 -H2 #H2
-%{(max n1 n2)} #n #Hmax
-@(transitive_lt β¦ (H1 ??)) [@(le_maxl β¦ Hmax)]
->(times_n_1 (s2 n)) in β’ (?%?); >commutative_times @H2 @(le_maxr β¦ Hmax)
-qed.
-
-
-(*********************************** pairing **********************************)
-
-axiom pair: nat βnat βnat.
-axiom fst : nat β nat.
-axiom snd : nat β nat.
-axiom fst_pair: βa,b. fst (pair a b) = a.
-axiom snd_pair: βa,b. snd (pair a b) = b.
-
-interpretation "abstract pair" 'pair f g = (pair f g).
-
-(************************ basic complexity notions ****************************)
-
-(* u is the deterministic configuration relation of the universal machine (one
- step)
-
-axiom u: nat β option nat.
-
-let rec U c n on n β
- match n with
- [ O β None ?
- | S m β match u c with
- [ None β Some ? c (* halting case *)
- | Some c1 β U c1 m
- ]
- ].
-
-lemma halt_U: βi,n,y. u i = None ? β U i n = Some ? y β y = i.
-#i #n #y #H cases n
- [normalize #H1 destruct |#m normalize >H normalize #H1 destruct //]
-qed.
-
-lemma Some_to_halt: βn,i,y. U i n = Some ? y β u y = None ? .
-#n elim n
- [#i #y normalize #H destruct (H)
- |#m #Hind #i #y normalize
- cut (u i = None ? β¨ βc. u i = Some ? c)
- [cases (u i) [/2/ | #c %2 /2/ ]]
- *[#H >H normalize #H1 destruct (H1) // |* #c #H >H normalize @Hind ]
- ]
-qed. *)
-
-axiom U: nat β nat β nat β option nat.
-(*
-lemma monotonici_U: βy,n,m,i.
- U i m = Some ? y β U i (n+m) = Some ? y.
-#y #n #m elim m
- [#i normalize #H destruct
- |#p #Hind #i <plus_n_Sm normalize
- cut (u i = None ? β¨ βc. u i = Some ? c)
- [cases (u i) [/2/ | #c %2 /2/ ]]
- *[#H1 >H1 normalize // |* #c #H >H normalize #H1 @Hind //]
- ]
-qed. *)
-
-axiom monotonic_U: βi,x,n,m,y.n β€m β
- U i x n = Some ? y β U i x m = Some ? y.
-(* #i #n #m #y #lenm #H >(plus_minus_m_m m n) // @monotonici_U //
-qed. *)
-
-(* axiom U: nat β nat β option nat. *)
-(* axiom monotonic_U: βi,n,m,y.n β€m β
- U i n = Some ? y β U i m = Some ? y. *)
-
-lemma unique_U: βi,x,n,m,yn,ym.
- U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
-#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
- [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
- |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
- >Hn #HS destruct (HS) //
- ]
-qed.
-
-definition code_for β Ξ»f,i.βx.
- βn.βm. n β€ m β U i x m = f x.
-
-definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
-notation "[i,x] β r" with precedence 60 for @{terminate $i $x $r}.
-
-definition lang β Ξ»i,x.βr,y. U i x r = Some ? y β§ 0 < y.
-
-lemma lang_cf :βf,i,x. code_for f i β
- lang i x β βy.f x = Some ? y β§ 0 < y.
-#f #i #x normalize #H %
- [* #n * #y * #H1 #posy %{y} % //
- cases (H x) -H #m #H <(H (max n m)) [2:@(le_maxr β¦ n) //]
- @(monotonic_U β¦ H1) @(le_maxl β¦ m) //
- |cases (H x) -H #m #Hm * #y #Hy %{m} %{y} >Hm //
- ]
-qed.
-
-(******************************* complexity classes ***************************)
-
-axiom size: nat β nat.
-axiom of_size: nat β nat.
-
-interpretation "size" 'card n = (size n).
-
-axiom size_of_size: βn. |of_size n| = n.
-axiom monotonic_size: monotonic ? le size.
-
-axiom of_size_max: βi,n. |i| = n β i β€ of_size n.
-
-axiom size_fst : βn. |fst n| β€ |n|.
-
-definition size_f β Ξ»f,n.Max_{i < S (of_size n) | eqb (|i|) n}|(f i)|.
-
-lemma size_f_def: βf,n. size_f f n =
- Max_{i < S (of_size n) | eqb (|i|) n}|(f i)|.
-// qed.
-
-(*
-definition Max_const : βf,p,n,a. a < n β p a β
- βn. f n = g n β
- Max_{i < n | p n}(f n) = *)
-
-lemma size_f_size : βf,n. size_f (f β size) n = |(f n)|.
-#f #n @le_to_le_to_eq
- [@Max_le #a #lta #Ha normalize >(eqb_true_to_eq β¦ Ha) //
- |<(size_of_size n) in β’ (?%?); >size_f_def
- @(le_Max (Ξ»i.|f (|i|)|) ? (S (of_size n)) (of_size n) ??)
- [@le_S_S // | @eq_to_eqb_true //]
- ]
-qed.
-
-lemma size_f_id : βn. size_f (Ξ»x.x) n = n.
-#n @le_to_le_to_eq
- [@Max_le #a #lta #Ha >(eqb_true_to_eq β¦ Ha) //
- |<(size_of_size n) in β’ (?%?); >size_f_def
- @(le_Max (Ξ»i.|i|) ? (S (of_size n)) (of_size n) ??)
- [@le_S_S // | @eq_to_eqb_true //]
- ]
-qed.
-
-lemma size_f_fst : βn. size_f fst n β€ n.
-#n @Max_le #a #lta #Ha <(eqb_true_to_eq β¦ Ha) //
-qed.
-
-(* definition def β Ξ»f:nat β option nat.Ξ»x.βy. f x = Some ? y.*)
-
-(* C s i means that the complexity of i is O(s) *)
-
-definition C β Ξ»s,i.βc.βa.βx.a β€ |x| β βy.
- U i x (c*(s(|x|))) = Some ? y.
-
-definition CF β Ξ»s,f.βi.code_for f i β§ C s i.
-
-lemma ext_CF : βf,g,s. (βn. f n = g n) β CF s f β CF s g.
-#f #g #s #Hext * #i * #Hcode #HC %{i} %
- [#x cases (Hcode x) #a #H %{a} <Hext @H | //]
-qed.
-
-lemma monotonic_CF: βs1,s2,f. O s2 s1 β CF s1 f β CF s2 f.
-#s1 #s2 #f * #c1 * #a #H * #i * #Hcodef #HCs1 %{i} % //
-cases HCs1 #c2 * #b #H2 %{(c2*c1)} %{(max a b)}
-#x #Hmax cases (H2 x ?) [2:@(le_maxr β¦ Hmax)] #y #Hy
-%{y} @(monotonic_U β¦Hy) >associative_times @le_times // @H @(le_maxl β¦ Hmax)
-qed.
-
-(************************** The diagonal language *****************************)
-
-(* the diagonal language used for the hierarchy theorem *)
-
-definition diag β Ξ»s,i.
- U (fst i) i (s (|i|)) = Some ? 0.
-
-lemma equiv_diag: βs,i.
- diag s i β [fst i,i] β s (|i|) β§ Β¬lang (fst i) i.
-#s #i %
- [whd in β’ (%β?); #H % [%{0} //] % * #x * #y *
- #H1 #Hy cut (0 = y) [@(unique_U β¦ H H1)] #eqy /2/
- |* * #y cases y //
- #y0 #H * #H1 @False_ind @H1 -H1 whd %{(s (|i|))} %{(S y0)} % //
- ]
-qed.
-
-(* Let us define the characteristic function diag_cf for diag, and prove
-it correctness *)
-
-definition diag_cf β Ξ»s,i.
- match U (fst i) i (s (|i|)) with
- [ None β None ?
- | Some y β if (eqb y 0) then (Some ? 1) else (Some ? 0)].
-
-lemma diag_cf_OK: βs,x. diag s x β βy.diag_cf s x = Some ? y β§ 0 < y.
-#s #x %
- [whd in β’ (%β?); #H %{1} % // whd in β’ (??%?); >H //
- |* #y * whd in β’ (??%?β?β%);
- cases (U (fst x) x (s (|x|))) normalize
- [#H destruct
- |#x cases (true_or_false (eqb x 0)) #Hx >Hx
- [>(eqb_true_to_eq β¦ Hx) //
- |normalize #H destruct #H @False_ind @(absurd ? H) @lt_to_not_le //
- ]
- ]
- ]
-qed.
-
-lemma diag_spec: βs,i. code_for (diag_cf s) i β βx. lang i x β diag s x.
-#s #i #Hcode #x @(iff_trans β¦ (lang_cf β¦ Hcode)) @iff_sym @diag_cf_OK
-qed.
-
-(******************************************************************************)
-
-lemma absurd1: βP. iff P (Β¬ P) βFalse.
-#P * #H1 #H2 cut (Β¬P) [% #H2 @(absurd β¦ H2) @H1 //]
-#H3 @(absurd ?? H3) @H2 @H3
-qed.
-
-(* axiom weak_pad : βa,βa0.βn. a0 < n β βb. |β©a,bβͺ| = n. *)
-lemma weak_pad1 :βn,a.βb. n β€ β©a,bβͺ.
-#n #a
-cut (βi.decidable (β©a,iβͺ < n))
- [#i @decidable_le ]
- #Hdec cases(decidable_forall (Ξ»b. β©a,bβͺ < n) Hdec n)
- [#H cut (βi. i < n β βb. b < n β§ β©a,bβͺ = i)
- [@(injective_to_exists β¦ H) //]
- #Hcut %{n} @not_lt_to_le % #Han
- lapply(Hcut ? Han) * #x * #Hx #Hx2
- cut (x = n) [//] #Hxn >Hxn in Hx; /2 by absurd/
- |#H lapply(not_forall_to_exists β¦ Hdec H)
- * #b * #H1 #H2 %{b} @not_lt_to_le @H2
- ]
-qed.
-
-lemma pad : βn,a. βb. n β€ |β©a,bβͺ|.
-#n #a cases (weak_pad1 (of_size n) a) #b #Hb
-%{b} <(size_of_size n) @monotonic_size //
-qed.
-
-lemma o_to_ex: βs1,s2. o s1 s2 β βi. C s2 i β
- βb.[i, β©i,bβͺ] β s1 (|β©i,bβͺ|).
-#s1 #s2 #H #i * #c * #x0 #H1
-cases (H c) #n0 #H2 cases (pad (max x0 n0) i) #b #Hmax
-%{b} cases (H1 β©i,bβͺ ?)
- [#z #H3 %{z} @(monotonic_U β¦ H3) @lt_to_le @H2
- @(le_maxr β¦ Hmax)
- |@(le_maxl β¦ Hmax)
- ]
-qed.
-
-lemma diag1_not_s1: βs1,s2. o s1 s2 β Β¬ CF s2 (diag_cf s1).
-#s1 #s2 #H1 % * #i * #Hcode_i #Hs2_i
-cases (o_to_ex β¦ H1 ? Hs2_i) #b #H2
-lapply (diag_spec β¦ Hcode_i) #H3
-@(absurd1 (lang i β©i,bβͺ))
-@(iff_trans β¦ (H3 β©i,bβͺ))
-@(iff_trans β¦ (equiv_diag β¦)) >fst_pair
-%[* #_ // |#H6 % // ]
-qed.
-
-(******************************************************************************)
-
-definition to_Some β Ξ»f.Ξ»x:nat. Some nat (f x).
-
-definition deopt β Ξ»n. match n with
- [ None β 1
- | Some n β n].
-
-definition opt_comp β Ξ»f,g:nat β option nat. Ξ»x.
- match g x with
- [ None β None ?
- | Some y β f y ].
-
-(* axiom CFU: βh,g,s. CF s (to_Some h) β CF s (to_Some (of_size β g)) β
- CF (Slow s) (Ξ»x.U (h x) (g x)). *)
-
-axiom sU2: nat β nat β nat.
-axiom sU: nat β nat β nat β nat.
-
-(* axiom CFU: CF sU (Ξ»x.U (fst x) (snd x)). *)
-
-axiom CFU_new: βh,g,f,s.
- CF s (to_Some h) β CF s (to_Some g) β CF s (to_Some f) β
- O s (Ξ»x. sU (size_f h x) (size_f g x) (size_f f x)) β
- CF s (Ξ»x.U (h x) (g x) (|f x|)).
-
-lemma CFU: βh,g,f,s1,s2,s3.
- CF s1 (to_Some h) β CF s2 (to_Some g) β CF s3 (to_Some f) β
- CF (Ξ»x. s1 x + s2 x + s3 x + sU (size_f h x) (size_f g x) (size_f f x))
- (Ξ»x.U (h x) (g x) (|f x|)).
-#h #g #f #s1 #s2 #s3 #Hh #Hg #Hf @CFU_new
- [@(monotonic_CF β¦ Hh) @O_plus_l @O_plus_l @O_plus_l //
- |@(monotonic_CF β¦ Hg) @O_plus_l @O_plus_l @O_plus_r //
- |@(monotonic_CF β¦ Hf) @O_plus_l @O_plus_r //
- |@O_plus_r //
- ]
-qed.
-
-axiom monotonic_sU: βa1,a2,b1,b2,c1,c2. a1 β€ a2 β b1 β€ b2 β c1 β€c2 β
- sU a1 b1 c1 β€ sU a2 b2 c2.
-
-axiom superlinear_sU: βi,x,r. r β€ sU i x r.
-
-definition sU_space β Ξ»i,x,r.i+x+r.
-definition sU_time β Ξ»i,x,r.i+x+(i^2)*r*(log 2 r).
-
-(*
-axiom CF_comp: βf,g,s1, s2. CF s1 f β CF s2 g β
- CF (Ξ»x.s2 x + s1 (size (deopt (g x)))) (opt_comp f g).
-
-(* axiom CF_comp: βf,g,s1, s2. CF s1 f β CF s2 g β
- CF (s1 β (Ξ»x. size (deopt (g x)))) (opt_comp f g). *)
-
-axiom CF_comp_strong: βf,g,s1,s2. CF s1 f β CF s2 g β
- CF (s1 β s2) (opt_comp f g). *)
-
-definition IF β Ξ»b,f,g:nat βoption nat. Ξ»x.
- match b x with
- [None β None ?
- |Some n β if (eqb n 0) then f x else g x].
-
-axiom IF_CF_new: βb,f,g,s. CF s b β CF s f β CF s g β CF s (IF b f g).
-
-lemma IF_CF: βb,f,g,sb,sf,sg. CF sb b β CF sf f β CF sg g β
- CF (Ξ»n. sb n + sf n + sg n) (IF b f g).
-#b #f #g #sb #sf #sg #Hb #Hf #Hg @IF_CF_new
- [@(monotonic_CF β¦ Hb) @O_plus_l @O_plus_l //
- |@(monotonic_CF β¦ Hf) @O_plus_l @O_plus_r //
- |@(monotonic_CF β¦ Hg) @O_plus_r //
- ]
-qed.
-
-lemma diag_cf_def : βs.βi.
- diag_cf s i =
- IF (Ξ»i.U (fst i) i (|of_size (s (|i|))|)) (Ξ»i.Some ? 1) (Ξ»i.Some ? 0) i.
-#s #i normalize >size_of_size // qed.
-
-(* and now ... *)
-axiom CF_pair: βf,g,s. CF s (Ξ»x.Some ? (f x)) β CF s (Ξ»x.Some ? (g x)) β
- CF s (Ξ»x.Some ? (pair (f x) (g x))).
-
-axiom CF_fst: βf,s. CF s (Ξ»x.Some ? (f x)) β CF s (Ξ»x.Some ? (fst (f x))).
-
-definition minimal β Ξ»s. CF s (Ξ»n. Some ? n) β§ βc. CF s (Ξ»n. Some ? c).
-
-
-(*
-axiom le_snd: βn. |snd n| β€ |n|.
-axiom daemon: βP:Prop.P. *)
-
-definition constructible β Ξ»s. CF s (Ξ»x.Some ? (of_size (s (|x|)))).
-
-lemma diag_s: βs. minimal s β constructible s β
- CF (Ξ»x.sU x x (s x)) (diag_cf s).
-#s * #Hs_id #Hs_c #Hs_constr
-cut (O (Ξ»x:β.sU x x (s x)) s) [%{1} %{0} #n //]
-#O_sU_s @ext_CF [2: #n @sym_eq @diag_cf_def | skip]
-@IF_CF_new [2,3:@(monotonic_CF β¦ (Hs_c ?)) // ]
-@CFU_new
- [@CF_fst @(monotonic_CF β¦ Hs_id) //
- |@(monotonic_CF β¦ Hs_id) //
- |@(monotonic_CF β¦ Hs_constr) //
- |%{1} %{0} #n #_ >commutative_times <times_n_1
- @monotonic_sU // >size_f_size >size_of_size //
- ]
-qed.
-
-(*
-lemma diag_s: βs. minimal s β constructible s β
- CF (Ξ»x.s x + sU x x (s x)) (diag_cf s).
-#s * #Hs_id #Hs_c #Hs_constr
-@ext_CF [2: #n @sym_eq @diag_cf_def | skip]
-@IF_CF_new [2,3:@(monotonic_CF β¦ (Hs_c ?)) @O_plus_l //]
-@CFU_new
- [@CF_fst @(monotonic_CF β¦ Hs_id) @O_plus_l //
- |@(monotonic_CF β¦ Hs_id) @O_plus_l //
- |@(monotonic_CF β¦ Hs_constr) @O_plus_l //
- |@O_plus_r %{1} %{0} #n #_ >commutative_times <times_n_1
- @monotonic_sU // >size_f_size >size_of_size //
- ]
-qed. *)
-
-(* proof with old axioms
-lemma diag_s: βs. minimal s β constructible s β
- CF (Ξ»x.s x + sU x x (s x)) (diag_cf s).
-#s * #Hs_id #Hs_c #Hs_constr
-@ext_CF [2: #n @sym_eq @diag_cf_def | skip]
-@(monotonic_CF ???? (IF_CF (Ξ»i:β.U (pair (fst i) i) (|of_size (s (|i|))|))
- β¦ (Ξ»i.s i + s i + s i + (sU (size_f fst i) (size_f (Ξ»i.i) i) (size_f (Ξ»i.of_size (s (|i|))) i))) β¦ (Hs_c 1) (Hs_c 0) β¦ ))
- [2: @CFU [@CF_fst // | // |@Hs_constr]
- |@(O_ext2 (Ξ»n:β.s n+sU (size_f fst n) n (s n) + (s n+s n+s n+s n)))
- [2: #i >size_f_size >size_of_size >size_f_id //]
- @O_absorbr
- [%{1} %{0} #n #_ >commutative_times <times_n_1 @le_plus //
- @monotonic_sU //
- |@O_plus_l @(O_plus β¦ (O_refl s)) @(O_plus β¦ (O_refl s))
- @(O_plus β¦ (O_refl s)) //
- ]
-qed.
-*)
-
-(*************************** The hierachy theorem *****************************)
-
-(*
-theorem hierarchy_theorem_right: βs1,s2:natβnat.
- O s1 idN β constructible s1 β
- not_O s2 s1 β Β¬ CF s1 β CF s2.
-#s1 #s2 #Hs1 #monos1 #H % #H1
-@(absurd β¦ (CF s2 (diag_cf s1)))
- [@H1 @diag_s // |@(diag1_not_s1 β¦ H)]
-qed.
-*)
-
-theorem hierarchy_theorem_left: βs1,s2:natβnat.
- O(s1) β O(s2) β CF s1 β CF s2.
-#s1 #s2 #HO #f * #i * #Hcode * #c * #a #Hs1_i %{i} % //
-cases (sub_O_to_O β¦ HO) -HO #c1 * #b #Hs1s2
-%{(c*c1)} %{(max a b)} #x #lemax
-cases (Hs1_i x ?) [2: @(le_maxl β¦lemax)]
-#y #Hy %{y} @(monotonic_U β¦ Hy) >associative_times
-@le_times // @Hs1s2 @(le_maxr β¦ lemax)
-qed.
-
+++ /dev/null
-include "basics/types.ma".
-include "arithmetics/minimization.ma".
-include "arithmetics/bigops.ma".
-include "arithmetics/sigma_pi.ma".
-include "arithmetics/bounded_quantifiers.ma".
-include "reverse_complexity/big_O.ma".
-include "basics/core_notation/napart_2.ma".
-
-(************************* notation for minimization *****************************)
-notation "ΞΌ_{ ident i < n } p"
- with precedence 80 for @{min $n 0 (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β€ n } p"
- with precedence 80 for @{min (S $n) 0 (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β [a,b[ } p"
- with precedence 80 for @{min ($b-$a) $a (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β [a,b] } p"
- with precedence 80 for @{min (S $b-$a) $a (Ξ»${ident i}.$p)}.
-
-(************************************ MAX *************************************)
-notation "Max_{ ident i < n | p } f"
- with precedence 80
-for @{'bigop $n max 0 (Ξ»${ident i}. $p) (Ξ»${ident i}. $f)}.
-
-notation "Max_{ ident i < n } f"
- with precedence 80
-for @{'bigop $n max 0 (Ξ»${ident i}.true) (Ξ»${ident i}. $f)}.
-
-notation "Max_{ ident j β [a,b[ } f"
- with precedence 80
-for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.true) (${ident j}+$a)))
- (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
-
-notation "Max_{ ident j β [a,b[ | p } f"
- with precedence 80
-for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.$p) (${ident j}+$a)))
- (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
-
-lemma Max_assoc: βa,b,c. max (max a b) c = max a (max b c).
-#a #b #c normalize cases (true_or_false (leb a b)) #leab >leab normalize
- [cases (true_or_false (leb b c )) #lebc >lebc normalize
- [>(le_to_leb_true a c) // @(transitive_le ? b) @leb_true_to_le //
- |>leab //
- ]
- |cases (true_or_false (leb b c )) #lebc >lebc normalize //
- >leab normalize >(not_le_to_leb_false a c) // @lt_to_not_le
- @(transitive_lt ? b) @not_le_to_lt @leb_false_to_not_le //
- ]
-qed.
-
-lemma Max0 : βn. max 0 n = n.
-// qed.
-
-lemma Max0r : βn. max n 0 = n.
-#n >commutative_max //
-qed.
-
-definition MaxA β
- mk_Aop nat 0 max Max0 Max0r (Ξ»a,b,c.sym_eq β¦ (Max_assoc a b c)).
-
-definition MaxAC β mk_ACop nat 0 MaxA commutative_max.
-
-lemma le_Max: βf,p,n,a. a < n β p a = true β
- f a β€ Max_{i < n | p i}(f i).
-#f #p #n #a #ltan #pa
->(bigop_diff p ? 0 MaxAC f a n) // @(le_maxl β¦ (le_n ?))
-qed.
-
-lemma le_MaxI: βf,p,n,m,a. m β€ a β a < n β p a = true β
- f a β€ Max_{i β [m,n[ | p i}(f i).
-#f #p #n #m #a #lema #ltan #pa
->(bigop_diff ? ? 0 MaxAC (Ξ»i.f (i+m)) (a-m) (n-m))
- [<plus_minus_m_m // @(le_maxl β¦ (le_n ?))
- |<plus_minus_m_m //
- |/2 by monotonic_lt_minus_l/
- ]
-qed.
-
-lemma Max_le: βf,p,n,b.
- (βa.a < n β p a = true β f a β€ b) β Max_{i < n | p i}(f i) β€ b.
-#f #p #n elim n #b #H //
-#b0 #H1 cases (true_or_false (p b)) #Hb
- [>bigop_Strue [2:@Hb] @to_max [@H1 // | @H #a #ltab #pa @H1 // @le_S //]
- |>bigop_Sfalse [2:@Hb] @H #a #ltab #pa @H1 // @le_S //
- ]
-qed.
-
-(********************************** pairing ***********************************)
-axiom pair: nat β nat β nat.
-axiom fst : nat β nat.
-axiom snd : nat β nat.
-
-interpretation "abstract pair" 'pair f g = (pair f g).
-
-axiom fst_pair: βa,b. fst β©a,bβͺ = a.
-axiom snd_pair: βa,b. snd β©a,bβͺ = b.
-axiom surj_pair: βx. βa,b. x = β©a,bβͺ.
-
-axiom le_fst : βp. fst p β€ p.
-axiom le_snd : βp. snd p β€ p.
-axiom le_pair: βa,a1,b,b1. a β€ a1 β b β€ b1 β β©a,bβͺ β€ β©a1,b1βͺ.
-
-(************************************* U **************************************)
-axiom U: nat β nat βnat β option nat.
-
-axiom monotonic_U: βi,x,n,m,y.n β€m β
- U i x n = Some ? y β U i x m = Some ? y.
-
-lemma unique_U: βi,x,n,m,yn,ym.
- U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
-#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
- [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
- |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
- >Hn #HS destruct (HS) //
- ]
-qed.
-
-definition code_for β Ξ»f,i.βx.
- βn.βm. n β€ m β U i x m = f x.
-
-definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
-
-notation "{i β x} β r" with precedence 60 for @{terminate $i $x $r}.
-
-lemma terminate_dec: βi,x,n. {i β x} β n β¨ Β¬ {i β x} β n.
-#i #x #n normalize cases (U i x n)
- [%2 % * #y #H destruct|#y %1 %{y} //]
-qed.
-
-lemma monotonic_terminate: βi,x,n,m.
- n β€ m β {i β x} β n β {i β x} β m.
-#i #x #n #m #lenm * #z #H %{z} @(monotonic_U β¦ H) //
-qed.
-
-definition termb β Ξ»i,x,t.
- match U i x t with [None β false |Some y β true].
-
-lemma termb_true_to_term: βi,x,t. termb i x t = true β {i β x} β t.
-#i #x #t normalize cases (U i x t) normalize [#H destruct | #y #_ %{y} //]
-qed.
-
-lemma term_to_termb_true: βi,x,t. {i β x} β t β termb i x t = true.
-#i #x #t * #y #H normalize >H //
-qed.
-
-definition out β Ξ»i,x,r.
- match U i x r with [ None β 0 | Some z β z].
-
-definition bool_to_nat: bool β nat β
- Ξ»b. match b with [true β 1 | false β 0].
-
-coercion bool_to_nat.
-
-definition pU : nat β nat β nat β nat β Ξ»i,x,r.β©termb i x r,out i x rβͺ.
-
-lemma pU_vs_U_Some : βi,x,r,y. pU i x r = β©1,yβͺ β U i x r = Some ? y.
-#i #x #r #y % normalize
- [cases (U i x r) normalize
- [#H cut (0=1) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H @H]
- #H1 destruct
- |#a #H cut (a=y) [lapply (eq_f β¦ snd β¦ H) >snd_pair >snd_pair #H1 @H1]
- #H1 //
- ]
- |#H >H //]
-qed.
-
-lemma pU_vs_U_None : βi,x,r. pU i x r = β©0,0βͺ β U i x r = None ?.
-#i #x #r % normalize
- [cases (U i x r) normalize //
- #a #H cut (1=0) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H1 @H1]
- #H1 destruct
- |#H >H //]
-qed.
-
-lemma fst_pU: βi,x,r. fst (pU i x r) = termb i x r.
-#i #x #r normalize cases (U i x r) normalize >fst_pair //
-qed.
-
-lemma snd_pU: βi,x,r. snd (pU i x r) = out i x r.
-#i #x #r normalize cases (U i x r) normalize >snd_pair //
-qed.
-
-(********************************* the speedup ********************************)
-
-definition min_input β Ξ»h,i,x. ΞΌ_{y β [S i,x] } (termb i y (h (S i) y)).
-
-lemma min_input_def : βh,i,x.
- min_input h i x = min (x -i) (S i) (Ξ»y.termb i y (h (S i) y)).
-// qed.
-
-lemma min_input_i: βh,i,x. x β€ i β min_input h i x = S i.
-#h #i #x #lexi >min_input_def
-cut (x - i = 0) [@sym_eq /2 by eq_minus_O/] #Hcut //
-qed.
-
-lemma min_input_to_terminate: βh,i,x.
- min_input h i x = x β {i β x} β (h (S i) x).
-#h #i #x #Hminx
-cases (decidable_le (S i) x) #Hix
- [cases (true_or_false (termb i x (h (S i) x))) #Hcase
- [@termb_true_to_term //
- |<Hminx in Hcase; #H lapply (fmin_false (Ξ»x.termb i x (h (S i) x)) (x-i) (S i) H)
- >min_input_def in Hminx; #Hminx >Hminx in β’ (%β?);
- <plus_n_Sm <plus_minus_m_m [2: @lt_to_le //]
- #Habs @False_ind /2/
- ]
- |@False_ind >min_input_i in Hminx;
- [#eqix >eqix in Hix; * /2/ | @le_S_S_to_le @not_le_to_lt //]
- ]
-qed.
-
-lemma min_input_to_lt: βh,i,x.
- min_input h i x = x β i < x.
-#h #i #x #Hminx cases (decidable_le (S i) x) //
-#ltxi @False_ind >min_input_i in Hminx;
- [#eqix >eqix in ltxi; * /2/ | @le_S_S_to_le @not_le_to_lt //]
-qed.
-
-lemma le_to_min_input: βh,i,x,x1. x β€ x1 β
- min_input h i x = x β min_input h i x1 = x.
-#h #i #x #x1 #lex #Hminx @(min_exists β¦ (le_S_S β¦ lex))
- [@(fmin_true β¦ (sym_eq β¦ Hminx)) //
- |@(min_input_to_lt β¦ Hminx)
- |#j #H1 <Hminx @lt_min_to_false //
- |@plus_minus_m_m @le_S_S @(transitive_le β¦ lex) @lt_to_le
- @(min_input_to_lt β¦ Hminx)
- ]
-qed.
-
-definition g β Ξ»h,u,x.
- S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
-
-lemma g_def : βh,u,x. g h u x =
- S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
-// qed.
-
-lemma le_u_to_g_1 : βh,u,x. x β€ u β g h u x = 1.
-#h #u #x #lexu >g_def cut (x-u = 0) [/2 by minus_le_minus_minus_comm/]
-#eq0 >eq0 normalize // qed.
-
-lemma g_lt : βh,i,x. min_input h i x = x β
- out i x (h (S i) x) < g h 0 x.
-#h #i #x #H @le_S_S @(le_MaxI β¦ i) /2 by min_input_to_lt/
-qed.
-
-(*
-axiom ax1: βh,i.
- (βy.i < y β§ (termb i y (h (S i) y)=true)) β¨
- βy. i < y β (termb i y (h (S i) y)=false).
-
-lemma eventually_0: βh,u.βnu.βx. nu < x β
- max_{i β [0,u[ | eqb (min_input h i x) x} (out i x (h (S i) x)) = 0.
-#h #u elim u
- [%{0} normalize //
- |#u0 * #nu0 #Hind cases (ax1 h u0)
- [* #x0 * #leu0x0 #Hx0 %{(max nu0 x0)}
- #x #Hx >bigop_Sfalse
- [>(minus_n_O u0) @Hind @(le_to_lt_to_lt β¦ Hx) /2 by le_maxl/
- |@not_eq_to_eqb_false % #Hf @(absurd (x β€ x0))
- [<Hf @true_to_le_min //
- |@lt_to_not_le @(le_to_lt_to_lt β¦ Hx) /2 by le_maxl/
- ]
- ]
- |#H %{(max u0 nu0)} #x #Hx >bigop_Sfalse
- [>(minus_n_O u0) @Hind @(le_to_lt_to_lt β¦ Hx) @le_maxr //
- |@not_eq_to_eqb_false >min_input_def
- >(min_not_exists (Ξ»y.(termb (u0+0) y (h (S (u0+0)) y))))
- [<plus_n_O <plus_n_Sm <plus_minus_m_m
- [% #H1 /2/
- |@lt_to_le @(le_to_lt_to_lt β¦ Hx) @le_maxl //
- ]
- |/2 by /
- ]
- ]
- ]
- ]
-qed.
-
-definition almost_equal β Ξ»f,g:nat β nat. βnu.βx. nu < x β f x = g x.
-
-definition almost_equal1 β Ξ»f,g:nat β nat. Β¬ βnu.βx. nu < x β§ f x β g x.
-
-interpretation "almost equal" 'napart f g = (almost_equal f g).
-
-lemma condition_1: βh,u.g h 0 β g h u.
-#h #u cases (eventually_0 h u) #nu #H %{(max u nu)} #x #Hx @(eq_f ?? S)
->(bigop_sumI 0 u x (Ξ»i:β.eqb (min_input h i x) x) nat 0 MaxA)
- [>H // @(le_to_lt_to_lt β¦Hx) /2 by le_maxl/
- |@lt_to_le @(le_to_lt_to_lt β¦Hx) /2 by le_maxr/
- |//
- ]
-qed. *)
-
-lemma max_neq0 : βa,b. max a b β 0 β a β 0 β¨ b β 0.
-#a #b whd in match (max a b); cases (true_or_false (leb a b)) #Hcase >Hcase
- [#H %2 @H | #H %1 @H]
-qed.
-
-definition almost_equal β Ξ»f,g:nat β nat. Β¬ βnu.βx. nu < x β§ f x β g x.
-interpretation "almost equal" 'napart f g = (almost_equal f g).
-
-lemma eventually_cancelled: βh,u.Β¬βnu.βx. nu < x β§
- max_{i β [0,u[ | eqb (min_input h i x) x} (out i x (h (S i) x)) β 0.
-#h #u elim u
- [normalize % #H cases (H u) #x * #_ * #H1 @H1 //
- |#u0 @not_to_not #Hind #nu cases (Hind nu) #x * #ltx
- cases (true_or_false (eqb (min_input h (u0+O) x) x)) #Hcase
- [>bigop_Strue [2:@Hcase] #Hmax cases (max_neq0 β¦ Hmax) -Hmax
- [2: #H %{x} % // <minus_n_O @H]
- #Hneq0 (* if x is not enough we retry with nu=x *)
- cases (Hind x) #x1 * #ltx1
- >bigop_Sfalse
- [#H %{x1} % [@transitive_lt //| <minus_n_O @H]
- |@not_eq_to_eqb_false >(le_to_min_input β¦ (eqb_true_to_eq β¦ Hcase))
- [@lt_to_not_eq @ltx1 | @lt_to_le @ltx1]
- ]
- |>bigop_Sfalse [2:@Hcase] #H %{x} % // <minus_n_O @H
- ]
- ]
-qed.
-
-lemma condition_1: βh,u.g h 0 β g h u.
-#h #u @(not_to_not β¦ (eventually_cancelled h u))
-#H #nu cases (H (max u nu)) #x * #ltx #Hdiff
-%{x} % [@(le_to_lt_to_lt β¦ ltx) @(le_maxr β¦ (le_n β¦))] @(not_to_not β¦ Hdiff)
-#H @(eq_f ?? S) >(bigop_sumI 0 u x (Ξ»i:β.eqb (min_input h i x) x) nat 0 MaxA)
- [>H // |@lt_to_le @(le_to_lt_to_lt β¦ltx) /2 by le_maxr/ |//]
-qed.
-
-(******************************** Condition 2 *********************************)
-definition total β Ξ»f.Ξ»x:nat. Some nat (f x).
-
-lemma exists_to_exists_min: βh,i. (βx. i < x β§ {i β x} β h (S i) x) β βy. min_input h i y = y.
-#h #i * #x * #ltix #Hx %{(min_input h i x)} @min_spec_to_min @found //
- [@(f_min_true (Ξ»y:β.termb i y (h (S i) y))) %{x} % [% // | @term_to_termb_true //]
- |#y #leiy #lty @(lt_min_to_false ????? lty) //
- ]
-qed.
-
-lemma condition_2: βh,i. code_for (total (g h 0)) i β Β¬βx. i<x β§ {i β x} β h (S i) x.
-#h #i whd in β’(%β?); #H % #H1 cases (exists_to_exists_min β¦ H1) #y #Hminy
-lapply (g_lt β¦ Hminy)
-lapply (min_input_to_terminate β¦ Hminy) * #r #termy
-cases (H y) -H #ny #Hy
-cut (r = g h 0 y) [@(unique_U β¦ ny β¦ termy) @Hy //] #Hr
-whd in match (out ???); >termy >Hr
-#H @(absurd ? H) @le_to_not_lt @le_n
-qed.
-
-
-(********************** complexity ***********************)
-
-(* We assume operations have a minimal structural complexity MSC.
-For instance, for time complexity, MSC is equal to the size of input.
-For space complexity, MSC is typically 0, since we only measure the
-space required in addition to dimension of the input. *)
-
-axiom MSC : nat β nat.
-axiom MSC_le: βn. MSC n β€ n.
-axiom monotonic_MSC: monotonic ? le MSC.
-axiom MSC_pair: βa,b. MSC β©a,bβͺ β€ MSC a + MSC b.
-
-(* C s i means i is running in O(s) *)
-
-definition C β Ξ»s,i.βc.βa.βx.a β€ x β βy.
- U i x (c*(s x)) = Some ? y.
-
-(* C f s means f β O(s) where MSC βO(s) *)
-definition CF β Ξ»s,f.O s MSC β§ βi.code_for (total f) i β§ C s i.
-
-lemma ext_CF : βf,g,s. (βn. f n = g n) β CF s f β CF s g.
-#f #g #s #Hext * #HO * #i * #Hcode #HC % // %{i} %
- [#x cases (Hcode x) #a #H %{a} whd in match (total ??); <Hext @H | //]
-qed.
-
-(* lemma ext_CF_total : βf,g,s. (βn. f n = g n) β CF s (total f) β CF s (total g).
-#f #g #s #Hext * #HO * #i * #Hcode #HC % // %{i} % [2:@HC]
-#x cases (Hcode x) #a #H %{a} #m #leam >(H m leam) normalize @eq_f @Hext
-qed. *)
-
-lemma monotonic_CF: βs1,s2,f.(βx. s1 x β€ s2 x) β CF s1 f β CF s2 f.
-#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
- [cases HO #c * #a -HO #HO %{c} %{a} #n #lean @(transitive_le β¦ (HO n lean))
- @le_times //
- |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1 %{c} %{a} #n #lean
- cases(Hs1 n lean) #y #Hy %{y} @(monotonic_U β¦Hy) @le_times //
- ]
-qed.
-
-lemma O_to_CF: βs1,s2,f.O s2 s1 β CF s1 f β CF s2 f.
-#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
- [@(O_trans β¦ H) //
- |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1
- cases H #c1 * #a1 #Ha1 %{(c*c1)} %{(a+a1)} #n #lean
- cases(Hs1 n ?) [2:@(transitive_le β¦ lean) //] #y #Hy %{y} @(monotonic_U β¦Hy)
- >associative_times @le_times // @Ha1 @(transitive_le β¦ lean) //
- ]
-qed.
-
-lemma timesc_CF: βs,f,c.CF (Ξ»x.c*s x) f β CF s f.
-#s #f #c @O_to_CF @O_times_c
-qed.
-
-(********************************* composition ********************************)
-axiom CF_comp: βf,g,sf,sg,sh. CF sg g β CF sf f β
- O sh (Ξ»x. sg x + sf (g x)) β CF sh (f β g).
-
-lemma CF_comp_ext: βf,g,h,sh,sf,sg. CF sg g β CF sf f β
- (βx.f(g x) = h x) β O sh (Ξ»x. sg x + sf (g x)) β CF sh h.
-#f #g #h #sh #sf #sg #Hg #Hf #Heq #H @(ext_CF (f β g))
- [#n normalize @Heq | @(CF_comp β¦ H) //]
-qed.
-
-(*
-lemma CF_comp1: βf,g,s. CF s (total g) β CF s (total f) β
- CF s (total (f β g)).
-#f #g #s #Hg #Hf @(timesc_CF β¦ 2) @(monotonic_CF β¦ (CF_comp β¦ Hg Hf))
-*)
-
-(*
-axiom CF_comp_ext2: βf,g,h,sf,sh. CF sh (total g) β CF sf (total f) β
- (βx.f(g x) = h x) β
- (βx. sf (g x) β€ sh x) β CF sh (total h).
-
-lemma main_MSC: βh,f. CF h f β O h (Ξ»x.MSC (f x)).
-
-axiom CF_S: CF MSC S.
-axiom CF_fst: CF MSC fst.
-axiom CF_snd: CF MSC snd.
-
-lemma CF_compS: βh,f. CF h f β CF h (S β f).
-#h #f #Hf @(CF_comp β¦ Hf CF_S) @O_plus // @main_MSC //
-qed.
-
-lemma CF_comp_fst: βh,f. CF h (total f) β CF h (total (fst β f)).
-#h #f #Hf @(CF_comp β¦ Hf CF_fst) @O_plus // @main_MSC //
-qed.
-
-lemma CF_comp_snd: βh,f. CF h (total f) β CF h (total (snd β f)).
-#h #f #Hf @(CF_comp β¦ Hf CF_snd) @O_plus // @main_MSC //
-qed. *)
-
-definition id β Ξ»x:nat.x.
-
-axiom CF_id: CF MSC id.
-axiom CF_compS: βh,f. CF h f β CF h (S β f).
-axiom CF_comp_fst: βh,f. CF h f β CF h (fst β f).
-axiom CF_comp_snd: βh,f. CF h f β CF h (snd β f).
-axiom CF_comp_pair: βh,f,g. CF h f β CF h g β CF h (Ξ»x. β©f x,g xβͺ).
-
-lemma CF_fst: CF MSC fst.
-@(ext_CF (fst β id)) [#n //] @(CF_comp_fst β¦ CF_id)
-qed.
-
-lemma CF_snd: CF MSC snd.
-@(ext_CF (snd β id)) [#n //] @(CF_comp_snd β¦ CF_id)
-qed.
-
-(************************************** eqb ***********************************)
-(* definition btotal β
- Ξ»f.Ξ»x:nat. match f x with [true β Some ? 0 |false β Some ? 1]. *)
-
-axiom CF_eqb: βh,f,g.
- CF h f β CF h g β CF h (Ξ»x.eqb (f x) (g x)).
-
-(*
-axiom eqb_compl2: βh,f,g.
- CF2 h (total2 f) β CF2 h (total2 g) β
- CF2 h (btotal2 (Ξ»x1,x2.eqb (f x1 x2) (g x1 x2))).
-
-axiom eqb_min_input_compl:βh,x.
- CF (Ξ»i.β_{y β [S i,S x[ }(h i y))
- (btotal (Ξ»i.eqb (min_input h i x) x)). *)
-(*********************************** maximum **********************************)
-
-axiom CF_max: βa,b.βp:nat βbool.βf,ha,hb,hp,hf,s.
- CF ha a β CF hb b β CF hp p β CF hf f β
- O s (Ξ»x.ha x + hb x + β_{i β[a x ,b x[ }(hp β©i,xβͺ + hf β©i,xβͺ)) β
- CF s (Ξ»x.max_{i β[a x,b x[ | p β©i,xβͺ }(f β©i,xβͺ)).
-
-(******************************** minimization ********************************)
-
-axiom CF_mu: βa,b.βf:nat βbool.βsa,sb,sf,s.
- CF sa a β CF sb b β CF sf f β
- O s (Ξ»x.sa x + sb x + β_{i β[a x ,S(b x)[ }(sf β©i,xβͺ)) β
- CF s (Ξ»x.ΞΌ_{i β[a x,b x] }(f β©i,xβͺ)).
-
-(****************************** constructibility ******************************)
-
-definition constructible β Ξ»s. CF s s.
-
-lemma constr_comp : βs1,s2. constructible s1 β constructible s2 β
- (βx. x β€ s2 x) β constructible (s2 β s1).
-#s1 #s2 #Hs1 #Hs2 #Hle @(CF_comp β¦ Hs1 Hs2) @O_plus @le_to_O #x [@Hle | //]
-qed.
-
-lemma ext_constr: βs1,s2. (βx.s1 x = s2 x) β
- constructible s1 β constructible s2.
-#s1 #s2 #Hext #Hs1 @(ext_CF β¦ Hext) @(monotonic_CF β¦ Hs1) #x >Hext //
-qed.
-
-(********************************* simulation *********************************)
-
-axiom sU : nat β nat.
-
-axiom monotonic_sU: βi1,i2,x1,x2,s1,s2. i1 β€ i2 β x1 β€ x2 β s1 β€ s2 β
- sU β©i1,β©x1,s1βͺβͺ β€ sU β©i2,β©x2,s2βͺβͺ.
-
-lemma monotonic_sU_aux : βx1,x2. fst x1 β€ fst x2 β fst (snd x1) β€ fst (snd x2) β
-snd (snd x1) β€ snd (snd x2) β sU x1 β€ sU x2.
-#x1 #x2 cases (surj_pair x1) #a1 * #y #eqx1 >eqx1 -eqx1 cases (surj_pair y)
-#b1 * #c1 #eqy >eqy -eqy
-cases (surj_pair x2) #a2 * #y2 #eqx2 >eqx2 -eqx2 cases (surj_pair y2)
-#b2 * #c2 #eqy2 >eqy2 -eqy2 >fst_pair >snd_pair >fst_pair >snd_pair
->fst_pair >snd_pair >fst_pair >snd_pair @monotonic_sU
-qed.
-
-axiom sU_le: βi,x,s. s β€ sU β©i,β©x,sβͺβͺ.
-axiom sU_le_i: βi,x,s. MSC i β€ sU β©i,β©x,sβͺβͺ.
-axiom sU_le_x: βi,x,s. MSC x β€ sU β©i,β©x,sβͺβͺ.
-
-definition pU_unary β Ξ»p. pU (fst p) (fst (snd p)) (snd (snd p)).
-
-axiom CF_U : CF sU pU_unary.
-
-definition termb_unary β Ξ»x:β.termb (fst x) (fst (snd x)) (snd (snd x)).
-definition out_unary β Ξ»x:β.out (fst x) (fst (snd x)) (snd (snd x)).
-
-lemma CF_termb: CF sU termb_unary.
-@(ext_CF (fst β pU_unary)) [2: @CF_comp_fst @CF_U]
-#n whd in β’ (??%?); whd in β’ (??(?%)?); >fst_pair %
-qed.
-
-lemma CF_out: CF sU out_unary.
-@(ext_CF (snd β pU_unary)) [2: @CF_comp_snd @CF_U]
-#n whd in β’ (??%?); whd in β’ (??(?%)?); >snd_pair %
-qed.
-
-(*
-lemma CF_termb_comp: βf.CF (sU β f) (termb_unary β f).
-#f @(CF_comp β¦ CF_termb) *)
-
-(******************** complexity of g ********************)
-
-definition unary_g β Ξ»h.Ξ»ux. g h (fst ux) (snd ux).
-definition auxg β
- Ξ»h,ux. max_{i β[fst ux,snd ux[ | eqb (min_input h i (snd ux)) (snd ux)}
- (out i (snd ux) (h (S i) (snd ux))).
-
-lemma compl_g1 : βh,s. CF s (auxg h) β CF s (unary_g h).
-#h #s #H1 @(CF_compS ? (auxg h) H1)
-qed.
-
-definition aux1g β
- Ξ»h,ux. max_{i β[fst ux,snd ux[ | (Ξ»p. eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β©i,uxβͺ}
- ((Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β©i,uxβͺ).
-
-lemma eq_aux : βh,x.aux1g h x = auxg h x.
-#h #x @same_bigop
- [#n #_ >fst_pair >snd_pair // |#n #_ #_ >fst_pair >snd_pair //]
-qed.
-
-lemma compl_g2 : βh,s1,s2,s.
- CF s1
- (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β
- CF s2
- (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β
- O s (Ξ»x.MSC x + β_{i β[fst x ,snd x[ }(s1 β©i,xβͺ+s2 β©i,xβͺ)) β
- CF s (auxg h).
-#h #s1 #s2 #s #Hs1 #Hs2 #HO @(ext_CF (aux1g h))
- [#n whd in β’ (??%%); @eq_aux]
-@(CF_max β¦ CF_fst CF_snd Hs1 Hs2 β¦) @(O_trans β¦ HO)
-@O_plus [@O_plus @O_plus_l // | @O_plus_r //]
-qed.
-
-lemma compl_g3 : βh,s.
- CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))) β
- CF s (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))).
-#h #s #H @(CF_eqb β¦ H) @(CF_comp β¦ CF_snd CF_snd) @(O_trans β¦ (proj1 β¦ H))
-@O_plus // %{1} %{0} #n #_ >commutative_times <times_n_1 @monotonic_MSC //
-qed.
-
-definition min_input_aux β Ξ»h,p.
- ΞΌ_{y β [S (fst p),snd (snd p)] }
- ((Ξ»x.termb (fst (snd x)) (fst x) (h (S (fst (snd x))) (fst x))) β©y,pβͺ).
-
-lemma min_input_eq : βh,p.
- min_input_aux h p =
- min_input h (fst p) (snd (snd p)).
-#h #p >min_input_def whd in β’ (??%?); >minus_S_S @min_f_g #i #_ #_
-whd in β’ (??%%); >fst_pair >snd_pair //
-qed.
-
-definition termb_aux β Ξ»h.
- termb_unary β Ξ»p.β©fst (snd p),β©fst p,h (S (fst (snd p))) (fst p)βͺβͺ.
-
-(*
-lemma termb_aux : βh,p.
- (Ξ»x:β.termb (fst x) (fst (snd x)) (snd (snd x)))
- β©fst (snd p),β©fst p,h (S (fst (snd p))) (fst p)βͺβͺ =
- termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)) .
-#h #p normalize >fst_pair >snd_pair >fst_pair >snd_pair //
-qed. *)
-
-lemma compl_g4 : βh,s1,s.
- (CF s1
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
- (O s (Ξ»x.MSC x + β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ))) β
- CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #s1 #s #Hs1 #HO @(ext_CF (min_input_aux h))
- [#n whd in β’ (??%%); @min_input_eq]
-@(CF_mu β¦ MSC MSC β¦ Hs1)
- [@CF_compS @CF_fst
- |@CF_comp_snd @CF_snd
- |@(O_trans β¦ HO) @O_plus [@O_plus @O_plus_l // | @O_plus_r //]
-(* @(ext_CF (btotal (termb_aux h)))
- [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
-@(CF_compb β¦ CF_termb) *)
-qed.
-
-(************************* a couple of technical lemmas ***********************)
-lemma minus_to_0: βa,b. a β€ b β minus a b = 0.
-#a elim a // #n #Hind *
- [#H @False_ind /2 by absurd/ | #b normalize #H @Hind @le_S_S_to_le /2/]
-qed.
-
-lemma sigma_bound: βh,a,b. monotonic nat le h β
- β_{i β [a,S b[ }(h i) β€ (S b-a)*h b.
-#h #a #b #H cases (decidable_le a b)
- [#leab cut (b = pred (S b - a + a))
- [<plus_minus_m_m // @le_S //] #Hb >Hb in match (h b);
- generalize in match (S b -a);
- #n elim n
- [//
- |#m #Hind >bigop_Strue [2://] @le_plus
- [@H @le_n |@(transitive_le β¦ Hind) @le_times [//] @H //]
- ]
- |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
- cut (S b -a = 0) [@minus_to_0 //] #Hcut >Hcut //
- ]
-qed.
-
-lemma sigma_bound_decr: βh,a,b. (βa1,a2. a1 β€ a2 β a2 < b β h a2 β€ h a1) β
- β_{i β [a,b[ }(h i) β€ (b-a)*h a.
-#h #a #b #H cases (decidable_le a b)
- [#leab cut ((b -a) +a β€ b) [/2 by le_minus_to_plus_r/] generalize in match (b -a);
- #n elim n
- [//
- |#m #Hind >bigop_Strue [2://] #Hm
- cut (m+a β€ b) [@(transitive_le β¦ Hm) //] #Hm1
- @le_plus [@H // |@(transitive_le β¦ (Hind Hm1)) //]
- ]
- |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
- cut (b -a = 0) [@minus_to_0 @lt_to_le @ltba] #Hcut >Hcut //
- ]
-qed.
-
-lemma coroll: βs1:natβnat. (βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
-O (Ξ»x.(snd (snd x)-fst x)*(s1 β©snd (snd x),xβͺ))
- (Ξ»x.β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ)).
-#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
-@(transitive_le β¦ (sigma_bound β¦)) [@Hs1|>minus_S_S //]
-qed.
-
-lemma coroll2: βs1:natβnat. (βn,a,b. a β€ b β b < snd n β s1 β©b,nβͺ β€ s1 β©a,nβͺ) β
-O (Ξ»x.(snd x - fst x)*s1 β©fst x,xβͺ) (Ξ»x.β_{i β[fst x,snd x[ }(s1 β©i,xβͺ)).
-#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
-@(transitive_le β¦ (sigma_bound_decr β¦)) [2://] @Hs1
-qed.
-
-lemma compl_g5 : βh,s1.(βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
- (CF s1
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
- CF (Ξ»x.MSC x + (snd (snd x)-fst x)*s1 β©snd (snd x),xβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #s1 #Hmono #Hs1 @(compl_g4 β¦ Hs1) @O_plus
-[@O_plus_l // |@O_plus_r @coroll @Hmono]
-qed.
-
-(*
-axiom compl_g6: βh.
- (* constructible (Ξ»x. h (fst x) (snd x)) β *)
- (CF (Ξ»x. max (MSC x) (sU β©fst (snd x),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ))
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))).
-*)
-
-lemma compl_g6: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (CF (Ξ»x. sU β©max (fst (snd x)) (snd (snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ)
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))).
-#h #hconstr @(ext_CF (termb_aux h))
- [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
-@(CF_comp β¦ (Ξ»x.MSC x + h (S (fst (snd x))) (fst x)) β¦ CF_termb)
- [@CF_comp_pair
- [@CF_comp_fst @(monotonic_CF β¦ CF_snd) #x //
- |@CF_comp_pair
- [@(monotonic_CF β¦ CF_fst) #x //
- |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst (snd x)),fst xβͺ)))
- [#n normalize >fst_pair >snd_pair %]
- @(CF_comp β¦ MSC β¦hconstr)
- [@CF_comp_pair [@CF_compS @CF_comp_fst // |//]
- |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
- ]
- ]
- ]
- |@O_plus
- [@O_plus
- [@(O_trans β¦ (Ξ»x.MSC (fst x) + MSC (max (fst (snd x)) (snd (snd x)))))
- [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- >distributive_times_plus @le_plus [//]
- cases (surj_pair b) #c * #d #eqb >eqb
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- whd in β’ (??%); @le_plus
- [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
- |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
- ]
- |@O_plus [@le_to_O #x @sU_le_x |@le_to_O #x @sU_le_i]
- ]
- |@le_to_O #n @sU_le
- ]
- |@le_to_O #x @monotonic_sU // @(le_maxl β¦ (le_n β¦)) ]
- ]
-qed.
-
-(* definition faux1 β Ξ»h.
- (Ξ»x.MSC x + (snd (snd x)-fst x)*(Ξ»x.sU β©fst (snd x),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ) β©snd (snd x),xβͺ).
-
-(* complexity of min_input *)
-lemma compl_g7: βh.
- (βx.MSC xβ€h (S (fst (snd x))) (fst x)) β
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- CF (Ξ»x.MSC x + (snd (snd x)-fst x)*sU β©fst x,β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #hle #hcostr #hmono @(monotonic_CF β¦ (faux1 h))
- [#n normalize >fst_pair >snd_pair //]
-@compl_g5 [2:@(compl_g6 h hcostr)] #n #x #y #lexy >fst_pair >snd_pair
->fst_pair >snd_pair @monotonic_sU // @hmono @lexy
-qed.*)
-
-definition big : nat βnat β Ξ»x.
- let m β max (fst x) (snd x) in β©m,mβͺ.
-
-lemma big_def : βa,b. big β©a,bβͺ = β©max a b,max a bβͺ.
-#a #b normalize >fst_pair >snd_pair // qed.
-
-lemma le_big : βx. x β€ big x.
-#x cases (surj_pair x) #a * #b #eqx >eqx @le_pair >fst_pair >snd_pair
-[@(le_maxl β¦ (le_n β¦)) | @(le_maxr β¦ (le_n β¦))]
-qed.
-
-definition faux2 β Ξ»h.
- (Ξ»x.MSC x + (snd (snd x)-fst x)*
- (Ξ»x.sU β©max (fst(snd x)) (snd(snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ) β©snd (snd x),xβͺ).
-
-(* proviamo con x *)
-lemma compl_g7: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- CF (Ξ»x.MSC x + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #hcostr #hmono @(monotonic_CF β¦ (faux2 h))
- [#n normalize >fst_pair >snd_pair //]
-@compl_g5 [2:@(compl_g6 h hcostr)] #n #x #y #lexy >fst_pair >snd_pair
->fst_pair >snd_pair @monotonic_sU // @hmono @lexy
-qed.
-
-(* proviamo con x *)
-lemma compl_g71: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- CF (Ξ»x.MSC (big x) + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #hcostr #hmono @(monotonic_CF β¦ (compl_g7 h hcostr hmono)) #x
-@le_plus [@monotonic_MSC //]
-cases (decidable_le (fst x) (snd(snd x)))
- [#Hle @le_times // @monotonic_sU
- |#Hlt >(minus_to_0 β¦ (lt_to_le β¦ )) [// | @not_le_to_lt @Hlt]
- ]
-qed.
-
-(*
-axiom compl_g8: βh.
- CF (Ξ»x. sU β©fst x,β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))). *)
-
-definition out_aux β Ξ»h.
- out_unary β Ξ»p.β©fst p,β©snd(snd p),h (S (fst p)) (snd (snd p))βͺβͺ.
-
-lemma compl_g8: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (CF (Ξ»x. sU β©max (fst x) (snd x),β©snd(snd x),h (S (fst x)) (snd(snd x))βͺβͺ)
- (Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p))))).
-#h #hconstr @(ext_CF (out_aux h))
- [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
-@(CF_comp β¦ (Ξ»x.h (S (fst x)) (snd(snd x)) + MSC x) β¦ CF_out)
- [@CF_comp_pair
- [@(monotonic_CF β¦ CF_fst) #x //
- |@CF_comp_pair
- [@CF_comp_snd @(monotonic_CF β¦ CF_snd) #x //
- |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst x),snd(snd x)βͺ)))
- [#n normalize >fst_pair >snd_pair %]
- @(CF_comp β¦ MSC β¦hconstr)
- [@CF_comp_pair [@CF_compS // | @CF_comp_snd // ]
- |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
- ]
- ]
- ]
- |@O_plus
- [@O_plus
- [@le_to_O #n @sU_le
- |@(O_trans β¦ (Ξ»x.MSC (max (fst x) (snd x))))
- [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- whd in β’ (??%); @le_plus
- [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
- |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
- ]
- |@le_to_O #x @(transitive_le ???? (sU_le_i β¦ )) //
- ]
- ]
- |@le_to_O #x @monotonic_sU [@(le_maxl β¦ (le_n β¦))|//|//]
- ]
-qed.
-
-(*
-lemma compl_g81: βh.
- (βx.MSC xβ€h (S (fst x)) (snd(snd x))) β
- constructible (Ξ»x. h (fst x) (snd x)) β
- CF (Ξ»x. sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))).
-#h #hle #hconstr @(monotonic_CF ???? (compl_g8 h hle hconstr)) #x @monotonic_sU // @(le_maxl β¦ (le_n β¦ ))
-qed. *)
-
-(* axiom daemon : False. *)
-
-lemma compl_g9 : βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
- CF (Ξ»x. (S (snd x-fst x))*MSC β©x,xβͺ +
- (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ)
- (auxg h).
-#h #hconstr #hmono #hantimono
-@(compl_g2 h ??? (compl_g3 β¦ (compl_g71 h hconstr hmono)) (compl_g8 h hconstr))
-@O_plus
- [@O_plus_l @le_to_O #x >(times_n_1 (MSC x)) >commutative_times @le_times
- [// | @monotonic_MSC // ]]
-@(O_trans β¦ (coroll2 ??))
- [#n #a #b #leab #ltb >fst_pair >fst_pair >snd_pair >snd_pair
- cut (b β€ n) [@(transitive_le β¦ (le_snd β¦)) @lt_to_le //] #lebn
- cut (max a n = n)
- [normalize >le_to_leb_true [//|@(transitive_le β¦ leab lebn)]] #maxa
- cut (max b n = n) [normalize >le_to_leb_true //] #maxb
- @le_plus
- [@le_plus [>big_def >big_def >maxa >maxb //]
- @le_times
- [/2 by monotonic_le_minus_r/
- |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
- ]
- |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
- ]
- |@le_to_O #n >fst_pair >snd_pair
- cut (max (fst n) n = n) [normalize >le_to_leb_true //] #Hmax >Hmax
- >associative_plus >distributive_times_plus
- @le_plus [@le_times [@le_S // |>big_def >Hmax //] |//]
- ]
-qed.
-
-definition sg β Ξ»h,x.
- (S (snd x-fst x))*MSC β©x,xβͺ + (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ.
-
-lemma sg_def : βh,a,b.
- sg h β©a,bβͺ = (S (b-a))*MSC β©β©a,bβͺ,β©a,bβͺβͺ +
- (b-a)*(S(b-a))*sU β©β©a,bβͺ,β©b,h (S a) bβͺβͺ.
-#h #a #b whd in β’ (??%?); >fst_pair >snd_pair //
-qed.
-
-lemma compl_g11 : βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
- CF (sg h) (unary_g h).
-#h #hconstr #Hm #Ham @compl_g1 @(compl_g9 h hconstr Hm Ham)
-qed.
-
-(**************************** closing the argument ****************************)
-
-let rec h_of_aux (r:nat βnat) (c,d,b:nat) on d : nat β
- match d with
- [ O β c (* MSC β©β©b,bβͺ,β©b,bβͺβͺ *)
- | S d1 β (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
- d*(S d)*sU β©β©b-d,bβͺ,β©b,r (h_of_aux r c d1 b)βͺβͺ].
-
-lemma h_of_aux_O: βr,c,b.
- h_of_aux r c O b = c.
-// qed.
-
-lemma h_of_aux_S : βr,c,d,b.
- h_of_aux r c (S d) b =
- (S (S d))*(MSC β©β©b-(S d),bβͺ,β©b-(S d),bβͺβͺ) +
- (S d)*(S (S d))*sU β©β©b-(S d),bβͺ,β©b,r(h_of_aux r c d b)βͺβͺ.
-// qed.
-
-definition h_of β Ξ»r,p.
- let m β max (fst p) (snd p) in
- h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (snd p - fst p) (snd p).
-
-lemma h_of_O: βr,a,b. b β€ a β
- h_of r β©a,bβͺ = let m β max a b in MSC β©β©m,mβͺ,β©m,mβͺβͺ.
-#r #a #b #Hle normalize >fst_pair >snd_pair >(minus_to_0 β¦ Hle) //
-qed.
-
-lemma h_of_def: βr,a,b.h_of r β©a,bβͺ =
- let m β max a b in
- h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (b - a) b.
-#r #a #b normalize >fst_pair >snd_pair //
-qed.
-
-lemma mono_h_of_aux: βr.(βx. x β€ r x) β monotonic ? le r β
- βd,d1,c,c1,b,b1.c β€ c1 β d β€ d1 β b β€ b1 β
- h_of_aux r c d b β€ h_of_aux r c1 d1 b1.
-#r #Hr #monor #d #d1 lapply d -d elim d1
- [#d #c #c1 #b #b1 #Hc #Hd @(le_n_O_elim ? Hd) #leb
- >h_of_aux_O >h_of_aux_O //
- |#m #Hind #d #c #c1 #b #b1 #lec #led #leb cases (le_to_or_lt_eq β¦ led)
- [#ltd @(transitive_le β¦ (Hind β¦ lec ? leb)) [@le_S_S_to_le @ltd]
- >h_of_aux_S @(transitive_le ???? (le_plus_n β¦))
- >(times_n_1 (h_of_aux r c1 m b1)) in β’ (?%?);
- >commutative_times @le_times [//|@(transitive_le β¦ (Hr ?)) @sU_le]
- |#Hd >Hd >h_of_aux_S >h_of_aux_S
- cut (b-S m β€ b1 - S m) [/2 by monotonic_le_minus_l/] #Hb1
- @le_plus [@le_times //]
- [@monotonic_MSC @le_pair @le_pair //
- |@le_times [//] @monotonic_sU
- [@le_pair // |// |@monor @Hind //]
- ]
- ]
- ]
-qed.
-
-lemma mono_h_of2: βr.(βx. x β€ r x) β monotonic ? le r β
- βi,b,b1. b β€ b1 β h_of r β©i,bβͺ β€ h_of r β©i,b1βͺ.
-#r #Hr #Hmono #i #a #b #leab >h_of_def >h_of_def
-cut (max i a β€ max i b)
- [@to_max
- [@(le_maxl β¦ (le_n β¦))|@(transitive_le β¦ leab) @(le_maxr β¦ (le_n β¦))]]
-#Hmax @(mono_h_of_aux r Hr Hmono)
- [@monotonic_MSC @le_pair @le_pair @Hmax |/2 by monotonic_le_minus_l/ |@leab]
-qed.
-
-axiom h_of_constr : βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- constructible (h_of r).
-
-lemma speed_compl: βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- CF (h_of r) (unary_g (Ξ»i,x. r(h_of r β©i,xβͺ))).
-#r #Hr #Hmono #Hconstr @(monotonic_CF β¦ (compl_g11 β¦))
- [#x cases (surj_pair x) #a * #b #eqx >eqx
- >sg_def cases (decidable_le b a)
- [#leba >(minus_to_0 β¦ leba) normalize in β’ (?%?);
- <plus_n_O <plus_n_O >h_of_def
- cut (max a b = a)
- [normalize cases (le_to_or_lt_eq β¦ leba)
- [#ltba >(lt_to_leb_false β¦ ltba) %
- |#eqba <eqba >(le_to_leb_true β¦ (le_n ?)) % ]]
- #Hmax >Hmax normalize >(minus_to_0 β¦ leba) normalize
- @monotonic_MSC @le_pair @le_pair //
- |#ltab >h_of_def >h_of_def
- cut (max a b = b)
- [normalize >(le_to_leb_true β¦ ) [%] @lt_to_le @not_le_to_lt @ltab]
- #Hmax >Hmax
- cut (max (S a) b = b)
- [whd in β’ (??%?); >(le_to_leb_true β¦ ) [%] @not_le_to_lt @ltab]
- #Hmax1 >Hmax1
- cut (βd.b - a = S d)
- [%{(pred(b-a))} >S_pred [//] @lt_plus_to_minus_r @not_le_to_lt @ltab]
- * #d #eqd >eqd
- cut (b-S a = d) [//] #eqd1 >eqd1 >h_of_aux_S >eqd1
- cut (b - S d = a)
- [@plus_to_minus >commutative_plus @minus_to_plus
- [@lt_to_le @not_le_to_lt // | //]] #eqd2 >eqd2
- normalize //
- ]
- |#n #a #b #leab #lebn >h_of_def >h_of_def
- cut (max a n = n)
- [normalize >le_to_leb_true [%|@(transitive_le β¦ leab lebn)]] #Hmaxa
- cut (max b n = n)
- [normalize >(le_to_leb_true β¦ lebn) %] #Hmaxb
- >Hmaxa >Hmaxb @Hmono @(mono_h_of_aux r β¦ Hr Hmono) // /2 by monotonic_le_minus_r/
- |#n #a #b #leab @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ leab)
- |@(constr_comp β¦ Hconstr Hr) @(ext_constr (h_of r))
- [#x cases (surj_pair x) #a * #b #eqx >eqx >fst_pair >snd_pair //]
- @(h_of_constr r Hr Hmono Hconstr)
- ]
-qed.
-
-(*
-lemma unary_g_def : βh,i,x. g h i x = unary_g h β©i,xβͺ.
-#h #i #x whd in β’ (???%); >fst_pair >snd_pair %
-qed. *)
-
-(* smn *)
-axiom smn: βf,s. CF s f β βx. CF (Ξ»y.s β©x,yβͺ) (Ξ»y.f β©x,yβͺ).
-
-lemma speed_compl_i: βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- βi. CF (Ξ»x.h_of r β©i,xβͺ) (Ξ»x.g (Ξ»i,x. r(h_of r β©i,xβͺ)) i x).
-#r #Hr #Hmono #Hconstr #i
-@(ext_CF (Ξ»x.unary_g (Ξ»i,x. r(h_of r β©i,xβͺ)) β©i,xβͺ))
- [#n whd in β’ (??%%); @eq_f @sym_eq >fst_pair >snd_pair %]
-@smn @(ext_CF β¦ (speed_compl r Hr Hmono Hconstr)) #n //
-qed.
-
-theorem pseudo_speedup:
- βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
- βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§ O sf (r β sg).
-(* βm,a.βn. aβ€n β r(sg a) < m * sf n. *)
-#r #Hr #Hmono #Hconstr
-(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
-#Hcodei #HCi
-(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
-(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
-%{(Ξ»x. h_of r β©S i,xβͺ)}
-lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
-%[%[@condition_1 |@Hg]
- |cases Hg #H1 * #j * #Hcodej #HCj
- lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
- cases HCi #m * #a #Ha %{m} %{(max (S i) a)} #n #ltin @lt_to_le @not_le_to_lt
- @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf %{n} %
- [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
- cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
- #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf) //
- ]
-qed.
-
-theorem pseudo_speedup':
- βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
- βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§
- (* Β¬ O (r β sg) sf. *)
- βm,a.βn. aβ€n β r(sg a) < m * sf n.
-#r #Hr #Hmono #Hconstr
-(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
-#Hcodei #HCi
-(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
-(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
-%{(Ξ»x. h_of r β©S i,xβͺ)}
-lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
-%[%[@condition_1 |@Hg]
- |cases Hg #H1 * #j * #Hcodej #HCj
- lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
- cases HCi #m * #a #Ha
- %{m} %{(max (S i) a)} #n #ltin @not_le_to_lt @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf
- %{n} % [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
- cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
- #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf)
- @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ ltin)
- ]
-qed.
-
+++ /dev/null
-include "basics/types.ma".
-include "arithmetics/minimization.ma".
-include "arithmetics/bigops.ma".
-include "arithmetics/sigma_pi.ma".
-include "arithmetics/bounded_quantifiers.ma".
-include "reverse_complexity/big_O.ma".
-include "basics/core_notation/napart_2.ma".
-
-(************************* notation for minimization *****************************)
-notation "ΞΌ_{ ident i < n } p"
- with precedence 80 for @{min $n 0 (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β€ n } p"
- with precedence 80 for @{min (S $n) 0 (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β [a,b[ } p"
- with precedence 80 for @{min ($b-$a) $a (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β [a,b] } p"
- with precedence 80 for @{min (S $b-$a) $a (Ξ»${ident i}.$p)}.
-
-(************************************ MAX *************************************)
-notation "Max_{ ident i < n | p } f"
- with precedence 80
-for @{'bigop $n max 0 (Ξ»${ident i}. $p) (Ξ»${ident i}. $f)}.
-
-notation "Max_{ ident i < n } f"
- with precedence 80
-for @{'bigop $n max 0 (Ξ»${ident i}.true) (Ξ»${ident i}. $f)}.
-
-notation "Max_{ ident j β [a,b[ } f"
- with precedence 80
-for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.true) (${ident j}+$a)))
- (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
-
-notation "Max_{ ident j β [a,b[ | p } f"
- with precedence 80
-for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.$p) (${ident j}+$a)))
- (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
-
-lemma Max_assoc: βa,b,c. max (max a b) c = max a (max b c).
-#a #b #c normalize cases (true_or_false (leb a b)) #leab >leab normalize
- [cases (true_or_false (leb b c )) #lebc >lebc normalize
- [>(le_to_leb_true a c) // @(transitive_le ? b) @leb_true_to_le //
- |>leab //
- ]
- |cases (true_or_false (leb b c )) #lebc >lebc normalize //
- >leab normalize >(not_le_to_leb_false a c) // @lt_to_not_le
- @(transitive_lt ? b) @not_le_to_lt @leb_false_to_not_le //
- ]
-qed.
-
-lemma Max0 : βn. max 0 n = n.
-// qed.
-
-lemma Max0r : βn. max n 0 = n.
-#n >commutative_max //
-qed.
-
-definition MaxA β
- mk_Aop nat 0 max Max0 Max0r (Ξ»a,b,c.sym_eq β¦ (Max_assoc a b c)).
-
-definition MaxAC β mk_ACop nat 0 MaxA commutative_max.
-
-lemma le_Max: βf,p,n,a. a < n β p a = true β
- f a β€ Max_{i < n | p i}(f i).
-#f #p #n #a #ltan #pa
->(bigop_diff p ? 0 MaxAC f a n) // @(le_maxl β¦ (le_n ?))
-qed.
-
-lemma le_MaxI: βf,p,n,m,a. m β€ a β a < n β p a = true β
- f a β€ Max_{i β [m,n[ | p i}(f i).
-#f #p #n #m #a #lema #ltan #pa
->(bigop_diff ? ? 0 MaxAC (Ξ»i.f (i+m)) (a-m) (n-m))
- [<plus_minus_m_m // @(le_maxl β¦ (le_n ?))
- |<plus_minus_m_m //
- |/2 by monotonic_lt_minus_l/
- ]
-qed.
-
-lemma Max_le: βf,p,n,b.
- (βa.a < n β p a = true β f a β€ b) β Max_{i < n | p i}(f i) β€ b.
-#f #p #n elim n #b #H //
-#b0 #H1 cases (true_or_false (p b)) #Hb
- [>bigop_Strue [2:@Hb] @to_max [@H1 // | @H #a #ltab #pa @H1 // @le_S //]
- |>bigop_Sfalse [2:@Hb] @H #a #ltab #pa @H1 // @le_S //
- ]
-qed.
-
-(********************************** pairing ***********************************)
-axiom pair: nat β nat β nat.
-axiom fst : nat β nat.
-axiom snd : nat β nat.
-
-interpretation "abstract pair" 'pair f g = (pair f g).
-
-axiom fst_pair: βa,b. fst β©a,bβͺ = a.
-axiom snd_pair: βa,b. snd β©a,bβͺ = b.
-axiom surj_pair: βx. βa,b. x = β©a,bβͺ.
-
-axiom le_fst : βp. fst p β€ p.
-axiom le_snd : βp. snd p β€ p.
-axiom le_pair: βa,a1,b,b1. a β€ a1 β b β€ b1 β β©a,bβͺ β€ β©a1,b1βͺ.
-
-(************************************* U **************************************)
-axiom U: nat β nat βnat β option nat.
-
-axiom monotonic_U: βi,x,n,m,y.n β€m β
- U i x n = Some ? y β U i x m = Some ? y.
-
-lemma unique_U: βi,x,n,m,yn,ym.
- U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
-#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
- [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
- |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
- >Hn #HS destruct (HS) //
- ]
-qed.
-
-definition code_for β Ξ»f,i.βx.
- βn.βm. n β€ m β U i x m = f x.
-
-definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
-
-notation "{i β x} β r" with precedence 60 for @{terminate $i $x $r}.
-
-lemma terminate_dec: βi,x,n. {i β x} β n β¨ Β¬ {i β x} β n.
-#i #x #n normalize cases (U i x n)
- [%2 % * #y #H destruct|#y %1 %{y} //]
-qed.
-
-lemma monotonic_terminate: βi,x,n,m.
- n β€ m β {i β x} β n β {i β x} β m.
-#i #x #n #m #lenm * #z #H %{z} @(monotonic_U β¦ H) //
-qed.
-
-definition termb β Ξ»i,x,t.
- match U i x t with [None β false |Some y β true].
-
-lemma termb_true_to_term: βi,x,t. termb i x t = true β {i β x} β t.
-#i #x #t normalize cases (U i x t) normalize [#H destruct | #y #_ %{y} //]
-qed.
-
-lemma term_to_termb_true: βi,x,t. {i β x} β t β termb i x t = true.
-#i #x #t * #y #H normalize >H //
-qed.
-
-definition out β Ξ»i,x,r.
- match U i x r with [ None β 0 | Some z β z].
-
-definition bool_to_nat: bool β nat β
- Ξ»b. match b with [true β 1 | false β 0].
-
-coercion bool_to_nat.
-
-definition pU : nat β nat β nat β nat β Ξ»i,x,r.β©termb i x r,out i x rβͺ.
-
-lemma pU_vs_U_Some : βi,x,r,y. pU i x r = β©1,yβͺ β U i x r = Some ? y.
-#i #x #r #y % normalize
- [cases (U i x r) normalize
- [#H cut (0=1) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H @H]
- #H1 destruct
- |#a #H cut (a=y) [lapply (eq_f β¦ snd β¦ H) >snd_pair >snd_pair #H1 @H1]
- #H1 //
- ]
- |#H >H //]
-qed.
-
-lemma pU_vs_U_None : βi,x,r. pU i x r = β©0,0βͺ β U i x r = None ?.
-#i #x #r % normalize
- [cases (U i x r) normalize //
- #a #H cut (1=0) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H1 @H1]
- #H1 destruct
- |#H >H //]
-qed.
-
-lemma fst_pU: βi,x,r. fst (pU i x r) = termb i x r.
-#i #x #r normalize cases (U i x r) normalize >fst_pair //
-qed.
-
-lemma snd_pU: βi,x,r. snd (pU i x r) = out i x r.
-#i #x #r normalize cases (U i x r) normalize >snd_pair //
-qed.
-
-(********************************* the speedup ********************************)
-
-definition min_input β Ξ»h,i,x. ΞΌ_{y β [S i,x] } (termb i y (h (S i) y)).
-
-lemma min_input_def : βh,i,x.
- min_input h i x = min (x -i) (S i) (Ξ»y.termb i y (h (S i) y)).
-// qed.
-
-lemma min_input_i: βh,i,x. x β€ i β min_input h i x = S i.
-#h #i #x #lexi >min_input_def
-cut (x - i = 0) [@sym_eq /2 by eq_minus_O/] #Hcut //
-qed.
-
-lemma min_input_to_terminate: βh,i,x.
- min_input h i x = x β {i β x} β (h (S i) x).
-#h #i #x #Hminx
-cases (decidable_le (S i) x) #Hix
- [cases (true_or_false (termb i x (h (S i) x))) #Hcase
- [@termb_true_to_term //
- |<Hminx in Hcase; #H lapply (fmin_false (Ξ»x.termb i x (h (S i) x)) (x-i) (S i) H)
- >min_input_def in Hminx; #Hminx >Hminx in β’ (%β?);
- <plus_n_Sm <plus_minus_m_m [2: @lt_to_le //]
- #Habs @False_ind /2/
- ]
- |@False_ind >min_input_i in Hminx;
- [#eqix >eqix in Hix; * /2/ | @le_S_S_to_le @not_le_to_lt //]
- ]
-qed.
-
-lemma min_input_to_lt: βh,i,x.
- min_input h i x = x β i < x.
-#h #i #x #Hminx cases (decidable_le (S i) x) //
-#ltxi @False_ind >min_input_i in Hminx;
- [#eqix >eqix in ltxi; * /2/ | @le_S_S_to_le @not_le_to_lt //]
-qed.
-
-lemma le_to_min_input: βh,i,x,x1. x β€ x1 β
- min_input h i x = x β min_input h i x1 = x.
-#h #i #x #x1 #lex #Hminx @(min_exists β¦ (le_S_S β¦ lex))
- [@(fmin_true β¦ (sym_eq β¦ Hminx)) //
- |@(min_input_to_lt β¦ Hminx)
- |#j #H1 <Hminx @lt_min_to_false //
- |@plus_minus_m_m @le_S_S @(transitive_le β¦ lex) @lt_to_le
- @(min_input_to_lt β¦ Hminx)
- ]
-qed.
-
-definition g β Ξ»h,u,x.
- S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
-
-lemma g_def : βh,u,x. g h u x =
- S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
-// qed.
-
-lemma le_u_to_g_1 : βh,u,x. x β€ u β g h u x = 1.
-#h #u #x #lexu >g_def cut (x-u = 0) [/2 by minus_le_minus_minus_comm/]
-#eq0 >eq0 normalize // qed.
-
-lemma g_lt : βh,i,x. min_input h i x = x β
- out i x (h (S i) x) < g h 0 x.
-#h #i #x #H @le_S_S @(le_MaxI β¦ i) /2 by min_input_to_lt/
-qed.
-
-lemma max_neq0 : βa,b. max a b β 0 β a β 0 β¨ b β 0.
-#a #b whd in match (max a b); cases (true_or_false (leb a b)) #Hcase >Hcase
- [#H %2 @H | #H %1 @H]
-qed.
-
-definition almost_equal β Ξ»f,g:nat β nat. Β¬ βnu.βx. nu < x β§ f x β g x.
-interpretation "almost equal" 'napart f g = (almost_equal f g).
-
-lemma eventually_cancelled: βh,u.Β¬βnu.βx. nu < x β§
- max_{i β [0,u[ | eqb (min_input h i x) x} (out i x (h (S i) x)) β 0.
-#h #u elim u
- [normalize % #H cases (H u) #x * #_ * #H1 @H1 //
- |#u0 @not_to_not #Hind #nu cases (Hind nu) #x * #ltx
- cases (true_or_false (eqb (min_input h (u0+O) x) x)) #Hcase
- [>bigop_Strue [2:@Hcase] #Hmax cases (max_neq0 β¦ Hmax) -Hmax
- [2: #H %{x} % // <minus_n_O @H]
- #Hneq0 (* if x is not enough we retry with nu=x *)
- cases (Hind x) #x1 * #ltx1
- >bigop_Sfalse
- [#H %{x1} % [@transitive_lt //| <minus_n_O @H]
- |@not_eq_to_eqb_false >(le_to_min_input β¦ (eqb_true_to_eq β¦ Hcase))
- [@lt_to_not_eq @ltx1 | @lt_to_le @ltx1]
- ]
- |>bigop_Sfalse [2:@Hcase] #H %{x} % // <minus_n_O @H
- ]
- ]
-qed.
-
-lemma condition_1: βh,u.g h 0 β g h u.
-#h #u @(not_to_not β¦ (eventually_cancelled h u))
-#H #nu cases (H (max u nu)) #x * #ltx #Hdiff
-%{x} % [@(le_to_lt_to_lt β¦ ltx) @(le_maxr β¦ (le_n β¦))] @(not_to_not β¦ Hdiff)
-#H @(eq_f ?? S) >(bigop_sumI 0 u x (Ξ»i:β.eqb (min_input h i x) x) nat 0 MaxA)
- [>H // |@lt_to_le @(le_to_lt_to_lt β¦ltx) /2 by le_maxr/ |//]
-qed.
-
-(******************************** Condition 2 *********************************)
-definition total β Ξ»f.Ξ»x:nat. Some nat (f x).
-
-lemma exists_to_exists_min: βh,i. (βx. i < x β§ {i β x} β h (S i) x) β βy. min_input h i y = y.
-#h #i * #x * #ltix #Hx %{(min_input h i x)} @min_spec_to_min @found //
- [@(f_min_true (Ξ»y:β.termb i y (h (S i) y))) %{x} % [% // | @term_to_termb_true //]
- |#y #leiy #lty @(lt_min_to_false ????? lty) //
- ]
-qed.
-
-lemma condition_2: βh,i. code_for (total (g h 0)) i β Β¬βx. i<x β§ {i β x} β h (S i) x.
-#h #i whd in β’(%β?); #H % #H1 cases (exists_to_exists_min β¦ H1) #y #Hminy
-lapply (g_lt β¦ Hminy)
-lapply (min_input_to_terminate β¦ Hminy) * #r #termy
-cases (H y) -H #ny #Hy
-cut (r = g h 0 y) [@(unique_U β¦ ny β¦ termy) @Hy //] #Hr
-whd in match (out ???); >termy >Hr
-#H @(absurd ? H) @le_to_not_lt @le_n
-qed.
-
-
-(********************************* complexity *********************************)
-
-(* We assume operations have a minimal structural complexity MSC.
-For instance, for time complexity, MSC is equal to the size of input.
-For space complexity, MSC is typically 0, since we only measure the
-space required in addition to dimension of the input. *)
-
-axiom MSC : nat β nat.
-axiom MSC_le: βn. MSC n β€ n.
-axiom monotonic_MSC: monotonic ? le MSC.
-axiom MSC_pair: βa,b. MSC β©a,bβͺ β€ MSC a + MSC b.
-
-(* C s i means i is running in O(s) *)
-
-definition C β Ξ»s,i.βc.βa.βx.a β€ x β βy.
- U i x (c*(s x)) = Some ? y.
-
-(* C f s means f β O(s) where MSC βO(s) *)
-definition CF β Ξ»s,f.O s MSC β§ βi.code_for (total f) i β§ C s i.
-
-lemma ext_CF : βf,g,s. (βn. f n = g n) β CF s f β CF s g.
-#f #g #s #Hext * #HO * #i * #Hcode #HC % // %{i} %
- [#x cases (Hcode x) #a #H %{a} whd in match (total ??); <Hext @H | //]
-qed.
-
-lemma monotonic_CF: βs1,s2,f.(βx. s1 x β€ s2 x) β CF s1 f β CF s2 f.
-#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
- [cases HO #c * #a -HO #HO %{c} %{a} #n #lean @(transitive_le β¦ (HO n lean))
- @le_times //
- |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1 %{c} %{a} #n #lean
- cases(Hs1 n lean) #y #Hy %{y} @(monotonic_U β¦Hy) @le_times //
- ]
-qed.
-
-lemma O_to_CF: βs1,s2,f.O s2 s1 β CF s1 f β CF s2 f.
-#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
- [@(O_trans β¦ H) //
- |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1
- cases H #c1 * #a1 #Ha1 %{(c*c1)} %{(a+a1)} #n #lean
- cases(Hs1 n ?) [2:@(transitive_le β¦ lean) //] #y #Hy %{y} @(monotonic_U β¦Hy)
- >associative_times @le_times // @Ha1 @(transitive_le β¦ lean) //
- ]
-qed.
-
-lemma timesc_CF: βs,f,c.CF (Ξ»x.c*s x) f β CF s f.
-#s #f #c @O_to_CF @O_times_c
-qed.
-
-(********************************* composition ********************************)
-axiom CF_comp: βf,g,sf,sg,sh. CF sg g β CF sf f β
- O sh (Ξ»x. sg x + sf (g x)) β CF sh (f β g).
-
-lemma CF_comp_ext: βf,g,h,sh,sf,sg. CF sg g β CF sf f β
- (βx.f(g x) = h x) β O sh (Ξ»x. sg x + sf (g x)) β CF sh h.
-#f #g #h #sh #sf #sg #Hg #Hf #Heq #H @(ext_CF (f β g))
- [#n normalize @Heq | @(CF_comp β¦ H) //]
-qed.
-
-
-(**************************** primitive operations*****************************)
-
-definition id β Ξ»x:nat.x.
-
-axiom CF_id: CF MSC id.
-axiom CF_compS: βh,f. CF h f β CF h (S β f).
-axiom CF_comp_fst: βh,f. CF h f β CF h (fst β f).
-axiom CF_comp_snd: βh,f. CF h f β CF h (snd β f).
-axiom CF_comp_pair: βh,f,g. CF h f β CF h g β CF h (Ξ»x. β©f x,g xβͺ).
-
-lemma CF_fst: CF MSC fst.
-@(ext_CF (fst β id)) [#n //] @(CF_comp_fst β¦ CF_id)
-qed.
-
-lemma CF_snd: CF MSC snd.
-@(ext_CF (snd β id)) [#n //] @(CF_comp_snd β¦ CF_id)
-qed.
-
-(************************************** eqb ***********************************)
-
-axiom CF_eqb: βh,f,g.
- CF h f β CF h g β CF h (Ξ»x.eqb (f x) (g x)).
-
-(*********************************** maximum **********************************)
-
-axiom CF_max: βa,b.βp:nat βbool.βf,ha,hb,hp,hf,s.
- CF ha a β CF hb b β CF hp p β CF hf f β
- O s (Ξ»x.ha x + hb x + β_{i β[a x ,b x[ }(hp β©i,xβͺ + hf β©i,xβͺ)) β
- CF s (Ξ»x.max_{i β[a x,b x[ | p β©i,xβͺ }(f β©i,xβͺ)).
-
-(******************************** minimization ********************************)
-
-axiom CF_mu: βa,b.βf:nat βbool.βsa,sb,sf,s.
- CF sa a β CF sb b β CF sf f β
- O s (Ξ»x.sa x + sb x + β_{i β[a x ,S(b x)[ }(sf β©i,xβͺ)) β
- CF s (Ξ»x.ΞΌ_{i β[a x,b x] }(f β©i,xβͺ)).
-
-(************************************* smn ************************************)
-axiom smn: βf,s. CF s f β βx. CF (Ξ»y.s β©x,yβͺ) (Ξ»y.f β©x,yβͺ).
-
-(****************************** constructibility ******************************)
-
-definition constructible β Ξ»s. CF s s.
-
-lemma constr_comp : βs1,s2. constructible s1 β constructible s2 β
- (βx. x β€ s2 x) β constructible (s2 β s1).
-#s1 #s2 #Hs1 #Hs2 #Hle @(CF_comp β¦ Hs1 Hs2) @O_plus @le_to_O #x [@Hle | //]
-qed.
-
-lemma ext_constr: βs1,s2. (βx.s1 x = s2 x) β
- constructible s1 β constructible s2.
-#s1 #s2 #Hext #Hs1 @(ext_CF β¦ Hext) @(monotonic_CF β¦ Hs1) #x >Hext //
-qed.
-
-(********************************* simulation *********************************)
-
-axiom sU : nat β nat.
-
-axiom monotonic_sU: βi1,i2,x1,x2,s1,s2. i1 β€ i2 β x1 β€ x2 β s1 β€ s2 β
- sU β©i1,β©x1,s1βͺβͺ β€ sU β©i2,β©x2,s2βͺβͺ.
-
-lemma monotonic_sU_aux : βx1,x2. fst x1 β€ fst x2 β fst (snd x1) β€ fst (snd x2) β
-snd (snd x1) β€ snd (snd x2) β sU x1 β€ sU x2.
-#x1 #x2 cases (surj_pair x1) #a1 * #y #eqx1 >eqx1 -eqx1 cases (surj_pair y)
-#b1 * #c1 #eqy >eqy -eqy
-cases (surj_pair x2) #a2 * #y2 #eqx2 >eqx2 -eqx2 cases (surj_pair y2)
-#b2 * #c2 #eqy2 >eqy2 -eqy2 >fst_pair >snd_pair >fst_pair >snd_pair
->fst_pair >snd_pair >fst_pair >snd_pair @monotonic_sU
-qed.
-
-axiom sU_le: βi,x,s. s β€ sU β©i,β©x,sβͺβͺ.
-axiom sU_le_i: βi,x,s. MSC i β€ sU β©i,β©x,sβͺβͺ.
-axiom sU_le_x: βi,x,s. MSC x β€ sU β©i,β©x,sβͺβͺ.
-
-definition pU_unary β Ξ»p. pU (fst p) (fst (snd p)) (snd (snd p)).
-
-axiom CF_U : CF sU pU_unary.
-
-definition termb_unary β Ξ»x:β.termb (fst x) (fst (snd x)) (snd (snd x)).
-definition out_unary β Ξ»x:β.out (fst x) (fst (snd x)) (snd (snd x)).
-
-lemma CF_termb: CF sU termb_unary.
-@(ext_CF (fst β pU_unary)) [2: @CF_comp_fst @CF_U]
-#n whd in β’ (??%?); whd in β’ (??(?%)?); >fst_pair %
-qed.
-
-lemma CF_out: CF sU out_unary.
-@(ext_CF (snd β pU_unary)) [2: @CF_comp_snd @CF_U]
-#n whd in β’ (??%?); whd in β’ (??(?%)?); >snd_pair %
-qed.
-
-
-(******************** complexity of g ********************)
-
-definition unary_g β Ξ»h.Ξ»ux. g h (fst ux) (snd ux).
-definition auxg β
- Ξ»h,ux. max_{i β[fst ux,snd ux[ | eqb (min_input h i (snd ux)) (snd ux)}
- (out i (snd ux) (h (S i) (snd ux))).
-
-lemma compl_g1 : βh,s. CF s (auxg h) β CF s (unary_g h).
-#h #s #H1 @(CF_compS ? (auxg h) H1)
-qed.
-
-definition aux1g β
- Ξ»h,ux. max_{i β[fst ux,snd ux[ | (Ξ»p. eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β©i,uxβͺ}
- ((Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β©i,uxβͺ).
-
-lemma eq_aux : βh,x.aux1g h x = auxg h x.
-#h #x @same_bigop
- [#n #_ >fst_pair >snd_pair // |#n #_ #_ >fst_pair >snd_pair //]
-qed.
-
-lemma compl_g2 : βh,s1,s2,s.
- CF s1
- (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β
- CF s2
- (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β
- O s (Ξ»x.MSC x + β_{i β[fst x ,snd x[ }(s1 β©i,xβͺ+s2 β©i,xβͺ)) β
- CF s (auxg h).
-#h #s1 #s2 #s #Hs1 #Hs2 #HO @(ext_CF (aux1g h))
- [#n whd in β’ (??%%); @eq_aux]
-@(CF_max β¦ CF_fst CF_snd Hs1 Hs2 β¦) @(O_trans β¦ HO)
-@O_plus [@O_plus @O_plus_l // | @O_plus_r //]
-qed.
-
-lemma compl_g3 : βh,s.
- CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))) β
- CF s (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))).
-#h #s #H @(CF_eqb β¦ H) @(CF_comp β¦ CF_snd CF_snd) @(O_trans β¦ (proj1 β¦ H))
-@O_plus // %{1} %{0} #n #_ >commutative_times <times_n_1 @monotonic_MSC //
-qed.
-
-definition min_input_aux β Ξ»h,p.
- ΞΌ_{y β [S (fst p),snd (snd p)] }
- ((Ξ»x.termb (fst (snd x)) (fst x) (h (S (fst (snd x))) (fst x))) β©y,pβͺ).
-
-lemma min_input_eq : βh,p.
- min_input_aux h p =
- min_input h (fst p) (snd (snd p)).
-#h #p >min_input_def whd in β’ (??%?); >minus_S_S @min_f_g #i #_ #_
-whd in β’ (??%%); >fst_pair >snd_pair //
-qed.
-
-definition termb_aux β Ξ»h.
- termb_unary β Ξ»p.β©fst (snd p),β©fst p,h (S (fst (snd p))) (fst p)βͺβͺ.
-
-lemma compl_g4 : βh,s1,s.
- (CF s1
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
- (O s (Ξ»x.MSC x + β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ))) β
- CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #s1 #s #Hs1 #HO @(ext_CF (min_input_aux h))
- [#n whd in β’ (??%%); @min_input_eq]
-@(CF_mu β¦ MSC MSC β¦ Hs1)
- [@CF_compS @CF_fst
- |@CF_comp_snd @CF_snd
- |@(O_trans β¦ HO) @O_plus [@O_plus @O_plus_l // | @O_plus_r //]
-qed.
-
-(************************* a couple of technical lemmas ***********************)
-lemma minus_to_0: βa,b. a β€ b β minus a b = 0.
-#a elim a // #n #Hind *
- [#H @False_ind /2 by absurd/ | #b normalize #H @Hind @le_S_S_to_le /2/]
-qed.
-
-lemma sigma_bound: βh,a,b. monotonic nat le h β
- β_{i β [a,S b[ }(h i) β€ (S b-a)*h b.
-#h #a #b #H cases (decidable_le a b)
- [#leab cut (b = pred (S b - a + a))
- [<plus_minus_m_m // @le_S //] #Hb >Hb in match (h b);
- generalize in match (S b -a);
- #n elim n
- [//
- |#m #Hind >bigop_Strue [2://] @le_plus
- [@H @le_n |@(transitive_le β¦ Hind) @le_times [//] @H //]
- ]
- |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
- cut (S b -a = 0) [@minus_to_0 //] #Hcut >Hcut //
- ]
-qed.
-
-lemma sigma_bound_decr: βh,a,b. (βa1,a2. a1 β€ a2 β a2 < b β h a2 β€ h a1) β
- β_{i β [a,b[ }(h i) β€ (b-a)*h a.
-#h #a #b #H cases (decidable_le a b)
- [#leab cut ((b -a) +a β€ b) [/2 by le_minus_to_plus_r/] generalize in match (b -a);
- #n elim n
- [//
- |#m #Hind >bigop_Strue [2://] #Hm
- cut (m+a β€ b) [@(transitive_le β¦ Hm) //] #Hm1
- @le_plus [@H // |@(transitive_le β¦ (Hind Hm1)) //]
- ]
- |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
- cut (b -a = 0) [@minus_to_0 @lt_to_le @ltba] #Hcut >Hcut //
- ]
-qed.
-
-lemma coroll: βs1:natβnat. (βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
-O (Ξ»x.(snd (snd x)-fst x)*(s1 β©snd (snd x),xβͺ))
- (Ξ»x.β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ)).
-#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
-@(transitive_le β¦ (sigma_bound β¦)) [@Hs1|>minus_S_S //]
-qed.
-
-lemma coroll2: βs1:natβnat. (βn,a,b. a β€ b β b < snd n β s1 β©b,nβͺ β€ s1 β©a,nβͺ) β
-O (Ξ»x.(snd x - fst x)*s1 β©fst x,xβͺ) (Ξ»x.β_{i β[fst x,snd x[ }(s1 β©i,xβͺ)).
-#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
-@(transitive_le β¦ (sigma_bound_decr β¦)) [2://] @Hs1
-qed.
-
-(**************************** end of technical lemmas *************************)
-
-lemma compl_g5 : βh,s1.(βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
- (CF s1
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
- CF (Ξ»x.MSC x + (snd (snd x)-fst x)*s1 β©snd (snd x),xβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #s1 #Hmono #Hs1 @(compl_g4 β¦ Hs1) @O_plus
-[@O_plus_l // |@O_plus_r @coroll @Hmono]
-qed.
-
-lemma compl_g6: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (CF (Ξ»x. sU β©max (fst (snd x)) (snd (snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ)
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))).
-#h #hconstr @(ext_CF (termb_aux h))
- [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
-@(CF_comp β¦ (Ξ»x.MSC x + h (S (fst (snd x))) (fst x)) β¦ CF_termb)
- [@CF_comp_pair
- [@CF_comp_fst @(monotonic_CF β¦ CF_snd) #x //
- |@CF_comp_pair
- [@(monotonic_CF β¦ CF_fst) #x //
- |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst (snd x)),fst xβͺ)))
- [#n normalize >fst_pair >snd_pair %]
- @(CF_comp β¦ MSC β¦hconstr)
- [@CF_comp_pair [@CF_compS @CF_comp_fst // |//]
- |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
- ]
- ]
- ]
- |@O_plus
- [@O_plus
- [@(O_trans β¦ (Ξ»x.MSC (fst x) + MSC (max (fst (snd x)) (snd (snd x)))))
- [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- >distributive_times_plus @le_plus [//]
- cases (surj_pair b) #c * #d #eqb >eqb
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- whd in β’ (??%); @le_plus
- [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
- |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
- ]
- |@O_plus [@le_to_O #x @sU_le_x |@le_to_O #x @sU_le_i]
- ]
- |@le_to_O #n @sU_le
- ]
- |@le_to_O #x @monotonic_sU // @(le_maxl β¦ (le_n β¦)) ]
- ]
-qed.
-
-definition big : nat βnat β Ξ»x.
- let m β max (fst x) (snd x) in β©m,mβͺ.
-
-lemma big_def : βa,b. big β©a,bβͺ = β©max a b,max a bβͺ.
-#a #b normalize >fst_pair >snd_pair // qed.
-
-lemma le_big : βx. x β€ big x.
-#x cases (surj_pair x) #a * #b #eqx >eqx @le_pair >fst_pair >snd_pair
-[@(le_maxl β¦ (le_n β¦)) | @(le_maxr β¦ (le_n β¦))]
-qed.
-
-definition faux2 β Ξ»h.
- (Ξ»x.MSC x + (snd (snd x)-fst x)*
- (Ξ»x.sU β©max (fst(snd x)) (snd(snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ) β©snd (snd x),xβͺ).
-
-lemma compl_g7: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- CF (Ξ»x.MSC x + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #hcostr #hmono @(monotonic_CF β¦ (faux2 h))
- [#n normalize >fst_pair >snd_pair //]
-@compl_g5 [2:@(compl_g6 h hcostr)] #n #x #y #lexy >fst_pair >snd_pair
->fst_pair >snd_pair @monotonic_sU // @hmono @lexy
-qed.
-
-lemma compl_g71: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- CF (Ξ»x.MSC (big x) + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #hcostr #hmono @(monotonic_CF β¦ (compl_g7 h hcostr hmono)) #x
-@le_plus [@monotonic_MSC //]
-cases (decidable_le (fst x) (snd(snd x)))
- [#Hle @le_times // @monotonic_sU
- |#Hlt >(minus_to_0 β¦ (lt_to_le β¦ )) [// | @not_le_to_lt @Hlt]
- ]
-qed.
-
-definition out_aux β Ξ»h.
- out_unary β Ξ»p.β©fst p,β©snd(snd p),h (S (fst p)) (snd (snd p))βͺβͺ.
-
-lemma compl_g8: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (CF (Ξ»x. sU β©max (fst x) (snd x),β©snd(snd x),h (S (fst x)) (snd(snd x))βͺβͺ)
- (Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p))))).
-#h #hconstr @(ext_CF (out_aux h))
- [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
-@(CF_comp β¦ (Ξ»x.h (S (fst x)) (snd(snd x)) + MSC x) β¦ CF_out)
- [@CF_comp_pair
- [@(monotonic_CF β¦ CF_fst) #x //
- |@CF_comp_pair
- [@CF_comp_snd @(monotonic_CF β¦ CF_snd) #x //
- |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst x),snd(snd x)βͺ)))
- [#n normalize >fst_pair >snd_pair %]
- @(CF_comp β¦ MSC β¦hconstr)
- [@CF_comp_pair [@CF_compS // | @CF_comp_snd // ]
- |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
- ]
- ]
- ]
- |@O_plus
- [@O_plus
- [@le_to_O #n @sU_le
- |@(O_trans β¦ (Ξ»x.MSC (max (fst x) (snd x))))
- [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- whd in β’ (??%); @le_plus
- [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
- |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
- ]
- |@le_to_O #x @(transitive_le ???? (sU_le_i β¦ )) //
- ]
- ]
- |@le_to_O #x @monotonic_sU [@(le_maxl β¦ (le_n β¦))|//|//]
- ]
-qed.
-
-lemma compl_g9 : βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
- CF (Ξ»x. (S (snd x-fst x))*MSC β©x,xβͺ +
- (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ)
- (auxg h).
-#h #hconstr #hmono #hantimono
-@(compl_g2 h ??? (compl_g3 β¦ (compl_g71 h hconstr hmono)) (compl_g8 h hconstr))
-@O_plus
- [@O_plus_l @le_to_O #x >(times_n_1 (MSC x)) >commutative_times @le_times
- [// | @monotonic_MSC // ]]
-@(O_trans β¦ (coroll2 ??))
- [#n #a #b #leab #ltb >fst_pair >fst_pair >snd_pair >snd_pair
- cut (b β€ n) [@(transitive_le β¦ (le_snd β¦)) @lt_to_le //] #lebn
- cut (max a n = n)
- [normalize >le_to_leb_true [//|@(transitive_le β¦ leab lebn)]] #maxa
- cut (max b n = n) [normalize >le_to_leb_true //] #maxb
- @le_plus
- [@le_plus [>big_def >big_def >maxa >maxb //]
- @le_times
- [/2 by monotonic_le_minus_r/
- |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
- ]
- |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
- ]
- |@le_to_O #n >fst_pair >snd_pair
- cut (max (fst n) n = n) [normalize >le_to_leb_true //] #Hmax >Hmax
- >associative_plus >distributive_times_plus
- @le_plus [@le_times [@le_S // |>big_def >Hmax //] |//]
- ]
-qed.
-
-definition sg β Ξ»h,x.
- (S (snd x-fst x))*MSC β©x,xβͺ + (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ.
-
-lemma sg_def : βh,a,b.
- sg h β©a,bβͺ = (S (b-a))*MSC β©β©a,bβͺ,β©a,bβͺβͺ +
- (b-a)*(S(b-a))*sU β©β©a,bβͺ,β©b,h (S a) bβͺβͺ.
-#h #a #b whd in β’ (??%?); >fst_pair >snd_pair //
-qed.
-
-lemma compl_g11 : βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
- CF (sg h) (unary_g h).
-#h #hconstr #Hm #Ham @compl_g1 @(compl_g9 h hconstr Hm Ham)
-qed.
-
-(**************************** closing the argument ****************************)
-
-let rec h_of_aux (r:nat βnat) (c,d,b:nat) on d : nat β
- match d with
- [ O β c
- | S d1 β (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
- d*(S d)*sU β©β©b-d,bβͺ,β©b,r (h_of_aux r c d1 b)βͺβͺ].
-
-lemma h_of_aux_O: βr,c,b.
- h_of_aux r c O b = c.
-// qed.
-
-lemma h_of_aux_S : βr,c,d,b.
- h_of_aux r c (S d) b =
- (S (S d))*(MSC β©β©b-(S d),bβͺ,β©b-(S d),bβͺβͺ) +
- (S d)*(S (S d))*sU β©β©b-(S d),bβͺ,β©b,r(h_of_aux r c d b)βͺβͺ.
-// qed.
-
-definition h_of β Ξ»r,p.
- let m β max (fst p) (snd p) in
- h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (snd p - fst p) (snd p).
-
-lemma h_of_O: βr,a,b. b β€ a β
- h_of r β©a,bβͺ = let m β max a b in MSC β©β©m,mβͺ,β©m,mβͺβͺ.
-#r #a #b #Hle normalize >fst_pair >snd_pair >(minus_to_0 β¦ Hle) //
-qed.
-
-lemma h_of_def: βr,a,b.h_of r β©a,bβͺ =
- let m β max a b in
- h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (b - a) b.
-#r #a #b normalize >fst_pair >snd_pair //
-qed.
-
-lemma mono_h_of_aux: βr.(βx. x β€ r x) β monotonic ? le r β
- βd,d1,c,c1,b,b1.c β€ c1 β d β€ d1 β b β€ b1 β
- h_of_aux r c d b β€ h_of_aux r c1 d1 b1.
-#r #Hr #monor #d #d1 lapply d -d elim d1
- [#d #c #c1 #b #b1 #Hc #Hd @(le_n_O_elim ? Hd) #leb
- >h_of_aux_O >h_of_aux_O //
- |#m #Hind #d #c #c1 #b #b1 #lec #led #leb cases (le_to_or_lt_eq β¦ led)
- [#ltd @(transitive_le β¦ (Hind β¦ lec ? leb)) [@le_S_S_to_le @ltd]
- >h_of_aux_S @(transitive_le ???? (le_plus_n β¦))
- >(times_n_1 (h_of_aux r c1 m b1)) in β’ (?%?);
- >commutative_times @le_times [//|@(transitive_le β¦ (Hr ?)) @sU_le]
- |#Hd >Hd >h_of_aux_S >h_of_aux_S
- cut (b-S m β€ b1 - S m) [/2 by monotonic_le_minus_l/] #Hb1
- @le_plus [@le_times //]
- [@monotonic_MSC @le_pair @le_pair //
- |@le_times [//] @monotonic_sU
- [@le_pair // |// |@monor @Hind //]
- ]
- ]
- ]
-qed.
-
-lemma mono_h_of2: βr.(βx. x β€ r x) β monotonic ? le r β
- βi,b,b1. b β€ b1 β h_of r β©i,bβͺ β€ h_of r β©i,b1βͺ.
-#r #Hr #Hmono #i #a #b #leab >h_of_def >h_of_def
-cut (max i a β€ max i b)
- [@to_max
- [@(le_maxl β¦ (le_n β¦))|@(transitive_le β¦ leab) @(le_maxr β¦ (le_n β¦))]]
-#Hmax @(mono_h_of_aux r Hr Hmono)
- [@monotonic_MSC @le_pair @le_pair @Hmax |/2 by monotonic_le_minus_l/ |@leab]
-qed.
-
-axiom h_of_constr : βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- constructible (h_of r).
-
-lemma speed_compl: βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- CF (h_of r) (unary_g (Ξ»i,x. r(h_of r β©i,xβͺ))).
-#r #Hr #Hmono #Hconstr @(monotonic_CF β¦ (compl_g11 β¦))
- [#x cases (surj_pair x) #a * #b #eqx >eqx
- >sg_def cases (decidable_le b a)
- [#leba >(minus_to_0 β¦ leba) normalize in β’ (?%?);
- <plus_n_O <plus_n_O >h_of_def
- cut (max a b = a)
- [normalize cases (le_to_or_lt_eq β¦ leba)
- [#ltba >(lt_to_leb_false β¦ ltba) %
- |#eqba <eqba >(le_to_leb_true β¦ (le_n ?)) % ]]
- #Hmax >Hmax normalize >(minus_to_0 β¦ leba) normalize
- @monotonic_MSC @le_pair @le_pair //
- |#ltab >h_of_def >h_of_def
- cut (max a b = b)
- [normalize >(le_to_leb_true β¦ ) [%] @lt_to_le @not_le_to_lt @ltab]
- #Hmax >Hmax
- cut (max (S a) b = b)
- [whd in β’ (??%?); >(le_to_leb_true β¦ ) [%] @not_le_to_lt @ltab]
- #Hmax1 >Hmax1
- cut (βd.b - a = S d)
- [%{(pred(b-a))} >S_pred [//] @lt_plus_to_minus_r @not_le_to_lt @ltab]
- * #d #eqd >eqd
- cut (b-S a = d) [//] #eqd1 >eqd1 >h_of_aux_S >eqd1
- cut (b - S d = a)
- [@plus_to_minus >commutative_plus @minus_to_plus
- [@lt_to_le @not_le_to_lt // | //]] #eqd2 >eqd2
- normalize //
- ]
- |#n #a #b #leab #lebn >h_of_def >h_of_def
- cut (max a n = n)
- [normalize >le_to_leb_true [%|@(transitive_le β¦ leab lebn)]] #Hmaxa
- cut (max b n = n)
- [normalize >(le_to_leb_true β¦ lebn) %] #Hmaxb
- >Hmaxa >Hmaxb @Hmono @(mono_h_of_aux r β¦ Hr Hmono) // /2 by monotonic_le_minus_r/
- |#n #a #b #leab @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ leab)
- |@(constr_comp β¦ Hconstr Hr) @(ext_constr (h_of r))
- [#x cases (surj_pair x) #a * #b #eqx >eqx >fst_pair >snd_pair //]
- @(h_of_constr r Hr Hmono Hconstr)
- ]
-qed.
-
-lemma speed_compl_i: βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- βi. CF (Ξ»x.h_of r β©i,xβͺ) (Ξ»x.g (Ξ»i,x. r(h_of r β©i,xβͺ)) i x).
-#r #Hr #Hmono #Hconstr #i
-@(ext_CF (Ξ»x.unary_g (Ξ»i,x. r(h_of r β©i,xβͺ)) β©i,xβͺ))
- [#n whd in β’ (??%%); @eq_f @sym_eq >fst_pair >snd_pair %]
-@smn @(ext_CF β¦ (speed_compl r Hr Hmono Hconstr)) #n //
-qed.
-
-(**************************** the speedup theorem *****************************)
-theorem pseudo_speedup:
- βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
- βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§ O sf (r β sg).
-(* βm,a.βn. aβ€n β r(sg a) < m * sf n. *)
-#r #Hr #Hmono #Hconstr
-(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
-#Hcodei #HCi
-(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
-(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
-%{(Ξ»x. h_of r β©S i,xβͺ)}
-lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
-%[%[@condition_1 |@Hg]
- |cases Hg #H1 * #j * #Hcodej #HCj
- lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
- cases HCi #m * #a #Ha %{m} %{(max (S i) a)} #n #ltin @lt_to_le @not_le_to_lt
- @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf %{n} %
- [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
- cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
- #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf) //
- ]
-qed.
-
-theorem pseudo_speedup':
- βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
- βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§
- (* Β¬ O (r β sg) sf. *)
- βm,a.βn. aβ€n β r(sg a) < m * sf n.
-#r #Hr #Hmono #Hconstr
-(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
-#Hcodei #HCi
-(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
-(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
-%{(Ξ»x. h_of r β©S i,xβͺ)}
-lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
-%[%[@condition_1 |@Hg]
- |cases Hg #H1 * #j * #Hcodej #HCj
- lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
- cases HCi #m * #a #Ha
- %{m} %{(max (S i) a)} #n #ltin @not_le_to_lt @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf
- %{n} % [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
- cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
- #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf)
- @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ ltin)
- ]
-qed.
-
+++ /dev/null
-include "basics/types.ma".
-include "arithmetics/minimization.ma".
-include "arithmetics/bigops.ma".
-include "arithmetics/sigma_pi.ma".
-include "arithmetics/bounded_quantifiers.ma".
-include "reverse_complexity/big_O.ma".
-include "basics/core_notation/napart_2.ma".
-
-(************************* notation for minimization *****************************)
-notation "ΞΌ_{ ident i < n } p"
- with precedence 80 for @{min $n 0 (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β€ n } p"
- with precedence 80 for @{min (S $n) 0 (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β [a,b[ } p"
- with precedence 80 for @{min ($b-$a) $a (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β [a,b] } p"
- with precedence 80 for @{min (S $b-$a) $a (Ξ»${ident i}.$p)}.
-
-(************************************ MAX *************************************)
-notation "Max_{ ident i < n | p } f"
- with precedence 80
-for @{'bigop $n max 0 (Ξ»${ident i}. $p) (Ξ»${ident i}. $f)}.
-
-notation "Max_{ ident i < n } f"
- with precedence 80
-for @{'bigop $n max 0 (Ξ»${ident i}.true) (Ξ»${ident i}. $f)}.
-
-notation "Max_{ ident j β [a,b[ } f"
- with precedence 80
-for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.true) (${ident j}+$a)))
- (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
-
-notation "Max_{ ident j β [a,b[ | p } f"
- with precedence 80
-for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.$p) (${ident j}+$a)))
- (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
-
-lemma Max_assoc: βa,b,c. max (max a b) c = max a (max b c).
-#a #b #c normalize cases (true_or_false (leb a b)) #leab >leab normalize
- [cases (true_or_false (leb b c )) #lebc >lebc normalize
- [>(le_to_leb_true a c) // @(transitive_le ? b) @leb_true_to_le //
- |>leab //
- ]
- |cases (true_or_false (leb b c )) #lebc >lebc normalize //
- >leab normalize >(not_le_to_leb_false a c) // @lt_to_not_le
- @(transitive_lt ? b) @not_le_to_lt @leb_false_to_not_le //
- ]
-qed.
-
-lemma Max0 : βn. max 0 n = n.
-// qed.
-
-lemma Max0r : βn. max n 0 = n.
-#n >commutative_max //
-qed.
-
-definition MaxA β
- mk_Aop nat 0 max Max0 Max0r (Ξ»a,b,c.sym_eq β¦ (Max_assoc a b c)).
-
-definition MaxAC β mk_ACop nat 0 MaxA commutative_max.
-
-lemma le_Max: βf,p,n,a. a < n β p a = true β
- f a β€ Max_{i < n | p i}(f i).
-#f #p #n #a #ltan #pa
->(bigop_diff p ? 0 MaxAC f a n) // @(le_maxl β¦ (le_n ?))
-qed.
-
-lemma le_MaxI: βf,p,n,m,a. m β€ a β a < n β p a = true β
- f a β€ Max_{i β [m,n[ | p i}(f i).
-#f #p #n #m #a #lema #ltan #pa
->(bigop_diff ? ? 0 MaxAC (Ξ»i.f (i+m)) (a-m) (n-m))
- [<plus_minus_m_m // @(le_maxl β¦ (le_n ?))
- |<plus_minus_m_m //
- |/2 by monotonic_lt_minus_l/
- ]
-qed.
-
-lemma Max_le: βf,p,n,b.
- (βa.a < n β p a = true β f a β€ b) β Max_{i < n | p i}(f i) β€ b.
-#f #p #n elim n #b #H //
-#b0 #H1 cases (true_or_false (p b)) #Hb
- [>bigop_Strue [2:@Hb] @to_max [@H1 // | @H #a #ltab #pa @H1 // @le_S //]
- |>bigop_Sfalse [2:@Hb] @H #a #ltab #pa @H1 // @le_S //
- ]
-qed.
-
-(********************************** pairing ***********************************)
-axiom pair: nat β nat β nat.
-axiom fst : nat β nat.
-axiom snd : nat β nat.
-
-interpretation "abstract pair" 'pair f g = (pair f g).
-
-axiom fst_pair: βa,b. fst β©a,bβͺ = a.
-axiom snd_pair: βa,b. snd β©a,bβͺ = b.
-axiom surj_pair: βx. βa,b. x = β©a,bβͺ.
-
-axiom le_fst : βp. fst p β€ p.
-axiom le_snd : βp. snd p β€ p.
-axiom le_pair: βa,a1,b,b1. a β€ a1 β b β€ b1 β β©a,bβͺ β€ β©a1,b1βͺ.
-
-(************************************* U **************************************)
-axiom U: nat β nat βnat β option nat.
-
-axiom monotonic_U: βi,x,n,m,y.n β€m β
- U i x n = Some ? y β U i x m = Some ? y.
-
-lemma unique_U: βi,x,n,m,yn,ym.
- U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
-#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
- [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
- |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
- >Hn #HS destruct (HS) //
- ]
-qed.
-
-definition code_for β Ξ»f,i.βx.
- βn.βm. n β€ m β U i x m = f x.
-
-definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
-
-notation "{i β x} β r" with precedence 60 for @{terminate $i $x $r}.
-
-lemma terminate_dec: βi,x,n. {i β x} β n β¨ Β¬ {i β x} β n.
-#i #x #n normalize cases (U i x n)
- [%2 % * #y #H destruct|#y %1 %{y} //]
-qed.
-
-lemma monotonic_terminate: βi,x,n,m.
- n β€ m β {i β x} β n β {i β x} β m.
-#i #x #n #m #lenm * #z #H %{z} @(monotonic_U β¦ H) //
-qed.
-
-definition termb β Ξ»i,x,t.
- match U i x t with [None β false |Some y β true].
-
-lemma termb_true_to_term: βi,x,t. termb i x t = true β {i β x} β t.
-#i #x #t normalize cases (U i x t) normalize [#H destruct | #y #_ %{y} //]
-qed.
-
-lemma term_to_termb_true: βi,x,t. {i β x} β t β termb i x t = true.
-#i #x #t * #y #H normalize >H //
-qed.
-
-definition out β Ξ»i,x,r.
- match U i x r with [ None β 0 | Some z β z].
-
-definition bool_to_nat: bool β nat β
- Ξ»b. match b with [true β 1 | false β 0].
-
-coercion bool_to_nat.
-
-definition pU : nat β nat β nat β nat β Ξ»i,x,r.β©termb i x r,out i x rβͺ.
-
-lemma pU_vs_U_Some : βi,x,r,y. pU i x r = β©1,yβͺ β U i x r = Some ? y.
-#i #x #r #y % normalize
- [cases (U i x r) normalize
- [#H cut (0=1) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H @H]
- #H1 destruct
- |#a #H cut (a=y) [lapply (eq_f β¦ snd β¦ H) >snd_pair >snd_pair #H1 @H1]
- #H1 //
- ]
- |#H >H //]
-qed.
-
-lemma pU_vs_U_None : βi,x,r. pU i x r = β©0,0βͺ β U i x r = None ?.
-#i #x #r % normalize
- [cases (U i x r) normalize //
- #a #H cut (1=0) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H1 @H1]
- #H1 destruct
- |#H >H //]
-qed.
-
-lemma fst_pU: βi,x,r. fst (pU i x r) = termb i x r.
-#i #x #r normalize cases (U i x r) normalize >fst_pair //
-qed.
-
-lemma snd_pU: βi,x,r. snd (pU i x r) = out i x r.
-#i #x #r normalize cases (U i x r) normalize >snd_pair //
-qed.
-
-(********************************* the speedup ********************************)
-
-definition min_input β Ξ»h,i,x. ΞΌ_{y β [S i,x] } (termb i y (h (S i) y)).
-
-lemma min_input_def : βh,i,x.
- min_input h i x = min (x -i) (S i) (Ξ»y.termb i y (h (S i) y)).
-// qed.
-
-lemma min_input_i: βh,i,x. x β€ i β min_input h i x = S i.
-#h #i #x #lexi >min_input_def
-cut (x - i = 0) [@sym_eq /2 by eq_minus_O/] #Hcut //
-qed.
-
-lemma min_input_to_terminate: βh,i,x.
- min_input h i x = x β {i β x} β (h (S i) x).
-#h #i #x #Hminx
-cases (decidable_le (S i) x) #Hix
- [cases (true_or_false (termb i x (h (S i) x))) #Hcase
- [@termb_true_to_term //
- |<Hminx in Hcase; #H lapply (fmin_false (Ξ»x.termb i x (h (S i) x)) (x-i) (S i) H)
- >min_input_def in Hminx; #Hminx >Hminx in β’ (%β?);
- <plus_n_Sm <plus_minus_m_m [2: @lt_to_le //]
- #Habs @False_ind /2/
- ]
- |@False_ind >min_input_i in Hminx;
- [#eqix >eqix in Hix; * /2/ | @le_S_S_to_le @not_le_to_lt //]
- ]
-qed.
-
-lemma min_input_to_lt: βh,i,x.
- min_input h i x = x β i < x.
-#h #i #x #Hminx cases (decidable_le (S i) x) //
-#ltxi @False_ind >min_input_i in Hminx;
- [#eqix >eqix in ltxi; * /2/ | @le_S_S_to_le @not_le_to_lt //]
-qed.
-
-lemma le_to_min_input: βh,i,x,x1. x β€ x1 β
- min_input h i x = x β min_input h i x1 = x.
-#h #i #x #x1 #lex #Hminx @(min_exists β¦ (le_S_S β¦ lex))
- [@(fmin_true β¦ (sym_eq β¦ Hminx)) //
- |@(min_input_to_lt β¦ Hminx)
- |#j #H1 <Hminx @lt_min_to_false //
- |@plus_minus_m_m @le_S_S @(transitive_le β¦ lex) @lt_to_le
- @(min_input_to_lt β¦ Hminx)
- ]
-qed.
-
-definition g β Ξ»h,u,x.
- S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
-
-lemma g_def : βh,u,x. g h u x =
- S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
-// qed.
-
-lemma le_u_to_g_1 : βh,u,x. x β€ u β g h u x = 1.
-#h #u #x #lexu >g_def cut (x-u = 0) [/2 by minus_le_minus_minus_comm/]
-#eq0 >eq0 normalize // qed.
-
-lemma g_lt : βh,i,x. min_input h i x = x β
- out i x (h (S i) x) < g h 0 x.
-#h #i #x #H @le_S_S @(le_MaxI β¦ i) /2 by min_input_to_lt/
-qed.
-
-lemma max_neq0 : βa,b. max a b β 0 β a β 0 β¨ b β 0.
-#a #b whd in match (max a b); cases (true_or_false (leb a b)) #Hcase >Hcase
- [#H %2 @H | #H %1 @H]
-qed.
-
-definition almost_equal β Ξ»f,g:nat β nat. Β¬ βnu.βx. nu < x β§ f x β g x.
-interpretation "almost equal" 'napart f g = (almost_equal f g).
-
-lemma eventually_cancelled: βh,u.Β¬βnu.βx. nu < x β§
- max_{i β [0,u[ | eqb (min_input h i x) x} (out i x (h (S i) x)) β 0.
-#h #u elim u
- [normalize % #H cases (H u) #x * #_ * #H1 @H1 //
- |#u0 @not_to_not #Hind #nu cases (Hind nu) #x * #ltx
- cases (true_or_false (eqb (min_input h (u0+O) x) x)) #Hcase
- [>bigop_Strue [2:@Hcase] #Hmax cases (max_neq0 β¦ Hmax) -Hmax
- [2: #H %{x} % // <minus_n_O @H]
- #Hneq0 (* if x is not enough we retry with nu=x *)
- cases (Hind x) #x1 * #ltx1
- >bigop_Sfalse
- [#H %{x1} % [@transitive_lt //| <minus_n_O @H]
- |@not_eq_to_eqb_false >(le_to_min_input β¦ (eqb_true_to_eq β¦ Hcase))
- [@lt_to_not_eq @ltx1 | @lt_to_le @ltx1]
- ]
- |>bigop_Sfalse [2:@Hcase] #H %{x} % // <minus_n_O @H
- ]
- ]
-qed.
-
-lemma condition_1: βh,u.g h 0 β g h u.
-#h #u @(not_to_not β¦ (eventually_cancelled h u))
-#H #nu cases (H (max u nu)) #x * #ltx #Hdiff
-%{x} % [@(le_to_lt_to_lt β¦ ltx) @(le_maxr β¦ (le_n β¦))] @(not_to_not β¦ Hdiff)
-#H @(eq_f ?? S) >(bigop_sumI 0 u x (Ξ»i:β.eqb (min_input h i x) x) nat 0 MaxA)
- [>H // |@lt_to_le @(le_to_lt_to_lt β¦ltx) /2 by le_maxr/ |//]
-qed.
-
-(******************************** Condition 2 *********************************)
-definition total β Ξ»f.Ξ»x:nat. Some nat (f x).
-
-lemma exists_to_exists_min: βh,i. (βx. i < x β§ {i β x} β h (S i) x) β βy. min_input h i y = y.
-#h #i * #x * #ltix #Hx %{(min_input h i x)} @min_spec_to_min @found //
- [@(f_min_true (Ξ»y:β.termb i y (h (S i) y))) %{x} % [% // | @term_to_termb_true //]
- |#y #leiy #lty @(lt_min_to_false ????? lty) //
- ]
-qed.
-
-lemma condition_2: βh,i. code_for (total (g h 0)) i β Β¬βx. i<x β§ {i β x} β h (S i) x.
-#h #i whd in β’(%β?); #H % #H1 cases (exists_to_exists_min β¦ H1) #y #Hminy
-lapply (g_lt β¦ Hminy)
-lapply (min_input_to_terminate β¦ Hminy) * #r #termy
-cases (H y) -H #ny #Hy
-cut (r = g h 0 y) [@(unique_U β¦ ny β¦ termy) @Hy //] #Hr
-whd in match (out ???); >termy >Hr
-#H @(absurd ? H) @le_to_not_lt @le_n
-qed.
-
-
-(********************************* complexity *********************************)
-
-(* We assume operations have a minimal structural complexity MSC.
-For instance, for time complexity, MSC is equal to the size of input.
-For space complexity, MSC is typically 0, since we only measure the
-space required in addition to dimension of the input. *)
-
-axiom MSC : nat β nat.
-axiom MSC_le: βn. MSC n β€ n.
-axiom monotonic_MSC: monotonic ? le MSC.
-axiom MSC_pair: βa,b. MSC β©a,bβͺ β€ MSC a + MSC b.
-
-(* C s i means i is running in O(s) *)
-
-definition C β Ξ»s,i.βc.βa.βx.a β€ x β βy.
- U i x (c*(s x)) = Some ? y.
-
-(* C f s means f β O(s) where MSC βO(s) *)
-definition CF β Ξ»s,f.O s MSC β§ βi.code_for (total f) i β§ C s i.
-
-lemma ext_CF : βf,g,s. (βn. f n = g n) β CF s f β CF s g.
-#f #g #s #Hext * #HO * #i * #Hcode #HC % // %{i} %
- [#x cases (Hcode x) #a #H %{a} whd in match (total ??); <Hext @H | //]
-qed.
-
-lemma monotonic_CF: βs1,s2,f.(βx. s1 x β€ s2 x) β CF s1 f β CF s2 f.
-#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
- [cases HO #c * #a -HO #HO %{c} %{a} #n #lean @(transitive_le β¦ (HO n lean))
- @le_times //
- |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1 %{c} %{a} #n #lean
- cases(Hs1 n lean) #y #Hy %{y} @(monotonic_U β¦Hy) @le_times //
- ]
-qed.
-
-lemma O_to_CF: βs1,s2,f.O s2 s1 β CF s1 f β CF s2 f.
-#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
- [@(O_trans β¦ H) //
- |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1
- cases H #c1 * #a1 #Ha1 %{(c*c1)} %{(a+a1)} #n #lean
- cases(Hs1 n ?) [2:@(transitive_le β¦ lean) //] #y #Hy %{y} @(monotonic_U β¦Hy)
- >associative_times @le_times // @Ha1 @(transitive_le β¦ lean) //
- ]
-qed.
-
-lemma timesc_CF: βs,f,c.CF (Ξ»x.c*s x) f β CF s f.
-#s #f #c @O_to_CF @O_times_c
-qed.
-
-(********************************* composition ********************************)
-axiom CF_comp: βf,g,sf,sg,sh. CF sg g β CF sf f β
- O sh (Ξ»x. sg x + sf (g x)) β CF sh (f β g).
-
-lemma CF_comp_ext: βf,g,h,sh,sf,sg. CF sg g β CF sf f β
- (βx.f(g x) = h x) β O sh (Ξ»x. sg x + sf (g x)) β CF sh h.
-#f #g #h #sh #sf #sg #Hg #Hf #Heq #H @(ext_CF (f β g))
- [#n normalize @Heq | @(CF_comp β¦ H) //]
-qed.
-
-
-(**************************** primitive operations*****************************)
-
-definition id β Ξ»x:nat.x.
-
-axiom CF_id: CF MSC id.
-axiom CF_compS: βh,f. CF h f β CF h (S β f).
-axiom CF_comp_fst: βh,f. CF h f β CF h (fst β f).
-axiom CF_comp_snd: βh,f. CF h f β CF h (snd β f).
-axiom CF_comp_pair: βh,f,g. CF h f β CF h g β CF h (Ξ»x. β©f x,g xβͺ).
-
-lemma CF_fst: CF MSC fst.
-@(ext_CF (fst β id)) [#n //] @(CF_comp_fst β¦ CF_id)
-qed.
-
-lemma CF_snd: CF MSC snd.
-@(ext_CF (snd β id)) [#n //] @(CF_comp_snd β¦ CF_id)
-qed.
-
-(************************************** eqb ***********************************)
-
-axiom CF_eqb: βh,f,g.
- CF h f β CF h g β CF h (Ξ»x.eqb (f x) (g x)).
-
-(*********************************** maximum **********************************)
-
-axiom CF_max: βa,b.βp:nat βbool.βf,ha,hb,hp,hf,s.
- CF ha a β CF hb b β CF hp p β CF hf f β
- O s (Ξ»x.ha x + hb x + β_{i β[a x ,b x[ }(hp β©i,xβͺ + hf β©i,xβͺ)) β
- CF s (Ξ»x.max_{i β[a x,b x[ | p β©i,xβͺ }(f β©i,xβͺ)).
-
-(******************************** minimization ********************************)
-
-axiom CF_mu: βa,b.βf:nat βbool.βsa,sb,sf,s.
- CF sa a β CF sb b β CF sf f β
- O s (Ξ»x.sa x + sb x + β_{i β[a x ,S(b x)[ }(sf β©i,xβͺ)) β
- CF s (Ξ»x.ΞΌ_{i β[a x,b x] }(f β©i,xβͺ)).
-
-(************************************* smn ************************************)
-axiom smn: βf,s. CF s f β βx. CF (Ξ»y.s β©x,yβͺ) (Ξ»y.f β©x,yβͺ).
-
-(****************************** constructibility ******************************)
-
-definition constructible β Ξ»s. CF s s.
-
-lemma constr_comp : βs1,s2. constructible s1 β constructible s2 β
- (βx. x β€ s2 x) β constructible (s2 β s1).
-#s1 #s2 #Hs1 #Hs2 #Hle @(CF_comp β¦ Hs1 Hs2) @O_plus @le_to_O #x [@Hle | //]
-qed.
-
-lemma ext_constr: βs1,s2. (βx.s1 x = s2 x) β
- constructible s1 β constructible s2.
-#s1 #s2 #Hext #Hs1 @(ext_CF β¦ Hext) @(monotonic_CF β¦ Hs1) #x >Hext //
-qed.
-
-(********************************* simulation *********************************)
-
-axiom sU : nat β nat.
-
-axiom monotonic_sU: βi1,i2,x1,x2,s1,s2. i1 β€ i2 β x1 β€ x2 β s1 β€ s2 β
- sU β©i1,β©x1,s1βͺβͺ β€ sU β©i2,β©x2,s2βͺβͺ.
-
-lemma monotonic_sU_aux : βx1,x2. fst x1 β€ fst x2 β fst (snd x1) β€ fst (snd x2) β
-snd (snd x1) β€ snd (snd x2) β sU x1 β€ sU x2.
-#x1 #x2 cases (surj_pair x1) #a1 * #y #eqx1 >eqx1 -eqx1 cases (surj_pair y)
-#b1 * #c1 #eqy >eqy -eqy
-cases (surj_pair x2) #a2 * #y2 #eqx2 >eqx2 -eqx2 cases (surj_pair y2)
-#b2 * #c2 #eqy2 >eqy2 -eqy2 >fst_pair >snd_pair >fst_pair >snd_pair
->fst_pair >snd_pair >fst_pair >snd_pair @monotonic_sU
-qed.
-
-axiom sU_le: βi,x,s. s β€ sU β©i,β©x,sβͺβͺ.
-axiom sU_le_i: βi,x,s. MSC i β€ sU β©i,β©x,sβͺβͺ.
-axiom sU_le_x: βi,x,s. MSC x β€ sU β©i,β©x,sβͺβͺ.
-
-definition pU_unary β Ξ»p. pU (fst p) (fst (snd p)) (snd (snd p)).
-
-axiom CF_U : CF sU pU_unary.
-
-definition termb_unary β Ξ»x:β.termb (fst x) (fst (snd x)) (snd (snd x)).
-definition out_unary β Ξ»x:β.out (fst x) (fst (snd x)) (snd (snd x)).
-
-lemma CF_termb: CF sU termb_unary.
-@(ext_CF (fst β pU_unary)) [2: @CF_comp_fst @CF_U]
-#n whd in β’ (??%?); whd in β’ (??(?%)?); >fst_pair %
-qed.
-
-lemma CF_out: CF sU out_unary.
-@(ext_CF (snd β pU_unary)) [2: @CF_comp_snd @CF_U]
-#n whd in β’ (??%?); whd in β’ (??(?%)?); >snd_pair %
-qed.
-
-
-(******************** complexity of g ********************)
-
-definition unary_g β Ξ»h.Ξ»ux. g h (fst ux) (snd ux).
-definition auxg β
- Ξ»h,ux. max_{i β[fst ux,snd ux[ | eqb (min_input h i (snd ux)) (snd ux)}
- (out i (snd ux) (h (S i) (snd ux))).
-
-lemma compl_g1 : βh,s. CF s (auxg h) β CF s (unary_g h).
-#h #s #H1 @(CF_compS ? (auxg h) H1)
-qed.
-
-definition aux1g β
- Ξ»h,ux. max_{i β[fst ux,snd ux[ | (Ξ»p. eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β©i,uxβͺ}
- ((Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β©i,uxβͺ).
-
-lemma eq_aux : βh,x.aux1g h x = auxg h x.
-#h #x @same_bigop
- [#n #_ >fst_pair >snd_pair // |#n #_ #_ >fst_pair >snd_pair //]
-qed.
-
-lemma compl_g2 : βh,s1,s2,s.
- CF s1
- (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β
- CF s2
- (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β
- O s (Ξ»x.MSC x + β_{i β[fst x ,snd x[ }(s1 β©i,xβͺ+s2 β©i,xβͺ)) β
- CF s (auxg h).
-#h #s1 #s2 #s #Hs1 #Hs2 #HO @(ext_CF (aux1g h))
- [#n whd in β’ (??%%); @eq_aux]
-@(CF_max β¦ CF_fst CF_snd Hs1 Hs2 β¦) @(O_trans β¦ HO)
-@O_plus [@O_plus @O_plus_l // | @O_plus_r //]
-qed.
-
-lemma compl_g3 : βh,s.
- CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))) β
- CF s (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))).
-#h #s #H @(CF_eqb β¦ H) @(CF_comp β¦ CF_snd CF_snd) @(O_trans β¦ (proj1 β¦ H))
-@O_plus // %{1} %{0} #n #_ >commutative_times <times_n_1 @monotonic_MSC //
-qed.
-
-definition min_input_aux β Ξ»h,p.
- ΞΌ_{y β [S (fst p),snd (snd p)] }
- ((Ξ»x.termb (fst (snd x)) (fst x) (h (S (fst (snd x))) (fst x))) β©y,pβͺ).
-
-lemma min_input_eq : βh,p.
- min_input_aux h p =
- min_input h (fst p) (snd (snd p)).
-#h #p >min_input_def whd in β’ (??%?); >minus_S_S @min_f_g #i #_ #_
-whd in β’ (??%%); >fst_pair >snd_pair //
-qed.
-
-definition termb_aux β Ξ»h.
- termb_unary β Ξ»p.β©fst (snd p),β©fst p,h (S (fst (snd p))) (fst p)βͺβͺ.
-
-lemma compl_g4 : βh,s1,s.
- (CF s1
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
- (O s (Ξ»x.MSC x + β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ))) β
- CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #s1 #s #Hs1 #HO @(ext_CF (min_input_aux h))
- [#n whd in β’ (??%%); @min_input_eq]
-@(CF_mu β¦ MSC MSC β¦ Hs1)
- [@CF_compS @CF_fst
- |@CF_comp_snd @CF_snd
- |@(O_trans β¦ HO) @O_plus [@O_plus @O_plus_l // | @O_plus_r //]
-qed.
-
-(************************* a couple of technical lemmas ***********************)
-lemma minus_to_0: βa,b. a β€ b β minus a b = 0.
-#a elim a // #n #Hind *
- [#H @False_ind /2 by absurd/ | #b normalize #H @Hind @le_S_S_to_le /2/]
-qed.
-
-lemma sigma_bound: βh,a,b. monotonic nat le h β
- β_{i β [a,S b[ }(h i) β€ (S b-a)*h b.
-#h #a #b #H cases (decidable_le a b)
- [#leab cut (b = pred (S b - a + a))
- [<plus_minus_m_m // @le_S //] #Hb >Hb in match (h b);
- generalize in match (S b -a);
- #n elim n
- [//
- |#m #Hind >bigop_Strue [2://] @le_plus
- [@H @le_n |@(transitive_le β¦ Hind) @le_times [//] @H //]
- ]
- |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
- cut (S b -a = 0) [@minus_to_0 //] #Hcut >Hcut //
- ]
-qed.
-
-lemma sigma_bound_decr: βh,a,b. (βa1,a2. a1 β€ a2 β a2 < b β h a2 β€ h a1) β
- β_{i β [a,b[ }(h i) β€ (b-a)*h a.
-#h #a #b #H cases (decidable_le a b)
- [#leab cut ((b -a) +a β€ b) [/2 by le_minus_to_plus_r/] generalize in match (b -a);
- #n elim n
- [//
- |#m #Hind >bigop_Strue [2://] #Hm
- cut (m+a β€ b) [@(transitive_le β¦ Hm) //] #Hm1
- @le_plus [@H // |@(transitive_le β¦ (Hind Hm1)) //]
- ]
- |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
- cut (b -a = 0) [@minus_to_0 @lt_to_le @ltba] #Hcut >Hcut //
- ]
-qed.
-
-lemma coroll: βs1:natβnat. (βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
-O (Ξ»x.(snd (snd x)-fst x)*(s1 β©snd (snd x),xβͺ))
- (Ξ»x.β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ)).
-#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
-@(transitive_le β¦ (sigma_bound β¦)) [@Hs1|>minus_S_S //]
-qed.
-
-lemma coroll2: βs1:natβnat. (βn,a,b. a β€ b β b < snd n β s1 β©b,nβͺ β€ s1 β©a,nβͺ) β
-O (Ξ»x.(snd x - fst x)*s1 β©fst x,xβͺ) (Ξ»x.β_{i β[fst x,snd x[ }(s1 β©i,xβͺ)).
-#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
-@(transitive_le β¦ (sigma_bound_decr β¦)) [2://] @Hs1
-qed.
-
-(**************************** end of technical lemmas *************************)
-
-lemma compl_g5 : βh,s1.(βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
- (CF s1
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
- CF (Ξ»x.MSC x + (snd (snd x)-fst x)*s1 β©snd (snd x),xβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #s1 #Hmono #Hs1 @(compl_g4 β¦ Hs1) @O_plus
-[@O_plus_l // |@O_plus_r @coroll @Hmono]
-qed.
-
-lemma compl_g6: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (CF (Ξ»x. sU β©max (fst (snd x)) (snd (snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ)
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))).
-#h #hconstr @(ext_CF (termb_aux h))
- [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
-@(CF_comp β¦ (Ξ»x.MSC x + h (S (fst (snd x))) (fst x)) β¦ CF_termb)
- [@CF_comp_pair
- [@CF_comp_fst @(monotonic_CF β¦ CF_snd) #x //
- |@CF_comp_pair
- [@(monotonic_CF β¦ CF_fst) #x //
- |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst (snd x)),fst xβͺ)))
- [#n normalize >fst_pair >snd_pair %]
- @(CF_comp β¦ MSC β¦hconstr)
- [@CF_comp_pair [@CF_compS @CF_comp_fst // |//]
- |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
- ]
- ]
- ]
- |@O_plus
- [@O_plus
- [@(O_trans β¦ (Ξ»x.MSC (fst x) + MSC (max (fst (snd x)) (snd (snd x)))))
- [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- >distributive_times_plus @le_plus [//]
- cases (surj_pair b) #c * #d #eqb >eqb
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- whd in β’ (??%); @le_plus
- [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
- |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
- ]
- |@O_plus [@le_to_O #x @sU_le_x |@le_to_O #x @sU_le_i]
- ]
- |@le_to_O #n @sU_le
- ]
- |@le_to_O #x @monotonic_sU // @(le_maxl β¦ (le_n β¦)) ]
- ]
-qed.
-
-definition big : nat βnat β Ξ»x.
- let m β max (fst x) (snd x) in β©m,mβͺ.
-
-lemma big_def : βa,b. big β©a,bβͺ = β©max a b,max a bβͺ.
-#a #b normalize >fst_pair >snd_pair // qed.
-
-lemma le_big : βx. x β€ big x.
-#x cases (surj_pair x) #a * #b #eqx >eqx @le_pair >fst_pair >snd_pair
-[@(le_maxl β¦ (le_n β¦)) | @(le_maxr β¦ (le_n β¦))]
-qed.
-
-definition faux2 β Ξ»h.
- (Ξ»x.MSC x + (snd (snd x)-fst x)*
- (Ξ»x.sU β©max (fst(snd x)) (snd(snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ) β©snd (snd x),xβͺ).
-
-lemma compl_g7: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- CF (Ξ»x.MSC x + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #hcostr #hmono @(monotonic_CF β¦ (faux2 h))
- [#n normalize >fst_pair >snd_pair //]
-@compl_g5 [2:@(compl_g6 h hcostr)] #n #x #y #lexy >fst_pair >snd_pair
->fst_pair >snd_pair @monotonic_sU // @hmono @lexy
-qed.
-
-lemma compl_g71: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- CF (Ξ»x.MSC (big x) + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #hcostr #hmono @(monotonic_CF β¦ (compl_g7 h hcostr hmono)) #x
-@le_plus [@monotonic_MSC //]
-cases (decidable_le (fst x) (snd(snd x)))
- [#Hle @le_times // @monotonic_sU
- |#Hlt >(minus_to_0 β¦ (lt_to_le β¦ )) [// | @not_le_to_lt @Hlt]
- ]
-qed.
-
-definition out_aux β Ξ»h.
- out_unary β Ξ»p.β©fst p,β©snd(snd p),h (S (fst p)) (snd (snd p))βͺβͺ.
-
-lemma compl_g8: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (CF (Ξ»x. sU β©max (fst x) (snd x),β©snd(snd x),h (S (fst x)) (snd(snd x))βͺβͺ)
- (Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p))))).
-#h #hconstr @(ext_CF (out_aux h))
- [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
-@(CF_comp β¦ (Ξ»x.h (S (fst x)) (snd(snd x)) + MSC x) β¦ CF_out)
- [@CF_comp_pair
- [@(monotonic_CF β¦ CF_fst) #x //
- |@CF_comp_pair
- [@CF_comp_snd @(monotonic_CF β¦ CF_snd) #x //
- |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst x),snd(snd x)βͺ)))
- [#n normalize >fst_pair >snd_pair %]
- @(CF_comp β¦ MSC β¦hconstr)
- [@CF_comp_pair [@CF_compS // | @CF_comp_snd // ]
- |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
- ]
- ]
- ]
- |@O_plus
- [@O_plus
- [@le_to_O #n @sU_le
- |@(O_trans β¦ (Ξ»x.MSC (max (fst x) (snd x))))
- [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- whd in β’ (??%); @le_plus
- [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
- |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
- ]
- |@le_to_O #x @(transitive_le ???? (sU_le_i β¦ )) //
- ]
- ]
- |@le_to_O #x @monotonic_sU [@(le_maxl β¦ (le_n β¦))|//|//]
- ]
-qed.
-
-lemma compl_g9 : βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
- CF (Ξ»x. (S (snd x-fst x))*MSC β©x,xβͺ +
- (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ)
- (auxg h).
-#h #hconstr #hmono #hantimono
-@(compl_g2 h ??? (compl_g3 β¦ (compl_g71 h hconstr hmono)) (compl_g8 h hconstr))
-@O_plus
- [@O_plus_l @le_to_O #x >(times_n_1 (MSC x)) >commutative_times @le_times
- [// | @monotonic_MSC // ]]
-@(O_trans β¦ (coroll2 ??))
- [#n #a #b #leab #ltb >fst_pair >fst_pair >snd_pair >snd_pair
- cut (b β€ n) [@(transitive_le β¦ (le_snd β¦)) @lt_to_le //] #lebn
- cut (max a n = n)
- [normalize >le_to_leb_true [//|@(transitive_le β¦ leab lebn)]] #maxa
- cut (max b n = n) [normalize >le_to_leb_true //] #maxb
- @le_plus
- [@le_plus [>big_def >big_def >maxa >maxb //]
- @le_times
- [/2 by monotonic_le_minus_r/
- |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
- ]
- |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
- ]
- |@le_to_O #n >fst_pair >snd_pair
- cut (max (fst n) n = n) [normalize >le_to_leb_true //] #Hmax >Hmax
- >associative_plus >distributive_times_plus
- @le_plus [@le_times [@le_S // |>big_def >Hmax //] |//]
- ]
-qed.
-
-definition sg β Ξ»h,x.
- (S (snd x-fst x))*MSC β©x,xβͺ + (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ.
-
-lemma sg_def : βh,a,b.
- sg h β©a,bβͺ = (S (b-a))*MSC β©β©a,bβͺ,β©a,bβͺβͺ +
- (b-a)*(S(b-a))*sU β©β©a,bβͺ,β©b,h (S a) bβͺβͺ.
-#h #a #b whd in β’ (??%?); >fst_pair >snd_pair //
-qed.
-
-lemma compl_g11 : βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
- CF (sg h) (unary_g h).
-#h #hconstr #Hm #Ham @compl_g1 @(compl_g9 h hconstr Hm Ham)
-qed.
-
-(**************************** closing the argument ****************************)
-
-let rec h_of_aux (r:nat βnat) (c,d,b:nat) on d : nat β
- match d with
- [ O β c
- | S d1 β (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
- d*(S d)*sU β©β©b-d,bβͺ,β©b,r (h_of_aux r c d1 b)βͺβͺ].
-
-lemma h_of_aux_O: βr,c,b.
- h_of_aux r c O b = c.
-// qed.
-
-lemma h_of_aux_S : βr,c,d,b.
- h_of_aux r c (S d) b =
- (S (S d))*(MSC β©β©b-(S d),bβͺ,β©b-(S d),bβͺβͺ) +
- (S d)*(S (S d))*sU β©β©b-(S d),bβͺ,β©b,r(h_of_aux r c d b)βͺβͺ.
-// qed.
-
-definition h_of β Ξ»r,p.
- let m β max (fst p) (snd p) in
- h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (snd p - fst p) (snd p).
-
-lemma h_of_O: βr,a,b. b β€ a β
- h_of r β©a,bβͺ = let m β max a b in MSC β©β©m,mβͺ,β©m,mβͺβͺ.
-#r #a #b #Hle normalize >fst_pair >snd_pair >(minus_to_0 β¦ Hle) //
-qed.
-
-lemma h_of_def: βr,a,b.h_of r β©a,bβͺ =
- let m β max a b in
- h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (b - a) b.
-#r #a #b normalize >fst_pair >snd_pair //
-qed.
-
-lemma mono_h_of_aux: βr.(βx. x β€ r x) β monotonic ? le r β
- βd,d1,c,c1,b,b1.c β€ c1 β d β€ d1 β b β€ b1 β
- h_of_aux r c d b β€ h_of_aux r c1 d1 b1.
-#r #Hr #monor #d #d1 lapply d -d elim d1
- [#d #c #c1 #b #b1 #Hc #Hd @(le_n_O_elim ? Hd) #leb
- >h_of_aux_O >h_of_aux_O //
- |#m #Hind #d #c #c1 #b #b1 #lec #led #leb cases (le_to_or_lt_eq β¦ led)
- [#ltd @(transitive_le β¦ (Hind β¦ lec ? leb)) [@le_S_S_to_le @ltd]
- >h_of_aux_S @(transitive_le ???? (le_plus_n β¦))
- >(times_n_1 (h_of_aux r c1 m b1)) in β’ (?%?);
- >commutative_times @le_times [//|@(transitive_le β¦ (Hr ?)) @sU_le]
- |#Hd >Hd >h_of_aux_S >h_of_aux_S
- cut (b-S m β€ b1 - S m) [/2 by monotonic_le_minus_l/] #Hb1
- @le_plus [@le_times //]
- [@monotonic_MSC @le_pair @le_pair //
- |@le_times [//] @monotonic_sU
- [@le_pair // |// |@monor @Hind //]
- ]
- ]
- ]
-qed.
-
-lemma mono_h_of2: βr.(βx. x β€ r x) β monotonic ? le r β
- βi,b,b1. b β€ b1 β h_of r β©i,bβͺ β€ h_of r β©i,b1βͺ.
-#r #Hr #Hmono #i #a #b #leab >h_of_def >h_of_def
-cut (max i a β€ max i b)
- [@to_max
- [@(le_maxl β¦ (le_n β¦))|@(transitive_le β¦ leab) @(le_maxr β¦ (le_n β¦))]]
-#Hmax @(mono_h_of_aux r Hr Hmono)
- [@monotonic_MSC @le_pair @le_pair @Hmax |/2 by monotonic_le_minus_l/ |@leab]
-qed.
-
-axiom h_of_constr : βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- constructible (h_of r).
-
-lemma speed_compl: βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- CF (h_of r) (unary_g (Ξ»i,x. r(h_of r β©i,xβͺ))).
-#r #Hr #Hmono #Hconstr @(monotonic_CF β¦ (compl_g11 β¦))
- [#x cases (surj_pair x) #a * #b #eqx >eqx
- >sg_def cases (decidable_le b a)
- [#leba >(minus_to_0 β¦ leba) normalize in β’ (?%?);
- <plus_n_O <plus_n_O >h_of_def
- cut (max a b = a)
- [normalize cases (le_to_or_lt_eq β¦ leba)
- [#ltba >(lt_to_leb_false β¦ ltba) %
- |#eqba <eqba >(le_to_leb_true β¦ (le_n ?)) % ]]
- #Hmax >Hmax normalize >(minus_to_0 β¦ leba) normalize
- @monotonic_MSC @le_pair @le_pair //
- |#ltab >h_of_def >h_of_def
- cut (max a b = b)
- [normalize >(le_to_leb_true β¦ ) [%] @lt_to_le @not_le_to_lt @ltab]
- #Hmax >Hmax
- cut (max (S a) b = b)
- [whd in β’ (??%?); >(le_to_leb_true β¦ ) [%] @not_le_to_lt @ltab]
- #Hmax1 >Hmax1
- cut (βd.b - a = S d)
- [%{(pred(b-a))} >S_pred [//] @lt_plus_to_minus_r @not_le_to_lt @ltab]
- * #d #eqd >eqd
- cut (b-S a = d) [//] #eqd1 >eqd1 >h_of_aux_S >eqd1
- cut (b - S d = a)
- [@plus_to_minus >commutative_plus @minus_to_plus
- [@lt_to_le @not_le_to_lt // | //]] #eqd2 >eqd2
- normalize //
- ]
- |#n #a #b #leab #lebn >h_of_def >h_of_def
- cut (max a n = n)
- [normalize >le_to_leb_true [%|@(transitive_le β¦ leab lebn)]] #Hmaxa
- cut (max b n = n)
- [normalize >(le_to_leb_true β¦ lebn) %] #Hmaxb
- >Hmaxa >Hmaxb @Hmono @(mono_h_of_aux r β¦ Hr Hmono) // /2 by monotonic_le_minus_r/
- |#n #a #b #leab @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ leab)
- |@(constr_comp β¦ Hconstr Hr) @(ext_constr (h_of r))
- [#x cases (surj_pair x) #a * #b #eqx >eqx >fst_pair >snd_pair //]
- @(h_of_constr r Hr Hmono Hconstr)
- ]
-qed.
-
-lemma speed_compl_i: βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- βi. CF (Ξ»x.h_of r β©i,xβͺ) (Ξ»x.g (Ξ»i,x. r(h_of r β©i,xβͺ)) i x).
-#r #Hr #Hmono #Hconstr #i
-@(ext_CF (Ξ»x.unary_g (Ξ»i,x. r(h_of r β©i,xβͺ)) β©i,xβͺ))
- [#n whd in β’ (??%%); @eq_f @sym_eq >fst_pair >snd_pair %]
-@smn @(ext_CF β¦ (speed_compl r Hr Hmono Hconstr)) #n //
-qed.
-
-(**************************** the speedup theorem *****************************)
-theorem pseudo_speedup:
- βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
- βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§ O sf (r β sg).
-(* βm,a.βn. aβ€n β r(sg a) < m * sf n. *)
-#r #Hr #Hmono #Hconstr
-(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
-#Hcodei #HCi
-(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
-(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
-%{(Ξ»x. h_of r β©S i,xβͺ)}
-lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
-%[%[@condition_1 |@Hg]
- |cases Hg #H1 * #j * #Hcodej #HCj
- lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
- cases HCi #m * #a #Ha %{m} %{(max (S i) a)} #n #ltin @lt_to_le @not_le_to_lt
- @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf %{n} %
- [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
- cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
- #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf) //
- ]
-qed.
-
-theorem pseudo_speedup':
- βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
- βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§
- (* Β¬ O (r β sg) sf. *)
- βm,a.βn. aβ€n β r(sg a) < m * sf n.
-#r #Hr #Hmono #Hconstr
-(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
-#Hcodei #HCi
-(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
-(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
-%{(Ξ»x. h_of r β©S i,xβͺ)}
-lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
-%[%[@condition_1 |@Hg]
- |cases Hg #H1 * #j * #Hcodej #HCj
- lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
- cases HCi #m * #a #Ha
- %{m} %{(max (S i) a)} #n #ltin @not_le_to_lt @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf
- %{n} % [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
- cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
- #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf)
- @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ ltin)
- ]
-qed.
-
+++ /dev/null
-include "basics/types.ma".
-include "arithmetics/minimization.ma".
-include "arithmetics/bigops.ma".
-include "arithmetics/sigma_pi.ma".
-include "arithmetics/bounded_quantifiers.ma".
-include "reverse_complexity/big_O.ma".
-include "basics/core_notation/napart_2.ma".
-
-(************************* notation for minimization *****************************)
-notation "ΞΌ_{ ident i < n } p"
- with precedence 80 for @{min $n 0 (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β€ n } p"
- with precedence 80 for @{min (S $n) 0 (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β [a,b[ } p"
- with precedence 80 for @{min ($b-$a) $a (Ξ»${ident i}.$p)}.
-
-notation "ΞΌ_{ ident i β [a,b] } p"
- with precedence 80 for @{min (S $b-$a) $a (Ξ»${ident i}.$p)}.
-
-(************************************ MAX *************************************)
-notation "Max_{ ident i < n | p } f"
- with precedence 80
-for @{'bigop $n max 0 (Ξ»${ident i}. $p) (Ξ»${ident i}. $f)}.
-
-notation "Max_{ ident i < n } f"
- with precedence 80
-for @{'bigop $n max 0 (Ξ»${ident i}.true) (Ξ»${ident i}. $f)}.
-
-notation "Max_{ ident j β [a,b[ } f"
- with precedence 80
-for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.true) (${ident j}+$a)))
- (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
-
-notation "Max_{ ident j β [a,b[ | p } f"
- with precedence 80
-for @{'bigop ($b-$a) max 0 (Ξ»${ident j}.((Ξ»${ident j}.$p) (${ident j}+$a)))
- (Ξ»${ident j}.((Ξ»${ident j}.$f)(${ident j}+$a)))}.
-
-lemma Max_assoc: βa,b,c. max (max a b) c = max a (max b c).
-#a #b #c normalize cases (true_or_false (leb a b)) #leab >leab normalize
- [cases (true_or_false (leb b c )) #lebc >lebc normalize
- [>(le_to_leb_true a c) // @(transitive_le ? b) @leb_true_to_le //
- |>leab //
- ]
- |cases (true_or_false (leb b c )) #lebc >lebc normalize //
- >leab normalize >(not_le_to_leb_false a c) // @lt_to_not_le
- @(transitive_lt ? b) @not_le_to_lt @leb_false_to_not_le //
- ]
-qed.
-
-lemma Max0 : βn. max 0 n = n.
-// qed.
-
-lemma Max0r : βn. max n 0 = n.
-#n >commutative_max //
-qed.
-
-definition MaxA β
- mk_Aop nat 0 max Max0 Max0r (Ξ»a,b,c.sym_eq β¦ (Max_assoc a b c)).
-
-definition MaxAC β mk_ACop nat 0 MaxA commutative_max.
-
-lemma le_Max: βf,p,n,a. a < n β p a = true β
- f a β€ Max_{i < n | p i}(f i).
-#f #p #n #a #ltan #pa
->(bigop_diff p ? 0 MaxAC f a n) // @(le_maxl β¦ (le_n ?))
-qed.
-
-lemma le_MaxI: βf,p,n,m,a. m β€ a β a < n β p a = true β
- f a β€ Max_{i β [m,n[ | p i}(f i).
-#f #p #n #m #a #lema #ltan #pa
->(bigop_diff ? ? 0 MaxAC (Ξ»i.f (i+m)) (a-m) (n-m))
- [<plus_minus_m_m // @(le_maxl β¦ (le_n ?))
- |<plus_minus_m_m //
- |/2 by monotonic_lt_minus_l/
- ]
-qed.
-
-lemma Max_le: βf,p,n,b.
- (βa.a < n β p a = true β f a β€ b) β Max_{i < n | p i}(f i) β€ b.
-#f #p #n elim n #b #H //
-#b0 #H1 cases (true_or_false (p b)) #Hb
- [>bigop_Strue [2:@Hb] @to_max [@H1 // | @H #a #ltab #pa @H1 // @le_S //]
- |>bigop_Sfalse [2:@Hb] @H #a #ltab #pa @H1 // @le_S //
- ]
-qed.
-
-(********************************** pairing ***********************************)
-axiom pair: nat β nat β nat.
-axiom fst : nat β nat.
-axiom snd : nat β nat.
-
-interpretation "abstract pair" 'pair f g = (pair f g).
-
-axiom fst_pair: βa,b. fst β©a,bβͺ = a.
-axiom snd_pair: βa,b. snd β©a,bβͺ = b.
-axiom surj_pair: βx. βa,b. x = β©a,bβͺ.
-
-axiom le_fst : βp. fst p β€ p.
-axiom le_snd : βp. snd p β€ p.
-axiom le_pair: βa,a1,b,b1. a β€ a1 β b β€ b1 β β©a,bβͺ β€ β©a1,b1βͺ.
-
-(************************************* U **************************************)
-axiom U: nat β nat βnat β option nat.
-
-axiom monotonic_U: βi,x,n,m,y.n β€m β
- U i x n = Some ? y β U i x m = Some ? y.
-
-lemma unique_U: βi,x,n,m,yn,ym.
- U i x n = Some ? yn β U i x m = Some ? ym β yn = ym.
-#i #x #n #m #yn #ym #Hn #Hm cases (decidable_le n m)
- [#lenm lapply (monotonic_U β¦ lenm Hn) >Hm #HS destruct (HS) //
- |#ltmn lapply (monotonic_U β¦ n β¦ Hm) [@lt_to_le @not_le_to_lt //]
- >Hn #HS destruct (HS) //
- ]
-qed.
-
-definition code_for β Ξ»f,i.βx.
- βn.βm. n β€ m β U i x m = f x.
-
-definition terminate β Ξ»i,x,r. βy. U i x r = Some ? y.
-
-notation "{i β x} β r" with precedence 60 for @{terminate $i $x $r}.
-
-lemma terminate_dec: βi,x,n. {i β x} β n β¨ Β¬ {i β x} β n.
-#i #x #n normalize cases (U i x n)
- [%2 % * #y #H destruct|#y %1 %{y} //]
-qed.
-
-lemma monotonic_terminate: βi,x,n,m.
- n β€ m β {i β x} β n β {i β x} β m.
-#i #x #n #m #lenm * #z #H %{z} @(monotonic_U β¦ H) //
-qed.
-
-definition termb β Ξ»i,x,t.
- match U i x t with [None β false |Some y β true].
-
-lemma termb_true_to_term: βi,x,t. termb i x t = true β {i β x} β t.
-#i #x #t normalize cases (U i x t) normalize [#H destruct | #y #_ %{y} //]
-qed.
-
-lemma term_to_termb_true: βi,x,t. {i β x} β t β termb i x t = true.
-#i #x #t * #y #H normalize >H //
-qed.
-
-definition out β Ξ»i,x,r.
- match U i x r with [ None β 0 | Some z β z].
-
-definition bool_to_nat: bool β nat β
- Ξ»b. match b with [true β 1 | false β 0].
-
-coercion bool_to_nat.
-
-definition pU : nat β nat β nat β nat β Ξ»i,x,r.β©termb i x r,out i x rβͺ.
-
-lemma pU_vs_U_Some : βi,x,r,y. pU i x r = β©1,yβͺ β U i x r = Some ? y.
-#i #x #r #y % normalize
- [cases (U i x r) normalize
- [#H cut (0=1) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H @H]
- #H1 destruct
- |#a #H cut (a=y) [lapply (eq_f β¦ snd β¦ H) >snd_pair >snd_pair #H1 @H1]
- #H1 //
- ]
- |#H >H //]
-qed.
-
-lemma pU_vs_U_None : βi,x,r. pU i x r = β©0,0βͺ β U i x r = None ?.
-#i #x #r % normalize
- [cases (U i x r) normalize //
- #a #H cut (1=0) [lapply (eq_f β¦ fst β¦ H) >fst_pair >fst_pair #H1 @H1]
- #H1 destruct
- |#H >H //]
-qed.
-
-lemma fst_pU: βi,x,r. fst (pU i x r) = termb i x r.
-#i #x #r normalize cases (U i x r) normalize >fst_pair //
-qed.
-
-lemma snd_pU: βi,x,r. snd (pU i x r) = out i x r.
-#i #x #r normalize cases (U i x r) normalize >snd_pair //
-qed.
-
-(********************************* the speedup ********************************)
-
-definition min_input β Ξ»h,i,x. ΞΌ_{y β [S i,x] } (termb i y (h (S i) y)).
-
-lemma min_input_def : βh,i,x.
- min_input h i x = min (x -i) (S i) (Ξ»y.termb i y (h (S i) y)).
-// qed.
-
-lemma min_input_i: βh,i,x. x β€ i β min_input h i x = S i.
-#h #i #x #lexi >min_input_def
-cut (x - i = 0) [@sym_eq /2 by eq_minus_O/] #Hcut //
-qed.
-
-lemma min_input_to_terminate: βh,i,x.
- min_input h i x = x β {i β x} β (h (S i) x).
-#h #i #x #Hminx
-cases (decidable_le (S i) x) #Hix
- [cases (true_or_false (termb i x (h (S i) x))) #Hcase
- [@termb_true_to_term //
- |<Hminx in Hcase; #H lapply (fmin_false (Ξ»x.termb i x (h (S i) x)) (x-i) (S i) H)
- >min_input_def in Hminx; #Hminx >Hminx in β’ (%β?);
- <plus_n_Sm <plus_minus_m_m [2: @lt_to_le //]
- #Habs @False_ind /2/
- ]
- |@False_ind >min_input_i in Hminx;
- [#eqix >eqix in Hix; * /2/ | @le_S_S_to_le @not_le_to_lt //]
- ]
-qed.
-
-lemma min_input_to_lt: βh,i,x.
- min_input h i x = x β i < x.
-#h #i #x #Hminx cases (decidable_le (S i) x) //
-#ltxi @False_ind >min_input_i in Hminx;
- [#eqix >eqix in ltxi; * /2/ | @le_S_S_to_le @not_le_to_lt //]
-qed.
-
-lemma le_to_min_input: βh,i,x,x1. x β€ x1 β
- min_input h i x = x β min_input h i x1 = x.
-#h #i #x #x1 #lex #Hminx @(min_exists β¦ (le_S_S β¦ lex))
- [@(fmin_true β¦ (sym_eq β¦ Hminx)) //
- |@(min_input_to_lt β¦ Hminx)
- |#j #H1 <Hminx @lt_min_to_false //
- |@plus_minus_m_m @le_S_S @(transitive_le β¦ lex) @lt_to_le
- @(min_input_to_lt β¦ Hminx)
- ]
-qed.
-
-definition g β Ξ»h,u,x.
- S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
-
-lemma g_def : βh,u,x. g h u x =
- S (max_{i β[u,x[ | eqb (min_input h i x) x} (out i x (h (S i) x))).
-// qed.
-
-lemma le_u_to_g_1 : βh,u,x. x β€ u β g h u x = 1.
-#h #u #x #lexu >g_def cut (x-u = 0) [/2 by minus_le_minus_minus_comm/]
-#eq0 >eq0 normalize // qed.
-
-lemma g_lt : βh,i,x. min_input h i x = x β
- out i x (h (S i) x) < g h 0 x.
-#h #i #x #H @le_S_S @(le_MaxI β¦ i) /2 by min_input_to_lt/
-qed.
-
-lemma max_neq0 : βa,b. max a b β 0 β a β 0 β¨ b β 0.
-#a #b whd in match (max a b); cases (true_or_false (leb a b)) #Hcase >Hcase
- [#H %2 @H | #H %1 @H]
-qed.
-
-definition almost_equal β Ξ»f,g:nat β nat. Β¬ βnu.βx. nu < x β§ f x β g x.
-interpretation "almost equal" 'napart f g = (almost_equal f g).
-
-lemma eventually_cancelled: βh,u.Β¬βnu.βx. nu < x β§
- max_{i β [0,u[ | eqb (min_input h i x) x} (out i x (h (S i) x)) β 0.
-#h #u elim u
- [normalize % #H cases (H u) #x * #_ * #H1 @H1 //
- |#u0 @not_to_not #Hind #nu cases (Hind nu) #x * #ltx
- cases (true_or_false (eqb (min_input h (u0+O) x) x)) #Hcase
- [>bigop_Strue [2:@Hcase] #Hmax cases (max_neq0 β¦ Hmax) -Hmax
- [2: #H %{x} % // <minus_n_O @H]
- #Hneq0 (* if x is not enough we retry with nu=x *)
- cases (Hind x) #x1 * #ltx1
- >bigop_Sfalse
- [#H %{x1} % [@transitive_lt //| <minus_n_O @H]
- |@not_eq_to_eqb_false >(le_to_min_input β¦ (eqb_true_to_eq β¦ Hcase))
- [@lt_to_not_eq @ltx1 | @lt_to_le @ltx1]
- ]
- |>bigop_Sfalse [2:@Hcase] #H %{x} % // <minus_n_O @H
- ]
- ]
-qed.
-
-lemma condition_1: βh,u.g h 0 β g h u.
-#h #u @(not_to_not β¦ (eventually_cancelled h u))
-#H #nu cases (H (max u nu)) #x * #ltx #Hdiff
-%{x} % [@(le_to_lt_to_lt β¦ ltx) @(le_maxr β¦ (le_n β¦))] @(not_to_not β¦ Hdiff)
-#H @(eq_f ?? S) >(bigop_sumI 0 u x (Ξ»i:β.eqb (min_input h i x) x) nat 0 MaxA)
- [>H // |@lt_to_le @(le_to_lt_to_lt β¦ltx) /2 by le_maxr/ |//]
-qed.
-
-(******************************** Condition 2 *********************************)
-definition total β Ξ»f.Ξ»x:nat. Some nat (f x).
-
-lemma exists_to_exists_min: βh,i. (βx. i < x β§ {i β x} β h (S i) x) β βy. min_input h i y = y.
-#h #i * #x * #ltix #Hx %{(min_input h i x)} @min_spec_to_min @found //
- [@(f_min_true (Ξ»y:β.termb i y (h (S i) y))) %{x} % [% // | @term_to_termb_true //]
- |#y #leiy #lty @(lt_min_to_false ????? lty) //
- ]
-qed.
-
-lemma condition_2: βh,i. code_for (total (g h 0)) i β Β¬βx. i<x β§ {i β x} β h (S i) x.
-#h #i whd in β’(%β?); #H % #H1 cases (exists_to_exists_min β¦ H1) #y #Hminy
-lapply (g_lt β¦ Hminy)
-lapply (min_input_to_terminate β¦ Hminy) * #r #termy
-cases (H y) -H #ny #Hy
-cut (r = g h 0 y) [@(unique_U β¦ ny β¦ termy) @Hy //] #Hr
-whd in match (out ???); >termy >Hr
-#H @(absurd ? H) @le_to_not_lt @le_n
-qed.
-
-
-(********************************* complexity *********************************)
-
-(* We assume operations have a minimal structural complexity MSC.
-For instance, for time complexity, MSC is equal to the size of input.
-For space complexity, MSC is typically 0, since we only measure the
-space required in addition to dimension of the input. *)
-
-axiom MSC : nat β nat.
-axiom MSC_le: βn. MSC n β€ n.
-axiom monotonic_MSC: monotonic ? le MSC.
-axiom MSC_pair: βa,b. MSC β©a,bβͺ β€ MSC a + MSC b.
-
-(* C s i means i is running in O(s) *)
-
-definition C β Ξ»s,i.βc.βa.βx.a β€ x β βy.
- U i x (c*(s x)) = Some ? y.
-
-(* C f s means f β O(s) where MSC βO(s) *)
-definition CF β Ξ»s,f.O s MSC β§ βi.code_for (total f) i β§ C s i.
-
-lemma ext_CF : βf,g,s. (βn. f n = g n) β CF s f β CF s g.
-#f #g #s #Hext * #HO * #i * #Hcode #HC % // %{i} %
- [#x cases (Hcode x) #a #H %{a} whd in match (total ??); <Hext @H | //]
-qed.
-
-lemma monotonic_CF: βs1,s2,f.(βx. s1 x β€ s2 x) β CF s1 f β CF s2 f.
-#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
- [cases HO #c * #a -HO #HO %{c} %{a} #n #lean @(transitive_le β¦ (HO n lean))
- @le_times //
- |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1 %{c} %{a} #n #lean
- cases(Hs1 n lean) #y #Hy %{y} @(monotonic_U β¦Hy) @le_times //
- ]
-qed.
-
-lemma O_to_CF: βs1,s2,f.O s2 s1 β CF s1 f β CF s2 f.
-#s1 #s2 #f #H * #HO * #i * #Hcode #Hs1 %
- [@(O_trans β¦ H) //
- |%{i} % [//] cases Hs1 #c * #a -Hs1 #Hs1
- cases H #c1 * #a1 #Ha1 %{(c*c1)} %{(a+a1)} #n #lean
- cases(Hs1 n ?) [2:@(transitive_le β¦ lean) //] #y #Hy %{y} @(monotonic_U β¦Hy)
- >associative_times @le_times // @Ha1 @(transitive_le β¦ lean) //
- ]
-qed.
-
-lemma timesc_CF: βs,f,c.CF (Ξ»x.c*s x) f β CF s f.
-#s #f #c @O_to_CF @O_times_c
-qed.
-
-(********************************* composition ********************************)
-axiom CF_comp: βf,g,sf,sg,sh. CF sg g β CF sf f β
- O sh (Ξ»x. sg x + sf (g x)) β CF sh (f β g).
-
-lemma CF_comp_ext: βf,g,h,sh,sf,sg. CF sg g β CF sf f β
- (βx.f(g x) = h x) β O sh (Ξ»x. sg x + sf (g x)) β CF sh h.
-#f #g #h #sh #sf #sg #Hg #Hf #Heq #H @(ext_CF (f β g))
- [#n normalize @Heq | @(CF_comp β¦ H) //]
-qed.
-
-(* primitve recursion *)
-
-let rec prim_rec (k,h:nat βnat) n m on n β
- match n with
- [ O β k m
- | S a β h β©a,β©prim_rec k h a m, mβͺβͺ].
-
-lemma prim_rec_S: βk,h,n,m.
- prim_rec k h (S n) m = h β©n,β©prim_rec k h n m, mβͺβͺ.
-// qed.
-
-definition unary_pr β Ξ»k,h,x. prim_rec k h (fst x) (snd x).
-
-let rec prim_rec_compl (k,h,sk,sh:nat βnat) n m on n β
- match n with
- [ O β sk m
- | S a β prim_rec_compl k h sk sh a m + sh (prim_rec k h a m)].
-
-axiom CF_prim_rec: βk,h,sk,sh,sf. CF sk k β CF sh h β
- O sf (unary_pr sk (Ξ»x. fst (snd x) + sh β©fst x,β©unary_pr k h β©fst x,snd (snd x)βͺ,snd (snd x)βͺβͺ))
- β CF sf (unary_pr k h).
-
-(* falso ????
-lemma prim_rec_O: βk1,h1,k2,h2. O k1 k2 β O h1 h2 β
- O (unary_pr k1 h1) (unary_pr k2 h2).
-#k1 #h1 #k2 #h2 #HO1 #HO2 whd *)
-
-
-(**************************** primitive operations*****************************)
-
-definition id β Ξ»x:nat.x.
-
-axiom CF_id: CF MSC id.
-axiom CF_compS: βh,f. CF h f β CF h (S β f).
-axiom CF_comp_fst: βh,f. CF h f β CF h (fst β f).
-axiom CF_comp_snd: βh,f. CF h f β CF h (snd β f).
-axiom CF_comp_pair: βh,f,g. CF h f β CF h g β CF h (Ξ»x. β©f x,g xβͺ).
-
-lemma CF_fst: CF MSC fst.
-@(ext_CF (fst β id)) [#n //] @(CF_comp_fst β¦ CF_id)
-qed.
-
-lemma CF_snd: CF MSC snd.
-@(ext_CF (snd β id)) [#n //] @(CF_comp_snd β¦ CF_id)
-qed.
-
-(************************************** eqb ***********************************)
-
-axiom CF_eqb: βh,f,g.
- CF h f β CF h g β CF h (Ξ»x.eqb (f x) (g x)).
-
-(*********************************** maximum **********************************)
-
-axiom CF_max: βa,b.βp:nat βbool.βf,ha,hb,hp,hf,s.
- CF ha a β CF hb b β CF hp p β CF hf f β
- O s (Ξ»x.ha x + hb x + β_{i β[a x ,b x[ }(hp β©i,xβͺ + hf β©i,xβͺ)) β
- CF s (Ξ»x.max_{i β[a x,b x[ | p β©i,xβͺ }(f β©i,xβͺ)).
-
-(******************************** minimization ********************************)
-
-axiom CF_mu: βa,b.βf:nat βbool.βsa,sb,sf,s.
- CF sa a β CF sb b β CF sf f β
- O s (Ξ»x.sa x + sb x + β_{i β[a x ,S(b x)[ }(sf β©i,xβͺ)) β
- CF s (Ξ»x.ΞΌ_{i β[a x,b x] }(f β©i,xβͺ)).
-
-(************************************* smn ************************************)
-axiom smn: βf,s. CF s f β βx. CF (Ξ»y.s β©x,yβͺ) (Ξ»y.f β©x,yβͺ).
-
-(****************************** constructibility ******************************)
-
-definition constructible β Ξ»s. CF s s.
-
-lemma constr_comp : βs1,s2. constructible s1 β constructible s2 β
- (βx. x β€ s2 x) β constructible (s2 β s1).
-#s1 #s2 #Hs1 #Hs2 #Hle @(CF_comp β¦ Hs1 Hs2) @O_plus @le_to_O #x [@Hle | //]
-qed.
-
-lemma ext_constr: βs1,s2. (βx.s1 x = s2 x) β
- constructible s1 β constructible s2.
-#s1 #s2 #Hext #Hs1 @(ext_CF β¦ Hext) @(monotonic_CF β¦ Hs1) #x >Hext //
-qed.
-
-lemma constr_prim_rec: βs1,s2. constructible s1 β constructible s2 β
- (βn,r,m. 2 * r β€ s2 β©n,β©r,mβͺβͺ) β constructible (unary_pr s1 s2).
-#s1 #s2 #Hs1 #Hs2 #Hincr @(CF_prim_rec β¦ Hs1 Hs2) whd %{2} %{0}
-#x #_ lapply (surj_pair x) * #a * #b #eqx >eqx whd in match (unary_pr ???);
->fst_pair >snd_pair
-whd in match (unary_pr ???); >fst_pair >snd_pair elim a
- [normalize //
- |#n #Hind >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair
- >prim_rec_S @transitive_le [| @(monotonic_le_plus_l β¦ Hind)]
- @transitive_le [| @(monotonic_le_plus_l β¦ (Hincr n ? b))]
- whd in match (unary_pr ???); >fst_pair >snd_pair //
- ]
-qed.
-
-(********************************* simulation *********************************)
-
-axiom sU : nat β nat.
-
-axiom monotonic_sU: βi1,i2,x1,x2,s1,s2. i1 β€ i2 β x1 β€ x2 β s1 β€ s2 β
- sU β©i1,β©x1,s1βͺβͺ β€ sU β©i2,β©x2,s2βͺβͺ.
-
-lemma monotonic_sU_aux : βx1,x2. fst x1 β€ fst x2 β fst (snd x1) β€ fst (snd x2) β
-snd (snd x1) β€ snd (snd x2) β sU x1 β€ sU x2.
-#x1 #x2 cases (surj_pair x1) #a1 * #y #eqx1 >eqx1 -eqx1 cases (surj_pair y)
-#b1 * #c1 #eqy >eqy -eqy
-cases (surj_pair x2) #a2 * #y2 #eqx2 >eqx2 -eqx2 cases (surj_pair y2)
-#b2 * #c2 #eqy2 >eqy2 -eqy2 >fst_pair >snd_pair >fst_pair >snd_pair
->fst_pair >snd_pair >fst_pair >snd_pair @monotonic_sU
-qed.
-
-axiom sU_le: βi,x,s. s β€ sU β©i,β©x,sβͺβͺ.
-axiom sU_le_i: βi,x,s. MSC i β€ sU β©i,β©x,sβͺβͺ.
-axiom sU_le_x: βi,x,s. MSC x β€ sU β©i,β©x,sβͺβͺ.
-
-definition pU_unary β Ξ»p. pU (fst p) (fst (snd p)) (snd (snd p)).
-
-axiom CF_U : CF sU pU_unary.
-
-definition termb_unary β Ξ»x:β.termb (fst x) (fst (snd x)) (snd (snd x)).
-definition out_unary β Ξ»x:β.out (fst x) (fst (snd x)) (snd (snd x)).
-
-lemma CF_termb: CF sU termb_unary.
-@(ext_CF (fst β pU_unary)) [2: @CF_comp_fst @CF_U]
-#n whd in β’ (??%?); whd in β’ (??(?%)?); >fst_pair %
-qed.
-
-lemma CF_out: CF sU out_unary.
-@(ext_CF (snd β pU_unary)) [2: @CF_comp_snd @CF_U]
-#n whd in β’ (??%?); whd in β’ (??(?%)?); >snd_pair %
-qed.
-
-
-(******************** complexity of g ********************)
-
-definition unary_g β Ξ»h.Ξ»ux. g h (fst ux) (snd ux).
-definition auxg β
- Ξ»h,ux. max_{i β[fst ux,snd ux[ | eqb (min_input h i (snd ux)) (snd ux)}
- (out i (snd ux) (h (S i) (snd ux))).
-
-lemma compl_g1 : βh,s. CF s (auxg h) β CF s (unary_g h).
-#h #s #H1 @(CF_compS ? (auxg h) H1)
-qed.
-
-definition aux1g β
- Ξ»h,ux. max_{i β[fst ux,snd ux[ | (Ξ»p. eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β©i,uxβͺ}
- ((Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β©i,uxβͺ).
-
-lemma eq_aux : βh,x.aux1g h x = auxg h x.
-#h #x @same_bigop
- [#n #_ >fst_pair >snd_pair // |#n #_ #_ >fst_pair >snd_pair //]
-qed.
-
-lemma compl_g2 : βh,s1,s2,s.
- CF s1
- (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))) β
- CF s2
- (Ξ»p:β.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p)))) β
- O s (Ξ»x.MSC x + β_{i β[fst x ,snd x[ }(s1 β©i,xβͺ+s2 β©i,xβͺ)) β
- CF s (auxg h).
-#h #s1 #s2 #s #Hs1 #Hs2 #HO @(ext_CF (aux1g h))
- [#n whd in β’ (??%%); @eq_aux]
-@(CF_max β¦ CF_fst CF_snd Hs1 Hs2 β¦) @(O_trans β¦ HO)
-@O_plus [@O_plus @O_plus_l // | @O_plus_r //]
-qed.
-
-lemma compl_g3 : βh,s.
- CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))) β
- CF s (Ξ»p:β.eqb (min_input h (fst p) (snd (snd p))) (snd (snd p))).
-#h #s #H @(CF_eqb β¦ H) @(CF_comp β¦ CF_snd CF_snd) @(O_trans β¦ (proj1 β¦ H))
-@O_plus // %{1} %{0} #n #_ >commutative_times <times_n_1 @monotonic_MSC //
-qed.
-
-definition min_input_aux β Ξ»h,p.
- ΞΌ_{y β [S (fst p),snd (snd p)] }
- ((Ξ»x.termb (fst (snd x)) (fst x) (h (S (fst (snd x))) (fst x))) β©y,pβͺ).
-
-lemma min_input_eq : βh,p.
- min_input_aux h p =
- min_input h (fst p) (snd (snd p)).
-#h #p >min_input_def whd in β’ (??%?); >minus_S_S @min_f_g #i #_ #_
-whd in β’ (??%%); >fst_pair >snd_pair //
-qed.
-
-definition termb_aux β Ξ»h.
- termb_unary β Ξ»p.β©fst (snd p),β©fst p,h (S (fst (snd p))) (fst p)βͺβͺ.
-
-lemma compl_g4 : βh,s1,s.
- (CF s1
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
- (O s (Ξ»x.MSC x + β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ))) β
- CF s (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #s1 #s #Hs1 #HO @(ext_CF (min_input_aux h))
- [#n whd in β’ (??%%); @min_input_eq]
-@(CF_mu β¦ MSC MSC β¦ Hs1)
- [@CF_compS @CF_fst
- |@CF_comp_snd @CF_snd
- |@(O_trans β¦ HO) @O_plus [@O_plus @O_plus_l // | @O_plus_r //]
-qed.
-
-(************************* a couple of technical lemmas ***********************)
-lemma minus_to_0: βa,b. a β€ b β minus a b = 0.
-#a elim a // #n #Hind *
- [#H @False_ind /2 by absurd/ | #b normalize #H @Hind @le_S_S_to_le /2/]
-qed.
-
-lemma sigma_bound: βh,a,b. monotonic nat le h β
- β_{i β [a,S b[ }(h i) β€ (S b-a)*h b.
-#h #a #b #H cases (decidable_le a b)
- [#leab cut (b = pred (S b - a + a))
- [<plus_minus_m_m // @le_S //] #Hb >Hb in match (h b);
- generalize in match (S b -a);
- #n elim n
- [//
- |#m #Hind >bigop_Strue [2://] @le_plus
- [@H @le_n |@(transitive_le β¦ Hind) @le_times [//] @H //]
- ]
- |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
- cut (S b -a = 0) [@minus_to_0 //] #Hcut >Hcut //
- ]
-qed.
-
-lemma sigma_bound_decr: βh,a,b. (βa1,a2. a1 β€ a2 β a2 < b β h a2 β€ h a1) β
- β_{i β [a,b[ }(h i) β€ (b-a)*h a.
-#h #a #b #H cases (decidable_le a b)
- [#leab cut ((b -a) +a β€ b) [/2 by le_minus_to_plus_r/] generalize in match (b -a);
- #n elim n
- [//
- |#m #Hind >bigop_Strue [2://] #Hm
- cut (m+a β€ b) [@(transitive_le β¦ Hm) //] #Hm1
- @le_plus [@H // |@(transitive_le β¦ (Hind Hm1)) //]
- ]
- |#ltba lapply (not_le_to_lt β¦ ltba) -ltba #ltba
- cut (b -a = 0) [@minus_to_0 @lt_to_le @ltba] #Hcut >Hcut //
- ]
-qed.
-
-lemma coroll: βs1:natβnat. (βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
-O (Ξ»x.(snd (snd x)-fst x)*(s1 β©snd (snd x),xβͺ))
- (Ξ»x.β_{i β[S(fst x) ,S(snd (snd x))[ }(s1 β©i,xβͺ)).
-#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
-@(transitive_le β¦ (sigma_bound β¦)) [@Hs1|>minus_S_S //]
-qed.
-
-lemma coroll2: βs1:natβnat. (βn,a,b. a β€ b β b < snd n β s1 β©b,nβͺ β€ s1 β©a,nβͺ) β
-O (Ξ»x.(snd x - fst x)*s1 β©fst x,xβͺ) (Ξ»x.β_{i β[fst x,snd x[ }(s1 β©i,xβͺ)).
-#s1 #Hs1 %{1} %{0} #n #_ >commutative_times <times_n_1
-@(transitive_le β¦ (sigma_bound_decr β¦)) [2://] @Hs1
-qed.
-
-(**************************** end of technical lemmas *************************)
-
-lemma compl_g5 : βh,s1.(βn. monotonic β le (Ξ»a:β.s1 β©a,nβͺ)) β
- (CF s1
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) β
- CF (Ξ»x.MSC x + (snd (snd x)-fst x)*s1 β©snd (snd x),xβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #s1 #Hmono #Hs1 @(compl_g4 β¦ Hs1) @O_plus
-[@O_plus_l // |@O_plus_r @coroll @Hmono]
-qed.
-
-lemma compl_g6: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (CF (Ξ»x. sU β©max (fst (snd x)) (snd (snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ)
- (Ξ»p.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))).
-#h #hconstr @(ext_CF (termb_aux h))
- [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
-@(CF_comp β¦ (Ξ»x.MSC x + h (S (fst (snd x))) (fst x)) β¦ CF_termb)
- [@CF_comp_pair
- [@CF_comp_fst @(monotonic_CF β¦ CF_snd) #x //
- |@CF_comp_pair
- [@(monotonic_CF β¦ CF_fst) #x //
- |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst (snd x)),fst xβͺ)))
- [#n normalize >fst_pair >snd_pair %]
- @(CF_comp β¦ MSC β¦hconstr)
- [@CF_comp_pair [@CF_compS @CF_comp_fst // |//]
- |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
- ]
- ]
- ]
- |@O_plus
- [@O_plus
- [@(O_trans β¦ (Ξ»x.MSC (fst x) + MSC (max (fst (snd x)) (snd (snd x)))))
- [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- >distributive_times_plus @le_plus [//]
- cases (surj_pair b) #c * #d #eqb >eqb
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- whd in β’ (??%); @le_plus
- [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
- |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
- ]
- |@O_plus [@le_to_O #x @sU_le_x |@le_to_O #x @sU_le_i]
- ]
- |@le_to_O #n @sU_le
- ]
- |@le_to_O #x @monotonic_sU // @(le_maxl β¦ (le_n β¦)) ]
- ]
-qed.
-
-definition big : nat βnat β Ξ»x.
- let m β max (fst x) (snd x) in β©m,mβͺ.
-
-lemma big_def : βa,b. big β©a,bβͺ = β©max a b,max a bβͺ.
-#a #b normalize >fst_pair >snd_pair // qed.
-
-lemma le_big : βx. x β€ big x.
-#x cases (surj_pair x) #a * #b #eqx >eqx @le_pair >fst_pair >snd_pair
-[@(le_maxl β¦ (le_n β¦)) | @(le_maxr β¦ (le_n β¦))]
-qed.
-
-definition faux2 β Ξ»h.
- (Ξ»x.MSC x + (snd (snd x)-fst x)*
- (Ξ»x.sU β©max (fst(snd x)) (snd(snd x)),β©fst x,h (S (fst (snd x))) (fst x)βͺβͺ) β©snd (snd x),xβͺ).
-
-lemma compl_g7: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- CF (Ξ»x.MSC x + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #hcostr #hmono @(monotonic_CF β¦ (faux2 h))
- [#n normalize >fst_pair >snd_pair //]
-@compl_g5 [2:@(compl_g6 h hcostr)] #n #x #y #lexy >fst_pair >snd_pair
->fst_pair >snd_pair @monotonic_sU // @hmono @lexy
-qed.
-
-lemma compl_g71: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- CF (Ξ»x.MSC (big x) + (snd (snd x)-fst x)*sU β©max (fst x) (snd x),β©snd (snd x),h (S (fst x)) (snd (snd x))βͺβͺ)
- (Ξ»p:β.min_input h (fst p) (snd (snd p))).
-#h #hcostr #hmono @(monotonic_CF β¦ (compl_g7 h hcostr hmono)) #x
-@le_plus [@monotonic_MSC //]
-cases (decidable_le (fst x) (snd(snd x)))
- [#Hle @le_times // @monotonic_sU
- |#Hlt >(minus_to_0 β¦ (lt_to_le β¦ )) [// | @not_le_to_lt @Hlt]
- ]
-qed.
-
-definition out_aux β Ξ»h.
- out_unary β Ξ»p.β©fst p,β©snd(snd p),h (S (fst p)) (snd (snd p))βͺβͺ.
-
-lemma compl_g8: βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (CF (Ξ»x. sU β©max (fst x) (snd x),β©snd(snd x),h (S (fst x)) (snd(snd x))βͺβͺ)
- (Ξ»p.out (fst p) (snd (snd p)) (h (S (fst p)) (snd (snd p))))).
-#h #hconstr @(ext_CF (out_aux h))
- [#n normalize >fst_pair >snd_pair >fst_pair >snd_pair // ]
-@(CF_comp β¦ (Ξ»x.h (S (fst x)) (snd(snd x)) + MSC x) β¦ CF_out)
- [@CF_comp_pair
- [@(monotonic_CF β¦ CF_fst) #x //
- |@CF_comp_pair
- [@CF_comp_snd @(monotonic_CF β¦ CF_snd) #x //
- |@(ext_CF ((Ξ»x.h (fst x) (snd x))β(Ξ»x.β©S (fst x),snd(snd x)βͺ)))
- [#n normalize >fst_pair >snd_pair %]
- @(CF_comp β¦ MSC β¦hconstr)
- [@CF_comp_pair [@CF_compS // | @CF_comp_snd // ]
- |@O_plus @le_to_O [//|#n >fst_pair >snd_pair //]
- ]
- ]
- ]
- |@O_plus
- [@O_plus
- [@le_to_O #n @sU_le
- |@(O_trans β¦ (Ξ»x.MSC (max (fst x) (snd x))))
- [%{2} %{0} #x #_ cases (surj_pair x) #a * #b #eqx >eqx
- >fst_pair >snd_pair @(transitive_le β¦ (MSC_pair β¦))
- whd in β’ (??%); @le_plus
- [@monotonic_MSC @(le_maxl β¦ (le_n β¦))
- |>commutative_times <times_n_1 @monotonic_MSC @(le_maxr β¦ (le_n β¦))
- ]
- |@le_to_O #x @(transitive_le ???? (sU_le_i β¦ )) //
- ]
- ]
- |@le_to_O #x @monotonic_sU [@(le_maxl β¦ (le_n β¦))|//|//]
- ]
-qed.
-
-lemma compl_g9 : βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
- CF (Ξ»x. (S (snd x-fst x))*MSC β©x,xβͺ +
- (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ)
- (auxg h).
-#h #hconstr #hmono #hantimono
-@(compl_g2 h ??? (compl_g3 β¦ (compl_g71 h hconstr hmono)) (compl_g8 h hconstr))
-@O_plus
- [@O_plus_l @le_to_O #x >(times_n_1 (MSC x)) >commutative_times @le_times
- [// | @monotonic_MSC // ]]
-@(O_trans β¦ (coroll2 ??))
- [#n #a #b #leab #ltb >fst_pair >fst_pair >snd_pair >snd_pair
- cut (b β€ n) [@(transitive_le β¦ (le_snd β¦)) @lt_to_le //] #lebn
- cut (max a n = n)
- [normalize >le_to_leb_true [//|@(transitive_le β¦ leab lebn)]] #maxa
- cut (max b n = n) [normalize >le_to_leb_true //] #maxb
- @le_plus
- [@le_plus [>big_def >big_def >maxa >maxb //]
- @le_times
- [/2 by monotonic_le_minus_r/
- |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
- ]
- |@monotonic_sU // @hantimono [@le_S_S // |@ltb]
- ]
- |@le_to_O #n >fst_pair >snd_pair
- cut (max (fst n) n = n) [normalize >le_to_leb_true //] #Hmax >Hmax
- >associative_plus >distributive_times_plus
- @le_plus [@le_times [@le_S // |>big_def >Hmax //] |//]
- ]
-qed.
-
-definition sg β Ξ»h,x.
- (S (snd x-fst x))*MSC β©x,xβͺ + (snd x-fst x)*(S(snd x-fst x))*sU β©x,β©snd x,h (S (fst x)) (snd x)βͺβͺ.
-
-lemma sg_def : βh,a,b.
- sg h β©a,bβͺ = (S (b-a))*MSC β©β©a,bβͺ,β©a,bβͺβͺ +
- (b-a)*(S(b-a))*sU β©β©a,bβͺ,β©b,h (S a) bβͺβͺ.
-#h #a #b whd in β’ (??%?); >fst_pair >snd_pair //
-qed.
-
-lemma compl_g11 : βh.
- constructible (Ξ»x. h (fst x) (snd x)) β
- (βn. monotonic ? le (h n)) β
- (βn,a,b. a β€ b β b β€ n β h b n β€ h a n) β
- CF (sg h) (unary_g h).
-#h #hconstr #Hm #Ham @compl_g1 @(compl_g9 h hconstr Hm Ham)
-qed.
-
-(**************************** closing the argument ****************************)
-
-let rec h_of_aux (r:nat βnat) (c,d,b:nat) on d : nat β
- match d with
- [ O β c
- | S d1 β (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
- d*(S d)*sU β©β©b-d,bβͺ,β©b,r (h_of_aux r c d1 b)βͺβͺ].
-
-lemma h_of_aux_O: βr,c,b.
- h_of_aux r c O b = c.
-// qed.
-
-lemma h_of_aux_S : βr,c,d,b.
- h_of_aux r c (S d) b =
- (S (S d))*(MSC β©β©b-(S d),bβͺ,β©b-(S d),bβͺβͺ) +
- (S d)*(S (S d))*sU β©β©b-(S d),bβͺ,β©b,r(h_of_aux r c d b)βͺβͺ.
-// qed.
-
-lemma h_of_aux_prim_rec : βr,c,n,b. h_of_aux r c n b =
- prim_rec (Ξ»x.c)
- (Ξ»x.let d β S(fst x) in
- let b β snd (snd x) in
- (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
- d*(S d)*sU β©β©b-d,bβͺ,β©b,r (fst (snd x))βͺβͺ) n b.
-#r #c #n #b elim n
- [>h_of_aux_O normalize //
- |#n1 #Hind >h_of_aux_S >prim_rec_S >snd_pair >snd_pair >fst_pair
- >fst_pair <Hind //
- ]
-qed.
-
-lemma h_of_aux_constr :
-βr,c. constructible (Ξ»x.h_of_aux r c (fst x) (snd x)).
-#r #c
- @(ext_constr β¦
- (unary_pr (Ξ»x.c)
- (Ξ»x.let d β S(fst x) in
- let b β snd (snd x) in
- (S d)*(MSC β©β©b-d,bβͺ,β©b-d,bβͺβͺ) +
- d*(S d)*sU β©β©b-d,bβͺ,β©b,r (fst (snd x))βͺβͺ)))
- [#n @sym_eq whd in match (unary_pr ???); @h_of_aux_prim_rec
- |@constr_prim_rec
-
-definition h_of β Ξ»r,p.
- let m β max (fst p) (snd p) in
- h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (snd p - fst p) (snd p).
-
-lemma h_of_O: βr,a,b. b β€ a β
- h_of r β©a,bβͺ = let m β max a b in MSC β©β©m,mβͺ,β©m,mβͺβͺ.
-#r #a #b #Hle normalize >fst_pair >snd_pair >(minus_to_0 β¦ Hle) //
-qed.
-
-lemma h_of_def: βr,a,b.h_of r β©a,bβͺ =
- let m β max a b in
- h_of_aux r (MSC β©β©m,mβͺ,β©m,mβͺβͺ) (b - a) b.
-#r #a #b normalize >fst_pair >snd_pair //
-qed.
-
-lemma mono_h_of_aux: βr.(βx. x β€ r x) β monotonic ? le r β
- βd,d1,c,c1,b,b1.c β€ c1 β d β€ d1 β b β€ b1 β
- h_of_aux r c d b β€ h_of_aux r c1 d1 b1.
-#r #Hr #monor #d #d1 lapply d -d elim d1
- [#d #c #c1 #b #b1 #Hc #Hd @(le_n_O_elim ? Hd) #leb
- >h_of_aux_O >h_of_aux_O //
- |#m #Hind #d #c #c1 #b #b1 #lec #led #leb cases (le_to_or_lt_eq β¦ led)
- [#ltd @(transitive_le β¦ (Hind β¦ lec ? leb)) [@le_S_S_to_le @ltd]
- >h_of_aux_S @(transitive_le ???? (le_plus_n β¦))
- >(times_n_1 (h_of_aux r c1 m b1)) in β’ (?%?);
- >commutative_times @le_times [//|@(transitive_le β¦ (Hr ?)) @sU_le]
- |#Hd >Hd >h_of_aux_S >h_of_aux_S
- cut (b-S m β€ b1 - S m) [/2 by monotonic_le_minus_l/] #Hb1
- @le_plus [@le_times //]
- [@monotonic_MSC @le_pair @le_pair //
- |@le_times [//] @monotonic_sU
- [@le_pair // |// |@monor @Hind //]
- ]
- ]
- ]
-qed.
-
-lemma mono_h_of2: βr.(βx. x β€ r x) β monotonic ? le r β
- βi,b,b1. b β€ b1 β h_of r β©i,bβͺ β€ h_of r β©i,b1βͺ.
-#r #Hr #Hmono #i #a #b #leab >h_of_def >h_of_def
-cut (max i a β€ max i b)
- [@to_max
- [@(le_maxl β¦ (le_n β¦))|@(transitive_le β¦ leab) @(le_maxr β¦ (le_n β¦))]]
-#Hmax @(mono_h_of_aux r Hr Hmono)
- [@monotonic_MSC @le_pair @le_pair @Hmax |/2 by monotonic_le_minus_l/ |@leab]
-qed.
-
-axiom h_of_constr : βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- constructible (h_of r).
-
-lemma speed_compl: βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- CF (h_of r) (unary_g (Ξ»i,x. r(h_of r β©i,xβͺ))).
-#r #Hr #Hmono #Hconstr @(monotonic_CF β¦ (compl_g11 β¦))
- [#x cases (surj_pair x) #a * #b #eqx >eqx
- >sg_def cases (decidable_le b a)
- [#leba >(minus_to_0 β¦ leba) normalize in β’ (?%?);
- <plus_n_O <plus_n_O >h_of_def
- cut (max a b = a)
- [normalize cases (le_to_or_lt_eq β¦ leba)
- [#ltba >(lt_to_leb_false β¦ ltba) %
- |#eqba <eqba >(le_to_leb_true β¦ (le_n ?)) % ]]
- #Hmax >Hmax normalize >(minus_to_0 β¦ leba) normalize
- @monotonic_MSC @le_pair @le_pair //
- |#ltab >h_of_def >h_of_def
- cut (max a b = b)
- [normalize >(le_to_leb_true β¦ ) [%] @lt_to_le @not_le_to_lt @ltab]
- #Hmax >Hmax
- cut (max (S a) b = b)
- [whd in β’ (??%?); >(le_to_leb_true β¦ ) [%] @not_le_to_lt @ltab]
- #Hmax1 >Hmax1
- cut (βd.b - a = S d)
- [%{(pred(b-a))} >S_pred [//] @lt_plus_to_minus_r @not_le_to_lt @ltab]
- * #d #eqd >eqd
- cut (b-S a = d) [//] #eqd1 >eqd1 >h_of_aux_S >eqd1
- cut (b - S d = a)
- [@plus_to_minus >commutative_plus @minus_to_plus
- [@lt_to_le @not_le_to_lt // | //]] #eqd2 >eqd2
- normalize //
- ]
- |#n #a #b #leab #lebn >h_of_def >h_of_def
- cut (max a n = n)
- [normalize >le_to_leb_true [%|@(transitive_le β¦ leab lebn)]] #Hmaxa
- cut (max b n = n)
- [normalize >(le_to_leb_true β¦ lebn) %] #Hmaxb
- >Hmaxa >Hmaxb @Hmono @(mono_h_of_aux r β¦ Hr Hmono) // /2 by monotonic_le_minus_r/
- |#n #a #b #leab @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ leab)
- |@(constr_comp β¦ Hconstr Hr) @(ext_constr (h_of r))
- [#x cases (surj_pair x) #a * #b #eqx >eqx >fst_pair >snd_pair //]
- @(h_of_constr r Hr Hmono Hconstr)
- ]
-qed.
-
-lemma speed_compl_i: βr:nat βnat.
- (βx. x β€ r x) β monotonic ? le r β constructible r β
- βi. CF (Ξ»x.h_of r β©i,xβͺ) (Ξ»x.g (Ξ»i,x. r(h_of r β©i,xβͺ)) i x).
-#r #Hr #Hmono #Hconstr #i
-@(ext_CF (Ξ»x.unary_g (Ξ»i,x. r(h_of r β©i,xβͺ)) β©i,xβͺ))
- [#n whd in β’ (??%%); @eq_f @sym_eq >fst_pair >snd_pair %]
-@smn @(ext_CF β¦ (speed_compl r Hr Hmono Hconstr)) #n //
-qed.
-
-(**************************** the speedup theorem *****************************)
-theorem pseudo_speedup:
- βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
- βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§ O sf (r β sg).
-(* βm,a.βn. aβ€n β r(sg a) < m * sf n. *)
-#r #Hr #Hmono #Hconstr
-(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
-#Hcodei #HCi
-(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
-(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
-%{(Ξ»x. h_of r β©S i,xβͺ)}
-lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
-%[%[@condition_1 |@Hg]
- |cases Hg #H1 * #j * #Hcodej #HCj
- lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
- cases HCi #m * #a #Ha %{m} %{(max (S i) a)} #n #ltin @lt_to_le @not_le_to_lt
- @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf %{n} %
- [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
- cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
- #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf) //
- ]
-qed.
-
-theorem pseudo_speedup':
- βr:nat βnat. (βx. x β€ r x) β monotonic ? le r β constructible r β
- βf.βsf. CF sf f β βg,sg. f β g β§ CF sg g β§
- (* Β¬ O (r β sg) sf. *)
- βm,a.βn. aβ€n β r(sg a) < m * sf n.
-#r #Hr #Hmono #Hconstr
-(* f is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) 0)} #sf * #H * #i *
-#Hcodei #HCi
-(* g is (g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i)) *)
-%{(g (Ξ»i,x. r(h_of r β©i,xβͺ)) (S i))}
-(* sg is (Ξ»x.h_of r β©i,xβͺ) *)
-%{(Ξ»x. h_of r β©S i,xβͺ)}
-lapply (speed_compl_i β¦ Hr Hmono Hconstr (S i)) #Hg
-%[%[@condition_1 |@Hg]
- |cases Hg #H1 * #j * #Hcodej #HCj
- lapply (condition_2 β¦ Hcodei) #Hcond2 (* @not_to_not *)
- cases HCi #m * #a #Ha
- %{m} %{(max (S i) a)} #n #ltin @not_le_to_lt @(not_to_not β¦ Hcond2) -Hcond2 #Hlesf
- %{n} % [@(transitive_le β¦ ltin) @(le_maxl β¦ (le_n β¦))]
- cases (Ha n ?) [2: @(transitive_le β¦ ltin) @(le_maxr β¦ (le_n β¦))]
- #y #Uy %{y} @(monotonic_U β¦ Uy) @(transitive_le β¦ Hlesf)
- @Hmono @(mono_h_of2 β¦ Hr Hmono β¦ ltin)
- ]
-qed.
-
+++ /dev/null
-include "turing/auxiliary_machines1.ma".
-include "turing/multi_to_mono/shift_trace_machines.ma".
-
-(******************************************************************************)
-(* mtiL: complete move L for tape i. We reaching the left border of trace i, *)
-(* add a blank if there is no more tape, then move the i-trace and finally *)
-(* come back to the head position. *)
-(******************************************************************************)
-
-(* we say that a tape is regular if for any trace after the first blank we
- only have other blanks *)
-
-definition all_blanks_in β Ξ»sig,l.
- βx. mem ? x l β x = blank sig.
-
-definition regular_i β Ξ»sig,n.Ξ»l:list (multi_sig sig n).Ξ»i.
- all_blanks_in ? (after_blank ? (trace sig n i l)).
-
-definition regular_trace β Ξ»sig,n,a.Ξ»ls,rs:list (multi_sig sig n).Ξ»i.
- Or (And (regular_i sig n (a::ls) i) (regular_i sig n rs i))
- (And (regular_i sig n ls i) (regular_i sig n (a::rs) i)).
-
-axiom regular_tail: βsig,n,l,i.
- regular_i sig n l i β regular_i sig n (tail ? l) i.
-
-axiom regular_extend: βsig,n,l,i.
- regular_i sig n l i β regular_i sig n (l@[all_blank sig n]) i.
-
-axiom all_blank_after_blank: βsig,n,l1,b,l2,i.
- nth i ? (vec β¦ b) (blank ?) = blank ? β
- regular_i sig n (l1@b::l2) i β all_blanks_in ? (trace sig n i l2).
-
-lemma regular_trace_extl: βsig,n,a,ls,rs,i.
- regular_trace sig n a ls rs i β
- regular_trace sig n a (ls@[all_blank sig n]) rs i.
-#sig #n #a #ls #rs #i *
- [* #H1 #H2 % % // @(regular_extend β¦ H1)
- |* #H1 #H2 %2 % // @(regular_extend β¦ H1)
- ]
-qed.
-
-lemma regular_cons_hd_rs: βsig,n.βa:multi_sig sig n.βls,rs1,rs2,i.
- regular_trace sig n a ls (rs1@rs2) i β
- regular_trace sig n a ls (rs1@((hd ? rs2 (all_blank β¦))::(tail ? rs2))) i.
-#sig #n #a #ls #rs1 #rs2 #i cases rs2 [2: #b #tl #H @H]
-*[* #H1 >append_nil #H2 %1 %
- [@H1 | whd in match (hd ???); @(regular_extend β¦ rs1) //]
- |* #H1 >append_nil #H2 %2 %
- [@H1 | whd in match (hd ???); @(regular_extend β¦ (a::rs1)) //]
- ]
-qed.
-
-lemma eq_trace_to_regular : βsig,n.βa1,a2:multi_sig sig n.βls1,ls2,rs1,rs2,i.
- nth i ? (vec β¦ a1) (blank ?) = nth i ? (vec β¦ a2) (blank ?) β
- trace sig n i ls1 = trace sig n i ls2 β
- trace sig n i rs1 = trace sig n i rs2 β
- regular_trace sig n a1 ls1 rs1 i β
- regular_trace sig n a2 ls2 rs2 i.
-#sig #n #a1 #a2 #ls1 #ls2 #rs1 #rs2 #i #H1 #H2 #H3 #H4
-whd in match (regular_trace ??????); whd in match (regular_i ????);
-whd in match (regular_i ?? rs2 ?); whd in match (regular_i ?? ls2 ?);
-whd in match (regular_i ?? (a2::rs2) ?); whd in match (trace ????);
-<trace_def whd in match (trace ??? (a2::rs2)); <trace_def
-<H1 <H2 <H3 @H4
-qed.
-
-(******************************* move_to_blank_L ******************************)
-(* we compose machines together to reduce the number of output cases, and
- improve semantics *)
-
-definition move_to_blank_L β Ξ»sig,n,i.
- (move_until ? L (no_blank sig n i)) Β· extend ? (all_blank sig n).
-
-(*
-definition R_move_to_blank_L β Ξ»sig,n,i,t1,t2.
-(current ? t1 = None ? β
- t2 = midtape (multi_sig sig n) (left ? t1) (all_blank β¦) (right ? t1)) β§
-βls,a,rs.t1 = midtape ? ls a rs β
- ((no_blank sig n i a = false) β§ t2 = t1) β¨
- (βb,ls1,ls2.
- (no_blank sig n i b = false) β§
- (βj.j β€n β to_blank_i ?? j (ls1@b::ls2) = to_blank_i ?? j ls) β§
- t2 = midtape ? ls2 b ((reverse ? (a::ls1))@rs)).
-*)
-
-definition R_move_to_blank_L β Ξ»sig,n,i,t1,t2.
-(current ? t1 = None ? β
- t2 = midtape (multi_sig sig n) (left ? t1) (all_blank β¦) (right ? t1)) β§
-βls,a,rs.
- t1 = midtape (multi_sig sig n) ls a rs β
- regular_i sig n (a::ls) i β
- (βj. j β i β regular_trace β¦ a ls rs j) β
- (βb,ls1,ls2.
- (regular_i sig n (ls1@b::ls2) i) β§
- (βj. j β i β regular_trace β¦
- (hd ? (ls1@b::ls2) (all_blank β¦)) (tail ? (ls1@b::ls2)) rs j) β§
- (no_blank sig n i b = false) β§
- (hd (multi_sig sig n) (ls1@[b]) (all_blank β¦) = a) β§ (* not implied by the next fact *)
- (βj.j β€n β to_blank_i ?? j (ls1@b::ls2) = to_blank_i ?? j (a::ls)) β§
- t2 = midtape ? ls2 b ((reverse ? ls1)@rs)).
-
-theorem sem_move_to_blank_L: βsig,n,i.
- move_to_blank_L sig n i β¨ R_move_to_blank_L sig n i.
-#sig #n #i
-@(sem_seq_app ??????
- (ssem_move_until_L ? (no_blank sig n i)) (sem_extend ? (all_blank sig n)))
-#tin #tout * #t1 * * #Ht1a #Ht1b * #Ht2a #Ht2b %
- [#Hcur >(Ht1a Hcur) in Ht2a; /2 by /
- |#ls #a #rs #Htin #Hreg #Hreg2 -Ht1a cases (Ht1b β¦ Htin)
- [* #Hnb #Ht1 -Ht1b -Ht2a >Ht1 in Ht2b; >Htin #H
- %{a} %{[ ]} %{ls}
- %[%[%[%[%[@Hreg|@Hreg2]|@Hnb]|//]|//]|@H normalize % #H1 destruct (H1)]
- |*
- [(* we find the blank *)
- * #ls1 * #b * #ls2 * * * #H1 #H2 #H3 #Ht1
- >Ht1 in Ht2b; #Hout -Ht1b
- %{b} %{(a::ls1)} %{ls2}
- %[%[%[%[%[>H1 in Hreg; #H @H
- |#j #jneqi whd in match (hd ???); whd in match (tail ??);
- <H1 @(Hreg2 j jneqi)]|@H2] |//]|>H1 //]
- |@Hout normalize % normalize #H destruct (H)
- ]
- |* #b * #lss * * #H1 #H2 #Ht1 -Ht1b >Ht1 in Ht2a;
- whd in match (left ??); whd in match (right ??); #Hout
- %{(all_blank β¦)} %{(lss@[b])} %{[]}
- %[%[%[%[%[<H2 @regular_extend //
- |<H2 #j #jneqi whd in match (hd ???); whd in match (tail ??);
- @regular_trace_extl @Hreg2 //]
- |whd in match (no_blank ????); >blank_all_blank //]
- |<H2 //]
- |#j #lejn <H2 @sym_eq @to_blank_i_ext]
- |>reverse_append >reverse_single @Hout normalize //
- ]
- ]
- ]
-qed.
-
-(******************************************************************************)
-
-definition shift_i_L β Ξ»sig,n,i.
- ncombf_r (multi_sig β¦) (shift_i sig n i) (all_blank sig n) Β·
- mti sig n i Β·
- extend ? (all_blank sig n).
-
-definition R_shift_i_L β Ξ»sig,n,i,t1,t2.
- (βa,ls,rs.
- t1 = midtape ? ls a rs β
- ((βrs1,b,rs2,a1,rss.
- rs = rs1@b::rs2 β§
- nth i ? (vec β¦ b) (blank ?) = (blank ?) β§
- (βx. mem ? x rs1 β nth i ? (vec β¦ x) (blank ?) β (blank ?)) β§
- shift_l sig n i (a::rs1) (a1::rss) β§
- t2 = midtape (multi_sig sig n) ((reverse ? (a1::rss))@ls) b rs2) β¨
- (βb,rss.
- (βx. mem ? x rs β nth i ? (vec β¦ x) (blank ?) β (blank ?)) β§
- shift_l sig n i (a::rs) (rss@[b]) β§
- t2 = midtape (multi_sig sig n)
- ((reverse ? (rss@[b]))@ls) (all_blank sig n) [ ]))).
-
-definition R_shift_i_L_new β Ξ»sig,n,i,t1,t2.
- (βa,ls,rs.
- t1 = midtape ? ls a rs β
- βrs1,b,rs2,rss.
- b = hd ? rs2 (all_blank sig n) β§
- nth i ? (vec β¦ b) (blank ?) = (blank ?) β§
- rs = rs1@rs2 β§
- (βx. mem ? x rs1 β nth i ? (vec β¦ x) (blank ?) β (blank ?)) β§
- shift_l sig n i (a::rs1) rss β§
- t2 = midtape (multi_sig sig n) ((reverse ? rss)@ls) b (tail ? rs2)).
-
-theorem sem_shift_i_L: βsig,n,i. shift_i_L sig n i β¨ R_shift_i_L sig n i.
-#sig #n #i
-@(sem_seq_app ??????
- (sem_ncombf_r (multi_sig sig n) (shift_i sig n i)(all_blank sig n))
- (sem_seq ????? (ssem_mti sig n i)
- (sem_extend ? (all_blank sig n))))
-#tin #tout * #t1 * * #Ht1a #Ht1b * #t2 * * #Ht2a #Ht2b * #Htout1 #Htout2
-#a #ls #rs cases rs
- [#Htin %2 %{(shift_i sig n i a (all_blank sig n))} %{[ ]}
- %[%[#x @False_ind | @daemon]
- |lapply (Ht1a β¦ Htin) -Ht1a -Ht1b #Ht1
- lapply (Ht2a β¦ Ht1) -Ht2a -Ht2b #Ht2 >Ht2 in Htout1;
- >Ht1 whd in match (left ??); whd in match (right ??); #Htout @Htout //
- ]
- |#a1 #rs1 #Htin
- lapply (Ht1b β¦ Htin) -Ht1a -Ht1b #Ht1
- lapply (Ht2b β¦ Ht1) -Ht2a -Ht2b *
- [(* a1 is blank *) * #H1 #H2 %1
- %{[ ]} %{a1} %{rs1} %{(shift_i sig n i a a1)} %{[ ]}
- %[%[%[%[// |//] |#x @False_ind] | @daemon]
- |>Htout2 [>H2 >reverse_single @Ht1 |>H2 >Ht1 normalize % #H destruct (H)]
- ]
- |*
- [* #rs10 * #b * #rs2 * #rss * * * * #H1 #H2 #H3 #H4
- #Ht2 %1
- %{(a1::rs10)} %{b} %{rs2} %{(shift_i sig n i a a1)} %{rss}
- %[%[%[%[>H1 //|//] |@H3] |@daemon ]
- |>reverse_cons >associative_append
- >H2 in Htout2; #Htout >Htout [@Ht2| >Ht2 normalize % #H destruct (H)]
- ]
- |* #b * #rss * * #H1 #H2
- #Ht2 %2
- %{(shift_i sig n i b (all_blank sig n))} %{(shift_i sig n i a a1::rss)}
- %[%[@H1 |@daemon ]
- |>Ht2 in Htout1; #Htout >Htout //
- whd in match (left ??); whd in match (right ??);
- >reverse_append >reverse_single >associative_append >reverse_cons
- >associative_append //
- ]
- ]
- ]
- ]
-qed.
-
-theorem sem_shift_i_L_new: βsig,n,i.
- shift_i_L sig n i β¨ R_shift_i_L_new sig n i.
-#sig #n #i
-@(Realize_to_Realize β¦ (sem_shift_i_L sig n i))
-#t1 #t2 #H #a #ls #rs #Ht1 lapply (H a ls rs Ht1) *
- [* #rs1 * #b * #rs2 * #a1 * #rss * * * * #H1 #H2 #H3 #H4 #Ht2
- %{rs1} %{b} %{(b::rs2)} %{(a1::rss)}
- %[%[%[%[%[//|@H2]|@H1]|@H3]|@H4] | whd in match (tail ??); @Ht2]
- |* #b * #rss * * #H1 #H2 #Ht2
- %{rs} %{(all_blank sig n)} %{[]} %{(rss@[b])}
- %[%[%[%[%[//|@blank_all_blank]|//]|@H1]|@H2] | whd in match (tail ??); @Ht2]
- ]
-qed.
-
-
-(*******************************************************************************
-The following machine implements a full move of for a trace: we reach the left
-border, shift the i-th trace and come back to the head position. *)
-
-(* this exclude the possibility that traces do not overlap: the head must
-remain inside all traces *)
-
-definition mtiL β Ξ»sig,n,i.
- move_to_blank_L sig n i Β·
- shift_i_L sig n i Β·
- move_until ? L (no_head sig n).
-
-definition Rmtil β Ξ»sig,n,i,t1,t2.
- βls,a,rs.
- t1 = midtape (multi_sig sig n) ls a rs β
- nth n ? (vec β¦ a) (blank ?) = head ? β
- (βi.regular_trace sig n a ls rs i) β
- (* next: we cannot be on rightof on trace i *)
- (nth i ? (vec β¦ a) (blank ?) = (blank ?)
- β nth i ? (vec β¦ (hd ? rs (all_blank β¦))) (blank ?) β (blank ?)) β
- no_head_in β¦ ls β
- no_head_in β¦ rs β
- (βls1,a1,rs1.
- t2 = midtape (multi_sig β¦) ls1 a1 rs1 β§
- (βi.regular_trace β¦ a1 ls1 rs1 i) β§
- (βj. j β€ n β j β i β to_blank_i ? n j (a1::ls1) = to_blank_i ? n j (a::ls)) β§
- (βj. j β€ n β j β i β to_blank_i ? n j rs1 = to_blank_i ? n j rs) β§
- (to_blank_i ? n i ls1 = to_blank_i ? n i (a::ls)) β§
- (to_blank_i ? n i (a1::rs1)) = to_blank_i ? n i rs).
-
-theorem sem_Rmtil: βsig,n,i. i < n β mtiL sig n i β¨ Rmtil sig n i.
-#sig #n #i #lt_in
-@(sem_seq_app ??????
- (sem_move_to_blank_L β¦ )
- (sem_seq ????? (sem_shift_i_L_new β¦)
- (ssem_move_until_L ? (no_head sig n))))
-#tin #tout * #t1 * * #_ #Ht1 * #t2 * #Ht2 * #_ #Htout
-(* we start looking into Rmitl *)
-#ls #a #rs #Htin (* tin is a midtape *)
-#Hhead #Hreg #no_rightof #Hnohead_ls #Hnohead_rs
-cut (regular_i sig n (a::ls) i)
- [cases (Hreg i) * //
- cases (true_or_false (nth i ? (vec β¦ a) (blank ?) == (blank ?))) #Htest
- [#_ @daemon (* absurd, since hd rs non e' blank *)
- |#H #_ @daemon]] #Hreg1
-lapply (Ht1 β¦ Htin Hreg1 ?) [#j #_ @Hreg] -Ht1 -Htin
-* #b * #ls1 * #ls2 * * * * * #reg_ls1_i #reg_ls1_j #Hno_blankb #Hhead #Hls1 #Ht1
-lapply (Ht2 β¦ Ht1) -Ht2 -Ht1
-* #rs1 * #b0 * #rs2 * #rss * * * * * #Hb0 #Hb0blank #Hrs1 #Hrs1b #Hrss #Ht2
-(* we need to recover the position of the head of the emulated machine
- that is the head of ls1. This is somewhere inside rs1 *)
-cut (βrs11. rs1 = (reverse ? ls1)@rs11)
- [cut (ls1 = [ ] β¨ βaa,tlls1. ls1 = aa::tlls1)
- [cases ls1 [%1 // | #aa #tlls1 %2 %{aa} %{tlls1} //]] *
- [#H1ls1 %{rs1} >H1ls1 //
- |* #aa * #tlls1 #H1ls1 >H1ls1 in Hrs1;
- cut (aa = a) [>H1ls1 in Hls1; #H @(to_blank_hd β¦ H)] #eqaa >eqaa
- #Hrs1_aux cases (compare_append β¦ (sym_eq β¦ Hrs1_aux)) #l *
- [* #H1 #H2 %{l} @H1
- |(* this is absurd : if l is empty, the case is as before.
- if l is not empty then it must start with a blank, since it is the
- first character in rs2. But in this case we would have a blank
- inside ls1=a::tls1 that is absurd *)
- @daemon
- ]]]
- * #rs11 #H1
-cut (rs = rs11@rs2)
- [@(injective_append_l β¦ (reverse β¦ ls1)) >Hrs1 <associative_append <H1 //] #H2
-lapply (Htout β¦ Ht2) -Htout -Ht2 *
- [(* the current character on trace i holds the head-mark.
- The case is absurd, since b0 is the head of rs2, that is a sublist of rs,
- and the head-mark is not in rs *)
- * #H3 @False_ind @(absurd (nth n ? (vec β¦ b0) (blank sig) = head ?))
- [@(\P ?) @injective_notb @H3 ]
- @Hnohead_rs >H2 >trace_append @mem_append_l2
- lapply Hb0 cases rs2
- [whd in match (hd ???); #H >H in H3; whd in match (no_head ???);
- >all_blank_n normalize -H #H destruct (H); @False_ind
- |#c #r #H4 %1 >H4 //
- ]
- |*
- [(* we reach the head position *)
- (* cut (trace sig n j (a1::ls20)=trace sig n j (ls1@b::ls2)) *)
- * #ls10 * #a1 * #ls20 * * * #Hls20 #Ha1 #Hnh #Htout
- cut (βj.j β i β
- trace sig n j (reverse (multi_sig sig n) rs1@b::ls2) =
- trace sig n j (ls10@a1::ls20))
- [#j #ineqj >append_cons <reverse_cons >trace_def <map_append <reverse_map
- lapply (trace_shift_neq β¦lt_in ? (sym_not_eq β¦ ineqj) β¦ Hrss) [//] #Htr
- <(trace_def β¦ (b::rs1)) <Htr >reverse_map >map_append @eq_f @Hls20 ]
- #Htracej
- cut (trace sig n i (reverse (multi_sig sig n) (rs1@[b0])@ls2) =
- trace sig n i (ls10@a1::ls20))
- [>trace_def <map_append <reverse_map <map_append <(trace_def β¦ [b0])
- cut (trace sig n i [b0] = [blank ?]) [@daemon] #Hcut >Hcut
- lapply (trace_shift β¦ lt_in β¦ Hrss) [//] whd in match (tail ??); #Htr <Htr
- >reverse_map >map_append <trace_def <Hls20 %
- ]
- #Htracei
- cut (βj. j β i β
- (trace sig n j (reverse (multi_sig sig n) rs11) = trace sig n j ls10) β§
- (trace sig n j (ls1@b::ls2) = trace sig n j (a1::ls20)))
- [@daemon (* si fa
- #j #ineqj @(first_P_to_eq ? (Ξ»x. x β head ?))
- [lapply (Htracej β¦ ineqj) >trace_def in β’ (%β?); <map_append
- >trace_def in β’ (%β?); <map_append #H @H
- | *) ] #H2
- cut ((trace sig n i (b0::reverse ? rs11) = trace sig n i (ls10@[a1])) β§
- (trace sig n i (ls1@ls2) = trace sig n i ls20))
- [>H1 in Htracei; >reverse_append >reverse_single >reverse_append
- >reverse_reverse >associative_append >associative_append
- @daemon
- ] #H3
- cut (βj. j β i β
- trace sig n j (reverse (multi_sig sig n) ls10@rs2) = trace sig n j rs)
- [#j #jneqi @(injective_append_l β¦ (trace sig n j (reverse ? ls1)))
- >map_append >map_append >Hrs1 >H1 >associative_append
- <map_append <map_append in β’ (???%); @eq_f
- <map_append <map_append @eq_f2 // @sym_eq
- <(reverse_reverse β¦ rs11) <reverse_map <reverse_map in β’ (???%);
- @eq_f @(proj1 β¦ (H2 j jneqi))] #Hrs_j
- %{ls20} %{a1} %{(reverse ? (b0::ls10)@tail (multi_sig sig n) rs2)}
- %[%[%[%[%[@Htout
- |#j cases (decidable_eq_nat j i)
- [#eqji >eqji (* by cases wether a1 is blank *)
- @daemon
- |#jneqi lapply (reg_ls1_j β¦ jneqi) #H4
- >reverse_cons >associative_append >Hb0 @regular_cons_hd_rs
- @(eq_trace_to_regular β¦ H4)
- [<hd_trace >(proj2 β¦ (H2 β¦ jneqi)) >hd_trace %
- |<tail_trace >(proj2 β¦ (H2 β¦ jneqi)) >tail_trace %
- |@sym_eq @Hrs_j //
- ]
- ]]
- |#j #lejn #jneqi <(Hls1 β¦ lejn)
- >to_blank_i_def >to_blank_i_def @eq_f @sym_eq @(proj2 β¦ (H2 j jneqi))]
- |#j #lejn #jneqi >reverse_cons >associative_append >Hb0
- <to_blank_hd_cons >to_blank_i_def >to_blank_i_def @eq_f @Hrs_j //]
- |<(Hls1 i) [2:@lt_to_le //]
- lapply (all_blank_after_blank β¦ reg_ls1_i)
- [@(\P ?) @daemon] #allb_ls2
- whd in match (to_blank_i ????); <(proj2 β¦ H3)
- @daemon ]
- |>reverse_cons >associative_append
- cut (to_blank_i sig n i rs = to_blank_i sig n i (rs11@[b0])) [@daemon]
- #Hcut >Hcut >(to_blank_i_chop β¦ b0 (a1::reverse β¦ls10)) [2: @Hb0blank]
- >to_blank_i_def >to_blank_i_def @eq_f
- >trace_def >trace_def @injective_reverse >reverse_map >reverse_cons
- >reverse_reverse >reverse_map >reverse_append >reverse_single @sym_eq
- @(proj1 β¦ H3)
- ]
- |(*we do not find the head: this is absurd *)
- * #b1 * #lss * * #H2 @False_ind
- cut (βx0. mem ? x0 (trace sig n n (b0::reverse ? rss@ls2)) β x0 β head ?)
- [@daemon] -H2 #H2
- lapply (trace_shift_neq sig n i n β¦ lt_in β¦ Hrss)
- [@lt_to_not_eq @lt_in | // ]
- #H3 @(absurd
- (nth n ? (vec β¦ (hd ? (ls1@[b]) (all_blank sig n))) (blank ?) = head ?))
- [>Hhead //
- |@H2 >trace_def %2 <map_append @mem_append_l1 <reverse_map <trace_def
- >H3 >H1 >trace_def >reverse_map >reverse_cons >reverse_append
- >reverse_reverse >associative_append <map_append @mem_append_l2
- cases ls1 [%1 % |#x #ll %1 %]
- ]
- ]
- ]
-qed.
projects / helm.git / commitdiff