prologswi-prologcrossword

Fill a word in a row in Prolog


I want to solve a crossword puzzle in Prolog, but I am stuck with this for a long time. I am making the predicate fit_word(+Row, +Word, -UpdatedRow). Row is a row of a puzzle and a list. A '#', is an unfillable element. An underscore _, is a fillable element. A single lower case letter is a pre-filled square. Word is a list of alphabets.

If cells are only '#', '_', I could make it. However, I can't find a way with existing words.

I'd appreciate it if anyone could help. My current implementation and test suits are as below. Most of cases, there is only one solution but possibly multiple solutions. e.g. Row = [_, _, _, #, #, #, _, _, _], Word = [a, b, c]

fit_word(Row, Word, UpdatedRow) :-
    append(Prefix, Suffix, Row),
    append(Word, Remaining, Suffix),
    length(Prefix, PrefixLen),
    length(Remaining, RemainingLen),
    (PrefixLen = 0 ; append(Prefix, ['#'|_], Row)),
    (RemainingLen = 0 ; append(_, ['#'|_], Remaining)),
    can_fit(Word, Suffix),
    append(Prefix, Word, UpdatedRow).

% helper predicate to check if the word fits with the existing letters
can_fit([], []).
can_fit([H1|T1], [H2|T2]) :-
    (H1 = H2 ; var(H2)),
    can_fit(T1, T2).
% Test suits for fit_word
test(fit_word_success_3) :-
    fit_word([_, _, _], [a, b, c], L),
    assertion(L == [a, b, c]).

test(fit_word_success_4) :-
    fit_word([_, _, _, _], [a, b, c, d], L),
    assertion(L == [a, b, c, d]).

test(fit_word_success_with_wall) :-
    fit_word([#, _, _, _], [a, b, c], L),
    assertion(L == [#, a, b, c]).

test(fit_word_success_with_wall_exisiting_letter) :-
    fit_word([_, b, c, #], [a, b, c], L),
    assertion(L == [a, b, c, #]).

test(fit_word_success_with_wall_exisiting_word) :-
        fit_word([e, f, #, _, _, _], [a, b, c], L),
        assertion(L == [e, f, #, a, b, c]).

# false
test(fit_word_failure_length_mismatch) :-
    assertion((\+ fit_word([_, _, _, _], [a, b, c], L), L = _)).

# false
test(fit_word_failure_letter_mismatch) :-
    assertion((\+ fit_word([_, c, _], [a, b, c], L), L = _)).

Solution

  • A possible solution is:

    % fit(+Word, +Row): try to fit a word in some gap in the row
    
    fit(Word, Row) :-
        gaps(Row, Gaps),
        member(Word, Gaps).
    
    % gaps(+Row, -Gaps): find all gaps in a row
    
    gaps([], []).
    gaps([X|Xs], [Gap|Gaps]) :-
        strip([X|Xs], NewRow),
        gap(NewRow, Gap, Rest),
        gaps(Rest, Gaps).
    
    % strip(+Row, -NewRow): strip # from the beginning of the row
    
    strip([X|Xs], NewRow) :-
        (   X \== #
        ->  NewRow = [X|Xs]
        ;   strip(Xs, NewRow) ).
    
    % gap(+Row, -Gap, -Rest): find a gap in the beginning of the row
    
    gap([], [], []).
    gap([X|Xs], Gap, Rest):-
        (   X == #
        ->  Gap = [],
            Rest = Xs
        ;   Gap = [X|Gap0],
            gap(Xs, Gap0, Rest) ).
    

    Examples:

    ?- Row = [_,_,_], fit([a,b,c], Row).
    Row = [a, b, c].
    
    ?- Row = [#,_,_,_,#,_,_,_], fit([a,b,c], Row).
    Row = [#, a, b, c, #, _, _, _] ;
    Row = [#, _, _, _, #, a, b, c].
    
    ?- Row = [#,_,d,_,#,_,_,_], fit([a,b,c], Row).
    Row = [#, _, d, _, #, a, b, c].
    
    ?- Row = [#,_,d,_,#,_,_,c], fit([a,b,c], Row).
    Row = [#, _, d, _, #, a, b, c].
    
    ?- Row = [#,_,d,_,#,_,_,c], fit([a,b], Row).
    false.
    
    ?- Row = [#,_,d,_,#,_,_,c], fit([e,f,g], Row).
    false.
    

    EDIT

    If you really need to keep the variable Row unchanged, you can use the ISO predicate copy_term/2:

    fit(Word, Row, NewRow) :-
        copy_term(Row, NewRow),
        gaps(NewRow, Gaps),
        member(Word, Gaps).
    

    Example:

    ?- Row = [#,_,_,_,#,_,_,_], fit([a,b,c], Row, New).
    Row = [#, _, _, _, #, _, _, _],
    New = [#, a, b, c, #, _, _, _] ;
    Row = [#, _, _, _, #, _, _, _],
    New = [#, _, _, _, #, a, b, c].