From 600fba840c748f67593838673a6eb40eab9b68e5 Mon Sep 17 00:00:00 2001 From: Ferruccio Guidi Date: Mon, 14 Oct 2019 12:07:33 +0200 Subject: [PATCH] backport of WIP on \lambda\delta to matita 0.99.3 auto tactic of matita 0.99.4 is broken for now WIP on \lambda\delta continues on this branch --- helm/www/lambdadelta/images/bronze-03BB.png | Bin 0 -> 45359 bytes helm/www/lambdadelta/web/home/home.ldw.xml | 3 + helm/www/lambdadelta/xslt/ld_web_root.xsl | 8 + .../basic_2/dynamic/cnv_cpce_etc.ma | 16 + .../lambdadelta/basic_2/etc/cpt/cpt.etc | 54 + .../lambdadelta/basic_2/etc/cpt/cpt_cpm.etc | 108 ++ .../lambdadelta/basic_2/etc/cpt/cpt_cpt.etc | 62 ++ .../basic_2/rt_conversion/cpce_drops.ma | 44 + .../lambdadelta/basic_2/rt_transition/cpt.ma | 76 +- .../basic_2/rt_transition/cpt_cpm.ma | 53 +- .../basic_2/rt_transition/cpt_fqu.ma | 63 ++ .../lambdadelta/basic_2/web/basic_2_src.tbl | 2 +- .../lambdadelta/ground_2/steps/rtc_ist.ma | 4 + .../ground_2/steps/rtc_ist_plus.ma | 6 + .../lambdadelta/static_2/relocation/lifts.ma | 16 + .../static_2/relocation/lifts_lifts.ma | 7 + matita/matita/lib/basics/deqlist.ma | 63 ++ matita/matita/lib/basics/finset.ma | 183 +++- matita/matita/lib/binding/db.ma | 110 -- matita/matita/lib/binding/fp.ma | 296 ------ matita/matita/lib/binding/ln.ma | 716 ------------- matita/matita/lib/binding/ln_concrete.ma | 683 ------------ matita/matita/lib/binding/names.ma | 78 -- .../matita/lib/didactic/natural_deduction.ma | 863 +++++++++++++++ .../matita/lib/reverse_complexity/almost.ma | 24 + .../matita/lib/reverse_complexity/basics.ma | 106 ++ .../lib/reverse_complexity/bigops_compl.ma | 607 +++++++++++ .../lib/reverse_complexity/complexity.ma | 290 ++++++ .../lib/reverse_complexity/hierarchy.ma | 212 ++-- .../lib/reverse_complexity/sigma_diseq.ma | 153 +++ .../matita/lib/reverse_complexity/speedup.ma | 572 ++++++++++ .../matita/lib/reverse_complexity/toolkit.ma | 983 +++++++++++++++--- .../lib/turing/multi_to_mono/multi_to_mono.ma | 397 ------- 33 files changed, 4223 insertions(+), 2635 deletions(-) create mode 100644 helm/www/lambdadelta/images/bronze-03BB.png create mode 100644 matita/matita/contribs/lambdadelta/basic_2/dynamic/cnv_cpce_etc.ma create mode 100644 matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt.etc create mode 100644 matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt_cpm.etc create mode 100644 matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt_cpt.etc create mode 100644 matita/matita/contribs/lambdadelta/basic_2/rt_transition/cpt_fqu.ma create mode 100644 matita/matita/lib/basics/deqlist.ma delete mode 100644 matita/matita/lib/binding/db.ma delete mode 100644 matita/matita/lib/binding/fp.ma delete mode 100644 matita/matita/lib/binding/ln.ma delete mode 100644 matita/matita/lib/binding/ln_concrete.ma delete mode 100644 matita/matita/lib/binding/names.ma create mode 100644 matita/matita/lib/didactic/natural_deduction.ma create mode 100644 matita/matita/lib/reverse_complexity/almost.ma create mode 100644 matita/matita/lib/reverse_complexity/basics.ma create mode 100644 matita/matita/lib/reverse_complexity/bigops_compl.ma create mode 100644 matita/matita/lib/reverse_complexity/complexity.ma create mode 100644 matita/matita/lib/reverse_complexity/sigma_diseq.ma create mode 100644 matita/matita/lib/reverse_complexity/speedup.ma delete mode 100644 matita/matita/lib/turing/multi_to_mono/multi_to_mono.ma diff --git a/helm/www/lambdadelta/images/bronze-03BB.png b/helm/www/lambdadelta/images/bronze-03BB.png new file mode 100644 index 0000000000000000000000000000000000000000..3cf5900001a4aa5db28039ca442cb3001866cfb0 GIT binary patch literal 45359 zcmb4qg;!MF_czi=gMiY~($YPELr98rcO#*6Do6||Qqlr~Al=>Fj!4JQHNenA4g9Xp z_x%Unz1DEKcNR0;bI;jle_})4XebdrrhbfuhDP{W8T=MF&i#9lU;{trt4=C_1E#&4 zx*Qr>bprmKB^Gf0=)+qjd9;cN+CAWe(OUVfIvSck8yecj&uC~jz@?A7XlP#iXlVNu zXlN4O(9o#dvs$#IfH$zMRF%LF{{@}_atXMC=dNt{0XQoE_fi~omic$l+g;8cIR5vK zpyivnm;j%N_8KgwVRN?fzyX0d%T7f|q$^>d~L=v+`kbb8|S@6?jvj7_(?S_Or5( zTlJ>5INqgtwvlmxlX%w>zv#H zqkL2lvFDyl<$9Hx zsxc_jpQ=Du56-&?hG=$wpQOTVLp3M|ev)M*!EHMkh^BzuZRb9;*(dnssJL@#;QSko zGtz(lRsC{jRr4N{rq)?JH0zFeL#|s{bL*!5{b=Wf{D7eB~=Pc8L=P-q?`IoeikTHH)tkN*cC$E|Bgb(w?JSs;)Za1mUKP z?6tGL<)LH>>$a*kh!PNZ|Dm=fxe`B4v*0xl^Q}HsOtd-Q<{HW?D?3Acui`|(aT=^* z6hF~*(6v3@q7m-zLUU0E6OxD~49tEt|5=lQsl5vcQ;m3EGY%mc`o}Nh>^+l*w)WvP zPZ{60Mn;(MHqg;XUO;xi7=8A&wzlcxE}1zR$vHV`X-U08(yiH!!4jqi*LiRFpFSoe z;Md+78wh-?6b579=E} z$q^F1?4hQy&d?SpY5^x^{F-`30M>K1E1Dle(h%6ycFWrE8t$weg6R9WUNNp-+ytr#o?jQ`h)PKzCy5QXiIn^$n1yQ7Nlo-9wKOyg4Lz!}RxN%J zgv;l-UulMr35%xu))~VA#^WXX7gCC|lRh#Eq2i8??d=8;wr{2t&CJE;=WT6cV+QEx z&@QA+qrI)I&Dfm`IS?m(r<HVNAUNA1O!AAS*x-x zhKBw9>FMv|2>S+b56vHR3F);GasNFmEXJ}PAhNO^ZuqonLs#kPkB*KGS@-uPyvy39 z{kl_Abl-l>9K{`3V;mXd=H}*L`~x4iE6~zVQ~Au|#H5sPwCHp2G*QpF-iRBFPpP9v z`Q#YB;qT>jAl~2>ayfsvczvCFx0%-A*-Kcxb`VK)xDs^E0iDRMY;Onw!9p&kfp-hj z$S5dNlQ*|cP|M47bU{Jj%C=L`!`Y1S$YAU8t5+KA(1&{jA{e<}8u%~>x^JE|^`gM< zaTl}7Wthb0HV-~(R!tp(Y1ZIk4-N#%+@rE5a&o%m^7HcIx1mp#&y4q*?PajV&RFtB&;ep^Z+;%yQM?BNm?e!@O z2wxd7wk~oQap;p=s>9@Z{GIf1N5_(q5$YT>H<3&=Fc#MIbV^Df4N;_g9tm^Jk!#T> z=B5M(nO1FIK3?CLT8Y1ZpQ!r&7PG%u27fp0?Ok4$mIj-eUR;=(LNZhFAO9+iiSc{# zL%C{W16YD$Kq?|UJODC-y_l7Hs6@8jC?0;_Z>Y!l?#ag3Ea~Bg#OHjKH8oXlj>

Nvg^QCub7z=hi)!r%{wi_6q(5gqI6lR7F}C+a-1tuaNNdpg%~R^(7*A3 znKqG@vuUWD-4EZ}Yc{}1Y(lRRkI~MP4i_6;=3CP^*nj?Dk<8p(`oPyx+#qs&xf*bJ zAuQV1So_YW@igFr*kkPz!JAv$l5+=AdU#z~!( z$_~H(-rO!ONJvDrv?kEO_bl;?2M0E16UmKOJs?c`Xi zrf97c@xgeZRiSc}sF{VEwMZ{7aBr`vDKqma{NEDO7!=|k{S%YeiFYswIz)M-n&IlV*RI z7>KK{2VY;uy4xJ~1q{GUO$X!YKodfB9Ws=tXOD+rs&;l-T8h|Oe%H|yF;r*Y8A+(~ zX{q?`NA&3f4k|;Y9fYXk*k}i?IrFm3-ryYwVa-@Ri&HG>TCt3bWen zP<#ze6%{B0)gyRLSC~53OjA>TwhJwBP*7t3g3Pd7#MpC$ zwF^OviT;Qw&hEVc*_t5Y+%wX8zlDMAyA4v6a{Z!@hw;{QhUhLk;}=lK-XW5oDC*1! z#EE9Cx|_S4NZ!&wKXZ#$pXvd%7Sw^vt?|k%d4(^SDxvp!UC&#J3-qclo|T#bc^f8| zAC5m;VcL?+Avm>GWn|q+C4@Zj=me24*32JV?tUk4<0};w6l4zL;H%8fFOE`w%ElHo zFkr%)o6yPE1^1F@H_PwnNKMV5�IcqyDRWTT?lI6pFK=u|ctxUFiwQ0F-P%l&FC z(%jD$)`5h%Ig0zbBUY4uG+(cFw+9GkjEpQS2s`Hoe2vzA^b6ZN8Y4r`$jB%|19=M* zL^o;}+o7Sm@Qqqnkh!bs$Z_!Ww6JI?<{bm8s;2Rlm#l%=GWR$YN-d?ozD>^I-hB?; z07p@ODL#o}E1qZ4ieuLz^y+x2KUscGpM1m|j1wpt$ah!q#MG(U#;)k+XeZYtyR%=_ z;)nNTdigaq6kJYDzM!0MxZyo(y^%omJ@_hbGFWeVOygZv&#=dYhU}F8)tYW;&)V&g zAT_XMd(85ZPz9nh1YZr%1Y8b5@G(3u_MI!5kL5+)Q1NYd#)QgdSz;KV5ilC5SBg>- zVmDi8lew>ZkhrU`Nsv_TCiVKMq4k?ZW;U(6*>+v@mCps2g{h=A*-#TT)ZC6PF!#Es zC#<8AS90g*J@UKRHMsYxn`AW9BDe!&4m8zmUq?VEot;JBNjwC~5P>b0ENCrFEVC?^ zgoUK;j_pCW*$94ht&a{mU+a*JeE;!$?5_{2^Mi{pH*|;D$sN+5RFbVSo6e{1TZ9|_ZCJ}h zHvYE0&eM~CfW*s(LCV0K0m5zKdw)He>L}FQe0`mse!Al=VYvOJsHi<4fnf*C-Q%L6 zDM}6b^=qcguqAoOq0V5;t}U%MGQi(IATmPa-P?j^nuNtNRY{m*t7g7yQ@Lgh2imzK zV`C#DL%v7i+Z4scy9l>;@7&mbRl=IjcD3x7Afl@l)MX{jtDzKJb2oIQDYt5UJjXM} zArH3`*>qm60go9@54G`U8L8i7Vqv z`Z}X*jh`_WCEcQ*Z(};7Scg_Jud?#_G`zD8Zd71O%^)>YcBk9P{lS%Kt69)R7;%(@ zT9#f43M{PHF9xjdwwW>bCvI-jC)IumJ{6*7 zDxF>%8X6iOA95EvxRgA)y4&Gvb(ydE^vV3ee>4>XXMbNOcYYYy)7hUg@}`pQ0J%(9 zn3a`v>l4m5LYRxI>q_Ut5NYb8f=1EH!1fiJKk#RkJfaHtzP;Z$R^qTeO++*Dpb|*w>lQP@=M&%N7VS35<+qsj3;=;VD7|z z7&baL62=#NlGf?6ta5$}>pcIn(hklPb%O<;b0jXi3JFZBmCQzvBqQW=8!2}0e%Abu;08Wh9&<^k2tsVKKzBe7Nx3d7YC>YWCzxU2G?N-%k6;;S zB6D`O2D{dWv(@jjs^?u806=K*0>fu34YbTADyL>OLql5@D9t5kRxQlj21bEW^ltMtw?)ss_br4+ZG0~)s}tgi*;#)= zN>nTVO9jqaeek0Q*kMz7HrTwT`+VPjcd|Gm0F&C;?`+!Gxh}G0;L=cgA4+(~j`tO` ziejt$t28Jmz~SNeRC>BE@P7aW^f@%mjEVZGMW}IsrQl6y==%DS$+cfo1;=;r6qVB5 zGhQ`+fhj}oq6~CfWVapxUz(#6a^-f^yyH#)dNzqznEngiJn?P+gr*fBS*mooUwVsd zY$PxIp$6a-aH$@T;aj5-b^pai2C?5uW0MaPKCbOvher8}Zk?A4XA{gV_cs@CDn2&< z`|EP!1ls3LPWuP6)J(u-d_I%9sK$cY4;B`{`W;OTx-~KqTl4fmUP@%EksH@V?Lyei z0uEQ@@)wLmw8VF^3ROo(n%u~#4d1`Dpj}?ph9AQ z{7uenu^}Wxn;aTOEOWEVRY_tRg7WD&+f2H1!)%T^92w%LE+|;IKaO+@x!umZZm1EE zT(o*F5!h5x(wPgw>8VzTd}q+a7Q?+!o9M zC$2$o3T_Px`i!~clV_GN2M1JvK)DnXZP#`Uy40etUiJ36`ndSffS>akd9H<*>XCYR z&rA!8kP#9!G)iXQiQOFn#N{or7V{C8{`O{-$6X(JTwLeP^p1?aiHRwykPmg_1G*ti zqH=m%Ixo*!^-MnN^>YquU__Z{JI*vZVH=ifhydiw^viC_$wpnXi9pJ4Cy&G-=GChG`g|S|f8fJv^&~<6hK`~>@yAn2 z0yWJ39bO*OhO(jvip_(=e=E_Qap7wy-afQou@SL2m|72fzm1Slx!qY9v53&!zJ4ys zMWMeZ-2CPbBIF^QkCCc?LsLgymEaerr0T~erbGw?f~R4EJMxsl-m;lm-HB86b#iLz z*Pgd+ps)p3%jLWRL5Fk%dHdeZ^bfg>8@~H-U1{)L5*sFuBm; z4mKDb?vW4oK1ZtlC;f+u@O>+Fj~Ge{3I+0~LKK+BXq~9Tv&qhfV3%7?uF=u6(Y2~hnzK0mR{zmcdx5x@3;Lu;z&!yHu*|U5 z1~0+vEqc~wbF-hH9+#H4w}*!Yk(SrRdcUnLSi%$lO-3%h;tge4;I<19+yz+@g}|h5 z+$KhtYWy+`XW8G>xR*d8fs!KJ^m5El%iF?2Kfh&JEmE1hF;zd`Oj>N9lT;Lv8dI}`&(6;1=^Wo~1eWUlR8?oaS=x~~O~mJA{No^> z2e7KwJIEuT&Zd55`66yY(rx(bS29;J<7%t!&`|XJ=;$Sr%s5BdjScWlR__cf2n82i z_PoCa$56iPiMf0c(F>-;$Ny^3=sNs$-75bVr#D?0S84IkFCLy?qJt-8T0huZGeiA$s*%Y# zuC)r8HvI^q{5~YrEk>weUvT-~T)&E;E0h=rBr3`rHsm@vQZpYlA#Q)T&>v&?EYAT} z$lX|E<_1t5;Jv-Eb1{h#$~#T9D#Yi4$jH`K9PBv>^{_`f(=+#@ohAW?`_oQO@740i zzM;z+blxr(sbgVXUjvU|P{w;LT+&-jBSL=dI7MF~yS*JCaCvxei0bP426WQZL^91Z z>nytcc6iJuaImr8aP--Q^6Hzzy3oj7Uc9Kr7_#8c9Jk9KQxkdfR{JNBfh=v4fHo!O z$3N)vbK#ZRl_06H{5sd>tw_*PTe?GFR{G3@beiLvVcsYTEPZ|bfB`;i|-ZXke{c_17g;v!xN?`mVBmU;QaKOap4D|6#;C)E`X$A@HpdalHu7N9FDNJrCV6An#A$Y)h#!y zb$N!^Wy(8PsJ9)hFijl7VK|tB{{9XnAVwk+Vo7v$fg)6|=s=qki{QIw8$nHam2%V- zT_`d5WJ2=d0+=U_%MF&V)Cs9b*1cp2a2qKX6X36YA1zG({=KML=RBLp4B#hVw!teI zWYlzYk`pZjNKt1XnCBE0)p5E^h0naL^9;8^S5#?H1dQtNQ<1%h;8ZrpRny1l&J;Wy zzZqY{frJurvUEmDJkq|%9TMTW7+#~AAH`9{ZCRujU0uJwEUKTMj=DVS&Jf0@qI}}c z1hAwufe&BFyiq|wy?YcbP2cMvl}?rt+U!w(6voHH!oc*zQ>&^fbEi*MG%op=nL!{) z$KuAFyxcTfYuj=bN?*P3Iv51`QTrV%pFbph~;m7LIdHNVDY-58) zl#^6nkCLl+F#n4cL^bPWM6X>fbVwni-wJrNiBZZX>wYR=OcwvP1DStH3KU<$cD8jR zzO*9R%=h+u$|dNDklKk%S**fA@QIA`EI=mf^aY9G9)0A4H+G_KX5E@T;p=2Y*3i$P zGd+R;1RkWrybc5LYN=;4veOo3?9DLm;mc<*cZYbmpPw}IV+Ekd!(hnLdweZ*_1CZU z^bUMTI&nhvs^SUYe}eDN_yX5XN3T6#w<}4St}xzQS)h>NPQvSX7#*3z#O!_n(lI?!iT&^JjB77F8-zoBy==~1sUqwbKDrHYVwYIGxR2Nat z?qClc)=EG%SZ&R%yjs8@{c!h-(>0?zh@YGa8N*La7*QvbUs@@HXai6&9x-(U!S6e; z`s+4gc8Q{N%TfDPZK_Mf&Ou*zu8nb>(o)fnzS;B5lJs?FYRDyy!}n^#>kV>@-vD8? zK#G8V^kRNEo{Jg`j2yCl6NC>-@c5 zLwe=TA5bAaupj^fJJ0Z&&rgQj|53#ua?jma??2`lSpa#hhi@DQr%aF|N8cDWJ7_t+ z0MsxpePDa+LxThpw@OP&3MO&T5@83)%shn2-J2>Y8S=h`*7;6K&zjWwdj;QD249SD z0a)w&>o16UzoDiDBey4RViQRgbR~FGSt@RHZD>+ca|hnoMO#_dzBWU2L4C_#@Sl zbB2eL9Z=^jZ{pN&puK?nlSGGWa#fKBt8kRE1gU? zAE9-*Y>Q4u{)7Zy?TaR;-CF4t26PCwv@6bGa=O&n3BV~{^uDXrgDd_q#Xs#m|039p zYKs7Dm08>XKrGQT2NFi!1PH8`*0 z@Jr<;qzir1;x__$i)bV7#{H*B)He>&^O2?DlFR}d=?=(kc?4JRBSrJ$60q)psY6>>cqaMZm1IRCFs(y#+d%jE(- zZ*j>QJWj-IrL(gj%$y2c!z4s_YKH`t^v9!y-(^0i54DckZgJll6HM;|X}+#iIhR1| zK&0sBe9%z9(z3Sp@u`D6gKvH;P%?bX&dm||;wgOR-={rX?_8f4u(|IQs-{s=^j`*G z{ zUeE3$3;wES#j#BvE%?b^D;{$aHZ?Qx+Pv>VxA0iqkl5Pl@1LK~`gng~4myEczzxq0 zow=x#0kUL>xw3NtqE=}Sj&SINY9$QrFdKCSU!R`7KT1k$$0nVabazU@ zrK0Kw3Pl{=-{$&S!Sz-U;4YTyUWVY47=2UL5Diu_j!zk?t=B;*+Ihy{lvP+ zM`VJF?(v8>>o`1|Ta6Z&K(wB%ew1Egv5y=a7{%`HftyOHGzk(`?SGQ}{MF1+^MH$R z16VMk4_`k0r~_h$pjv#6-92`GO&)|8&fyEz_gLe*f#$tZBX8aR^VxU^ zJy$O5Va&dwZ3BH){7ZcKGSOXdlNxAeU&a>(adx_QgE54XFc<|=x+dOyFMI9Z zGW=tfL8=(Av-k&jd#jG#qm&XjeP~(bgpK8-VWAxz9R=17QS2W5V;2Fi+q<3g7w-Eg z&}B6aL*S8k&P(~fb#JyYp0V^5i#!9%iOy!kj{S|i{q*q)hK(`${iSG1_zpffd6b!L zIH(}$g_4qav~ucPN{41XihTAH9uM@aA1`@MQ{j7VepzfWWZYYdRnj9_orOGG_J#Tn zE>692qZ-WNpEx+Cyt#Z&O`6|t3^3eToNedj)rJpEP?Iz1z|HU0sXCkB6+FfUO-|n4 znwqa(efYrb;aJc8;g#Y1>6UT@%`z#*qsm!0tN&sBPR?R;Qslhrl5a1e^Xx=hb}gMl zWk*W@@?=A5cA2Wv_aEtV`sq<LNACcSSe@VBpk>QkmVf%%{LF<9w87(;OHTHj2uI9H_!Df5Othy2+DW*Qv{+bvepzVTlntvQ!otESh2O3E@IS8lUS7W8pxw5-Sq~t8 zPDc0<`8=4o5HD@_Ht_=I#OEcRzT&AqgyI4(2ZH(djFF;+BP@ zy*|nZy3nc9yjza}VCn_DxgUL&?}cGYUCmcV8+G-iAGqRJ&HZX$=I61n02e`vEk1s0 z=W1y6OK%Vhp^P@fDr z`M01*WlZBA^6Wt*KtJ9bbq7DYuF(rg2UW%l^b|^F-uIlDhJLlF_zLy z{UHJMh}&p0`w2k9QG5%lohnu7aoX_kYe2th zzuBMdXmFfjPB8JB)(mN}9hF9A?SZ`qGD!Lv9oAMo37sv_k&bqi%1a6cr5~ z7ees1!_+9(suT;Le`kOG*!3(a349*DNJkLSdvdxsNdSP#%IQ;~-lU|w-+f@ibUhjf zm`PZ8*o;qD7Z8*T6meU#Ik-xj#P||`!;c?TZ|I5Q{T+VKZU2g$P#Z12yX^!>&&p1X zzjI>zt0#R%nBV=n^N+*%0Q%5xr+)=!R*nQWeh{pI&5EvZ>9??GY~=6nD{w@?rB_)| zlBh|GmKIa~>Tu7|<4~a%M5YhzjiHba>$u+TBI)aiX6T{)kP8?9CKm z^_O;V_w!3hxxNNBH*akf7FLsErWd7hC*O1)h$Tcia{taE2~L1e=9`kv@U26Y0E&xP zCW=r*-c)=Z%s21Nb`vNV1iGRtdi4*|9Om4#D)x>xR(ZV(3&SBgSOnZ7hxI-%6ta^+ z99`UZn`Hi(vphEkz?h6I)PyU*UYhHxs5clvR34 zRI`yH(O`hwU+vx)Y;Cm;d*LpFOT3dE;OgZS99)MM#fO`mqyJZJjf?y_J)e`_`YjFh z{=vbK9e8?vSg7p&9=rn639XqI5InpTU3tS+a- zGN+%W8#^rQ@DTV~rFa)W=Ky7TG}Ko^z@8{UG_Y;;lP5Oz53?ab_h-fpw4nQ8O@ApG zktKilMuMoYtsSq))lsWb0(D$r;qo$jW7-7hIP0$Y@Dd9@C-4-iWbW?>pJ8~ovSu)D zZTR)8`sGss%uu;7xq|d>-?GYn^<4W-VqpA}8^J+AW1EH3MTOOy<7J%aY_vu^qe9)I zLyQ>Mfwl*&(J1-Pe-KQ4@cdlY`5GU$4}wsJhbAxQAZd19AX@|J%*oM`Z3|$+H@~u~ zT5*M#dr^#DBHRtQq2!z=G6HI8`8@tokU>IX!Q8usca~Hw^$IVR+ zeFwisH@cqN>(V%ea$)@!A^!dmk$}+!(2f#9mO8Q>b|wmxBqbqwWyQrq<8iD42ZJ8U zTL4x1kFi&(vmNaS;^C1J{!7&X6kN_TBzvAN*M%IiHW6IWtYpGWq=2ae%zcQIjMp19)H){>IeOy!@}TEA0L zxLMO27Q(|Z$WN+YQvN`{77^Kg9~W0$!zV(6zdtlcsvv4Us~em>+37_ zBpS?==zis?uHdzB+a+r;7>`<~@>%veW)ytJYaD^~X=5Weq)x1MzNQB7>9n=|`c)&a z1@HZg3)mk6n8G>iA44&b3(m2=Rd2{e?r<3H&VTZ?MBTQaT@jcCc_EJm6!o4pcIG-P zw=682zRy{v!{@Ork}32aX2dpSjHTNJb{rR1HYYcGuU`OZ9}o^`BF4!{a}vTdb_yxW8(?KJa3PvphBo(O&5EaZ?@bLaQ8#3y#OS zGhmOfAR1ZV;S=W*l7Ums*tuV+Blj$a5j8L|tEd zw+{E+`e~End(X99hY@FF_zGBlqjYQc+8D4MwW@5iC(gW*zS)J{Hw1_R@LFkbm9f+! zJE@n`PH+^{x$%!LAnTh<#XQ^zOtsD3>i2y=Zzc8rg&}YFW6!8E&`+g z6d9FSfXy{I&vu86eO_E1SBuc5@^ungJ5J?EO42KZ`raN+%4BA?dTcN!v>{jKzKw66 zWE}(-S#chl#?#f#b8?ycuI-mn@d`Z+ez;v*%gI?;VO9MmVy+vGkdj)O78U}W3j~CO zgw+?0L^z3NlQRX+CGR#_$g?11sdJ!y6jPRlUIXTa&2me0bQyPk0HS>>6`wD5+J&FK z^P+r^0oIZ-1SiDqwajl2*=7!SKmj>U!q+eNuMT*4pz^j1?EX>NX8kM<@U|2b1fojJ za=-S3exJMQ^}`P9w-ORyqM_TGMcx`#Mfa}*X&o$**_)W?G0e)PZ^WHAv^~z(_Qo8< z|9jS_CB<1hJZW2v7@%i`o_0J0-NkuFp9 zc8Z|*yx41#U_t!tlC+Pd!C0iD4`w?U6M|T7{lNYKk6*k#I)wZ?gSL5z>Ct~-xU@80}4hZEKI?{!MeJRC4t*hvx9cg z*48c&H4e~!l)94;&@C~HwoafavH=ukku4Tc!TWIQ63gJzq{*P8no)q8o%`5>$j(Ng zn3)0F%1c6gSx-w14FKtb&!Gtw#`@Z?0PC2)iLV(65phQpvDOBeeZx=?F1e-H*!yE) zA%6AJ%F5>E&RjZ>`0FQ+3yX?=fSGvp`FD{a$X4J%>Uu4E0o%J1nUvrsgpvM^yN>?D z&1`shSeTdB8o!{S>3fJGIgzHCgAl*4zm&$#F~63gqM4bu2tvPYg$iDoza1JJjS?f$ z>Z|c^tlqr<+EoN6U0`PVN}Ffly@|NUZ0R$C(ho(`HM=93u11ZnYw~8W3c!HM!4*^d z{iCfssqjzm)~ozMxM!j=zw+Pt;XoflLkbFUalj3Pg>~{ip+`VKLPBiUQ-GX_^h`Xm zcd1Vm`~#YtR%xD_Svo5!(s4RcZH+<^68?;NeUi-1?_pU3;2kv$nFlHIWV;V;Zra-R z>>zqAF>!HQTR%Uw;|#UHZ8kDPM@L;C95dp-hiIH&Oj-C{?@z0yngpIOJQUAXnxRIx z*jpJ&#HwYVKGe_h8hoD}%%BdF(-X0A|Kfl%h zkC(d_cC}`cYG3Gy(-ML~qkE3E)ydZB>GShMgW*&%r$dWw4AM7|pehk8^q(!SPwHMi z2h{ohS?-xD4qSfLHa2#G8f0_3yWU?Kaz6t?Q1kjLw@s1cGuIBkT}L~&UG$`1})3S(-KDl z(^*$HIJk{~v34BFMn;8+E#a#)2rVEa9P@d}-=%l_^9KnQdfpqxH-L+F?$GW`c-Cdb zM8~tALQ~qS<~A-`o96czB~M1y!BOzVwENu7+4T(2I5_2WaZ|>fVDB)ru{O%((on`7 z8OF{UZ<-+Nb;oH)-3KEr$Ddl&);wIAUs4ki=n4ECrPsEbZ#$}@a^*EJFfho@76lk> zQAiqU1H-&{BBq~7Jd2-f!Jp@NwJL@-V+hvVfd)N*1o+P{{DdGL0K?U(ECo+`SHp8nxGLiSW=rWMh#8ags!j#BwK zwO0pl@K66i&qG_f!2KIwLbYb6Gtm;Qyu1rerMm~1_K;wttLrNb&Bm5D=*&own3Jk>LYd068sVS*sbmBevFU*6y9_|4r zsNbzzs(Yx-pHO@oh-K!(^-j}?_z!JUfs0eZ?YXt>%2Q^H8o8$ z1vcuCdv(zhmPSq;7WAvJU}S5Wng32Udrs4Obd5la?KEe$M(On4uU~IOFsCv8Or4z? zC_dii+9>M3A|JJZ5EOOOxV5c@?mML>7Swztr-~0a8}E$-5C$Nw472+jtdfsMV5hEG z&sIc4teClm0!4HRSHWy%G&05Z251L~)ASrnsNL+qJ(9&H{zk2!27sWNQ;FCnG;RaY z%tLR0qG&LBCsI3a;d?p^c<`P4ueaVf0G$QtS)X5PvGU`A$48xn)6Z`}_b*AF($LT_ zQv+A@FV4o>tCO!^>xAOifZbjMuo4=+h5gg#%|s&7_AEDOGH@A3e>`U2)sd&RTsM>yA4u9TV$S zQ$tlm+%ENe{t$zzn0?TiDMnU^o@vAQo2UG!L@J_N*}XJa_k2@UYY6z zYw402!s-Xf7oQyK$;sD_i9@0~O)Kt!mbST#?|y|pe*EY=yKtxnEIZWDt+ZO3@3ST! z&c=6gCj)JuoE-+a4n+=*�+sHs;q7#R~va#HigyUpNeCBHE{>kEi>n$Q+QNTdJZe zC^$dn$YxlX5;clI`nH+n4-71~8Vb$mtW!UIN^|B9SPhzY9^+Rwtsk{&8sNO~&_hQN zpongveDM91AmpmtiW@Ycf9VJ0Cbr*$PtxtyJ9Qpg)&K>FqNYYVeUrTcRA|$5U>4`~ zG*otOZdzKRoadB!?)^E?TWIPvJt)%<+F?j$tH$Iuqv~YWFgcLAzdL~d*b%XEb2G<{ zk}w5YaPKr90N@>pHEW7&M~nyHyvbvFyz8?YIhPO|9n3}c?53IEDb=usj*`;+Y1(wD zstPTU%!C3XE~YG*ZOr%t2k-HqZO~-vNvfYn|?1#+-pBId!-v2XLv+!vT;gz=r zI1IsU>DbKT#ZFp=WpF06*?8^9x?03>V?lRv{|qCb`xBeNYn^sa*YAQfV>9Cg9P>+U2P$tLBWgqW}|m=&H7H!b(} zD)Ugd$s^qRhzCKYLe)t}7%|gr1lZ-52_fLfC))WI17Fe&4ZfvO-F7#)_+8E;SC}O{ z9S|!;Yz=P&056k^U4y0JAmqZMdV|CZXEk`KK`LdaZ{x#o|5=w@To_*X zt6SFhPqeeiXt|%tw(V2M68EJSjS<57d)z_rbrQEq=N63&bT_; zDxiNy-hJ>E(TTcDWR}AIUh|dpY~b1ew)bBXdxA{PH;WG8GG@W2v5M`%{n2NDz3jIW zKwE3~vwM&9A(foX938ozxe0kZVoO@4pTvwJ-aV^6)<-LB{qVt1z*v?=hE@K{xNnur zkJ=9o91_mbYGG(!mw}Am2K30XgE1?11Kj3 z9;R}Gw*{%p#|9CAB1sa9UcKH#^=Q1jy!@xV?>A#7n^VQQgQ3ew$}gp^$W@EFrEpqr zpdpeFy8=Q=N+;<(Db3yr$`V2+7v_uU2iiD9-#rF=3AqX5xPdakQZ98>%Og7b7jV87 zhc$Vow3u)v9bFy+lI+kITGPgkAPN4Ftf-H8YjAVG7k)Mob2#_Ewu0a~a$j$@H!FER z?KpPf&Q4CwF{~9GGL4HH&4>;jssrxTzOk`S$Iea$z-5eA`J`R zl~!_^RkdE}!qCK+%^Plh+5Yng#8xhA@Vhm+vWmSEyLAH%E z_#eTfUA8i=0mX};_4V})OG~2wZ+2pAG^Cjsqr=`;l0#Tn`zDPk3}BMM{QUVjGV7fg zvtZW!{iCCuh%Ec(kvoGJa{a^o!&M%Q#O2`YkIEf{IW0W`StF3|=ol?` zx^L%COgwvL=+Jb@IM9`T+bPc9fbh(kui|T8)n>;{P&Nr-1NO5!prBbH+RP?0pgVx9 zegs-qUPvVh5^dbn&2PEOciQ5MP_vYzB=?qK;!2IMl8&Z_09#u(T`uL|-xUWxcl$Zh zcsEUJe|P@Yc-a}&7ugx=v~)Rw^CEm>{XYvnAr6ka8#dm_+Ba!qu(flXfroVzixC9{ zfF4#robv}~#9r24N~5qU=gW)M>b)Z{YuNfSS4&{O*c2G3fc`*3GzYo}+Xb#8EI$u^ z;!u(DZgfsgZn&xH9BFQFq?bwp$F+<0NA|Qwku(Pftq+DQ4I8KU@z?hz;kb8~J$cu} z2H(grpjPNeTp1hBDbMke7=(B&L(t-Jn)59l?pJ$el#3e;T5{zY%vsZH@jqCytYBJg+yuRkBjK`UaRNY0j>IizcYwVIM;#lKK$1wL@>9g-6fzr7S5)w_Pf0*KK_pDs~-;!8ifks`fZ_D*WLnG~V!`!}` z!_qxW4YX(=bbcS4gPh;Isd9Vo?q0$wI0oATLVv^bBssTsR2G)qN#~@6sh0Dlhh}%q z=c=a}Og0*)2~iiXwQ~{S)N=h#KNS{Mj#@Kwa2iy?;lXr{0yF!hSb|{hPrdd7j7QUz zA>Q7hp$!dbM*TvSLs{IUy1}fhx_^qUx}J=+nT3d?3*u*LiAf5VP%Zy^b;b<;)@vCh zg1ELxM*Ow#Sif3S ztX-N&^p#6cW)PjoGFsJ2P0g4tivl&oPfAB#UL&Ey`Qgr{{S}E7)9*umTs|H?RXzs< z78UIHK2&PFm0(2zRKCv%?K-jhae=_hzdOZg5NpX%-npq)Yc~qN^@INh763~m4@dt{ zj1-;=nG5;j&7i8tPafSZaqt_^24cd<{KPd1I*H1H9v>?=Pvd}w8ABr@_4u5aGjv8i z^e&gad{`2AebD!o#ZiD-q){yqI-G`Iso12_P>droY z*`7Z^OXIm4d1zWEEx(x1;jM48tk&g9RmtLW@RG;8Ok`st>ht;{6u^LvUxJ9E0;&4G z3|z&h^^u@_)h>8ic_V|{xDXOD+HMj*Cqm`APycPzoX+=OU$d{Mqh+Gky=#6h9}+T? z+#u{;TTpmF^rBD5~;2A@HC$XV+yy^^C|)5{QSN`yQF2;yvEyq`LAICzAgO57ho|Q7sf(qT9o-fls1u>l$09) zZW0DX5)QK<@K6Lhhq$Yf>$twXBrOYDAHc#aIPo7LJr-(jNS2H5h#x>$6IrXD$jo)9 zGxp;bWa;Kv&*jxzd2$le?iSIC476*ld9C#K@N`#oh(b>S6DSF?L?7094_jW31LdRu zAN~#e7?FrYhCm6D&aN^1g9)|?6MRuvUC1^I6?@i)8PK66khY{88YzfF&PFae9p~JI z)uh_GD5SyO7j(s#4RK!UJy^iONx(=eM#mKr?xIC+;Oe*Sb^ee+$oq2(vaT#?ijw+m zTOE704gFx7f-(}fnvQ&HE5ayFcr2FD#z~1r=Daal#)1-FLQ}QN^tA9>C1bynbV~*% zi4{kubBJ@OGwX}@)C1>HE;8F*{3ZS^ToUzVQ@fx+C+Pvqi*7>tJgZ`Qd<&-q5XN-E z&HE?!hj+tMp4Ck`FVGSxw?amv_S(oYYyq?HXfA29WH*WH(`!T>dFDM zm0)<6nTTMX?hoCr`lzx4z8uzksH{dNUtLX29Uji{AoX-4R<6Y>?G}XJCH?)Wyyf5i z%2HLGbbch1@zY!>P&u(z%63H}qR+A{R5x6N{k3>i1X1 zEiB4wDnqdVkH9QlGSL?4(X4EA_*jNeRwJ%J=mN9t4Gd;TcQGoZoIcpM{v)Z);Tfq1 z^r_#Sd}S4MtGKIt8JPXBdd$w%675tR+6KZP+p_PaF=P{xnlW~@tcn@gr0YM~FJ5Y{ z7``_plex{pi;MJYZ2A%p13V8}r)NH-aL$l+q8K#WEhEP&lo4cy-*F5RN33G5 zswz9Du_vZTWMph_%QKCF;py4LKpN5ASvin*y(BxnTXDCf;^7@5etfv{;xgWR3F(4Z z*ObJPBQ(T%$Q}$R!vq~0j;LMT83-`4L_vWcV%i>jd@O^I!3ei+)h{)oi=+Sa=5YRM z*7oLt$bRm8)|M_H{qim);-#eO{G!KP!)7Y@yz@HGg⋙(L!nWK9(rbuH3YvsMN1z zk@r-rk+3J0zaor0O+~CM^-B%viZZ8^5rTa-X=-!6vkL1>X*d@lf-}Ls;m7^5u6Qbj zN~n??&yLvsgU#R~-;Iu?SE%x0(f4Nmivn!X-*c`OGvnx%|xlv$glwR7c$1@IB0*tu|l#| zmMrmfa6azRtm9DiGy!k|Q))BA$X8migX1ZDW2;vBDXZ`(V9V;lgaeOkYd|{^JQ#Gs zw4FS6&YZg^a-5wDfS_d;!KPNq3TkY^qv0jQHz*&~`0n z0eUJ=@|GOEllDTm*_=%l+sylm7g&GXo&VZ9 zSzC-6v+KmaPdR9d9_-Wp_P)9$6U^cot$tZmYc{hqI%S@j)jlnIWUF+hY%a6q3Fi0^8(UVE zKmZTCsbkBVuZeQh*hlI-n>2`tK}LqC77mc8i8I^0NUkAjDS6}(mGRV;(Eo%B)B6T! z9GJf&zt1hkrm4oYBK9}#>bknZ?I}L4OfG{XeUmQ5`z!259c_c!)(%$Aa_7NPF4WTcKY#kdSJ3$DaY4Sa)f> zyJyR#7pEv*RrO?l|H5;zuU1Wx;K8%x@+R)VWUlog$36v)_xx`A`{sACg&=2ZAsZnG znK4&pFZ7>fLCY~Zt=D$GT=?Y@=$IE9jqKtefk(#Xt>TkWHfiVOPylmkedFH_VVhJ@ zad*$jNqFVzsyWv7K|Un7J$bm0zsUWU$$pNyKEdA`C2FHCls+*xge$N z=Q`2?88{OE3FD4pL^rN)vT5Q8$Rl3K8wyZM_SVu}y)wIaI|a*m8XqI)JRb?pWHiXZ zlO7+FV8MMVMTf^&_4Mv=$!9lH*ihQ^vtUGVadF+${>Hur<2dBYS8mc~qr%l^gr$?G zr(XOR{|1>f*QLEo%lu7Ujqtbtfo=X^#q7%{RDjYvCs!crsnHQCnW3A83XXxy)`hDT z+>SNDx~J{bUZd&Z+oSiY%nD~CiMiF(7e0Xp!_RXN9{+?<6OMZi`7%kwGwE_qB$6LLy2 zF^PpGA@{o-r*vgW9f}D1+IaT}@D~k~r30jl;pXR_8tq3>#)JE3G9URABbTrF7=G!b zTH{AVYLbwrd3ysP#K$Mf|DF&gSJ+XUoFT)hIXHkBawf6$z;3;Surr!^47sl|SQf?g z(vOHJDXCBGiRB%;)32IZT8YVdLoH_U!xbs(CSs*tORfTSBxoOJO4akIK!Z}BW_h{O zQb*vDFM4Zu7FJEnA#N#S{BT`8axm8;EKHI3j*juf|2tOdCLw+1mB70FoXFkb4$`I| zYL)Z%AGn+|UmJlx^o?0Hf&YOkfN?;dh&~xku1C-l@vqETS^E8nk_wN`!7&a3#rl~N zyz3-I+(aCgwf$@3nIHqBMZ{hxdvgVz^mOHy$^->ExU`A}a5`yd?1jG~uJVzj7jVP3 z^F|yBLM%_)>Ln-~+hpS48XO4WYu;=_lH4=dF9s*6#bli4Od3IBH}wID#}MT6c`8UMRKX%7=QnHW4yF5^o79J*Vo68 z2M#)4fQurqetvwT9OIWxImquyw36Mdua^!T#0hm8_(+ur4K>$m7bB?JB_Up013PCO zLk-QOBqmWBR)g^HkypCOs;4*V{>Ft=pJw`$KiUYbWMFJynXi(riWybN3!EWztv>uq zyI8b!V4ba6-x_U^R@Iu0+meg3a&xnbR#2ImsQH17-8+~2jr!xfo7kVR8A2p92vg)g zVU31db~Wb6XJc*ntQ4^5xDiOWZuQ3P2`6WUlC-oc5I|ex7qXT2^&!M?@bYpFK$UV| zC2>c8U)v=b@oboP$SZGt_wK@794Rw>3rkZa!ithlwRG}P;d-!^O1uKMEHd2=9&;W7ikjAk?19yZUg*PG&k0y zkbOhJpFpM~{}4I|tofS;r4V7^{CqvVz8{?Y27-S9XcZNyC-ysvhd5Gb0JMQj7OKRm zKvF3F-&g-(y^_954~xeB!p|K;L@|1`nU?12?S6SwX%5Cy^U~s0rna_Ln}1EXD!X`u zRFxh2>C2f%)+DEt3;(qlhL4RjxNAd?pn+=VUNhkY&O^cjsq333Bzx0FE`2Lt(aWx= zsGtzcnWj*2*-w*-`xac>PE{zF9HA)8lKZqxEXG}jpiqVfn^wr=4( zYsqe|d&-|7C7EkJpuj~_F*h>MRdZ*){|>@$i-T<%4=}5x+6KD4baqAEB(`s|u4O<8 z@M+*BlrMb<4Vg2YRE4^VEN3gKxXcm-Rb?jx?`I>B9MVYOQb$Y<@^#3%t*mtE=~-6) z3r}V+icI;gcM&7se1GZ8D7>`19R&$_7VoRkwT&A+=QMqYho<-E-?k=a7aPWm^D9%f zf?8yg7eD4YmSsMmXE2Dx5ZSnVWSToX6VGuF9c^oC`_MxKOHSd|jZZ5a?S=PS;Cmyb zzZbiUexl5UlamMsGM!sF*2u?#VbKWwMS+S6NXp|~cYk4tIv7?#?#+@cZVU4kn;V;R zwsJgoc6@xV0!nUvKHS@u=~aCsS{S#=**18iJ;BEMYuTy3(RagB-FXMW^k(IS&0A!N zF+TVCe|EbvRVWNARRcxE)m4|;5Fvv0bwXH0YhjX(;Kawpz`)Jn4a?imPqDAQ!r=u4 z74hiay@yoIMm*>Kh??FOeumpWU2|cpP}%pg49dX>mLm4{Oia>r8U|EMVvMz2(VM9T z!&06+W|kYTL$#eb5TtqZFgf>nJjw)uzllva!Mm?usch<86@z`yegKYAXD!=qCleYu z#bnEA!vrkElM@(MD!AnmvhY(rCI8StQ4Th{LOfv3!NgxQB+zwh%#iO^E=h=>ln%UJ zy}u!nz=fpQ37C=;GU|#o0|;#YRLGEf=s6ffgNY+DdW49bZf!}uZdt;Rs0o2w28rIw z4WgK@PwZ-0K3QZY4yESMl)rijw?If12!sS)Zs8&XXWBpe2oa3?CYFToLP^LF%r24^ z%t#8+2vuZ5>0|R>Uv)|lAZ2}*e4~^qJ=Mu#@EbcJLyZ^_iPm{mWMM%;!Ag|SWmXAkG_n) z9l6#`HwU%$I5?NDznDHF+*EVmG@V58IBe!^b_0&g4bN^Rzh$F5N!>Cg zU5q6QBODho@TgrF7I6H8hT+KOYtr>Vm;uJldp zL{Lydf>&|TS_9T98%Pp#}fStrfIY?h@kQ6Z{wCH{u zWbD2E`}44BOFTuJPgE2y4`=n9`C-=HomTdfbj~5HwqOEx)03HC$a)AnS>Sm!5XqMj z8*3zF+17ODUKBpxpC0}53+vzg^_1s4sG|P4w?p@HivLzOq$Zuj4~kZzMfNaIY7822 zN$}2)jsE$wba;#}bp&8AG~%5}ri|XawXb5YjyfD$W~SL&9U0wQwO&XpAi^`gZ{%zB zzM1IMQbt`vTO&!lC^M)tk@fJ{bDm!Dq~?`>$7X=51QDag4toKSrYnA)x_7qmnl|^; z-GqjQn;RLqX@%`gYPRR%Pxpz5{!O-PGoyg3qvb8?2wgUYVe484ds`q^gn0aIJ91)& zXc=T>Wb`6Q&nSnIRb&_S9bb#tuxx1J8DI794Y!`C)}m^_UZ1@+o(ARa91JGYcDQ+S zC8nU4u&v@*we+&#hk4KOYDkC+&feelMWZ-{fP1@2tC6yILqn1&S{7i0tE$TU=FJfKK+qcKmz}1T;BS(S3tBdJG1uZXH5nPGsQniS1Zfz|tJ%BP zVjLSt^qIVY-jo97~sJZc+nwLs;a2puZq zgj&dMQ085a|8xf&E*2KcYE=a=w(p6>!FKxf>xC5;QLy1_Quqe@!SlnWlVMI?HcCoL zT3V`Atn{R2JTJ4d#Su_4^kYF70qwan7!{)FYWXret2@gZYC%Favew0hN&JJFVy4;m zX9h$&b*NyhPbIqV1vAh6?cTn1%~%>481C@vWTufPBjPBNV#CX@Bo^pn4H^bau9Z$< zD=Sg9wt7w!bHl=bSsIYk=OCH|5V3n6)q1LiRo~>A;$A_%Fl09V(>NiQr)#aqx|Hdc zr5bz4-Ex%~Blo_8}V}h=rj0`dr>a8FmqrG@{PV&~e8n zCdLO(<%-g=28CWGE1wWDFbQbcX*(CmiKv=?Nh-|yG_aPDm>qKai`1p4)ZS})lgUNg zzvWV6w3N8 ziJ|hhG(Ax_=|PX1!lU=ff=oWQ7TEiV3I?jd##xy~ul#|+bM%5-3;vli-IDID{bG&c`w zt2FnJh&o?gM<%QeD$}iWv2f=9e?`{X`ugVFer2W(oKD7rT8IaK>QP>jnMLKBJ!C0F zN_KKIk(*mt>6HGhWYFZ*>({qZT}1~a9Z{xrmemtBm4<$m;L^RyW*@?OHBMH5=9*mu zE@RLX-Wt)LnM*%)G}O`1bnAh{Yam(C%Sa0YOw**A@R zw%dZvJ-B#bU0OyO-6g^m;3K`v7>NPUN5oOuC)w5n4pV-Ls-;iKgqDuoMIY6GBpx=k zdxnPeZ#CY=rUfA{4?{S86|w?(Z-jtWw%0`EAU5L&dFj{Noo`1yLQD?_E!$KB?K0+{ z+XXeY#YJ9`?993d^A4?n;?K|qg^1ABgx9M2pw(Rl8_Y>3EB<)_KR=s#iA_$R&??sY zyUG(dbvv&lhFZ8J%@_uFQFM}FkWh2{Ovlpr!LOrjX=T7=D6A&3`Q_F>^u_T8g}?vM zkiET*ks{=W+crAg-~*L7RnVC(o6-p(BF<}N4X{K<1SgMZz0KA&G0Ys&w*7&|9J|_( zh=<^JNF~DeVy>mRcwl$E3}^h=$EVI6VHN|Jm}{7wezH&B^Ue}ss;J5{j+**ZHys*2 ze`QnD{%Op9A#-aG!c6Xl0eGAdFPjH>8mljtO$0tZA^3TFScGs6tRn=G89xa!j&7K>&(4h8wk&BK) zM{1`Zz%b*(*DKxL_PFUH3*0q;EG(d+{{M3L!3j_CM#LZ~&2}k+AuJgoI5z!s-h-b* zp0Th7Ym}our)XVcB z&66r;cB(p=s?;yBxM`gD^w-x@dHxyKPOfq=`77-)th>vbgNf6bH*g<)9hs!wzw zrRnxYqXs{}>KhWxbH$BQ{n*djXk4|Qkiq=RG|d*eCYYD84Q_LO1I>BA_eLMyw7*6` zNw#xBk3{;OsZ$jnBQYbEvmLy#&}g8at$Kd}?0R^f9)wb7<1PLR3x>1|{rK%v6$mNG zUkep(x-A^652d$NCV zxjZ_m0D&0)qdrcJckZ%cRyG5@lNc6Hl*h921vQ*H?`H*-Bz>;v+~1hM`9RVoFMVYd z3P$4#W^u%0#OrGxUj+rG1Y~qvnw=d+ai8Rg+3zcZ_ZtoDe3I#1XM}c`lk7eCz^DoLVKy!o=-=d#K$M-8AP>tBK|1nH*|Rz3HyI zc;uHa?U4L-OM$Se)U0b3zL)xx$mWy*|F&0e)ytBH4rU zQ#a4JXb9tqchz4Ujo}fUqweRk{KjPRHczW(97HoNe?A#?Bi}t$j!lOO($7S{y7k?k z&CJZErv1uL=7ug~D7x^&T0<3g?5|UE=WK@VwAAFgX}g&juKw_u^qcF&Sp-n^Mx9^igX=5u$}Ll?M~kW8HP6u_OktWSM9mSInF z4rZ(zTfDdbH2az=DXWbP#qbzDNf`tC&`7K44^Ku-Ds)e;uZ%TXT&?`?0God7`{>t# zfAi+WI&*e*G*nS#%5Kei@Q7G>>~L6oRo5~*SG3XQ^6{hpmXtJ?W48m;7zqlhIrxay zMx~{K5_Ci%Ni2UKR-aFMv_xPR^g~vx)UY>{?gvRRW-Ii^{=9kP)&8=uy0Nh}k0@R2 zK1rA+*Shz~+rjbnSUKJM%laicTp~S?nA0?_Ap%kwe0)ltjIQq-($Q|Tlp8quA2fVX z;BAb)>wkjH3dwUcGjsWKs3zitobHNaSEQ+07=knYn6!j;fF)Nib^+@O90lr52cg{h zSfm(ibw>7bPnS2vECS@+J%x3A$y!ewCDL38>&I zFbnX@CMSIvdr1`19-m`hHlS~fJXnOj6_Ja#%^%vriy+w!$Fn+K zungEaMd(mH3tez0)2@i(rRN?3>P>Ii*ZI-pu(H-yKg|0u-bfnneW*}mQhLQKb9J{; zhb1U!Z3YyMy<6-WK0d0d9wG_A(n1yEIe+|H?%6Y=LqN4zXaI6o8RnVE6`UC%$3^Q%tQl7Bh*6u{Wt1_qCoRS*)YgbmMy#gB zE^4a-nuh$h0Ss}I?jVI6e6cS+Kk5buh+N-SIJ3#EgmM+qqNky(p~3SAemJjzA)zr{ z8e6Y?+^3jer0Qqlc2c8|Cjt#b7+%fo^l8P9H5O~qyakiNJxT+v-_4war-$c>1*7Z! z4bnz*n@I<>rNYUJqhrU-r+LCg$YFsJ+eZ>Or4q>PDdnccMtdXXXl@uNDKj(C(7a+H zaXssxB(kx6R8?y|%TM})-V-o>2X-Bk{+~M#f7j!qMV&#pxgXn@5E7Ed{#k#9Y%&H; zX8ORy(sSVTbXwco+%OBPcV3ml<2JGr0MTbNr7+pQdGB|#{#FM&;-at$@~?P(oMQVq zytjue#0yH*-p#psf*bx}uOenkf_BnJ4GM-Y@6(3UKRY%&R={kMpN31b((~B{EjBNE z5O7rLlh+jC@qKT{t%wgh)`c8*Lb1IM#76)VhFKRTjVu?8_ZmetwCui2^3Z;*q?jI$39zpZE?2yuLr z`Y>G)x~;*&!xFKIwyHGVlA(8T~36>)o=oKsik^gh4 zb{~+f*Z+q+k?@G<2}0l4*nQa?*U<6_8}#tgTKDF9a(o`!lJxkT-*C{XpDjkc;3>o6 z(QT})O0*Rd4BZPcD+r}F*QE=)(-lRV6Fv|8m$aE{ps#c~GXf;bZmI&?QEJnoqGw{@ z&&=24gKe1|Yf{eLQAe?MXvf8ZXx@@~Xyh2pqoRvkfn4XqH|HUdx=+~kBdzzlENNQW z|DFg6An(t*-(LRyy*I~zy!I{8Fmzizc`APOgSB|J;~-TK>=|JO&iHz8By5Y;c>zId z9Ae+!cc051Z;ma<=*E0m-*Oy-L)Aa0;}MBWMqegu-6f^) zDxvZ=n3+~W!pGzs`_rskuI(ex0}zdvpKY~3EJx0#MbAAw&=6~9JFf8|Jnh*>i2Aa z2phB~>Lz8!ZTYacysW6dH)5h9Ihfb1!@)`cy5jvP?(RfM7@L`!TN>#w@RyG3*bX@)OzgvB_x%(aJcBb_g{ z;D>3#g+1i2`4rg4aK|R2JYMRJ*MF~Xe0^5jKV)R?b)F>Q1g5=w*>5QcGZM`t7p7!P zD=r^dH(Rb4rRhJs04h;*IxScBA~C9ro_@to_p!XutE`17=5PREe+3; z%by6z_Q8D`9)T3eYqYai&-&(e&*afV5#t--)WO+d)Krv|)YKHP81du`+)bquqz!)> za(c@xFvzWTbvq3ubNJb}TrqR-a{$=5nvH4~pU%QC<~Z$2y*{(BprVcnB0u^MYzXqd zHPuSY{8@tKmVa!hDpkPy1bYH6D>LtzosHn&u(2iMUZJFbm$sah&d-mIrf_bGqfUHJ z#C#Qs$#}4f8GaYgeBVW;sj0US(Wh8jg1(A^598E`0`^_W)8A$9a&ips>B&nj?H3?`ss;XKs zYorOZ6{=367k1hI>w53xU@Zgca@lvI0uXzq^$$e0o_L1*FOY{ZVPgZd5%v^S zR9>4mFe3%^f#Vf)e|AtA2vMr%9@B4DyT`RekVhZ0u@YW=F@2iLm;h3Z7%8O3pafk92mP(jgT+NF0t&f#kRCGi78D4s`Vo&IqD|M3BALQ^LZ6 z5aHR>^46iD6ck)jtK*0awXdI0;z&r4pI*ISIKKd%T$cCMrk_o{uWF`JlfQmVPHnli zadfodAZ>coKCh;=8rE4LUD-u_I;?TJN zS~$0lhCDi31KQpckk@JYrD(_oqB|!9HMO{SaWMqVHx9PDy%-4#Wq_%I588HiKFx*> zpPSR$R_mebIe(nBZM9PuXgLFWy5$w5Xc+-6{`e|FT>SbPM2K9EaU0CeEgbmYOi$Er z$M;?JDO&1hXE*)pZ#=kOA=~7+#uqb{rLG8y9A#g+?2e^*_fAb3hPwz#eGh*mh*C>JK05!G?n$ ztJ%w#rPH#CA5fg-#zxsr9*V!-rT~9sW;kH8wsz^GpcBOqjtnC^dskAz5VQ zCPcpGnhB=DwOr5h6og?@pz>&vj0*i$0ya3a=Ou1*1dPYaUbHHqzdj8OH8@ zb86gBVCvA<$ECKm{);RrOhV)C;^OiT#-_!n=`8-?LUR&WGe?0Ntg;MiRpu#%+()~n zxVW3U&-ihaz}m61lT9t1+jU~`54AuU1gyeT<;y-oG}mMgOk3H>y3ScBdE)*yepl$) z@i-xICqHRAaW`d==|V9NJaEkt1y+t-svabl)7U8A4F!yPk14&eel zN0Tx=fT(@{)KkBIHi5meZ@A;kloCSve(*PR6Lz6E?#6)T&0ZtQJ!BHWT2)&s7Y>M| zz}InVcAD}QoInwn(10ICzE%D?x-5b#No;J%e%sE(_O_YJ+}4SyJ|vkT-df;q=Rme{ zGws@+NRrp7#H57W`ahgZ-AoPJpjC5vZ}CEcEM&}FNP*R2dfQE0L7~o0k;{4&d%P_f zfkbP(bN-;ceG9c80Zx)sLonc{qQv_0*y~stXv%Ef21t)Ea@$yn(MtaWSd-S)y0ooa z-(25=Bh!`_#>~=s5|FXae}ZlBXD+?y@o|ZSh4*J%FDsOw9IE#01Z3Cz*TUD{a3nhQ zNCA`ro+%C0MVv84zs0JXsGB4eQm&hK<1$@0Ukf)kEG@cn+4|po9N;Xy5FbsyV22Py zDB1mAz!}spn)(!S_ zjziP&tZh`JP$mqfW4ynwq9|+nhJ<5-3}ZMw8#}yX+4!FD=H&_|N_V&J8++1xHhD5u zN`LIXVl#*2Q^?5DOPwgZ%CJ^oK-TMtlgJ5pKAPnyB8rDc#I2VI9DbFh6C7;R`PMcF z6p-Y}loe2^luVXzWyL(EcfmtM;?03S#_9L^O6HUt9*9<%yBP;!sss!Ip%SNQP#$P% zA_q0_Bqg$|UW)UvL}ZfR;Cn8tyPREsPgq}ns|6`HuFw?_*z;hGcvp5Qmj!}!~}z!ylQ10h9yP=?*ihi?4qygV`!;1GV<{S*_`2>@C z9jq>Te0cFGKRhYgI?)dP1ECy=I*y{pLEs^tao3>NL0RLP^)9k8dhp6kayRGyCbvOE zMSJe!-_k>ig`(?E4UN0+LB7o!5|NS;om&1YNW_8?5)kNClm^jhVY~6v(FuH*CO7^a z9Xi;{%-DGN_Y*)&vgW!d2?a%9eYVhu!biZzh>4-|b2?=wBbQm9xwMExE2yZraak;FB_b$)bxvhs(%>vTkxrGGJ^0*t;#?NPjC-y$IRtZ`2`46&+q zqh5*3s;6QqdC;ygudyODU_RS*iHQXSx0|L72}7eW&2Dto7aK&b;=Vrc-BkqA*8poH z&KpX@-K(kTjhRwZw6apd1$@7poJOe@AUFn+Zar=Sm!)sZa`f;7%dfB~9 zRZPrdP|xUM^B~#e#QGT!GN?VjTMln-hJ@p~d&EW`^$+J=f@nUF4sF9>@ExzsGZb*9 zI}w97)vNY9JU{IIvJw;cGbShi;!M95s4C;n?9a?(WMCu>4S`Td{nB&6yoT$Y+uK)= zvy|`Yv`6;uYaWxnjqig4J|54Ff%SP-X?)cA(g}cW@QAo_V(mxcUgqgA4rstfh~koB z*qmQ*(u(pE;3`-R;`^(A_~WH4^uAuKg~5t1plf$?{jD}B3Bk6TkCZ^b*RS|7vA8%m zcpzb?!O)18fXfK@+H<9(q z^3y^i|C)RYDD>hW&L8;g=I6`(P@m@G$3)--)5oc^lS9a@`FbT%OG5fl8pW!ka8uKV z`yx+{Zi?OlL7bq5qa!{3{_V^D@9w)C992~jKwP6;HaLJRdvrozahA1I@yiQ%x-IzM z{O+~KERG@=WJ}0SyLMr2peu3Ze#a0aBvzuXe4`gTyb#!LB~fmLMc`D z>NR(I7~z^=_lv>pWuB*e>r6if*m( z_EqQ2BNvAhD`6owiHOENg8A>=U1{mU!tGDc3+F5s5}J1oS3U{e#(xS=&(6&L$mjyU znR+T`qLitt6bVMq5XQ}%w2X|@4VM|vb7-${HU}doT5Q6MAu!pKXr&dZ9vy9evn?Eg zfWRlJ2$9v2E!12*j-|1+-a2I4*)pMw?}Jv7V<%t;)o!tOc?mw%Qy>ZKLC|fHl$f() z{kZ|QCwq2qAU7#-6N|91DX>^7K55!E;UGz99k!O!bgWJ=9 zi$}7Ce8kR<$DWv1`~_!D>^jE8Zbm+2FO42^roJPfaw#fP!xP9SM-)y61>N1jM-UMy zPXUD5`FR3?1OHQ=$=w=##^RJ3g(kdNrUUd&ST!MZL>T0cuU!z)NX`Ck6R`RE6+%>M zH@~r|^EM^*-xFy*vFXv#g&~(hv=9gl4Kgwl)5XHYq(M#&t(yPc_cHIh)w^5{6g2kt zW}opD1E15VsmKky2kl%@`;gRCz{Feq`VXl`!J3l$ZN5fe;$-}(Lf)2Eh#5`nAo zq_GcOyheVN3(_Lz2aS$R{9@^;q%>qjD{g3h`oME4UvjEn>Vnv|Fm z0l}!qs%kxDnbSjzBs%K7Epl>t;BxkA0&dopa{#p6-@9GsRU;e15?jYmexF0``}zHQ zk*xMl6X$2Znw;^z60l7{<%W=C=H~Sc#IJnLO`jUjZ2uIZ$EB;&?Pui_*-vw}|N=H6fkshfYJmyw~kc3iP{0)~Q%Kq3vnMbBzC`vB58 z+}a}cBXjhs4%>$<2FT|fQt!Y};(Z$$GMx-Q6hK=tReSs_lO7>%E{gJDBU8UW5zcO- z;!om;CW9U6?Y5eDj#2rT|Do^Yu-Guzfl-mu7nKJdHg|;UrJrxH#|6KBZN5umvHD6x z6{3Qr{wJby$y5ME<3HO07i52*OLAeEFKg`2B?{px@AEv=sPzpnF54YYzEZxugC1l>gmXtw`Ys)smQ(lhg0b zsB>|`9L(LOWT$=ta(WvxGm6wNfVO>m-_r7$mz%prp9VLFhj7%|#uf(3!Y2+dP@?6t zhU{2f8Xu9|X0G{qT=M2WVD!2B;y?YzhUyElp7f)A8(0T1lL@_tfq|D!fvxh$D=&1* z{+ksMo}E|y^0J*=+t4qq+#TR)0h}MpC}Ho2{ltATn8EuGFxAy#=h|3%>xiMF+km>c zb+gQjj&{pwLpdH^0I32eD1DN_Sw1*~6ArR|dGoUOcIT=U&T?|}L9EIuopJqd>)S3~ zY&4)Hy*w*Frdh70p|fh)-q`TJ!KJfwuNN0jKYni({Qg$oz66Gk55vAAN+s4{A__!@ zqAakH_-LzW4Pp{M_LXF*U4-MAZXQ=qxH;+s4Gt>II4%Dt`RK zj~uA_KBxBJ#Kh^ZO{!Loj>dFYlSfz6KANq@q$LczQ7%Q+pm+-`^m(~3WgK{WtU#-% zXet6NowS<-6|K8?xhQpR`tR-ZJf-r$o$r8ZSGCrB5%J43rl6|oD|GwMKNk@u*n#z< zG3+0$M>~Yrfhh^TSJlL5eFnb-~yUy)7>Zy#vxpHgmOdcu7_3PH=UF zMY^_5kdg|tLYf_@nHbu#7yET!tNk4Ra@e!wYUrnU)OrY>sz;!t0RqkdNbkl8I}FT2 zeS5^`X#%uDnBlP5xj5?Y zcMlVRmR4EWa9^c9%%RnPlo5rq%N2EyRKT0wwr=mXsj0vJ*Napp5uYm+`oF+HV8=K* zs|5KvA@cKv@Xop(Hy@BhcG?7jD1+2fFmjE)h<7EXjCD^7&WY{DVQK8LKM?2JPq zviC@m**IkvvPV|G%jf(1-{W!ab36BS-}m)?y`Imq0-%JfO}*q`mgG>yH1F=BWjFZv z4*$8mB%`gvQMLv(T$%d&_wu1n7?c~{``_W5)Iu~2yvqyz**YIx~h!EK5U$Cgfxw6R~Z{i%g%sLc+V?3ARED;EijT}3LZ9;l`3-Q zHweanq7gtoG3{r|>ot;~a#;}4?<9wL+AkZ)fhWA-3Z*&RhbSvwW8zT*tGoWQx}v9R zwNWS(Se1-AA5GwP!nzki)=UL`1&01Crh<2UJRet>z#bv7>Rm%a@Svcm+#dl}qwH)z zDGXRoO5Qv)fP#d#g=L5t8^7n%A)-}88;`1$&CKM@&v;Fsk)?NaQ^4PV$e0(*Znm`i z`X$9;-*(`5_foaexb1ts0HTTK=YZC`zXq}bTaQFJtE1QRC34vw4l}XWuBnGVOz^O9 z2|Spe2gtnOFm+`^hGk-P-b=K;m(&`27yr7MkdVphEc+G?4wrh|fPSZ^2g4Cw)!{Bu z+4@)<4a&aQShCX-bzVRQwASA!{1-9>(6$D`k|W;N*quv69D|E1hJFcyz+{R3=}EB2 zEXXE$adAv|P*Nh5W242z60+c0napm(0ADJ|kW5S&M;aY>M54_a{{6p={cmHGbjm;% zjN>R7>9dTB{)i?}%EN3u05{TahX=Jj^O+e;ln-Vf{sn-(#YN7s;Vk5KRj)D&e`TIe zO*PEubWOju6}%g*m1&NRj(!MKi8zpKvuSgG!AAWoju6_v8ei=4V*c6VpR zd!nP8nm(Ac49U$orC1v8oeTu2O&KQ&x`_5^Ie{rTW4}&G8ipAk=I^J#E?ikHbt$TE zRn>H2Ye{KZF+@Z^J9v=%=-IdH3C zyp!U7jbBdl<40uOoww4B8t=TnAuT;kBJS(~bjq!H_iZ;fkueN+%jN&`7N{V6C;wUz zQYMxjK#k*^S7->b)5h}b?%2zu=#6TS7w!xLK)*q*+TG^IIBhoEUe@6V|Mwu|(<`Y2 z)?Rw?UG!cG(wC>DT54K%;Q&VwVl(q!(`YT$z)gYVEFxCmGFP##F=ZStXktgygXdS6 zrhtha_o98}CD(!N^v^pHqi5XO2|BntQkf(_xYof9dh2(R2swjcZ|0g-)?J%ls)od? zn{Q7~!fs&4@{YE))_xFkxjG#F325y>q_`b;<{4L|K#|HBSHTt?L|a9nJDq_O0)KTl zOu~Gapd%IZ(!hhhXd7rbZd+$()qi$ESv6gm)d@Cv`17F(H*HWL?g4m&)qBJ*n*H}> zY5araWNouh4Ldf>+JT-vT+Y(b(cj;W>*(&#_iNMcKOdJwZf}hoidEi1o%UUb3bDeL z{vSWnqHCT&cf4|KT(hHDg|Qw)MAjAHr-4>J-ha5HT}GxIaT)J^b&gf=Ns&c+siq5d8em7Z4B3GTyxpHTF1q5sc#eIi3xLl-C5+TwX?C>$BZ)r z^vjn`fQTxOx?^7NIh8I_KLeZ)9v1-`j>8eQE$wTazjDemKo)3*=2?*AOXNB%oGaCIH-5?_eGkY=rI;Z`%>i|uG= zG0{GW=?ZrB=lAgU9|07e5O&{C)e-jY?xTz?_hK_Sc1jv*xs25`p;@{Gql=^+Lcyd6 z&58=69NhN)ix*2@#=>r2N*90dPgbLSUcCu;Xl7#dm03JupyJ%*>~37To{ZoeMbQiw z=qS7>qUGUa-wq9V!j&f-31HIoFT^4PySjxyTP+Do)baRtp#J*S*~vw zS(v5lZQ&e`?JspaQgiYd`WhNCGiz(%M?ltl89n%SzE$?PE}ptf8t~|HnE{sp1#MpKgM2P{^b<+w=mL4**s&aoFa05Fd$6ws?@a?KOmx#Bo-YY!;s&n{~ zlF_Asi$K-I+azS4KEXtjpB!0Ud|!+#bD=Pz!0kjukW+P~2_Xq(gD@9ffwh zW*j;nws%{4{1!JCR(LR6d44V1G-&a!#UGM@x@2(5LleLgi|A^Vv3}bkpWMVBnAPD=QQvR|%d3E|o&W``< zbzmqcF`5=KQt>;w`i75QN#eS>v8k;BU)d)pG^ATOKqtnD+Kuul%hJbcvr=KP1eRwk zwLv?;h}~CTR){JE49|=&y7Jock}Ig2ncu1Q527SwGw&Yfnn8A7zwjy+z3P; zL6{@IobNXdQq?e5_O;*|pn=?co0kiIVa}~kVbw_%yd!p1ta1W1uvc!17GKO0HB}mn z5qIHCXWU6Nuofzib}7|_4L;-+b;)tKb2mRjh|Y}&YV5t(-=>~%E96YXO95Q#zUpG@ zI^~sj-iPiu3$ljwL=Hg9F7c7^q!Hi1JSofO_wV4EA;l>d_PutKK;jij!z&6qgmVcz zoH71Pt3s3@)m=n<+v@YQjD7h=E5p&f^z%no>m5*Fa1P+-<`o)lAeK+UPD=->RbpBQ&k%lki4gho7(c8UiDv zs3EqWuCejyGr``d#PXMMx`ZSBgf+=1PKW}x*gD<9W2@i#xXoS?s)FangDzV1%u7!V z?4KJsH#Uk7d|+K5`oK=aR19@7y%DkjSiK2+hX*YHc^H0F+;eGs3_VkEEF*dOsvfz% z=A=N>9o0F?`>Gvrsu!OGy%K}e6T6@tbXyo~B&4Q(`b>|CGEyBKU@d@{~gc!@k33>w;LV^W)e&O>zZ7rO;63JOFqB&_lWQ;55bSW!k zQ3xVS8mdf#+6=0P&vhV#{nrkLzT;uV!kvU3)`^^P6?c?>Mx{~#j46381{ou=CogII z!p(Cx^FXnqaO$Y43It2GRu>(Rh1D9afY57W=?M|0#V>&On+$t^LTSddLrh^uV17$AI*``-*^mo7w&*6QjgjEyvocL zxO?T(#<}Fo6X)^REAtan4kaB4NGfq2u_mUO)DNy~@3qvGuN9nyPOK&aR;EJYR&r#* z@#@IQRmc{Yn0_p7zmc-C`4-;MMRaoXef2KZkxuPOGl7j;=N%4X# z&-yFI&ViI-vFCn@@cmL0 zE&(?nwszd&dOe}k^g+xIwkx^8-};g#CsXvW55B0X-IZ~mqrhlt*&D#K3cMBM`8Z+m zpne7w-W^rcPdz;Hf($b6g2z{TOrfa@q_oUV3JPpAO9rNN=7?et8f9Ewu19`HW4s_0 z6`V9ib0uJZU$D5Zbi+ALl96j(L`c}44eai9;c?P`geb%2SZA`nnKl{kw;MwHjO{FI zCEI1|9TR7kb3M;m0oB-YaxhWPf8WCgpgoUX0r{)sDd7Fbm;vNzz|luKZdw?>ZG6hG z;Y!uFx3#t7>r)<~p|;H1Evu}|wy)bF6XRIETpTkABVEU(x!eVz&OLEvC5S0$LnD7b zWYes0kCyMwLZ65Ttftq9aB2eN9B&d&%(7Qytn6KhjnI^R+}+{hcPn_D87v33M8uiH z4T;dhh2+<-WoEo;qX$LB1_p%E0JvHlaG`~8fUl#d`1e3pFjlYMJ-+%>=Uy7iv;Dv7 z1v|bV#8D6<#vq1!I@lWu#ddZ_WT3{v#?@+pAa?QUBTuiry$8xzuiDp@eky_tc_}Q% zPi0DUp!+B5`Jjb9(T_MT&sAZH}O`s73TB>qY&DIM*Jiq zm=?6U!jpoB ze_U_Kk{~+Eo~+i}vhP5yHJtuvPL`3liuzzqsddw_MFFU{MI~f|RIuSU4X?B6{?LdH z?p?JRM#lQiPfblO`t7{4=a;IF{Hd|nE+S%-lbyxz3QW)Y?XqbXbcn8GH8b|WZ(g1& zWY|}LkFKih{^|5_HG>Hblo16zT{Alm`KCT&sz#OrPtV&vRhkUAc?YUV!o(!^#U{Bk zAxR#N6IPD!v%{ep$&)r^WO>EV$i3VwlK~Ji79Jh+)g-s4e>pRP<VW_ge$({4{*+Byh7yElqTYdB#{NETdv*BYU92we0HWM^2@ay{A4KN2!rb zQkceOzTSg>7x+KlczD|8yV6BMLX^4EM*3nToK9j>J^${4e_eNN@V^Aw`bAMOI65-m z;In;1ZToQ8y}7xkR8t@t^GdbO{uqKNI8er;rGY9v%y zl?+{YBdKaA^ZlHbkC*pZV1#3suXc1_cX<55PNFvy=M2?ntPdpk@|KRSVfbD3-DEb? z!guR8c<&MF%3oViLgak!?~e@i z(iT~WxxQC9E6Z@Hv#_v#px7~^y^_{tLT*&o1iarJ(J9-MDk4d`0lFCO$9f5&MSp z?&7G|d|X^N^-{I?xoJt7klJKO@9!P|1{n%sX|>2|Dq6O?mq*|nIUY>ZZ_@i0qHu5+Hyne4d*Y(sXo2Hq1RttA%_V0p>`i&+TojUdDJ_Ue&9{9d8rq>?qJ z;iv)B2>C~ueSh;wmeiZ<>I%(?oyR1IxWksq<2OXz~3y3_@7 zqAjW+yVK=41IK9=-Tkyddl@%FFVFdg)op~b7Pd9b!3X4@pj2!C^FN#=b>00D*+3}2 zd7V=cL@6MUmS*Q`GWz~r;DDI$@@l?nr*DC{IO7yOKRS50@Ob?bKTvbA#8@(C;#Rvx zd2@+Ls0b|Unj?(cXdzD~%=M&#z13ys6Alb~-uH#+2wogT!q49TA@_qXw#E9aZGy4r zsX{SHH@kKd?-SG$@-oX3R0N)1RK2VkueI10VJ?(Sc+T3{yO?b^Jff(Oc;nyS%bX^v zefx>)$nGw1x}WhH#)*74J#>H?8^t#@0Yo0djrQN`c6JHzON(YC{qp@v{UMJ|Ma5d| zqh3UPMSmZ-a(oUrEqv}8(TINR%QWLL0Z}o9!c^BhZ;#nG>p!$huj^7NKrzy`b#7z3 z%TPF6SC@lh!sN$soU?-QSPS_eX>M>kHL9RcTz(-4Z3}fK+;02$R11oYV){bt91|Z6 zWO*(e+z)xopWhRBd(6$l1Ir*Px|)<*Z<}Ly7~%S5=$17djh#K4-85O&Tks0T^$o8D z3+|AUP9oyC{q|K(}Oi$;ay1vW1lVL91&JqH;oe0 z4`7})`}qwI<8a3+tdcqRzTTwOk`Xqtf39Z8IWt!pLI}Pi>UjXk#LL0Me#W`Z&RO)# zV|@5p-KGBP@iu=NKsNM_ydlGbulV4Bt1D8JhPnucJ3D(yU9jn(N3D?80edLHV2zD2 zXe-WowlV)vB{qxwC#qyxXY*v?uq;f&aHE_E&FianS1?mHB0QG}S&cX$Z) z9^HA@*gX65M=6vfh<}Y}oe*JRwBJf>7$@wYe|C2o-@A^e`utCRA||z}t*uiT@C5b>m2+y3%0P1hca*(Bc5~^SD3uS^-Hg7|WWM6s)VofxBFxUq+k8?%w(A2R9%4YXTn24t&B^+K6q*b zNFO&vQ(kIELo6o?Oz=kG__Z4*nR#|*KOR2pW*Rrm9CXHyd|oWNUgx^7yQr%bWgq-= zA5VD1U~DHoh-w|2_X6nT4VA;jg#c&@(KxYIQO{dqK5k0Mq+I?QG3(hZ#5gZ&DXk^G zKw~3}L`_REOR9!Z)!;2`l6oY7j~K%wRqa0WNB!bF5CYn}29%8%`}YmIp*qp|4+)(Ka?QUWrA@ zw}06@It|00%P6@2IEKb5Hh(oYj^BAW{bWLn5^g8~_mqIU(d8M}&H%QCv;^);NTqfB=H58>+R&ZH|UHlWX=#k~UKC09L)vu33XNe3t zoe_w3y+tb~GBy$w$FIZBh7?i;^}>}Cqjyia;mLwpU|oQxZAX)vu?g*7n(1|mbE@vUH zckYdY>B!80VwROv-GQNs_hjkt@F)yu-(7Oi?_A%<=_^jpD5j9FF1}-Pv^R5V(2eY< zKrAeb>n`u?(VKg1egY^FJ2jOq}7YhRCxGk`n_x~ zaQ(2h#?Q&;{@(XXQ;kg7o)F*PWmzyE*uu9k4Ty2wCJ%|-yFKP5@d528Ax0_wC8h(@ znUUjz(C0{jjpmNgX|{Ra1=xr2-v@wu>SzhhhLuS&>)qg=mA8?I2W{IRRo~TBEa0H0 z?e>L_&;9CSr5usaxu)jAAKLc>q}c{B*AO z)0P+|Y0pn5Ib~{IfTU_Ow4J;uQpe$33XNYh7r0ZF3~ih@&inDjj8p3&ZHe>#nnz@0 zTe*rzX96)36)XjJART3(qR0YKaJGEsfNfWSx9W;BtWKIXAb%5N({w_wEZk(jK@P&I zz)KVS3UA8nrYevA70wtAh?|-xuLluQt5XhC*-P*Vbm)3k7idreRu(K3b6a zK?N!Tzi2f3gP&mqaoJ+-xuL@2%#5|)&Vr`D&*B$}2YfBv&$wBg)eyMqis)Y{u8%&h zmz7dW$hud&ovucRY925D*fXEU2K5?Et9{$^#V=b~0_TkgJaLQcoN(**G@o-v$0z^3 ze>~@`Hyrlu@=}&fmYAxJR~I$FeAv#~qI(!Eb*FbAiyTeOAc@&mK!1%WLKEvcncFE z0>x;nhUb7$a>TM#xE6{HUKO*Lv(1**Iegy>lU}%JnT~P`4abPS+`sVE+`qZ=IGGbY z>*ER}c(KM(5|TEr!NsY2v%djy99B|dJ07xRP>tID7DPsNei3kjnl5zaqw2 zb;3ANMve#@!A5=FmW8C@;jM@nC-MZP+}1zc7Yhp_MoGzVp5kCc+u2D^j|^L?+y1FW zK`@n9U$hL<3)?k{&!01M^u6MT9Ij2AN>F@&Qrrr3Pt*e6-S9%`&&gB%$lNJ+Gb+1Ugti?Rz6Z^dZa_S8kpw`eh zZ?IH9@aO%}*fqO55hs=#rpjmM$g$fhc<{U1BY}T%`n+ncAm4uG=f5{Nc(}=$-1R&i z7vO~`o+zKFw!f~d3@Sg_SxO)~2zDB#DKIc-==o>yibhDrkQ4v#NL8hTjHq*k_1x2R zn%1FPDe+X#*UFncn4XUGMX*sFyehMMEt;V&<|NKcshigiO%yc&d}3KE_HgbRs!6VW zj>enFj%H)#oeymI@y}Np&n{3%peEP#+Vz0#msD(N4?#G-nbeQ!w;f64D)gNWwO1KP zEd=yRw--+S3e+d7U3(-&?&|s5twpqK3MW2-!!3`D3@27r0)X2bZq}Eu`5Q4Yc!$GYxn%B!Z>(@BiHK}lXP zX(y+nZ3CB-R2y#mdDQQ}vCrRbkNjs(7L&=J5JfvZFYoAh^QI)WylnM&r-1iQW;Ui0 zl+9E{p#Fr|cwv8>5T^wx#)(mh3!^8R+XhV>7izt*N0jEmu`>Vyjal0p`Oa44!U&DL z)yVfFnBW}drZBY*56Q-2b3q4b`k#?u=BY;d+TqdLCR*BEylXD2rlS%=L6RB82FX1) zD5?1A=<~GVmvIO_XS4^eK+on&UhVsH|Ks3x_ERRR~h;@pu`o-F|n&-wYz31OwIa41jxdvtkLPOW{5 z%Pk}+BZG!UO3K(6h`WtK5;N@-5AN>-R`do)Xo=KikcbHOTtJl?_|BX*=exVPe4s0I z`QBh=Y*C_}guPq^S*7^Fkco14cWINTSfD}6#wI*G=o;U#p+VpZjW$^#G^bj$NO+BD z$|)02^W$e_L>7!P*D}8sGCtI(F6$1u@_Ydn2V=^)zrAq&<5WV%0r#>z(YzIL;m$$0Nu_0uS+-(P6w@?B&T^($Ch{GX28^`je*?`Cq2ck`N(ot;={it9 z&@RikZ#$661l*!mR{5(@6e(`b3p)cDN;JEx=1Q+EIV7UH@vw4T9MvfLY$Y~$6r5VZpNh#nUqGOCfpT8 z+Mr4*0Ia7E#UUtoi$R)S{q*#-ui znVPw#GDtDYlM*5E$5~v1 zkrDhLc3}Y&BLs3ktWp9UL(^MDyq67|IscCxsMleGh}8E8a0pD7hmbUPC7Qrb$L?)S z^Q?ErMdoM0$u@-?P-g z-YB(vvc2;AL{UWe)e*W}lsaV?pbh0|&YAW*pGLPJ$3>v2YUwoyf=i9gU z@1?5WS0xXw2dI`<=GS)%92_`oEx8EqYW@>SW+Y)0kveR`l< z;r3rN9kVO2v~zN)soH+*+m_R$&1IQbS~@=Vs=bOKBFw6@>WwvYa#sOAuCx5|AqMaa zp_~Vj`89T8C!Yz-@8!KFV3AkohGj%YfmtW+_4oiRdz368z|h|)Sd269v32&u;P1iv zZ(#TQR1&F4vz}6t-eFG=zX3ZyvS?sc>k8bppD@){!C+H`hIk;({(+_vZ?d z%+073;v#BVenxsZ8>n!sfmv`(TH5#T6Xt(P7}KQ82_+B}Xc}<3N8~Madhq_bNRWDa zIb&nx0g3KBKAwMrO{F2|g1^RKfDv0NJ*yAq{OcDoQjb)UQ1fnod;?81!ARZ0e~wu> zM-Y1=_w-2ISIiw28sQ{yO``A;8k0%2rXomTYbQfY+#H$Ai# zdP({09z1X>?W%ipA4?)ebVCJ{7Gw49Dfo6@3Pu|t*;9DrjRO=Nbm>SjMUI=6bYS4R zK$q3;z50zmSUN*e4s9M4IdyJw?(5j45+X(si3msVDWlvH(G_UcJtL%F<#UES^0YN4 z?28xFpe;8%%qXJD@uOA%XcGKX|C=`i%`;A z8YY?KO0jaDf64hFaZ(3wi-lzr)`cA zfg{*SJS`UZxrOmGG&IOA3U191lF*u}wi+e5JS@vmt9!)hLMmEwYu7Bh)hwU03lP@# zl87@f7kOGqn2=ZzS^DZc7q2HY%;kE{-bL7O$vZBXluk(e4}W+#w(!5Dc}lePrq5_9zJ9=Sn~jJns)1 nGBv!tJ!%Xyr7;BH0TKe)7gs*lP*)g(zb3e)YXYs&afUnicode support. + + + diff --git a/helm/www/lambdadelta/xslt/ld_web_root.xsl b/helm/www/lambdadelta/xslt/ld_web_root.xsl index 3fbc83b45..82ce7d781 100644 --- a/helm/www/lambdadelta/xslt/ld_web_root.xsl +++ b/helm/www/lambdadelta/xslt/ld_web_root.xsl @@ -190,6 +190,14 @@ + + [Official bronze sponsor of Unicode Consortium] + +

diff --git a/matita/matita/contribs/lambdadelta/basic_2/dynamic/cnv_cpce_etc.ma b/matita/matita/contribs/lambdadelta/basic_2/dynamic/cnv_cpce_etc.ma new file mode 100644 index 000000000..af37a9a30 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/dynamic/cnv_cpce_etc.ma @@ -0,0 +1,16 @@ +include "basic_2/dynamic/cnv_cpce.ma". + +(* +lemma cpce_inv_eta_drops (h) (n) (G) (L) (i): + ∀X. ⦃G,L⦄ ⊢ #i ⬌η[h] X → + ∀K,W. ⇩*[i] L ≘ K.ⓛW → + ∀p,V1,U. ⦃G,K⦄ ⊢ W ➡*[n,h] ⓛ{p}V1.U → + ∀V2. ⦃G,K⦄ ⊢ V1 ⬌η[h] V2 → + ∀W2. ⇧*[↑i] V2 ≘ W2 → X = +ⓛW2.ⓐ#0.#↑i. +*) + + +theorem cpce_mono_cnv (h) (a) (G) (L): + ∀T. ⦃G,L⦄ ⊢ T ![h,a] → + ∀T1. ⦃G,L⦄ ⊢ T ⬌η[h] T1 → ∀T2. ⦃G,L⦄ ⊢ T ⬌η[h] T2 → T1 = T2. +#h #a #G #L #T #HT diff --git a/matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt.etc b/matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt.etc new file mode 100644 index 000000000..e9e1cd8e9 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt.etc @@ -0,0 +1,54 @@ +(* Advanced inversion lemmas ************************************************) + +lemma cpt_inv_sort_sn (h) (n) (G) (L) (s): + ∀X2. ⦃G,L⦄ ⊢ ⋆s ⬆[h,n] X2 → + ∨∨ ∧∧ X2 = ⋆s & n = 0 + | ∧∧ X2 = ⋆(⫯[h]s) & n =1. +#h #n #G #L #s #X2 * #c #Hc #H +elim (cpg_inv_sort1 … H) -H * #H1 #H2 destruct +/3 width=1 by or_introl, or_intror, conj/ +qed-. + +lemma cpt_inv_zero_sn (h) (n) (G) (L): + ∀X2. ⦃G,L⦄ ⊢ #0 ⬆[h,n] X2 → + ∨∨ ∧∧ X2 = #0 & n = 0 + | ∃∃K,V1,V2. ⦃G,K⦄ ⊢ V1 ⬆[h,n] V2 & ⇧*[1] V2 ≘ X2 & L = K.ⓓV1 + | ∃∃m,K,V1,V2. ⦃G,K⦄ ⊢ V1 ⬆[h,m] V2 & ⇧*[1] V2 ≘ X2 & L = K.ⓛV1 & n = ↑m. +#h #n #G #L #X2 * #c #Hc #H +elim (cpg_inv_zero1 … H) -H * +[ #H1 #H2 destruct /3 width=1 by or3_intro0, conj/ +| #cV #K #V1 #V2 #HV12 #HVT2 #H1 #H2 destruct + /4 width=8 by or3_intro1, ex3_3_intro, ex2_intro/ +| #cV #K #V1 #V2 #HV12 #HVT2 #H1 #H2 destruct + elim (ist_inv_plus_SO_dx … H2) -H2 [| // ] #m #Hc #H destruct + /4 width=8 by or3_intro2, ex4_4_intro, ex2_intro/ +] +qed-. + +lemma cpt_inv_lref_sn (h) (n) (G) (L) (i): + ∀X2. ⦃G,L⦄ ⊢ #↑i ⬆[h,n] X2 → + ∨∨ ∧∧ X2 = #(↑i) & n = 0 + | ∃∃I,K,T. ⦃G,K⦄ ⊢ #i ⬆[h,n] T & ⇧*[1] T ≘ X2 & L = K.ⓘ{I}. +#h #n #G #L #i #X2 * #c #Hc #H +elim (cpg_inv_lref1 … H) -H * +[ #H1 #H2 destruct /3 width=1 by or_introl, conj/ +| #I #K #V2 #HV2 #HVT2 #H destruct + /4 width=6 by ex3_3_intro, ex2_intro, or_intror/ +] +qed-. + +lemma cpt_inv_gref_sn (h) (n) (G) (L) (l): + ∀X2. ⦃G,L⦄ ⊢ §l ⬆[h,n] X2 → ∧∧ X2 = §l & n = 0. +#h #n #G #L #l #X2 * #c #Hc #H +elim (cpg_inv_gref1 … H) -H #H1 #H2 destruct +/2 width=1 by conj/ +qed-. + + +lemma cpt_inv_sort_sn_iter (h) (n) (G) (L) (s): + ∀X2. ⦃G,L⦄ ⊢ ⋆s ⬆[h,n] X2 → + ∧∧ X2 = ⋆(((next h)^n) s) & n ≤ 1. +#h #n #G #L #s #X2 #H +elim (cpt_inv_sort_sn … H) -H * #H1 #H2 destruct +/2 width=1 by conj/ +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt_cpm.etc b/matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt_cpm.etc new file mode 100644 index 000000000..ccb459081 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt_cpm.etc @@ -0,0 +1,108 @@ +(* Properties with t-bound rt-transition for terms **************************) + +axiom cpt_total (h) (n) (G) (L) (T): + ∃U. ⦃G,L⦄ ⊢ T ⬆[h,n] U. + +lemma pippo (h) (G) (L) (T0): + ∀T1. ⦃G,L⦄ ⊢ T1 ➡[h] T0 → ∀n,T2. ⦃G,L⦄ ⊢ T0 ⬆[h,n] T2 → + ∃∃T. ⦃G,L⦄ ⊢ T1 ⬆[h,n] T & ⦃G,L⦄ ⊢ T ➡[h] T2. +#h #G #L #T0 #T1 #H +@(cpr_ind … H) -G -L -T0 -T1 +[ #I #G #L #n #T2 #HT2 + /2 width=3 by ex2_intro/ +| #G #K #V1 #V0 #W0 #_ #IH #HVW0 #n #T2 #HT2 + elim (cpt_inv_lifts_sn … HT2 (Ⓣ) … K … HVW0) -W0 + [| /3 width=1 by drops_refl, drops_drop/ ] #V2 #HVT2 #HV02 + elim (IH … HV02) -V0 #V0 #HV10 #HV02 +| +| +| +| +| +| #p #G #L #V1 #V0 #W1 #W0 #T1 #T0 #_ #_ #_ #IHV #IHW #IHT #n #X #HX + elim (cpt_inv_bind_sn … HX) -HX #X0 #T2 #HX #HT02 #H destruct + elim (cpt_inv_cast_sn … HX) -HX * + [ #W2 #V2 #HW02 #HV02 #H destruct + elim (cpt_total h n G (L.ⓛW1) T0) #T3 #HT03 + elim (IHV … HV02) -V0 #V0 #HV10 #HV02 + elim (IHW … HW02) -W0 #W0 #HW10 #HW02 + elim (IHT … HT02) -T0 #T0 #HT10 #HT02 + @(ex2_intro … (ⓐV0.ⓛ{p}W0.T0)) + [ /3 width=1 by cpt_appl, cpt_bind/ + | @(cpm_beta … HV02 HW02) + + | #m #_ #H destruct + ] + +lemma cpm_cpt_cpr (h) (n) (G) (L): + ∀T1,T2. ⦃G,L⦄ ⊢ T1 ➡[n,h] T2 → + ∃∃T0. ⦃G,L⦄ ⊢ T1 ⬆[h,n] T0 & ⦃G,L⦄ ⊢ T0 ➡[h] T2. +#h #n #G #L #T1 #T2 #H +@(cpm_ind … H) -n -G -L -T1 -T2 +[ #I #G #L /2 width=3 by ex2_intro/ +| #G #L #s /3 width=3 by cpm_sort, ex2_intro/ +| #n #G #K #V1 #V2 #W2 #_ * #V0 #HV10 #HV02 #HVW2 + elim (lifts_total V0 (𝐔❴1❵)) #W0 #HVW0 + lapply (cpm_lifts_bi … HV02 (Ⓣ) … (K.ⓓV1) … HVW0 … HVW2) -HVW2 + [ /3 width=1 by drops_refl, drops_drop/ ] -HV02 #HW02 + /3 width=3 by cpt_delta, ex2_intro/ +| #n #G #K #V1 #V2 #W2 #_ * #V0 #HV10 #HV02 #HVW2 + elim (lifts_total V0 (𝐔❴1❵)) #W0 #HVW0 + lapply (cpm_lifts_bi … HV02 (Ⓣ) … (K.ⓛV1) … HVW0 … HVW2) -HVW2 + [ /3 width=1 by drops_refl, drops_drop/ ] -HV02 #HW02 + /3 width=3 by cpt_ell, ex2_intro/ +| #n #I #G #K #T2 #U2 #i #_ * #T0 #HT0 #HT02 #HTU2 + elim (lifts_total T0 (𝐔❴1❵)) #U0 #HTU0 + lapply (cpm_lifts_bi … HT02 (Ⓣ) … (K.ⓘ{I}) … HTU0 … HTU2) -HTU2 + [ /3 width=1 by drops_refl, drops_drop/ ] -HT02 #HU02 + /3 width=3 by cpt_lref, ex2_intro/ +| #n #p #I #G #L #V1 #V2 #T1 #T2 #HV12 #_ #_ * #T0 #HT10 #HT02 + /3 width=5 by cpt_bind, cpm_bind, ex2_intro/ +| #n #G #L #V1 #V2 #T1 #T2 #HV12 #_ #_ * #T0 #HT10 #HT02 + /3 width=5 by cpt_appl, cpm_appl, ex2_intro/ +| #n #G #L #V1 #V2 #T1 #T2 #_ #_ * #V0 #HV10 #HV02 * #T0 #HT10 #HT02 + /3 width=5 by cpt_cast, cpm_cast, ex2_intro/ +| #n #G #L #V #U1 #T1 #T2 #HTU1 #_ * #T0 #HT10 #HT02 + elim (cpt_lifts_sn … HT10 (Ⓣ) … (L.ⓓV) … HTU1) -T1 + [| /3 width=1 by drops_refl, drops_drop/ ] #U0 #HTU0 #HU10 + /3 width=6 by cpt_bind, cpm_zeta, ex2_intro/ +| #n #G #L #U #T1 #T2 #_ * #T0 #HT10 #HT02 +| #n #G #L #U1 #U2 #T #_ * #U0 #HU10 #HU02 + /3 width=3 by cpt_ee, ex2_intro/ +| #n #p #G #L #V1 #V2 #W1 #W2 #T1 #T2 #HV12 #HW12 #_ #_ #_ * #T0 #HT10 #HT02 + /4 width=7 by cpt_appl, cpt_bind, cpm_beta, ex2_intro/ +| #n #p #G #L #V1 #V2 #V0 #W1 #W2 #T1 #T2 #HV12 #HW12 #_ #_ #_ * #T0 #HT10 #HT02 #HV20 + /4 width=9 by cpt_appl, cpt_bind, cpm_theta, ex2_intro/ +] + +(* Forward lemmas with t-bound rt-transition for terms **********************) + +lemma pippo (h) (G) (L) (T0): + ∀T1. ⦃G,L⦄ ⊢ T1 ➡[h] T0 → + ∀n,T2. ⦃G,L⦄ ⊢ T0 ⬆[h,n] T2 → ⦃G,L⦄ ⊢ T1 ➡[n,h] T2. +#h #G #L #T0 #T1 #H +@(cpr_ind … H) -G -L -T0 -T1 +[ #I #G #L #n #T2 #HT2 + /2 width=1 by cpt_fwd_cpm/ +| #G #K #V1 #V0 #W0 #_ #IH #HVW0 #n #T2 #HT2 + elim (cpt_inv_lifts_sn … HT2 (Ⓣ) … K … HVW0) -W0 + [| /3 width=1 by drops_refl, drops_drop/ ] #V2 #HVT2 #HV02 + lapply (IH … HV02) -V0 #HV12 + /2 width=3 by cpm_delta/ +| +| +| +| +| +| #p #G #L #V1 #V0 #W1 #W0 #T1 #T0 #_ #_ #_ #IHV #IHW #IHT #n #X #HX + elim (cpt_inv_bind_sn … HX) -HX #X0 #T2 #HX #HT02 #H destruct + elim (cpt_inv_cast_sn … HX) -HX * + [ #W2 #V2 #HW02 #HV02 #H destruct + elim (cpt_total h n G (L.ⓛW1) T0) #T2 #HT02 + lapply (IHV … HV02) -V0 #HV12 + lapply (IHW … HW02) -W0 #HW12 + lapply (IHT … HT02) -T0 #HT12 + @(cpm_beta … HV12 HW12) // + + | #m #_ #H destruct + ] diff --git a/matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt_cpt.etc b/matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt_cpt.etc new file mode 100644 index 000000000..ae5bb2bb5 --- /dev/null +++ b/matita/matita/contribs/lambdadelta/basic_2/etc/cpt/cpt_cpt.etc @@ -0,0 +1,62 @@ +(**************************************************************************) +(* ___ *) +(* ||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 "basic_2/rt_transition/cpt_drops.ma". +include "basic_2/rt_transition/cpt_fqu.ma". + +(* T-BOUND CONTEXT-SENSITIVE PARALLEL T-TRANSITION FOR TERMS ****************) + +(* Main properties **********************************************************) + +theorem cpt_n_O_trans (h) (n) (G) (L) (T0): + ∀T1. ⦃G,L⦄ ⊢ T1 ⬆[h,n] T0 → + ∀T2. ⦃G,L⦄ ⊢ T0 ⬆[h,0] T2 → ⦃G,L⦄ ⊢ T1 ⬆[h,n] T2. +#h #n #G #L #T0 #T1 #H +@(cpt_ind … H) -H +[ #I #G #L #X2 #HX2 // +| #G #L #s #X2 #HX2 + elim (cpt_inv_sort_sn_iter … HX2) -HX2 #H #_ destruct // +| #n #G #K #V1 #V0 #W0 #_ #IH #HVW0 #W2 #HW02 + elim (cpt_inv_lifts_sn … HW02 (Ⓣ) … K … HVW0) -W0 + [| /3 width=1 by drops_refl, drops_drop/ ] #V2 #HVW2 #HV02 + /3 width=3 by cpt_delta/ +| #n #G #K #W1 #W0 #V0 #_ #IH #HWV0 #V2 #HV02 + elim (cpt_inv_lifts_sn … HV02 (Ⓣ) … K … HWV0) -V0 + [| /3 width=1 by drops_refl, drops_drop/ ] #W2 #HWV2 #HW02 + /3 width=3 by cpt_ell/ +| #n #I #G #K #T0 #U0 #i #_ #IH #HTU0 #U2 #HU02 + elim (cpt_inv_lifts_sn … HU02 (Ⓣ) … K … HTU0) -U0 + [| /3 width=1 by drops_refl, drops_drop/ ] #T2 #HTU2 #HT02 + /3 width=3 by cpt_lref/ +| #n #p #I #G #L #V1 #V0 #T1 #T0 #_ #_ #IHV #IHT #X2 #HX2 + elim (cpt_inv_bind_sn … HX2) -HX2 #V2 #T2 #HV02 #HT02 #H destruct + @cpt_bind + [ /2 width=1 by/ + | @IHT + ] +| #n #G #L #V1 #V0 #T1 #T0 #_ #_ #IHV #IHT #X2 #HX2 + elim (cpt_inv_appl_sn … HX2) -HX2 #V2 #T2 #HV02 #HT02 #H destruct + /3 width=1 by cpt_appl/ +| #n #G #L #V1 #V0 #T1 #T0 #_ #_ #IHV #IHT #X2 #HX2 + elim (cpt_inv_cast_sn … HX2) -HX2 * + [ #V2 #T2 #HV02 #HT02 #H destruct /3 width=1 by cpt_cast/ + | #m #_ #H destruct + ] +| #n #G #L #V1 #V0 #T1 #_ #IH #V2 #HV02 + /3 width=1 by cpt_ee/ +] + + + + \ No newline at end of file diff --git a/matita/matita/contribs/lambdadelta/basic_2/rt_conversion/cpce_drops.ma b/matita/matita/contribs/lambdadelta/basic_2/rt_conversion/cpce_drops.ma index 6e8afb63c..985f9f8f4 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/rt_conversion/cpce_drops.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/rt_conversion/cpce_drops.ma @@ -13,6 +13,7 @@ (**************************************************************************) include "static_2/relocation/drops.ma". +include "static_2/relocation/lifts_lifts.ma". include "basic_2/rt_conversion/cpce.ma". (* CONTEXT-SENSITIVE PARALLEL ETA-CONVERSION FOR TERMS **********************) @@ -44,3 +45,46 @@ lemma cpce_zero_drops (h) (G): /5 width=8 by cpce_lref, drops_drop/ ] qed. + +(* Inversion lemmas with uniform slicing for local environments *************) + +lemma cpce_inv_lref_sn_drops (h) (G) (i) (L): + ∀X2. ⦃G,L⦄ ⊢ #i ⬌η[h] X2 → + ∀I,K. ⇩*[i] L ≘ K.ⓘ{I} → + ∨∨ ∧∧ ∀n,p,W,V,U. I = BPair Abst W → ⦃G,K⦄ ⊢ W ➡*[n,h] ⓛ{p}V.U → ⊥ & #i = X2 + | ∃∃n,p,W,V1,V2,W2,U. ⦃G,K⦄ ⊢ W ➡*[n,h] ⓛ{p}V1.U & ⦃G,K⦄ ⊢ V1 ⬌η[h] V2 + & ⇧*[↑i] V2 ≘ W2 & I = BPair Abst W & +ⓛW2.ⓐ#0.#(↑i) = X2. +#h #G #i elim i -i +[ #L #X2 #HX2 #I #K #HLK + lapply (drops_fwd_isid … HLK ?) -HLK [ // ] #H destruct + /2 width=1 by cpce_inv_zero_sn/ +| #i #IH #L0 #X0 #HX0 #J #K #H0 + elim (drops_inv_succ … H0) -H0 #I #L #HLK #H destruct + elim (cpce_inv_lref_sn … HX0) -HX0 #X2 #HX2 #HX20 + elim (IH … HX2 … HLK) -IH -I -L * + [ #HJ #H destruct + lapply (lifts_inv_lref1_uni … HX20) -HX20 #H destruct + /4 width=7 by or_introl, conj/ + | #n #p #W #V1 #V2 #W2 #U #HWU #HV12 #HVW2 #H1 #H2 destruct + elim (lifts_inv_bind1 … HX20) -HX20 #X2 #X #HWX2 #HX #H destruct + elim (lifts_inv_flat1 … HX) -HX #X0 #X1 #H0 #H1 #H destruct + lapply (lifts_inv_push_zero_sn … H0) -H0 #H destruct + elim (lifts_inv_push_succ_sn … H1) -H1 #j #Hj #H destruct + lapply (lifts_inv_lref1_uni … Hj) -Hj #H destruct + /4 width=12 by lifts_trans_uni, ex5_7_intro, or_intror/ + ] +] +qed-. + +lemma cpce_inv_zero_sn_drops (h) (G) (i) (L): + ∀X2. ⦃G,L⦄ ⊢ #i ⬌η[h] X2 → + ∀I,K. ⇩*[i] L ≘ K.ⓘ{I} → + (∀n,p,W,V,U. I = BPair Abst W → ⦃G,K⦄ ⊢ W ➡*[n,h] ⓛ{p}V.U → ⊥) → + #i = X2. +#h #G #i #L #X2 #HX2 #I #K #HLK #HI +elim (cpce_inv_lref_sn_drops … HX2 … HLK) -L * +[ #_ #H // +| #n #p #W #V1 #V2 #W2 #U #HWU #_ #_ #H destruct + elim (HI … HWU) -n -p -K -X2 -V1 -V2 -W2 -U -i // +] +qed-. diff --git a/matita/matita/contribs/lambdadelta/basic_2/rt_transition/cpt.ma b/matita/matita/contribs/lambdadelta/basic_2/rt_transition/cpt.ma index 0ccb505e6..229c32a96 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/rt_transition/cpt.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/rt_transition/cpt.ma @@ -86,10 +86,72 @@ qed. lemma cpt_refl (h) (G) (L): reflexive … (cpt h G L 0). /3 width=3 by cpg_refl, ex2_intro/ qed. -(* Advanced properties ******************************************************) - -lemma cpt_sort (h) (G) (L): - ∀n. n ≤ 1 → ∀s. ⦃G,L⦄ ⊢ ⋆s ⬆[h,n] ⋆((next h)^n s). -#h #G #L * // -#n #H #s <(le_n_O_to_eq n) /2 width=1 by le_S_S_to_le/ -qed. +(* Basic inversion lemmas ***************************************************) + +lemma cpt_inv_atom_sn (h) (n) (J) (G) (L): + ∀X2. ⦃G,L⦄ ⊢ ⓪{J} ⬆[h,n] X2 → + ∨∨ ∧∧ X2 = ⓪{J} & n = 0 + | ∃∃s. X2 = ⋆(⫯[h]s) & J = Sort s & n =1 + | ∃∃K,V1,V2. ⦃G,K⦄ ⊢ V1 ⬆[h,n] V2 & ⇧*[1] V2 ≘ X2 & L = K.ⓓV1 & J = LRef 0 + | ∃∃m,K,V1,V2. ⦃G,K⦄ ⊢ V1 ⬆[h,m] V2 & ⇧*[1] V2 ≘ X2 & L = K.ⓛV1 & J = LRef 0 & n = ↑m + | ∃∃I,K,T,i. ⦃G,K⦄ ⊢ #i ⬆[h,n] T & ⇧*[1] T ≘ X2 & L = K.ⓘ{I} & J = LRef (↑i). +#h #n #J #G #L #X2 * #c #Hc #H +elim (cpg_inv_atom1 … H) -H * +[ #H1 #H2 destruct /3 width=1 by or5_intro0, conj/ +| #s #H1 #H2 #H3 destruct /3 width=3 by or5_intro1, ex3_intro/ +| #cV #K #V1 #V2 #HV12 #HVT2 #H1 #H2 #H3 destruct + /4 width=6 by or5_intro2, ex4_3_intro, ex2_intro/ +| #cV #K #V1 #V2 #HV12 #HVT2 #H1 #H2 #H3 destruct + elim (ist_inv_plus_SO_dx … H3) -H3 [| // ] #m #Hc #H destruct + /4 width=9 by or5_intro3, ex5_4_intro, ex2_intro/ +| #I #K #V2 #i #HV2 #HVT2 #H1 #H2 destruct + /4 width=8 by or5_intro4, ex4_4_intro, ex2_intro/ +] +qed-. + +lemma cpt_inv_bind_sn (h) (n) (p) (I) (G) (L) (V1) (T1): + ∀X2. ⦃G,L⦄ ⊢ ⓑ{p,I}V1.T1 ⬆[h,n] X2 → + ∃∃V2,T2. ⦃G,L⦄ ⊢ V1 ⬆[h,0] V2 & ⦃G,L.ⓑ{I}V1⦄ ⊢ T1 ⬆[h,n] T2 + & X2 = ⓑ{p,I}V2.T2. +#h #n #p #I #G #L #V1 #T1 #X2 * #c #Hc #H +elim (cpg_inv_bind1 … H) -H * +[ #cV #cT #V2 #T2 #HV12 #HT12 #H1 #H2 destruct + elim (ist_inv_max … H2) -H2 #nV #nT #HcV #HcT #H destruct + elim (ist_inv_shift … HcV) -HcV #HcV #H destruct + /3 width=5 by ex3_2_intro, ex2_intro/ +| #cT #T2 #_ #_ #_ #_ #H destruct + elim (ist_inv_plus_10_dx … H) +] +qed-. + +lemma cpt_inv_appl_sn (h) (n) (G) (L) (V1) (T1): + ∀X2. ⦃G,L⦄ ⊢ ⓐV1.T1 ⬆[h,n] X2 → + ∃∃V2,T2. ⦃G,L⦄ ⊢ V1 ⬆[h,0] V2 & ⦃G,L⦄ ⊢ T1 ⬆[h,n] T2 & X2 = ⓐV2.T2. +#h #n #G #L #V1 #T1 #X2 * #c #Hc #H elim (cpg_inv_appl1 … H) -H * +[ #cV #cT #V2 #T2 #HV12 #HT12 #H1 #H2 destruct + elim (ist_inv_max … H2) -H2 #nV #nT #HcV #HcT #H destruct + elim (ist_inv_shift … HcV) -HcV #HcV #H destruct + /3 width=5 by ex3_2_intro, ex2_intro/ +| #cV #cW #cU #p #V2 #W1 #W2 #U1 #U2 #_ #_ #_ #_ #_ #H destruct + elim (ist_inv_plus_10_dx … H) +| #cV #cW #cU #p #V #V2 #W1 #W2 #U1 #U2 #_ #_ #_ #_ #_ #_ #H destruct + elim (ist_inv_plus_10_dx … H) +] +qed-. + +lemma cpt_inv_cast_sn (h) (n) (G) (L) (V1) (T1): + ∀X2. ⦃G,L⦄ ⊢ ⓝV1.T1 ⬆[h,n] X2 → + ∨∨ ∃∃V2,T2. ⦃G,L⦄ ⊢ V1 ⬆[h,n] V2 & ⦃G,L⦄ ⊢ T1 ⬆[h,n] T2 & X2 = ⓝV2.T2 + | ∃∃m. ⦃G,L⦄ ⊢ V1 ⬆[h,m] X2 & n = ↑m. +#h #n #G #L #V1 #T1 #X2 * #c #Hc #H elim (cpg_inv_cast1 … H) -H * +[ #cV #cT #V2 #T2 #HV12 #HT12 #HcVT #H1 #H2 destruct + elim (ist_inv_max … H2) -H2 #nV #nT #HcV #HcT #H destruct + Type[0]; + eqb: carr → carr → bool; + eqb_true: ∀x,y. (eqb x y = true) ↔ (x = y) +}. *) + + +(* list *) + +let rec eq_list (A:DeqSet) (l1,l2:list A) on l1 ≝ + match l1 with + [ nil ⇒ match l2 with [nil ⇒ true | _ ⇒ false] + | cons a1 tl1 ⇒ + match l2 with [nil ⇒ false | cons a2 tl2 ⇒ a1 ==a2 ∧ eq_list A tl1 tl2]]. + +lemma eq_list_true: ∀A:DeqSet.∀l1,l2:list A. + eq_list A l1 l2 = true ↔ l1 = l2. +#A #l1 elim l1 + [* [% // |#a #tl % normalize #H destruct ] + |#a1 #tl1 #Hind * + [normalize % #H destruct + |#a2 #tl2 normalize % + [cases (true_or_false (a1==a2)) #Heq >Heq normalize + [#Htl >(\P Heq) >(proj1 … (Hind tl2) Htl) // | #H destruct ] + |#H destruct >(\b (refl … )) >(proj2 … (Hind tl2) (refl …)) // + ] + ] + ] +qed. + +definition DeqList ≝ λA:DeqSet. + mk_DeqSet (list A) (eq_list A) (eq_list_true A). + +unification hint 0 ≔ C; + T ≟ carr C, + X ≟ DeqList C +(* ---------------------------------------- *) ⊢ + list T ≡ carr X. + +alias id "eqb" = "cic:/matita/basics/deqsets/eqb#fix:0:0:3". +alias symbol "hint_decl" (instance 1) = "hint_decl_Type0". +unification hint 0 ≔ T,a1,a2; + X ≟ DeqList T +(* ---------------------------------------- *) ⊢ + eq_list T a1 a2 ≡ eqb X a1 a2. + + diff --git a/matita/matita/lib/basics/finset.ma b/matita/matita/lib/basics/finset.ma index df8d0a87c..24a5e16ce 100644 --- a/matita/matita/lib/basics/finset.ma +++ b/matita/matita/lib/basics/finset.ma @@ -9,7 +9,7 @@ \ / GNU General Public License Version 2 V_______________________________________________________________ *) -include "basics/lists/listb.ma". +include "basics/deqlist.ma". (****** DeqSet: a set with a decidable equality ******) @@ -270,3 +270,184 @@ f a = b → memb ? 〈a,b〉 (graph_enum A B f) = true. #A #B #f #a #b #eqf @memb_filter_l [@(\b eqf)] @enum_prod_complete // qed. + +(* FinFun *) + +definition enum_fun_raw: ∀A,B:DeqSet.list A → list B → list (list (DeqProd A B)) ≝ + λA,B,lA,lB.foldr A (list (list (DeqProd A B))) + (λa.compose ??? (λb. cons ? 〈a,b〉) lB) [[]] lA. + +lemma enum_fun_raw_cons: ∀A,B,a,lA,lB. + enum_fun_raw A B (a::lA) lB = + compose ??? (λb. cons ? 〈a,b〉) lB (enum_fun_raw A B lA lB). +// +qed. + +definition is_functional ≝ λA,B:DeqSet.λlA:list A.λl: list (DeqProd A B). + map ?? (fst A B) l = lA. + +definition carr_fun ≝ λA,B:FinSet. + DeqSig (DeqList (DeqProd A B)) (is_functional A B (enum A)). + +definition carr_fun_l ≝ λA,B:DeqSet.λl. + DeqSig (DeqList (DeqProd A B)) (is_functional A B l). + +lemma compose_spec1 : ∀A,B,C:DeqSet.∀f:A→B→C.∀a:A.∀b:B.∀lA:list A.∀lB:list B. + a ∈ lA = true → b ∈ lB = true → ((f a b) ∈ (compose A B C f lA lB)) = true. +#A #B #C #f #a #b #lA elim lA + [normalize #lB #H destruct + |#a1 #tl #Hind #lB #Ha #Hb cases (orb_true_l ?? Ha) #Hcase + [>(\P Hcase) normalize @memb_append_l1 @memb_map // + |@memb_append_l2 @Hind // + ] + ] +qed. + +lemma compose_cons: ∀A,B,C.∀f:A→B→C.∀l1,l2,a. + compose A B C f (a::l1) l2 = + (map ?? (f a) l2)@(compose A B C f l1 l2). +// qed. + +lemma compose_spec2 : ∀A,B,C:DeqSet.∀f:A→B→C.∀c:C.∀lA:list A.∀lB:list B. + c ∈ (compose A B C f lA lB) = true → + ∃a,b.a ∈ lA = true ∧ b ∈ lB = true ∧ c = f a b. +#A #B #C #f #c #lA elim lA + [normalize #lB #H destruct + |#a1 #tl #Hind #lB >compose_cons #Hc cases (memb_append … Hc) #Hcase + [lapply(memb_map_to_exists … Hcase) * #b * #Hb #Hf + %{a1} %{b} /3/ + |lapply(Hind ? Hcase) * #a2 * #b * * #Ha #Hb #Hf %{a2} %{b} % // % // + @orb_true_r2 // + ] + ] +qed. + +definition compose2 ≝ + λA,B:DeqSet.λa:A.λl. compose B (carr_fun_l A B l) (carr_fun_l A B (a::l)) + (λb,tl. mk_Sig ?? (〈a,b〉::(pi1 … tl)) ?). +normalize @eq_f @(pi2 … tl) +qed. + +let rec Dfoldr (A:Type[0]) (B:list A → Type[0]) + (f:∀a:A.∀l.B l → B (a::l)) (b:B [ ]) (l:list A) on l : B l ≝ + match l with [ nil ⇒ b | cons a l ⇒ f a l (Dfoldr A B f b l)]. + +definition empty_graph: ∀A,B:DeqSet. carr_fun_l A B []. +#A #B %{[]} // qed. + +definition enum_fun: ∀A,B:DeqSet.∀lA:list A.list B → list (carr_fun_l A B lA) ≝ + λA,B,lA,lB.Dfoldr A (λl.list (carr_fun_l A B l)) + (λa,l.compose2 ?? a l lB) [empty_graph A B] lA. + +lemma mem_enum_fun: ∀A,B:DeqSet.∀lA,lB.∀x:carr_fun_l A B lA. + pi1 … x ∈ map ?? (pi1 … ) (enum_fun A B lA lB) = true → + x ∈ enum_fun A B lA lB = true . +#A #B #lA #lB #x @(memb_map_inj + (DeqSig (DeqList (DeqProd A B)) + (λx0:DeqList (DeqProd A B).is_functional A B lA x0)) + (DeqList (DeqProd A B)) (pi1 …)) +* #l1 #H1 * #l2 #H2 #Heq lapply H1 lapply H2 >Heq // +qed. + +lemma enum_fun_cons: ∀A,B,a,lA,lB. + enum_fun A B (a::lA) lB = + compose ??? (λb,tl. mk_Sig ?? (〈a,b〉::(pi1 … tl)) ?) lB (enum_fun A B lA lB). +// +qed. + +lemma map_map: ∀A,B,C.∀f:A→B.∀g:B→C.∀l. + map ?? g (map ?? f l) = map ?? (g ∘ f) l. +#A #B #C #f #g #l elim l [//] +#a #tl #Hind normalize @eq_f @Hind +qed. + +lemma map_compose: ∀A,B,C,D.∀f:A→B→C.∀g:C→D.∀l1,l2. + map ?? g (compose A B C f l1 l2) = compose A B D (λa,b. g (f a b)) l1 l2. +#A #B #C #D #f #g #l1 elim l1 [//] +#a #tl #Hind #l2 >compose_cons >compose_cons (enum_fun_cons A B a tl lB) >enum_fun_raw_cons >map_compose +cut (∀lB2. compose B (Σx:DeqList (DeqProd A B).is_functional A B tl x) + (DeqList (DeqProd A B)) + (λa0:B + .λb:Σx:DeqList (DeqProd A B).is_functional A B tl x + .〈a,a0〉 + ::pi1 (list (A×B)) (λx:DeqList (DeqProd A B).is_functional A B tl x) b) lB + (enum_fun A B tl lB2) + =compose B (list (A×B)) (list (A×B)) (λb:B.cons (A×B) 〈a,b〉) lB + (enum_fun_raw A B tl lB2)) + [#lB2 elim lB + [normalize // + |#b #tlb #Hindb >compose_cons in ⊢ (???%); >compose_cons + @eq_f2 [map_map // |@Hindb]]] +#Hcut @Hcut +qed. + +lemma uniqueb_compose: ∀A,B,C:DeqSet.∀f,l1,l2. + (∀a1,a2,b1,b2. f a1 b1 = f a2 b2 → a1 = a2 ∧ b1 = b2) → + uniqueb ? l1 = true → uniqueb ? l2 = true → + uniqueb ? (compose A B C f l1 l2) = true. +#A #B #C #f #l1 #l2 #Hinj elim l1 // +#a #tl #Hind #HuA #HuB >compose_cons @uniqueb_append + [@(unique_map_inj … HuB) #b1 #b2 #Hb1b2 @(proj2 … (Hinj … Hb1b2)) + |@Hind // @(andb_true_r … HuA) + |#c #Hc lapply(memb_map_to_exists … Hc) * #b * #Hb2 #Hfab % #Hc + lapply(compose_spec2 … Hc) * #a1 * #b1 * * #Ha1 #Hb1 H + normalize #H1 destruct (H1) + ] + ] +qed. + +lemma enum_fun_unique: ∀A,B:DeqSet.∀lA,lB. + uniqueb ? lA = true → uniqueb ? lB = true → + uniqueb ? (enum_fun A B lA lB) = true. +#A #B #lA elim lA + [#lB #_ #ulB // + |#a #tlA #Hind #lB #uA #uB lapply (enum_fun_cons A B a tlA lB) #H >H + @(uniqueb_compose B (carr_fun_l A B tlA) (carr_fun_l A B (a::tlA))) + [#b1 #b2 * #l1 #funl1 * #l2 #funl2 #H1 destruct (H1) /2/ + |// + |@(Hind … uB) @(andb_true_r … uA) + ] + ] +qed. + +lemma enum_fun_complete: ∀A,B:FinSet.∀l1,l2. + (∀x:A. memb A x l1 = true) → + (∀x:B. memb B x l2 = true) → + ∀x:carr_fun_l A B l1. memb ? x (enum_fun A B l1 l2) = true. +#A #B #l1 #l2 #H1 #H2 * #g #H @mem_enum_fun >enum_fun_graphs +lapply H -H lapply g -g elim l1 + [* // #p #tlg normalize #H destruct (H) + |#a #tl #Hind #g cases g + [normalize in ⊢ (%→?); #H destruct (H) + |* #a1 #b #tl1 normalize in ⊢ (%→?); #H + cut (is_functional A B tl tl1) [destruct (H) //] #Hfun + >(cons_injective_l ????? H) + >(enum_fun_raw_cons … ) @(compose_spec1 … (λb. cons ? 〈a,b〉)) + [@H2 |@Hind @Hfun] + ] + ] +qed. + +definition FinFun ≝ +λA,B:FinSet.mk_FinSet (carr_fun A B) + (enum_fun A B (enum A) (enum B)) + (enum_fun_unique A B … (enum_unique A) (enum_unique B)) + (enum_fun_complete A B … (enum_complete A) (enum_complete B)). + +(* +unification hint 0 ≔ C1,C2; + T1 ≟ FinSetcarr C1, + T2 ≟ FinSetcarr C2, + X ≟ FinProd C1 C2 +(* ---------------------------------------- *) ⊢ + T1×T2 ≡ FinSetcarr X. *) \ No newline at end of file diff --git a/matita/matita/lib/binding/db.ma b/matita/matita/lib/binding/db.ma deleted file mode 100644 index 534874f21..000000000 --- a/matita/matita/lib/binding/db.ma +++ /dev/null @@ -1,110 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||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 diff --git a/matita/matita/lib/binding/fp.ma b/matita/matita/lib/binding/fp.ma deleted file mode 100644 index 14ba2f774..000000000 --- a/matita/matita/lib/binding/fp.ma +++ /dev/null @@ -1,296 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||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 diff --git a/matita/matita/lib/binding/ln.ma b/matita/matita/lib/binding/ln.ma deleted file mode 100644 index ca7f574ed..000000000 --- a/matita/matita/lib/binding/ln.ma +++ /dev/null @@ -1,716 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||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) - 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 >TM_ind_plus_LAM [|@HC|@Hx0] - @eq_f 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 diff --git a/matita/matita/lib/binding/ln_concrete.ma b/matita/matita/lib/binding/ln_concrete.ma deleted file mode 100644 index bdafdb1a0..000000000 --- a/matita/matita/lib/binding/ln_concrete.ma +++ /dev/null @@ -1,683 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||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

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) - 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 diff --git a/matita/matita/lib/binding/names.ma b/matita/matita/lib/binding/names.ma deleted file mode 100644 index bc5f07d43..000000000 --- a/matita/matita/lib/binding/names.ma +++ /dev/null @@ -1,78 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||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 diff --git a/matita/matita/lib/didactic/natural_deduction.ma b/matita/matita/lib/didactic/natural_deduction.ma new file mode 100644 index 000000000..45ce24f91 --- /dev/null +++ b/matita/matita/lib/didactic/natural_deduction.ma @@ -0,0 +1,863 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| A.Asperti, C.Sacerdoti Coen, *) +(* ||A|| E.Tassi, S.Zacchiroli *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU Lesser General Public License Version 2.1 *) +(* *) +(**************************************************************************) + +(* Logic system *) + +include "basics/pts.ma". +include "hints_declaration.ma". + +inductive Imply (A,B:Prop) : Prop ≝ +| Imply_intro: (A → B) → Imply A B. + +definition Imply_elim ≝ λA,B:Prop.λf:Imply A B. λa:A. + match f with [ Imply_intro g ⇒ g a]. + +inductive And (A,B:Prop) : Prop ≝ +| And_intro: A → B → And A B. + +definition And_elim_l ≝ λA,B.λc:And A B. + match c with [ And_intro a b ⇒ a ]. + +definition And_elim_r ≝ λA,B.λc:And A B. + match c with [ And_intro a b ⇒ b ]. + +inductive Or (A,B:Prop) : Prop ≝ +| Or_intro_l: A → Or A B +| Or_intro_r: B → Or A B. + +definition Or_elim ≝ λA,B,C:Prop.λc:Or A B.λfa: A → C.λfb: B → C. + match c with + [ Or_intro_l a ⇒ fa a + | Or_intro_r b ⇒ fb b]. + +inductive Top : Prop := +| Top_intro : Top. + +inductive Bot : Prop := . + +definition Bot_elim ≝ λP:Prop.λx:Bot. + match x in Bot return λx.P with []. + +definition Not := λA:Prop.Imply A Bot. + +definition Not_intro : ∀A.(A → Bot) → Not A ≝ λA. + Imply_intro A Bot. + +definition Not_elim : ∀A.Not A → A → Bot ≝ λA. + Imply_elim ? Bot. + +definition Discharge := λA:Prop.λa:A. + a. + +axiom Raa : ∀A.(Not A → Bot) → A. + +axiom sort : Type[0]. + +inductive Exists (A:Type[0]) (P:A→Prop) : Prop ≝ + Exists_intro: ∀w:A. P w → Exists A P. + +definition Exists_elim ≝ + λA:Type[0].λP:A→Prop.λC:Prop.λc:Exists A P.λH:(Πx.P x → C). + match c with [ Exists_intro w p ⇒ H w p ]. + +inductive Forall (A:Type[0]) (P:A→Prop) : Prop ≝ + Forall_intro: (∀n:A. P n) → Forall A P. + +definition Forall_elim ≝ + λA:Type[0].λP:A→Prop.λn:A.λf:Forall A P.match f with [ Forall_intro g ⇒ g n ]. + +(* Dummy proposition *) +axiom unit : Prop. + +(* Notations *) +notation "hbox(a break ⇒ b)" right associative with precedence 20 +for @{ 'Imply $a $b }. +interpretation "Imply" 'Imply a b = (Imply a b). +interpretation "constructive or" 'or x y = (Or x y). +interpretation "constructive and" 'and x y = (And x y). +notation "⊤" non associative with precedence 90 for @{'Top}. +interpretation "Top" 'Top = Top. +notation "⊥" non associative with precedence 90 for @{'Bot}. +interpretation "Bot" 'Bot = Bot. +interpretation "Not" 'not a = (Not a). +notation "✶" non associative with precedence 90 for @{'unit}. +interpretation "dummy prop" 'unit = unit. +notation > "\exists list1 ident x sep , . term 19 Px" with precedence 20 +for ${ fold right @{$Px} rec acc @{'myexists (λ${ident x}.$acc)} }. +notation < "hvbox(\exists ident i break . p)" with precedence 20 +for @{ 'myexists (\lambda ${ident i} : $ty. $p) }. +interpretation "constructive ex" 'myexists \eta.x = (Exists sort x). +notation > "\forall ident x.break term 19 Px" with precedence 20 +for @{ 'Forall (λ${ident x}.$Px) }. +notation < "\forall ident x.break term 19 Px" with precedence 20 +for @{ 'Forall (λ${ident x}:$tx.$Px) }. +interpretation "Forall" 'Forall \eta.Px = (Forall ? Px). + +(* Variables *) +axiom A : Prop. +axiom B : Prop. +axiom C : Prop. +axiom D : Prop. +axiom E : Prop. +axiom F : Prop. +axiom G : Prop. +axiom H : Prop. +axiom I : Prop. +axiom J : Prop. +axiom K : Prop. +axiom L : Prop. +axiom M : Prop. +axiom N : Prop. +axiom O : Prop. +axiom x: sort. +axiom y: sort. +axiom z: sort. +axiom w: sort. + +(* Every formula user provided annotates its proof: + `A` becomes `(show A ?)` *) +definition show : ΠA.A→A ≝ λA:Prop.λa:A.a. + +(* When something does not fit, this daemon is used *) +axiom cast: ΠA,B:Prop.B → A. + +(* begin a proof: draws the root *) +notation > "'prove' p" non associative with precedence 19 +for @{ 'prove $p }. +interpretation "prove KO" 'prove p = (cast ? ? (show p ?)). +interpretation "prove OK" 'prove p = (show p ?). + +(* Leaves *) +notation < "\infrule (t\atop ⋮) a ?" with precedence 19 +for @{ 'leaf_ok $a $t }. +interpretation "leaf OK" 'leaf_ok a t = (show a t). +notation < "\infrule (t\atop ⋮) mstyle color #ff0000 (a) ?" with precedence 19 +for @{ 'leaf_ko $a $t }. +interpretation "leaf KO" 'leaf_ko a t = (cast ? ? (show a t)). + +(* discharging *) +notation < "[ a ] \sup mstyle color #ff0000 (H)" with precedence 19 +for @{ 'discharge_ko_1 $a $H }. +interpretation "discharge_ko_1" 'discharge_ko_1 a H = + (show a (cast ? ? (Discharge ? H))). +notation < "[ mstyle color #ff0000 (a) ] \sup mstyle color #ff0000 (H)" with precedence 19 +for @{ 'discharge_ko_2 $a $H }. +interpretation "discharge_ko_2" 'discharge_ko_2 a H = + (cast ? ? (show a (cast ? ? (Discharge ? H)))). + +notation < "[ a ] \sup H" with precedence 19 +for @{ 'discharge_ok_1 $a $H }. +interpretation "discharge_ok_1" 'discharge_ok_1 a H = + (show a (Discharge ? H)). +notation < "[ mstyle color #ff0000 (a) ] \sup H" with precedence 19 +for @{ 'discharge_ok_2 $a $H }. +interpretation "discharge_ok_2" 'discharge_ok_2 a H = + (cast ? ? (show a (Discharge ? H))). + +notation > "'discharge' [H]" with precedence 19 +for @{ 'discharge $H }. +interpretation "discharge KO" 'discharge H = (cast ? ? (Discharge ? H)). +interpretation "discharge OK" 'discharge H = (Discharge ? H). + +(* ⇒ introduction *) +notation < "\infrule hbox(\emsp b \emsp) ab (mstyle color #ff0000 (⇒\sub\i \emsp) ident H) " with precedence 19 +for @{ 'Imply_intro_ko_1 $ab (λ${ident H}:$p.$b) }. +interpretation "Imply_intro_ko_1" 'Imply_intro_ko_1 ab \eta.b = + (show ab (cast ? ? (Imply_intro ? ? b))). + +notation < "\infrule hbox(\emsp b \emsp) mstyle color #ff0000 (ab) (mstyle color #ff0000 (⇒\sub\i \emsp) ident H) " with precedence 19 +for @{ 'Imply_intro_ko_2 $ab (λ${ident H}:$p.$b) }. +interpretation "Imply_intro_ko_2" 'Imply_intro_ko_2 ab \eta.b = + (cast ? ? (show ab (cast ? ? (Imply_intro ? ? b)))). + +notation < "maction (\infrule hbox(\emsp b \emsp) ab (⇒\sub\i \emsp ident H) ) (\vdots)" with precedence 19 +for @{ 'Imply_intro_ok_1 $ab (λ${ident H}:$p.$b) }. +interpretation "Imply_intro_ok_1" 'Imply_intro_ok_1 ab \eta.b = + (show ab (Imply_intro ? ? b)). + +notation < "\infrule hbox(\emsp b \emsp) mstyle color #ff0000 (ab) (⇒\sub\i \emsp ident H) " with precedence 19 +for @{ 'Imply_intro_ok_2 $ab (λ${ident H}:$p.$b) }. +interpretation "Imply_intro_ok_2" 'Imply_intro_ok_2 ab \eta.b = + (cast ? ? (show ab (Imply_intro ? ? b))). + +notation > "⇒#'i' [ident H] term 90 b" with precedence 19 +for @{ 'Imply_intro $b (λ${ident H}.show $b ?) }. + +interpretation "Imply_intro KO" 'Imply_intro b pb = + (cast ? (Imply unit b) (Imply_intro ? b pb)). +interpretation "Imply_intro OK" 'Imply_intro b pb = + (Imply_intro ? b pb). + +(* ⇒ elimination *) +notation < "\infrule hbox(\emsp ab \emsp\emsp\emsp a\emsp) b mstyle color #ff0000 (⇒\sub\e) " with precedence 19 +for @{ 'Imply_elim_ko_1 $ab $a $b }. +interpretation "Imply_elim_ko_1" 'Imply_elim_ko_1 ab a b = + (show b (cast ? ? (Imply_elim ? ? (cast ? ? ab) (cast ? ? a)))). + +notation < "\infrule hbox(\emsp ab \emsp\emsp\emsp a\emsp) mstyle color #ff0000 (b) mstyle color #ff0000 (⇒\sub\e) " with precedence 19 +for @{ 'Imply_elim_ko_2 $ab $a $b }. +interpretation "Imply_elim_ko_2" 'Imply_elim_ko_2 ab a b = + (cast ? ? (show b (cast ? ? (Imply_elim ? ? (cast ? ? ab) (cast ? ? a))))). + +notation < "maction (\infrule hbox(\emsp ab \emsp\emsp\emsp a\emsp) b (⇒\sub\e) ) (\vdots)" with precedence 19 +for @{ 'Imply_elim_ok_1 $ab $a $b }. +interpretation "Imply_elim_ok_1" 'Imply_elim_ok_1 ab a b = + (show b (Imply_elim ? ? ab a)). + +notation < "\infrule hbox(\emsp ab \emsp\emsp\emsp a\emsp) mstyle color #ff0000 (b) (⇒\sub\e) " with precedence 19 +for @{ 'Imply_elim_ok_2 $ab $a $b }. +interpretation "Imply_elim_ok_2" 'Imply_elim_ok_2 ab a b = + (cast ? ? (show b (Imply_elim ? ? ab a))). + +notation > "⇒#'e' term 90 ab term 90 a" with precedence 19 +for @{ 'Imply_elim (show $ab ?) (show $a ?) }. +interpretation "Imply_elim KO" 'Imply_elim ab a = + (cast ? ? (Imply_elim ? ? (cast (Imply unit unit) ? ab) (cast unit ? a))). +interpretation "Imply_elim OK" 'Imply_elim ab a = + (Imply_elim ? ? ab a). + +(* ∧ introduction *) +notation < "\infrule hbox(\emsp a \emsp\emsp\emsp b \emsp) ab mstyle color #ff0000 (∧\sub\i)" with precedence 19 +for @{ 'And_intro_ko_1 $a $b $ab }. +interpretation "And_intro_ko_1" 'And_intro_ko_1 a b ab = + (show ab (cast ? ? (And_intro ? ? a b))). + +notation < "\infrule hbox(\emsp a \emsp\emsp\emsp b \emsp) mstyle color #ff0000 (ab) mstyle color #ff0000 (∧\sub\i)" with precedence 19 +for @{ 'And_intro_ko_2 $a $b $ab }. +interpretation "And_intro_ko_2" 'And_intro_ko_2 a b ab = + (cast ? ? (show ab (cast ? ? (And_intro ? ? a b)))). + +notation < "maction (\infrule hbox(\emsp a \emsp\emsp\emsp b \emsp) ab (∧\sub\i)) (\vdots)" with precedence 19 +for @{ 'And_intro_ok_1 $a $b $ab }. +interpretation "And_intro_ok_1" 'And_intro_ok_1 a b ab = + (show ab (And_intro ? ? a b)). + +notation < "\infrule hbox(\emsp a \emsp\emsp\emsp b \emsp) mstyle color #ff0000 (ab) (∧\sub\i)" with precedence 19 +for @{ 'And_intro_ok_2 $a $b $ab }. +interpretation "And_intro_ok_2" 'And_intro_ok_2 a b ab = + (cast ? ? (show ab (And_intro ? ? a b))). + +notation > "∧#'i' term 90 a term 90 b" with precedence 19 +for @{ 'And_intro (show $a ?) (show $b ?) }. +interpretation "And_intro KO" 'And_intro a b = (cast ? ? (And_intro ? ? a b)). +interpretation "And_intro OK" 'And_intro a b = (And_intro ? ? a b). + +(* ∧ elimination *) +notation < "\infrule hbox(\emsp ab \emsp) a mstyle color #ff0000 (∧\sub(\e_\l))" with precedence 19 +for @{ 'And_elim_l_ko_1 $ab $a }. +interpretation "And_elim_l_ko_1" 'And_elim_l_ko_1 ab a = + (show a (cast ? ? (And_elim_l ? ? (cast ? ? ab)))). + +notation < "\infrule hbox(\emsp ab \emsp) mstyle color #ff0000 (a) mstyle color #ff0000 (∧\sub(\e_\l))" with precedence 19 +for @{ 'And_elim_l_ko_2 $ab $a }. +interpretation "And_elim_l_ko_2" 'And_elim_l_ko_2 ab a = + (cast ? ? (show a (cast ? ? (And_elim_l ? ? (cast ? ? ab))))). + +notation < "maction (\infrule hbox(\emsp ab \emsp) a (∧\sub(\e_\l))) (\vdots)" with precedence 19 +for @{ 'And_elim_l_ok_1 $ab $a }. +interpretation "And_elim_l_ok_1" 'And_elim_l_ok_1 ab a = + (show a (And_elim_l ? ? ab)). + +notation < "\infrule hbox(\emsp ab \emsp) mstyle color #ff0000 (a) (∧\sub(\e_\l))" with precedence 19 +for @{ 'And_elim_l_ok_2 $ab $a }. +interpretation "And_elim_l_ok_2" 'And_elim_l_ok_2 ab a = + (cast ? ? (show a (And_elim_l ? ? ab))). + +notation > "∧#'e_l' term 90 ab" with precedence 19 +for @{ 'And_elim_l (show $ab ?) }. +interpretation "And_elim_l KO" 'And_elim_l a = (cast ? ? (And_elim_l ? ? (cast (And unit unit) ? a))). +interpretation "And_elim_l OK" 'And_elim_l a = (And_elim_l ? ? a). + +notation < "\infrule hbox(\emsp ab \emsp) a mstyle color #ff0000 (∧\sub(\e_\r))" with precedence 19 +for @{ 'And_elim_r_ko_1 $ab $a }. +interpretation "And_elim_r_ko_1" 'And_elim_r_ko_1 ab a = + (show a (cast ? ? (And_elim_r ? ? (cast ? ? ab)))). + +notation < "\infrule hbox(\emsp ab \emsp) mstyle color #ff0000 (a) mstyle color #ff0000 (∧\sub(\e_\r))" with precedence 19 +for @{ 'And_elim_r_ko_2 $ab $a }. +interpretation "And_elim_r_ko_2" 'And_elim_r_ko_2 ab a = + (cast ? ? (show a (cast ? ? (And_elim_r ? ? (cast ? ? ab))))). + +notation < "maction (\infrule hbox(\emsp ab \emsp) a (∧\sub(\e_\r))) (\vdots)" with precedence 19 +for @{ 'And_elim_r_ok_1 $ab $a }. +interpretation "And_elim_r_ok_1" 'And_elim_r_ok_1 ab a = + (show a (And_elim_r ? ? ab)). + +notation < "\infrule hbox(\emsp ab \emsp) mstyle color #ff0000 (a) (∧\sub(\e_\r))" with precedence 19 +for @{ 'And_elim_r_ok_2 $ab $a }. +interpretation "And_elim_r_ok_2" 'And_elim_r_ok_2 ab a = + (cast ? ? (show a (And_elim_r ? ? ab))). + +notation > "∧#'e_r' term 90 ab" with precedence 19 +for @{ 'And_elim_r (show $ab ?) }. +interpretation "And_elim_r KO" 'And_elim_r a = (cast ? ? (And_elim_r ? ? (cast (And unit unit) ? a))). +interpretation "And_elim_r OK" 'And_elim_r a = (And_elim_r ? ? a). + +(* ∨ introduction *) +notation < "\infrule hbox(\emsp a \emsp) ab mstyle color #ff0000 (∨\sub(\i_\l))" with precedence 19 +for @{ 'Or_intro_l_ko_1 $a $ab }. +interpretation "Or_intro_l_ko_1" 'Or_intro_l_ko_1 a ab = + (show ab (cast ? ? (Or_intro_l ? ? a))). + +notation < "\infrule hbox(\emsp a \emsp) mstyle color #ff0000 (ab) mstyle color #ff0000 (∨\sub(\i_\l))" with precedence 19 +for @{ 'Or_intro_l_ko_2 $a $ab }. +interpretation "Or_intro_l_ko_2" 'Or_intro_l_ko_2 a ab = + (cast ? ? (show ab (cast ? ? (Or_intro_l ? ? a)))). + +notation < "maction (\infrule hbox(\emsp a \emsp) ab (∨\sub(\i_\l))) (\vdots)" with precedence 19 +for @{ 'Or_intro_l_ok_1 $a $ab }. +interpretation "Or_intro_l_ok_1" 'Or_intro_l_ok_1 a ab = + (show ab (Or_intro_l ? ? a)). + +notation < "\infrule hbox(\emsp a \emsp) mstyle color #ff0000 (ab) (∨\sub(\i_\l))" with precedence 19 +for @{ 'Or_intro_l_ok_2 $a $ab }. +interpretation "Or_intro_l_ok_2" 'Or_intro_l_ok_2 a ab = + (cast ? ? (show ab (Or_intro_l ? ? a))). + +notation > "∨#'i_l' term 90 a" with precedence 19 +for @{ 'Or_intro_l (show $a ?) }. +interpretation "Or_intro_l KO" 'Or_intro_l a = (cast ? (Or ? unit) (Or_intro_l ? ? a)). +interpretation "Or_intro_l OK" 'Or_intro_l a = (Or_intro_l ? ? a). + +notation < "\infrule hbox(\emsp a \emsp) ab mstyle color #ff0000 (∨\sub(\i_\r))" with precedence 19 +for @{ 'Or_intro_r_ko_1 $a $ab }. +interpretation "Or_intro_r_ko_1" 'Or_intro_r_ko_1 a ab = + (show ab (cast ? ? (Or_intro_r ? ? a))). + +notation < "\infrule hbox(\emsp a \emsp) mstyle color #ff0000 (ab) mstyle color #ff0000 (∨\sub(\i_\r))" with precedence 19 +for @{ 'Or_intro_r_ko_2 $a $ab }. +interpretation "Or_intro_r_ko_2" 'Or_intro_r_ko_2 a ab = + (cast ? ? (show ab (cast ? ? (Or_intro_r ? ? a)))). + +notation < "maction (\infrule hbox(\emsp a \emsp) ab (∨\sub(\i_\r))) (\vdots)" with precedence 19 +for @{ 'Or_intro_r_ok_1 $a $ab }. +interpretation "Or_intro_r_ok_1" 'Or_intro_r_ok_1 a ab = + (show ab (Or_intro_r ? ? a)). + +notation < "\infrule hbox(\emsp a \emsp) mstyle color #ff0000 (ab) (∨\sub(\i_\r))" with precedence 19 +for @{ 'Or_intro_r_ok_2 $a $ab }. +interpretation "Or_intro_r_ok_2" 'Or_intro_r_ok_2 a ab = + (cast ? ? (show ab (Or_intro_r ? ? a))). + +notation > "∨#'i_r' term 90 a" with precedence 19 +for @{ 'Or_intro_r (show $a ?) }. +interpretation "Or_intro_r KO" 'Or_intro_r a = (cast ? (Or unit ?) (Or_intro_r ? ? a)). +interpretation "Or_intro_r OK" 'Or_intro_r a = (Or_intro_r ? ? a). + +(* ∨ elimination *) +notation < "\infrule hbox(\emsp ab \emsp\emsp\emsp ac \emsp\emsp\emsp bc \emsp) c (mstyle color #ff0000 (∨\sub\e \emsp) ident Ha \emsp ident Hb)" with precedence 19 +for @{ 'Or_elim_ko_1 $ab $c (λ${ident Ha}:$ta.$ac) (λ${ident Hb}:$tb.$bc) }. +interpretation "Or_elim_ko_1" 'Or_elim_ko_1 ab c \eta.ac \eta.bc = + (show c (cast ? ? (Or_elim ? ? ? (cast ? ? ab) (cast ? ? ac) (cast ? ? bc)))). + +notation < "\infrule hbox(\emsp ab \emsp\emsp\emsp ac \emsp\emsp\emsp bc \emsp) mstyle color #ff0000 (c) (mstyle color #ff0000 (∨\sub\e) \emsp ident Ha \emsp ident Hb)" with precedence 19 +for @{ 'Or_elim_ko_2 $ab (λ${ident Ha}:$ta.$ac) (λ${ident Hb}:$tb.$bc) $c }. +interpretation "Or_elim_ko_2" 'Or_elim_ko_2 ab \eta.ac \eta.bc c = + (cast ? ? (show c (cast ? ? (Or_elim ? ? ? (cast ? ? ab) (cast ? ? ac) (cast ? ? bc))))). + +notation < "maction (\infrule hbox(\emsp ab \emsp\emsp\emsp ac \emsp\emsp\emsp bc \emsp) c (∨\sub\e \emsp ident Ha \emsp ident Hb)) (\vdots)" with precedence 19 +for @{ 'Or_elim_ok_1 $ab (λ${ident Ha}:$ta.$ac) (λ${ident Hb}:$tb.$bc) $c }. +interpretation "Or_elim_ok_1" 'Or_elim_ok_1 ab \eta.ac \eta.bc c = + (show c (Or_elim ? ? ? ab ac bc)). + +notation < "\infrule hbox(\emsp ab \emsp\emsp\emsp ac \emsp\emsp\emsp bc \emsp) mstyle color #ff0000 (c) (∨\sub\e \emsp ident Ha \emsp ident Hb)" with precedence 19 +for @{ 'Or_elim_ok_2 $ab (λ${ident Ha}:$ta.$ac) (λ${ident Hb}:$tb.$bc) $c }. +interpretation "Or_elim_ok_2" 'Or_elim_ok_2 ab \eta.ac \eta.bc c = + (cast ? ? (show c (Or_elim ? ? ? ab ac bc))). + +definition unit_to ≝ λx:Prop.unit → x. + +notation > "∨#'e' term 90 ab [ident Ha] term 90 cl [ident Hb] term 90 cr" with precedence 19 +for @{ 'Or_elim (show $ab ?) (λ${ident Ha}.show $cl ?) (λ${ident Hb}.show $cr ?) }. +interpretation "Or_elim KO" 'Or_elim ab ac bc = + (cast ? ? (Or_elim ? ? ? + (cast (Or unit unit) ? ab) + (cast (unit_to unit) (unit_to ?) ac) + (cast (unit_to unit) (unit_to ?) bc))). +interpretation "Or_elim OK" 'Or_elim ab ac bc = (Or_elim ? ? ? ab ac bc). + +(* ⊤ introduction *) +notation < "\infrule \nbsp ⊤ mstyle color #ff0000 (⊤\sub\i)" with precedence 19 +for @{'Top_intro_ko_1}. +interpretation "Top_intro_ko_1" 'Top_intro_ko_1 = + (show ? (cast ? ? Top_intro)). + +notation < "\infrule \nbsp mstyle color #ff0000 (⊤) mstyle color #ff0000 (⊤\sub\i)" with precedence 19 +for @{'Top_intro_ko_2}. +interpretation "Top_intro_ko_2" 'Top_intro_ko_2 = + (cast ? ? (show ? (cast ? ? Top_intro))). + +notation < "maction (\infrule \nbsp ⊤ (⊤\sub\i)) (\vdots)" with precedence 19 +for @{'Top_intro_ok_1}. +interpretation "Top_intro_ok_1" 'Top_intro_ok_1 = (show ? Top_intro). + +notation < "maction (\infrule \nbsp ⊤ (⊤\sub\i)) (\vdots)" with precedence 19 +for @{'Top_intro_ok_2 }. +interpretation "Top_intro_ok_2" 'Top_intro_ok_2 = (cast ? ? (show ? Top_intro)). + +notation > "⊤#'i'" with precedence 19 for @{ 'Top_intro }. +interpretation "Top_intro KO" 'Top_intro = (cast ? ? Top_intro). +interpretation "Top_intro OK" 'Top_intro = Top_intro. + +(* ⊥ introduction *) +notation < "\infrule b a mstyle color #ff0000 (⊥\sub\e)" with precedence 19 +for @{'Bot_elim_ko_1 $a $b}. +interpretation "Bot_elim_ko_1" 'Bot_elim_ko_1 a b = + (show a (Bot_elim ? (cast ? ? b))). + +notation < "\infrule b mstyle color #ff0000 (a) mstyle color #ff0000 (⊥\sub\e)" with precedence 19 +for @{'Bot_elim_ko_2 $a $b}. +interpretation "Bot_elim_ko_2" 'Bot_elim_ko_2 a b = + (cast ? ? (show a (Bot_elim ? (cast ? ? b)))). + +notation < "maction (\infrule b a (⊥\sub\e)) (\vdots)" with precedence 19 +for @{'Bot_elim_ok_1 $a $b}. +interpretation "Bot_elim_ok_1" 'Bot_elim_ok_1 a b = + (show a (Bot_elim ? b)). + +notation < "\infrule b mstyle color #ff0000 (a) (⊥\sub\e)" with precedence 19 +for @{'Bot_elim_ok_2 $a $b}. +interpretation "Bot_elim_ok_2" 'Bot_elim_ok_2 a b = + (cast ? ? (show a (Bot_elim ? b))). + +notation > "⊥#'e' term 90 b" with precedence 19 +for @{ 'Bot_elim (show $b ?) }. +interpretation "Bot_elim KO" 'Bot_elim a = (Bot_elim ? (cast ? ? a)). +interpretation "Bot_elim OK" 'Bot_elim a = (Bot_elim ? a). + +(* ¬ introduction *) +notation < "\infrule hbox(\emsp b \emsp) ab (mstyle color #ff0000 (\lnot\sub(\emsp\i)) \emsp ident H)" with precedence 19 +for @{ 'Not_intro_ko_1 $ab (λ${ident H}:$p.$b) }. +interpretation "Not_intro_ko_1" 'Not_intro_ko_1 ab \eta.b = + (show ab (cast ? ? (Not_intro ? (cast ? ? b)))). + +notation < "\infrule hbox(\emsp b \emsp) mstyle color #ff0000 (ab) (mstyle color #ff0000 (\lnot\sub(\emsp\i)) \emsp ident H)" with precedence 19 +for @{ 'Not_intro_ko_2 $ab (λ${ident H}:$p.$b) }. +interpretation "Not_intro_ko_2" 'Not_intro_ko_2 ab \eta.b = + (cast ? ? (show ab (cast ? ? (Not_intro ? (cast ? ? b))))). + +notation < "maction (\infrule hbox(\emsp b \emsp) ab (\lnot\sub(\emsp\i) \emsp ident H) ) (\vdots)" with precedence 19 +for @{ 'Not_intro_ok_1 $ab (λ${ident H}:$p.$b) }. +interpretation "Not_intro_ok_1" 'Not_intro_ok_1 ab \eta.b = + (show ab (Not_intro ? b)). + +notation < "\infrule hbox(\emsp b \emsp) mstyle color #ff0000 (ab) (\lnot\sub(\emsp\i) \emsp ident H) " with precedence 19 +for @{ 'Not_intro_ok_2 $ab (λ${ident H}:$p.$b) }. +interpretation "Not_intro_ok_2" 'Not_intro_ok_2 ab \eta.b = + (cast ? ? (show ab (Not_intro ? b))). + +notation > "¬#'i' [ident H] term 90 b" with precedence 19 +for @{ 'Not_intro (λ${ident H}.show $b ?) }. +interpretation "Not_intro KO" 'Not_intro a = (cast ? ? (Not_intro ? (cast ? ? a))). +interpretation "Not_intro OK" 'Not_intro a = (Not_intro ? a). + +(* ¬ elimination *) +notation < "\infrule hbox(\emsp ab \emsp\emsp\emsp a\emsp) b mstyle color #ff0000 (\lnot\sub(\emsp\e)) " with precedence 19 +for @{ 'Not_elim_ko_1 $ab $a $b }. +interpretation "Not_elim_ko_1" 'Not_elim_ko_1 ab a b = + (show b (cast ? ? (Not_elim ? (cast ? ? ab) (cast ? ? a)))). + +notation < "\infrule hbox(\emsp ab \emsp\emsp\emsp a\emsp) mstyle color #ff0000 (b) mstyle color #ff0000 (\lnot\sub(\emsp\e)) " with precedence 19 +for @{ 'Not_elim_ko_2 $ab $a $b }. +interpretation "Not_elim_ko_2" 'Not_elim_ko_2 ab a b = + (cast ? ? (show b (cast ? ? (Not_elim ? (cast ? ? ab) (cast ? ? a))))). + +notation < "maction (\infrule hbox(\emsp ab \emsp\emsp\emsp a\emsp) b (\lnot\sub(\emsp\e)) ) (\vdots)" with precedence 19 +for @{ 'Not_elim_ok_1 $ab $a $b }. +interpretation "Not_elim_ok_1" 'Not_elim_ok_1 ab a b = + (show b (Not_elim ? ab a)). + +notation < "\infrule hbox(\emsp ab \emsp\emsp\emsp a\emsp) mstyle color #ff0000 (b) (\lnot\sub(\emsp\e)) " with precedence 19 +for @{ 'Not_elim_ok_2 $ab $a $b }. +interpretation "Not_elim_ok_2" 'Not_elim_ok_2 ab a b = + (cast ? ? (show b (Not_elim ? ab a))). + +notation > "¬#'e' term 90 ab term 90 a" with precedence 19 +for @{ 'Not_elim (show $ab ?) (show $a ?) }. +interpretation "Not_elim KO" 'Not_elim ab a = + (cast ? ? (Not_elim unit (cast ? ? ab) (cast ? ? a))). +interpretation "Not_elim OK" 'Not_elim ab a = + (Not_elim ? ab a). + +(* RAA *) +notation < "\infrule hbox(\emsp Px \emsp) Pn (mstyle color #ff0000 (\RAA) \emsp ident x)" with precedence 19 +for @{ 'RAA_ko_1 (λ${ident x}:$tx.$Px) $Pn }. +interpretation "RAA_ko_1" 'RAA_ko_1 Px Pn = + (show Pn (cast ? ? (Raa ? (cast ? ? Px)))). + +notation < "\infrule hbox(\emsp Px \emsp) mstyle color #ff0000 (Pn) (mstyle color #ff0000 (\RAA) \emsp ident x)" with precedence 19 +for @{ 'RAA_ko_2 (λ${ident x}:$tx.$Px) $Pn }. +interpretation "RAA_ko_2" 'RAA_ko_2 Px Pn = + (cast ? ? (show Pn (cast ? ? (Raa ? (cast ? ? Px))))). + +notation < "maction (\infrule hbox(\emsp Px \emsp) Pn (\RAA \emsp ident x)) (\vdots)" with precedence 19 +for @{ 'RAA_ok_1 (λ${ident x}:$tx.$Px) $Pn }. +interpretation "RAA_ok_1" 'RAA_ok_1 Px Pn = + (show Pn (Raa ? Px)). + +notation < "\infrule hbox(\emsp Px \emsp) mstyle color #ff0000 (Pn) (\RAA \emsp ident x)" with precedence 19 +for @{ 'RAA_ok_2 (λ${ident x}:$tx.$Px) $Pn }. +interpretation "RAA_ok_2" 'RAA_ok_2 Px Pn = + (cast ? ? (show Pn (Raa ? Px))). + +notation > "'RAA' [ident H] term 90 b" with precedence 19 +for @{ 'Raa (λ${ident H}.show $b ?) }. +interpretation "RAA KO" 'Raa p = (cast ? unit (Raa ? (cast ? (unit_to ?) p))). +interpretation "RAA OK" 'Raa p = (Raa ? p). + +(* ∃ introduction *) +notation < "\infrule hbox(\emsp Pn \emsp) Px mstyle color #ff0000 (∃\sub\i)" with precedence 19 +for @{ 'Exists_intro_ko_1 $Pn $Px }. +interpretation "Exists_intro_ko_1" 'Exists_intro_ko_1 Pn Px = + (show Px (cast ? ? (Exists_intro ? ? ? (cast ? ? Pn)))). + +notation < "\infrule hbox(\emsp Pn \emsp) mstyle color #ff0000 (Px) mstyle color #ff0000 (∃\sub\i)" with precedence 19 +for @{ 'Exists_intro_ko_2 $Pn $Px }. +interpretation "Exists_intro_ko_2" 'Exists_intro_ko_2 Pn Px = + (cast ? ? (show Px (cast ? ? (Exists_intro ? ? ? (cast ? ? Pn))))). + +notation < "maction (\infrule hbox(\emsp Pn \emsp) Px (∃\sub\i)) (\vdots)" with precedence 19 +for @{ 'Exists_intro_ok_1 $Pn $Px }. +interpretation "Exists_intro_ok_1" 'Exists_intro_ok_1 Pn Px = + (show Px (Exists_intro ? ? ? Pn)). + +notation < "\infrule hbox(\emsp Pn \emsp) mstyle color #ff0000 (Px) (∃\sub\i)" with precedence 19 +for @{ 'Exists_intro_ok_2 $Pn $Px }. +interpretation "Exists_intro_ok_2" 'Exists_intro_ok_2 Pn Px = + (cast ? ? (show Px (Exists_intro ? ? ? Pn))). + +notation >"∃#'i' {term 90 t} term 90 Pt" non associative with precedence 19 +for @{'Exists_intro $t (λw.? w) (show $Pt ?)}. +interpretation "Exists_intro KO" 'Exists_intro t P Pt = + (cast ? ? (Exists_intro sort P t (cast ? ? Pt))). +interpretation "Exists_intro OK" 'Exists_intro t P Pt = + (Exists_intro sort P t Pt). + +(* ∃ elimination *) +notation < "\infrule hbox(\emsp ExPx \emsp\emsp\emsp Pc \emsp) c (mstyle color #ff0000 (∃\sub\e) \emsp ident n \emsp ident HPn)" with precedence 19 +for @{ 'Exists_elim_ko_1 $ExPx (λ${ident n}:$tn.λ${ident HPn}:$Pn.$Pc) $c }. +interpretation "Exists_elim_ko_1" 'Exists_elim_ko_1 ExPx Pc c = + (show c (cast ? ? (Exists_elim ? ? ? (cast ? ? ExPx) (cast ? ? Pc)))). + +notation < "\infrule hbox(\emsp ExPx \emsp\emsp\emsp Pc \emsp) mstyle color #ff0000 (c) (mstyle color #ff0000 (∃\sub\e) \emsp ident n \emsp ident HPn)" with precedence 19 +for @{ 'Exists_elim_ko_2 $ExPx (λ${ident n}:$tn.λ${ident HPn}:$Pn.$Pc) $c }. +interpretation "Exists_elim_ko_2" 'Exists_elim_ko_2 ExPx Pc c = + (cast ? ? (show c (cast ? ? (Exists_elim ? ? ? (cast ? ? ExPx) (cast ? ? Pc))))). + +notation < "maction (\infrule hbox(\emsp ExPx \emsp\emsp\emsp Pc \emsp) c (∃\sub\e \emsp ident n \emsp ident HPn)) (\vdots)" with precedence 19 +for @{ 'Exists_elim_ok_1 $ExPx (λ${ident n}:$tn.λ${ident HPn}:$Pn.$Pc) $c }. +interpretation "Exists_elim_ok_1" 'Exists_elim_ok_1 ExPx Pc c = + (show c (Exists_elim ? ? ? ExPx Pc)). + +notation < "\infrule hbox(\emsp ExPx \emsp\emsp\emsp Pc \emsp) mstyle color #ff0000 (c) (∃\sub\e \emsp ident n \emsp ident HPn)" with precedence 19 +for @{ 'Exists_elim_ok_2 $ExPx (λ${ident n}:$tn.λ${ident HPn}:$Pn.$Pc) $c }. +interpretation "Exists_elim_ok_2" 'Exists_elim_ok_2 ExPx Pc c = + (cast ? ? (show c (Exists_elim ? ? ? ExPx Pc))). + +definition ex_concl := λx:sort → Prop.Πy:sort.unit → x y. +definition ex_concl_dummy := Πy:sort.unit → unit. +definition fake_pred := λx:sort.unit. + +notation >"∃#'e' term 90 ExPt {ident t} [ident H] term 90 c" non associative with precedence 19 +for @{'Exists_elim (λx.? x) (show $ExPt ?) (λ${ident t}:sort.λ${ident H}.show $c ?)}. +interpretation "Exists_elim KO" 'Exists_elim P ExPt c = + (cast ? ? (Exists_elim sort P ? + (cast (Exists ? P) ? ExPt) + (cast ex_concl_dummy (ex_concl ?) c))). +interpretation "Exists_elim OK" 'Exists_elim P ExPt c = + (Exists_elim sort P ? ExPt c). + +(* ∀ introduction *) + +notation < "\infrule hbox(\emsp Px \emsp) Pn (mstyle color #ff0000 (∀\sub\i) \emsp ident x)" with precedence 19 +for @{ 'Forall_intro_ko_1 (λ${ident x}:$tx.$Px) $Pn }. +interpretation "Forall_intro_ko_1" 'Forall_intro_ko_1 Px Pn = + (show Pn (cast ? ? (Forall_intro ? ? (cast ? ? Px)))). + +notation < "\infrule hbox(\emsp Px \emsp) mstyle color #ff0000(Pn) (mstyle color #ff0000 (∀\sub\i) \emsp ident x)" with precedence 19 +for @{ 'Forall_intro_ko_2 (λ${ident x}:$tx.$Px) $Pn }. +interpretation "Forall_intro_ko_2" 'Forall_intro_ko_2 Px Pn = + (cast ? ? (show Pn (cast ? ? (Forall_intro ? ? (cast ? ? Px))))). + +notation < "maction (\infrule hbox(\emsp Px \emsp) Pn (∀\sub\i \emsp ident x)) (\vdots)" with precedence 19 +for @{ 'Forall_intro_ok_1 (λ${ident x}:$tx.$Px) $Pn }. +interpretation "Forall_intro_ok_1" 'Forall_intro_ok_1 Px Pn = + (show Pn (Forall_intro ? ? Px)). + +notation < "\infrule hbox(\emsp Px \emsp) mstyle color #ff0000 (Pn) (∀\sub\i \emsp ident x)" with precedence 19 +for @{ 'Forall_intro_ok_2 (λ${ident x}:$tx.$Px) $Pn }. +interpretation "Forall_intro_ok_2" 'Forall_intro_ok_2 Px Pn = + (cast ? ? (show Pn (Forall_intro ? ? Px))). + +notation > "∀#'i' {ident y} term 90 Px" non associative with precedence 19 +for @{ 'Forall_intro (λ_.?) (λ${ident y}.show $Px ?) }. +interpretation "Forall_intro KO" 'Forall_intro P Px = + (cast ? ? (Forall_intro sort P (cast ? ? Px))). +interpretation "Forall_intro OK" 'Forall_intro P Px = + (Forall_intro sort P Px). + +(* ∀ elimination *) +notation < "\infrule hbox(\emsp Px \emsp) Pn (mstyle color #ff0000 (∀\sub\e))" with precedence 19 +for @{ 'Forall_elim_ko_1 $Px $Pn }. +interpretation "Forall_elim_ko_1" 'Forall_elim_ko_1 Px Pn = + (show Pn (cast ? ? (Forall_elim ? ? ? (cast ? ? Px)))). + +notation < "\infrule hbox(\emsp Px \emsp) mstyle color #ff0000(Pn) (mstyle color #ff0000 (∀\sub\e))" with precedence 19 +for @{ 'Forall_elim_ko_2 $Px $Pn }. +interpretation "Forall_elim_ko_2" 'Forall_elim_ko_2 Px Pn = + (cast ? ? (show Pn (cast ? ? (Forall_elim ? ? ? (cast ? ? Px))))). + +notation < "maction (\infrule hbox(\emsp Px \emsp) Pn (∀\sub\e)) (\vdots)" with precedence 19 +for @{ 'Forall_elim_ok_1 $Px $Pn }. +interpretation "Forall_elim_ok_1" 'Forall_elim_ok_1 Px Pn = + (show Pn (Forall_elim ? ? ? Px)). + +notation < "\infrule hbox(\emsp Px \emsp) mstyle color #ff0000 (Pn) (∀\sub\e)" with precedence 19 +for @{ 'Forall_elim_ok_2 $Px $Pn }. +interpretation "Forall_elim_ok_2" 'Forall_elim_ok_2 Px Pn = + (cast ? ? (show Pn (Forall_elim ? ? ? Px))). + +notation > "∀#'e' {term 90 t} term 90 Pn" non associative with precedence 19 +for @{ 'Forall_elim (λ_.?) $t (show $Pn ?) }. +interpretation "Forall_elim KO" 'Forall_elim P t Px = + (cast ? unit (Forall_elim sort P t (cast ? ? Px))). +interpretation "Forall_elim OK" 'Forall_elim P t Px = + (Forall_elim sort P t Px). + +(* already proved lemma *) +definition hide_args : ΠA:Type[0].A→A := λA:Type[0].λa:A.a. +notation < "t" non associative with precedence 90 for @{'hide_args $t}. +interpretation "hide 0 args" 'hide_args t = (hide_args ? t). +interpretation "hide 1 args" 'hide_args t = (hide_args ? t ?). +interpretation "hide 2 args" 'hide_args t = (hide_args ? t ? ?). +interpretation "hide 3 args" 'hide_args t = (hide_args ? t ? ? ?). +interpretation "hide 4 args" 'hide_args t = (hide_args ? t ? ? ? ?). +interpretation "hide 5 args" 'hide_args t = (hide_args ? t ? ? ? ? ?). +interpretation "hide 6 args" 'hide_args t = (hide_args ? t ? ? ? ? ? ?). +interpretation "hide 7 args" 'hide_args t = (hide_args ? t ? ? ? ? ? ? ?). + +(* more args crashes the pattern matcher *) + +(* already proved lemma, 0 assumptions *) +definition Lemma : ΠA.A→A ≝ λA:Prop.λa:A.a. + +notation < "\infrule + (\infrule + (\emsp) + (╲ mstyle mathsize normal (mstyle color #ff0000 (H)) ╱) \nbsp) + p \nbsp" +non associative with precedence 19 +for @{ 'lemma_ko_1 $p ($H : $_) }. +interpretation "lemma_ko_1" 'lemma_ko_1 p H = + (show p (cast ? ? (Lemma ? (cast ? ? H)))). + +notation < "\infrule + (\infrule + (\emsp) + (╲ mstyle mathsize normal (mstyle color #ff0000 (H)) ╱) \nbsp) + mstyle color #ff0000 (p) \nbsp" +non associative with precedence 19 +for @{ 'lemma_ko_2 $p ($H : $_) }. +interpretation "lemma_ko_2" 'lemma_ko_2 p H = + (cast ? ? (show p (cast ? ? + (Lemma ? (cast ? ? H))))). + + +notation < "\infrule + (\infrule + (\emsp) + (╲ mstyle mathsize normal (H) ╱) \nbsp) + p \nbsp" +non associative with precedence 19 +for @{ 'lemma_ok_1 $p ($H : $_) }. +interpretation "lemma_ok_1" 'lemma_ok_1 p H = + (show p (Lemma ? H)). + +notation < "\infrule + (\infrule + (\emsp) + (╲ mstyle mathsize normal (H) ╱) \nbsp) + mstyle color #ff0000 (p) \nbsp" +non associative with precedence 19 +for @{ 'lemma_ok_2 $p ($H : $_) }. +interpretation "lemma_ok_2" 'lemma_ok_2 p H = + (cast ? ? (show p (Lemma ? H))). + +notation > "'lem' 0 term 90 l" non associative with precedence 19 +for @{ 'Lemma (hide_args ? $l : ?) }. +interpretation "lemma KO" 'Lemma l = + (cast ? ? (Lemma unit (cast unit ? l))). +interpretation "lemma OK" 'Lemma l = (Lemma ? l). + + +(* already proved lemma, 1 assumption *) +definition Lemma1 : ΠA,B. (A ⇒ B) → A → B ≝ + λA,B:Prop.λf:A⇒B.λa:A. + Imply_elim A B f a. + +notation < "\infrule + (\infrule + (\emsp a \emsp) + (╲ mstyle mathsize normal (mstyle color #ff0000 (H)) ╱) \nbsp) + p \nbsp" +non associative with precedence 19 +for @{ 'lemma1_ko_1 $a $p ($H : $_) }. +interpretation "lemma1_ko_1" 'lemma1_ko_1 a p H = + (show p (cast ? ? (Lemma1 ? ? (cast ? ? H) (cast ? ? a)))). + +notation < "\infrule + (\infrule + (\emsp a \emsp) + (╲ mstyle mathsize normal (mstyle color #ff0000 (H)) ╱) \nbsp) + mstyle color #ff0000 (p) \nbsp" +non associative with precedence 19 +for @{ 'lemma1_ko_2 $a $p ($H : $_) }. +interpretation "lemma1_ko_2" 'lemma1_ko_2 a p H = + (cast ? ? (show p (cast ? ? + (Lemma1 ? ? (cast ? ? H) (cast ? ? a))))). + + +notation < "\infrule + (\infrule + (\emsp a \emsp) + (╲ mstyle mathsize normal (H) ╱) \nbsp) + p \nbsp" +non associative with precedence 19 +for @{ 'lemma1_ok_1 $a $p ($H : $_) }. +interpretation "lemma1_ok_1" 'lemma1_ok_1 a p H = + (show p (Lemma1 ? ? H a)). + +notation < "\infrule + (\infrule + (\emsp a \emsp) + (╲ mstyle mathsize normal (H) ╱) \nbsp) + mstyle color #ff0000 (p) \nbsp" +non associative with precedence 19 +for @{ 'lemma1_ok_2 $a $p ($H : $_) }. +interpretation "lemma1_ok_2" 'lemma1_ok_2 a p H = + (cast ? ? (show p (Lemma1 ? ? H a))). + + +notation > "'lem' 1 term 90 l term 90 p" non associative with precedence 19 +for @{ 'Lemma1 (hide_args ? $l : ?) (show $p ?) }. +interpretation "lemma 1 KO" 'Lemma1 l p = + (cast ? ? (Lemma1 unit unit (cast (Imply unit unit) ? l) (cast unit ? p))). +interpretation "lemma 1 OK" 'Lemma1 l p = (Lemma1 ? ? l p). + +(* already proved lemma, 2 assumptions *) +definition Lemma2 : ΠA,B,C. (A ⇒ B ⇒ C) → A → B → C ≝ + λA,B,C:Prop.λf:A⇒B⇒C.λa:A.λb:B. + Imply_elim B C (Imply_elim A (B⇒C) f a) b. + +notation < "\infrule + (\infrule + (\emsp a \emsp\emsp\emsp b \emsp) + (╲ mstyle mathsize normal (mstyle color #ff0000 (H)) ╱) \nbsp) + p \nbsp" +non associative with precedence 19 +for @{ 'lemma2_ko_1 $a $b $p ($H : $_) }. +interpretation "lemma2_ko_1" 'lemma2_ko_1 a b p H = + (show p (cast ? ? (Lemma2 ? ? ? (cast ? ? H) (cast ? ? a) (cast ? ? b)))). + +notation < "\infrule + (\infrule + (\emsp a \emsp\emsp\emsp b \emsp) + (╲ mstyle mathsize normal (mstyle color #ff0000 (H)) ╱) \nbsp) + mstyle color #ff0000 (p) \nbsp" +non associative with precedence 19 +for @{ 'lemma2_ko_2 $a $b $p ($H : $_) }. +interpretation "lemma2_ko_2" 'lemma2_ko_2 a b p H = + (cast ? ? (show p (cast ? ? + (Lemma2 ? ? ? (cast ? ? H) (cast ? ? a) (cast ? ? b))))). + + +notation < "\infrule + (\infrule + (\emsp a \emsp\emsp\emsp b \emsp) + (╲ mstyle mathsize normal (H) ╱) \nbsp) + p \nbsp" +non associative with precedence 19 +for @{ 'lemma2_ok_1 $a $b $p ($H : $_) }. +interpretation "lemma2_ok_1" 'lemma2_ok_1 a b p H = + (show p (Lemma2 ? ? ? H a b)). + +notation < "\infrule + (\infrule + (\emsp a \emsp\emsp\emsp b \emsp) + (╲ mstyle mathsize normal (H) ╱) \nbsp) + mstyle color #ff0000 (p) \nbsp" +non associative with precedence 19 +for @{ 'lemma2_ok_2 $a $b $p ($H : $_) }. +interpretation "lemma2_ok_2" 'lemma2_ok_2 a b p H = + (cast ? ? (show p (Lemma2 ? ? ? H a b))). + +notation > "'lem' 2 term 90 l term 90 p term 90 q" non associative with precedence 19 +for @{ 'Lemma2 (hide_args ? $l : ?) (show $p ?) (show $q ?) }. +interpretation "lemma 2 KO" 'Lemma2 l p q = + (cast ? ? (Lemma2 unit unit unit (cast (Imply unit (Imply unit unit)) ? l) (cast unit ? p) (cast unit ? q))). +interpretation "lemma 2 OK" 'Lemma2 l p q = (Lemma2 ? ? ? l p q). + +(* already proved lemma, 3 assumptions *) +definition Lemma3 : ΠA,B,C,D. (A ⇒ B ⇒ C ⇒ D) → A → B → C → D ≝ + λA,B,C,D:Prop.λf:A⇒B⇒C⇒D.λa:A.λb:B.λc:C. + Imply_elim C D (Imply_elim B (C⇒D) (Imply_elim A (B⇒C⇒D) f a) b) c. + +notation < "\infrule + (\infrule + (\emsp a \emsp\emsp\emsp b \emsp\emsp\emsp c \emsp) + (╲ mstyle mathsize normal (mstyle color #ff0000 (H)) ╱) \nbsp) + p \nbsp" +non associative with precedence 19 +for @{ 'lemma3_ko_1 $a $b $c $p ($H : $_) }. +interpretation "lemma3_ko_1" 'lemma3_ko_1 a b c p H = + (show p (cast ? ? + (Lemma3 ? ? ? ? (cast ? ? H) (cast ? ? a) (cast ? ? b) (cast ? ? c)))). + +notation < "\infrule + (\infrule + (\emsp a \emsp\emsp\emsp b \emsp\emsp\emsp c \emsp) + (╲ mstyle mathsize normal (mstyle color #ff0000 (H)) ╱) \nbsp) + mstyle color #ff0000 (p) \nbsp" +non associative with precedence 19 +for @{ 'lemma3_ko_2 $a $b $c $p ($H : $_) }. +interpretation "lemma3_ko_2" 'lemma3_ko_2 a b c p H = + (cast ? ? (show p (cast ? ? + (Lemma3 ? ? ? ? (cast ? ? H) (cast ? ? a) (cast ? ? b) (cast ? ? c))))). + + +notation < "\infrule + (\infrule + (\emsp a \emsp\emsp\emsp b \emsp\emsp\emsp c \emsp) + (╲ mstyle mathsize normal (H) ╱) \nbsp) + p \nbsp" +non associative with precedence 19 +for @{ 'lemma3_ok_1 $a $b $c $p ($H : $_) }. +interpretation "lemma3_ok_1" 'lemma3_ok_1 a b c p H = + (show p (Lemma3 ? ? ? ? H a b c)). + +notation < "\infrule + (\infrule + (\emsp a \emsp\emsp\emsp b \emsp\emsp\emsp c \emsp) + (╲ mstyle mathsize normal (H) ╱) \nbsp) + mstyle color #ff0000 (p) \nbsp" +non associative with precedence 19 +for @{ 'lemma3_ok_2 $a $b $c $p ($H : $_) }. +interpretation "lemma3_ok_2" 'lemma3_ok_2 a b c p H = + (cast ? ? (show p (Lemma3 ? ? ? ? H a b c))). + +notation > "'lem' 3 term 90 l term 90 p term 90 q term 90 r" non associative with precedence 19 +for @{ 'Lemma3 (hide_args ? $l : ?) (show $p ?) (show $q ?) (show $r ?) }. +interpretation "lemma 3 KO" 'Lemma3 l p q r = + (cast ? ? (Lemma3 unit unit unit unit (cast (Imply unit (Imply unit (Imply unit unit))) ? l) (cast unit ? p) (cast unit ? q) (cast unit ? r))). +interpretation "lemma 3 OK" 'Lemma3 l p q r = (Lemma3 ? ? ? ? l p q r). diff --git a/matita/matita/lib/reverse_complexity/almost.ma b/matita/matita/lib/reverse_complexity/almost.ma new file mode 100644 index 000000000..75578d0f9 --- /dev/null +++ b/matita/matita/lib/reverse_complexity/almost.ma @@ -0,0 +1,24 @@ +include "reverse_complexity/speedup.ma". + +definition aes : (nat → nat) → (nat → nat) → Prop ≝ λf,g. + ∃n.∀m. n ≤ m → f m = g m. + +lemma CF_almost: ∀f,g,s. CF s g → aes g f → CF s f. +#f #g #s #CFg * #n lapply CFg -CFg lapply g -g +elim n + [#g #CFg #H @(ext_CF … g) [#m @H // |//] + |#i #Hind #g #CFg #H + @(Hind (λx. if eqb i x then f i else g x)) + [@CF_if + [@(O_to_CF … MSC) [@le_to_O @(MSC_in … CFg)] @CF_eqb // + |@(O_to_CF … MSC) [@le_to_O @(MSC_in … CFg)] @CF_const + |@CFg + ] + |#m #leim cases (le_to_or_lt_eq … leim) + [#ltim lapply (lt_to_not_eq … ltim) #noteqim + >(not_eq_to_eqb_false … noteqim) @H @ltim + |#eqim >eqim >eqb_n_n // + ] + ] + ] +qed. \ No newline at end of file diff --git a/matita/matita/lib/reverse_complexity/basics.ma b/matita/matita/lib/reverse_complexity/basics.ma new file mode 100644 index 000000000..de383d1d0 --- /dev/null +++ b/matita/matita/lib/reverse_complexity/basics.ma @@ -0,0 +1,106 @@ +include "basics/types.ma". +include "arithmetics/nat.ma". + +(********************************** 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〉. + +lemma expand_pair: ∀x. x = 〈fst x, snd x〉. +#x lapply (surj_pair x) * #a * #b #Hx >Hx >fst_pair >snd_pair // +qed. + +(************************************* 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. + + +definition total ≝ λf.λx:nat. Some nat (f x). + + diff --git a/matita/matita/lib/reverse_complexity/bigops_compl.ma b/matita/matita/lib/reverse_complexity/bigops_compl.ma new file mode 100644 index 000000000..032174a0c --- /dev/null +++ b/matita/matita/lib/reverse_complexity/bigops_compl.ma @@ -0,0 +1,607 @@ +include "reverse_complexity/complexity.ma". +include "reverse_complexity/sigma_diseq.ma". + +include alias "reverse_complexity/basics.ma". + +lemma bigop_prim_rec: ∀a,b,c,p,f,x. + bigop (b x-a x) (λi:ℕ.p 〈i+a x,x〉) ? (c 〈a x,x〉) plus (λi:ℕ.f 〈i+a x,x〉) = + prim_rec c + (λi.if p 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉 + then plus (f 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉) (fst (snd i)) + else fst (snd i)) (b x-a x) 〈a x ,x〉. +#a #b #c #p #f #x normalize elim (b x-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + cases (true_or_false (p 〈i+a x,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +lemma bigop_prim_rec_dec: ∀a,b,c,p,f,x. + bigop (b x-a x) (λi:ℕ.p 〈b x -i,x〉) ? (c 〈b x,x〉) plus (λi:ℕ.f 〈b x-i,x〉) = + prim_rec c + (λi.if p 〈fst (snd (snd i)) - fst i,snd (snd (snd i))〉 + then plus (f 〈fst (snd (snd i)) - fst i,snd (snd (snd i))〉) (fst (snd i)) + else fst (snd i)) (b x-a x) 〈b x ,x〉. +#a #b #c #p #f #x normalize elim (b x-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + cases (true_or_false (p 〈b x - i,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +lemma bigop_prim_rec_dec1: ∀a,b,c,p,f,x. + bigop (S(b x)-a x) (λi:ℕ.p 〈b x - i,x〉) ? (c 〈b x,x〉) plus (λi:ℕ.f 〈b x- i,x〉) = + prim_rec c + (λi.if p 〈fst (snd (snd i)) - (fst i),snd (snd (snd i))〉 + then plus (f 〈fst (snd (snd i)) - (fst i),snd (snd (snd i))〉) (fst (snd i)) + else fst (snd i)) (S(b x)-a x) 〈b x,x〉. +#a #b #c #p #f #x elim (S(b x)-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + cases (true_or_false (p 〈b x - i,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +lemma sum_prim_rec1: ∀a,b,p,f,x. + ∑_{i ∈[a x,b x[ | p 〈i,x〉 }(f 〈i,x〉) = + prim_rec (λi.0) + (λi.if p 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉 + then f 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉 + fst (snd i) + else fst (snd i)) (b x-a x) 〈a x ,x〉. +#a #b #p #f #x elim (b x-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + cases (true_or_false (p 〈i+a x,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +lemma bigop_plus_c: ∀k,p,f,c. + c k + bigop k (λi.p i) ? 0 plus (λi.f i) = + bigop k (λi.p i) ? (c k) plus (λi.f i). +#k #p #f elim k [normalize //] +#i #Hind #c cases (true_or_false (p i)) #Hcase +[>bigop_Strue // >bigop_Strue // (commutative_plus ? (f i)) + >associative_plus @eq_f @Hind +|>bigop_Sfalse // >bigop_Sfalse // +] +qed. + + +(*********************************** maximum **********************************) + +lemma max_gen: ∀a,b,p,f,x. a ≤b → + max_{i ∈[a,b[ | p 〈i,x〉 }(f 〈i,x〉) = max_{i < b | leb a i ∧ p 〈i,x〉 }(f 〈i,x〉). +#a #b #p #f #x @(bigop_I_gen ????? MaxA) +qed. + +lemma max_prim_rec_base: ∀a,b,p,f,x. a ≤b → + max_{i < b| p 〈i,x〉 }(f 〈i,x〉) = + prim_rec (λi.0) + (λi.if p 〈fst i,x〉 then max (f 〈fst i,snd (snd i)〉) (fst (snd i)) else fst (snd i)) b x. +#a #b #p #f #x #leab >max_gen // elim b + [normalize // + |#i #Hind >prim_rec_S >fst_pair >snd_pair >snd_pair >fst_pair + cases (true_or_false (p 〈i,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +lemma max_prim_rec: ∀a,b,p,f,x. a ≤b → + max_{i ∈[a,b[ | p 〈i,x〉 }(f 〈i,x〉) = + prim_rec (λi.0) + (λi.if leb a (fst i) ∧ p 〈fst i,x〉 then max (f 〈fst i,snd (snd i)〉) (fst (snd i)) else fst (snd i)) b x. +#a #b #p #f #x #leab >max_gen // elim b + [normalize // + |#i #Hind >prim_rec_S >fst_pair >snd_pair >snd_pair >fst_pair + cases (true_or_false (leb a i ∧ p 〈i,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +lemma max_prim_rec1: ∀a,b,p,f,x. + max_{i ∈[a x,b x[ | p 〈i,x〉 }(f 〈i,x〉) = + prim_rec (λi.0) + (λi.if p 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉 + then max (f 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉) (fst (snd i)) + else fst (snd i)) (b x-a x) 〈a x ,x〉. +#a #b #p #f #x elim (b x-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + cases (true_or_false (p 〈i+a x,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +(* the argument is 〈b-a,〈a,x〉〉 *) + +definition max_unary_pr ≝ λp,f.unary_pr (λx.0) + (λi. + let k ≝ fst i in + let r ≝ fst (snd i) in + let a ≝ fst (snd (snd i)) in + let x ≝ snd (snd (snd i)) in + if p 〈k + a,x〉 then max (f 〈k+a,x〉) r else r). + +lemma max_unary_pr1: ∀a,b,p,f,x. + max_{i ∈[a x,b x[ | p 〈i,x〉 }(f 〈i,x〉) = + ((max_unary_pr p f) ∘ (λx.〈b x - a x,〈a x,x〉〉)) x. +#a #b #p #f #x normalize >fst_pair >snd_pair @max_prim_rec1 +qed. + +definition aux_compl ≝ λhp,hf.λi. + let k ≝ fst i in  + let r ≝ fst (snd i) in  + let a ≝ fst (snd (snd i)) in  + let x ≝ snd (snd (snd i)) in  + hp 〈k+a,x〉 + hf 〈k+a,x〉 + (* was MSC r*) MSC i . + +definition aux_compl1 ≝ λhp,hf.λi. + let k ≝ fst i in  + let r ≝ fst (snd i) in  + let a ≝ fst (snd (snd i)) in  + let x ≝ snd (snd (snd i)) in  + hp 〈k+a,x〉 + hf 〈k+a,x〉 + MSC r. + +lemma aux_compl1_def: ∀k,r,m,hp,hf. + aux_compl1 hp hf 〈k,〈r,m〉〉 = + let a ≝ fst m in  + let x ≝ snd m in  + hp 〈k+a,x〉 + hf 〈k+a,x〉 + MSC r. +#k #r #m #hp #hf normalize >fst_pair >snd_pair >snd_pair >fst_pair // +qed. + +lemma aux_compl1_def1: ∀k,r,a,x,hp,hf. + aux_compl1 hp hf 〈k,〈r,〈a,x〉〉〉 = hp 〈k+a,x〉 + hf 〈k+a,x〉 + MSC r. +#k #r #a #x #hp #hf normalize >fst_pair >snd_pair >snd_pair >fst_pair +>fst_pair >snd_pair // +qed. + +axiom Oaux_compl: ∀hp,hf. O (aux_compl1 hp hf) (aux_compl hp hf). + +lemma MSC_max: ∀f,h,x. CF h f → MSC (max_{i < x}(f i)) ≤ max_{i < x}(h i). +#f #h #x #hf elim x // #i #Hind >bigop_Strue [|//] >bigop_Strue [|//] +whd in match (max ??); +cases (true_or_false (leb (f i) (bigop i (λi0:ℕ.true) ? 0 max(λi0:ℕ.f i0)))) +#Hcase >Hcase + [@(transitive_le … Hind) @le_maxr // + |@(transitive_le … (MSC_out … hf i)) @le_maxl // + ] +qed. + +lemma 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〉 + max_{i ∈ [a x, b x [ }(hf 〈i,x〉)))) → + CF s (λx.max_{i ∈[a x,b x[ | p 〈i,x〉 }(f 〈i,x〉)). +#a #b #p #f #ha #hb #hp #hf #s #CFa #CFb #CFp #CFf #HO +@ext_CF1 [|#x @max_unary_pr1] +@(CF_comp ??? (λx.ha x + hb x)) + [|@CF_comp_pair + [@CF_minus [@(O_to_CF … CFb) @O_plus_r // |@(O_to_CF … CFa) @O_plus_l //] + |@CF_comp_pair + [@(O_to_CF … CFa) @O_plus_l // + | @(O_to_CF … CF_id) @O_plus_r @le_to_O @(MSC_in … CFb) + ] + ] + |@(CF_prim_rec … MSC … (aux_compl1 hp hf)) + [@CF_const + |@(O_to_CF … (Oaux_compl … )) + @CF_if + [@(CF_comp p … MSC … CFp) + [@CF_comp_pair + [@CF_plus [@CF_fst| @CF_comp_fst @CF_comp_snd @CF_snd] + |@CF_comp_snd @CF_comp_snd @CF_snd] + |@le_to_O #x normalize >commutative_plus >associative_plus @le_plus // + ] + |@CF_max1 + [@(CF_comp f … MSC … CFf) + [@CF_comp_pair + [@CF_plus [@CF_fst| @CF_comp_fst @CF_comp_snd @CF_snd] + |@CF_comp_snd @CF_comp_snd @CF_snd] + |@le_to_O #x normalize >commutative_plus // + ] + |@CF_comp_fst @(monotonic_CF … CF_snd) normalize // + ] + |@CF_comp_fst @(monotonic_CF … CF_snd) normalize // + ] + |@O_refl + ] + |@(O_trans … HO) -HO + @(O_trans ? (λx:ℕ + .ha x+hb x + +bigop (b x-a x) (λi:ℕ.true) ? (MSC 〈a x,x〉) plus + (λi:ℕ + .(λi0:ℕ + .hp 〈i0,x〉+hf 〈i0,x〉 + +bigop (b x-a x) (λi1:ℕ.true) ? 0 max + (λi1:ℕ.(λi2:ℕ.hf 〈i2,x〉) (i1+a x))) (i+a x)))) + [ + @le_to_O #n @le_plus // whd in match (unary_pr ???); + >fst_pair >snd_pair >bigop_prim_rec elim (b n - a n) + [normalize // + |#x #Hind >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair >aux_compl1_def1 + >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair >fst_pair + >snd_pair normalize in ⊢ (??%); >commutative_plus @le_plus + [-Hind @le_plus // normalize >fst_pair >snd_pair + @(transitive_le ? (bigop x (λi1:ℕ.true) ? 0 (λn0:ℕ.λm:ℕ.if leb n0 m then m else n0 ) + (λi1:ℕ.hf 〈i1+a n,n〉))) + [elim x [normalize @MSC_le] + #x0 #Hind >prim_rec_S >fst_pair >snd_pair >snd_pair >snd_pair + >fst_pair >fst_pair cases (p 〈x0+a n,n〉) normalize + [cases (true_or_false (leb (f 〈x0+a n,n〉) + (prim_rec (λx00:ℕ.O) + (λi:ℕ + .if p 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉  + then if leb (f 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉) + (fst (snd i))  + then fst (snd i)  + else f 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉   + else fst (snd i) ) x0 〈a n,n〉))) #Hcase >Hcase normalize + [@(transitive_le … Hind) -Hind @(le_maxr … (le_n …)) + |@(transitive_le … (MSC_out … CFf …)) @(le_maxl … (le_n …)) + ] + |@(transitive_le … Hind) -Hind @(le_maxr … (le_n …)) + ] + |@(le_maxr … (le_n …)) + ] + |@(transitive_le … Hind) -Hind + generalize in match (bigop x (λi:ℕ.true) ? 0 max + (λi1:ℕ.(λi2:ℕ.hf 〈i2,n〉) (i1+a n))); #c + generalize in match (hf 〈x+a n,n〉); #c1 + elim x [//] #x0 #Hind + >prim_rec_S >prim_rec_S normalize >fst_pair >fst_pair >snd_pair + >snd_pair >snd_pair >snd_pair >snd_pair >snd_pair >fst_pair >fst_pair + >fst_pair @le_plus + [@le_plus // cases (true_or_false (leb c1 c)) #Hcase + >Hcase normalize // @lt_to_le @not_le_to_lt @(leb_false_to_not_le ?? Hcase) + |@Hind + ] + ] + ] + |@O_plus [@O_plus_l //] @le_to_O #x + Hind +cases (true_or_false (eqb a (a+i))) #Hcase >Hcase normalize // +<(eqb_true_to_eq … Hcase) >H // +qed. + +lemma my_minim_nfa : ∀a,f,x,k. f〈a,x〉 = false → +my_minim a f x (S k) = my_minim (S a) f x k. +#a #f #x #k #H elim k + [normalize H >eq_to_eqb_true // + |#i #Hind >my_minim_S >Hind >my_minim_S Hcase + [>(my_minim_fa … Hcase) // | >Hind @sym_eq @(my_minim_nfa … Hcase) ] +qed. + +(* cambiare qui: togliere S *) + + +definition minim_unary_pr ≝ λf.unary_pr (λx.S(fst x)) + (λi. + let k ≝ fst i in + let r ≝ fst (snd i) in + let b ≝ fst (snd (snd i)) in + let x ≝ snd (snd (snd i)) in + if f 〈b-k,x〉 then b-k else r). + +definition compl_minim_unary ≝ λhf:nat → nat.λi. + let k ≝ fst i in + let b ≝ fst (snd (snd i)) in + let x ≝ snd (snd (snd i)) in + hf 〈b-k,x〉 + MSC 〈k,〈S b,x〉〉. + +definition compl_minim_unary_aux ≝ λhf,i. + let k ≝ fst i in + let r ≝ fst (snd i) in + let b ≝ fst (snd (snd i)) in + let x ≝ snd (snd (snd i)) in + hf 〈b-k,x〉 + MSC i. + +lemma compl_minim_unary_aux_def : ∀hf,k,r,b,x. + compl_minim_unary_aux hf 〈k,〈r,〈b,x〉〉〉 = hf 〈b-k,x〉 + MSC 〈k,〈r,〈b,x〉〉〉. +#hf #k #r #b #x normalize >snd_pair >snd_pair >snd_pair >fst_pair >fst_pair // +qed. + +lemma compl_minim_unary_def : ∀hf,k,r,b,x. + compl_minim_unary hf 〈k,〈r,〈b,x〉〉〉 = hf 〈b-k,x〉 + MSC 〈k,〈S b,x〉〉. +#hf #k #r #b #x normalize >snd_pair >snd_pair >snd_pair >fst_pair >fst_pair // +qed. + +lemma compl_minim_unary_aux_def2 : ∀hf,k,r,x. + compl_minim_unary_aux hf 〈k,〈r,x〉〉 = hf 〈fst x-k,snd x〉 + MSC 〈k,〈r,x〉〉. +#hf #k #r #x normalize >snd_pair >snd_pair >fst_pair // +qed. + +lemma compl_minim_unary_def2 : ∀hf,k,r,x. + compl_minim_unary hf 〈k,〈r,x〉〉 = hf 〈fst x-k,snd x〉 + MSC 〈k,〈S(fst x),snd x〉〉. +#hf #k #r #x normalize >snd_pair >snd_pair >fst_pair // +qed. + +lemma min_aux: ∀a,f,x,k. min (S k) (a x) (λi:ℕ.f 〈i,x〉) = + ((minim_unary_pr f) ∘ (λx.〈S k,〈a x + k,x〉〉)) x. +#a #f #x #k whd in ⊢ (???%); >fst_pair >snd_pair +lapply a -a (* @max_prim_rec1 *) +elim k + [normalize #a >fst_pair >snd_pair >fst_pair >snd_pair >snd_pair >fst_pair + fst_pair // + |#i #Hind #a normalize in ⊢ (??%?); >prim_rec_S >fst_pair >snd_pair + >fst_pair >snd_pair >snd_pair >fst_pair minus_S_S <(minus_plus_m_m (a x) i) // +qed. + +lemma minim_unary_pr1: ∀a,b,f,x. + μ_{i ∈[a x,b x]}(f 〈i,x〉) = + if leb (a x) (b x) then ((minim_unary_pr f) ∘ (λx.〈S (b x) - a x,〈b x,x〉〉)) x + else (a x). +#a #b #f #x cases (true_or_false (leb (a x) (b x))) #Hcase >Hcase + [cut (b x = a x + (b x - a x)) + [>commutative_plus minus_Sn_m [|@leb_true_to_le //] + >min_aux whd in ⊢ (??%?); eq_minus_O // @not_le_to_lt @leb_false_to_not_le // + ] +qed. + +axiom sum_inv: ∀a,b,f.∑_{i ∈ [a,S b[ }(f i) = ∑_{i ∈ [a,S b[ }(f (a + b - i)). + +(* +#a #b #f @(bigop_iso … plusAC) whd %{(λi.b - a - i)} %{(λi.b - a -i)} % + [%[#i #lti #_ normalize @eq_f >commutative_plus commutative_plus // + ] + |@(O_to_CF … MSC) + [@le_to_O #x normalize // + |@CF_minus + [@CF_comp_fst @CF_comp_snd @CF_snd |@CF_fst] + ] + |@CF_comp_fst @(monotonic_CF … CF_snd) normalize // + ] + |@O_plus + [@O_plus_l @O_refl + |@O_plus_r @O_ext2 [||#x >compl_minim_unary_aux_def2 @refl] + @O_trans [||@le_to_O #x >compl_minim_unary_def2 @le_n] + @O_plus [@O_plus_l //] + @O_plus_r + @O_trans [|@le_to_O #x @MSC_pair] @O_plus + [@le_to_O #x @monotonic_MSC @(transitive_le ???? (le_fst …)) + >fst_pair @le_n] + @O_trans [|@le_to_O #x @MSC_pair] @O_plus + [@le_to_O #x @monotonic_MSC @(transitive_le ???? (le_snd …)) + >snd_pair @(transitive_le ???? (le_fst …)) >fst_pair + normalize >snd_pair >fst_pair lapply (surj_pair x) + * #x1 * #x2 #Hx >Hx >fst_pair >snd_pair elim x1 // + #i #Hind >prim_rec_S >fst_pair >snd_pair >snd_pair >fst_pair + cases (f ?) [@le_S // | //]] + @le_to_O #x @monotonic_MSC @(transitive_le ???? (le_snd …)) >snd_pair + >(expand_pair (snd (snd x))) in ⊢ (?%?); @le_pair // + ] + ] + |cut (O s (λx.ha x + hb x + + ∑_{i ∈[a x ,S(b x)[ }(hf 〈a x+b x-i,x〉 + MSC 〈b x -(a x+b x-i),〈S(b x),x〉〉))) + [@(O_ext2 … HO) #x @eq_f @sum_inv] -HO #HO + @(O_trans … HO) -HO + @(O_trans ? (λx:ℕ.ha x+hb x + +bigop (S(b x)-a x) (λi:ℕ.true) ? + (MSC 〈b x,x〉) plus (λi:ℕ.(λj.hf j + MSC 〈b x - fst j,〈S(b (snd j)),snd j〉〉) 〈b x- i,x〉))) + [@le_to_O #n @le_plus // whd in match (unary_pr ???); + >fst_pair >snd_pair >(bigop_prim_rec_dec1 a b ? (λi.true)) + (* it is crucial to recall that the index is bound by S(b x) *) + cut (S (b n) - a n ≤ S (b n)) [//] + elim (S(b n) - a n) + [normalize // + |#x #Hind #lex >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair + >compl_minim_unary_def >prim_rec_S >fst_pair >snd_pair >fst_pair + >snd_pair >fst_pair >snd_pair >fst_pair whd in ⊢ (??%); >commutative_plus + @le_plus [2:@Hind @le_S @le_S_S_to_le @lex] -Hind >snd_pair + >minus_minus_associative // @le_S_S_to_le // + ] + |@O_plus [@O_plus_l //] @O_ext2 [||#x @bigop_plus_c] + @O_plus + [@O_plus_l @O_trans [|@le_to_O #x @MSC_pair] + @O_plus + [@O_plus_r @le_to_O @(MSC_out … CFb) + |@O_plus_r @le_to_O @(MSC_in … CFb) + ] + |@O_plus_r @(O_ext2 … (O_refl …)) #x @same_bigop + [//|#i #H #_ @eq_f2 [@eq_f @eq_f2 //|>fst_pair @eq_f @eq_f2 //] + ] + ] + ] + ] + |@(O_to_CF … CFa) @(O_trans … HO) @O_plus_l @O_plus_l @O_refl + ] + +qed. + +lemma CF_mu2: ∀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〉 + MSC〈S(b x),x〉)) → + CF s (λx.μ_{i ∈[a x,b x] }(f 〈i,x〉)). +#a #b #f #sa #sb #sf #s #CFa #CFb #CFf #HO +@(O_to_CF … HO (CF_mu … CFa CFb CFf ?)) @O_plus [@O_plus_l @O_refl] +@O_plus_r @O_ext2 [|| #x @(bigop_op … plusAC)] +@O_plus [@le_to_O #x @le_sigma //] +@(O_trans ? (λx.∑_{i ∈[a x ,S(b x)[ }(MSC(b x -i)+MSC 〈S(b x),x〉))) + [@le_to_O #x @le_sigma //] +@O_ext2 [|| #x @(bigop_op … plusAC)] @O_plus + [@le_to_O #x @le_sigma // #i #lti #_ @(transitive_le … (MSC 〈S (b x),x〉)) // + @monotonic_MSC @(transitive_le … (S(b x))) // @le_S // + |@le_to_O #x @le_sigma // + ] +qed. + +(* uses MSC_S *) + +lemma CF_mu3: ∀a,b.∀f:nat →bool.∀sa,sb,sf,s. (∀x.sf x > 0) → + 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〉 + MSC〈b x,x〉)) → + CF s (λx.μ_{i ∈[a x,b x] }(f 〈i,x〉)). +#a #b #f #sa #sb #sf #s #sfpos #CFa #CFb #CFf #HO +@(O_to_CF … HO (CF_mu2 … CFa CFb CFf ?)) @O_plus [@O_plus_l @O_refl] +@O_plus_r @O_ext2 [|| #x @(bigop_op … plusAC)] +@O_plus [@le_to_O #x @le_sigma //] +@le_to_O #x @le_sigma // #x #lti #_ >MSC_pair_eq >MSC_pair_eq 0) → + CF sa a → CF sb b → CF sf f → + O s (λx.sa x + sb x + (S(b x) - a x)*Max_{i ∈[a x ,S(b x)[ }(sf 〈i,x〉)) → + CF s (λx.μ_{i ∈[a x,b x] }(f 〈i,x〉)). +#a #b #f #sa #sb #sf #s #sfpos #CFa #CFb #CFf #HO +@(O_to_CF … HO (CF_mu3 … sfpos CFa CFb CFf ?)) @O_plus [@O_plus_l @O_refl] +@O_ext2 [|| #x @(bigop_op … plusAC)] @O_plus_r @O_plus + [@le_to_O #x @sigma_to_Max + |lapply (MSC_in … CFf) #Hle + %{1} %{0} #n #_ @(transitive_le … (sigma_const …)) + >(commutative_times 1) (eq_minus_O … H) // + |lapply (le_S_S_to_le … (not_le_to_lt … H)) -H #H + @le_times // @(transitive_le … (Hle … )) + cut (b n = b n - a n + a n) [Hcut in ⊢ (?%?); @(le_Max (λi.sf 〈i+a n,n〉)) /2/ + ] + ] +qed. + +(* +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〉)). *) + + + \ No newline at end of file diff --git a/matita/matita/lib/reverse_complexity/complexity.ma b/matita/matita/lib/reverse_complexity/complexity.ma new file mode 100644 index 000000000..ae7baceca --- /dev/null +++ b/matita/matita/lib/reverse_complexity/complexity.ma @@ -0,0 +1,290 @@ +include "reverse_complexity/basics.ma". +include "reverse_complexity/big_O.ma". + +(********************************* 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_sublinear : ∀n. MSC (S n) ≤ S (MSC n). +(* axiom MSC_S: O MSC (λx.MSC (S x)) . *) +axiom MSC_le: ∀n. MSC n ≤ n. + +axiom monotonic_MSC: monotonic ? le MSC. +axiom MSC_pair_eq: ∀a,b. MSC 〈a,b〉 = MSC a + MSC b. + + +lemma MSC_pair: ∀a,b. MSC 〈a,b〉 ≤ MSC a + MSC b. // qed. + +(* 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.∃i.code_for (total f) i ∧ C s i. + +axiom MSC_in: ∀f,h. CF h f → ∀x. MSC x ≤ h x. +axiom MSC_out: ∀f,h. CF h f → ∀x. MSC (f x) ≤ h x. + + +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} 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 * #i * #Hcode #Hs1 +%{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 * #i * #Hcode #Hs1 +%{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. + +(************************************* 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. + + +(***************************** primitive recursion ****************************) + +(* no arguments *) + +let rec prim_rec0 (k:nat) (h:nat →nat) n on n ≝ + match n with + [ O ⇒ k + | S a ⇒ h 〈a, prim_rec0 k h a〉]. + +lemma prim_rec0_S: ∀k,h,n. + prim_rec0 k h (S n) = h 〈n, prim_rec0 k h n〉. +// qed. + +let rec prim_rec0_compl (k,sk:nat) (h,sh:nat →nat) n on n ≝ + match n with + [ O ⇒ sk + | S a ⇒ prim_rec0_compl k sk h sh a + sh (prim_rec0 k h a)]. + +axiom CF_prim_rec0_gen: ∀k,h,sk,sh,sh1,sf. CF sh h → + O sh1 (λx.snd x + sh 〈fst x,prim_rec0 k h (fst x)〉) → + O sf (prim_rec0 sk sh1) → + CF sf (prim_rec0 k h). + +lemma CF_prim_rec0: ∀k,h,sk,sh,sf. CF sh h → + O sf (prim_rec0 sk (λx. snd x + sh 〈fst x,prim_rec0 k h (fst x)〉)) + → CF sf (prim_rec0 k h). +#k #h #sk #sh #sf #Hh #HO @(CF_prim_rec0_gen … Hh … HO) @O_refl +qed. + +(* with arguments. m is a vector of arguments *) +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. + +lemma prim_rec_le: ∀k1,k2,h1,h2. (∀x.k1 x ≤ k2 x) → +(∀x,y.x ≤y → h1 x ≤ h2 y) → + ∀x,m. prim_rec k1 h1 x m ≤ prim_rec k2 h2 x m. +#k1 #k2 #h1 #h2 #lek #leh #x #m elim x // +#n #Hind normalize @leh @le_pair // @le_pair // +qed. + +definition unary_pr ≝ λk,h,x. prim_rec k h (fst x) (snd x). + +lemma prim_rec_unary: ∀k,h,a,b. + prim_rec k h a b = unary_pr k h 〈a,b〉. +#k #h #a #b normalize >fst_pair >snd_pair // +qed. + +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 〈a,〈prim_rec k h a m,m〉〉]. + +axiom CF_prim_rec_gen: ∀k,h,sk,sh,sh1. CF sk k → CF sh h → + O sh1 (λx. fst (snd x) + + sh 〈fst x,〈unary_pr k h 〈fst x,snd (snd x)〉,snd (snd x)〉〉) → + CF (unary_pr sk sh1) (unary_pr k h). + +lemma 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). +#k #h #sk #sh #sf #Hk #Hh #Osf @(O_to_CF … Osf) @(CF_prim_rec_gen … Hk Hh) +@O_refl +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. + +(**************************** primitive operations*****************************) + +definition id ≝ λx:nat.x. + +axiom CF_id: CF MSC id. +axiom CF_const: ∀k.CF MSC (λx.k). +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. + +(**************************** arithmetic operations ***************************) + +axiom CF_compS: ∀h,f. CF h f → CF h (S ∘ f). +axiom CF_le: ∀h,f,g. CF h f → CF h g → CF h (λx. leb (f x) (g x)). +axiom CF_eqb: ∀h,f,g. CF h f → CF h g → CF h (λx.eqb (f x) (g x)). +axiom CF_max1: ∀h,f,g. CF h f → CF h g → CF h (λx. max (f x) (g x)). +axiom CF_plus: ∀h,f,g. CF h f → CF h g → CF h (λx. f x + g x). +axiom CF_minus: ∀h,f,g. CF h f → CF h g → CF h (λx. f x - g x). + +(******************************** if then else ********************************) + +lemma if_prim_rec: ∀b:nat → bool. ∀f,g:nat → nat.∀x:nat. + if b x then f x else g x = prim_rec g (f ∘ snd ∘ snd) (b x) x. +#b #f #g #x cases (b x) normalize // +qed. + +lemma CF_if: ∀b:nat → bool. ∀f,g,s. CF s b → CF s f → CF s g → + CF s (λx. if b x then f x else g x). +#b #f #g #s #CFb #CFf #CFg @(ext_CF (λx.unary_pr g (f ∘ snd ∘ snd) 〈b x,x〉)) + [#n @sym_eq normalize >fst_pair >snd_pair @if_prim_rec + |@(CF_comp ??? s) + [|@CF_comp_pair // @(O_to_CF … CF_id) @le_to_O @MSC_in // + |@(CF_prim_rec_gen ??? (λx.MSC x + s(snd (snd x))) … CFg) [3:@O_refl|] + @(CF_comp … (λx.MSC x + s(snd x)) … CF_snd) + [@(CF_comp … s … CF_snd CFf) @O_refl + |@O_plus + [@O_plus_l @O_refl + |@O_plus + [@O_plus_l @le_to_O #x @monotonic_MSC // + |@O_plus_r @O_refl + ] + ] + ] + |%{6} %{0} #n #_ normalize in ⊢ (??%); snd_pair >fst_pair normalize + [@le_plus [//] >fst_pair >fst_pair >snd_pair >fst_pair + @le_plus [//] >snd_pair >snd_pair >snd_pair >snd_pair + associative_plus @le_plus + [@(transitive_le ???? (MSC_in … CFf n)) @monotonic_MSC // + |@(transitive_le … (MSC_pair …)) @le_plus [|@(MSC_in … CFf)] + normalize @MSC_out @CFg + ] + |@le_plus // + ] + ] + ] +qed. + +(********************************* simulation *********************************) + +definition pU_unary ≝ λp. pU (fst p) (fst (snd p)) (snd (snd p)). + +axiom sU : nat → nat. +axiom CF_U : CF sU pU_unary. + +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_pos: ∀x. 0 < sU x. + +axiom sU_le: ∀i,x,s. s ≤ sU 〈i,〈x,s〉〉. + +lemma sU_le_i: ∀i,x,s. MSC i ≤ sU 〈i,〈x,s〉〉. +#i #x #s @(transitive_le ???? (MSC_in … CF_U 〈i,〈x,s〉〉)) @monotonic_MSC // +qed. + +lemma sU_le_x: ∀i,x,s. MSC x ≤ sU 〈i,〈x,s〉〉. +#i #x #s @(transitive_le ???? (MSC_in … CF_U 〈i,〈x,s〉〉)) @monotonic_MSC +@(transitive_le … 〈x,s〉) // +qed. + + + + +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. + diff --git a/matita/matita/lib/reverse_complexity/hierarchy.ma b/matita/matita/lib/reverse_complexity/hierarchy.ma index a621b55a5..d833a5164 100644 --- a/matita/matita/lib/reverse_complexity/hierarchy.ma +++ b/matita/matita/lib/reverse_complexity/hierarchy.ma @@ -1,10 +1,9 @@ include "arithmetics/nat.ma". -include "arithmetics/log.ma". -(* include "arithmetics/ord.ma". *) +include "arithmetics/log.ma". include "arithmetics/bigops.ma". include "arithmetics/bounded_quantifiers.ma". -include "arithmetics/pidgeon_hole.ma". +include "arithmetics/pidgeon_hole.ma". include "basics/sets.ma". include "basics/types.ma". @@ -46,6 +45,8 @@ lemma Max0r : ∀n. max n 0 = n. #n >commutative_max // qed. +alias id "max" = "cic:/matita/arithmetics/nat/max#def:2". +alias id "mk_Aop" = "cic:/matita/arithmetics/bigops/Aop#con:0:1:2". definition MaxA ≝ mk_Aop nat 0 max Max0 Max0r (λa,b,c.sym_eq … (Max_assoc a b c)). @@ -116,21 +117,12 @@ 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 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 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. @@ -226,7 +172,7 @@ 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}. +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. @@ -260,11 +206,6 @@ 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) // @@ -287,12 +228,9 @@ 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 C ≝ λs,i.∃c.∃a.∀x.a ≤ |x| → {i ⊙ x} ↓ (c*(s(|x|))). definition CF ≝ λs,f.∃i.code_for f i ∧ C s i. @@ -308,6 +246,18 @@ cases HCs1 #c2 * #b #H2 %{(c2*c1)} %{(max a b)} %{y} @(monotonic_U …Hy) >associative_times @le_times // @H @(le_maxl … Hmax) qed. +(*********************** The hierachy theorem (left) **************************) + +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. + (************************** The diagonal language *****************************) (* the diagonal language used for the hierarchy theorem *) @@ -316,7 +266,7 @@ 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. + 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/ @@ -358,7 +308,39 @@ lemma absurd1: ∀P. iff P (¬ P) →False. #H3 @(absurd ?? H3) @H2 @H3 qed. -(* axiom weak_pad : ∀a,∃a0.∀n. a0 < n → ∃b. |〈a,b〉| = n. *) +let rec f_img (f:nat →nat) n on n ≝ + match n with + [O ⇒ [ ] + |S m ⇒ f m::f_img f m + ]. + +(* a few lemma to prove injective_to_exists. This is a general result; a nice +example of the pidgeon hole pricniple *) + +lemma f_img_to_exists: + ∀f.∀n,a. a ∈ f_img f n → ∃b. b < n ∧ f b = a. +#f #n #a elim n normalize [@False_ind] +#m #Hind * + [#Ha %{m} /2/ |#H cases(Hind H) #b * #Hb #Ha %{b} % // @le_S //] +qed. + +lemma length_f_img: ∀f,n. |f_img f n| = n. +#f #n elim n // normalize // +qed. + +lemma unique_f_img: ∀f,n. injective … f → unique ? (f_img f n). +#f #n #Hinj elim n normalize // +#m #Hind % // % #H lapply(f_img_to_exists …H) * #b * #ltbm +#eqbm @(absurd … ltbm) @le_to_not_lt >(Hinj… eqbm) // +qed. + +lemma injective_to_exists: ∀f. injective nat nat f → + ∀n.(∀i.i < n → f i < n) → ∀a. a < n → ∃b. bcommutative_times 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 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 associative_times -@le_times // @Hs1s2 @(le_maxr … lemax) -qed. - +qed. \ No newline at end of file diff --git a/matita/matita/lib/reverse_complexity/sigma_diseq.ma b/matita/matita/lib/reverse_complexity/sigma_diseq.ma new file mode 100644 index 000000000..4356cd24e --- /dev/null +++ b/matita/matita/lib/reverse_complexity/sigma_diseq.ma @@ -0,0 +1,153 @@ +include "arithmetics/sigma_pi.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)) + [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. + + +(************************* 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_const: ∀c,a,b. + ∑_{i ∈ [a,b[ }c ≤ (b-a)*c. +#c #a #b elim (b-a) // #n #Hind normalize @le_plus // +qed. + +lemma sigma_to_Max: ∀h,a,b. + ∑_{i ∈ [a,b[ }(h i) ≤ (b-a)*Max_{i ∈ [a,b[ }(h i). +#h #a #b elim (b-a) + [// + |#n #Hind >bigop_Strue [2://] whd in ⊢ (??%); + @le_plus + [>bigop_Strue // @(le_maxl … (le_n …)) + |@(transitive_le … Hind) @le_times // >bigop_Strue // + @(le_maxr … (le_n …)) + ] + ] +qed. + +lemma sigma_bound1: ∀h,a,b. monotonic nat le h → + ∑_{i ∈ [a,b[ }(h i) ≤ (b-a)*h b. +#h #a #b #H +@(transitive_le … (sigma_to_Max …)) @le_times // +@Max_le #i #lti #_ @H @lt_to_le @lt_minus_to_plus_r // +qed. + +lemma sigma_bound_decr1: ∀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 +@(transitive_le … (sigma_to_Max …)) @le_times // +@Max_le #i #lti #_ @H // @lt_minus_to_plus_r // +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)) + [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. + \ No newline at end of file diff --git a/matita/matita/lib/reverse_complexity/speedup.ma b/matita/matita/lib/reverse_complexity/speedup.ma new file mode 100644 index 000000000..f1e56d560 --- /dev/null +++ b/matita/matita/lib/reverse_complexity/speedup.ma @@ -0,0 +1,572 @@ +include "reverse_complexity/bigops_compl.ma". + +(********************************* 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 // + |min_input_def in Hminx; #Hminx >Hminx in ⊢ (%→?); + 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 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} % // bigop_Sfalse + [#H %{x1} % [@transitive_lt //| (le_to_min_input … (eqb_true_to_eq … Hcase)) + [@lt_to_not_eq @ltx1 | @lt_to_le @ltx1] + ] + |>bigop_Sfalse [2:@Hcase] #H %{x} % // (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 *********************************) + +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. itermy >Hr +#H @(absurd ? H) @le_to_not_lt @le_n +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 + (snd x - fst x)*Max_{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_max2 … 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 … (le_to_O … (MSC_in … H))) +@O_plus // %{1} %{0} #n #_ >commutative_times 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. (∀x. 0 < s1 x) → + (CF s1 + (λp.termb (fst (snd p)) (fst p) (h (S (fst (snd p))) (fst p)))) → + (O s (λx.MSC x + ((snd(snd x) - (fst x)))*Max_{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 #pos_s1 #Hs1 #HO @(ext_CF (min_input_aux h)) + [#n whd in ⊢ (??%%); @min_input_eq] +@(CF_mu4 … MSC MSC … pos_s1 … Hs1) + [@CF_compS @CF_fst + |@CF_comp_snd @CF_snd + |@(O_trans … HO) @O_plus [@O_plus @O_plus_l // | @O_plus_r //] +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 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 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 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 [#n @sU_pos | 3:@(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 (MSC x)) >commutative_times @le_times + [// | @monotonic_MSC // ]] +@(O_trans … (coroll3 ??)) + [#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 c ≝ λx.(S (snd x-fst x))*MSC 〈x,x〉. + +definition sg ≝ λh,x. + let a ≝ fst x in + let b ≝ snd x in + c x + (b-a)*(S(b-a))*sU 〈x,〈snd x,h (S a) b〉〉. + +lemma sg_def1 : ∀h,a,b. + sg h 〈a,b〉 = c 〈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 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 normalize >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 ⊢ (?%?); + h_of_def + cut (max a b = a) + [normalize cases (le_to_or_lt_eq … leba) + [#ltba >(lt_to_leb_false … ltba) % + |#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 * #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 * #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 〈S 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. + \ No newline at end of file diff --git a/matita/matita/lib/reverse_complexity/toolkit.ma b/matita/matita/lib/reverse_complexity/toolkit.ma index 69fa3525a..16f079f48 100644 --- a/matita/matita/lib/reverse_complexity/toolkit.ma +++ b/matita/matita/lib/reverse_complexity/toolkit.ma @@ -4,9 +4,8 @@ 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 for minimization **************************) notation "μ_{ ident i < n } p" with precedence 80 for @{min $n 0 (λ${ident i}.$p)}. @@ -102,6 +101,10 @@ 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〉. +lemma expand_pair: ∀x. x = 〈fst x, snd x〉. +#x lapply (surj_pair x) * #a * #b #Hx >Hx >fst_pair >snd_pair // +qed. + (************************************* U **************************************) axiom U: nat → nat →nat → option nat. @@ -150,7 +153,7 @@ definition out ≝ λi,x,r. 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〉. @@ -182,124 +185,8 @@ 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 // - |min_input_def in Hminx; #Hminx >Hminx in ⊢ (%→?); - 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 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} % // bigop_Sfalse - [#H %{x1} % [@transitive_lt //| (le_to_min_input … (eqb_true_to_eq … Hcase)) - [@lt_to_not_eq @ltx1 | @lt_to_le @ltx1] - ] - |>bigop_Sfalse [2:@Hcase] #H %{x} % // (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. itermy >Hr -#H @(absurd ? H) @le_to_not_lt @le_n -qed. (********************************* complexity *********************************) @@ -327,6 +214,11 @@ lemma ext_CF : ∀f,g,s. (∀n. f n = g n) → CF s f → CF s g. [#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)) @@ -362,6 +254,34 @@ qed. (* primitve recursion *) +(* no arguments *) + +let rec prim_rec0 (k:nat) (h:nat →nat) n on n ≝ + match n with + [ O ⇒ k + | S a ⇒ h 〈a, prim_rec0 k h a〉]. + +lemma prim_rec0_S: ∀k,h,n. + prim_rec0 k h (S n) = h 〈n, prim_rec0 k h n〉. +// qed. + +let rec prim_rec0_compl (k,sk:nat) (h,sh:nat →nat) n on n ≝ + match n with + [ O ⇒ sk + | S a ⇒ prim_rec0_compl k sk h sh a + sh (prim_rec0 k h a)]. + +axiom CF_prim_rec0_gen: ∀k,h,sk,sh,sh1,sf. CF sh h → + O sh1 (λx.snd x + sh 〈fst x,prim_rec0 k h (fst x)〉) → + O sf (prim_rec0 sk sh1) → + CF sf (prim_rec0 k h). + +lemma CF_prim_rec0: ∀k,h,sk,sh,sf. CF sh h → + O sf (prim_rec0 sk (λx. snd x + sh 〈fst x,prim_rec0 k h (fst x)〉)) + → CF sf (prim_rec0 k h). +#k #h #sk #sh #sf #Hh #HO @(CF_prim_rec0_gen … Hh … HO) @O_refl +qed. + +(* with argument(s) m *) let rec prim_rec (k,h:nat →nat) n m on n ≝ match n with [ O ⇒ k m @@ -371,28 +291,42 @@ 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. +lemma prim_rec_le: ∀k1,k2,h1,h2. (∀x.k1 x ≤ k2 x) → +(∀x,y.x ≤y → h1 x ≤ h2 y) → + ∀x,m. prim_rec k1 h1 x m ≤ prim_rec k2 h2 x m. +#k1 #k2 #h1 #h2 #lek #leh #x #m elim x // +#n #Hind normalize @leh @le_pair // @le_pair // +qed. + definition unary_pr ≝ λk,h,x. prim_rec k h (fst x) (snd x). +lemma prim_rec_unary: ∀k,h,a,b. + prim_rec k h a b = unary_pr k h 〈a,b〉. +#k #h #a #b normalize >fst_pair >snd_pair // +qed. + + 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 *) +axiom CF_prim_rec_gen: ∀k,h,sk,sh,sh1. CF sk k → CF sh h → + O sh1 (λx. fst (snd x) + sh 〈fst x,〈unary_pr k h 〈fst x,snd (snd x)〉,snd (snd x)〉〉) → + CF (unary_pr sk sh1) (unary_pr k h). +lemma 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). +#k #h #sk #sh #sf #Hk #Hh #Osf @(O_to_CF … Osf) @(CF_prim_rec_gen … Hk Hh) @O_refl +qed. (**************************** primitive operations*****************************) definition id ≝ λx:nat.x. axiom CF_id: CF MSC id. +axiom CF_const: ∀k.CF MSC (λx.k). 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). @@ -404,7 +338,7 @@ qed. lemma CF_snd: CF MSC snd. @(ext_CF (snd ∘ id)) [#n //] @(CF_comp_snd … CF_id) -qed. +qed. (************************************** eqb ***********************************) @@ -413,17 +347,771 @@ axiom CF_eqb: ∀h,f,g. (*********************************** maximum **********************************) +alias symbol "pair" (instance 13) = "abstract pair". +alias symbol "pair" (instance 12) = "abstract pair". +alias symbol "and" (instance 11) = "boolean and". +alias symbol "plus" (instance 8) = "natural plus". +alias symbol "pair" (instance 7) = "abstract pair". +alias symbol "plus" (instance 6) = "natural plus". +alias symbol "pair" (instance 5) = "abstract pair". +alias id "max" = "cic:/matita/arithmetics/nat/max#def:2". +alias symbol "minus" (instance 3) = "natural minus". +lemma max_gen: ∀a,b,p,f,x. a ≤b → + max_{i ∈[a,b[ | p 〈i,x〉 }(f 〈i,x〉) = max_{i < b | leb a i ∧ p 〈i,x〉 }(f 〈i,x〉). +#a #b #p #f #x @(bigop_I_gen ????? MaxA) +qed. + +lemma max_prim_rec_base: ∀a,b,p,f,x. a ≤b → + max_{i < b| p 〈i,x〉 }(f 〈i,x〉) = + prim_rec (λi.0) + (λi.if p 〈fst i,x〉 then max (f 〈fst i,snd (snd i)〉) (fst (snd i)) else fst (snd i)) b x. +#a #b #p #f #x #leab >max_gen // elim b + [normalize // + |#i #Hind >prim_rec_S >fst_pair >snd_pair >snd_pair >fst_pair + cases (true_or_false (p 〈i,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +lemma max_prim_rec: ∀a,b,p,f,x. a ≤b → + max_{i ∈[a,b[ | p 〈i,x〉 }(f 〈i,x〉) = + prim_rec (λi.0) + (λi.if leb a (fst i) ∧ p 〈fst i,x〉 then max (f 〈fst i,snd (snd i)〉) (fst (snd i)) else fst (snd i)) b x. +#a #b #p #f #x #leab >max_gen // elim b + [normalize // + |#i #Hind >prim_rec_S >fst_pair >snd_pair >snd_pair >fst_pair + cases (true_or_false (leb a i ∧ p 〈i,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +(* FG: aliases added by matita compiled with OCaml 4.0.5, bah ??? *) +alias symbol "pair" (instance 15) = "abstract pair". +alias symbol "minus" (instance 14) = "natural minus". +alias symbol "plus" (instance 11) = "natural plus". +alias symbol "pair" (instance 10) = "abstract pair". +alias symbol "plus" (instance 13) = "natural plus". +alias symbol "pair" (instance 12) = "abstract pair". +alias symbol "plus" (instance 8) = "natural plus". +alias symbol "pair" (instance 7) = "abstract pair". +alias symbol "plus" (instance 6) = "natural plus". +alias symbol "pair" (instance 5) = "abstract pair". +alias id "max" = "cic:/matita/arithmetics/nat/max#def:2". +alias symbol "minus" (instance 3) = "natural minus". +lemma max_prim_rec1: ∀a,b,p,f,x. + max_{i ∈[a x,b x[ | p 〈i,x〉 }(f 〈i,x〉) = + prim_rec (λi.0) + (λi.if p 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉 + then max (f 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉) (fst (snd i)) + else fst (snd i)) (b x-a x) 〈a x ,x〉. +#a #b #p #f #x elim (b x-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + cases (true_or_false (p 〈i+a x,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +lemma sum_prim_rec1: ∀a,b,p,f,x. + ∑_{i ∈[a x,b x[ | p 〈i,x〉 }(f 〈i,x〉) = + prim_rec (λi.0) + (λi.if p 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉 + then plus (f 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉) (fst (snd i)) + else fst (snd i)) (b x-a x) 〈a x ,x〉. +#a #b #p #f #x elim (b x-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + cases (true_or_false (p 〈i+a x,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +(* FG: aliases added by matita compiled with OCaml 4.0.5, bah ??? *) +alias symbol "pair" (instance 15) = "abstract pair". +alias symbol "minus" (instance 14) = "natural minus". +alias symbol "plus" (instance 11) = "natural plus". +alias symbol "pair" (instance 10) = "abstract pair". +alias symbol "plus" (instance 13) = "natural plus". +alias symbol "pair" (instance 12) = "abstract pair". +alias symbol "plus" (instance 8) = "natural plus". +alias symbol "pair" (instance 7) = "abstract pair". +alias symbol "pair" (instance 6) = "abstract pair". +alias symbol "plus" (instance 4) = "natural plus". +alias symbol "pair" (instance 3) = "abstract pair". +alias symbol "minus" (instance 2) = "natural minus". +lemma bigop_prim_rec: ∀a,b,c,p,f,x. + bigop (b x-a x) (λi:ℕ.p 〈i+a x,x〉) ? (c 〈a x,x〉) plus (λi:ℕ.f 〈i+a x,x〉) = + prim_rec c + (λi.if p 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉 + then plus (f 〈fst i +fst (snd (snd i)),snd (snd (snd i))〉) (fst (snd i)) + else fst (snd i)) (b x-a x) 〈a x ,x〉. +#a #b #c #p #f #x normalize elim (b x-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + cases (true_or_false (p 〈i+a x,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +(* FG: aliases added by matita compiled with OCaml 4.0.5, bah ??? *) +alias symbol "pair" (instance 15) = "abstract pair". +alias symbol "minus" (instance 14) = "natural minus". +alias symbol "minus" (instance 11) = "natural minus". +alias symbol "pair" (instance 10) = "abstract pair". +alias symbol "minus" (instance 13) = "natural minus". +alias symbol "pair" (instance 12) = "abstract pair". +alias symbol "minus" (instance 8) = "natural minus". +alias symbol "pair" (instance 7) = "abstract pair". +alias symbol "pair" (instance 6) = "abstract pair". +alias symbol "minus" (instance 4) = "natural minus". +alias symbol "pair" (instance 3) = "abstract pair". +alias symbol "minus" (instance 2) = "natural minus". +lemma bigop_prim_rec_dec: ∀a,b,c,p,f,x. + bigop (b x-a x) (λi:ℕ.p 〈b x -i,x〉) ? (c 〈b x,x〉) plus (λi:ℕ.f 〈b x-i,x〉) = + prim_rec c + (λi.if p 〈fst (snd (snd i)) - fst i,snd (snd (snd i))〉 + then plus (f 〈fst (snd (snd i)) - fst i,snd (snd (snd i))〉) (fst (snd i)) + else fst (snd i)) (b x-a x) 〈b x ,x〉. +#a #b #c #p #f #x normalize elim (b x-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + cases (true_or_false (p 〈b x - i,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +lemma bigop_prim_rec_dec1: ∀a,b,c,p,f,x. + bigop (S(b x)-a x) (λi:ℕ.p 〈b x - i,x〉) ? (c 〈b x,x〉) plus (λi:ℕ.f 〈b x- i,x〉) = + prim_rec c + (λi.if p 〈fst (snd (snd i)) - (fst i),snd (snd (snd i))〉 + then plus (f 〈fst (snd (snd i)) - (fst i),snd (snd (snd i))〉) (fst (snd i)) + else fst (snd i)) (S(b x)-a x) 〈b x,x〉. +#a #b #c #p #f #x elim (S(b x)-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + cases (true_or_false (p 〈b x - i,x〉)) #Hcase >Hcase + [bigop_Strue // |bigop_Sfalse // ] + ] +qed. + +(* +lemma bigop_aux_1: ∀k,c,f. + bigop (S k) (λi:ℕ.true) ? c plus (λi:ℕ.f i) = + f 0 + bigop k (λi:ℕ.true) ? c plus (λi:ℕ.f (S i)). +#k #c #f elim k [normalize //] #i #Hind >bigop_Strue // + +lemma bigop_prim_rec_dec: ∀a,b,c,f,x. + bigop (b x-a x) (λi:ℕ.true) ? (c 〈b x,x〉) plus (λi:ℕ.f 〈i+a x,x〉) = + prim_rec c + (λi. plus (f 〈fst (snd (snd i)) - fst i,snd (snd (snd i))〉) (fst (snd i))) + (b x-a x) 〈b x ,x〉. +#a #b #c #f #x normalize elim (b x-a x) + [normalize // + |#i #Hind >prim_rec_S + >fst_pair >snd_pair >snd_pair >fst_pair >snd_pair >fst_pair + bigop_Strue // |bigop_Sfalse // ] + ] +qed. *) + +lemma bigop_plus_c: ∀k,p,f,c. + c k + bigop k (λi.p i) ? 0 plus (λi.f i) = + bigop k (λi.p i) ? (c k) plus (λi.f i). +#k #p #f elim k [normalize //] +#i #Hind #c cases (true_or_false (p i)) #Hcase +[>bigop_Strue // >bigop_Strue // (commutative_plus ? (f i)) + >associative_plus @eq_f @Hind +|>bigop_Sfalse // >bigop_Sfalse // +] +qed. + +(* the argument is 〈b-a,〈a,x〉〉 *) + +(* FG: aliases added by matita compiled with OCaml 4.0.5, bah ??? *) +alias symbol "plus" (instance 3) = "natural plus". +alias symbol "pair" (instance 2) = "abstract pair". +alias id "max" = "cic:/matita/arithmetics/nat/max#def:2". +alias symbol "plus" (instance 5) = "natural plus". +alias symbol "pair" (instance 4) = "abstract pair". +definition max_unary_pr ≝ λp,f.unary_pr (λx.0) + (λi. + let k ≝ fst i in + let r ≝ fst (snd i) in + let a ≝ fst (snd (snd i)) in + let x ≝ snd (snd (snd i)) in + if p 〈k + a,x〉 then max (f 〈k+a,x〉) r else r). + +lemma max_unary_pr1: ∀a,b,p,f,x. + max_{i ∈[a x,b x[ | p 〈i,x〉 }(f 〈i,x〉) = + ((max_unary_pr p f) ∘ (λx.〈b x - a x,〈a x,x〉〉)) x. +#a #b #p #f #x normalize >fst_pair >snd_pair @max_prim_rec1 +qed. + +(* +lemma max_unary_pr: ∀a,b,p,f,x. + max_{i ∈[a,b[ | p 〈i,x〉 }(f 〈i,x〉) = + prim_rec (λi.0) + (λi.if p 〈fst i +a,x〉 then max (f 〈fst i +a ,snd (snd i)〉) (fst (snd i)) else fst (snd i)) (b-a) x. +*) + +(* +definition unary_compl ≝ λp,f,hf. + unary_pr MSC + (λx:ℕ + .fst (snd x) + +hf + 〈fst x, + 〈unary_pr (λx0:ℕ.O) + (λi:ℕ + .(let (k:ℕ) ≝fst i in  + let (r:ℕ) ≝fst (snd i) in  + let (a:ℕ) ≝fst (snd (snd i)) in  + let (x:ℕ) ≝snd (snd (snd i)) in  + if p 〈k+a,x〉 then max (f 〈k+a,x〉) r else r )) 〈fst x,snd (snd x)〉, + snd (snd x)〉〉). *) + +(* FG: aliases added by matita compiled with OCaml 4.0.5, bah ??? *) +alias symbol "plus" (instance 6) = "natural plus". +alias symbol "pair" (instance 5) = "abstract pair". +alias symbol "plus" (instance 4) = "natural plus". +alias symbol "pair" (instance 3) = "abstract pair". +alias symbol "plus" (instance 2) = "natural plus". +alias symbol "plus" (instance 1) = "natural plus". +definition aux_compl ≝ λhp,hf.λi. + let k ≝ fst i in  + let r ≝ fst (snd i) in  + let a ≝ fst (snd (snd i)) in  + let x ≝ snd (snd (snd i)) in  + hp 〈k+a,x〉 + hf 〈k+a,x〉 + (* was MSC r*) MSC i . + +definition aux_compl1 ≝ λhp,hf.λi. + let k ≝ fst i in  + let r ≝ fst (snd i) in  + let a ≝ fst (snd (snd i)) in  + let x ≝ snd (snd (snd i)) in  + hp 〈k+a,x〉 + hf 〈k+a,x〉 + MSC r. + +lemma aux_compl1_def: ∀k,r,m,hp,hf. + aux_compl1 hp hf 〈k,〈r,m〉〉 = + let a ≝ fst m in  + let x ≝ snd m in  + hp 〈k+a,x〉 + hf 〈k+a,x〉 + MSC r. +#k #r #m #hp #hf normalize >fst_pair >snd_pair >snd_pair >fst_pair // +qed. + +lemma aux_compl1_def1: ∀k,r,a,x,hp,hf. + aux_compl1 hp hf 〈k,〈r,〈a,x〉〉〉 = hp 〈k+a,x〉 + hf 〈k+a,x〉 + MSC r. +#k #r #a #x #hp #hf normalize >fst_pair >snd_pair >snd_pair >fst_pair +>fst_pair >snd_pair // +qed. + + +axiom Oaux_compl: ∀hp,hf. O (aux_compl1 hp hf) (aux_compl hp hf). + +(* +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 CF_if: ∀b:nat → bool. ∀f,g,s. CF s b → CF s f → CF s g → + CF s (λx. if b x then f x else g x). + +(* +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. +*) + +axiom CF_le: ∀h,f,g. CF h f → CF h g → CF h (λx. leb (f x) (g x)). +axiom CF_max1: ∀h,f,g. CF h f → CF h g → CF h (λx. max (f x) (g x)). +axiom CF_plus: ∀h,f,g. CF h f → CF h g → CF h (λx. f x + g x). +axiom CF_minus: ∀h,f,g. CF h f → CF h g → CF h (λx. f x - g x). + +axiom MSC_prop: ∀f,h. CF h f → ∀x. MSC (f x) ≤ h x. + +lemma MSC_max: ∀f,h,x. CF h f → MSC (max_{i < x}(f i)) ≤ max_{i < x}(h i). +#f #h #x #hf elim x // #i #Hind >bigop_Strue [|//] >bigop_Strue [|//] +whd in match (max ??); +cases (true_or_false (leb (f i) (bigop i (λi0:ℕ.true) ? 0 max(λi0:ℕ.f i0)))) +#Hcase >Hcase + [@(transitive_le … Hind) @le_maxr // + |@(transitive_le … (MSC_prop … hf i)) @le_maxl // + ] +qed. + +lemma 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〉 + max_{i ∈ [a x, b x [ }(hf 〈i,x〉)))) → + CF s (λx.max_{i ∈[a x,b x[ | p 〈i,x〉 }(f 〈i,x〉)). +#a #b #p #f #ha #hb #hp #hf #s #CFa #CFb #CFp #CFf #HO +@ext_CF1 [|#x @max_unary_pr1] +@(CF_comp ??? (λx.ha x + hb x)) + [|@CF_comp_pair + [@CF_minus [@(O_to_CF … CFb) @O_plus_r // |@(O_to_CF … CFa) @O_plus_l //] + |@CF_comp_pair + [@(O_to_CF … CFa) @O_plus_l // + | @(O_to_CF … CF_id) @O_plus_r @(proj1 … CFb) + ] + ] + |@(CF_prim_rec … MSC … (aux_compl1 hp hf)) + [@CF_const + |@(O_to_CF … (Oaux_compl … )) + @CF_if + [@(CF_comp p … MSC … CFp) + [@CF_comp_pair + [@CF_plus [@CF_fst| @CF_comp_fst @CF_comp_snd @CF_snd] + |@CF_comp_snd @CF_comp_snd @CF_snd] + |@le_to_O #x normalize >commutative_plus >associative_plus @le_plus // + ] + |@CF_max1 + [@(CF_comp f … MSC … CFf) + [@CF_comp_pair + [@CF_plus [@CF_fst| @CF_comp_fst @CF_comp_snd @CF_snd] + |@CF_comp_snd @CF_comp_snd @CF_snd] + |@le_to_O #x normalize >commutative_plus // + ] + |@CF_comp_fst @(monotonic_CF … CF_snd) normalize // + ] + |@CF_comp_fst @(monotonic_CF … CF_snd) normalize // + ] + |@O_refl + ] + |@(O_trans … HO) -HO + @(O_trans ? (λx:ℕ + .ha x+hb x + +bigop (b x-a x) (λi:ℕ.true) ? (MSC 〈a x,x〉) plus + (λi:ℕ + .(λi0:ℕ + .hp 〈i0,x〉+hf 〈i0,x〉 + +bigop (b x-a x) (λi1:ℕ.true) ? 0 max + (λi1:ℕ.(λi2:ℕ.hf 〈i2,x〉) (i1+a x))) (i+a x)))) + [ + @le_to_O #n @le_plus // whd in match (unary_pr ???); + >fst_pair >snd_pair >bigop_prim_rec elim (b n - a n) + [normalize // + |#x #Hind >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair >aux_compl1_def1 + >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair >fst_pair + >snd_pair normalize in ⊢ (??%); >commutative_plus @le_plus + [-Hind @le_plus // normalize >fst_pair >snd_pair + @(transitive_le ? (bigop x (λi1:ℕ.true) ? 0 (λn0:ℕ.λm:ℕ.if leb n0 m then m else n0 ) + (λi1:ℕ.hf 〈i1+a n,n〉))) + [elim x [normalize @MSC_le] + #x0 #Hind >prim_rec_S >fst_pair >snd_pair >snd_pair >snd_pair + >fst_pair >fst_pair cases (p 〈x0+a n,n〉) normalize + [cases (true_or_false (leb (f 〈x0+a n,n〉) + (prim_rec (λx00:ℕ.O) + (λi:ℕ + .if p 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉  + then if leb (f 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉) + (fst (snd i))  + then fst (snd i)  + else f 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉   + else fst (snd i) ) x0 〈a n,n〉))) #Hcase >Hcase normalize + [@(transitive_le … Hind) -Hind @(le_maxr … (le_n …)) + |@(transitive_le … (MSC_prop … CFf …)) @(le_maxl … (le_n …)) + ] + |@(transitive_le … Hind) -Hind @(le_maxr … (le_n …)) + ] + |@(le_maxr … (le_n …)) + ] + |@(transitive_le … Hind) -Hind + generalize in match (bigop x (λi:ℕ.true) ? 0 max + (λi1:ℕ.(λi2:ℕ.hf 〈i2,n〉) (i1+a n))); #c + generalize in match (hf 〈x+a n,n〉); #c1 + elim x [//] #x0 #Hind + >prim_rec_S >prim_rec_S normalize >fst_pair >fst_pair >snd_pair + >snd_pair >snd_pair >snd_pair >snd_pair >snd_pair >fst_pair >fst_pair + >fst_pair @le_plus + [@le_plus // cases (true_or_false (leb c1 c)) #Hcase + >Hcase normalize // @lt_to_le @not_le_to_lt @(leb_false_to_not_le ?? Hcase) + |@Hind + ] + ] + ] + |@O_plus [@O_plus_l //] @le_to_O #x + Hind +cases (true_or_false (eqb a (a+i))) #Hcase >Hcase normalize // +<(eqb_true_to_eq … Hcase) >H // +qed. + +lemma my_minim_nfa : ∀a,f,x,k. f〈a,x〉 = false → +my_minim a f x (S k) = my_minim (S a) f x k. +#a #f #x #k #H elim k + [normalize H >eq_to_eqb_true // + |#i #Hind >my_minim_S >Hind >my_minim_S Hcase + [>(my_minim_fa … Hcase) // | >Hind @sym_eq @(my_minim_nfa … Hcase) ] +qed. + +(* cambiare qui: togliere S *) + +(* FG: aliases added by matita compiled with OCaml 4.0.5, bah ??? *) +alias symbol "minus" (instance 1) = "natural minus". +alias symbol "minus" (instance 3) = "natural minus". +alias symbol "pair" (instance 2) = "abstract pair". +definition minim_unary_pr ≝ λf.unary_pr (λx.S(fst x)) + (λi. + let k ≝ fst i in + let r ≝ fst (snd i) in + let b ≝ fst (snd (snd i)) in + let x ≝ snd (snd (snd i)) in + if f 〈b-k,x〉 then b-k else r). + +definition compl_minim_unary ≝ λhf:nat → nat.λi. + let k ≝ fst i in + let b ≝ fst (snd (snd i)) in + let x ≝ snd (snd (snd i)) in + hf 〈b-k,x〉 + MSC 〈k,〈S b,x〉〉. + +definition compl_minim_unary_aux ≝ λhf,i. + let k ≝ fst i in + let r ≝ fst (snd i) in + let b ≝ fst (snd (snd i)) in + let x ≝ snd (snd (snd i)) in + hf 〈b-k,x〉 + MSC i. + +lemma compl_minim_unary_aux_def : ∀hf,k,r,b,x. + compl_minim_unary_aux hf 〈k,〈r,〈b,x〉〉〉 = hf 〈b-k,x〉 + MSC 〈k,〈r,〈b,x〉〉〉. +#hf #k #r #b #x normalize >snd_pair >snd_pair >snd_pair >fst_pair >fst_pair // +qed. + +lemma compl_minim_unary_def : ∀hf,k,r,b,x. + compl_minim_unary hf 〈k,〈r,〈b,x〉〉〉 = hf 〈b-k,x〉 + MSC 〈k,〈S b,x〉〉. +#hf #k #r #b #x normalize >snd_pair >snd_pair >snd_pair >fst_pair >fst_pair // +qed. + +lemma compl_minim_unary_aux_def2 : ∀hf,k,r,x. + compl_minim_unary_aux hf 〈k,〈r,x〉〉 = hf 〈fst x-k,snd x〉 + MSC 〈k,〈r,x〉〉. +#hf #k #r #x normalize >snd_pair >snd_pair >fst_pair // +qed. + +lemma compl_minim_unary_def2 : ∀hf,k,r,x. + compl_minim_unary hf 〈k,〈r,x〉〉 = hf 〈fst x-k,snd x〉 + MSC 〈k,〈S(fst x),snd x〉〉. +#hf #k #r #x normalize >snd_pair >snd_pair >fst_pair // +qed. + +lemma min_aux: ∀a,f,x,k. min (S k) (a x) (λi:ℕ.f 〈i,x〉) = + ((minim_unary_pr f) ∘ (λx.〈S k,〈a x + k,x〉〉)) x. +#a #f #x #k whd in ⊢ (???%); >fst_pair >snd_pair +lapply a -a (* @max_prim_rec1 *) +elim k + [normalize #a >fst_pair >snd_pair >fst_pair >snd_pair >snd_pair >fst_pair + fst_pair // + |#i #Hind #a normalize in ⊢ (??%?); >prim_rec_S >fst_pair >snd_pair + >fst_pair >snd_pair >snd_pair >fst_pair minus_S_S <(minus_plus_m_m (a x) i) // +qed. + +lemma minim_unary_pr1: ∀a,b,f,x. + μ_{i ∈[a x,b x]}(f 〈i,x〉) = + if leb (a x) (b x) then ((minim_unary_pr f) ∘ (λx.〈S (b x) - a x,〈b x,x〉〉)) x + else (a x). +#a #b #f #x cases (true_or_false (leb (a x) (b x))) #Hcase >Hcase + [cut (b x = a x + (b x - a x)) + [>commutative_plus minus_Sn_m [|@leb_true_to_le //] + >min_aux whd in ⊢ (??%?); eq_minus_O // @not_le_to_lt @leb_false_to_not_le // + ] +qed. + +axiom sum_inv: ∀a,b,f.∑_{i ∈ [a,S b[ }(f i) = ∑_{i ∈ [a,S b[ }(f (a + b - i)). + +(* +#a #b #f @(bigop_iso … plusAC) whd %{(λi.b - a - i)} %{(λi.b - a -i)} % + [%[#i #lti #_ normalize @eq_f >commutative_plus commutative_plus // + ] + |@(O_to_CF … MSC) + [@le_to_O #x normalize // + |@CF_minus + [@CF_comp_fst @CF_comp_snd @CF_snd |@CF_fst] + ] + |@CF_comp_fst @(monotonic_CF … CF_snd) normalize // + ] + |@O_plus + [@O_plus_l @O_refl + |@O_plus_r @O_ext2 [||#x >compl_minim_unary_aux_def2 @refl] + @O_trans [||@le_to_O #x >compl_minim_unary_def2 @le_n] + @O_plus [@O_plus_l //] + @O_plus_r + @O_trans [|@le_to_O #x @MSC_pair] @O_plus + [@le_to_O #x @monotonic_MSC @(transitive_le ???? (le_fst …)) + >fst_pair @le_n] + @O_trans [|@le_to_O #x @MSC_pair] @O_plus + [@le_to_O #x @monotonic_MSC @(transitive_le ???? (le_snd …)) + >snd_pair @(transitive_le ???? (le_fst …)) >fst_pair + normalize >snd_pair >fst_pair lapply (surj_pair x) + * #x1 * #x2 #Hx >Hx >fst_pair >snd_pair elim x1 // + #i #Hind >prim_rec_S >fst_pair >snd_pair >snd_pair >fst_pair + cases (f ?) [@le_S // | //]] + @le_to_O #x @monotonic_MSC @(transitive_le ???? (le_snd …)) >snd_pair + >(expand_pair (snd (snd x))) in ⊢ (?%?); @le_pair // + ] + ] + |cut (O s (λx.ha x + hb x + + ∑_{i ∈[a x ,S(b x)[ }(hf 〈a x+b x-i,x〉 + MSC 〈b x -(a x+b x-i),〈S(b x),x〉〉))) + [@(O_ext2 … HO) #x @eq_f @sum_inv] -HO #HO + @(O_trans … HO) -HO + @(O_trans ? (λx:ℕ.ha x+hb x + +bigop (S(b x)-a x) (λi:ℕ.true) ? + (MSC 〈b x,x〉) plus (λi:ℕ.(λj.hf j + MSC 〈b x - fst j,〈S(b (snd j)),snd j〉〉) 〈b x- i,x〉))) + [@le_to_O #n @le_plus // whd in match (unary_pr ???); + >fst_pair >snd_pair >(bigop_prim_rec_dec1 a b ? (λi.true)) + (* it is crucial to recall that the index is bound by S(b x) *) + cut (S (b n) - a n ≤ S (b n)) [//] + elim (S(b n) - a n) + [normalize // + |#x #Hind #lex >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair + >compl_minim_unary_def >prim_rec_S >fst_pair >snd_pair >fst_pair + >snd_pair >fst_pair >snd_pair >fst_pair whd in ⊢ (??%); >commutative_plus + @le_plus [2:@Hind @le_S @le_S_S_to_le @lex] -Hind >snd_pair + >minus_minus_associative // @le_S_S_to_le // + ] + |@O_plus [@O_plus_l //] @O_ext2 [||#x @bigop_plus_c] + @O_plus + [@O_plus_l @O_trans [|@le_to_O #x @MSC_pair] + @O_plus [@O_plus_r @le_to_O @(MSC_prop … CFb)|@O_plus_r @(proj1 … CFb)] + |@O_plus_r @(O_ext2 … (O_refl …)) #x @same_bigop + [//|#i #H #_ @eq_f2 [@eq_f @eq_f2 //|>fst_pair @eq_f @eq_f2 //] + ] + ] + ] + ] + |@(O_to_CF … CFa) @(O_trans … HO) @O_plus_l @O_plus_l @O_refl + ] +qed. + +(* +lemma 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〉)). +#a #b #f #ha #hb #hf #s #CFa #CFb #CFf #HO +@ext_CF1 [|#x @minim_unary_pr1] +@(CF_comp ??? (λx.ha x + hb x)) + [|@CF_comp_pair + [@CF_minus [@CF_compS @(O_to_CF … CFb) @O_plus_r // |@(O_to_CF … CFa) @O_plus_l //] + |@CF_comp_pair + [@CF_max1 [@(O_to_CF … CFa) @O_plus_l // | @CF_compS @(O_to_CF … CFb) @O_plus_r //] + | @(O_to_CF … CF_id) @O_plus_r @(proj1 … CFb) + ] + ] + |@(CF_prim_rec … MSC … (compl_minim_unary_aux hf)) + [@CF_fst + |@CF_if + [@(CF_comp f … MSC … CFf) + [@CF_comp_pair + [@CF_minus [@CF_comp_fst @CF_comp_snd @CF_snd|@CF_compS @CF_fst] + |@CF_comp_snd @CF_comp_snd @CF_snd] + |@le_to_O #x normalize >commutative_plus // + ] + |@(O_to_CF … MSC) + [@le_to_O #x normalize // + |@CF_minus + [@CF_comp_fst @CF_comp_snd @CF_snd |@CF_compS @CF_fst] + ] + |@CF_comp_fst @(monotonic_CF … CF_snd) normalize // + ] + |@O_refl + ] + |@(O_trans … HO) -HO + @(O_trans ? (λx:ℕ + .ha x+hb x + +bigop (S(b x)-a x) (λi:ℕ.true) ? (MSC 〈a x,x〉) plus (λi:ℕ.hf 〈i+a x,x〉))) + [@le_to_O #n @le_plus // whd in match (unary_pr ???); + >fst_pair >snd_pair >(bigop_prim_rec ? (λn.S(b n)) ? (λi.true)) elim (S(b n) - a n) + [normalize @monotonic_MSC @le_pair + |#x #Hind >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair >compl_minim_unary_def + >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair >fst_pair + >snd_pair normalize in ⊢ (??%); >commutative_plus @le_plus + [-Hind @le_plus // normalize >fst_pair >snd_pair + @(transitive_le ? (bigop x (λi1:ℕ.true) ? 0 (λn0:ℕ.λm:ℕ.if leb n0 m then m else n0 ) + (λi1:ℕ.hf 〈i1+a n,n〉))) + [elim x [normalize @MSC_le] + #x0 #Hind >prim_rec_S >fst_pair >snd_pair >snd_pair >snd_pair + >fst_pair >fst_pair cases (p 〈x0+a n,n〉) normalize + [cases (true_or_false (leb (f 〈x0+a n,n〉) + (prim_rec (λx00:ℕ.O) + (λi:ℕ + .if p 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉  + then if leb (f 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉) + (fst (snd i))  + then fst (snd i)  + else f 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉   + else fst (snd i) ) x0 〈a n,n〉))) #Hcase >Hcase normalize + [@(transitive_le … Hind) -Hind @(le_maxr … (le_n …)) + |@(transitive_le … (MSC_prop … CFf …)) @(le_maxl … (le_n …)) + ] + |@(transitive_le … Hind) -Hind @(le_maxr … (le_n …)) + ] + |@(le_maxr … (le_n …)) + ] + + + @(O_trans ? (λx:ℕ + .ha x+hb x + +bigop (b x-a x) (λi:ℕ.true) ? (MSC 〈a x,x〉) plus + (λi:ℕ + .(λi0:ℕ + .hp 〈i0,x〉+hf 〈i0,x〉 + +bigop (b x-a x) (λi1:ℕ.true) ? 0 max + (λi1:ℕ.(λi2:ℕ.hf 〈i2,x〉) (i1+a x))) (i+a x)))) + [ + @le_to_O #n @le_plus // whd in match (unary_pr ???); + >fst_pair >snd_pair >bigop_prim_rec elim (b n - a n) + [normalize // + |#x #Hind >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair >aux_compl1_def1 + >prim_rec_S >fst_pair >snd_pair >fst_pair >snd_pair >fst_pair + >snd_pair normalize in ⊢ (??%); >commutative_plus @le_plus + [-Hind @le_plus // normalize >fst_pair >snd_pair + @(transitive_le ? (bigop x (λi1:ℕ.true) ? 0 (λn0:ℕ.λm:ℕ.if leb n0 m then m else n0 ) + (λi1:ℕ.hf 〈i1+a n,n〉))) + [elim x [normalize @MSC_le] + #x0 #Hind >prim_rec_S >fst_pair >snd_pair >snd_pair >snd_pair + >fst_pair >fst_pair cases (p 〈x0+a n,n〉) normalize + [cases (true_or_false (leb (f 〈x0+a n,n〉) + (prim_rec (λx00:ℕ.O) + (λi:ℕ + .if p 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉  + then if leb (f 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉) + (fst (snd i))  + then fst (snd i)  + else f 〈fst i+fst (snd (snd i)),snd (snd (snd i))〉   + else fst (snd i) ) x0 〈a n,n〉))) #Hcase >Hcase normalize + [@(transitive_le … Hind) -Hind @(le_maxr … (le_n …)) + |@(transitive_le … (MSC_prop … CFf …)) @(le_maxl … (le_n …)) + ] + |@(transitive_le … Hind) -Hind @(le_maxr … (le_n …)) + ] + |@(le_maxr … (le_n …)) + ] + |@(transitive_le … Hind) -Hind + generalize in match (bigop x (λi:ℕ.true) ? 0 max + (λi1:ℕ.(λi2:ℕ.hf 〈i2,n〉) (i1+a n))); #c + generalize in match (hf 〈x+a n,n〉); #c1 + elim x [//] #x0 #Hind + >prim_rec_S >prim_rec_S normalize >fst_pair >fst_pair >snd_pair + >snd_pair >snd_pair >snd_pair >snd_pair >snd_pair >fst_pair >fst_pair + >fst_pair @le_plus + [@le_plus // cases (true_or_false (leb c1 c)) #Hcase + >Hcase normalize // @lt_to_le @not_le_to_lt @(leb_false_to_not_le ?? Hcase) + |@Hind + ] + ] + ] + |@O_plus [@O_plus_l //] @le_to_O #x + (minus_to_0 … (lt_to_le … )) [// | @not_le_to_lt @Hlt] ] -qed. +qed.*) definition out_aux ≝ λh. out_unary ∘ λp.〈fst p,〈snd(snd p),h (S (fst p)) (snd (snd p))〉〉. @@ -739,7 +1427,7 @@ lemma compl_g8: ∀h. ] qed. -lemma compl_g9 : ∀h. +(*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) → @@ -770,7 +1458,7 @@ lemma compl_g9 : ∀h. >associative_plus >distributive_times_plus @le_plus [@le_times [@le_S // |>big_def >Hmax //] |//] ] -qed. +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)〉〉. @@ -781,13 +1469,13 @@ lemma sg_def : ∀h,a,b. #h #a #b whd in ⊢ (??%?); >fst_pair >snd_pair // qed. -lemma compl_g11 : ∀h. +(*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. +qed.*) (**************************** closing the argument ****************************) @@ -820,6 +1508,7 @@ lemma h_of_aux_prim_rec : ∀r,c,n,b. h_of_aux r c n b = ] qed. +(* lemma h_of_aux_constr : ∀r,c. constructible (λx.h_of_aux r c (fst x) (snd x)). #r #c @@ -830,7 +1519,7 @@ lemma h_of_aux_constr : (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 + |@constr_prim_rec*) definition h_of ≝ λr,p. let m ≝ max (fst p) (snd p) in @@ -883,7 +1572,7 @@ 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. +(*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 …)) @@ -933,10 +1622,10 @@ lemma speed_compl_i: ∀r:nat →nat. @(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. +qed.*) (**************************** the speedup theorem *****************************) -theorem pseudo_speedup: +(*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. *) @@ -984,5 +1673,5 @@ lapply (speed_compl_i … Hr Hmono Hconstr (S i)) #Hg #y #Uy %{y} @(monotonic_U … Uy) @(transitive_le … Hlesf) @Hmono @(mono_h_of2 … Hr Hmono … ltin) ] -qed. - +qed.*) + \ No newline at end of file diff --git a/matita/matita/lib/turing/multi_to_mono/multi_to_mono.ma b/matita/matita/lib/turing/multi_to_mono/multi_to_mono.ma deleted file mode 100644 index 0e9bce53e..000000000 --- a/matita/matita/lib/turing/multi_to_mono/multi_to_mono.ma +++ /dev/null @@ -1,397 +0,0 @@ -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 ????); -(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 //] - |@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])} %{[]} - %[%[%[%[%[

blank_all_blank //] - |

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 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 trace_def 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 Hcut - lapply (trace_shift … lt_in … Hrss) [//] whd in match (tail ??); #Htr reverse_map >map_append trace_def in ⊢ (%→?); trace_def in ⊢ (%→?); 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 - 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) - [(proj2 … (H2 … jneqi)) >hd_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_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 H3 >H1 >trace_def >reverse_map >reverse_cons >reverse_append - >reverse_reverse >associative_append