Подтвердить что ты не робот

Оптимизация pathfinding в Constraint Logic Programming с помощью Prolog

Я работаю над небольшим прологовым приложением, чтобы решить головоломку Небоскребы и заборы.

Неразрешенная головоломка:

Skyscrapers in fences puzzle (unsolved)

Решенная головоломка:

Skyscrapers in fences puzzle (solved)

Когда я передаю уже разрешенные головоломки, это быстро, почти мгновенно, чтобы проверить его для меня. Когда я передаю программу действительно маленькие головоломки (например, 2x2, с измененными правилами), также довольно быстро найти решение.

Проблема заключается в вычислении головоломок с "родным" размером 6х6. Я оставил его в течение 5 или около часов, прежде чем прерывать его. Слишком много времени.

Я обнаружил, что самая длинная часть - это "заборы", а не "небоскребы". Запуск "небоскребов" по ​​отдельности приводит к быстрому решению.

Здесь мой алгоритм для заборов:

  • Вершины представлены числами, 0 означает, что путь не проходит через эту конкретную вершину, > 1 представляет этот порядок вершин в пути.
  • Ограничьте каждую ячейку, чтобы иметь соответствующее количество линий, окружающих ее.
    • Это означает, что две вершины связаны, если они имеют последовательные числа, например, 1 → 2, 2 → 1, 1 → Max, Max → 1 (Max - это номер для последняя вершина в пути, вычисленная через maximum/2)
  • Убедитесь, что каждая ненулевая вершина имеет по крайней мере две соседние вершины с последовательными номерами
  • Ограничить Max равным (BoardWidth + 1)^2 - NumberOfZeros (BoardWidth+1 - количество вершин вдоль края и NumberOfZeros вычисляется через count/4).
  • Используйте nvalue(Vertices, Max + 1), чтобы убедиться, что количество различных значений в Vertices равно Max (т.е. количество вершин в пути) плюс 1 (нулевые значения)
  • Найдите первую ячейку, содержащую 3, и запустите путь, чтобы начать и завершить там, для эффективности.

Что я могу сделать для повышения эффективности? Код приведен ниже для справки.

skyscrapersinfences.pro

:-use_module(library(clpfd)).
:-use_module(library(lists)).

:-ensure_loaded('utils.pro').
:-ensure_loaded('s1.pro').

print_row([]).

print_row([Head|Tail]) :-
    write(Head), write(' '),
    print_row(Tail).

print_board(Board, BoardWidth) :-
    print_board(Board, BoardWidth, 0).

print_board(_, BoardWidth, BoardWidth).

print_board(Board, BoardWidth, Index) :-
    make_segment(Board, BoardWidth, Index, row, Row),
    print_row(Row), nl,
    NewIndex is Index + 1,
    print_board(Board, BoardWidth, NewIndex).

print_boards([], _).
print_boards([Head|Tail], BoardWidth) :-
    print_board(Head, BoardWidth), nl,
    print_boards(Tail, BoardWidth).

get_board_element(Board, BoardWidth, X, Y, Element) :-
    Index is BoardWidth*Y + X,
    get_element_at(Board, Index, Element).

make_column([], _, _, []).

make_column(Board, BoardWidth, Index, Segment) :-
    get_element_at(Board, Index, Element),
    munch(Board, BoardWidth, MunchedBoard),
    make_column(MunchedBoard, BoardWidth, Index, ColumnTail),
    append([Element], ColumnTail, Segment).

make_segment(Board, BoardWidth, Index, row, Segment) :-
    NIrrelevantElements is BoardWidth*Index,
    munch(Board, NIrrelevantElements, MunchedBoard),
    select_n_elements(MunchedBoard, BoardWidth, Segment).

make_segment(Board, BoardWidth, Index, column, Segment) :-
    make_column(Board, BoardWidth, Index, Segment).

verify_segment(_, 0).
verify_segment(Segment, Value) :-
    verify_segment(Segment, Value, 0).

verify_segment([], 0, _).
verify_segment([Head|Tail], Value, Max) :-
    Head #> Max #<=> B, 
    Value #= M+B,
    maximum(NewMax, [Head, Max]),
    verify_segment(Tail, M, NewMax).

exactly(_, [], 0).
exactly(X, [Y|L], N) :-
    X #= Y #<=> B,
    N #= M  +B,
    exactly(X, L, M).

constrain_numbers(Vars) :-
    exactly(3, Vars, 1),
    exactly(2, Vars, 1),
    exactly(1, Vars, 1).

iteration_values(BoardWidth, Index, row, 0, column) :-
    Index is BoardWidth - 1.

iteration_values(BoardWidth, Index, Type, NewIndex, Type) :-
    \+((Type = row, Index is BoardWidth - 1)),
    NewIndex is Index + 1.

solve_skyscrapers(Board, BoardWidth) :-
    solve_skyscrapers(Board, BoardWidth, 0, row).

solve_skyscrapers(_, BoardWidth, BoardWidth, column).

solve_skyscrapers(Board, BoardWidth, Index, Type) :-
    make_segment(Board, BoardWidth, Index, Type, Segment),

    domain(Segment, 0, 3),
    constrain_numbers(Segment),

    observer(Type, Index, forward, ForwardObserver),
    verify_segment(Segment, ForwardObserver),

    observer(Type, Index, reverse, ReverseObserver),
    reverse(Segment, ReversedSegment),
    verify_segment(ReversedSegment, ReverseObserver),

    iteration_values(BoardWidth, Index, Type, NewIndex, NewType),
    solve_skyscrapers(Board, BoardWidth, NewIndex, NewType).

build_vertex_list(_, Vertices, BoardWidth, X, Y, List) :-
    V1X is X, V1Y is Y, V1Index is V1X + V1Y*(BoardWidth+1),
    V2X is X+1, V2Y is Y, V2Index is V2X + V2Y*(BoardWidth+1),
    V3X is X+1, V3Y is Y+1, V3Index is V3X + V3Y*(BoardWidth+1),
    V4X is X, V4Y is Y+1, V4Index is V4X + V4Y*(BoardWidth+1),
    get_element_at(Vertices, V1Index, V1),
    get_element_at(Vertices, V2Index, V2),
    get_element_at(Vertices, V3Index, V3),
    get_element_at(Vertices, V4Index, V4),
    List = [V1, V2, V3, V4].

build_neighbors_list(Vertices, VertexWidth, X, Y, [NorthMask, EastMask, SouthMask, WestMask], [NorthNeighbor, EastNeighbor, SouthNeighbor, WestNeighbor]) :-
    NorthY is Y - 1,
    EastX is X + 1,
    SouthY is Y + 1,
    WestX is X - 1,
    NorthNeighborIndex is (NorthY)*VertexWidth + X,
    EastNeighborIndex is Y*VertexWidth + EastX,
    SouthNeighborIndex is (SouthY)*VertexWidth + X,
    WestNeighborIndex is Y*VertexWidth + WestX,
    (NorthY >= 0, get_element_at(Vertices, NorthNeighborIndex, NorthNeighbor) -> NorthMask = 1 ; NorthMask = 0),
    (EastX < VertexWidth, get_element_at(Vertices, EastNeighborIndex, EastNeighbor) -> EastMask = 1 ; EastMask = 0),
    (SouthY < VertexWidth, get_element_at(Vertices, SouthNeighborIndex, SouthNeighbor) -> SouthMask = 1 ; SouthMask = 0),
    (WestX >= 0, get_element_at(Vertices, WestNeighborIndex, WestNeighbor) -> WestMask = 1 ; WestMask = 0).

solve_path(_, VertexWidth, 0, VertexWidth) :-
    write('end'),nl.

solve_path(Vertices, VertexWidth, VertexWidth, Y) :-
    write('switch row'),nl,
    Y \= VertexWidth,
    NewY is Y + 1,
    solve_path(Vertices, VertexWidth, 0, NewY).

solve_path(Vertices, VertexWidth, X, Y) :-
    X >= 0, X < VertexWidth, Y >= 0, Y < VertexWidth,
    write('Path: '), nl,
    write('Vertex width: '), write(VertexWidth), nl,
    write('X: '), write(X), write(' Y: '), write(Y), nl,
    VertexIndex is X + Y*VertexWidth,
    write('1'),nl,
    get_element_at(Vertices, VertexIndex, Vertex),
    write('2'),nl,
    build_neighbors_list(Vertices, VertexWidth, X, Y, [NorthMask, EastMask, SouthMask, WestMask], [NorthNeighbor, EastNeighbor, SouthNeighbor, WestNeighbor]),
    L1 = [NorthMask, EastMask, SouthMask, WestMask],
    L2 = [NorthNeighbor, EastNeighbor, SouthNeighbor, WestNeighbor],
    write(L1),nl,
    write(L2),nl,
    write('3'),nl,
    maximum(Max, Vertices),
    write('4'),nl,
    write('Max: '), write(Max),nl,
    write('Vertex: '), write(Vertex),nl,
    (Vertex #> 1 #/\ Vertex #\= Max) #=> (
                        ((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= Vertex - 1)) #\
                        ((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= Vertex - 1)) #\
                        ((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= Vertex - 1)) #\
                        ((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= Vertex - 1))
                    ) #/\ (
                        ((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= Vertex + 1)) #\
                        ((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= Vertex + 1)) #\
                        ((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= Vertex + 1)) #\
                        ((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= Vertex + 1))
                    ),
    write('5'),nl,
    Vertex #= 1 #=> (
                        ((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= Max)) #\
                        ((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= Max)) #\
                        ((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= Max)) #\
                        ((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= Max))
                    ) #/\ (
                        ((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= 2)) #\
                        ((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= 2)) #\
                        ((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= 2)) #\
                        ((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= 2))
                    ),

    write('6'),nl,
    Vertex #= Max #=> (
                        ((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= 1)) #\
                        ((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= 1)) #\
                        ((SouthMask #> 0 #/\ SouthNeighbor #> 0) #/\ (SouthNeighbor #= 1)) #\
                        ((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= 1))
                    ) #/\ (
                        ((NorthMask #> 0 #/\ NorthNeighbor #> 0) #/\ (NorthNeighbor #= Max - 1)) #\
                        ((EastMask #> 0 #/\ EastNeighbor #> 0) #/\ (EastNeighbor #= Max - 1)) #\
                        ((SouthMask #> 0 #/\ SouthNeighbor   #> 0) #/\ (SouthNeighbor #= Max - 1)) #\
                        ((WestMask #> 0 #/\ WestNeighbor #> 0) #/\ (WestNeighbor #= Max - 1))
                    ),

    write('7'),nl,
    NewX is X + 1,
    solve_path(Vertices, VertexWidth, NewX, Y).

solve_fences(Board, Vertices, BoardWidth) :-
    VertexWidth is BoardWidth + 1,
    write('- Solving vertices'),nl,
    solve_vertices(Board, Vertices, BoardWidth, 0, 0),
    write('- Solving path'),nl,
    solve_path(Vertices, VertexWidth, 0, 0).

solve_vertices(_, _, BoardWidth, 0, BoardWidth).

solve_vertices(Board, Vertices, BoardWidth, BoardWidth, Y) :-
    Y \= BoardWidth,
    NewY is Y + 1,
    solve_vertices(Board, Vertices, BoardWidth, 0, NewY).

solve_vertices(Board, Vertices, BoardWidth, X, Y) :-
    X >= 0, X < BoardWidth, Y >= 0, Y < BoardWidth,
    write('process'),nl,
    write('X: '), write(X), write(' Y: '), write(Y), nl,
    build_vertex_list(Board, Vertices, BoardWidth, X, Y, [V1, V2, V3, V4]),
    write('1'),nl,
    get_board_element(Board, BoardWidth, X, Y, Element),
    write('2'),nl,
    maximum(Max, Vertices),
    (V1 #> 0 #/\ V2 #> 0 #/\ 
        (
            (V1 + 1 #= V2) #\ 
            (V1 - 1 #= V2) #\ 
            (V1 #= Max #/\ V2 #= 1) #\
            (V1 #= 1 #/\ V2 #= Max) 
        ) 
    ) #<=> B1,
    (V2 #> 0 #/\ V3 #> 0 #/\ 
        (
            (V2 + 1 #= V3) #\ 
            (V2 - 1 #= V3) #\ 
            (V2 #= Max #/\ V3 #= 1) #\
            (V2 #= 1 #/\ V3 #= Max) 
        ) 
    ) #<=> B2,
    (V3 #> 0 #/\ V4 #> 0 #/\ 
        (
            (V3 + 1 #= V4) #\ 
            (V3 - 1 #= V4) #\ 
            (V3 #= Max #/\ V4 #= 1) #\
            (V3 #= 1 #/\ V4 #= Max) 
        ) 
    ) #<=> B3,
    (V4 #> 0 #/\ V1 #> 0 #/\ 
        (
            (V4 + 1 #= V1) #\ 
            (V4 - 1 #= V1) #\ 
            (V4 #= Max #/\ V1 #= 1) #\
            (V4 #= 1 #/\ V1 #= Max) 
        ) 
    ) #<=> B4,
    write('3'),nl,
    sum([B1, B2, B3, B4], #= , C),
    write('4'),nl,
    Element #> 0 #=> C #= Element,
    write('5'),nl,
    NewX is X + 1,
    solve_vertices(Board, Vertices, BoardWidth, NewX, Y).

sel_next_variable_for_path(Vars,Sel,Rest) :-
    % write(Vars), nl,
    findall(Idx-Cost, (nth1(Idx, Vars,V), fd_set(V,S), fdset_size(S,Size), fdset_min(S,Min),  var_cost(Min,Size, Cost)), L), 
    min_member(comp, BestIdx-_MinCost, L),
    nth1(BestIdx, Vars, Sel, Rest),!.

var_cost(0, _, 1000000) :- !.
var_cost(_, 1, 1000000) :- !.
var_cost(X, _, X).

%build_vertex_list(_, Vertices, BoardWidth, X, Y, List)

constrain_starting_and_ending_vertices(Vertices, [V1,V2,V3,V4]) :-
    maximum(Max, Vertices),
    (V1 #= 1 #/\        V2 #= Max #/\       V3 #= Max - 1 #/\   V4 #= 2         ) #\
    (V1 #= Max #/\      V2 #= 1 #/\         V3 #= 2 #/\         V4 #= Max - 1   ) #\
    (V1 #= Max - 1 #/\  V2 #= Max #/\       V3 #= 1 #/\         V4 #= 2         ) #\
    (V1 #= 2 #/\        V2 #= 1 #/\         V3 #= Max #/\       V4 #= Max - 1   ) #\
    (V1 #= 1 #/\        V2 #= 2 #/\         V3 #= Max - 1 #/\   V4 #= Max       ) #\
    (V1 #= Max #/\      V2 #= Max - 1 #/\   V3 #= 2 #/\         V4 #= 1         ) #\
    (V1 #= Max - 1 #/\  V2 #= 2 #/\         V3 #= 1 #/\         V4 #= Max       ) #\
    (V1 #= 2 #/\        V2 #= Max - 1 #/\   V3 #= Max #/\       V4 #= 1         ).

set_starting_and_ending_vertices(Board, Vertices, BoardWidth) :-
    set_starting_and_ending_vertices(Board, Vertices, BoardWidth, 0, 0).

set_starting_and_ending_vertices(Board, Vertices, BoardWidth, BoardWidth, Y) :-
    Y \= BoardWidth,
    NewY is Y + 1,
    solve_path(Board, Vertices, BoardWidth, 0, NewY).

set_starting_and_ending_vertices(Board, Vertices, BoardWidth, X, Y) :-
    X >= 0, X < BoardWidth, Y >= 0, Y < BoardWidth,
    build_vertex_list(_, Vertices, BoardWidth, X, Y, List),
    get_board_element(Board, BoardWidth, X, Y, Element),
    (Element = 3 -> 
        constrain_starting_and_ending_vertices(Vertices, List) 
        ; 
            NewX is X + 1,
        set_starting_and_ending_vertices(Board, Vertices, BoardWidth, NewX, Y)).

solve(Board, Vertices, BoardWidth) :-
    write('Skyscrapers'), nl,
    solve_skyscrapers(Board, BoardWidth),
    write('Labeling'), nl,
    labeling([ff], Board), !, 
    write('Setting domain'), nl,
    NVertices is (BoardWidth+1)*(BoardWidth+1),
    domain(Vertices, 0, NVertices),
    write('Starting and ending vertices'), nl,
    set_starting_and_ending_vertices(Board, Vertices, BoardWidth),
    write('Setting maximum'), nl,
    maximum(Max, Vertices),
    write('1'),nl,
    Max #> BoardWidth + 1,
    write('2'),nl,
    Max #< NVertices,
    count(0, Vertices, #=, NZeros),
    Max #= NVertices - NZeros,
    write('3'),nl,
    write('Calling nvalue'), nl,
    ValueCount #= Max + 1,
    nvalue(ValueCount, Vertices),
    write('Solving fences'), nl,
    solve_fences(Board, Vertices, BoardWidth),
    write('Labeling'), nl,
    labeling([ff], Vertices).

main :-
    board(Board),
    board_width(BoardWidth),
    vertices(Vertices),

    solve(Board, Vertices, BoardWidth),

    %findall(Board,
    %   labeling([ff], Board),
    %   Boards
    %),

    %append(Board, Vertices, Final),

    write('done.'),nl,
    print_board(Board, 6), nl,
    print_board(Vertices, 7).

utils.pro

get_element_at([Head|_], 0, Head).

get_element_at([_|Tail], Index, Element) :-
  Index \= 0,
  NewIndex is Index - 1,
  get_element_at(Tail, NewIndex, Element).

reverse([], []).

reverse([Head|Tail], Inv) :-
  reverse(Tail, Aux),
  append(Aux, [Head], Inv).

munch(List, 0, List).

munch([_|Tail], Count, FinalList) :-
    Count > 0,
    NewCount is Count - 1,
    munch(Tail, NewCount, FinalList).

select_n_elements(_, 0, []).

select_n_elements([Head|Tail], Count, FinalList) :-
    Count > 0,
    NewCount is Count - 1,
    select_n_elements(Tail, NewCount, Result),
    append([Head], Result, FinalList).

generate_list(Element, NElements, [Element|Result]) :-
  NElements > 0,
  NewNElements is NElements - 1,
  generate_list(Element, NewNElements, Result).

generate_list(_, 0, []).

s1.pro

% Skyscrapers and Fences puzzle S1

board_width(6).

%observer(Type, Index, Orientation, Observer),
observer(row, 0, forward, 2).
observer(row, 1, forward, 2).
observer(row, 2, forward, 2).
observer(row, 3, forward, 1).
observer(row, 4, forward, 2).
observer(row, 5, forward, 1).

observer(row, 0, reverse, 1).
observer(row, 1, reverse, 1).
observer(row, 2, reverse, 2).
observer(row, 3, reverse, 3).
observer(row, 4, reverse, 2).
observer(row, 5, reverse, 2).

observer(column, 0, forward, 2).
observer(column, 1, forward, 3).
observer(column, 2, forward, 0).
observer(column, 3, forward, 2).
observer(column, 4, forward, 2).
observer(column, 5, forward, 1).

observer(column, 0, reverse, 1).
observer(column, 1, reverse, 1).
observer(column, 2, reverse, 2).
observer(column, 3, reverse, 2).
observer(column, 4, reverse, 2).
observer(column, 5, reverse, 2).

board(
    [
        _, _, 2, _, _, _,
        _, _, _, _, _, _,
        _, 2, _, _, _, _,
        _, _, _, 2, _, _,
        _, _, _, _, _, _,
        _, _, _, _, _, _
    ]
).

vertices(
    [
        _, _, _, _, _, _, _,
        _, _, _, _, _, _, _,
        _, _, _, _, _, _, _,
        _, _, _, _, _, _, _,
        _, _, _, _, _, _, _,
        _, _, _, _, _, _, _,
        _, _, _, _, _, _, _
    ]
).
4b9b3361

Ответ 1

Я также, как и твинтер, наслаждался этой загадкой. Но, будучи первопроходцем, я сначала обнаружил подходящую стратегию, как для части, так и для беговых платформ, а затем для глубокой отладки последних, вызвав проблему переменных копии, которая запирала меня на многие часы.

Как только я решил проблему, я столкнулся с неэффективностью моей первой попытки. Я переработал в простой Prolog аналогичную схему, чтобы проверить, насколько она неэффективна.

По крайней мере, я понял, как лучше использовать CLP (FD) для моделирования проблемы (с помощью ответа twinterer), и теперь программа выполняется быстро (0,2 секунды). Итак, теперь я могу намекнуть вам о вашем коде: требуемые ограничения далеко проще, чем те, которые вы закодировали: для части ограждений, т.е. При фиксированном размещении зданий, у нас есть 2 ограничения: количество ребер, высота которых > 0, и связывание ребер togheter: когда используется ребро, сумма смещений должна быть 1 (с обеих сторон).

Вот последняя версия моего кода, разработанная с помощью SWI-Prolog. Я опубликую весь код в своем блоге и опубликую ссылку.

/*  File:    skys.pl
    Author:  Carlo,,,
    Created: Dec 11 2011
    Purpose: questions/8458945 on http://stackoverflow.com
        http://stackoverflow.com/questions/8458945/optimizing-pathfinding-in-constraint-logic-programming-with-prolog
*/

:- module(skys, [skys/0, fences/2, draw_path/2]).
:- [index_square,
    lambda,
    library(clpfd),
    library(aggregate)].

puzzle(1,
  [[-,2,3,-,2,2,1,-],
   [2,-,-,2,-,-,-,1],
   [2,-,-,-,-,-,-,1],
   [2,-,2,-,-,-,-,2],
   [1,-,-,-,2,-,-,3],
   [2,-,-,-,-,-,-,2],
   [1,-,-,-,-,-,-,2],
   [-,1,1,2,2,2,2,-]]).

skys :-
    puzzle(1, P),
    skyscrapes(P, Rows),

    flatten(Rows, Flat),
    label(Flat),

    maplist(writeln, Rows),

    fences(Rows, Loop),

    writeln(Loop),
    draw_path(7, Loop).

%%  %%%%%%%%%%
%   skyscrapes part
%   %%%%%%%%%%

skyscrapes(Puzzle, Rows) :-

    % massaging definition: separe external 'visibility' counters
    first_and_last(Puzzle, Fpt, Lpt, Wpt),
    first_and_last(Fpt, -, -, Fp),
    first_and_last(Lpt, -, -, Lp),
    maplist(first_and_last, Wpt, Lc, Rc, InnerData),

    % InnerData it the actual 'playground', Fp, Lp, Lc, Rc are list of counters
    maplist(make_vars, InnerData, Rows),

    % exploit symmetry wrt rows/cols
    transpose(Rows, Cols),

    % each row or col contains once 1,2,3
    Occurs = [0-_, 1-1, 2-1, 3-1],  % allows any grid size leaving unspecified 0s
    maplist(\Vs^global_cardinality(Vs, Occurs), Rows),
    maplist(\Vs^global_cardinality(Vs, Occurs), Cols),

    % apply 'external visibility' constraint
    constraint_views(Lc, Rows),
    constraint_views(Fp, Cols),

    maplist(reverse, Rows, RRows),
    constraint_views(Rc, RRows),

    maplist(reverse, Cols, RCols),
    constraint_views(Lp, RCols).

first_and_last(List, First, Last, Without) :-
    append([[First], Without, [Last]], List).

make_vars(Data, Vars) :-
    maplist(\C^V^(C \= (-) -> V #= C ; V in 0..3), Data, Vars).

constraint_views(Ns, Ls) :-
    maplist(\N^L^
    (   N \= (-)
    ->  constraint_view(0, L, Rs),
        sum(Rs, #=, N)
    ;   true
    ), Ns, Ls).

constraint_view(_, [], []).
constraint_view(Top, [V|Vs], [R|Rs]) :-
    R #<==> V #> 0 #/\ V #> Top,
    Max #= max(Top, V),
    constraint_view(Max, Vs, Rs).

%%  %%%%%%%%%%%%%%%
%   fences part
%   %%%%%%%%%%%%%%%

fences(SkyS, Ps) :-

    length(SkyS, D),

    % allocate edges
    max_dimensions(D, _,_,_,_, N),
    N1 is N + 1,
    length(Edges, N1),
    Edges ins 0..1,

    findall((R, C, V),
        (nth0(R, SkyS, Row), nth0(C, Row, V), V > 0),
        Buildings),
    maplist(count_edges(D, Edges), Buildings),

    findall((I, Adj1, Adj2),
        (between(0, N, I), edge_adjacents(D, I, Adj1, Adj2)),
        Path),
    maplist(make_path(Edges), Path, Vs),

    flatten([Edges, Vs], Gs),
    label(Gs),

    used_edges_to_path_coords(D, Edges, Ps).

count_edges(D, Edges, (R, C, V)) :-
    cell_edges(D, (R, C), Is),
    idxs0_to_elems(Is, Edges, Es),
    sum(Es, #=, V).

make_path(Edges, (Index, G1, G2), [S1, S2]) :-

    idxs0_to_elems(G1, Edges, Adj1),
    idxs0_to_elems(G2, Edges, Adj2),
    nth0(Index, Edges, Edge),

    [S1, S2] ins 0..3,
    sum(Adj1, #=, S1),
    sum(Adj2, #=, S2),
    Edge #= 1 #<==> S1 #= 1 #/\ S2 #= 1.

%%  %%%%%%%%%%%%%%
%   utility: draw a path with arrows
%   %%%%%%%%%%%%%%

draw_path(D, P) :-
    forall(between(1, D, R),
           (   forall(between(1, D, C),
              (   V is (R - 1) * D + C - 1,
                  U is (R - 2) * D + C - 1,
                  (   append(_, [V, U|_], P)
                  ->  write(' ^   ')
                  ;   append(_, [U, V|_], P)
                  ->  write(' v   ')
                  ;   write('     ')
                  )
              )),
           nl,
           forall(between(1, D, C),
              (   V is (R - 1) * D + C - 1,
                  (   V < 10
                  ->  write(' ') ; true
                  ),
                  write(V),
                  U is V + 1,
                  (   append(_, [V, U|_], P)
                  ->  write(' > ')
                  ;   append(_, [U, V|_], P)
                  ->  write(' < ')
                  ;   write('   ')
                  )
              )),
             nl
        )
           ).

% convert from 'edge used flags' to vertex indexes
%
used_edges_to_path_coords(D, EdgeUsedFlags, PathCoords) :-
    findall((X, Y),
        (nth0(Used, EdgeUsedFlags, 1), edge_verts(D, Used, X, Y)),
        Path),
    Path = [(First, _)|_],
    edge_follower(First, Path, PathCoords).

edge_follower(C, Path, [C|Rest]) :-
    (   select(E, Path, Path1),
        ( E = (C, D) ; E = (D, C) )
    ->  edge_follower(D, Path1, Rest)
    ;   Rest = []
    ).

Выход:

[0,0,2,1,0,3]
[2,1,3,0,0,0]
[0,2,0,3,1,0]
[0,3,0,2,0,1]
[1,0,0,0,3,2]
[3,0,1,0,2,0]

[1,2,3,4,5,6,13,12,19,20,27,34,41,48,47,40,33,32,39,46,45,38,31,24,25,18,17,10,9,16,23,
22,29,30,37,36,43,42,35,28,21,14,7,8,1]

 0    1 >  2 >  3 >  4 >  5 >  6   
      ^                        v   
 7 >  8    9 < 10   11   12 < 13   
 ^         v    ^         v        
14   15   16   17 < 18   19 > 20   
 ^         v         ^         v   
21   22 < 23   24 > 25   26   27   
 ^    v         ^              v   
28   29 > 30   31   32 < 33   34   
 ^         v    ^    v    ^    v   
35   36 < 37   38   39   40   41   
 ^    v         ^    v    ^    v   
42 < 43   44   45 < 46   47 < 48   

Как я уже упоминал, моя первая попытка была более "процедурной": она рисует цикл, но проблема, которую я не смог решить, в основном состоит в том, что количество подмножеств вершин должно быть известно раньше, основываясь на глобальном ограничении all_different. Это мучительно работает на уменьшенной головоломке 4 * 4, но я остановил ее через несколько часов на оригинале 6 * 6. В любом случае, обучение с нуля, как рисовать путь с CLP (FD), было полезным.

t :-
    time(fences([[0,0,2,1,0,3],
             [2,1,3,0,0,0],
             [0,2,0,3,1,0],
             [0,3,0,2,0,1],
             [1,0,0,0,3,2],
             [3,0,1,0,2,0]
            ],L)),
    writeln(L).

fences(SkyS, Ps) :-

    length(SkyS, Dt),
        D is Dt + 1,
    Sq is D * D - 1,

    % min/max num. of vertices
    aggregate_all(sum(V), (member(R, SkyS), member(V, R)), MinVertsT),
    MinVerts is max(4, MinVertsT),
    MaxVerts is D * D,

    % find first cell with heigth 3, for sure start vertex
    nth0(R, SkyS, Row), nth0(C, Row, 3),

    % search a path with at least MinVerts
    between(MinVerts, MaxVerts, NVerts),
    length(Vs, NVerts),

    Vs ins 0 .. Sq,
    all_distinct(Vs),

    % make a loop
    Vs = [O|_],
    O is R * D + C,
    append(Vs, [O], Ps),

    % apply #edges check
    findall(rc(Ri, Ci, V),
        (nth0(Ri, SkyS, Rowi),
         nth0(Ci, Rowi, V),
         V > 0), VRCs),
    maplist(count_edges(Ps, D), VRCs),

    connect_path(D, Ps),
    label(Vs).

count_edges(Ps, D, rc(R, C, V)) :-
    V0 is R * D + C,
    V1 is R * D + C + 1,
    V2 is (R + 1) * D + C,
    V3 is (R + 1) * D + C + 1,
    place_edges(Ps, [V0-V1, V0-V2, V1-V3, V2-V3], Ts),
    flatten(Ts, Tsf),
    sum(Tsf, #=, V).

place_edges([A,B|Ps], L, [R|Rs]) :-
    place_edge(L, A-B, R),
    place_edges([B|Ps], L, Rs).
place_edges([_], _L, []).

place_edge([M-N | L], A-B, [Y|R]) :-
    Y #<==> (A #= M #/\ B #= N) #\/ (A #= N #/\ B #= M),
    place_edge(L, A-B, R).
place_edge([], _, []).

connect(X, D, Y) :-
    D1 is D - 1,
    [R, C] ins 0 .. D1,

    X #= R * D + C,
    ( C #< D - 1, Y #= R * D + C + 1
    ; R #< D - 1, Y #= (R + 1) * D + C
    ; C #> 0, Y #= R * D + C - 1
    ; R #> 0, Y #= (R - 1) * D + C
    ).

connect_path(D, [X, Y | R]) :-
    connect(X, D, Y),
    connect_path(D, [Y | R]).
connect_path(_, [_]).

Спасибо за такой интересный вопрос.

БОЛЬШЕ РЕДАКТИРОВАНИЯ: здесь главная промаха кода для полного решения (index_square.pl)

/*  File:    index_square.pl
    Author:  Carlo,,,
    Created: Dec 15 2011
    Purpose: indexing square grid for FD mapping
*/

:- module(index_square,
      [max_dimensions/6,
       idxs0_to_elems/3,
       edge_verts/4,
       edge_is_horiz/3,
       cell_verts/3,
       cell_edges/3,
       edge_adjacents/4,
       edge_verts_all/2
      ]).

%
% index row  : {D}, left to right
% index col  : {D}, top to bottom
% index cell : same as top edge or row,col
% index vert : {(D + 1) * 2}
% index edge : {(D * (D + 1)) * 2}, first all horiz, then vert
%
% {N} denote range 0 .. N-1
%
%  on a 2*2 grid, the numbering schema is
%
%       0   1
%   0-- 0 --1-- 1 --2
%   |       |       |
% 0 6  0,0  7  0,1  8
%   |       |       |
%   3-- 2 --4-- 3 --5
%   |       |       |
% 1 9  1,0  10 1,1  11
%   |       |       |
%   6-- 4 --7-- 5 --8
%
%  while on a 4*4 grid:
%
%       0   1       2       3
%   0-- 0 --1-- 1 --2-- 2 --3-- 3 --4
%   |       |       |       |       |
% 0 20      21      22      23      24
%   |       |       |       |       |
%   5-- 4 --6-- 5 --7-- 6 --8-- 7 --9
%   |       |       |       |       |
% 1 25      26      27      28      29
%   |       |       |       |       |
%   10--8 --11- 9 --12--10--13--11--14
%   |       |       |       |       |
% 2 30      31      32      33      34
%   |       |       |       |       |
%   15--12--16--13--17--14--18--15--19
%   |       |       |       |       |
% 3 35      36      37      38      39
%   |       |       |       |       |
%   20--16--21--17--22--18--23--19--24
%
%   |       |
% --+-- N --+--
%   |       |
%   W  R,C  E
%   |       |
% --+-- S --+--
%   |       |
%

% get range upper value for interesting quantities
%
max_dimensions(D, MaxRow, MaxCol, MaxCell, MaxVert, MaxEdge) :-
    MaxRow is D - 1,
    MaxCol is D - 1,
    MaxCell is D * D - 1,
    MaxVert is ((D + 1) * 2) - 1,
    MaxEdge is (D * (D + 1) * 2) - 1.

% map indexes to elements
%
idxs0_to_elems(Is, Edges, Es) :-
    maplist(nth0_(Edges), Is, Es).
nth0_(Edges, I, E) :-
    nth0(I, Edges, E).

% get vertices of edge
%
edge_verts(D, E, X, Y) :-
    S is D + 1,
    edge_is_horiz(D, E, H),
    (   H
    ->  X is (E // D) * S + E mod D,
        Y is X + 1
    ;   X is E - (D * S),
        Y is X + S
    ).

% qualify edge as horizontal (never fail!)
%
edge_is_horiz(D, E, H) :-
    E >= (D * (D + 1)) -> H = false ; H = true.

% get 4 vertices of cell
%
cell_verts(D, (R, C), [TL, TR, BL, BR]) :-
    TL is R * (D + 1) + C,
    TR is TL + 1,
    BL is TR + D,
    BR is BL + 1.

% get 4 edges of cell
%
cell_edges(D, (R, C), [N, S, W, E]) :-
    N is R * D + C,
    S is N + D,
    W is (D * (D + 1)) + R * (D + 1) + C,
    E is W + 1.

% get adjacents at two extremities of edge I
%
edge_adjacents(D, I, G1, G2) :-
    edge_verts(D, I, X, Y),
    edge_verts_all(D, EVs),
    setof(E, U^V^(member(E - (U, V), EVs), E \= I, (U == X ; V == X)), G1),
    setof(E, U^V^(member(E - (U, V), EVs), E \= I, (U == Y ; V == Y)), G2).

% get all edge_verts/4 for grid D
%
edge_verts_all(D, L) :-
    (   edge_verts_all_(D, L)
    ->  true
    ;   max_dimensions(D, _,_,_,_, S), %S is (D + 1) * (D + 2) - 1,
        findall(E - (X, Y),
            (   between(0, S, E),
            edge_verts(D, E, X, Y)
            ), L),
        assert(edge_verts_all_(D, L))
    ).

:- dynamic edge_verts_all_/2.

%%  %%%%%%%%%%%%%%%%%%%%

:- begin_tests(index_square).

test(1) :-
    cell_edges(2, (0,1), [1, 3, 7, 8]),
    cell_edges(2, (1,1), [3, 5, 10, 11]).

test(2) :-
    cell_verts(2, (0,1), [1, 2, 4, 5]),
    cell_verts(2, (1,1), [4, 5, 7, 8]).

test(3) :-
    edge_is_horiz(2, 0, true),
    edge_is_horiz(2, 5, true),
    edge_is_horiz(2, 6, false),
    edge_is_horiz(2, 9, false),
    edge_is_horiz(2, 11, false).

test(4) :-
    edge_verts(2, 0, 0, 1),
    edge_verts(2, 3, 4, 5),
    edge_verts(2, 5, 7, 8),
    edge_verts(2, 6, 0, 3),
    edge_verts(2, 11, 5, 8).

test(5) :-
    edge_adjacents(2, 0, A, B), A = [6], B = [1, 7],
    edge_adjacents(2, 9, [2, 6], [4]),
    edge_adjacents(2, 10, [2, 3, 7], [4, 5]).

test(6) :-
    cell_edges(4, (2,1), [9, 13, 31, 32]).

:- end_tests(index_square).

Ответ 2

Быстрый взгляд на вашу программу предполагает, что вы используете овеществление довольно сильно. К сожалению, такие формулировки подразумевают слабую согласованность в существующих системах, таких как SICStus.

Часто, однако, все может быть сформулировано более компактно, что ведет к лучшей согласованности. Вот один пример, который вы можете адаптировать к вашим потребностям.

Скажем, вы хотите выразить, что (X1, Y1) и (X2, Y2) являются горизонтальными или вертикальными соседями. Вы можете сказать ( X1+1 #= X2 #/\ Y1 #= Y2 ) #\ ... для каждой возможности (и проверить, покрывает ли ваша медицинская страховка RSI).

Или вы можете сказать abs(X1-X2)+abs(Y1-Y2) #= 1. В старых программах SICStus Prolog для этого имел симметричную разницу (--)/2, но я предполагаю, что вы используете версию 4.

Выше формулировка поддерживает согласованность интервалов (по крайней мере, я заключаю это из примеров, которые я пробовал):

| ?- X1 in 1..9, abs(X1-X2)+abs(Y1-Y2) #= 1.
X1 in 1..9,
X2 in 0..10,...

Итак, X2 легко сдерживается!

В вашем ответе могут возникнуть ситуации (как вы укажете в своем ответе), где вам нужна защищенная форма для сохранения других ограничений. В этом случае вы можете рассмотреть опубликовать как.

Лист через руководство содержит несколько комбинаторных ограничений, которые могут быть интересными. И как быстрое исправление, smt/1 может помочь (новый в 4.2.0). Было бы интересно услышать об этом...

Другой возможностью может быть использование другой реализации: например library(clpfd) для YAP или SWI.

Ответ 3

Какая приятная маленькая головоломка! Чтобы понять свойства, я внедрил решение в ECLiPSe. Это можно найти здесь: http://pastebin.com/eZbgjgFA (не волнуйтесь, если вы видите циклы в коде: их можно легко перевести в стандартные предикаты Prolog.Такой другой материал, однако, что не так легко перевести с ECLiPSe в Sicstus)

Время выполнения быстрее, чем то, что вы сообщаете, но, вероятно, может быть лучше:

?- snf(L).
L = [[]([]([](0,0,1,1),[](1,1,0,0),[](0,1,0,1),[](0,1,0,0),[](0,1,0,0),[](0,1,1,1)),
        []([](1,1,0,0),[](0,0,1,0),[](1,1,1,0),[](1,0,0,1),[](0,0,1,0),[](1,1,0,1)),
        []([](1,0,0,0),[](0,0,1,1),[](1,0,0,0),[](0,1,1,1),[](1,0,0,0),[](0,1,1,0)),
        []([](1,0,1,0),[](1,1,0,1),[](0,0,1,0),[](1,1,0,0),[](0,0,0,1),[](0,0,1,0)),
        []([](1,0,0,0),[](0,1,1,1),[](1,0,1,0),[](1,0,1,0),[](1,1,1,0),[](1,0,1,0)),
        []([](1,0,1,1),[](1,1,0,0),[](0,0,1,0),[](1,0,1,1),[](1,0,1,0),[](1,0,1,1))),
     ...]
Yes (40.42s cpu, solution 1, maybe more)
No (52.88s cpu)

То, что вы видите в ответе, - это матрица ребер. Каждый внутренний член обозначает поле в головоломке, край которого активен (слева, вверх, вправо, вниз). Я отредактировал остальные.

Я использовал всего восемь массивов: массив хххххх ребер (0/1), массив активных ребер (H + 1) x (W + 1) на вершине поля (0/2), массив HxW суммы активных ребер (0..3), массив зданий HxW (0/1), два массива [H, W] x3 высот здания и два массива [H, W] x3 строительных позиций.

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

Ограничения:

  • суммарный массив должен содержать для каждого поля сумму активных ребер для этого поля

  • касание границ соседних полей должно содержать одно и то же значение

  • вершинные точки должны иметь два активных ребра, соединенных с ними, или none

  • в каждом столбце/строке должно быть размещено ровно три здания. Некоторые из зданий помещаются по определению головоломки

  • каждая высота здания в строке/столбце должна быть разной

  • высота здания соответствует сумме активных ребер в этом положении

  • количество видимых зданий определяется определением головоломки. Это ограничивает порядок, в котором здания могут отображаться в строке/столбце.

  • позиции зданий в строке/столбце должны быть указаны в порядке возрастания

  • Как только позиция первого/второго/третьего здания известна, мы можем заключить некоторые положения, в которых невозможно разместить здание.

С этим набором ограничений мы теперь готовы к метке. Маркировка выполняется в два этапа, что ускоряет процесс решения.

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

На втором этапе все остальные переменные помечены. Для обоих этапов я выбрал "первый сбой" как стратегию маркировки, т.е. Сначала обозначить переменные с наименьшим доменом.

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

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

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

Надеюсь, это поможет!