X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=weblib%2Ftutorial%2Fchapter5.ma;h=12df4cc6d2ab877e151011c19028359c61336a13;hb=df8e8b840c36a1a789ec7bebc47c3cc8aca4f663;hp=3f58c2c4838344070027c766ecf58744fa39b15b;hpb=3443885ee60fbcb90e2d106e67d3b7f7e3c59bad;p=helm.git diff --git a/weblib/tutorial/chapter5.ma b/weblib/tutorial/chapter5.ma index 3f58c2c48..12df4cc6d 100644 --- a/weblib/tutorial/chapter5.ma +++ b/weblib/tutorial/chapter5.ma @@ -1,437 +1,215 @@ -(**************************************************************************) -(* ___ *) -(* ||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 *) -(* *) -(**************************************************************************) +(* boolean functions over lists *) -include "re/lang.ma". +include "basics/list.ma". +include "basics/sets.ma". +include "basics/deqsets.ma". -inductive re (S: DeqSet) : Type[0] ≝ - z: re S - | e: re S - | s: S → re S - | c: re S → re S → re S - | o: re S → re S → re S - | k: re S → re S. +(********* search *********) -interpretation "re epsilon" 'epsilon = (e ?). -interpretation "re or" 'plus a b = (o ? a b). -interpretation "re cat" 'middot a b = (c ? a b). -interpretation "re star" 'star a = (k ? a). - -notation < "a" non associative with precedence 90 for @{ 'ps $a}. -notation > "` term 90 a" non associative with precedence 90 for @{ 'ps $a}. -interpretation "atom" 'ps a = (s ? a). - -notation "`∅" non associative with precedence 90 for @{ 'empty }. -interpretation "empty" 'empty = (z ?). - -let rec in_l (S : DeqSet) (r : re S) on r : word S → Prop ≝ -match r with -[ z ⇒ ∅ -| e ⇒ {ϵ} -| s x ⇒ {[x]} -| c r1 r2 ⇒ (in_l ? r1) · (in_l ? r2) -| o r1 r2 ⇒ (in_l ? r1) ∪ (in_l ? r2) -| k r1 ⇒ (in_l ? r1) ^*]. - -notation "\sem{term 19 E}" non associative with precedence 75 for @{'in_l $E}. -interpretation "in_l" 'in_l E = (in_l ? E). -interpretation "in_l mem" 'mem w l = (in_l ? l w). - -lemma rsem_star : ∀S.∀r: re S. \sem{r^*} = \sem{r}^*. -// qed. - - -(* pointed items *) -inductive pitem (S: DeqSet) : Type[0] ≝ - pz: pitem S - | pe: pitem S - | ps: S → pitem S - | pp: S → pitem S - | pc: pitem S → pitem S → pitem S - | po: pitem S → pitem S → pitem S - | pk: pitem S → pitem S. - -definition pre ≝ λS.pitem S × bool. - -interpretation "pitem star" 'star a = (pk ? a). -interpretation "pitem or" 'plus a b = (po ? a b). -interpretation "pitem cat" 'middot a b = (pc ? a b). -notation < ".a" non associative with precedence 90 for @{ 'pp $a}. -notation > "`. term 90 a" non associative with precedence 90 for @{ 'pp $a}. -interpretation "pitem pp" 'pp a = (pp ? a). -interpretation "pitem ps" 'ps a = (ps ? a). -interpretation "pitem epsilon" 'epsilon = (pe ?). -interpretation "pitem empty" 'empty = (pz ?). - -let rec forget (S: DeqSet) (l : pitem S) on l: re S ≝ - match l with - [ pz ⇒ `∅ - | pe ⇒ ϵ - | ps x ⇒ `x - | pp x ⇒ `x - | pc E1 E2 ⇒ (forget ? E1) · (forget ? E2) - | po E1 E2 ⇒ (forget ? E1) + (forget ? E2) - | pk E ⇒ (forget ? E)^* ]. - -(* notation < "|term 19 e|" non associative with precedence 70 for @{'forget $e}.*) -interpretation "forget" 'norm a = (forget ? a). - -let rec in_pl (S : DeqSet) (r : pitem S) on r : word S → Prop ≝ -match r with -[ pz ⇒ ∅ -| pe ⇒ ∅ -| ps _ ⇒ ∅ -| pp x ⇒ { [x] } -| pc r1 r2 ⇒ (in_pl ? r1) · \sem{forget ? r2} ∪ (in_pl ? r2) -| po r1 r2 ⇒ (in_pl ? r1) ∪ (in_pl ? r2) -| pk r1 ⇒ (in_pl ? r1) · \sem{forget ? r1}^* ]. - -interpretation "in_pl" 'in_l E = (in_pl ? E). -interpretation "in_pl mem" 'mem w l = (in_pl ? l w). - -definition in_prl ≝ λS : DeqSet.λp:pre S. - if (\snd p) then \sem{\fst p} ∪ {ϵ} else \sem{\fst p}. - -interpretation "in_prl mem" 'mem w l = (in_prl ? l w). -interpretation "in_prl" 'in_l E = (in_prl ? E). - -lemma sem_pre_true : ∀S.∀i:pitem S. - \sem{〈i,true〉} = \sem{i} ∪ {ϵ}. -// qed. - -lemma sem_pre_false : ∀S.∀i:pitem S. - \sem{〈i,false〉} = \sem{i}. -// qed. - -lemma sem_cat: ∀S.∀i1,i2:pitem S. - \sem{i1 · i2} = \sem{i1} · \sem{|i2|} ∪ \sem{i2}. -// qed. - -lemma sem_cat_w: ∀S.∀i1,i2:pitem S.∀w. - \sem{i1 · i2} w = ((\sem{i1} · \sem{|i2|}) w ∨ \sem{i2} w). -// qed. - -lemma sem_plus: ∀S.∀i1,i2:pitem S. - \sem{i1 + i2} = \sem{i1} ∪ \sem{i2}. -// qed. - -lemma sem_plus_w: ∀S.∀i1,i2:pitem S.∀w. - \sem{i1 + i2} w = (\sem{i1} w ∨ \sem{i2} w). -// qed. - -lemma sem_star : ∀S.∀i:pitem S. - \sem{i^*} = \sem{i} · \sem{|i|}^*. -// qed. - -lemma sem_star_w : ∀S.∀i:pitem S.∀w. - \sem{i^*} w = (∃w1,w2.w1 @ w2 = w ∧ \sem{i} w1 ∧ \sem{|i|}^* w2). -// qed. +let rec memb (S:DeqSet) (x:S) (l: list S) on l ≝ + match l with + [ nil ⇒ false + | cons a tl ⇒ (x == a) ∨ memb S x tl + ]. -lemma append_eq_nil : ∀S.∀w1,w2:word S. w1 @ w2 = ϵ → w1 = ϵ. -#S #w1 #w2 cases w1 // #a #tl normalize #H destruct qed. +notation < "\memb x l" non associative with precedence 90 for @{'memb $x $l}. +interpretation "boolean membership" 'memb a l = (memb ? a l). -lemma not_epsilon_lp : ∀S:DeqSet.∀e:pitem S. ¬ (ϵ ∈ e). -#S #e elim e normalize /2/ - [#r1 #r2 * #n1 #n2 % * /2/ * #w1 * #w2 * * #H - >(append_eq_nil …H…) /2/ - |#r1 #r2 #n1 #n2 % * /2/ - |#r #n % * #w1 * #w2 * * #H >(append_eq_nil …H…) /2/ - ] +lemma memb_hd: ∀S,a,l. memb S a (a::l) = true. +#S #a #l normalize >(proj2 … (eqb_true S …) (refl S a)) // qed. -(* lemma 12 *) -lemma epsilon_to_true : ∀S.∀e:pre S. ϵ ∈ e → \snd e = true. -#S * #i #b cases b // normalize #H @False_ind /2/ +lemma memb_cons: ∀S,a,b,l. + memb S a l = true → memb S a (b::l) = true. +#S #a #b #l normalize cases (a==b) normalize // qed. -lemma true_to_epsilon : ∀S.∀e:pre S. \snd e = true → ϵ ∈ e. -#S * #i #b #btrue normalize in btrue; >btrue %2 // +lemma memb_single: ∀S,a,x. memb S a [x] = true → a = x. +#S #a #x normalize cases (true_or_false … (a==x)) #H + [#_ >(\P H) // |>H normalize #abs @False_ind /2/] qed. -definition lo ≝ λS:DeqSet.λa,b:pre S.〈\fst a + \fst b,\snd a ∨ \snd b〉. -notation "a ⊕ b" left associative with precedence 60 for @{'oplus $a $b}. -interpretation "oplus" 'oplus a b = (lo ? a b). +lemma memb_append: ∀S,a,l1,l2. +memb S a (l1@l2) = true → + memb S a l1= true ∨ memb S a l2 = true. +#S #a #l1 elim l1 normalize [#l2 #H %2 //] +#b #tl #Hind #l2 cases (a==b) normalize /2/ +qed. -lemma lo_def: ∀S.∀i1,i2:pitem S.∀b1,b2. 〈i1,b1〉⊕〈i2,b2〉=〈i1+i2,b1∨b2〉. -// qed. +lemma memb_append_l1: ∀S,a,l1,l2. + memb S a l1= true → memb S a (l1@l2) = true. +#S #a #l1 elim l1 normalize + [normalize #le #abs @False_ind /2/ + |#b #tl #Hind #l2 cases (a==b) normalize /2/ + ] +qed. + +lemma memb_append_l2: ∀S,a,l1,l2. + memb S a l2= true → memb S a (l1@l2) = true. +#S #a #l1 elim l1 normalize // +#b #tl #Hind #l2 cases (a==b) normalize /2/ +qed. + +lemma memb_exists: ∀S,a,l.memb S a l = true → + ∃l1,l2.l=l1@(a::l2). +#S #a #l elim l [normalize #abs @False_ind /2/] +#b #tl #Hind #H cases (orb_true_l … H) + [#eqba @(ex_intro … (nil S)) @(ex_intro … tl) >(\P eqba) // + |#mem_tl cases (Hind mem_tl) #l1 * #l2 #eqtl + @(ex_intro … (b::l1)) @(ex_intro … l2) >eqtl // + ] +qed. -definition pre_concat_r ≝ λS:DeqSet.λi:pitem S.λe:pre S. - match e with [ mk_Prod i1 b ⇒ 〈i · i1, b〉]. +lemma not_memb_to_not_eq: ∀S,a,b,l. + memb S a l = false → memb S b l = true → a==b = false. +#S #a #b #l cases (true_or_false (a==b)) // +#eqab >(\P eqab) #H >H #abs @False_ind /2/ +qed. -notation "i ◂ e" left associative with precedence 60 for @{'ltrif $i $e}. -interpretation "pre_concat_r" 'ltrif i e = (pre_concat_r ? i e). - -lemma eq_to_ex_eq: ∀S.∀A,B:word S → Prop. - A = B → A =1 B. -#S #A #B #H >H /2/ qed. - -lemma sem_pre_concat_r : ∀S,i.∀e:pre S. - \sem{i ◂ e} =1 \sem{i} · \sem{|\fst e|} ∪ \sem{e}. -#S #i * #i1 #b1 cases b1 [2: @eq_to_ex_eq //] ->sem_pre_true >sem_cat >sem_pre_true /2/ +lemma memb_map: ∀S1,S2,f,a,l. memb S1 a l= true → + memb S2 (f a) (map … f l) = true. +#S1 #S2 #f #a #l elim l normalize [//] +#x #tl #memba cases (true_or_false (a==x)) + [#eqx >eqx >(\P eqx) >(\b (refl … (f x))) normalize // + |#eqx >eqx cases (f a==f x) normalize /2/ + ] qed. - -definition lc ≝ λS:DeqSet.λbcast:∀S:DeqSet.pitem S → pre S.λe1:pre S.λi2:pitem S. - match e1 with - [ mk_Prod i1 b1 ⇒ match b1 with - [ true ⇒ (i1 ◂ (bcast ? i2)) - | false ⇒ 〈i1 · i2,false〉 - ] - ]. - -definition lift ≝ λS.λf:pitem S →pre S.λe:pre S. - match e with - [ mk_Prod i b ⇒ 〈\fst (f i), \snd (f i) ∨ b〉]. - -notation "a ▸ b" left associative with precedence 60 for @{'lc eclose $a $b}. -interpretation "lc" 'lc op a b = (lc ? op a b). - -definition lk ≝ λS:DeqSet.λbcast:∀S:DeqSet.∀E:pitem S.pre S.λe:pre S. - match e with - [ mk_Prod i1 b1 ⇒ - match b1 with - [true ⇒ 〈(\fst (bcast ? i1))^*, true〉 - |false ⇒ 〈i1^*,false〉 - ] - ]. - -(* notation < "a \sup ⊛" non associative with precedence 90 for @{'lk $op $a}.*) -interpretation "lk" 'lk op a = (lk ? op a). -notation "a^⊛" non associative with precedence 90 for @{'lk eclose $a}. - -notation "•" non associative with precedence 60 for @{eclose ?}. -let rec eclose (S: DeqSet) (i: pitem S) on i : pre S ≝ - match i with - [ pz ⇒ 〈 `∅, false 〉 - | pe ⇒ 〈 ϵ, true 〉 - | ps x ⇒ 〈 `.x, false〉 - | pp x ⇒ 〈 `.x, false 〉 - | po i1 i2 ⇒ •i1 ⊕ •i2 - | pc i1 i2 ⇒ •i1 ▸ i2 - | pk i ⇒ 〈(\fst (•i))^*,true〉]. - -notation "• x" non associative with precedence 60 for @{'eclose $x}. -interpretation "eclose" 'eclose x = (eclose ? x). - -lemma eclose_plus: ∀S:DeqSet.∀i1,i2:pitem S. - •(i1 + i2) = •i1 ⊕ •i2. -// qed. - -lemma eclose_dot: ∀S:DeqSet.∀i1,i2:pitem S. - •(i1 · i2) = •i1 ▸ i2. -// qed. - -lemma eclose_star: ∀S:DeqSet.∀i:pitem S. - •i^* = 〈(\fst(•i))^*,true〉. -// qed. - -definition reclose ≝ λS. lift S (eclose S). -interpretation "reclose" 'eclose x = (reclose ? x). - -(* theorem 16: 2 *) -lemma sem_oplus: ∀S:DeqSet.∀e1,e2:pre S. - \sem{e1 ⊕ e2} =1 \sem{e1} ∪ \sem{e2}. -#S * #i1 #b1 * #i2 #b2 #w % - [cases b1 cases b2 normalize /2/ * /3/ * /3/ - |cases b1 cases b2 normalize /2/ * /3/ * /3/ +lemma memb_compose: ∀S1,S2,S3,op,a1,a2,l1,l2. + memb S1 a1 l1 = true → memb S2 a2 l2 = true → + memb S3 (op a1 a2) (compose S1 S2 S3 op l1 l2) = true. +#S1 #S2 #S3 #op #a1 #a2 #l1 elim l1 [normalize //] +#x #tl #Hind #l2 #memba1 #memba2 cases (orb_true_l … memba1) + [#eqa1 >(\P eqa1) @memb_append_l1 @memb_map // + |#membtl @memb_append_l2 @Hind // ] qed. -lemma odot_true : - ∀S.∀i1,i2:pitem S. - 〈i1,true〉 ▸ i2 = i1 ◂ (•i2). -// qed. - -lemma odot_true_bis : - ∀S.∀i1,i2:pitem S. - 〈i1,true〉 ▸ i2 = 〈i1 · \fst (•i2), \snd (•i2)〉. -#S #i1 #i2 normalize cases (•i2) // qed. - -lemma odot_false: - ∀S.∀i1,i2:pitem S. - 〈i1,false〉 ▸ i2 = 〈i1 · i2, false〉. -// qed. - -lemma LcatE : ∀S.∀e1,e2:pitem S. - \sem{e1 · e2} = \sem{e1} · \sem{|e2|} ∪ \sem{e2}. -// qed. - -lemma erase_dot : ∀S.∀e1,e2:pitem S. |e1 · e2| = c ? (|e1|) (|e2|). -// qed. +(**************** unicity test *****************) -lemma erase_plus : ∀S.∀i1,i2:pitem S. - |i1 + i2| = |i1| + |i2|. -// qed. - -lemma erase_star : ∀S.∀i:pitem S.|i^*| = |i|^*. -// qed. - -lemma erase_bull : ∀S.∀i:pitem S. |\fst (•i)| = |i|. -#S #i elim i // - [ #i1 #i2 #IH1 #IH2 >erase_dot eclose_dot - cases (•i1) #i11 #b1 cases b1 // odot_true_bis // - | #i1 #i2 #IH1 #IH2 >eclose_plus >(erase_plus … i1) eclose_star >(erase_star … i) odot_false >sem_pre_false >sem_pre_false >sem_cat /2/ - |#H >odot_true >sem_pre_true @(eqP_trans … (sem_pre_concat_r …)) - >erase_bull @eqP_trans [|@(eqP_union_l … H)] - @eqP_trans [|@eqP_union_l[|@union_comm ]] - @eqP_trans [|@eqP_sym @union_assoc ] /3/ - ] -qed. +(* unique_append l1 l2 add l1 in fornt of l2, but preserving unicity *) -lemma sem_fst: ∀S.∀e:pre S. \sem{\fst e} =1 \sem{e}-{[ ]}. -#S * #i * - [>sem_pre_true normalize in ⊢ (??%?); #w % - [/3/ | * * // #H1 #H2 @False_ind @(absurd …H1 H2)] - |>sem_pre_false normalize in ⊢ (??%?); #w % [ /3/ | * // ] - ] -qed. +let rec unique_append (S:DeqSet) (l1,l2: list S) on l1 ≝ + match l1 with + [ nil ⇒ l2 + | cons a tl ⇒ + let r ≝ unique_append S tl l2 in + if memb S a r then r else a::r + ]. -lemma item_eps: ∀S.∀i:pitem S. \sem{i} =1 \sem{i}-{[ ]}. -#S #i #w % - [#H whd % // normalize @(not_to_not … (not_epsilon_lp …i)) // - |* // +axiom unique_append_elim: ∀S:DeqSet.∀P: S → Prop.∀l1,l2. +(∀x. memb S x l1 = true → P x) → (∀x. memb S x l2 = true → P x) → +∀x. memb S x (unique_append S l1 l2) = true → P x. + +lemma unique_append_unique: ∀S,l1,l2. uniqueb S l2 = true → + uniqueb S (unique_append S l1 l2) = true. +#S #l1 elim l1 normalize // #a #tl #Hind #l2 #uniquel2 +cases (true_or_false … (memb S a (unique_append S tl l2))) +#H >H normalize [@Hind //] >H normalize @Hind // +qed. + +(******************* sublist *******************) +definition sublist ≝ + λS,l1,l2.∀a. memb S a l1 = true → memb S a l2 = true. + +lemma sublist_length: ∀S,l1,l2. + uniqueb S l1 = true → sublist S l1 l2 → |l1| ≤ |l2|. +#S #l1 elim l1 // +#a #tl #Hind #l2 #unique #sub +cut (∃l3,l4.l2=l3@(a::l4)) [@memb_exists @sub //] +* #l3 * #l4 #eql2 >eql2 >length_append normalize +applyS le_S_S eql2 in sub; #sub #x #membx +cases (memb_append … (sub x (orb_true_r2 … membx))) + [#membxl3 @memb_append_l1 // + |#membxal4 cases (orb_true_l … membxal4) + [#eqxa @False_ind lapply (andb_true_l … unique) + <(\P eqxa) >membx normalize /2/ |#membxl4 @memb_append_l2 // + ] ] qed. - -lemma sem_fst_aux: ∀S.∀e:pre S.∀i:pitem S.∀A. - \sem{e} =1 \sem{i} ∪ A → \sem{\fst e} =1 \sem{i} ∪ (A - {[ ]}). -#S #e #i #A #seme -@eqP_trans [|@sem_fst] -@eqP_trans [||@eqP_union_r [|@eqP_sym @item_eps]] -@eqP_trans [||@distribute_substract] -@eqP_substract_r // -qed. -(* theorem 16: 1 *) -theorem sem_bull: ∀S:DeqSet. ∀e:pitem S. \sem{•e} =1 \sem{e} ∪ \sem{|e|}. -#S #e elim e - [#w normalize % [/2/ | * //] - |/2/ - |#x normalize #w % [ /2/ | * [@False_ind | //]] - |#x normalize #w % [ /2/ | * // ] - |#i1 #i2 #IH1 #IH2 >eclose_dot - @eqP_trans [|@odot_dot_aux //] >sem_cat - @eqP_trans - [|@eqP_union_r - [|@eqP_trans [|@(cat_ext_l … IH1)] @distr_cat_r]] - @eqP_trans [|@union_assoc] - @eqP_trans [||@eqP_sym @union_assoc] - @eqP_union_l // - |#i1 #i2 #IH1 #IH2 >eclose_plus - @eqP_trans [|@sem_oplus] >sem_plus >erase_plus - @eqP_trans [|@(eqP_union_l … IH2)] - @eqP_trans [|@eqP_sym @union_assoc] - @eqP_trans [||@union_assoc] @eqP_union_r - @eqP_trans [||@eqP_sym @union_assoc] - @eqP_trans [||@eqP_union_l [|@union_comm]] - @eqP_trans [||@union_assoc] /2/ - |#i #H >sem_pre_true >sem_star >erase_bull >sem_star - @eqP_trans [|@eqP_union_r [|@cat_ext_l [|@sem_fst_aux //]]] - @eqP_trans [|@eqP_union_r [|@distr_cat_r]] - @eqP_trans [|@union_assoc] @eqP_union_l >erase_star - @eqP_sym @star_fix_eps +lemma sublist_unique_append_l1: + ∀S,l1,l2. sublist S l1 (unique_append S l1 l2). +#S #l1 elim l1 normalize [#l2 #S #abs @False_ind /2/] +#x #tl #Hind #l2 #a +normalize cases (true_or_false … (a==x)) #eqax >eqax +[<(\P eqax) cases (true_or_false (memb S a (unique_append S tl l2))) + [#H >H normalize // | #H >H normalize >(\b (refl … a)) //] +|cases (memb S x (unique_append S tl l2)) normalize + [/2/ |>eqax normalize /2/] +] +qed. + +lemma sublist_unique_append_l2: + ∀S,l1,l2. sublist S l2 (unique_append S l1 l2). +#S #l1 elim l1 [normalize //] #x #tl #Hind normalize +#l2 #a cases (memb S x (unique_append S tl l2)) normalize +[@Hind | cases (a==x) normalize // @Hind] +qed. + +lemma decidable_sublist:∀S,l1,l2. + (sublist S l1 l2) ∨ ¬(sublist S l1 l2). +#S #l1 #l2 elim l1 + [%1 #a normalize in ⊢ (%→?); #abs @False_ind /2/ + |#a #tl * #subtl + [cases (true_or_false (memb S a l2)) #memba + [%1 whd #x #membx cases (orb_true_l … membx) + [#eqax >(\P eqax) // |@subtl] + |%2 @(not_to_not … (eqnot_to_noteq … true memba)) #H1 @H1 @memb_hd + ] + |%2 @(not_to_not … subtl) #H1 #x #H2 @H1 @memb_cons // + ] ] qed. -definition lifted_cat ≝ λS:DeqSet.λe:pre S. - lift S (lc S eclose e). +(********************* filtering *****************) -notation "e1 ⊙ e2" left associative with precedence 70 for @{'odot $e1 $e2}. - -interpretation "lifted cat" 'odot e1 e2 = (lifted_cat ? e1 e2). - -lemma odot_true_b : ∀S.∀i1,i2:pitem S.∀b. - 〈i1,true〉 ⊙ 〈i2,b〉 = 〈i1 · (\fst (•i2)),\snd (•i2) ∨ b〉. -#S #i1 #i2 #b normalize in ⊢ (??%?); cases (•i2) // -qed. - -lemma odot_false_b : ∀S.∀i1,i2:pitem S.∀b. - 〈i1,false〉 ⊙ 〈i2,b〉 = 〈i1 · i2 ,b〉. -// -qed. +lemma filter_true: ∀S,f,a,l. + memb S a (filter S f l) = true → f a = true. +#S #f #a #l elim l [normalize #H @False_ind /2/] +#b #tl #Hind cases (true_or_false (f b)) #H +normalize >H normalize [2:@Hind] +cases (true_or_false (a==b)) #eqab + [#_ >(\P eqab) // | >eqab normalize @Hind] +qed. -lemma erase_odot:∀S.∀e1,e2:pre S. - |\fst (e1 ⊙ e2)| = |\fst e1| · (|\fst e2|). -#S * #i1 * * #i2 #b2 // >odot_true_b // +lemma memb_filter_memb: ∀S,f,a,l. + memb S a (filter S f l) = true → memb S a l = true. +#S #f #a #l elim l [normalize //] +#b #tl #Hind normalize (cases (f b)) normalize +cases (a==b) normalize // @Hind qed. - -lemma ostar_true: ∀S.∀i:pitem S. - 〈i,true〉^⊛ = 〈(\fst (•i))^*, true〉. -// qed. - -lemma ostar_false: ∀S.∀i:pitem S. - 〈i,false〉^⊛ = 〈i^*, false〉. -// qed. -lemma erase_ostar: ∀S.∀e:pre S. - |\fst (e^⊛)| = |\fst e|^*. -#S * #i * // qed. - -lemma sem_odot_true: ∀S:DeqSet.∀e1:pre S.∀i. - \sem{e1 ⊙ 〈i,true〉} =1 \sem{e1 ▸ i} ∪ { [ ] }. -#S #e1 #i -cut (e1 ⊙ 〈i,true〉 = 〈\fst (e1 ▸ i), \snd(e1 ▸ i) ∨ true〉) [//] -#H >H cases (e1 ▸ i) #i1 #b1 cases b1 - [>sem_pre_true @eqP_trans [||@eqP_sym @union_assoc] - @eqP_union_l /2/ - |/2/ +lemma memb_filter: ∀S,f,l,x. memb S x (filter ? f l) = true → +memb S x l = true ∧ (f x = true). +/3/ qed. + +lemma memb_filter_l: ∀S,f,x,l. (f x = true) → memb S x l = true → +memb S x (filter ? f l) = true. +#S #f #x #l #fx elim l normalize // +#b #tl #Hind cases (true_or_false (x==b)) #eqxb + [<(\P eqxb) >(\b (refl … x)) >fx normalize >(\b (refl … x)) normalize // + |>eqxb cases (f b) normalize [>eqxb normalize @Hind| @Hind] ] -qed. +qed. -lemma eq_odot_false: ∀S:DeqSet.∀e1:pre S.∀i. - e1 ⊙ 〈i,false〉 = e1 ▸ i. -#S #e1 #i -cut (e1 ⊙ 〈i,false〉 = 〈\fst (e1 ▸ i), \snd(e1 ▸ i) ∨ false〉) [//] -cases (e1 ▸ i) #i1 #b1 cases b1 #H @H -qed. +(********************* exists *****************) -lemma sem_odot: - ∀S.∀e1,e2: pre S. \sem{e1 ⊙ e2} =1 \sem{e1}· \sem{|\fst e2|} ∪ \sem{e2}. -#S #e1 * #i2 * - [>sem_pre_true - @eqP_trans [|@sem_odot_true] - @eqP_trans [||@union_assoc] @eqP_union_r @odot_dot_aux // - |>sem_pre_false >eq_odot_false @odot_dot_aux // - ] -qed. +let rec exists (A:Type[0]) (p:A → bool) (l:list A) on l : bool ≝ +match l with +[ nil ⇒ false +| cons h t ⇒ orb (p h) (exists A p t) +]. -(* theorem 16: 4 *) -theorem sem_ostar: ∀S.∀e:pre S. - \sem{e^⊛} =1 \sem{e} · \sem{|\fst e|}^*. -#S * #i #b cases b - [>sem_pre_true >sem_pre_true >sem_star >erase_bull - @eqP_trans [|@eqP_union_r[|@cat_ext_l [|@sem_fst_aux //]]] - @eqP_trans [|@eqP_union_r [|@distr_cat_r]] - @eqP_trans [||@eqP_sym @distr_cat_r] - @eqP_trans [|@union_assoc] @eqP_union_l - @eqP_trans [||@eqP_sym @epsilon_cat_l] @eqP_sym @star_fix_eps - |>sem_pre_false >sem_pre_false >sem_star /2/ - ] +lemma Exists_exists : ∀A,P,l. + Exists A P l → + ∃x. P x. +#A #P #l elim l [ * | #hd #tl #IH * [ #H %{hd} @H | @IH ] qed. -