%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Solving sliding puzzle in Prolog % % author: Ivan Kuckir, ivan@kuckir.com % hello :- write('\n\tWelcome to\n\t\tS L I D I N G P U Z Z L E S O L V E R\n\n\tAuthor: Ivan Kuckir\n\n\tfor quick start, insert\n\t\t\solve(graph1, 8).\n\n'). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Input % % graph : g(vertices, edges). % vertices: name-content % edges : e(name, name) graph(ctverec, g( [0-1, 1-2, 2-3, 3-0], [e(0,1), e(1,2), e(2,3), e(3, 0)] ) ). %ok graph(graph1, g( [0-0, 1-2, 2-1, 3-4, 4-3], [e(0, 1), e(1, 2), e(2, 3), e(3, 4), e(4, 0), e(0, 2), e(2, 4)]) ). %ok graph(graph3, g( [0-0, 1-2, 2-1, 3-4, 4-3], [e(0, 1), e(1, 2), e(2, 3), e(3, 4), e(4, 0), e(0, 2), e(0, 3)]) ). %ok graph(graph5, g( [0-0, 1-2, 2-1, 3-4, 4-3], [e(0, 1), e(1, 2), e(2, 3), e(3, 4), e(4, 0), e(0, 3), e(4, 1)]) ). %ok graph(graph7, g( [0-0, 1-5, 2-4, 3-3, 4-2, 5-1], [e(0, 1), e(1, 2), e(2, 3), e(3, 4), e(4, 5), e(5,0), e(0, 3), e(1, 4), e(2,5)]) ). %ok graph(graph9, g( [0-0, 1-6, 2-4, 3-2, 4-3, 5-1, 6-5], [e(0, 1), e(1, 2), e(2, 3), e(3, 4), e(4, 5), e(5,6), e(6,0), e(1,5), e(2,6), e(2,5)]) ). %ok graph(graph11, g( [0-0, 1-5, 2-4, 3-3, 4-2, 5-1], [e(0, 1), e(1, 2), e(2, 3), e(3, 4), e(4, 5), e(5,0), e(1,4), e(2,5)]) ). %ok graph(graph17, g( [0-0, 1-2, 2-3, 3-5, 4-1, 5-4], [e(0, 1), e(1, 2), e(2, 3), e(3, 4), e(4, 5), e(5,0), e(2,5)]) ). %ok - min. 24 tahů!!! graph(graph30, g( [0-0, 1-2, 2-1, 3-4, 4-3, 5-6, 6-7, 7-5], [e(0, 1), e(1, 2), e(2, 3), e(3, 4), e(4, 5), e(5,6), e(6,7), e(7,0), e(2,7), e(3,6)]) ). %ok graph(loyd8, g( [1-1, 2-2, 3-3, 4-5, 5-0, 6-6, 7-4, 8-7, 0-8], [e(1,2), e(2,3), e(4,5), e(5,6), e(7,8), e(8,0), e(1,4), e(4,7), e(2,5), e(5,8), e(3,6), e(6,0)]) ). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Access to the graph % vertices(Graph, V) :- graph(Graph, g(V, _)). zerov(Graph, X-0) :- vertices(Graph, V), member(X-0, V). edges(Graph, E) :- graph(Graph, g(_, E)). edge(Graph, U-_, V-_) :- edges(Graph, E), ( member(e(U, V), E); member(e(V, U), E) ). vname(N-_, N). vcont(_-C, C). vnc(N-C, N, C). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Solving algorithm % solve(Graph, MM) :- floydWarsh(Graph), totalDist(Graph, N), vertices(Graph, X), zerov(Graph, ZV), move(Graph, X, ZV, asd, N, SL, MM), write(SL). % move(Vertices, ZeroVertex, PrevVertex(only name), TotalDistance, SlideList). move(_, _, _, _, 0, [], _). move(Graph, Ver, ZV, PV, TD, Moves, MM) :- MM > 0, TD \= 0, vfilter(Graph, Ver, ZV, PV, FVer), vname(ZV, N), iSort(FVer, N, SFVer), tryMoves(Graph, Ver, SFVer, ZV, TD, Moves, MM). tryMoves(Graph, All, Verts, ZV, TD, [Move|Rest], MM) :- member(V, Verts), vnc(V, NV, CV), vnc(ZV, NZV, _), % slide from V to ZV dist(NV, CV, X1), dist(NZV, CV, Y1), dist(NZV, 0, X2), dist(NV, 0, Y2), VDif is Y1-X1, ZVDif is Y2-X2, TDif is VDif+ZVDif, %Heur < 1, % heuristics replace(All, ZV, NZV-CV, V, NV-0, NVer), Move is NV, NTD is TD+TDif, NMM is MM - 1, move(Graph, NVer, NV-0, NZV, NTD, Rest, NMM). replace([], _, _, _, _, []). replace([H| Rest], A, NA, B, NB, [NH| NRest]) :-( ( H = A, NH = NA); ( H = B, NH = NB ); ( H\= A, H\= B, NH = H) ), replace(Rest, A, NA, B, NB, NRest). vfilter(_,[], _, _, []). vfilter(Graph, [H|Rest], H , PV, OList) :- vfilter(Graph, Rest, H , PV, OList). vfilter(Graph, [H|Rest], ZV, PV, OList) :- vname(H, N), N = PV, vfilter(Graph, Rest, ZV, PV, OList). vfilter(Graph, [H|Rest], ZV, PV, OList) :- H \= ZV, not(edge(Graph, H, ZV)), vfilter(Graph, Rest, ZV, PV, OList). vfilter(Graph, [H|Rest], ZV, PV, [H|Tail]) :- vname(H, N), H\=ZV, N\=PV, edge(Graph, H, ZV), vfilter(Graph, Rest, ZV, PV, Tail). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Insertion sort algorithm % % sorts vertices due the distance of their content to it's home after moving to vertex V % iSort(List, V, Sorted):- i_sort(List, V, [],Sorted). i_sort([], _,Acc,Acc). i_sort([H|T], V, Acc,Sorted):-insert(H, V, Acc,NAcc), i_sort(T, V, NAcc,Sorted). insert(X, V, [Y|T],[Y |NT]) :- vnc(X, NX, CX), vnc(Y, NY, CY), dist(V, CX, DaX), dist(V, CY, DaY), dist(NX, CX, DbX), dist(NY, CY, DbY), DiX is DaX - DbX, DiY is DaY - DbY, DiX>DiY, insert(X,V,T,NT). insert(X, V, [Y|T],[X,Y|T]) :- vnc(X, NX, CX), vnc(Y, NY, CY), dist(V, CX, DaX), dist(V, CY, DaY), dist(NX, CX, DbX), dist(NY, CY, DbY), DiX is DaX - DbX, DiY is DaY - DbY, DiX== D) ), floydCol(R, P, Rest). % Creating beginning "dist" beginDist(Graph) :- vertices(Graph, R), beginRow(Graph, R, R). beginRow(_, [],_). beginRow(Graph, [V|Rest], C) :- beginCol(Graph, V, C), beginRow(Graph, Rest, C). beginCol(_, _, []). beginCol(Graph, V, [W|Rest]) :- vname(V, A), vname(W, B), assert(dist(-1,-1,-1)), ( (dist(A, B, X), retract(dist(A,B,X))); not(dist(A,B,_)) ), ( (edge(Graph, V, W), assert(dist(A, B, 1))); ( not(edge(Graph, V, W)), ( (V \= W, assert(dist(A, B, 999))); (V = W, assert(dist(A, B, 0))) ) ) ), beginCol(Graph, V, Rest). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Rozdělaný Floyd-Warshall pracující s maticemi % (pak mi došlo, že to není efektivní a je lepší použít predikáty) % /* floydWarshall(X) :- distMat(M), vertices(Graph, V), floydIter(V, M, X). floydIter([], X, X). floydIter([U|Rest], M, X) :- floydRow(U, M, X1), floydIter(Rest, X1, X). floydRow(U, [], []). % přepočítá řádek a zavolá se na další řádek floydRow(U, [Row|Rest], X):- floydCol(U, %%% Distance function distance([H|Rest], 0, Col, N) :- column(H, Col, N). distance([H|Rest], Row, Col, N) :- Row \= 0, R2 is Row-1, distance(Rest, R2, Col, N). column([H|Rest], 0, H). column([H|Rest], Col, N) :- Col \= 0, C2 is Col-1, column(Rest, C2, N). %%% Distance Matrix distMat(X) :- vertices(Graph, V), distRows(V, X), write(X). distRows([], []). distRows([V| Tail], [R| Rest]) :- distRow(V, R), distRows(Tail, Rest). distRow(U, Row) :- vertices(V), getDR(U, V, Row). % getDR(+Vertex, +Acc, -Row). getDR(_, [], []). getDR(V, [H| Tail], [X|Rest]) :- edge(V, H), X is 1, getDR(V, Tail, Rest). getDR(V, [H| Tail], [X|Rest]) :- not(edge(V, H)), X is 999 , getDR(V, Tail, Rest). */ ?-hello.