/******************************************************************
Example B-Prolog programs Neng-Fa Zhou posted to comp.lang.prolog
******************************************************************/
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% L=[1,2,3,...,N]
% Posted July 23, 2011
create_list(N,L) :- L @= [I : I in 1..N].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Cartesian product of lists Options
% Posted July 1, 2011
cartprod([L1,L2],R):-!,
R @= [[X1,X2] : X1 in L1, X2 in L2].
cartprod([L|Ls],R):-
cartprod(Ls,R1),
R @= [[X|P] : X in L, P in R1].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% All possible pairs
% Posted Nov. 25, 2010
all_pairs(List,Pairs):-
Pairs @= [[I-J] : I in List, J in List, I
(I\==J->(Row @= Matrix[I], % swap row I and J
Matrix[I] @:= Matrix[J],
Matrix[J] @:= Row)
;
true
),
foreach(K in I+1..Matrix^length,trans_row(I,K,Matrix))
;
true
)).
% select a row J where Matrix[J,I] is not zero
select_nonzero_row(I,J0,Matrix,J):-
Matrix[J0,I]=\=0,!,J=J0.
select_nonzero_row(I,J0,Matrix,J):-
J0 < Matrix^length,
J1 is J0+1,
select_nonzero_row(I,J1,Matrix,J).
% transform row K to make Matrix[K,I] zero
trans_row(I,K,Matrix):-
Matrix[K,I]=:=0,!. % is already zero
trans_row(I,K,Matrix):-
foreach(J in I+1..Matrix[K]^length,
[NewCoe],
(NewCoe is Matrix[K,J]/Matrix[K,I]-Matrix[I,J]/Matrix[I,I],
Matrix[K,J] @:= NewCoe)),
Matrix[K,I] @:= 0.
% It uses destructive updates (@:=) and thus is not so clean, but it
% should be much faster than your program. Here are some matrices to
% test on.
test:-
matrix(Ls),
lists_to_matrix(Ls,Matrix),
triangle_matrix(Matrix),
foreach(I in 1..Matrix^length,[Row],(Row@=Matrix[I],
writeln(Row))),
nl,nl,
fail.
lists_to_matrix(Ls,Matrix):-
NRows is Ls^length,
NCols is Ls[1]^length,
new_array(Matrix,[NRows,NCols]),
foreach(I in 1..NRows, J in 1..NCols, Matrix[I,J] is Ls[I,J]).
matrix(M):-
M=[[1,1,1,0],
[1,-2,2,4],
[1,2,-1,2]].
matrix(M):-
M=[[2,1,-1,8],
[-3,-1,2,-11],
[-2,1,2,-3]].
matrix(M):-
M=[[2,-3,-1,2,3,4],
[4,-4,-1,4,11,4],
[2,-5,-2,2,-1,9],
[0,2,1,0,4,-5]].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% quickk sort, permutation generation, queens
% Posted January 5, 2010
qsort([],[]).
qsort([H|T],S):-
L1 @= [X : X in T, X=H],
qsort(L1,S1),
qsort(L2,S2),
append(S1,[H|S2],S).
perms([],[[]]).
perms([X|Xs],Ps):-
perms(Xs,Ps1),
Ps @= [P : P1 in Ps1, I in 0..Xs^length,[P],insert(X,I,P1,P)].
% insert(X,I,L1,L): insert X into L1 in Ith position to get L
insert(X,0,L,[X|L]).
insert(X,I,[Y|L1],[Y|L]):-
I>0,
I1 is I-1,
insert(X,I1,L1,L).
queens(N):-
length(Qs,N),
Qs :: 1..N,
foreach(I in 1..N-1, J in I+1..N,
(Qs[I] #\= Qs[J],
abs(Qs[I]-Qs[J]) #\= J-I)),
labeling([ff],Qs),
writeln(Qs).
bool_queens(N):-
new_array(Qs,[N,N]),
Vars @= [Qs[I,J] : I in 1..N, J in 1..N],
Vars :: 0..1,
foreach(I in 1..N,
sum([Qs[I,J] : J in 1..N]) #= 1),
foreach(J in 1..N,
sum([Qs[I,J] : I in 1..N]) #= 1),
foreach(K in 1-N..N-1,
sum([Qs[I,J] : I in 1..N, J in 1..N, I-J=:=K]) #=< 1),
foreach(K in 2..2*N,
sum([Qs[I,J] : I in 1..N, J in 1..N, I+J=:=K]) #=< 1),
labeling(Vars),
foreach(I in 1..N,[Row],
(Row @= [Qs[I,J] : J in 1..N], writeln(Row))).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Magic square
% Posted Nov. 16, 2009 (reformulated)
magicSquare(N):-
new_array(Board,[N,N]),
NN is N*N,
Vars @= [Board[I,J] : I in 1..N, J in 1..N],
Vars :: 1..NN,
Sum is NN*(NN+1)//(2*N),
foreach(I in 1..N,sum([Board[I,J] : J in 1..N]) #= Sum),
foreach(J in 1..N,sum([Board[I,J] : I in 1..N]) #= Sum),
sum([Board[I,I] : I in 1..N]) #= Sum,
sum([Board[I,N-I+1] : I in 1..N]) #= Sum,
all_different(Vars),
labeling([ffc],Vars),
foreach(I in 1..N,
(foreach(J in 1..N, [Bij], (Bij @= Board[I,J], format("~4d ",[Bij]))),nl)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Shortest path
% Posted Sep. 9, 2009
> My problem now is to find the shortest path between two vertices.
> Three lines of Prolog solve this really easy, but the problem arises
> when I try to find a path between two vertices that are not in the
> same graph (that means, there is no such path!). It falls in an
> endless loop.
:-table sp(+,+,-,min).
sp(X,Y,[(X,Y)],1):-edge(X,Y).
sp(X,Y,[(X,Z)|Path],Len):-
edge(X,Z),
sp(Z,Y,Path,Len1),
Len is Len1+1.