FREECELL Solver

Having trouble solving a praticular FREECELL game? Maybe this program can show you the solution! Just create a text file named "GAME.TXT" indicating the starting arrangement of the cards. (For example, to solve FREECELL game number 27188, you would create this text file.)

[Note: Depending on the particular game being solved, the execution time for this program can range anywhere from a few seconds to many days!]

Source Listing

// // Program: FREECELL Solver // Author: Bob Bishop // // (Spacebar toggles sound on/off) Pro-SiMPLE Common Int level, nfc, ncol Common Int blist[10], nlist[10] path=Param[1] If (path="") path="game.txt" init (path) @ start: a=11; b=12 Do moves=test (a, b) If moves If !repeat (a, blist[0]) Do k=1,moves make move (a, blist[k-1], nlist[k-1], k, 0) @ Loop auto move @ If nfc+ncol<level Goto start report @ quit Endif Endif Do next (a, b) @ If a=11 And b=12 take move (a, b) @ Continue Endif If a!=b Break Loop Loop Int repeat (Int aa, Int bb) Common Int stack[250], sp Int a, b If aa>7 Return 0 If bb>7 And bb<12 val=stack[sp] +b_=(val_>>4)&15; +a_=val_&15; If a=aa And b>7 And b<12 Return 1 val=stack[sp+1] +b_=(val_>>4)&15; +a_=val_&15; If a=aa And b>7 And b<12 Return 1 Endif Return 0 //////////////////////////////////////////////////////// Task init (Text path) Common Int free[4], home[4], board[8][20] Common Int level, xflag, stack[250] Common Int nfc=4, ncol=0 Common Int total, state, sub, subsub Common Text title Text line Do k=0,249 stack[k]=0 Loop start timer command="read "+path open a (command) read line a (title, 0) read line a (line, 0) level=ttoi(extract(line,0,1)) If (!level Or level>12)level=12 If (length(line)>2) xflag=1 Else xflag=0 Do k=1,7 read line a (line, 0) n=7; If (k=7) n=3 Do j=0,n rank=extract(line,3*j,3*j) If (rank~"A") card=16 If (ascii(rank)>49 And ascii(rank)<58) card=16*(ascii(rank)-48) If (rank~"T" Or rank~"X") card=160 If (rank~"J") card=16*11 If (rank~"Q") card=16*12 If (rank~"K") card=16*13 suit=extract(line,3*j+1,3*j+1) If (suit~"C") card=card+1 If (suit~"D") card=card+2 If (suit~"S") card=card+3 If (suit~"H") card=card+4 board[j][k]=card Loop j Loop k close a Do k=0,3 board[k][0]=7 free[k]=0 board[k+4][0]=6 home[k]=0 Loop total=0; state=0 a=11; b=12 Do moves=test (a, b) If moves Set total=total+1 next (a, b) @ If a=11 And b=12 Break Loop show @ //////////////////////////////////////////////////////// Int test (Int a, Int b) Common Int blist[10], nlist[10] Common Int free[4], home[4], board[8][20] Common Int nfc, ncol Common Int aid, asuit, arank, board a0 //Must be supplied to GET RUN !!! Int bsuit, brank blist[0]=b; nlist[0]=0 If a<8 And b<8 Return column proc (a, b) If (a<8) board a0=board[a][0] aid=board[a][board a0] Endif Else aid=free[a-8] If !aid Return 0 +arank_=aid_>>4; +asuit_=aid_&15; If b<8 Set bid=board[b][board[b][0]] If b>7 And b<12 Set bid=free[b-8] If b>11 And b<16 Set bid=home[b-12] +brank_=bid_>>4; +bsuit_=bid_&15; nlist[0]=1 If b>11 If asuit!=bsuit Return 0 If arank!=brank+1 Return 0 Return 1 Endif If b>7 If a>7 Or bid Return 0 If nfc>1 Do k=0,b-9,1 If !free[k] Return 0 Loop Endif run=get run(a); If run=board a0 Return 0 If run>nfc+ncol Return 0 xs=run-1 Return finish(xs, b) Endif //If !bid Return 0 //??? If arank+1!=brank Return 0 Return (asuit+bsuit)%2 //////////////////////////////////////////////////////// Int column proc (Int a, Int b) Common Int blist[10], nlist[10] Common Int free[4], home[4], board[8][20] Common Int clock Common Int nfc, ncol Common Int aid, asuit, arank, board a0 //Must be supplied to GET RUN !!! Int bsuit, brank, suit, rank board a0=board[a][0] aid=board[a][board a0] If !aid Return 0 +arank_=aid_>>4; +asuit_=aid_&15; bid=board[b][board[b][0]] //Move to an empty column? If !bid If ncol>1 Do k=0,b-1,1 If !board[k][0] Return 0 Loop Endif run=get run(a) If run=board a0 Return 0//No sense in just moving a whole column normax=nfc+1; max=normax power=1 Do k=0,7 If (!board[k][0]) power=2*power Loop max=(nfc+1)*power/2 If (run>max+nfc+ncol-1) Return 0 If (run<=normax) nlist[0]=run Return 1 Endif If (run<=max) nlist[0]=-run Return 1 Endif nlist[0]=-max xs=run-max Return finish(xs, b) Endif //Move to an non-empty column +brank_=bid_>>4; +bsuit_=bid_&15; If (arank+brank)%2!=(asuit+bsuit)%2 Return 0 //Wrong group If (arank>=brank) Return 0 max=(nfc+1)*(ncol+1) number=brank-arank If number>max Return 0 run=get run(a) If arank+run<brank Return 0 xs=run-number If xs>nfc+ncol Return 0 If xs And run=board a0 Return 0 //Can't "xs" a final card nlist[0]=number Return finish(xs, b) //////////////////////////////////////////////////////// Int finish (Int xs, Int b) Common Int blist[10], nlist[10] Common Int free[4], home[4], board[8][20] If !xs Return 1 If !xflag Return 0 ind=0 Do k=0,3 If free[k] Or k+8=b Continue ind=ind+1 blist[ind]=k+8 nlist[ind]=1 xs=xs-1 If !xs Return ind+1 Loop Do k=0,7 If board[k][0] Or k=b Continue ind=ind+1 blist[ind]=k nlist[ind]=1 xs=xs-1 If !xs Return ind+1 Loop Display "Uh-oh...",xs quit //////////////////////////////////////////////////////// Int get run (Int a) Common Int free[4], home[4], board[8][20] Common Int aid, asuit, arank, board a0 //Must be supplied to GET RUN !!! Int suit, rank crank=arank; csuit=asuit Do run=1,board a0-1 id=board[a][board a0-run] +rank_=id_>>4; +suit_=id_&15; If rank-1!=crank Or (suit+csuit)%2=0 Return run crank=rank; csuit=suit Loop Return run //////////////////////////////////////////////////////// Task move (Int a, Int b, Int n) Common Int free[4], home[4], board[8][20] Common Int nfc, ncol If a<8 And b<8 If (board[a][0]=n) ncol=ncol+1 If (board[b][0]=0) ncol=ncol-1 andx=board[a][0]-n; bndx=board[b][0] Do k=1,n board[b][bndx+k]=board[a][andx+k] Loop board[a][0]=andx; board[b][0]=bndx+n Return Endif If a<8 And b>7 And b<12 free[b-8]=board[a][board[a][0]] board[a][0]=board[a][0]-1 If (!board[a][0]) ncol=ncol+1 nfc=nfc-1; Return Endif If a<8 And b>11 home[b-12]=board[a][board[a][0]] board[a][0]=board[a][0]-1 If (!board[a][0]) ncol=ncol+1 Return Endif If a>7 And a<12 And b<8 If (!board[b][0]) ncol=ncol-1 board[b][0]=board[b][0]+1 board[b][board[b][0]]=free[a-8] free[a-8]=0 nfc=nfc+1; Return Endif If a>7 And a<12 And b>11 home[b-12]=free[a-8] free[a-8]=0 nfc=nfc+1; Return Endif If a>11 val=home[a-12] home[a-12]=val-16 If (home[a-12]<16) home[a-12]=0 If b<8 If (!board[b][0]) ncol=ncol-1 board[b][0]=board[b][0]+1 board[b][board[b][0]]=val Endif Else free[b-8]=val nfc=nfc-1 Endif Return Endif Display "OOPS!"; quit /////////////////////////////////////////////////////// Task make move (Int a, Int b, Int n, Int multi, Int auto) Common Int stack[250], sp=0, maxsp=0, noise Common Int total, state, sub, subsub move (a, b, iabs(n)) @ stack[sp]=4096*auto+256*iabs(n)+16*b+a If (n<0) stack[sp]=stack[sp]+8192 If (multi>1) stack[sp]=stack[sp]+16384 If !sp state=state+1 sub=0 Endif If sp=1 sub=sub+1 subsub=0 Endif If sp=2 subsub=subsub+1 maxsp=0 Endif sp=sp+1 If (noise) sound (16*sp) If sp>maxsp Set maxsp=sp show @ If sp<250 Return tabxy (1, 23); Display "Stack overflow" quit //////////////////////////////////////////////////////// Task take move (Int a, Int b) Common Int stack[250], sp, maxsp, clock Common Int total, state, sub, subsub Int multi, auto, n Do sp=sp-1 If sp<0 maxsp=0; state=total sub=0; subsub=0 clock=-1; show @ tabxy (1, 23) Display "No solution was found" quit Endif val=stack[sp] +multi_=val_&16384; +auto_=val_&4096; +n_=(val_>>8)&15; +b_=(val_>>4)&15; +a_=val_&15; move (b, a, n) @ show @ If !multi And !auto Return Loop //////////////////////////////////////////////////////// Task auto move Common Int free[4], home[4], board[8][20] Common Int rlow, blow Do +blow_=home_[0]>>4; +if(blow_>(home_[2]>>4)){blow_=home_[2]>>4;} +rlow_=home_[1]>>4; +if(rlow_>(home_[3]>>4)){rlow_=home_[3]>>4;} flag=0 Do k=0,7 aid=board[k][board[k][0]] If !aid Continue guts (k, aid, flag) @ Loop Do k=0,3 aid=free[k] If !aid Continue guts (k+8, aid, flag) @ Loop If !flag Return Loop Task guts (Int a, Int aid, Int flag) * Common Int free[4], home[4], board[8][20] Common Int rlow, blow Int arank, asuit +arank_=aid_>>4; +asuit_=aid_&15; If arank=1 //Found an Ace make move (a, 11+asuit, 1, 1, 1) @ flag=1; Return Endif If arank=2 And home[asuit-1] //Found a Deuce make move (a, 11+asuit, 1, 1, 1) @ flag=1; Return Endif If asuit%2// Black card? If arank<=rlow+1 +if(home_[asuit_-1]>>4!=arank_-1){return;} make move (a, 11+asuit, 1, 1, 1) @ flag=1; Return Endif Endif Else //Red card! If arank<=blow+1 +if(home_[asuit_-1]>>4!=arank_-1){return;} make move (a, 11+asuit, 1, 1, 1) @ flag=1; Return Endif Endif //////////////////////////////////////////////////////// Task next (Int a, Int b) Common Int free[4], home[4], board[8][20] +if(++b_<16){return;} b=0 next: +if(--a_<0){a_=11;return;} If a<8 If !board[a][0] Goto next //Nothing to move! If board[a][0]=1 And b>7 And b<12 Goto next Endif Else If !free[a-8] Goto next //Nothing to move! If b>7 And b<12 Goto next Endelse //////////////////////////////////////////////////////// Task show Common Text title Common Int free[4], home[4], board[8][20] Common Int sp, maxsp, clock=-1, noise=0 Common Int nfc, ncol Common Int total, state, sub, subsub clock=(clock+1)%10000; If clock Return If readkey(32) noise=!noise If (!noise) no sound Endif cls; Display Display " Game Number: ",title, htab (31); Display "FREECELL SOLVER 4.19", htab (60); Display "Probe ",state,".",sub,".",subsub," of ",total et=elapsed time()/100 Display " Time: ",et/10,".",et%10, htab (60); Display "Stack Level: ",maxsp,"/",sp tabxy (26, 4) Do k=0,3 dump(free[k]) @ Loop htab (44) Do k=0,3 dump(home[k]) @ Loop max=0 Do k=0,7 If (board[k][0]>max) max=board[k][0] Loop Display Do row=1,max,1 Display; htab (29) Do k=0,7 If row>board[k][0] Display "-- ", Else dump (board[k][row]) @ Loop Loop tabxy (1, 25) Task dump (Int card) * Int rank, suit +rank_=card_>>4; +suit_=card_&15; If rank=0 Display "-", If rank=1 Display "A", If rank>1 And rank<10 Display rank, If rank=10 Display "T", If rank=11 Display "J", If rank=12 Display "Q", If rank=13 Display "K", If suit=0 Display "- ", If suit=1 Display char(5),, If suit=2 Display char(4),, If suit=3 Display char(6),, If suit=4 Display char(3),, //////////////////////////////////////////////////////// Task report Common Text title Common Int stack[250], sp, maxsp Common Int level, clock Int a, b, auto, macro, n sound (666) clock=-1; show @ tabxy (37, 10); cprint ("Eureka!", 15, 0) output mode (2) output (" Game Number:",1) output (title); output Do k=0,sp-1 t=" Move " val=stack[k] +macro_=val_&8192; If (macro) t="Macromove " +auto_=val_&4096; If (auto) t="Automoved " +n_=(val_>>8)&15; t=t+itot(n)+" card" If (n>1) t=t+"s " Else t=t+" " +b_=(val_>>4)&15; +a_=val_&15; If (a<8 And b< 8) t=t+"from column "+char(a+49)+ " to column "+char(b+49) If (a<8 And b>7 And b<12) t=t+"from column "+char(a+49)+ " to cell "+char(b-8+49) If (a<8 And b>11) t=t+"from column "+char(a+49)+ " to home" If (b<8 And a> 7) t=t+"from cell "+char(a-8+49)+" to column "+char(b+49) If (a>7 And b>11) t=t+"from cell "+char(a-8+49)+" to home" output (t) Loop delay (100); nosound tabxy (21, 16); cprint ("[ Press any key to view the solution ]", 14, 0) tabxy (1, 20); Display "________________________________________________________________________________" tabxy (28, 23); cprint ("(www.simplecodeworks.com)", 9, 0) flush kbd; waitkey system ("notepad output")

How To Run The Program If you're feeling ambitious and have nothing better to do, you could just copy the source listing by hand! However, there is a much easier way to do it: Copy the source listing into the Windows Clipboard Paste the Clipboard into a new text document Drop that text document onto the "Drop SiMPLE Listing Here" icon

(If you would like to contribute any of your SiMPLE programs to The Gallery, just e-mail them to us.)

  [ Webmaster | FAQ's | Home Page | Contact Us ]

© Copyright 2006 SiMPLE CodeWorks, Inc. All rights reserved.