project/oslik/oslik/oslik-hash.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 geths(150).
  12
  13 % Utility:
  14
  15 map(_,[]).
  16 map(F,[H|T]):-call(F,H),map(F,T).
  17
  18 % l2ll/chop provided by the courtesy of Ghort
  19 l2ll([],_,[]).
  20 l2ll(BL,LEN,[LLh|LLt]):-chop(BL,LEN,LLh,BLr),l2ll(BLr,LEN,LLt).
  21
  22 chop(L,0,[],L):-!.
  23 chop([],_,[],[]).
  24 chop([X|BLt],LEN,[X|Lt],Lr):-LEN1 is LEN-1,chop(BLt,LEN1,Lt,Lr).
  25
  26 reversen(I,N,O):-reversen(I,N,[],O).
  27 reversen([],_,D,D).
  28 reversen(I,N,M,O):-chop(I,N,CHUNK,REST),append(CHUNK,M,BIGRED),reversen(REST,N,BIGRED,O).
  29
  30 dbgxy(X,I,_,O):-O is I+1,write_ln(['dbgxy:',X,'=',I,'->',O]).
  31
  32 forallc(Y,Y,_,_,_,D,_,D).
  33 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).
  34 forall([],X,F,I,D,O):-call(F,X,I,D,O).
  35 forall([Y0,Y1|Yr],X,F,I,D,O):-Y1i is Y1+1,forallc(Y0,Y1i,Yr,X,F,I,D,O).
  36 forall(Y,F,I,D,O):-reversen(Y,2,Yx),forall(Yx,[],F,I,D,O).
  37
  38 split(I,N,A,B):-split(I,N,[],A,B).
  39 split(I,0,J,Jx,I):-reverse(J,Jx).
  40 split([Ih|It],N,Aa,A,B):-
  41         Nd is N-1,split(It,Nd,[Ih|Aa],A,B).
  42
  43 replace(I,N,X,O):-
  44         split(I,N,Ia,[_|Ic]),append(Ia,[X|Ic],O).
  45
  46 prependn(I,N,[X1,X2],O):-
  47         split(I,N,Ia,[Ib|Ic]),dbg_ln(['Ia=',Ia,',Ib=',Ib,',Ic=',Ic]),append(Ia,[[X1,X2|Ib]|Ic],O).
  48
  49 hashval(ST,SThv):-
  50         concat('(',ST,STterm),hash_term(STterm,SThvr),
  51         geths(HS),SThv is SThvr mod HS.
  52
  53 addst(HASH,ST,STo,HASHn):-
  54         hashval(ST,SThv),prependn(HASH,SThv,[ST,STo],HASHn).
  55 getst(HASH,ST,STo):-
  56         hashval(ST,SThv),nth0(SThv,HASH,PL),getkey(PL,ST,STo).
  57
  58 getkey([C,V|_],C,V):-dbg_ln(['getkey-final:C=',C,',V=',V]).
  59 getkey([LhC,LhV|Lt],C,V):-dbg_ln(['getkey-iterate:C=',C,',V=',V,',LhC=',LhC,',LhV=',LhV,',Lt=',Lt]),getkey(Lt,C,V).
  60
  61 replist(_,0,[]).
  62 replist(V,N,[V|Lt]):-Nd is N-1,replist(V,Nd,Lt).
  63
  64 hashsize([],0).
  65 hashsize([Hh|Ht],N):-
  66         dbg_ln(['HASHSIZE:Hh=',Hh,',Ht=',Ht,',N=',N]),
  67         length(Hh,A),hashsize(Ht,B),N is A+B.
  68
  69 % Oslik:
  70
  71 saLX(I,X):-X is I mod 5.
  72 saLY(I,Y):-Y is floor(I/5).
  73 saLXY(I,X,Y):-saLX(I,X),saLY(I,Y).
  74 saXYL(X,Y,I):-I is Y*5+X.
  75 getXY(STl,X,Y,C):-saXYL(X,Y,L),nth0(L,STl,C).
  76
  77 foryi(I,I,_):-dbg_ln(['foryi-final: I=',I]).
  78 foryi(Vyi,Vys,[Vxi,Vxs,Vdx,Vdy,STl,Vsx,Vsy,Vbx,Vby]):-
  79         dbg_ln(['foryi entered,Vxi=',Vxi,',Vyi=',Vyi,',Vsy=',Vsy,',Vys=',Vys,',Vxs=',Vxs]),
  80         ((Vxi-Vsx>(-1),Vxi-Vsx<Vxs,Vyi-Vsy>(-1),Vyi-Vsy<Vys)->true
  81         ;Gx is Vbx-Vdx+Vxi,Gy is Vby-Vdy+Vyi,
  82         getXY(STl,Gx,Gy,C),
  83         string_to_list('+',[C])),
  84         dbg_ln(['foryi middle,Vxi=',Vxi,',Vyi=',Vyi,',Vsy=',Vsy,',Vys=',Vys,',Vxs=',Vxs]),
  85         Vyi1 is Vyi+1,foryi(Vyi1,Vys,[Vxi,Vxs,Vdx,Vdy,STl,Vsx,Vsy,Vbx,Vby])
  86         ,dbg_ln(['foryi leave, success,Vxi=',Vxi,',Vyi=',Vyi,',Vsy=',Vsy,',Vys=',Vys,',Vxs=',Vxs]).
  87
  88 forxi(I,I,_):-dbg_ln(['forxi-final: I=',I]).
  89 forxi(Vxi,Vxs,[Vys|D]):-
  90         dbg_ln(['forxi enter, Vxi=',Vxi,',Vxs=',Vxs]),
  91         foryi(0,Vys,[Vxi,Vxs|D]),
  92         dbg_ln(['forxi middle, Vxi=',Vxi,',Vxs=',Vxs]),
  93         Vxi1 is Vxi+1,forxi(Vxi1,Vxs,[Vys|D])
  94         ,dbg_ln(['forxi leave, success, Vxi=',Vxi,',Vxs=',Vxs]).
  95
  96 fillass([X,Y],STl,C,STlN):-
  97         saXYL(X,Y,L),replace(STl,L,C,STlN).
  98
  99 moveass([X,Y],STl,[STlO,Vsx,Vsy],STlN):-
 100         dbg_ln(['INSIDE moveass:',X,Y,Vsx,Vsy]),
 101         NX is X-Vsx,NY is Y-Vsy,
 102         saXYL(NX,NY,NL),saXYL(X,Y,L),
 103         nth0(L,STlO,C),replace(STl,NL,C,STlN)
 104         ,dbg_ln(['FINISH moveass:C=',C]).
 105
 106 dumpit(_,[],-1).
 107 dumpit(HASH,ST,LEV):-
 108         dbg_ln(['DUMP_IT!:HASH=',HASH,',ST=',ST]),
 109         getst(HASH,ST,STo),
 110         dbg_ln(['DUMP_IT got STo=',STo]),
 111         dumpit(HASH,STo,LEVd),
 112         dbg_ln(['DUMP_IT got LEVd=',LEVd]),
 113         LEV is LEVd+1,
 114         write('> /-------\\ forwardtrace: level='),write_ln(LEV),
 115         dumpst(ST)
 116         ,dbg_ln('DUMP_IT finished!').
 117 dumpit(HASH,ST,LEV):-write_ln(['DUMP_IT FAILURE:HASH=',HASH,',ST=',ST,',LEV=',LEV]),halt.
 118
 119 final(STl,HASH):-
 120         string_to_list('A',[AC]),getXY(STl,3,1,AC),
 121         string_to_list('B',[BC]),getXY(STl,4,1,BC),
 122         string_to_list('C',[CC]),getXY(STl,3,2,CC),
 123         string_to_list('D',[DC]),getXY(STl,4,2,DC),
 124         string_to_list(ST,STl),string_to_atom(ST,STa)
 125         ,write_ln('*** GOAL'),dumpit(HASH,STa,_)
 126         .
 127 final(_,_).
 128
 129 addstate(ST,STo,[[HASH,DOo],[HASHn,DOn]]):-
 130         dbg_ln(['addstate:ST=',ST,',STo=',STo,',HASH=',HASH,',DOo=',DOo,',DOn=',DOn]),
 131         \+ getst(HASH,ST,_),
 132         append(DOo,[ST],DOn),
 133         addst(HASH,ST,STo,HASHn)
 134 %       ,write('***addstate new (HASHo='),write(HASH),write(';ST='),write(ST),write_ln('):'),dumpst(ST),write_ln('+++ was from:'),dumpst(STo)
 135 %       ,write_ln('***addstate:'),dumpst(ST)
 136         ,dbg_ln(['on addstate end, DOn=',DOn]).
 137 addstate(_,_,[H,H]).
 138
 139 chkpos(Vxs,Vys,Vdx,Vdy,[STl,HIST,Vnbx,Vnby,Vsx,Vsy|D]):-
 140         dbg_ln(['chkpos entered,Vnbx=',Vnbx,',Vdx=',Vdx,',HIST=',HIST]),
 141         Vnxb is Vnbx-Vdx,Vnyb is Vnby-Vdy,
 142         Vnxb>(-1),Vnxb+Vxs<6,Vnyb>(-1),Vnyb+Vys<6,
 143         forxi(0,Vxs,[Vys,Vdx,Vdy,STl,Vsx,Vsy|D]),
 144         Vgx is Vnbx-Vdx,Vgy is Vnby-Vdy,
 145         Vgxe is Vgx+Vxs-1,Vgye is Vgy+Vys-1,
 146         dbg_ln(['HERE IT IS:',Vxs,Vys,Vdx,Vdy,STl,HIST,Vnbx,Vnby,D,'Vgx,Vgy=',Vgx,Vgy,',Vgxe,Vgye=',Vgxe,Vgye]),
 147         string_to_list('+',[PLUSC]),
 148         forall([Vgx,Vgxe,Vgy,Vgye],'fillass',STl,PLUSC,STl1),
 149         dbg_ln('AFTER fillass'),
 150         forall([Vgx,Vgxe,Vgy,Vgye],'moveass',STl1,[STl,Vsx,Vsy],STl2),
 151         dbg_ln('AFTER moveass'),
 152 %       dumpsl(STl2),
 153 %       dbg_ln('AFTER moveass AFTER dumpsl'),
 154         string_to_list(ST2,STl2),string_to_atom(ST2,ST2a),
 155         dbg_ln('AFTER 1st string_to_list'),
 156         string_to_list(ST,STl),string_to_atom(ST,STa),
 157         dbg_ln(['BEFORE addstate:HIST=',HIST]),
 158         addstate(ST2a,STa,HIST)
 159         ,dbg_ln(['On end of chkpos,HIST=',HIST]).
 160 chkpos(_,_,_,_,[_,[H,H]|_]).
 161
 162 trymove(C,D):-string_to_list('{',[C]),chkpos(2,1, 0, 0,D).
 163 trymove(C,D):-string_to_list('}',[C]),chkpos(2,1,+1, 0,D).
 164 trymove(C,D):-string_to_list('^',[C]),chkpos(1,2, 0, 0,D).
 165 trymove(C,D):-string_to_list('v',[C]),chkpos(1,2, 0,+1,D).
 166 trymove(C,D):-string_to_list('#',[C]),chkpos(1,1, 0, 0,D).
 167 trymove(C,D):-string_to_list('A',[C]),chkpos(2,2, 0, 0,D).
 168 trymove(C,D):-string_to_list('B',[C]),chkpos(2,2,+1, 0,D).
 169 trymove(C,D):-string_to_list('C',[C]),chkpos(2,2, 0,+1,D).
 170 trymove(C,D):-string_to_list('D',[C]),chkpos(2,2,+1,+1,D).
 171 trymove(_,[_,[H,H]|_]).
 172
 173 foroibody(Vsx,Vsy,PLUS2,STl,HIST):-
 174         dbg_ln(['foroibody:HIST=',HIST]),
 175         saLXY(PLUS2,Vbx,Vby),Vnbx is Vbx+Vsx,Vnby is Vby+Vsy,
 176         Vnbx>(-1),Vnbx<5,Vnby>(-1),Vnby<4,
 177         dbg_ln(['Vnbx=',Vnbx,',Vnby=',Vnby]),
 178         getXY(STl,Vnbx,Vnby,C),
 179         dbg_ln(['trymove{',C,[STl,HIST,Vnbx,Vnby,Vbx,Vby],'}']),
 180         trymove(C,[STl,HIST,Vnbx,Vnby,Vsx,Vsy,Vbx,Vby]).
 181 foroibody(_,_,_,_,[H,H]).
 182
 183 foroi([],_,_,[H,H]).
 184 foroi([[Vsx,Vsy]|Voffs],PLUS2,STl,[HISTo,HISTn]):-
 185         foroibody(Vsx,Vsy,PLUS2,STl,[HISTo,HISTm]),
 186         foroi(Voffs,PLUS2,STl,[HISTm,HISTn]).
 187
 188 oneplus(STl,[HISTo,HISTn],PLUSi,CNT):-
 189         dbg_ln(['CNT=',CNT,',HISTo=',HISTo,',HISTn=',HISTn]),
 190         PLUSi1 is PLUSi+1,chop(STl,PLUSi1,_,STlr),string_to_list('+',[PLUSC]),nth0(PLUS2x,STlr,PLUSC),PLUS2 is PLUSi1+PLUS2x,
 191         foroi([[0,-1],[+1,0],[0,+1],[-1,0]],PLUS2,STl,[HISTo,HISTm]),
 192         CNT1 is CNT+1,oneplus(STl,[HISTm,HISTn],PLUS2,CNT1).
 193 oneplus(_,[H,H],_,2).
 194 oneplus(STl,[H,H],_,CNT):-write_ln(['ONEPLUS FAILURE:CNT=',CNT]),dumpsl(STl),halt.
 195
 196 process(ST,[[HASHo,DOo],HISTn]):-string_to_list(ST,STl),final(STl,HASHo),oneplus(STl,[[HASHo,DOo],HISTn],-1,0).
 197 %runi(T,_):-T>1000.
 198 runi(T,_):-0 is T mod 2000,garbage_collect,fail.
 199 runi(_,D):-run(D).
 200 run([_,[]]).
 201 run([HASH,[DOh|DOt]]):-
 202         process(DOh,[[HASH,DOt],[HASHn,DOn]]),
 203         hashsize(HASHn,TOTAL2),TOTAL is floor(TOTAL2/2),length(DOn,TODO),GONE is TOTAL-TODO,
 204 %       (0 is GONE mod 100->format('~t~d~5|+~t~d~11|=~t~d~17|~n',[GONE,TODO,TOTAL]);true),
 205         !,
 206         runi(GONE,[HASHn,DOn]).
 207
 208 st2ll(ST,LL):-string_to_list(ST,BL),l2ll(BL,5,LL).
 209
 210 dumpc(C):-string_to_list(S,[C]),write(S).
 211 dumpl(L):-write('  | '),map('dumpc',L),write_ln(' |').
 212 dumpst(ST):-
 213         st2ll(ST,LL),dumpll(LL).
 214 dumpll(LL):-map('dumpl',LL),write_ln('  \\-------/').
 215 dumpsl(BL):-l2ll(BL,5,LL),dumpll(LL).
 216
 217 runinit(ST):-string_to_atom(ST,STa),geths(HS),replist([],HS,HASHi),addst(HASHi,STa,[],HASH),run([HASH,[STa]]).
 218 %HIST <=> [[[StrState,ParentStrState]...],[Todo..]]
 219 go:-runinit('{}{}#AB^#+CDv#+{}{}#').