Retour sur la recherche de mots dans un texte :

Knuth-Morris-Pratt en style récursif

mardi 13 mai 2008
popularité : 7%

Voici comme promis une version en style récursif du programme Knuth-Morris-Pratt. Ce type d’exercice est plein de pièges : si vous découvrez que je suis tombé dans l’un d’entre eux, je serais content que vous me le signaliez.

  1. (module kmp-table
  2.    (export (kmp:table Word)))
  3. (define (kmp:table Word)
  4.    (let* ((WordLength (string-length Word))
  5.           (Tpref (make-vector (+ WordLength 1) 0)) )
  6.       (vector-set! Tpref 0 -1)
  7.       (let loop ((i 0)
  8.                  (j -1)
  9.                  (c #a000))    ;;  null character
  10.          (if (>= i WordLength)
  11.              Tpref
  12.              (cond ((char=? c (string-ref Word i))
  13.                     (vector-set! Tpref (+ i 1) (+ j 1))
  14.                     (loop (+ i 1)
  15.                           (+ j 1)
  16.                           (string-ref Word (+ j 1))))
  17.                    ((> j 0)
  18.                     (let ((j2 (vector-ref Tpref j)))
  19.                        (loop i
  20.                              j2
  21.                              (string-ref Word j2))))
  22.                    (else
  23.                     (vector-set! Tpref (+ i 1) 0)
  24.                     (loop (+ i 1)
  25.                           0
  26.                           (string-ref Word 0)))) ) )))
  1. (module kmp
  2.    (main main)
  3.    (import kmp-table))
  4. (define (main args)
  5.    (print (kmp:KMP (cadr args) (caddr args))))
  6. (define (kmp:KMP Word Text)
  7.    (let ((Tpref (kmp:table Word))
  8.          (L-texte (string-length Text))
  9.          (LastCharPos (- (string-length Word) 1)))
  10.       (let loop ((m 0)         ;; match
  11.                  (i 0))        ;; index
  12.          (cond ((>= (+ m i) L-texte)
  13.                 -1)
  14.                ((char=? (string-ref Text (+ m i))
  15.                         (string-ref Word i))
  16.                 (if (= i LastCharPos)
  17.                     m
  18.                     (loop m (+ i 1))))
  19.                (else
  20.                 (loop
  21.                  (- (+ m i) (vector-ref Tpref i))
  22.                  (if (> i 0)
  23.                      (vector-ref Tpref i)
  24.                      i))) ) ) ))