OUnit.assert_equal ~pp_diff
允许精确打印预期/实际值差异,OUnitDiff
似乎为集合提供了不同的内容。
但字符串值是否有库存pp_diff
?理想情况下,最大努力将差异扩展到最接近的UTF-8序列边界。
即使是普通的前缀/后缀消除也会比没有更好。
答案 0 :(得分:3)
一个有趣的早晨挑战。
type move = Same | Add | Del
let edit_distance_matrix a b =
(* The usual dynamic edit distance algorithm, except we keep
a complete matrix of moves to be able to step back and see which
operations can turn [sa] into [sb].
This is not very efficient: we keep the complete matrices of
distances (costs) and moves. One doesn't need to know the move
for all cases of the matrix, only those that are on the "best"
path from begin to end; it would be better to recompute the moves
along the path after the facts. There probably also exists
a classic clever trick to apply the usual optimization of keeping
only two rows of the matrix at any time, and still compute the
best path along the way.
*)
let la, lb = String.length a, String.length b in
let m = Array.make_matrix (la + 1) (lb + 1) (-1) in
let moves = Array.make_matrix (la + 1) (lb + 1) Same in
m.(0).(0) <- 0;
for i = 1 to la do
m.(i).(0) <- i;
done;
for j = 1 to lb do
m.(0).(j) <- j;
done;
for i = 1 to la do
for j = 1 to lb do
let best, move =
if a.[i-1] = b.[j-1] then m.(i-1).(j-1), Same
else
if m.(i-1).(j) <= m.(i).(j-1)
then m.(i-1).(j) + 1, Del
else m.(i).(j-1) + 1, Add
in
m.(i).(j) <- best;
moves.(i).(j) <- move;
done;
done;
m, moves
let get m (i, j) = m.(i).(j)
let valid m pos =
fst pos >= 0 && snd pos >= 0
let previous (i, j) = function
| Same -> (i - 1, j - 1)
| Add -> (i, j - 1)
| Del -> (i - 1, j)
let cons _pos action = function
| (action', n) :: rest when action = action' ->
(action', n+1) :: rest
| list -> (action, 1) :: list
(** walk back along the "best path", taking notes of changes to make
as we go *)
let chunks moves =
let la = Array.length moves - 1 in
let lb = Array.length moves.(0) - 1 in
let start = (la, lb) in
let rec loop acc pos =
let move = get moves pos in
let next_pos = previous pos move in
(* if the next position is not valid,
the current move is a dummy move,
and it must not be returned as part of [acc] *)
if not (valid moves next_pos) then acc
else loop (cons pos move acc) next_pos
in loop [] start
(** print the list of changes in term of the original string
We skip large parts of the string that are common, keeping only
[context] characters on the sides to provide some context.
*)
let diff context sa sb =
let cost, moves = edit_distance_matrix sa sb in
let chks = chunks moves in
let buf = Buffer.create cost.(String.length sa).(String.length sb) in
let rec loop i j = function
| [] -> ()
| (Same, n) :: rest ->
if n <= 2 * context then
Buffer.add_substring buf sa i n
else begin
Buffer.add_substring buf sa i context;
Buffer.add_string buf "...\n...";
Buffer.add_substring buf sa (i + n - context) context;
end;
loop (i + n) (j + n) rest
| (Add, n) :: rest ->
begin
Buffer.add_string buf "[+";
Buffer.add_substring buf sb j n;
Buffer.add_char buf ']';
end;
loop i (j + n) rest
| (Del, n) :: rest ->
begin
Buffer.add_string buf "[-";
Buffer.add_substring buf sa i n;
Buffer.add_char buf ']';
end;
loop (i + n) j rest
in
begin
try loop 0 0 chks with _ -> ()
end;
Buffer.contents buf
测试:
# print_endline @@ diff 4
"le gros chat mange beaucoup de croquettes au saumon"
"le chat maigre mange peu de croquettes au saumon"
;;
le[- gros] chat[+ maigre] mange [+p][-b]e[-auco]u[-p] de ...
...umon