Site WWW de Laurent Bloch
Slogan du site

ISSN 2271-3905
Cliquez ici si vous voulez visiter mon autre site, orienté vers des sujets moins techniques.

Pour recevoir (au plus une fois par semaine) les nouveautés de ce site, indiquez ici votre adresse électronique :

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