(* Ed *) (* $Id: ed.ml,v 1.1 2003/01/12 15:33:00 berke Exp $ *) (* By Berke Durak *) let substcost = 2 and deletecost = 1 and insertcost = 1;; type oped = Rien | Suppression of int | Insertion of int * char | Modification of int * char;; let edit_distance s1 s2 = let m = String.length s1 and n = String.length s2 in let d = Array.init (m + 1) (fun i -> Array.make (n + 1) (-1)) and o = Array.init (m + 1) (fun i -> Array.make (n + 1) Rien) in let rec compute i j = if d.(i).(j) < 0 then let c = if i = 0 & j = 0 then begin o.(i).(j) <- Rien; 0 end else if i > 0 & j = 0 then begin o.(i).(j) <- Suppression i; deletecost end else if i = 0 & j > 0 then begin o.(i).(j) <- Insertion (j, s2.[j-1]); insertcost end else let op = ref Rien in let a = compute (i - 1) (j - 1) + if s1.[i - 1] = s2.[j - 1] then 0 else begin op := Modification ((i - 1), s2.[j - 1]); substcost end and b = compute (i - 1) (j) + insertcost and c = compute (i) (j - 1) + deletecost in let x = min a (min b c) in begin if b = x then op := Insertion ((j - 1), s2.[j - 1]) else if c = x then op := Suppression j; o.(i).(j) <- !op; x end in begin d.(i).(j) <- c; c end else d.(i).(j) in let r = compute m n in begin for i = 0 to m do begin for j = 0 to n do Printf.printf "%8s " (match o.(i).(j) with Rien -> "R" | Suppression i -> Printf.sprintf "S%d" i | Insertion (i, c) -> Printf.sprintf "I%d'%c'" i c | Modification (i, c) -> Printf.sprintf "M%d'%c'" i c); done; Printf.printf "\n" end done; (* now construct list of operations *) let rec col i j = if i = 0 & j = 0 then [] else let c = o.(i).(j) in let (ni,nj) = match c with Rien -> (i - 1, j - 1) | Suppression _ -> (i - 1, j) | Insertion (_, _) -> (i, j - 1) | Modification (_, _) -> (i - 1, j - 1) in c::(col ni nj) in col m n end;; let _ = ignore (edit_distance Sys.argv.(1) Sys.argv.(2))