e5f4633c39
which included commits to RCS files with non-trunk default branches. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
445 lines
11 KiB
Plaintext
445 lines
11 KiB
Plaintext
% Boolean tests from Daniel Diaz
|
|
% 931127 adapted to Eclipse and CHRs by Thom Fruehwirth, ECRC
|
|
|
|
%From diaz@margaux.inria.fr Tue Nov 23 18:59:17 1993
|
|
%
|
|
%I send you 3 programs schur.pl, pigeon.pl and queens.pl and a file
|
|
%b_bips.pl containing the necessary built-ins and libraries.
|
|
|
|
|
|
|
|
|
|
%---schur.pl---
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
/* Benchmark (Boolean) INRIA Rocquencourt - ChLoE Project */
|
|
/* */
|
|
/* Name : bschur.pl */
|
|
/* Title : Schur's lemma */
|
|
/* Original Source: Giovanna Dore - Italy */
|
|
/* Adapted by : Daniel Diaz - INRIA France */
|
|
/* Date : January 1993 */
|
|
/* */
|
|
/* Color the integers 1,2...,N with 3 colors so that there is no monochrome*/
|
|
/* triplets (x,y,z) where x+y=z. Solution iff N<=13. */
|
|
/* The solution is a list [ [Int11,Int12,Int13],..., [IntN1,IntN2,IntN3] ] */
|
|
/* where Intij is 1 if the integer i is colored with the color j. */
|
|
/* */
|
|
/* Solution: */
|
|
/* N=4 [[0,0,1],[0,1,0],[0,0,1],[1,0,0]] */
|
|
/* [[0,0,1],[0,1,0],[0,1,0],[0,0,1]] */
|
|
/* ... */
|
|
/* N=13 [[0,0,1],[0,1,0],[0,1,0],[0,0,1],[1,0,0],[1,0,0],[0,0,1],[1,0,0], */
|
|
/* [1,0,0],[0,0,1],[0,1,0],[0,1,0],[0,0,1]] (first solution) */
|
|
/*-------------------------------------------------------------------------*/
|
|
|
|
bschur:- write('N ?'), read(N),
|
|
cputime( Starttime),
|
|
(schur(N,A),
|
|
% write(A), nl,
|
|
fail
|
|
;
|
|
write('No more solutions'), nl),
|
|
cputime( Cputime),
|
|
Y is Cputime-Starttime,
|
|
write('time : '), write(Y), nl.
|
|
|
|
cputime( Ts) :-
|
|
statistics( runtime, [Tm,_]),
|
|
Ts is Tm/1000.
|
|
|
|
|
|
schur(N,A):-
|
|
create_array(N,3,A),
|
|
for_each_line(A,only1),
|
|
pair_constraints(A,A),
|
|
!,
|
|
% labeling.
|
|
array_labeling(A).
|
|
|
|
|
|
|
|
|
|
pair_constraints([],_):-
|
|
!.
|
|
|
|
pair_constraints([_],_):-
|
|
!.
|
|
|
|
pair_constraints([_,[K1,K2,K3]|A2],[[I1,I2,I3]|A1]):-
|
|
and0(I1,K1),
|
|
and0(I2,K2),
|
|
and0(I3,K3),
|
|
triplet_constraints(A2,A1,[I1,I2,I3]),
|
|
pair_constraints(A2,A1).
|
|
|
|
|
|
|
|
|
|
triplet_constraints([],_,_).
|
|
|
|
triplet_constraints([[K1,K2,K3]|A2],[[J1,J2,J3]|A1],[I1,I2,I3]):-
|
|
and0(I1,J1,K1),
|
|
and0(I2,J2,K2),
|
|
and0(I3,J3,K3),
|
|
triplet_constraints(A2,A1,[I1,I2,I3]).
|
|
|
|
|
|
|
|
|
|
|
|
|
|
%--- pigeon.pl ---
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
/* Benchmark (Boolean) INRIA Rocquencourt - ChLoE Project */
|
|
/* */
|
|
/* Name : bpigeon.pl */
|
|
/* Title : pigeon-hole problem */
|
|
/* Originated from: */
|
|
/* Adapted by : Daniel Diaz - INRIA France */
|
|
/* Date : January 1993 */
|
|
/* */
|
|
/* Put N pigeons in M pigeon-holes. Solution iff N<=M. */
|
|
/* The solution is a list [ [Pig11,...,Pig1m], ... ,[Pign1,...,Pignm] ] */
|
|
/* where Pigij = 1 if the pigeon i is in the pigeon-hole j */
|
|
/* */
|
|
/* Solution: */
|
|
/* N=2 M=3 [[0,0,1],[0,1,0]] */
|
|
/* [[0,0,1],[1,0,0]] */
|
|
/* [[0,1,0],[0,0,1]] */
|
|
/* [[0,1,0],[1,0,0]] */
|
|
/* [[1,0,0],[0,0,1]] */
|
|
/* [[1,0,0],[0,1,0]] */
|
|
/*-------------------------------------------------------------------------*/
|
|
|
|
|
|
bpigeon:- write('N ?'), read(N), write('M ?'), read(M),
|
|
cputime( Starttime),
|
|
(bpigeon(N,M,A),
|
|
% write(A), nl,
|
|
fail
|
|
;
|
|
write('No more solutions'), nl),
|
|
cputime( Cputime),
|
|
Y is Cputime-Starttime,
|
|
write('time : '), write(Y), nl.
|
|
|
|
|
|
|
|
|
|
bpigeon(N,M,A):-
|
|
create_array(N,M,A),
|
|
for_each_line(A,only1),
|
|
for_each_column(A,atmost1),
|
|
!,
|
|
array_labeling(A).
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
%--- queens.pl ---
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
/* Benchmark (Boolean) INRIA Rocquencourt - ChLoE Project */
|
|
/* */
|
|
/* Name : bqueens.pl */
|
|
/* Title : N-queens problem */
|
|
/* Original Source: Daniel Diaz - INRIA France */
|
|
/* Adapted by : */
|
|
/* Date : January 1993 */
|
|
/* */
|
|
/* Put N queens on an NxN chessboard so that there is no couple of queens */
|
|
/* threatening each other. */
|
|
/* The solution is a list [ [Que11,...,Que1N], ... ,[QueN1,...,QueNN] ] */
|
|
/* where Queij is 1 if the the is a queen on the ith line an jth row. */
|
|
/* */
|
|
/* Solution: */
|
|
/* N=4 [[0,0,1,0], [[0,1,0,0], */
|
|
/* [1,0,0,0], [0,0,0,1], */
|
|
/* [0,0,0,1], and [1,0,0,0], */
|
|
/* [0,1,0,0]] [0,0,1,0]] */
|
|
/* */
|
|
/* N=8 [[0,0,0,0,0,0,0,1], (first solution) */
|
|
/* [0,0,0,1,0,0,0,0], */
|
|
/* [1,0,0,0,0,0,0,0], */
|
|
/* [0,0,1,0,0,0,0,0], */
|
|
/* [0,0,0,0,0,1,0,0], */
|
|
/* [0,1,0,0,0,0,0,0], */
|
|
/* [0,0,0,0,0,0,1,0], */
|
|
/* [0,0,0,0,1,0,0,0]] */
|
|
/*-------------------------------------------------------------------------*/
|
|
|
|
|
|
bqueens:- write('N ?'), read(N),
|
|
cputime( Starttime),
|
|
(bqueens(N,A),
|
|
% write(A), nl,
|
|
fail
|
|
;
|
|
write('No more solutions'), nl),
|
|
cputime( Cputime),
|
|
Y is Cputime-Starttime,
|
|
write('time : '), write(Y), nl.
|
|
|
|
|
|
|
|
|
|
bqueens(N,A):-
|
|
create_array(N,N,A),
|
|
for_each_line(A,only1),
|
|
for_each_column(A,only1),
|
|
for_each_diagonal(A,N,N,atmost1),
|
|
!,
|
|
array_labeling(A).
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
%--- b_bips.pl ---
|
|
|
|
|
|
|
|
%I also use the following shorthands:
|
|
|
|
and0(X,Y):-
|
|
and(X,Y,0).
|
|
% delay([X,Y],and(X,Y,0)).
|
|
|
|
|
|
|
|
or1(X,Y):-
|
|
or(X,Y,1).
|
|
|
|
|
|
and0(X,Y,Z):-
|
|
and(X,Y,XY),
|
|
and(XY,Z,0).
|
|
% delay([X,Y,Z],(
|
|
% and(X,Y,XY),
|
|
% and(XY,Z,0))).
|
|
|
|
|
|
|
|
|
|
or1(X,Y,Z):-
|
|
or(X,Y,XY),
|
|
or(XY,Z,1).
|
|
|
|
|
|
/*-------------------------------------------------------------------------*/
|
|
/* Prolog to Wam Compiler INRIA Rocquencourt - ChLoE Project */
|
|
/* Version 1.0 - C Run-time Daniel Diaz - 1991 */
|
|
/* Extended to FD Constraints (July 1992) */
|
|
/* */
|
|
/* Built-In: B predicates (booleans) */
|
|
/* */
|
|
/* b_bips.pl */
|
|
/*-------------------------------------------------------------------------*/
|
|
|
|
/* Symbolic constraints */
|
|
|
|
%:- public only_one/1, at_least_one/1, at_most_one/1.
|
|
|
|
%only_one(L):- card(1,1,L).
|
|
%at_most_one(L):- card(0,1,L).
|
|
|
|
|
|
only_one(L):-
|
|
at_least_one(L),
|
|
at_most_one(L).
|
|
|
|
|
|
|
|
|
|
at_least_one(L):-
|
|
at_least_one1(L,1).
|
|
|
|
|
|
at_least_one1([X],X).
|
|
|
|
at_least_one1([X|L],R):-
|
|
at_least_one1(L,R1),
|
|
or(X,R1,R).
|
|
|
|
|
|
|
|
|
|
at_most_one([]).
|
|
|
|
at_most_one([X|L]):-
|
|
not_two(L,X),
|
|
at_most_one(L).
|
|
|
|
|
|
|
|
|
|
not_two([],_).
|
|
|
|
not_two([X1|L],X):-
|
|
and0(X1,X),
|
|
not_two(L,X).
|
|
|
|
|
|
|
|
/* Array procedures */
|
|
|
|
%:- public create_array/3, for_each_line/2, for_each_column/2, for_each_diagonal/4, array_labeling/1.
|
|
|
|
|
|
/*---------------------------------------------------------*/
|
|
/* */
|
|
/* An array NL x NC elements is represented as follows : */
|
|
/* A = [L_1, ..., L_NL] with L_i = [X_i_1, ..., X_i_NC] */
|
|
/* Hence : */
|
|
/* A = [ [X_1_1,..., X_1_NC], ..., [X_NL_1,..., X_NL_NC] ] */
|
|
/*---------------------------------------------------------*/
|
|
|
|
% create_array(NL,NC,A)
|
|
% NL: nb of lines NC:nb of columns A:array
|
|
% creates an array (with unbound variables)
|
|
|
|
create_array(NL,NC,A):-
|
|
create_array1(0,NL,NC,A),
|
|
!.
|
|
|
|
|
|
create_array1(NL,NL,_,[]).
|
|
|
|
create_array1(I,NL,NC,[L|A]):-
|
|
create_one_line(0,NC,L),
|
|
I1 is I+1,
|
|
create_array1(I1,NL,NC,A).
|
|
|
|
|
|
|
|
|
|
create_one_line(NC,NC,[]).
|
|
|
|
create_one_line(J,NC,[_|L]):-
|
|
J1 is J+1,
|
|
create_one_line(J1,NC,L).
|
|
|
|
|
|
|
|
|
|
% for_each_line(A,P)
|
|
% A:array P: program atom
|
|
% calls: array_prog(P,L) for each line L (L is a list)
|
|
|
|
for_each_line([],_).
|
|
|
|
for_each_line([L|A],P):-
|
|
array_prog(P,L),
|
|
for_each_line(A,P).
|
|
|
|
|
|
|
|
|
|
% for_each_column(A,P)
|
|
% A:array P: program atom
|
|
% calls: array_prog(P,L) for each column L (L is a list)
|
|
|
|
for_each_column([[]|_],_):-
|
|
!.
|
|
|
|
for_each_column(A,P):-
|
|
create_column(A,C,A1),
|
|
array_prog(P,C),
|
|
for_each_column(A1,P).
|
|
|
|
|
|
|
|
|
|
create_column([],[],[]).
|
|
|
|
create_column([[X|L]|A],[X|C],[L|A1]):-
|
|
create_column(A,C,A1).
|
|
|
|
|
|
|
|
|
|
% for_each_diagonal(A,NL,NC,P)
|
|
% A:array NL: nb of lines
|
|
% NC:nb of columns P: program atom
|
|
% calls: array_prog(P,L) for each diagonal D (D is a list)
|
|
|
|
for_each_diagonal(A,NL,NC,P):-
|
|
NbDiag is 2*(NL+NC-1), % numbered from 0 to NbDiag-1
|
|
create_lst_diagonal(0,NbDiag,LD),
|
|
fill_lst_diagonal(A,0,NL,NC,LD,LD1),
|
|
!,
|
|
for_each_line(LD1,P).
|
|
|
|
|
|
|
|
|
|
create_lst_diagonal(NbDiag,NbDiag,[]).
|
|
|
|
create_lst_diagonal(I,NbDiag,[[]|LD]):-
|
|
I1 is I+1,
|
|
create_lst_diagonal(I1,NbDiag,LD).
|
|
|
|
|
|
|
|
|
|
fill_lst_diagonal([],_,_,_,LD,LD).
|
|
|
|
fill_lst_diagonal([L|A],I,NL,NC,LD,LD2):-
|
|
I1 is I+1,
|
|
fill_lst_diagonal(A,I1,NL,NC,LD,LD1),
|
|
one_list(L,I,NL,0,NC,LD1,LD2).
|
|
|
|
|
|
|
|
|
|
|
|
one_list([],_,_,_,_,LD,LD).
|
|
|
|
one_list([X|L],I,NL,J,NC,LD,LD3):-
|
|
J1 is J+1,
|
|
one_list(L,I,NL,J1,NC,LD,LD1),
|
|
NoDiag1 is I+J,
|
|
NoDiag2 is I+NC-J+NL+NC-2,
|
|
add_in_lst_diagonal(0,NoDiag1,X,LD1,LD2),
|
|
add_in_lst_diagonal(0,NoDiag2,X,LD2,LD3).
|
|
|
|
|
|
|
|
|
|
|
|
add_in_lst_diagonal(NoDiag,NoDiag,X,[D|LD],[[X|D]|LD]).
|
|
|
|
add_in_lst_diagonal(K,NoDiag,X,[D|LD],[D|LD1]):-
|
|
K1 is K+1,
|
|
add_in_lst_diagonal(K1,NoDiag,X,LD,LD1).
|
|
|
|
|
|
|
|
array_prog(only1,L):- !,
|
|
only_one(L).
|
|
|
|
array_prog(atmost1,L):- !,
|
|
at_most_one(L).
|
|
|
|
|
|
|
|
|
|
array_labeling([]).
|
|
|
|
array_labeling([L|A]):-
|
|
label_bool(L),
|
|
array_labeling(A).
|
|
|
|
|
|
%--- end ---
|