Boyer-Moore string search: Difference between revisions
Emacs lisp support good suffix heuristic
SqrtNegInf (talk | contribs) m (→{{header|Perl}}: off-by-one) |
(Emacs lisp support good suffix heuristic) |
||
Line 13:
<syntaxhighlight lang="lisp">
(defun bm_compile_pattern (pattern)
"Compile the pattern to a right most position map"
Line 23 ⟶ 24:
)
)
;;
(defun bm_make_suffix_table (text)
(let ((suffix-table (make-vector (length text) -1)) (textLen (length text))
(suffix-found nil)
)
(cl-loop for pos from (1- textLen) downto 1 do
(setq suffix-found nil)
(cl-loop for ptn from (- textLen 2) downto 0 while (not suffix-found) do
(let ((start1 pos) (end1 (1- textLen))
(start2 (- ptn (- (1- textLen) pos))) (end2 ptn)
(matched 't)
)
(if (< start2 0) (setq start2 0))
(cl-loop for idx1 from end1 downto start1 and idx2 from end2 downto start2 while matched do
(if (/= (elt text idx1) (elt text idx2))
(setq matched nil))
)
(when matched
(aset suffix-table pos start2)
(setq suffix-found 't) )
)
)
)
suffix-table
)
)▼
;;
;;
(defun bm_substring_search (pattern text)
"Boyer-Moore string search"
Line 30 ⟶ 58:
(startPos 0)
(result nil)
(rightMap (bm_compile_pattern pattern
(suffixTable (bm_make_suffix_table pattern)))
;; Continue this loop when no result and not exceed the text length
(while (and (not result) (<= (+ startPos patLen) txtLen))
(let ((idx patLen)
(suffixSkip 0)
(badCharSkip 0)
(skip 0))
(while (and (= 0 skip) (<= 0 (setq idx (1- idx))))
(setq suffixSkip 0)
(setq badCharSkip 0)
;; skip when the character at position idx is different
(when (/= (elt pattern idx) (elt text (+ startPos idx)))
(when (< idx (1- (length pattern)))
(setq suffixSkip (aref suffixTable (1+ idx))) )
;; looking up the right most position in pattern
▲ (setq skip (max 1 (- idx (aref rightMap (elt text (+ startPos idx))))))
(setq skip (max 1 badCharSkip suffixSkip))
)
)
Line 52 ⟶ 89:
)
)
;;
(let ((pattern "alfalfa")
(full_text "Nearby farms grew a half acre of alfalfa on the dairy's behalf, with bales of all that alfalfa exchanged for milk."))
(bm_substring_search pattern full_text) )▼
▲ (bm_substring_search pattern full_text)
)
</syntaxhighlight>
Line 64 ⟶ 100:
<pre>33</pre>
=={{header|J}}==
{{trans|Emacs Lisp}}
| |||