Boyer-Moore string search

From Rosetta Code
Revision as of 16:20, 5 July 2022 by Yong (talk | contribs) (Created page with " =={{header|Emacs Lisp}}== <lang lisp> ;; Compile the pattern to a right most position map (defun bm_compile_pattern (pattern) (let* ((R 256) (patLen (length pattern)) (rig...")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)

Emacs Lisp

<lang lisp>

Compile the pattern to a right most position map

(defun bm_compile_pattern (pattern)

 (let* ((R 256) (patLen (length pattern)) (rightMap (make-vector R -1)))
   (let ((j -1))
     (while (progn (setq j (1+ j)) (< j patLen))

;;(aset rightMap (-charCodeAt pattern j) j) ) ) (aset rightMap (elt pattern j) j) ) )

   rightMap
   )
 )
(print (bm_compile_pattern "abcdb"))

(defun bm_substring_search (pattern text)

 "Boyer-Moore string search"
 (let ((startPos 0)

(skip 0) (result nil) (rightMap nil) (result nil))

   (setq rightMap (bm_compile_pattern pattern))
   ;; Continue this loop when no result and not exceed the text length
   (while (and (not result) (<= (+ startPos skip (length pattern)) (length text)))
     (setq startPos (+ startPos skip))
     (let ((idx (length pattern)) (skip1 nil))

(while (and (not skip1) (>= (setq idx (1- idx)) 0))  ;; skip when the character at position idx is different (when (/= (elt pattern idx) (elt text (+ startPos idx)))  ;; looking up the right most position in pattern (let ((right (aref rightMap (elt text (+ startPos idx))))) (if (>= right 0) (progn (setq skip1 (- idx right)) (when (<= skip1 0) (setq skip1 1))) (progn (setq skip1 (1+ idx))) ) ) ) ) (if (or (not skip1) (<= skip1 0)) (progn (setq result startPos)) (progn (setq skip skip1)) ) )

     )
   result
   )
 )

</lang>