給定一個nxn
字母矩陣和一個單詞列表,程序應該找出單詞在矩陣中的所有外觀及其位置。Prolog - 在矩陣中找到單詞
他們可能會出現上下,左右和對角(在所有8個方向)。一個單詞可以出現任意次數(包括零),它們可以重疊(如單詞bad
和adult
),甚至可以是另一單詞的子集(如單詞bad
和ad
)。
給定一個nxn
字母矩陣和一個單詞列表,程序應該找出單詞在矩陣中的所有外觀及其位置。Prolog - 在矩陣中找到單詞
他們可能會出現上下,左右和對角(在所有8個方向)。一個單詞可以出現任意次數(包括零),它們可以重疊(如單詞bad
和adult
),甚至可以是另一單詞的子集(如單詞bad
和ad
)。
編輯這是一個完整的代碼(查找對角線中的單詞)。一個缺點:主要對角線的字被發現兩次。
% word(X) iff X is a word
word("foo").
word("bar").
word("baz").
% prefix(?A, +B) iff A is a prefix of B
prefix([], _).
prefix([A|B], [A|C]) :- prefix(B, C).
% sublist(?A, +B) iff A is a sublist of B
sublist(A, B) :- prefix(A, B).
sublist(A, [_|B]) :- sublist(A, B).
% reversed(?A, +B) iff A is reversed B
reversed(A, B) :- reversed(B, [], A).
reversed([A|B], C, D) :- reversed(B, [A|C], D).
reversed([], A, A).
% rowsreversed(?A, +B) iff matrix A is matrix B with reversed rows
rowsreversed([A|B], [C|D]) :- reversed(A, C), rowsreversed(B, D).
rowsreversed([], []).
% transposed(+A, ?B) iff matrix B is transposed matrix A
transposed(A, B) :- transposed(A, [], B).
transposed(M, X, X) :- empty(M), !.
transposed(M, A, X) :- columns(M, Hs, Ts), transposed(Ts, [Hs|A], X).
% empty(+A) iff A is empty list or a list of empty lists
empty([[]|A]) :- empty(A).
empty([]).
% columns(+M, ?Hs, ?Ts) iff Hs is the first column
% of matrix M and Ts is the rest of matrix M
columns([[Rh|Rt]|Rs], [Rh|Hs], [Rt|Ts]) :- columns(Rs, Hs, Ts).
columns([[]], [], []).
columns([], [], []).
% inmatrix(+M, ?W) iff word W is in the matrix M
inmatrix(M, W) :- inrows(M, W).
inmatrix(M, W) :- incolumns(M, W).
inmatrix(M, W) :- inleftdiagonals(M, W).
inmatrix(M, W) :- inrightdiagonals(M, W).
% inrows(+M, ?W) iff W or reversed W is in a row of M
inrows([R|_], W) :- word(W), sublist(W, R).
inrows([R|_], W) :- word(W), reversed(V, W), sublist(V, R).
inrows([_|Rs], W) :- inrows(Rs, W).
% incolumns(+M, ?W) iff W or reversed W is in a column of M
incolumns(M, W) :- transposed(M, N), inrows(N, W).
% inleftdiagonals(+M, ?W) iff W or reversed W is in a left diagonal of M
inleftdiagonals(M, W) :- inupperleftdiagonals(M, W).
inleftdiagonals(M, W) :- transposed(M, N), inupperleftdiagonals(N, W).
% inupperleftdiagonals(+M, ?W) iff W or reversed W is in an upper left diagonal of M
inupperleftdiagonals(M, W) :- upperdiags(M, N), inrows(N, W).
% upperdiags(+M, ?X) iff X is a list of upper diagonals of matrix M
upperdiags(M, X) :- upperdiags(M, [], Y), reversed(Z, Y), transposed(Z, X).
upperdiags([R|Rs], A, X) :- columns(Rs, _, T), upperdiags(T, [R|A], X).
upperdiags([], X, X).
% inrightdiagonals(+M, ?W) iff W or reversed W is in a right diagonal of M
inrightdiagonals(M, W) :- rowsreversed(N, M), inleftdiagonals(N, W).
抱歉輸入和輸出參數的順序不一致。現在已經很晚了,如果我現在嘗試交換它們,我相信我會製作一些列表。 – Bolo 2010-07-24 22:26:45
下面是水平和垂直的直鏈和反向查找的部分解決方案:
count_hits(Word, Matrix, Result):-
atom_chars(Word, Chars),
reverse(Chars, C2),
transpose_matrix(Matrix, M2),
findall(1, find_chars_in_matrix(Chars,Matrix), A),
findall(1, find_chars_in_matrix(Chars,M2), B),
findall(1, find_chars_in_matrix(C2,Matrix), C),
findall(1, find_chars_in_matrix(C2,M2), D),
length(A, X1),
length(B, X2),
length(C, X3),
length(D, X4),
Result is X1 + X2 + X3 + X4.
transpose_matrix([],[]).
transpose_matrix([[ULCorner|Header]|Body], [[ULCorner|NewHeader]|NewBody]) :-
collect_heads_and_tails(Body, NewHeader, Kernel),
collect_heads_and_tails(NewBody, Header, X2),
transpose_matrix(Kernel, X2).
collect_heads_and_tails([], [], []).
collect_heads_and_tails([[H|T]|TT], [H|X], [T|Y]):-collect_heads_and_tails(TT, X, Y).
find_chars_in_matrix(Chars, [H|_]):-
sublist(Chars, H).
find_chars_in_matrix(Chars, [_|T]):-
find_chars_in_matrix(Chars, T).
sublist(L, [_|T]) :- sublist(L, T).
sublist(A, B) :- prefix(A, B).
prefix([H|T], [H|T2]) :- prefix(T, T2).
prefix([], _).
% test data
matrix([[e,t,r,e],
[r,r,t,r],
[t,r,t,t],
[e,e,t,e]]).
go :- matrix(M), count_hits(etre, M, X), write(X).
:-go.
兩個弱點:(一)迴文字被發現兩次,和一個字母的單詞被發現四次 - 數學上合理的,但從常識的角度來看可能是不需要的。 (b)根本找不到對角線匹配,因爲您至少需要一個附加的計數參數才需要更多的遞歸。
完全披露:transpose_matrix/2被改編自this問題的美麗答案。這真是太神奇了,只有兩年的時間積累了大量的代碼...
我不會擔心「我的朋友」的事情。你的SO聲譽本身就說明你在這裏做出了很多貢獻。 – Greg 2010-07-24 18:44:28
@Greg哈曼你幾乎讓我的一天,謝謝! – 2010-07-24 18:59:15