1

我一直在尝试在 JIProlog 中实现 Dijkstra 最短路径算法。网上有一些可用的实现，例如here和here，但它们都将路径作为节点列表返回。这对我的实现来说是有问题的，因为我在技术上使用的是多重图，其中顶点可以通过多条边连接。因此，我需要一个返回边列表而不是节点列表的算法。

我一直在尝试调整我提到的第一个实现来跟踪边缘，但我迷失在dijkstra_l/3规则中。有人可以帮助我吗？谢谢！

4

1 回答 1

2

我前段时间回答了一个类似的问题，并提供了一个实现。唉，该代码不适用于 lastes SWI-Prlog，我已经调试并发现 ord_memberchk（用于提高效率）已经改变了行为。我已经用 memberchk 替换了，现在正在工作......

我建议将算法的输出与从节点恢复边缘的简单后处理通道一起使用，选择较小的值。我已经实现了 dijkstra_edges/3

/*  File:    dijkstra_av.pl
    Author:  Carlo,,,
    Created: Aug  3 2012
    Modified:Oct 28 2012
    Purpose: learn graph programming with attribute variables
*/

:- module(dijkstra_av, [dijkstra_av/3,
            dijkstra_edges/3]).

dijkstra_av(Graph, Start, Solution) :-
    setof(X, Y^D^(member(d(X,Y,D), Graph) ; member(d(Y,X,D), Graph)), Xs),
    length(Xs, L),
    length(Vs, L),
    aggregate_all(sum(D), member(d(_, _, D), Graph), Infinity),
    catch((algo(Graph, Infinity, Xs, Vs, Start, Solution),
           throw(sol(Solution))
          ), sol(Solution), true).

dijkstra_edges(Graph, Start, Edges) :-
    dijkstra_av(Graph, Start, Solution),
    maplist(nodes_to_edges(Graph), Solution, Edges).

nodes_to_edges(Graph, s(Node, Dist, Nodes), s(Node, Dist, Edges)) :-
    join_nodes(Graph, Nodes, Edges).

join_nodes(_Graph, [_Last], []).
join_nodes(Graph, [N,M|Ns], [e(N,M,D)|Es]) :-
    aggregate_all(min(X), member(d(N, M, X), Graph), D),
    join_nodes(Graph, [M|Ns], Es).

algo(Graph, Infinity, Xs, Vs, Start, Solution) :-
    pairs_keys_values(Ps, Xs, Vs),
    maplist(init_adjs(Ps), Graph),
    maplist(init_dist(Infinity), Ps),
    %ord_memberchk(Start-Sv, Ps),
    memberchk(Start-Sv, Ps),
    put_attr(Sv, dist, 0),
    time(main_loop(Vs)),
    maplist(solution(Start), Vs, Solution).

solution(Start, V, s(N, D, [Start|P])) :-
    get_attr(V, name, N),
    get_attr(V, dist, D),
    rpath(V, [], P).

rpath(V, X, P) :-
    get_attr(V, name, N),
    (   get_attr(V, previous, Q)
    ->  rpath(Q, [N|X], P)
    ;   P = X
    ).

init_dist(Infinity, N-V) :-
    put_attr(V, name, N),
    put_attr(V, dist, Infinity).

init_adjs(Ps, d(X, Y, D)) :-
    %ord_memberchk(X-Xv, Ps),
    %ord_memberchk(Y-Yv, Ps),
    memberchk(X-Xv, Ps),
    memberchk(Y-Yv, Ps),
    adj_add(Xv, Yv, D),
    adj_add(Yv, Xv, D).

adj_add(X, Y, D) :-
    (   get_attr(X, adjs, L)
    ->  put_attr(X, adjs, [Y-D|L])
    ;   put_attr(X, adjs, [Y-D])
    ).

main_loop([]).
main_loop([Q|Qs]) :-
    smallest_distance(Qs, Q, U, Qn),
    put_attr(U, assigned, true),
    get_attr(U, adjs, As),
    update_neighbours(As, U),
    main_loop(Qn).

smallest_distance([A|Qs], C, M, [T|Qn]) :-
    get_attr(A, dist, Av),
    get_attr(C, dist, Cv),
    (   Av < Cv
    ->  (N,T) = (A,C)
    ;   (N,T) = (C,A)
    ),
    !, smallest_distance(Qs, N, M, Qn).
smallest_distance([], U, U, []).

update_neighbours([V-Duv|Vs], U) :-
    (   get_attr(V, assigned, true)
    ->  true
    ;   get_attr(U, dist, Du),
        get_attr(V, dist, Dv),
        Alt is Du + Duv,
        (   Alt < Dv
        ->  put_attr(V, dist, Alt),
        put_attr(V, previous, U)
        ;   true
        )
    ),
    update_neighbours(Vs, U).
update_neighbours([], _).

:- begin_tests(dijkstra_av).

small([d(a,b,2),d(a,b,1),d(b,c,1),d(c,d,1),d(a,d,3),d(a,d,2)]).

test(1) :-
    nl,
    small(S),
    time(dijkstra_av(S, a, L)),
    maplist(writeln, L).

test(2) :-
    open('salesman.pl', read, F),
    readf(F, L),
    close(F),
    nl,
    dijkstra_av(L, penzance, R),
    maplist(writeln, R).

readf(F, [d(X,Y,D)|R]) :-
    read(F, dist(X,Y,D)), !, readf(F, R).
readf(_, []).

test(3) :-
    nl, small(S),
    time(dijkstra_edges(S, a, Es)),
    maplist(writeln, Es).

:- end_tests(dijkstra_av).

test(3) 显示了实现，我添加了一些具有更高值的边缘来验证，输出显示这些被正确丢弃：

s(a,0,[])
s(b,1,[e(a,b,1)])
s(c,2,[e(a,b,1),e(b,c,1)])
s(d,2,[e(a,d,2)])
于 2012-10-27T22:42:21.613 回答