gpt4 book ai didi

prolog - 使用 Prolog 优化约束逻辑编程中的寻路

转载 作者:行者123 更新时间:2023-12-04 00:19:59 30 4
gpt4 key购买 nike

我正在开发一个小型 prolog 应用程序来解决 Skyscrapers and Fences拼图。

一个未解之谜:

Skyscrapers in fences puzzle (unsolved)

一个已解决的谜题:

Skyscrapers in fences puzzle (solved)

当我通过程序已经解决的谜题时,它很快,几乎是即时的,为我验证它。当我通过程序非常小的谜题(例如2x2,当然,修改规则)时,找到解决方案也相当快。

问题在于计算“ native ”大小为 6x6 的拼图。在中止它之前,我已经让它运行了 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(
    [
    _, _, _, _, _, _, _,
    _, _, _, _, _, _, _,
    _, _, _, _, _, _, _,
    _, _, _, _, _, _, _,
    _, _, _, _, _, _, _,
    _, _, _, _, _, _, _,
    _, _, _, _, _, _, _
    ]
    ).

    最佳答案

    我也和 twinterer 一样,喜欢这个谜题。但是作为一名校长,我必须首先找到一个合适的策略,对于摩天大楼和围栏部分,然后对后者进行深度调试,导致复制变量问题锁定了我很多小时。

    一旦解决了这个错误,我就面临着第一次尝试的低效率。我在普通的 Prolog 中重新编写了一个类似的模式,只是为了验证它的效率有多低。

    至少,我了解如何更有效地使用 CLP(FD) 对问题进行建模(在 twinterer 的回答的帮助下),现在程序运行速度很快(0.2 秒)。所以现在我可以提示你关于你的代码:所需的约束是 比您编码的更简单:对于围栏部分,即建筑物放置固定,我们有 2 个约束:高度 > 0 的边数,并将边连接在一起:使用边时,相邻的总和必须为 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's 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).

    关于prolog - 使用 Prolog 优化约束逻辑编程中的寻路,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/8458945/

    30 4 0
    Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
    广告合作:1813099741@qq.com 6ren.com