Our submission to ICLP07 Prolog Net Contest

Main page: http://www.cs.kuleuven.be/~bmd/PrologProgrammingContests/Contest2007.html , contest net version page: http://www.cs.kuleuven.be/~bmd/PrologProgrammingContests/2007/net2007.html

Problem Specification: probs.pdf

Date: Sep 10, 2007 12:57 AM
Subject: PPC2007

%%%%%%%%%%%%%begin submission%%%%%%%%%%%%%


Name(s): Anu Singh, Diptikalyan Saha, Hui Wan, Paul Fodor, Senlin Liang (Dictionary order)
Affiliation(s): Dept. of Computer Science, SUNY Stony Brook
Prolog system used: xsb


%%%%%%%%%%%%%carpet.pl%%%%%%%%%%%%
rewrite('X',[['X','X','X'],['X',0,'X'],['X','X','X']]).
rewrite(0,[[0,0,0],[0,0,0],[0,0,0]]).

power(K,0,1).
power(K,N,P):-
  N > 0,
  N1 is N-1,
  power(K,N1,P1),
  P is P1 * K.

:- import ith/3,length/2 from basics.

carpet(L):-
  rewrite('X',List),
  length(List,N),
  power(N,L,NpL),

for(I,1,NpL,[for(J,1,NpL,[cal1(I,J,N,L,Char),change(Char,Char1),write(Char1)]),nl]).

change('X','X').
change(0,' ').

cal1(I,J,N,1,Char):-
  rewrite('X',List),
  ith(I,List,EList),
  ith(J,EList,Char).

cal1(I,J,N,R,Char):-
  R>1,
  cal(J,N,R,P1,J1),
  cal(I,N,R,P2,I1),
  cal1(P2,P1,N,1,Char1),
  (Char1=='X'->
    R1 is R-1,
    cal1(I1,J1,N,R1,Char)
    ;
    R1 is R-1,
    cal2(I1,J1,N,R1,Char)
  ).

cal2(I,J,N,1,Char):-
  rewrite(0,List),
  ith(I,List,EList),
  ith(J,EList,Char).

cal2(I,J,N,R,Char):-
  R>1,
  cal(J,N,R,P1,J1),
  cal(I,N,R,P2,I1),
  cal2(P2,P1,N,1,Char1),
  (Char1=='X'->
    R1 is R-1,
    cal1(I1,J1,N,R1,Char)
    ;
    R1 is R-1,
    cal2(I1,J1,N,R1,Char)
  ).

cal(J,N,R,K, Rem1):-
  R1 is R-1,
  power(N,R1,P),
  K1 is J// P,
  Rem is J rem P,
  (Rem==0->
     Rem1 is P,
     K = K1
   ;
     Rem1 = Rem,
     K is K1 + 1
  ).

for(_,M,N,_):- M>N,!.
for(Var,I,N,ListofCommands):-
  (Var=I,
  perform(ListofCommands),
  fail;true),
  I1 is I+1,
  for(Var,I1,N,ListofCommands).

perform([]):-!.
perform([X|L]):-X,perform(L).

%%%%%%%%%%%%%bitrev.pl%%%%%%%%%%%%

:- import
  length/2,
  append/3

  from basics.

/*B is log(2,N)*/
lg(N,B) :-
  N1 is N//2,
  (N1 == 0
  ->
    B is 0
  ;
    lg(N1,B1),
    B is B1+1
  ).

/*B is the bitwise representation of N*/
bw(N, B) :-
  (N == 0
  ->
    B = [0]
  ;
    (N == 1
    ->
      B = [1]
    ;
      N1 is N//2,
      N2 is N mod 2,
      bw(N1, B1),
      append(B1,[N2],B)
    )
  ).

pad(B,0,B1) :- !,B1 = B.
pad(B,N,B1) :-
  N1 is N -1,
  pad(B,N1,B2),
  append([0],B2,B1).

rev([],[]):- !.
rev([H|T],R) :-
  rev(T,R1),
  append(R1,[H],R).

/*P is the number represented by list L*/
power(L,P) :-
  rev(L,L1),
  power1(L1,P).
power1([],0) :- !.
power1([H|T],P) :-
  power1(T,P1),
  P is P1*2 + H.

/*R is bitrev(N,i)*/
br(N,I,R) :-
  %%writeln('in br/3'),
  %%write('  N='),writeln(N),
  %%write('  I='),writeln(I),
  bw(I,B),
  %%write('  bw(I,B)='),writeln(B),
  length(B,L),
  %%write('  length(B)='),writeln(L),
  (L < N
  ->
    Diff is N - L,
    pad(B,Diff,B1)
  ;
    B1 = B
  ),
  rev(B1,R1),
  power(R1,R).

/*split list*/
sp(In,0,F,L) :-
  !,
  F = [],
  In = [_H|L].
sp([H|T],I,F,L) :-
  I1 is I -1,
  sp(T,I1,F1,L),
  F = [H|F1].

makelist([]).
makelist(In) :-
  makelist(In1),
  length(In1, L1),
  (L1 > 0
  ->
    length(In2,L1),
    append(In1,In2,In)
  ;
    In = [_H]
  ).

/* the first case of bitrev/2, In is a list*/
bitrev1(In, Out) :-
  length(In,Length),
  lg(Length,N),
  length(Out1,Length),
  brl(In,0,N,Out1,Out).

brl([],_I,_N,Out1,Out) :- !,Out = Out1.
brl([H|T],I,N,Out1,Out) :-
  br(N,I,R), /*bitrev(N,I) = R*/
  sp(Out1,R,F,L), /* split Out1 into F and L, deleting R_th element*/
  append(F, [H], TmpOut),
  append(TmpOut,L,TmpOut1),
  I1 is I + 1,
  brl(T,I1,N,TmpOut1,Out).

bitrev(In,Out) :-
  ( (var(In),var(Out))
  ->
    makelist(In),
    bitrev1(In,Out)
  ;
    (var(Out)
    ->
       bitrev1(In,Out)
    ;
      (var(In)
      ->
        bitrev1(Out,In)
      ;
        In == Out
      )
    )
  ).

%%%%%%%%%%%%%sumdiff.pl%%%%%%%%%%%%

:- import findall/3 from setof.
:- import append/3, memberchk/2, length/2 from basics.

sumdiff(N, Ls) :-
  W is N - 1,  %% start with minimum possible weight
  newcheck(N, W, [], Ls).

tempchk(N, W, NotMSTD, Ls) :-
  choose_set(N, W, NotMSTD, S),
  check(N, S, W, Ls).

newcheck(N, W, NotMSTD, Ls) :-
  (
  tempchk(N, W, NotMSTD, L) ->
      Ls = L
      ;
    findall(S, choose_set(N, W, NotMSTD, S), Add),
    NMSTD = [Add|NotMSTD],
    rem_dups(NMSTD, NewNotMSTD),
    W1 is W + 1,
    newcheck(N, W1, NewNotMSTD, Ls)
  ).

check(N, S, W, L) :-
  sum(S, Sums),
  diff(S, Diffs),
  length(Sums, Slen),
  length(Diffs, Dlen),
  Slen > Dlen,  L = S.

choose_set(N, Weight, NotMSTD, S) :-
  enumerate(0, Weight, L),
  subset(L, S),
  length(S, N),
  \+ memberchk(S, NotMSTD).

sum([], []) :- !.
sum([X|Xs],  List) :-
  sums(X, [X|Xs], YL),
  sum(Xs, YLL),
  append(YL, YLL, Ls),
  rem_dups(Ls, List).

sums(_, [], []) :- !.
sums(X, [Y|Ys], [Z|Zs]) :-
  Z is X + Y,
  sums(X, Ys, Zs).

diff([], []) :- !.
diff([X|Xs],  List) :-
  diffs(X, [X|Xs], YL),
  diff(Xs, YLL),
  append(YL, YLL, Ls),
  rem_dups(Ls, List).

diffs(_, [], []) :- !.
diffs(X, [Y|Ys], [Z1,Z2|Zs]) :-
  Z1 is X - Y,
  Z2 is Y - X,
  diffs(X, Ys, Zs).

%% subset(L1,L2) means L2 is a subset of L1
subset([],[]).
subset([X|R],[X|S]) :- subset(R,S).
subset([_|R],S) :- subset(R,S).

enumerate(I,J,List) :-
  ( I =< J ->
      List = [I|Rest],
          I1 is I + 1,
          enumerate(I1,J,Rest)
      ;
      List = []
 ).

rem_dups([], []).
rem_dups([X|Xs], Ls) :-
  (memberchk(X, Xs) -> rem_dups(Xs,Ls)
      ;
    rem_dups(Xs, L),
    Ls = [X|L]
  ).

%%%%%%%%%%%%%juggle.pl%%%%%%%%%%%%

juggle(_Hands,[]):-
  !,
  fail.
juggle(_Hands,Sequence):-
  lengthList(Sequence,Length),
  max_juggle(0,Sequence,Sequence,Length,[],0,[state(0,[])]),
  !.

%
max_juggle(+CurrentPos,+PartialSequence,+Sequence,+Length,+Constrains,+MaxBall,+PreviousFinalConstraints)

% a previous state was found
max_juggle(CurrentPos,[],_Sequence,_Length,Constraints,_MaxBall,PreviousFinalConstraints):-

  cleanConstraints(CurrentPos,Constraints,CleanConstraints),
  check_constraints(CurrentPos,CleanConstraints,PreviousFinalConstraints),
  !.
% a new final state is added to the seen states to check termination
max_juggle(CurrentPos,[],Sequence,Length,Constraints,MaxBall,PreviousFinalConstraints):-

  cleanConstraints(CurrentPos,Constraints,CleanConstraints),

max_juggle(CurrentPos,Sequence,Sequence,Length,CleanConstraints,MaxBall,[state(CurrentPos,CleanConstraints)|PreviousFinalConstraints]),

  !.
max_juggle(CurrentPos,[H|_T],_Sequence,_Length,Constraints,_MaxBall,_PreviousFinalConstraints):-

  NewCurrentPos is CurrentPos+1,
  ConstraintPos is NewCurrentPos+H,
  memberList(ball(ConstraintPos,_XBall),Constraints), % no previous ball
cannot be in the constraints for ConstraintPos
  !,
  fail.
max_juggle(CurrentPos,[H|T],Sequence,Length,Constraints,MaxBall,PreviousFinalConstraints):-

  NewCurrentPos is CurrentPos+1,
  memberList(ball(NewCurrentPos,Ball),Constraints),
  ConstraintPos is NewCurrentPos+H,

max_juggle(NewCurrentPos,T,Sequence,Length,[ball(ConstraintPos,Ball)|Constraints],MaxBall,PreviousFinalConstraints),

  !.
max_juggle(CurrentPos,[H|T],Sequence,Length,Constraints,MaxBall,PreviousFinalConstraints):-

  NewCurrentPos is CurrentPos+1,
  NewMaxBall is MaxBall+1,
  ConstraintPos is NewCurrentPos+H,

max_juggle(NewCurrentPos,T,Sequence,Length,[ball(ConstraintPos,NewMaxBall)|Constraints],NewMaxBall,PreviousFinalConstraints),

  !.

% check_constraints(+Pos1,+List1,+PreviousFinalConstraints)
%
% checks if the current contraints are equal with any of the past constrains

%  if they are equal then the same state was encounted before and we can
stop
%  the PreviousFinalConstraints have the form: state(Position,Constraints)
%  the constraints have the form: ball(Beat,Duration)
check_constraints(Pos1,List1,[state(Position,Constraints)|_T]):-
  equal_constraints(Pos1,List1,Position,Constraints),
  !.
check_constraints(Pos1,List1,[_H|T]):-
  check_constraints(Pos1,List1,T),
  !.

%equal_constraints(+Pos1,+List1,+Pos2,+List2)
%
%
% Example:
equal_constraints(6,[ball(7,1),ball(9,2),ball(11,3)],12,[ball(13,1),ball(15,2),ball(17,3)]).

equal_constraints(_,[],_,[]):-
  !.
equal_constraints(Pos1,[H|T],Pos2,L):-
  member_constraint(H,L,Pos1,Pos2,RestL),
  equal_constraints(Pos1,T,Pos2,RestL).

% member_constraint(+X,+L,+Pos1,+Pos2,-RestL)
%
% checks is an element X is a member_constraint of a list L and returns the
rest of the list L
member_constraint(ball(Beat1,Duration1),[ball(Beat2,Duration1)|T],Pos1,Pos2,T):-

  Temp1 is Beat1-Pos1,
  Temp2 is Beat2-Pos2,
  Temp1 = Temp2,
  !.
member_constraint(H1,[H2|T],[H2|T2]):-
  member_constraint(H1,T,T2).

% cleanConstraints(+CurrentPos,+Constraints,-CleanConstraints)
cleanConstraints(_,[],[]):-
  !.
cleanConstraints(CurrentPos,[ball(Pos,Ball)|T],[ball(Pos,Ball)|RestCleanConstraints]):-

  Pos>CurrentPos,
  !,
  cleanConstraints(CurrentPos,T,RestCleanConstraints).
cleanConstraints(CurrentPos,[_H|T],RestCleanConstraints):-
  cleanConstraints(CurrentPos,T,RestCleanConstraints).

% lengthList(Sequence,Length)
lengthList([],0).
lengthList([_H|T],X):-
  lengthList(T,XN),
  X is XN+1.

% memberList(+Element,+List)
memberList(H,[H|_T]):-
  !.
memberList(H,[_H2|T]):-
  memberList(H,T),
  !.

%%%%%%%%%%%%%optisort.pl%%%%%%%%%%%%

optisort(Nodes,Constraints,MinD):-
  findall(D,sortAll(Nodes,Constraints,D),ListD),
  lengthList(Nodes,Length),
  NewLength is Length+1,
  selectMin(ListD,NewLength,bigTree,MinD).

% sortAll(+Nodes,+Constraints,-D)
%
% Example:  trace,sortAll([a,b],[],D).
sortAll(Nodes,Constraints,D):-
  transitiveClosure(Constraints,ConstraintsTransitiveClosure),
  not(fails(ConstraintsTransitiveClosure)),
  sortAllWithTC(Nodes,ConstraintsTransitiveClosure,D).

% sortAllWithTC(+Nodes,+ConstraintsTransitiveClosure,-D)
sortAllWithTC(Nodes,ConstraintsTransitiveClosure,done):-
  lengthList(Nodes,Length),
  lengthList(ConstraintsTransitiveClosure,LTC),
  Temp is Length*(Length-1)/2,
  Temp =< LTC,
  !.
sortAllWithTC(Nodes,ConstraintsTransitiveClosure,D):-
  memberListElemUnknown(Node1,Nodes),
  memberListElemUnknown(Node2,Nodes),
  Node1 \= Node2,
  not(memberListElemUnknown(Node1<Node2,ConstraintsTransitiveClosure)),

transitiveClosure([Node1<Node2|ConstraintsTransitiveClosure],LeftConstraintsTransitiveClosure),
  not(fails(LeftConstraintsTransitiveClosure)),
  sortAllWithTC(Nodes,LeftConstraintsTransitiveClosure,LD),

transitiveClosure([Node2<Node1|ConstraintsTransitiveClosure],RightConstraintsTransitiveClosure),
  not(fails(RightConstraintsTransitiveClosure)),
  sortAllWithTC(Nodes,RightConstraintsTransitiveClosure,RD),
  D=compare(Node1,Node2,LD,RD).

% transitiveClosure(+Constraints,-ConstraintsTransitiveClosure)
transitiveClosure(Constraints,ConstraintsTransitiveClosure):-
  findall(
    ConstraintsTransitiveClosure2,
    (
      select(Constraint,Constraints,RestConstraints),
      transitiveClosure(RestConstraints,ConstraintsTransitiveClosure1),

addConstraint(Constraint,ConstraintsTransitiveClosure1,ConstraintsTransitiveClosure2)

    ),
    ConstraintsTransitiveClosure3
  ),

leverageEliminateDupl(ConstraintsTransitiveClosure3,ConstraintsTransitiveClosureDupl),

eliminateDuplicates(ConstraintsTransitiveClosureDupl,ConstraintsTransitiveClosure).

% addConstraint(+Constraint,+Constraints,-ConstraintsTransitiveClosure)
addConstraint(Constraint,[],[Constraint]):-
  !.
addConstraint(X<Y,Constraints,[X<Y|ConstraintsTransitiveClosure]):-
  findall(
    X<Z,
    memberListElemUnknown(Y<Z,Constraints),
    ConstraintsTransitiveClosureTemp1
  ),

appendList(ConstraintsTransitiveClosureTemp1,Constraints,ConstraintsTransitiveClosure),
  !.

% leverageEliminateDupl(+LL,-L)
leverageEliminateDupl(LL,L):-
  leverageEliminateDupl(LL,[],L).
% leverageEliminateDupl(+LL,+PartialL,-L).
leverageEliminateDupl([],L,L):-
  !.
leverageEliminateDupl([H|T],PartialL,L):-
  leverageOneEliminateDupl(H,PartialL,L1),
  leverageEliminateDupl(T,PartialL,L2),

  append(L1,L2,L),
  !.
% leverageOneEliminateDupl(+List,+PartialL,-L).
leverageOneEliminateDupl([],L,L):-
  !.
leverageOneEliminateDupl([H|T],PartialL,L):-
  member(H,PartialL),
  !,
  leverageOneEliminateDupl(T,PartialL,L).
leverageOneEliminateDupl([H|T],PartialL,L):-
  leverageOneEliminateDupl(T,[H|PartialL],L).

% eliminateDuplicates(+ListDupl,-List)
eliminateDuplicates([],[]):-
  !.
eliminateDuplicates([H|T],List):-
  member(H,T),
  !,
  eliminateDuplicates(T,List).
eliminateDuplicates([H|T],[H|List]):-
  eliminateDuplicates(T,List).

% fails(+Constraints)
fails(Constraints):-
  member(Node1<Node2,Constraints),
  member(Node2<Node1,Constraints).

% selectMin(+ListTrees,+CurrentMin,+PartialTree,-Tree)
%
% selects a minimum tree
selectMin([],_,Tree,Tree):-
  !.
selectMin([H|T],CurrentMin,_PartialTree,Tree):-
  depth(H,Depth),
  Depth<CurrentMin,
  !,
  selectMin(T,Depth,H,Tree).
selectMin([_H|T],CurrentMin,PartialTree,Tree):-
  selectMin(T,CurrentMin,PartialTree,Tree).

% depth(+Tree,-Depth)
depth(done,0).
depth(compare(_,_,L,R),Depth):-
  depth(L,LDepth),
  depth(R,RDepth),
  (
    (LDepth<RDepth,!,Depth is RDepth+1);
    Depth is LDepth+1
  ).

% lengthList(Sequence,Length)
lengthList([],0).
lengthList([_H|T],X):-
  lengthList(T,XN),
  X is XN+1.

% memberListElemUnknown(-Element,+List)
memberListElemUnknown(H,[H|_T]).
memberListElemUnknown(H,[_H2|T]):-
  memberListElemUnknown(H,T).

% appendList(+L1,+L2,L)
appendList([],L,L):-
  !.
appendList([H|T],L,[H|R]):-
  appendList(T,L,R),
  !.

%%%%%%%%%%%%%bookmove.pl%%%%%%%%%%%%

bookmove(List1,List2):-
  one_book_move(List1,List3),
  same_conf(List3,List2).

:- import length/2, member/2, append/3 from basics.

same_conf(L,L1):-
  divide(L,L2,L3),
  append(L3,L2,L1).

one_book_move(List1,List2):-
  length(List1,L),
  takeN(List1,L,List2).

takeN(List,N,List2):-
  N>0,
  subseq(List,N,S,A), divide(A,B1,B2),add3(B1,S,B2,List2).

takeN(List,N,List2):-
  N>1,
  N1 is N-1,
  takeN(List,N1,List2).

add3(L,L1,L2,Lout):-
  append(L,L1,L3),
  append(L3,L2,Lout).

divide(L,L1,L2):-
  append(L1,L2,L),L1\=[],L2\=[].

% take out N books
%  subsequence of length N
subseq(L, N ,S, Rest):-
  take([],L,N,S,Left,Right),
  reverse(Left,RevLeft),
  (Right==[]->
      Rest=RevLeft
  ;
    append(Right,RevLeft,Rest)
  ).

reverse(L,L1):-
  reverse1(L,[],L1).

reverse1([],Acc,Acc).
reverse1([X|L],Acc,R):-
  reverse1(L,[X|Acc],R).

take(Left,[X|L],N,[X|L1],Left,Right):-
  N > 0,
  N1 is N-1,
  first(L,N1,L1,Right).

take(L2,[X|L],N,S,L1,R):-
  take([X|L2],L,N,S,L1,R).

first(L,0,[],L).
first([X|L],N,[X|L1],Rest):-
  N>0,
  N1 is N-1,
  first(L,N1,L1,Rest).

%%%%%%%%%%%%%end submission%%%%%%%%%%%%