La lettre de Caml, numéro 4

Les sources des programmes Caml

recherche naïve d'un motif ; algorithme MP ; algorithme KMP ; algorithme BMH

Retour à la page générale de La lettre de Caml.

Recherche naîve d'un motif :

(* version non fonctionnelle *)
exception Échec and Réussite ;;

let position motif chaîne =
    let m = string_length motif
    and n = string_length chaîne
    and i = ref 0
    and k = ref 0
    in
    try while !i <= n - m do
            k := 0 ;
            while !k < m && motif.[!k] = chaîne.[!i + !k] do incr k done ;
            if !k = m then raise Réussite
            else incr i
        done ;
        raise Échec
    with Réussite -> !i ;;

(* version fonctionnelle *)
exception Échec ;;

let position motif chaîne =
    let m = string_length motif
    and n = string_length chaîne
    in
    let rec coïncide i j =
        motif.[j] = chaîne.[i]
            && (j = m-1 || coïncide (i+1) (j+1))
    in
    let rec teste i =
        if i > n-m then raise Échec
        else if coïncide i 0 then i
        else teste (i+1)
    in
    teste 0 ;;

Algorithme MP :

let calcule_bords motif =
    let m = string_length motif
    in
    let r = make_vect (1 + m) (-1)
    in
    let rec calcule j k =
        if k < 0 || motif.[j-1] = motif.[k] then 1 + k
        else calcule j r.(k)
    in
    for j = 1 to m do r.(j) <- calcule j r.(j-1) done ;
    r ;;

exception Échec ;;

let position motif chaîne =
    let p = string_length motif
    and n = string_length chaîne
    and i = ref 0
    and k = ref 0
    and r = calcule_bords motif
    in
    while !k < p && !i < n do
        if !k < 0 || chaîne.[!i] = motif.[!k] then (incr i ; incr k)
        else k := r.(!k)
    done ;
    if !k >= p then !i - p
    else raise Échec ;;

Algorithme KMP :

let calcule_bords motif =
    let m = string_length motif
    in
    let r = make_vect (1 + m) (-1)
    and rho = ref (-1)
    in
    for j = 1 to m do
        while !rho >= 0 && motif.[j-1] <> motif.[!rho] do 
        	rho := r.(!rho)
        done ;
        incr rho ;
        r.(j) <- if  j = m || motif.[j] <> motif.[!rho]
        		 then !rho
        		 else r.(!rho)
    done ;    
    r ;;

exception Échec ;;

let position motif chaîne =
    let p = string_length motif
    and n = string_length chaîne
    and i = ref 0
    and k = ref 0
    and r = calcule_bords motif
    in
    while !k < p && !i < n do
        if !k < 0 || chaîne.[!i] = motif.[!k] then (incr i ; incr k)
        else k := r.(!k)
    done ;
    if !k >= p then !i - p
    else raise Échec ;;

Algorithme BMH:

let decale_v1 motif c =
    let m = string_length motif
    in
    let r = ref m
    in
    for i = 0 to m - 2 do if motif.[i] = c then r := m - 1 - i done ;
    !r ;;

let decale_v2 motif =
    let table = ref []
    in
    function c ->
        try assoc c !table
        with _ ->
            let m = string_length motif
            in
            let r = ref m
            in
            for i = 0 to m - 2 do if motif.[i] = c then r := m - 1 - i done ;
            table := (c,!r) :: !table ;
            !r ;;

exception Échec ;;

let décale motif =
    let m = string_length motif
    in
    let d = make_vect 256 m
    in
    for i = 0 to m - 2 do d.(int_of_char motif.[i]) <- m - 1 - i done ;
    d ;;

let position motif =
    let d = décale motif
    and m = string_length motif
    in
    function chaîne ->
        let n = string_length chaîne
        in
        let i = ref (m - 1)
        and j = ref (m - 1)
        in
        while !i < n && !j >= 0 do
            if chaîne.[!i - m + 1 + !j] = motif.[!j] then decr j
            else
            begin
                i := !i + d.(int_of_char chaîne.[!i]) ;
                j := m - 1
            end
        done ;
        if !i >= n then raise Échec
        else !i - m + 1 ;;

Retour à la page générale de La lettre de Caml.