Retour sur la recherche de mots dans un texte :
Knuth-Morris-Pratt en style récursif
Article mis en ligne le 13 mai 2008
dernière modification le 9 juin 2013

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.  
  4. (define (kmp:table Word)
  5.    (let* ((WordLength (string-length Word))
  6.           (Tpref (make-vector (+ WordLength 1) 0)) )
  7.       (vector-set! Tpref 0 -1)
  8.       (let loop ((i 0)
  9.                  (j -1)
  10.                  (c #a000))    ;;  null character
  11.          (if (>= i WordLength)
  12.              Tpref
  13.              (cond ((char=? c (string-ref Word i))
  14.                     (vector-set! Tpref (+ i 1) (+ j 1))
  15.                     (loop (+ i 1)
  16.                           (+ j 1)
  17.                           (string-ref Word (+ j 1))))
  18.                    ((> j 0)
  19.                     (let ((j2 (vector-ref Tpref j)))
  20.                        (loop i
  21.                              j2
  22.                              (string-ref Word j2))))
  23.                    (else
  24.                     (vector-set! Tpref (+ i 1) 0)
  25.                     (loop (+ i 1)
  26.                           0
  27.                           (string-ref Word 0)))) ) )))

Télécharger

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

Télécharger