2 * In 1998 by Jan Kratochvil <short@ucw.cz>
3 * This software is public domain.
4 * Prolog investigator had to be retarded and strongly suffered
5 * from progressive form of brain demency.
8 dbg_ln(M):-write_ln(M).
14 map(F,[H|T]):-call(F,H),map(F,T).
16 % l2ll/chop provided by the courtesy of Ghort
18 l2ll(BL,LEN,[LLh|LLt]):-chop(BL,LEN,LLh,BLr),l2ll(BLr,LEN,LLt).
22 chop([X|BLt],LEN,[X|Lt],Lr):-LEN1 is LEN-1,chop(BLt,LEN1,Lt,Lr).
24 reversen(I,N,O):-reversen(I,N,[],O).
26 reversen(I,N,M,O):-chop(I,N,CHUNK,REST),append(CHUNK,M,BIGRED),reversen(REST,N,BIGRED,O).
28 dbgxy(X,I,_,O):-O is I+1,write_ln(['dbgxy:',X,'=',I,'->',O]).
30 forallc(Y,Y,_,_,_,D,_,D).
31 forallc(Y,Y1,Yr,X,F,I,D,O):-forall(Yr,[Y|X],F,I,D,M),Yi is Y+1,forallc(Yi,Y1,Yr,X,F,M,D,O).
32 forall([],X,F,I,D,O):-call(F,X,I,D,O).
33 forall([Y0,Y1|Yr],X,F,I,D,O):-Y1i is Y1+1,forallc(Y0,Y1i,Yr,X,F,I,D,O).
34 forall(Y,F,I,D,O):-reversen(Y,2,Yx),forall(Yx,[],F,I,D,O).
36 split(I,N,A,B):-split(I,N,[],A,B).
37 split(I,0,J,Jx,I):-reverse(J,Jx).
38 split([Ih|It],N,Aa,A,B):-
39 Nd is N-1,split(It,Nd,[Ih|Aa],A,B).
42 split(I,N,Ia,[_|Ic]),append(Ia,[X|Ic],O).
46 saLX(I,X):-X is I mod 5.
47 saLY(I,Y):-Y is floor(I/5).
48 saLXY(I,X,Y):-saLX(I,X),saLY(I,Y).
49 saXYL(X,Y,I):-I is Y*5+X.
50 getXY(STl,X,Y,C):-saXYL(X,Y,L),nth0(L,STl,C).
52 foryi(I,I,_):-dbg_ln(['foryi-final: I=',I]).
53 foryi(Vyi,Vys,[Vxi,Vxs,Vdx,Vdy,STl,Vsx,Vsy,Vbx,Vby]):-
54 dbg_ln(['foryi entered,Vxi=',Vxi,',Vyi=',Vyi,',Vsy=',Vsy,',Vys=',Vys,',Vxs=',Vxs]),
55 ((Vxi-Vsx>(-1),Vxi-Vsx<Vxs,Vyi-Vsy>(-1),Vyi-Vsy<Vys)->true
56 ;Gx is Vbx-Vdx+Vxi,Gy is Vby-Vdy+Vyi,
58 string_to_list('+',[C])),
59 dbg_ln(['foryi middle,Vxi=',Vxi,',Vyi=',Vyi,',Vsy=',Vsy,',Vys=',Vys,',Vxs=',Vxs]),
60 Vyi1 is Vyi+1,foryi(Vyi1,Vys,[Vxi,Vxs,Vdx,Vdy,STl,Vsx,Vsy,Vbx,Vby])
61 ,dbg_ln(['foryi leave, success,Vxi=',Vxi,',Vyi=',Vyi,',Vsy=',Vsy,',Vys=',Vys,',Vxs=',Vxs]).
63 forxi(I,I,_):-dbg_ln(['forxi-final: I=',I]).
64 forxi(Vxi,Vxs,[Vys|D]):-
65 dbg_ln(['forxi enter, Vxi=',Vxi,',Vxs=',Vxs]),
66 foryi(0,Vys,[Vxi,Vxs|D]),
67 dbg_ln(['forxi middle, Vxi=',Vxi,',Vxs=',Vxs]),
68 Vxi1 is Vxi+1,forxi(Vxi1,Vxs,[Vys|D])
69 ,dbg_ln(['forxi leave, success, Vxi=',Vxi,',Vxs=',Vxs]).
71 fillass([X,Y],STl,C,STlN):-
72 saXYL(X,Y,L),replace(STl,L,C,STlN).
74 moveass([X,Y],STl,[STlO,Vsx,Vsy],STlN):-
75 dbg_ln(['INSIDE moveass:',X,Y,Vsx,Vsy]),
76 NX is X-Vsx,NY is Y-Vsy,
77 saXYL(NX,NY,NL),saXYL(X,Y,L),
78 nth0(L,STlO,C),replace(STl,NL,C,STlN)
79 ,dbg_ln(['FINISH moveass:C=',C]).
83 dbg_ln(['DUMP_IT!:ST=',ST]),
85 dbg_ln(['DUMP_IT got STo=',STo]),
87 dbg_ln(['DUMP_IT got LEVd=',LEVd]),
89 write('> /-------\\ forwardtrace: level='),write_ln(LEV),
91 ,dbg_ln('DUMP_IT finished!').
92 dumpit(ST,LEV):-write_ln(['DUMP_IT FAILURE:ST=',ST,',LEV=',LEV]),halt.
95 string_to_list('A',[AC]),getXY(STl,3,1,AC),
96 string_to_list('B',[BC]),getXY(STl,4,1,BC),
97 string_to_list('C',[CC]),getXY(STl,3,2,CC),
98 string_to_list('D',[DC]),getXY(STl,4,2,DC),
99 string_to_list(ST,STl),string_to_atom(ST,STa)
100 ,write_ln('*** GOAL'),dumpit(STa,_)
101 ,flag('GOALS',GOALS,GOALS+1),(0 is GOALS mod 20->garbage_collect).
105 dbg_ln(['addstate:ST=',ST,',STo=',STo]),
107 assert(todo(ST)),flag('TODO',TODO,TODO+1),assert(hash(ST,STo)),flag('TOTAL',TOTAL,TOTAL+1)
108 % ,write('***addstate new (HASHo='),write(HASH),write(';ST='),write(ST),write_ln('):'),dumpst(ST),write_ln('+++ was from:'),dumpst(STo)
109 % ,write_ln('***addstate:'),dumpst(ST)
110 ,dbg_ln('on addstate end').
113 chkpos(Vxs,Vys,Vdx,Vdy,[STl,Vnbx,Vnby,Vsx,Vsy|D]):-
114 dbg_ln(['chkpos entered,Vnbx=',Vnbx,',Vdx=',Vdx]),
115 Vnxb is Vnbx-Vdx,Vnyb is Vnby-Vdy,
116 Vnxb>(-1),Vnxb+Vxs<6,Vnyb>(-1),Vnyb+Vys<6,
117 forxi(0,Vxs,[Vys,Vdx,Vdy,STl,Vsx,Vsy|D]),
118 Vgx is Vnbx-Vdx,Vgy is Vnby-Vdy,
119 Vgxe is Vgx+Vxs-1,Vgye is Vgy+Vys-1,
120 dbg_ln(['HERE IT IS:',Vxs,Vys,Vdx,Vdy,STl,Vnbx,Vnby,D,'Vgx,Vgy=',Vgx,Vgy,',Vgxe,Vgye=',Vgxe,Vgye]),
121 string_to_list('+',[PLUSC]),
122 forall([Vgx,Vgxe,Vgy,Vgye],'fillass',STl,PLUSC,STl1),
123 dbg_ln('AFTER fillass'),
124 forall([Vgx,Vgxe,Vgy,Vgye],'moveass',STl1,[STl,Vsx,Vsy],STl2),
125 dbg_ln('AFTER moveass'),
127 % dbg_ln('AFTER moveass AFTER dumpsl'),
128 string_to_list(ST2,STl2),string_to_atom(ST2,ST2a),
129 dbg_ln('AFTER 1st string_to_list'),
130 string_to_list(ST,STl),string_to_atom(ST,STa),
131 dbg_ln('BEFORE addstate'),
133 ,dbg_ln('On end of chkpos').
136 trymove(C,D):-string_to_list('{',[C]),chkpos(2,1, 0, 0,D).
137 trymove(C,D):-string_to_list('}',[C]),chkpos(2,1,+1, 0,D).
138 trymove(C,D):-string_to_list('^',[C]),chkpos(1,2, 0, 0,D).
139 trymove(C,D):-string_to_list('v',[C]),chkpos(1,2, 0,+1,D).
140 trymove(C,D):-string_to_list('#',[C]),chkpos(1,1, 0, 0,D).
141 trymove(C,D):-string_to_list('A',[C]),chkpos(2,2, 0, 0,D).
142 trymove(C,D):-string_to_list('B',[C]),chkpos(2,2,+1, 0,D).
143 trymove(C,D):-string_to_list('C',[C]),chkpos(2,2, 0,+1,D).
144 trymove(C,D):-string_to_list('D',[C]),chkpos(2,2,+1,+1,D).
147 foroibody(Vsx,Vsy,PLUS2,STl):-
149 saLXY(PLUS2,Vbx,Vby),Vnbx is Vbx+Vsx,Vnby is Vby+Vsy,
150 Vnbx>(-1),Vnbx<5,Vnby>(-1),Vnby<4,
151 dbg_ln(['Vnbx=',Vnbx,',Vnby=',Vnby]),
152 getXY(STl,Vnbx,Vnby,C),
153 dbg_ln(['trymove{',C,[STl,Vnbx,Vnby,Vbx,Vby],'}']),
154 trymove(C,[STl,Vnbx,Vnby,Vsx,Vsy,Vbx,Vby]).
158 foroi([[Vsx,Vsy]|Voffs],PLUS2,STl):-
159 foroibody(Vsx,Vsy,PLUS2,STl),
160 foroi(Voffs,PLUS2,STl).
162 oneplus(STl,PLUSi,CNT):-
163 dbg_ln(['CNT=',CNT]),
164 PLUSi1 is PLUSi+1,chop(STl,PLUSi1,_,STlr),string_to_list('+',[PLUSC]),
165 dbg_ln('oneplus search begin'),
166 nth0(PLUS2x,STlr,PLUSC),
167 dbg_ln('oneplus search passed'),
168 PLUS2 is PLUSi1+PLUS2x,
169 foroi([[0,-1],[+1,0],[0,+1],[-1,0]],PLUS2,STl),
170 CNT1 is CNT+1,oneplus(STl,PLUS2,CNT1).
172 oneplus(STl,_,CNT):-write_ln(['ONEPLUS FAILURE:CNT=',CNT]),dumpsl(STl),halt.
174 process(ST):-dbg_ln(['process:ST=',ST]),string_to_list(ST,STl),final(STl),oneplus(STl,-1,0).
176 runi(T):-0 is T mod 2000,garbage_collect,fail.
179 flag('TODO',TODO,TODO),flag('TOTAL',TOTAL,TOTAL),GONE is TOTAL-TODO,
180 % (GONE>0,0 is GONE mod 100->format('~t~d~5|+~t~d~11|=~t~d~17|~n',[GONE,TODO,TOTAL]);true),
181 TODO>0,todo(ST),retract(todo(ST)),flag('TODO',TODO,TODO-1),process(ST),!,runi(GONE).
184 st2ll(ST,LL):-string_to_list(ST,BL),l2ll(BL,5,LL).
186 dumpc(C):-string_to_list(S,[C]),write(S).
187 dumpl(L):-write(' | '),map('dumpc',L),write_ln(' |').
189 st2ll(ST,LL),dumpll(LL).
190 dumpll(LL):-map('dumpl',LL),write_ln(' \\-------/').
191 dumpsl(BL):-l2ll(BL,5,LL),dumpll(LL).
193 runinit(ST):-assert(hash(ST,[])),flag('TOTAL',_,1),flag('TODO',_,1),assert(todo(ST)),run.
194 go:-flag('GOALS',_,0),runinit('{}{}#AB^#+CDv#+{}{}#').