fixedpoint.jp

:- module(hakoiri,[play/4,history/4,search/0]).

box(4,5).

block(daughter,2,2).
block(father,1,2).
block(mother,1,2).
block(grandfather,1,2).
block(grandmother,1,2).
block(brother,2,1).
block(wasai,1,1).
block(kado,1,1).
block(sado,1,1).
block(shodo,1,1).

initial(daughter,1,0).
initial(father,0,0).
initial(mother,3,0).
initial(grandfather,0,2).
initial(grandmother,3,2).
initial(brother,1,2).
initial(wasai,0,4).
initial(kado,1,3).
initial(sado,2,3).
initial(shodo,3,4).

goal(daughter,1,3).

%%% an alternative problem

%% block(oh,2,2).
%% block(hisha,1,2).
%% block(kaku,1,2).
%% block(kin,2,1).
%% block(gin,2,1).
%% block(keima1,1,1).
%% block(keima2,1,1).
%% block(yari1,1,1).
%% block(yari2,1,1).
%% block(fu1,1,1).
%% block(fu2,1,1).

%% initial(hisha,0,0).
%% initial(oh,1,0).
%% initial(kaku,3,0).
%% initial(yari1,0,2).
%% initial(keima1,1,2).
%% initial(keima2,2,2).
%% initial(yari2,3,2).
%% initial(kin,0,3).
%% initial(gin,2,3).
%% initial(fu1,0,4).
%% initial(fu2,3,4).

%% goal(oh,1,3).

initial_positions(Positions) :- setof([Block,X,Y],initial(Block,X,Y),Positions).

spaces(Positions,Spaces) :- setof([X,Y],space(X,Y,Positions),Spaces).

space(X,Y,Positions) :-
    box(Width,Height),
    XMax is Width-1,
    YMax is Height-1,
    between(0,XMax,X),
    between(0,YMax,Y),
    \+ covered(X,Y,Positions).

covered(_,_,[]) :- !,fail.
covered(X,Y,[[Block,X0,Y0]|_]) :-
    block(Block,W,H),
    X1 is X0+W-1,
    Y1 is Y0+H-1,
    between(X0,X1,X),
    between(Y0,Y1,Y).
covered(X,Y,[_|Rest]) :- covered(X,Y,Rest).

layout([Block,X,Y],[X,Y,W,H]) :- block(Block,W,H).

layouts(Positions,Sorted) :- maplist(layout,Positions,Layouts),sort(Layouts,Sorted).

move(Block,X0,Y0,Spaces0,X1,Y0,Spaces1) :- % left
    0<X0,
    block(Block,W,H),
    X1 is X0-1,
    Y1 is Y0+H-1,
    setof([X1,Y],between(Y0,Y1,Y),S0),
    subset(S0,Spaces0),
    X2 is X0+W-1,
    setof([X2,Y],between(Y0,Y1,Y),S1),
    subtract(Spaces0,S0,R),
    union(R,S1,Spaces1).
move(Block,X0,Y0,Spaces0,X1,Y0,Spaces1) :- % right
    block(Block,W,H),
    X2 is X0+W,box(Width,_),X2<Width,
    Y1 is Y0+H-1,
    setof([X2,Y],between(Y0,Y1,Y),S0),
    subset(S0,Spaces0),
    X1 is X0+1,
    setof([X0,Y],between(Y0,Y1,Y),S1),
    subtract(Spaces0,S0,R),
    union(R,S1,Spaces1).
move(Block,X0,Y0,Spaces0,X0,Y1,Spaces1) :- % up
    0<Y0,
    block(Block,W,H),
    X1 is X0+W-1,
    Y1 is Y0-1,
    setof([X,Y1],between(X0,X1,X),S0),
    subset(S0,Spaces0),
    Y2 is Y0+H-1,
    setof([X,Y2],between(X0,X1,X),S1),
    subtract(Spaces0,S0,R),
    union(R,S1,Spaces1).
move(Block,X0,Y0,Spaces0,X0,Y1,Spaces1) :- % down
    block(Block,W,H),
    X1 is X0+W-1,
    Y2 is Y0+H,box(_,Height),Y2<Height,
    setof([X,Y2],between(X0,X1,X),S0),
    subset(S0,Spaces0),
    Y1 is Y0+1,
    setof([X,Y0],between(X0,X1,X),S1),
    subtract(Spaces0,S0,R),
    union(R,S1,Spaces1).

:- dynamic history/4, layouts/1, counter/1.

play(Positions,Spaces,Path,N) :-
    repeat,
    retract(history(Position0,Spaces0,Path0,N0)),
    select([Block,X0,Y0],Position0,Rest),
    move(Block,X0,Y0,Spaces0,X,Y,Spaces),
    Positions = [[Block,X,Y]|Rest],
    layouts(Positions,Layouts),
    \+ layouts(Layouts),
    assertz(layouts(Layouts)),
    Path = [Position0|Path0],
    N is N0+1,
    assertz(history(Positions,Spaces,Path,N)).

setup :-
    initial_positions(InitialPositions),
    spaces(InitialPositions,InitialSpaces),
    layouts(InitialPositions,InitialLayout),
    assert(history(InitialPositions,InitialSpaces,[],0)),
    assert(layouts(InitialLayout)),
    assert(counter(0)).

search :-
    setup,
    goal(Block,X,Y),
    play(Positions,_,Path,N),
    counter(Num),
    ( N>Num ->
      retractall(counter(_)),
      assert(counter(N)),
      writef('%t\n',[N])
    ; true
    ),
    nth0(0,Positions,[Block,X,Y]),
    % output
    write('moves: \n'),
    maplist(nth0(0),Path,P),
    reverse(P,[_|Moves]),
    forall(nth1(Nm,Moves,[Bm,Xm,Ym]),writef(' %t: (%t, %t) %t\n',[Nm,Xm,Ym,Bm])),
    writef(' %t: (%t, %t) %t\n',[N,X,Y,Block]),
    write('final positions:\n'),
    forall(member([Bp,Xp,Yp],Positions),writef(' (%t, %t) %t\n',[Xp,Yp,Bp])).