From: Ferruccio Guidi Date: Mon, 14 Oct 2019 10:07:33 +0000 (+0200) Subject: backport of WIP on \lambda\delta to matita 0.99.3 X-Git-Tag: make_still_working~225^2~2 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=600fba840c748f67593838673a6eb40eab9b68e5;p=helm.git 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 --- diff --git a/helm/www/lambdadelta/images/bronze-03BB.png b/helm/www/lambdadelta/images/bronze-03BB.png new file mode 100644 index 000000000..3cf590000 Binary files /dev/null and b/helm/www/lambdadelta/images/bronze-03BB.png differ diff --git a/helm/www/lambdadelta/web/home/home.ldw.xml b/helm/www/lambdadelta/web/home/home.ldw.xml index 8e6135836..e773b460b 100644 --- a/helm/www/lambdadelta/web/home/home.ldw.xml +++ b/helm/www/lambdadelta/web/home/home.ldw.xml @@ -30,6 +30,9 @@ to view this site correctly, please select a font with Unicode 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