Самый длинный общий префикс (LCP) списка строк

Во-первых, давайте начнем с чего-то родственного, но гораздо более простого.

:- set_prolog_flag(double_quotes, chars).  % "abc" = [a,b,c]

prefix_of(Prefix, List) :-
   append(Prefix, _, List).

commonprefix(Prefix, Lists) :-
   maplist(prefix_of(Prefix), Lists).

?- commonprefix(Prefix, ["interview", "integrate", "intermediate"]).
   Prefix = []
;  Prefix = "i"
;  Prefix = "in"
;  Prefix = "int"
;  Prefix = "inte"
;  false.

(См. этот ответ, как выполняется печать списков символов с двойными кавычками.)

Это та часть, которая довольно проста в Прологе. Единственным недостатком является то, что он дает нам не максимум, а все возможные решения, включая максимум. Обратите внимание, что не обязательно знать все строки, например:

?- commonprefix(Prefix, ["interview", "integrate", Xs]).
   Prefix = []
;  Prefix = "i", Xs = [i|_A]
;  Prefix = "in", Xs = [i, n|_A]
;  Prefix = "int", Xs = [i, n, t|_A]
;  Prefix = "inte", Xs = [i, n, t, e|_A]
;  false.

Таким образом, мы получаем в ответ частичное описание последнего неизвестного слова. А теперь представьте, позже мы понимаем, что Xs = "induce". Нет проблем для Пролога:

?- commonprefix(Prefix, ["interview", "integrate", Xs]), Xs = "induce".
   Prefix = [], Xs = "induce"
;  Prefix = "i", Xs = "induce"
;  Prefix = "in", Xs = "induce"
;  false.

На самом деле, не имеет значения, говорим ли мы об этом задним числом или непосредственно перед фактическим запросом:

?- Xs = "induce", commonprefix(Prefix, ["interview", "integrate", Xs]).
   Xs = "induce", Prefix = []
;  Xs = "induce", Prefix = "i"
;  Xs = "induce", Prefix = "in"
;  false.

Можем ли мы теперь исходя из этого сформулировать максимум? Обратите внимание, что это фактически требует некоторой формы дополнительного квантора, для которого у нас нет прямых положений в Прологе. По этой причине мы должны ограничить нас определенными случаями, которые, как мы знаем, будут безопасными. Проще всего было бы настаивать на том, чтобы список слов не содержал никаких переменных. Для этой цели я буду использовать iwhen/2.

maxprefix(Prefix, Lists) :-
   iwhen(ground(Lists), maxprefix_g(Prefix, Lists)).

maxprefix_g(Prefix, Lists_g) :-
   setof(N-IPrefix, ( commonprefix(IPrefix, Lists_g), length(IPrefix, N ) ), Ns),
   append(_,[N-Prefix], Ns).   % the longest one

Недостатком этого подхода является то, что мы получаем ошибки инстанцирования, если список слов не известен.

Обратите внимание, что мы сделали довольно много предположений (которые, я надеюсь, действительно верны). В частности, мы предполагали, что существует ровно один максимум. В данном случае это верно, но в целом может быть несколько независимых значений для Prefix. Также мы предполагали, что IPrefix всегда будет заземлен. Мы могли бы проверить это тоже, просто чтобы быть уверенным. В качестве альтернативы:

maxprefix_g(Prefix, Lists_g) :-
   setof(N, IPrefix^ ( commonprefix(IPrefix, Lists_g), length(IPrefix, N ) ), Ns),
   append(_,[N], Ns),
   length(Prefix, N),
   commonprefix(Prefix, Lists_g).

Здесь префикс не обязательно должен быть одним префиксом (как в нашей ситуации).

Однако лучше всего будет более чистая версия, в которой вообще не нужно прибегать к ошибкам инстанцирования.

Вот очищенный вариант кода, предложенный (и впоследствии отозванный) @CapelliC:

:- set_prolog_flag(double_quotes, chars).

:- use_module(library(reif)).

lists_lcp([], []).
lists_lcp([Es|Ess], Ls) :-
   if_((maplist_t(list_first_rest_t, [Es|Ess], [X|Xs], Ess0),
        maplist_t(=(X), Xs))
       , (Ls = [X|Ls0], lists_lcp(Ess0, Ls0))
       , Ls = []).

list_first_rest_t([], _, _, false).
list_first_rest_t([X|Xs], X, Xs, true).

Над мета-предикат maplist_t/3 находится вариант maplist/2, который работает с овеществлением равенства/неравенства терминов,maplist_t/5 точно такой же, но с более высокой арностью:

maplist_t(P_2, Xs, T) :-
   i_maplist_t(Xs, P_2, T).

i_maplist_t([], _P_2, true).
i_maplist_t([X|Xs], P_2, T) :-
   if_(call(P_2, X), i_maplist_t(Xs, P_2, T), T = false).

maplist_t(P_4, Xs, Ys, Zs, T) :-
   i_maplist_t(Xs, Ys, Zs, P_4, T).

i_maplist_t([], [], [], _P_4, true).
i_maplist_t([X|Xs], [Y|Ys], [Z|Zs], P_4, T) :-
   if_(call(P_4, X, Y, Z), i_maplist_t(Xs, Ys, Zs, P_4, T), T = false).

Сначала вот наземный запрос:

?- lists_lcp(["a","ab"], []).
false.                                % fails (as expected)

Вот запросы, представленные в прекрасном ответе @Fatalize.

?- lists_lcp(["interview",X,"intermediate"], "inte").
   X = [i,n,t,e]
;  X = [i,n,t,e,_A|_B], dif(_A,r)
;  false.

?- lists_lcp(["interview","integrate",X], Z).
   X = Z, Z = []
;  X = Z, Z = [i]
;  X = Z, Z = [i,n]
;  X = Z, Z = [i,n,t]
;  X = Z, Z = [i,n,t,e]
;  X = [i,n,t,e,_A|_B], Z = [i,n,t,e]
;  X = [i,n,t,_A|_B]  , Z = [i,n,t]  , dif(_A,e)
;  X = [i,n,_A|_B]    , Z = [i,n]    , dif(_A,t)
;  X = [i,_A|_B]      , Z = [i]      , dif(_A,n)
;  X = [_A|_B]        , Z = []       , dif(_A,i).

?- lists_lcp([X,Y], "abc").
   X = [a,b,c]      , Y = [a,b,c|_A]
;  X = [a,b,c,_A|_B], Y = [a,b,c]
;  X = [a,b,c,_A|_B], Y = [a,b,c,_C|_D], dif(_A,_C)
;  false.

?- lists_lcp(L, "abc").
   L = [[a,b,c]]
;  L = [[a,b,c],[a,b,c|_A]]
;  L = [[a,b,c,_A|_B],[a,b,c]]
;  L = [[a,b,c,_A|_B],[a,b,c,_C|_D]], dif(_A,_C)
;  L = [[a,b,c],[a,b,c|_A],[a,b,c|_B]]
;  L = [[a,b,c,_A|_B],[a,b,c],[a,b,c|_C]]
;  L = [[a,b,c,_A|_B],[a,b,c,_C|_D],[a,b,c]]
;  L = [[a,b,c,_A|_B],[a,b,c,_C|_D],[a,b,c,_E|_F]], dif(_A,_E) 
…

Наконец, вот запрос, показывающий улучшенный детерминизм:

?- lists_lcp(["interview","integrate","intermediate"], Z).
Z = [i,n,t,e].                              % succeeds deterministically

Вот как бы я это реализовал:

:- set_prolog_flag(double_quotes, chars).

longest_common_prefix([], []).
longest_common_prefix([H], H).
longest_common_prefix([H1,H2|T], P) :-
    maplist(append(P), L, [H1,H2|T]),
    (   one_empty_head(L)
    ;   maplist(head, L, Hs),
        not_all_equal(Hs)
    ).

one_empty_head([[]|_]).
one_empty_head([[_|_]|T]) :-
    one_empty_head(T).

head([H|_], H).

not_all_equal([E|Es]) :-
    some_dif(Es, E).

some_dif([X|Xs], E) :-
    if_(diffirst(X,E), true, some_dif(Xs,E)).

diffirst(X, Y, T) :-
    (   X == Y -> T = false
    ;   X \= Y -> T = true
    ;   T = true,  dif(X, Y)
    ;   T = false, X = Y
    ).

Реализация not_all_equal/1 взята из этого ответа @repeat (вы можете найти мою реализацию в редактировать историю).

Мы используем append и maplist, чтобы разделить строки в списке на префикс и суффикс, и где префикс одинаков для всех строк. Чтобы этот префикс был самым длинным, нам нужно указать, что первые символы по крайней мере двух суффиксов различны.

Вот почему мы используем head/2, one_empty_head/1 и not_all_equal/1. head/2 используется для получения первого символа строки; one_empty_head/1 используется, чтобы указать, что если один из суффиксов пуст, то автоматически это самый длинный префикс. not_all_equal/1 используется, чтобы затем проверить или указать, что по крайней мере два символа отличаются.

Примеры

?- longest_common_prefix(["interview", "integrate", "intermediate"], Z).
Z = [i, n, t, e] ;
false.

?- longest_common_prefix(["interview", X, "intermediate"], "inte").
X = [i, n, t, e] ;
X = [i, n, t, e, _156|_158],
dif(_156, r) ;
false.

?- longest_common_prefix(["interview", "integrate", X], Z).
X = Z, Z = [] ;
X = [_246|_248],
Z = [],
dif(_246, i) ;
X = Z, Z = [i] ;
X = [i, _260|_262],
Z = [i],
dif(_260, n) ;
X = Z, Z = [i, n] ;
X = [i, n, _272|_274],
Z = [i, n],
dif(_272, t) ;
X = Z, Z = [i, n, t] ;
X = [i, n, t, _284|_286],
Z = [i, n, t],
dif(_284, e) ;
X = Z, Z = [i, n, t, e] ;
X = [i, n, t, e, _216|_224],
Z = [i, n, t, e] ;
false.

?- longest_common_prefix([X,Y], "abc").
X = [a, b, c],
Y = [a, b, c|_60] ;
X = [a, b, c, _84|_86],
Y = [a, b, c] ;
X = [a, b, c, _218|_220],
Y = [a, b, c, _242|_244],
dif(_218, _242) ;
false.

?- longest_common_prefix(L, "abc").
L = [[a, b, c]] ;
L = [[a, b, c], [a, b, c|_88]] ;
L = [[a, b, c, _112|_114], [a, b, c]] ;
L = [[a, b, c, _248|_250], [a, b, c, _278|_280]],
dif(_248, _278) ;
L = [[a, b, c], [a, b, c|_76], [a, b, c|_100]] ;
L = [[a, b, c, _130|_132], [a, b, c], [a, b, c|_100]];
…

В этом предыдущем ответе представлена ​​реализация, основанная на if_/3.

:- use_module(library(reif)).

Вот несколько иной взгляд на это:

lists_lcp([], []).
lists_lcp([Es|Ess], Xs) :-
   foldl(list_list_lcp, Ess, Es, Xs).                % foldl/4

list_list_lcp([], _, []).
list_list_lcp([X|Xs], Ys0, Zs0) :-
   if_(list_first_rest_t(Ys0, Y, Ys)                 % if_/3
      , ( Zs0 = [X|Zs], list_list_lcp(Xs, Ys, Zs) )
      ,   Zs0 = []
      ).

list_first_rest_t([], _, _, false).
list_first_rest_t([X|Xs], Y, Xs, T) :-
   =(X, Y, T).                                       % =/3

Почти все запросы в моем предыдущем ответе дают одинаковые ответы, поэтому я не показываю их здесь.

lists_lcp([X,Y], "abc"), однако, больше не завершается универсально с новым кодом.

Простая версия:

:- set_prolog_flag(double_quotes, chars).
pref([],_,[]).
pref(_,[],[]).
pref([H|T1],[H|T2],[H|Tr]):-
    pref(T1,T2,Tr).
pref([H|_],[H|_],[]).
pref([H1|_],[H2|_],[]):-
    dif(H1,H2).

lcf([],[]).
lcf([W],R):-
    pref(W,W,R).
lcf([W1,W2|L],R):-
    pref(W1,W2,R),
    lcf([W2|L],R).

Примеры:

pref("interview","integrate",R).
R = [i, n, t, e] ;
R = [i, n, t] ;
R = [i, n] ;
R = [i] ;
R = [] ;
False.

lcf(["interview", "interrupt", "integrate", "intermediate"],R).
R = [i, n, t, e]

lcf(["interview", "interrupt", X, "intermediate"],R).
R = X, X = [i, n, t, e, r]

Недавно мне пришлось реализовать это для двух списков, и это код, который я придумал. Предполагается, что два входных списка достаточно конкретизированы.

longest_common_prefix([X|Xs], [X|Ys], [X|Common]) :- !,
    longest_common_prefix(Xs, Ys, Common).
longest_common_prefix(_, _, []).

Это легко распространяется на несколько списков:

lcs([], []).
lcs([L1|Ls], Prefix) :-
    foldl(longest_common_prefix, Ls, L1, Prefix).

Если вам не нравится использовать foldl:

lcs([], []).
lcs([L1|Ls], Prefix) :-
    lcs(Ls, L1, Prefix).

lcs([], Prefix, Prefix).
lcs([L1|Ls], Prefix0, Prefix) :-
    longest_common_prefix(L1, Prefix0, Prefix1),
    lcs(Ls, Prefix1, Prefix).