(* Title: A formalisation of the Cocke-Younger-Kasami algorithm Author:MaksymBortin<Maksym.Bortin@nicta.com.au>
*)
theory CYK imports Main begin
text‹The theory is structured as follows. First section deals with modelling
of grammars, derivations, and the language semantics. Then the basic
properties are proved. Further, CYK is abstractly specified and its
underlying recursive relationship proved. The final section contains a
prototypical implementation accompanied by a proof of its correctness.›
section"Basic modelling"
subsection"Grammars in Chomsky normal form"
text"A grammar in Chomsky normal form is here simply modelled by a list of production rules (the type CNG below), each having a non-terminal symbol on the lhs and either two non-terminals or one terminal symbol on the rhs."
text"Abbreviating the list append symbol for better readability" abbreviation list_append :: "'a list ==> 'a list ==> 'a list" (infixr‹⋅›65) where"xs ⋅ ys ≡ xs @ ys"
subsection"Derivation by grammars"
text‹A \emph{word form} (or sentential form) may be built of both non-terminal and terminal
symbols, as opposed to a \emph{word} that contains only terminals. By the usage of disjoint
union, non-terminals are injected into a word form by @{term "Inl"} whereas terminals --
by @{term "Inr"}.› type_synonym ('n, 't) word_form = "('n + 't) list" type_synonym 't word = "'t list"
text"A single step derivation relation on word forms is induced by a grammar in the standard way, replacing a non-terminal within a word form in accordance to the production rules." definition DSTEP :: "('n, 't) CNG ==> (('n, 't) word_form × ('n, 't) word_form) set" where"DSTEP G = {(l ⋅ [Inl N] ⋅ r, x) | l N r rhs x. (N, rhs) ∈ set G ∧ (case rhs of Branch A B ==> x = l ⋅ [Inl A, Inl B] ⋅ r | Leaf t ==> x = l ⋅ [Inr t] ⋅ r)}"
text"The language generated by a grammar from a non-terminal symbol comprises all words that can be derived from the non-terminal in one or more steps. Notice that by the presented grammar modelling, languages containing the empty word cannot be generated. Hence in rare situations when such languages are required, the empty word case should be treated separately." definition Lang :: "('n, 't) CNG ==> 'n ==> 't word set" where"Lang G S = {w. [Inl S] -G→+ map Inr w }"
text‹So, for instance, a grammar generating the language $a^nb^n$
from the non-terminal @{term "''S''"} might look as follows.› definition"G_anbn = [(''S'', Branch ''A'' ''T''), (''S'', Branch ''A'' ''B''), (''T'', Branch ''S'' ''B''), (''A'', Leaf ''a''), (''B'', Leaf ''b'')]"
text‹Now the term @{term "Lang G_anbn ''S''"} denotes the set of words of
the form $a^nb^n$ with $n > 0$. This is intuitively clear, but not
straight forward to show, and a lengthy proof for that is out of scope.›
section"Basic properties"
lemma prod_into_DSTEP1 : "(S, Branch A B) ∈ set G ==> L ⋅ [Inl S] ⋅ R -G→ L ⋅ [Inl A, Inl B] ⋅ R" by(simp add: DSTEP_def, rule_tac x="L"in exI, force)
lemma prod_into_DSTEP2 : "(S, Leaf a) ∈ set G ==> L ⋅ [Inl S] ⋅ R -G→ L ⋅ [Inr a] ⋅ R" by(simp add: DSTEP_def, rule_tac x="L"in exI, force)
lemma DSTEP_D : "s -G→ t ==> ∃L N R rhs. s = L ⋅ [Inl N] ⋅ R ∧ (N, rhs) ∈ set G ∧ (∀A B. rhs = Branch A B ⟶ t = L ⋅ [Inl A, Inl B] ⋅ R) ∧ (∀x. rhs = Leaf x ⟶ t = L ⋅ [Inr x] ⋅ R)" by(unfold DSTEP_def, clarsimp, simp split: RHS.split_asm, blast+)
lemma DSTEP_append : assumes a: "s -G→ t" shows"L ⋅ s ⋅ R -G→ L ⋅ t ⋅ R" proof - from a have"∃l N r rhs. s = l ⋅ [Inl N] ⋅ r ∧ (N, rhs) ∈ set G ∧ (∀A B. rhs = Branch A B ⟶ t = l ⋅ [Inl A, Inl B] ⋅ r) ∧ (∀x. rhs = Leaf x ⟶ t = l ⋅ [Inr x] ⋅ r)" (is"∃l N r rhs. ?P l N r rhs") by(rule DSTEP_D) thenobtain l N r rhs where"?P l N r rhs"by blast thus ?thesis by(simp add: DSTEP_def, rule_tac x="L ⋅ l"in exI,
rule_tac x=N in exI, rule_tac x="r ⋅ R"in exI,
simp, rule_tac x=rhs in exI, simp split: RHS.split) qed
lemma DSTEP_star_mono : "s -G→* t ==> length s ≤ length t" proof(erule rtrancl_induct, simp) fix t u assume"s -G→* t" assume a: "t -G→ u" assume b: "length s ≤ length t" show"length s ≤ length u" proof - from a have"∃L N R rhs. t = L ⋅ [Inl N] ⋅ R ∧ (N, rhs) ∈ set G ∧ (∀A B. rhs = Branch A B ⟶ u = L ⋅ [Inl A, Inl B] ⋅ R) ∧ (∀x. rhs = Leaf x ⟶ u = L ⋅ [Inr x] ⋅ R)" (is"∃L N R rhs. ?P L N R rhs") by(rule DSTEP_D) thenobtain L N R rhs where"?P L N R rhs"by blast with b show ?thesis by(case_tac rhs, clarsimp+) qed qed
lemma DSTEP_comp : assumes a: "l ⋅ r -G→ t" shows"∃l' r'. l -G→= l' ∧ r -G→= r' ∧ t = l' ⋅ r'" proof - from a have"∃L N R rhs. l ⋅ r = L ⋅ [Inl N] ⋅ R ∧ (N, rhs) ∈ set G ∧ (∀A B. rhs = Branch A B ⟶ t = L ⋅ [Inl A, Inl B] ⋅ R) ∧ (∀x. rhs = Leaf x ⟶ t = L ⋅ [Inr x] ⋅ R)" (is"∃L N R rhs. ?T L N R rhs") by(rule DSTEP_D) thenobtain L N R rhs where b: "?T L N R rhs"by blast hence"l ⋅ r = L ⋅ Inl N # R"by simp hence"∃u. (l = L ⋅ u ∧ u ⋅ r = Inl N # R) ∨ (l ⋅ u = L ∧ r = u ⋅ Inl N # R)"by(rule append_eq_append_conv2[THEN iffD1]) thenobtain xs where c: "l = L ⋅ xs ∧ xs ⋅ r = Inl N # R ∨ l ⋅ xs = L ∧ r = xs ⋅ Inl N # R" (is"?C1 ∨ ?C2") by blast show ?thesis proof(cases rhs) case (Leaf x) with b have d: "t = L ⋅ [Inr x] ⋅ R ∧ (N, Leaf x) ∈ set G"by simp from c show ?thesis proof assume e: "?C1" show ?thesis proof(cases xs) case Nil with d and e show ?thesis by(clarsimp, rule_tac x=L in exI, simp add: DSTEP_def, simp split: RHS.split, blast) next case (Cons z zs) with d and e show ?thesis by(rule_tac x="L ⋅ Inr x # zs"in exI, clarsimp, simp add: DSTEP_def, simp split: RHS.split, blast) qed next assume e: "?C2" show ?thesis proof(cases xs) case Nil with d and e show ?thesis by(rule_tac x=L in exI, clarsimp, simp add: DSTEP_def, simp split: RHS.split, blast) next case (Cons z zs) with d and e show ?thesis by(rule_tac x="l"in exI, clarsimp, simp add: DSTEP_def, simp split: RHS.split,
rule_tac x="z#zs"in exI, rule_tac x=N in exI, rule_tac x=R in exI, simp, rule_tac x="Leaf x"in exI, simp) qed qed next case (Branch A B) with b have d: "t = L ⋅ [Inl A, Inl B] ⋅ R ∧ (N, Branch A B) ∈ set G"by simp from c show ?thesis proof assume e: "?C1" show ?thesis proof(cases xs) case Nil with d and e show ?thesis by(clarsimp, rule_tac x=L in exI, simp add: DSTEP_def, simp split: RHS.split, blast) next case (Cons z zs) with d and e show ?thesis by(rule_tac x="L ⋅ [Inl A, Inl B] ⋅ zs"in exI, clarsimp, simp add: DSTEP_def, simp split: RHS.split, blast) qed next assume e: "?C2" show ?thesis proof(cases xs) case Nil with d and e show ?thesis by(rule_tac x=L in exI, clarsimp, simp add: DSTEP_def, simp split: RHS.split, blast) next case (Cons z zs) with d and e show ?thesis by(rule_tac x="l"in exI, clarsimp, simp add: DSTEP_def, simp split: RHS.split,
rule_tac x="z#zs"in exI, rule_tac x=N in exI, rule_tac x=R in exI, simp, rule_tac x="Branch A B"in exI, simp) qed qed qed qed
theorem DSTEP_star_comp1 : assumes A: "l ⋅ r -G→* t" shows"∃l' r'. l -G→* l' ∧ r -G→* r' ∧ t = l' ⋅ r'" proof - have"∧s. s -G→* t ==> ∀l r. s = l ⋅ r ⟶ (∃l' r'. l -G→* l' ∧ r -G→* r' ∧ t = l' ⋅ r')" (is"∧s. ?P s t ==> ?Q s t") proof(erule rtrancl_induct, force) fix s t u assume"?P s t" assume a: "t -G→ u" assume b: "?Q s t" show"?Q s u" proof(clarify) fix l r assume"s = l ⋅ r" with b have"∃l' r'. l -G→* l' ∧ r -G→* r' ∧ t = l' ⋅ r'"by simp thenobtain l' r' where c: "l -G→* l' ∧ r -G→* r' ∧ t = l' ⋅ r'"by blast with a have"l' ⋅ r' -G→ u"by simp hence"∃l'' r''. l' -G→= l'' ∧ r' -G→= r'' ∧ u = l'' ⋅ r''"by(rule DSTEP_comp) thenobtain l'' r'' where"l' -G→= l'' ∧ r' -G→= r'' ∧ u = l'' ⋅ r''"by blast hence"l' -G→* l'' ∧ r' -G→* r'' ∧ u = l'' ⋅ r''"by blast with c show"∃l' r'. l -G→* l' ∧ r -G→* r' ∧ u = l' ⋅ r'" by(rule_tac x=l'' in exI, rule_tac x=r'' in exI, force) qed qed with A show ?thesis by force qed
theorem DSTEP_star_comp2 : assumes A: "l -G→* l'" and B: "r -G→* r'" shows"l ⋅ r -G→* l' ⋅ r'" proof - have"l -G→* l' ==> ∀r r'. r -G→* r' ⟶ l ⋅ r -G→* l' ⋅ r'" (is"?P l l' ==> ?Q l l'") proof(erule rtrancl_induct) show"?Q l l" proof(clarify, erule rtrancl_induct, simp) fix r s t assume a: "s -G→ t" assume b: "l ⋅ r -G→* l ⋅ s" show"l ⋅ r -G→* l ⋅ t" proof - from a have"l ⋅ s -G→ l ⋅ t"by(drule_tac L=l and R="[]"in DSTEP_append, simp) with b show ?thesis by simp qed qed next fix s t assume a: "s -G→ t" assume b: "?Q l s" show"?Q l t" proof(clarsimp) fix r r' assume"r -G→* r'" with b have c: "l ⋅ r -G→* s ⋅ r'"by simp from a have"s ⋅ r' -G→ t ⋅ r'"by(drule_tac L="[]"and R=r' in DSTEP_append, simp) with c show"l ⋅ r -G→* t ⋅ r'"by simp qed qed with A and B show ?thesis by simp qed
lemma DSTEP_trancl_term : assumes A: "[Inl S] -G→+ t" and B: "Inr x ∈ set t" shows"∃N. (N, Leaf x) ∈ set G" proof - have"[Inl S] -G→+ t ==> ∀x. Inr x ∈ set t ⟶ (∃N. (N, Leaf x) ∈ set G)" (is"?P t ==> ?Q t") proof(erule trancl_induct) fix t assume a: "[Inl S] -G→ t" show"?Q t" proof - from a have"∃rhs. (S, rhs) ∈ set G ∧ (∀A B. rhs = Branch A B ⟶ t = [Inl A, Inl B]) ∧ (∀x. rhs = Leaf x ⟶ t = [Inr x])" (is"∃rhs. ?P rhs") by(simp add: DSTEP_def, clarsimp, simp split: RHS.split_asm, case_tac l, force, simp,
clarsimp, simp split: RHS.split_asm, case_tac l, force, simp) thenobtain rhs where"?P rhs"by blast thus ?thesis by(case_tac rhs, clarsimp, force) qed next fix s t assume a: "s -G→ t" assume b: "?Q s" show"?Q t" proof - from a have"∃L N R rhs. s = L ⋅ [Inl N] ⋅ R ∧ (N, rhs) ∈ set G ∧ (∀A B. rhs = Branch A B ⟶ t = L ⋅ [Inl A, Inl B] ⋅ R) ∧ (∀x. rhs = Leaf x ⟶ t = L ⋅ [Inr x] ⋅ R)" (is"∃L N R rhs. ?P L N R rhs") by(rule DSTEP_D) thenobtain L N R rhs where"?P L N R rhs"by blast with b show ?thesis by(case_tac rhs, clarsimp, force) qed qed with A and B show ?thesis by simp qed
subsection"Properties of generated languages"
lemma Lang_no_Nil : "w ∈ Lang G S ==> w ≠ []" by(simp add: Lang_def, drule trancl_into_rtrancl, drule DSTEP_star_mono, force)
lemma Lang_term : "w ∈ Lang G S ==> ∀x ∈ set w. ∃N. (N, Leaf x) ∈ set G" by(clarsimp simp add: Lang_def, drule DSTEP_trancl_term,
simp, erule imageI, assumption)
lemma Lang_eq1 : "([x] ∈ Lang G S) = ((S, Leaf x) ∈ set G)" proof(simp add: Lang_def, rule iffI, subst (asm) trancl_unfold_left, clarsimp) fix t assume a: "[Inl S] -G→ t" assume b: "t -G→* [Inr x]" note DSTEP_star_mono[OF b, simplified] hence c: "length t ≤ 1"by simp have"∃z. t = [z]" proof(cases t) assume"t = []" with b have d: "[] -G→* [Inr x]"by simp have"∧s. ([], s) ∈ (DSTEP G)*==> s = []" by(erule rtrancl_induct, simp_all, drule DSTEP_D, clarsimp) note this[OF d] thus ?thesis by simp next fix z zs assume"t = z#zs" with c show ?thesis by force qed with a have"∃z. (S, Leaf z) ∈ set G ∧ t = [Inr z]" by(clarsimp simp add: DSTEP_def, simp split: RHS.split_asm, case_tac l, simp_all) with b show"(S, Leaf x) ∈ set G" proof(clarsimp) fix z assume c: "(S, Leaf z) ∈ set G" assume"[Inr z] -G→* [Inr x]" hence"([Inr z], [Inr x]) ∈ ((DSTEP G)+)="by simp hence"[Inr z] = [Inr x] ∨ [Inr z] -G→+ [Inr x]"by force hence"x = z" proof assume"[Inr z] = [Inr x]"thus ?thesis by simp next assume"[Inr z] -G→+ [Inr x]" hence"∃u. [Inr z] -G→ u ∧ u -G→* [Inr x]"by(subst (asm) trancl_unfold_left, force) thenobtain u where"[Inr z] -G→ u"by blast thus ?thesis by(clarsimp simp add: DSTEP_def, case_tac l, simp_all) qed with c show ?thesis by simp qed next assume a: "(S, Leaf x) ∈ set G" show"[Inl S] -G→+ [Inr x]" by(rule r_into_trancl, simp add: DSTEP_def, rule_tac x="[]"in exI,
rule_tac x="S"in exI, rule_tac x="[]"in exI, simp, rule_tac x="Leaf x"in exI,
simp add: a) qed
theorem Lang_eq2 : "(w ∈ Lang G S ∧ 1 < length w) = (∃A B. (S, Branch A B) ∈ set G ∧ (∃l r. w = l ⋅ r ∧ l ∈ Lang G A ∧ r ∈ Lang G B))"
(is"?L = ?R") proof(rule iffI, clarify, subst (asm) Lang_def, simp, subst (asm) trancl_unfold_left, clarsimp) have map_Inr_split : "∧xs. ∀zs w. map Inr w = xs ⋅ zs ⟶ (∃u v. w = u ⋅ v ∧ xs = map Inr u ∧ zs = map Inr v)" by(induct_tac xs, simp, force) fix t assume a: "Suc 0 < length w" assume b: "[Inl S] -G→ t" assume c: "t -G→* map Inr w" from b have"∃A B. (S, Branch A B) ∈ set G ∧ t = [Inl A, Inl B]" proof(simp add: DSTEP_def, clarify, case_tac l, simp_all, simp split: RHS.split_asm, clarify) fix x assume"t = [Inr x]" with c have d: "[Inr x] -G→* map Inr w"by simp have"∧x s. [Inr x] -G→* s ==> s = [Inr x]" by(erule rtrancl_induct, simp_all, drule DSTEP_D, clarsimp, case_tac L, simp_all) note this[OF d] hence"w = [x]"by(case_tac w, simp_all) with a show"False"by simp qed thenobtain A B where d: "(S, Branch A B) ∈ set G ∧ t = [Inl A, Inl B]"by blast with c have e: "[Inl A] ⋅ [Inl B] -G→* map Inr w"by simp note DSTEP_star_comp1[OF e] thenobtain l' r' where e: "[Inl A] -G→* l' ∧ [Inl B] -G→* r' ∧ map Inr w = l' ⋅ r'"by blast note map_Inr_split[rule_format, OF e[THEN conjunct2, THEN conjunct2]] thenobtain u v where f: "w = u ⋅ v ∧ l' = map Inr u ∧ r' = map Inr v"by blast with e have g: "[Inl A] -G→* map Inr u ∧ [Inl B] -G→* map Inr v"by simp show"?R" by(rule_tac x=A in exI, rule_tac x=B in exI, simp add: d,
rule_tac x=u in exI, rule_tac x=v in exI, simp add: f,
(subst Lang_rtrancl_eq)+, rule g) next assume"?R" thenobtain A B l r where a: "(S, Branch A B) ∈ set G ∧ w = l ⋅ r ∧ l ∈ Lang G A ∧ r ∈ Lang G B"by blast have"[Inl A] ⋅ [Inl B] -G→* map Inr l ⋅ map Inr r" by(rule DSTEP_star_comp2, subst Lang_rtrancl_eq[THEN sym], simp add: a,
subst Lang_rtrancl_eq[THEN sym], simp add: a) hence b: "[Inl A] ⋅ [Inl B] -G→* map Inr w"by(simp add: a) have c: "w ∈ Lang G S" by(simp add: Lang_def, subst trancl_unfold_left, rule_tac b="[Inl A] ⋅ [Inl B]"in relcompI,
simp add: DSTEP_def, rule_tac x="[]"in exI, rule_tac x="S"in exI, rule_tac x="[]"in exI,
simp, rule_tac x="Branch A B"in exI, simp add: a[THEN conjunct1], rule b) thus"?L" proof show"1 < length w" proof(simp add: a, rule ccontr, drule leI) assume"length l + length r ≤ Suc 0" hence"l = [] ∨ r = []"by(case_tac l, simp_all) thus"False" proof assume"l = []" with a have"[] ∈ Lang G A"by simp note Lang_no_Nil[OF this] thus ?thesis by simp next assume"r = []" with a have"[] ∈ Lang G B"by simp note Lang_no_Nil[OF this] thus ?thesis by simp qed qed qed qed
section"Abstract specification of CYK"
text"A subword of a word $w$, starting at the position $i$ (first element is at the position $0$) and having the length $j$, is defined as follows." definition"subword w i j = take j (drop i w)"
text"Thus, to any subword of the given word $w$ CYK assigns all non-terminals from which this subword is derivable by the grammar $G$." definition"CYK G w i j = {S. subword w i j ∈ Lang G S}"
subsection‹Properties of @{term "subword"}›
lemma subword_length : "i + j ≤ length w ==> length(subword w i j) = j" by(simp add: subword_def)
lemma subword_nth1 : "i + j ≤ length w ==> k < j ==> (subword w i j)!k = w!(i + k)" by(simp add: subword_def)
lemma subword_nth2 : assumes A: "i + 1 ≤ length w" shows"subword w i 1 = [w!i]" proof - note subword_length[OF A] hence"∃x. subword w i 1 = [x]"by(case_tac "subword w i 1", simp_all) thenobtain x where a:"subword w i 1 = [x]"by blast note subword_nth1[OF A, where k="(0 :: nat)", simplified] with a have"x = w!i"by simp with a show ?thesis by simp qed
lemma take_split[rule_format] : "∀n m. n ≤ length xs ⟶ n ≤ m ⟶ take n xs ⋅ take (m - n) (drop n xs) = take m xs" by(induct_tac xs, clarsimp+, case_tac n, simp_all, case_tac m, simp_all)
lemma subword_split : "i + j ≤ length w ==> 0 < k ==> k < j ==> subword w i j = subword w i k ⋅ subword w (i + k) (j - k)" by(simp add: subword_def, subst take_split[where n=k, THEN sym], simp_all,
rule_tac f="λx. take (j - k) (drop x w)"in arg_cong, simp)
lemma subword_split2 : assumes A: "subword w i j = l ⋅ r" and B: "i + j ≤ length w" and C: "0 < length l" and D: "0 < length r" shows"l = subword w i (length l) ∧ r = subword w (i + length l) (j - length l)" proof - have a: "length(subword w i j) = j"by(rule subword_length, rule B) note arg_cong[where f=length, OF A] with a and D have b: "length l < j"by force with B have c: "i + length l ≤ length w"by force have"subword w i j = subword w i (length l) ⋅ subword w (i + length l) (j - length l)" by(rule subword_split, rule B, rule C, rule b) with A have d: "l ⋅ r = subword w i (length l) ⋅ subword w (i + length l) (j - length l)"by simp show ?thesis by(rule append_eq_append_conv[THEN iffD1], subst subword_length, rule c, simp, rule d) qed
subsection‹Properties of @{term "CYK"}›
lemma CYK_Lang : "(S ∈ CYK G w 0 (length w)) = (w ∈ Lang G S)" by(simp add: CYK_def subword_self)
lemma CYK_eq1 : "i + 1 ≤ length w ==> CYK G w i 1 = {S. (S, Leaf (w!i)) ∈ set G}" by(simp add: CYK_def, subst subword_nth2[simplified], assumption,
subst Lang_eq1, rule refl)
theorem CYK_eq2 : assumes A: "i + j ≤ length w" and B: "1 < j" shows"CYK G w i j = {X | X A B k. (X, Branch A B) ∈ set G ∧ A ∈ CYK G w i k ∧ B ∈ CYK G w (i + k) (j - k) ∧ 1 ≤ k ∧ k < j}" proof(rule set_eqI, rule iffI, simp_all add: CYK_def) fix X assume a: "subword w i j ∈ Lang G X" show"∃A B. (X, Branch A B) ∈ set G ∧ (∃k. subword w i k ∈ Lang G A ∧ subword w (i + k) (j - k) ∈ Lang G B ∧ Suc 0 ≤ k ∧ k < j)" proof - have b: "1 < length(subword w i j)"by(subst subword_length, rule A, rule B) note Lang_eq2[THEN iffD1, OF conjI, OF a b] thenobtain A B l r where c: "(X, Branch A B) ∈ set G ∧ subword w i j = l ⋅ r ∧ l ∈ Lang G A ∧ r ∈ Lang G B"by blast note Lang_no_Nil[OF c[THEN conjunct2, THEN conjunct2, THEN conjunct1]] hence d: "0 < length l"by(case_tac l, simp_all) note Lang_no_Nil[OF c[THEN conjunct2, THEN conjunct2, THEN conjunct2]] hence e: "0 < length r"by(case_tac r, simp_all) note subword_split2[OF c[THEN conjunct2, THEN conjunct1], OF A, OF d, OF e] with c show ?thesis proof(rule_tac x=A in exI, rule_tac x=B in exI, simp,
rule_tac x="length l"in exI, simp) show"Suc 0 ≤ length l ∧ length l < j" (is"?A ∧ ?B") proof from d show"?A"by(case_tac l, simp_all) next note arg_cong[where f=length, OF c[THEN conjunct2, THEN conjunct1], THEN sym] alsohave"length(subword w i j) = j"by(rule subword_length, rule A) finallyhave"length l + length r = j"by simp with e show ?B by force qed qed qed next fix X assume"∃A B. (X, Branch A B) ∈ set G ∧ (∃k. subword w i k ∈ Lang G A ∧ subword w (i + k) (j - k) ∈ Lang G B ∧ Suc 0 ≤ k ∧ k < j)" thenobtain A B k where a: "(X, Branch A B) ∈ set G ∧ subword w i k ∈ Lang G A ∧ subword w (i + k) (j - k) ∈ Lang G B ∧ Suc 0 ≤ k ∧ k < j"by blast show"subword w i j ∈ Lang G X" proof(rule Lang_eq2[THEN iffD2, THEN conjunct1], rule_tac x=A in exI, rule_tac x=B in exI, simp add: a,
rule_tac x="subword w i k"in exI, rule_tac x="subword w (i + k) (j - k)"in exI, simp add: a,
rule subword_split, rule A) from a show"0 < k"by force next from a show"k < j"by simp qed qed
section"Implementation"
text"One of the particularly interesting features of CYK implementation is that it follows the principles of dynamic programming, constructing a table of solutions for sub-problems in the bottom-up style reusing already stored results."
subsection"Main cycle"
text"This is an auxiliary implementation of the membership test on lists." fun mem :: "'a ==> 'a list ==> bool" where "mem a [] = False" | "mem a (x#xs) = (x = a ∨ mem a xs)"
lemma mem[simp] : "mem x xs = (x ∈ set xs)" by(induct_tac xs, simp, force)
text"The purpose of the following is to collect non-terminals that appear on the lhs of a production such that the first non-terminal on its rhs appears in the first of two given lists and the second non-terminal -- in the second list." fun match_prods :: "('n, 't) CNG ==> 'n list ==> 'n list ==> 'n list" where"match_prods [] ls rs = []" | "match_prods ((X, Branch A B)#ps) ls rs = (if mem A ls ∧ mem B rs then X # match_prods ps ls rs else match_prods ps ls rs)" | "match_prods ((X, Leaf a)#ps) ls rs = match_prods ps ls rs"
lemma match_prods : "(X ∈ set(match_prods G ls rs)) = (∃A ∈ set ls. ∃B ∈ set rs. (X, Branch A B) ∈ set G)" by(induct_tac G, clarsimp+, rename_tac l r ps, case_tac r, force+)
text"The following function is the inner cycle of the algorithm. The parameters $i$ and $j$ identify a subword starting at $i$ with the length $j$, whereas $k$ is used to iterate through its splits (which are of course subwords as well) all having the length greater $0$ but less than $j$. The parameter $T$ represents a table containing CYK solutions for those splits." function inner :: "('n, 't) CNG ==> (nat × nat ==> 'n list) ==> nat ==> nat ==> nat==> 'n list" where"inner G T i k j = (if k < j then match_prods G (T(i, k)) (T(i + k, j - k)) @ inner G T i (k + 1) j else [])" by pat_completeness auto termination by(relation "measure(λ(a, b, c, d, e). e - d)", rule wf_measure, simp)
declare inner.simps[simp del]
lemma inner : "(X ∈ set(inner G T i k j)) = (∃l. k ≤ l ∧ l < j ∧ X ∈ set(match_prods G (T(i, l)) (T(i + l, j - l))))"
(is"?L G T i k j = ?R G T i k j") proof(induct_tac G T i k j rule: inner.induct) fix G T i k j assume a: "k < j ==> ?L G T i (k + 1) j = ?R G T i (k + 1) j" show"?L G T i k j = ?R G T i k j" proof(case_tac "k < j") assume b: "k < j" with a have c: "?L G T i (k + 1) j = ?R G T i (k + 1) j"by simp show ?thesis proof(subst inner.simps, simp add: b, rule iffI, erule disjE, rule_tac x=k in exI, simp add: b) assume"X ∈ set(inner G T i (Suc k) j)" with c have"?R G T i (k + 1) j"by simp thus"?R G T i k j"by(clarsimp, rule_tac x=l in exI, simp) next assume"?R G T i k j" thenobtain l where d: "k ≤ l ∧ l < j ∧ X ∈ set(match_prods G (T(i, l)) (T(i + l, j - l)))"by blast show"X ∈ set(match_prods G (T(i, k)) (T(i + k, j - k))) ∨ ?L G T i (Suc k) j" proof(case_tac "Suc k ≤ l", rule disjI2, subst c[simplified], rule_tac x=l in exI, simp add: d,
rule disjI1) assume"¬ Suc k ≤ l" with d have"l = k"by force with d show"X ∈ set(match_prods G (T(i, k)) (T(i + k, j - k)))"by simp qed qed next assume"¬ k < j" thus ?thesis by(subst inner.simps, simp) qed qed
text‹Now the main part of the algorithm just iterates through all subwords up to the given length $len$,
calls @{term "inner"} on these, and stores the results in the table $T$. The length $j$ is supposed to
be greater than $1$ -- the subwords of length $1$ will be handled in the initialisation phase below.› function main :: "('n, 't) CNG ==> (nat × nat ==> 'n list) ==> nat ==> nat ==> nat ==> (nat × nat ==> 'n list)" where"main G T len i j = (let T' = T((i, j) := inner G T i 1 j) in if i + j < len then main G T' len (i + 1) j else if j < len then main G T' len 0 (j + 1) else T')" by pat_completeness auto termination by(relation "inv_image (less_than <*lex*> less_than) (λ(a, b, c, d, e). (c - e, c - (d + e)))", rule wf_inv_image, rule wf_lex_prod, (rule wf_less_than)+, simp_all)
declare main.simps[simp del]
lemma main : assumes"1 < j" and"i + j ≤ length w" and"∧i' j'. j' < j ==> 1 ≤ j' ==> i' + j' ≤ length w ==> set(T(i', j')) = CYK G w i' j'" and"∧i'. i' < i ==> i' + j ≤ length w ==> set(T(i', j)) = CYK G w i' j" and"1 ≤ j'" and"i' + j' ≤ length w" shows"set((main G T (length w) i j)(i', j')) = CYK G w i' j'" proof - have"∀len T' w. main G T len i j = T' ⟶ length w = len ⟶ 1 < j ⟶ i + j ≤ len ⟶ (∀j' < j. ∀i'. 1 ≤ j' ⟶ i' + j' ≤ len ⟶ set(T(i', j')) = CYK G w i' j') ⟶ (∀i' < i. i' + j ≤ len ⟶ set(T(i', j)) = CYK G w i' j) ⟶ (∀j' ≥ 1. ∀i'. i' + j' ≤ len ⟶ set(T'(i', j')) = CYK G w i' j')" (is"∀len. ?P G T len i j") proof(rule allI, induct_tac G T len i j rule: main.induct, (drule meta_spec, drule meta_mp, rule refl)+, clarify) fix G T i j i' j' fix w :: "'a list" assume a: "i + j < length w ==> ?P G (T((i, j) := inner G T i 1 j)) (length w) (i + 1) j" assume b: "¬ i + j < length w ==> j < length w ==> ?P G (T((i, j) := inner G T i 1 j)) (length w) 0 (j + 1)" assume c: "1 < j" assume d: "i + j ≤ length w" assume e: "(1::nat) ≤ j'" assume f: "i' + j' ≤ length w" assume g: "∀j' < j. ∀i'. 1 ≤ j' ⟶ i' + j' ≤ length w ⟶ set(T(i', j')) = CYK G w i' j'" assume h: "∀i' < i. i' + j ≤ length w ⟶ set(T(i', j)) = CYK G w i' j"
have inner: "set (inner G T i (Suc 0) j) = CYK G w i j" proof(rule set_eqI, subst inner, subst match_prods, subst CYK_eq2, rule d, rule c, simp) fix X show"(∃l≥Suc 0. l < j ∧ (∃A ∈ set(T(i, l)). ∃B ∈ set(T(i + l, j - l)). (X, Branch A B) ∈ set G)) = (∃A B. (X, Branch A B) ∈ set G ∧ (∃k. A ∈ CYK G w i k ∧ B ∈ CYK G w (i + k) (j - k) ∧ Suc 0 ≤ k ∧ k < j))" (is"?L = ?R") proof assume"?L" thus"?R" proof(clarsimp, rule_tac x=A in exI, rule_tac x=B in exI, simp, rule_tac x=l in exI, simp) fix l A B assume i: "Suc 0 ≤ l" assume j: "l < j" assume k: "A ∈ set(T(i, l))" assume l: "B ∈ set(T(i + l, j - l))" note g[rule_format, where i'=i and j'=l] with d i j have A: "set(T(i, l)) = CYK G w i l"by force note g[rule_format, where i'="i + l"and j'="j - l"] with d i j have"set(T(i + l, j - l)) = CYK G w (i + l) (j - l)"by force with k l A show"A ∈ CYK G w i l ∧ B ∈ CYK G w (i + l) (j - l)"by simp qed next assume"?R" thus"?L" proof(clarsimp, rule_tac x=k in exI, simp) fix A B k assume i: "Suc 0 ≤ k" assume j: "k < j" assume k: "A ∈ CYK G w i k" assume l: "B ∈ CYK G w (i + k) (j - k)" assume m: "(X, Branch A B) ∈ set G" note g[rule_format, where i'=i and j'=k] with d i j have A: "CYK G w i k = set(T(i, k))"by force note g[rule_format, where i'="i + k"and j'="j - k"] with d i j have"CYK G w (i + k) (j - k) = set(T(i + k, j - k))"by force with k l A have"A ∈ set(T(i, k)) ∧ B ∈ set(T(i + k, j - k))"by simp with m show"∃A ∈ set(T(i, k)). ∃B ∈ set(T(i + k, j - k)). (X, Branch A B) ∈ set G"by force qed qed qed(* inner *)
show"set((main G T (length w) i j)(i', j')) = CYK G w i' j'" proof(case_tac "i + j = length w") assume i: "i + j = length w" show ?thesis proof(case_tac "j < length w") assume j: "j < length w" show ?thesis proof(subst main.simps, simp add: Let_def i j,
rule b[rule_format, where w=w and i'=i' and j'=j', OF _ _ refl, simplified],
simp_all add: inner) from i show"¬ i + j < length w"by simp next from c show"0 < j"by simp next from j show"Suc j ≤ length w"by simp next from e show"Suc 0 ≤ j'"by simp next from f show"i' + j' ≤ length w"by assumption next fix i'' j'' assume k: "j'' < Suc j" assume l: "Suc 0 ≤ j''" assume m: "i'' + j'' ≤ length w" show"(i'' = i ⟶ j'' ≠ j) ⟶ set(T(i'',j'')) = CYK G w i'' j''" proof(case_tac "j'' = j", simp_all, clarify) assume n: "j'' = j" assume"i'' ≠ i" with i m n have"i'' < i"by simp with n m h show"set(T(i'', j)) = CYK G w i'' j"by simp next assume"j'' ≠ j" with k have"j'' < j"by simp with l m g show"set(T(i'', j'')) = CYK G w i'' j''"by simp qed qed next assume"¬ j < length w" with i have j: "i = 0 ∧ j = length w"by simp show ?thesis proof(subst main.simps, simp add: Let_def j, intro conjI, clarify) from j and inner show"set (inner G T 0 (Suc 0) (length w)) = CYK G w 0 (length w)"bysimp next show"0 < i' ⟶ set(T(i', j')) = CYK G w i' j'" proof assume"0 < i'" with j and f have"j' < j"by simp with e g f show"set(T(i', j')) = CYK G w i' j'"by simp qed next show"j' ≠ length w ⟶ set(T(i', j')) = CYK G w i' j'" proof assume"j' ≠ length w " with j and f have"j' < j"by simp with e g f show"set(T(i', j')) = CYK G w i' j'"by simp qed qed qed next assume"i + j ≠ length w" with d have i: "i + j < length w"by simp show ?thesis proof(subst main.simps, simp add: Let_def i,
rule a[rule_format, where w=w and i'=i' and j'=j', OF i, OF refl, simplified]) from c show"Suc 0 < j"by simp next from i show"Suc(i + j) ≤ length w"by simp next from e show"Suc 0 ≤ j'"by simp next from f show"i' + j' ≤ length w"by assumption next fix i'' j'' assume"j'' < j" and"Suc 0 ≤ j''" and"i'' + j'' ≤ length w" with g show"set(T(i'', j'')) = CYK G w i'' j''"by simp next fix i'' assume j: "i'' < Suc i" show"set(if i'' = i then inner G T i (Suc 0) j else T(i'', j)) = CYK G w i'' j" proof(simp split: if_split, rule conjI, clarify, rule inner, clarify) assume"i'' ≠ i" with j have"i'' < i"by simp with d h show"set(T(i'', j)) = CYK G w i'' j"by simp qed qed qed qed with assms show ?thesis by force qed
subsection"Initialisation phase"
text‹Similarly to @{term "match_prods"} above, here we collect non-terminals from which
the given terminal symbol can be derived.› fun init_match :: "('n, 't) CNG ==> 't ==> 'n list" where"init_match [] t = []" | "init_match ((X, Branch A B)#ps) t = init_match ps t" | "init_match ((X, Leaf a)#ps) t = (if a = t then X # init_match ps t else init_match ps t)"
lemma init_match : "(X ∈ set(init_match G a)) = ((X, Leaf a) ∈ set G)" by(induct_tac G a rule: init_match.induct, simp_all)
text"Representing the empty table." definition"emptyT = (λ(i, j). [])"
text"The following function initialises the empty table for subwords of length $1$, i.e. each symbol occurring in the given word." fun init' :: "('n, 't) CNG ==> 't list ==> nat ==> nat × nat ==> 'n list" where"init' G [] k = emptyT" | "init' G (t#ts) k = (init' G ts (k + 1))((k, 1) := init_match G t)"
lemma init' : assumes"i + 1 ≤ length w" shows"set(init' G w 0 (i, 1)) = CYK G w i 1" proof - have"∀i. Suc i ≤ length w ⟶ (∀k. set(init' G w k (k + i, Suc 0)) = CYK G w i (Suc 0))" (is"∀i. ?P i w ⟶ (∀k. ?Q i k w)") proof(induct_tac w, clarsimp+, rule conjI, clarsimp, rule set_eqI, subst init_match) fix x w S show"((S, Leaf x) ∈ set G) = (S ∈ CYK G (x#w) 0 (Suc 0))"by(subst CYK_eq1[simplified], simp_all) next fix x w i assume a: "∀i. ?P i w ⟶ (∀k. ?Q i k w)" assume b: "i ≤ length w" show"0 < i ⟶ (∀k. set(init' G w (Suc k) (k + i, Suc 0)) = CYK G (x#w) i (Suc 0))" proof(clarify, case_tac i, simp_all, subst CYK_eq1[simplified], simp, erule subst, rule b, simp) fix k j assume c: "i = Suc j" note a[rule_format, where i=j and k="Suc k"] with b and c have"set(init' G w (Suc k) (Suc k + j, Suc 0)) = CYK G w j (Suc 0)"by simp alsowith b and c have"... = {S. (S, Leaf (w ! j)) ∈ set G}"by(subst CYK_eq1[simplified], simp_all) finallyshow"set(init' G w (Suc k) (Suc (k + j), Suc 0)) = {S. (S, Leaf (w ! j)) ∈ set G}"by simp qed qed with assms have"∀k. ?Q i k w"by simp note this[rule_format, where k=0] thus ?thesis by simp qed
text‹The next version of initialization refines @{term "init'"} in that
it takes additional account of the cases when the given word is
empty or contains a terminal symbol that does not have any matching
production (that is, @{term "init_match"} is an empty list). No initial
table is then needed as such words can immediately be rejected.› fun init :: "('n, 't) CNG ==> 't list ==> nat ==> (nat × nat ==> 'n list) option" where"init G [] k = None" | "init G [t] k = (case (init_match G t) of [] ==> None | xs ==> Some(emptyT((k, 1) := xs)))" | "init G (t#ts) k = (case (init_match G t) of [] ==> None | xs ==> (case (init G ts (k + 1)) of None ==> None | Some T ==> Some(T((k, 1) := xs))))"
lemma init1: ‹init' G w k = T›if‹init G w k = Some T› using that by (induction G w k arbitrary: T rule: init.induct)
(simp_all split: list.splits option.splits)
lemma init2 : "(init G w k = None) = (w = [] ∨ (∃a ∈ set w. init_match G a = []))" by(induct_tac G w k rule: init.induct, simp, simp split: list.split,
simp split: list.split option.split, force)
subsection‹The overall procedure›
definition"cyk G S w = (case init G w 0 of None ==> False | Some T ==> let len = length w in if len = 1 then mem S (T(0, 1)) else let T' = main G T len 0 2 in mem S (T'(0, len)))"
theorem cyk : "cyk G S w = (w ∈ Lang G S)" proof(simp add: cyk_def split: option.split, simp_all add: Let_def,
rule conjI, subst init2, simp, rule conjI) show"w = [] ⟶ [] ∉ Lang G S"by(clarify, drule Lang_no_Nil, clarify) next show"(∃x∈set w. init_match G x = []) ⟶ w ∉ Lang G S"by(clarify, drule Lang_term, subst (asm) init_match[THEN sym], force) next show"∀T. init G w 0 = Some T ⟶ ((length w = Suc 0 ⟶ S ∈ set(T(0, Suc 0))) ∧ (length w ≠ Suc 0 ⟶ S ∈ set(main G T (length w) 0 2 (0, length w)))) = (w ∈ Lang G S)" (is"∀T. ?P T ⟶ ?L T = ?R") proof clarify fix T assume a: "?P T" hence b: "init' G w 0 = T"by(rule init1) note init2[THEN iffD2, OF disjI1] have c: "w ≠ []"by(clarify, drule init2[where G=G and k=0, THEN iffD2, OF disjI1], simp add: a) have"?L (init' G w 0) = ?R" proof(case_tac "length w = 1", simp_all) assume d: "length w = Suc 0" show"S ∈ set(init' G w 0 (0, Suc 0)) = ?R" by(subst init'[simplified], simp add: d, subst CYK_Lang[THEN sym], simp add: d) next assume"length w ≠ Suc 0" with c have"1 < length w"by(case_tac w, simp_all) hence d: "Suc(Suc 0) ≤ length w"by simp show"(S ∈ set(main G (init' G w 0) (length w) 0 2 (0, length w))) = (w ∈ Lang G S)" proof(subst main, simp_all, rule d) fix i' j' assume"j' < 2"and"Suc 0 ≤ j'" hence e: "j' = 1"by simp assume"i' + j' ≤ length w" with e have f: "i' + 1 ≤ length w"by simp have"set(init' G w 0 (i', 1)) = CYK G w i' 1"by(rule init', rule f) with e show"set(init' G w 0 (i', j')) = CYK G w i' j'"by simp next from d show"Suc 0 ≤ length w"by simp next show"(S ∈ CYK G w 0 (length w)) = (w ∈ Lang G S)"by(rule CYK_Lang) qed qed with b show"?L T = ?R"by simp qed qed
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.