project/oslik/oslik/oslik-assert.pl

   1 /* OSLIK
   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.
   6  */
   7
   8 dbg_ln(M):-write_ln(M).
   9 %dbg_ln(_).
  10
  11 % Utility:
  12
  13 map(_,[]).
  14 map(F,[H|T]):-call(F,H),map(F,T).
  15
  16 % l2ll/chop provided by the courtesy of Ghort
  17 l2ll([],_,[]).
  18 l2ll(BL,LEN,[LLh|LLt]):-chop(BL,LEN,LLh,BLr),l2ll(BLr,LEN,LLt).
  19
  20 chop(L,0,[],L):-!.
  21 chop([],_,[],[]).
  22 chop([X|BLt],LEN,[X|Lt],Lr):-LEN1 is LEN-1,chop(BLt,LEN1,Lt,Lr).
  23
  24 reversen(I,N,O):-reversen(I,N,[],O).
  25 reversen([],_,D,D).
  26 reversen(I,N,M,O):-chop(I,N,CHUNK,REST),append(CHUNK,M,BIGRED),reversen(REST,N,BIGRED,O).
  27
  28 dbgxy(X,I,_,O):-O is I+1,write_ln(['dbgxy:',X,'=',I,'->',O]).
  29
  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).
  35
  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).
  40
  41 replace(I,N,X,O):-
  42         split(I,N,Ia,[_|Ic]),append(Ia,[X|Ic],O).
  43
  44 % Oslik:
  45
  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).
  51
  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,
  57         getXY(STl,Gx,Gy,C),
  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]).
  62
  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]).
  70
  71 fillass([X,Y],STl,C,STlN):-
  72         saXYL(X,Y,L),replace(STl,L,C,STlN).
  73
  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]).
  80
  81 dumpit([],-1).
  82 dumpit(ST,LEV):-
  83         dbg_ln(['DUMP_IT!:ST=',ST]),
  84         hash(ST,STo),
  85         dbg_ln(['DUMP_IT got STo=',STo]),
  86         dumpit(STo,LEVd),
  87         dbg_ln(['DUMP_IT got LEVd=',LEVd]),
  88         LEV is LEVd+1,
  89         write('> /-------\\ forwardtrace: level='),write_ln(LEV),
  90         dumpst(ST)
  91         ,dbg_ln('DUMP_IT finished!').
  92 dumpit(ST,LEV):-write_ln(['DUMP_IT FAILURE:ST=',ST,',LEV=',LEV]),halt.
  93
  94 final(STl):-
  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).
 102 final(_).
 103
 104 addstate(ST,STo):-
 105         dbg_ln(['addstate:ST=',ST,',STo=',STo]),
 106         \+ hash(ST,_),
 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').
 111 addstate(_,_).
 112
 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'),
 126 %       dumpsl(STl2),
 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'),
 132         addstate(ST2a,STa)
 133         ,dbg_ln('On end of chkpos').
 134 chkpos(_,_,_,_,_).
 135
 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).
 145 trymove(_,_).
 146
 147 foroibody(Vsx,Vsy,PLUS2,STl):-
 148         dbg_ln('foroibody'),
 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]).
 155 foroibody(_,_,_,_).
 156
 157 foroi([],_,_).
 158 foroi([[Vsx,Vsy]|Voffs],PLUS2,STl):-
 159         foroibody(Vsx,Vsy,PLUS2,STl),
 160         foroi(Voffs,PLUS2,STl).
 161
 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).
 171 oneplus(_,_,2).
 172 oneplus(STl,_,CNT):-write_ln(['ONEPLUS FAILURE:CNT=',CNT]),dumpsl(STl),halt.
 173
 174 process(ST):-dbg_ln(['process:ST=',ST]),string_to_list(ST,STl),final(STl),oneplus(STl,-1,0).
 175 %runi(T):-T>1000.
 176 runi(T):-0 is T mod 2000,garbage_collect,fail.
 177 runi(_):-run.
 178 run:-
 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).
 182 run.
 183
 184 st2ll(ST,LL):-string_to_list(ST,BL),l2ll(BL,5,LL).
 185
 186 dumpc(C):-string_to_list(S,[C]),write(S).
 187 dumpl(L):-write('  | '),map('dumpc',L),write_ln(' |').
 188 dumpst(ST):-
 189         st2ll(ST,LL),dumpll(LL).
 190 dumpll(LL):-map('dumpl',LL),write_ln('  \\-------/').
 191 dumpsl(BL):-l2ll(BL,5,LL),dumpll(LL).
 192
 193 runinit(ST):-assert(hash(ST,[])),flag('TOTAL',_,1),flag('TODO',_,1),assert(todo(ST)),run.
 194 go:-flag('GOALS',_,0),runinit('{}{}#AB^#+CDv#+{}{}#').