\ Article: 53305 of comp.lang.forth \ Path: news.tuwien.ac.at!aconews.univie.ac.at!news-fra1.dfn.de!news-koe1.dfn.de!news-was.dfn.de!nntp-out.monmouth.com!newspeer.monmouth.com!newsfeed.clear.net.nz!news.clear.net.nz.POSTED!not-for-mail \ From: "Bruce Hoyt" \ Newsgroups: comp.lang.forth \ Subject: Pentomino solutions code, explanation \ Lines: 124 \ MIME-Version: 1.0 \ Content-Type: text/plain; \ charset="Windows-1252" \ Content-Transfer-Encoding: 7bit \ X-Priority: 3 \ X-MSMail-Priority: Normal \ X-Newsreader: Microsoft Outlook Express 5.00.2919.6600 \ X-MimeOLE: Produced By Microsoft MimeOLE V5.00.2919.6600 \ Message-ID: <2ncw4.335$t_2.4091@news.clear.net.nz> \ Date: Sun, 5 Mar 2000 07:13:31 +1300 \ NNTP-Posting-Host: 203.96.130.60 \ X-Complaints-To: abuse@clear.net.nz \ X-Trace: news.clear.net.nz 952193598 203.96.130.60 (Sun, 05 Mar 2000 07:13:18 NZDT) \ NNTP-Posting-Date: Sun, 05 Mar 2000 07:13:18 NZDT \ Organization: CLEAR Net http://www.clear.net.nz/ \ Xref: news.tuwien.ac.at comp.lang.forth:53305 \ Here follows an explanation of the Pentomino solutions code \ The Twelve Pentominoes \ ff i l n pp ttt u u v w x y zz \ ff i l nn pp t uuu v ww xxx yy z \ f i l n p vvv ww x y zz \ i ll n y \ i \ These are all twelve planar shapes consisting of 5 adjacent \ squares. They can be fit into a 6x10 rectangle in exactly 2339 \ way not counting rotations and mirror images. \ First two solutions found by PENTOM \ uuxppp uuxppp \ uxxxpp uxxxpp \ uuxttt uuxttt \ yyyytn yyyytn \ lywwtn iywwtn \ lwwfnn iwwfnn \ lwffnv iwffnv \ llzffv izzffv \ zzzvvv izlvvv \ aiiiii zzllll \ PENTOM does an exhaustive search for all solutions of the \ pentomino puzzle for the given board. The method is to find the \ first empty square (called lead square) and then place \ recursively all available pieces in all possible orientations. \ When the last square on the board is reached, a solution has \ been found and the solution is printed on the screen. \ The excellence of this algorithm is in method of testing whether \ pieces and their orientations fit at a given location. A simple \ but slow method is to list all pieces in all orientations (there \ are 63 possibilities) and go through the full list each time. \ This method is slow since all pieces will be tried even though \ none will fit (for example in a one-square hole bounded on all \ sides). \ My method is to test squares increasingly far from the lead \ square. Thus a hole too small for any pieces to fit will be \ found quickly. Branching out to the right and below yields all \ 63 possible orientations. This branching is encoded as a binary \ tree. Traversing the tree is the means by which all pieces in \ all their orientations are tried starting at the lead square. \ Rather than traverse the tree by observation and then test the \ squares on the board to see if they are empty, I have hard-coded \ the testing of the squares on the board using postpone. This is \ done by two forth macros which compile the necessary code: \ 'leaf-test' and 'testsq'. The tricky bit (tricky to understand \ what is happening) is the postponing of if and then in the \ recursive macro testsq. But it works! The two macros generate \ over 6000 cells of code of threaded code. \ Another not so obvious speed up in the code is to traverse the \ board across the shorter side, i.e. across rows of 6 squares \ rather than across rows of 10 squares. To understand why this is \ so consider what happens when a too-small hole occurs below the \ piece being placed. It won't be found as quickly if the board is \ oriented the long way. \ A further speed up is to manually place the 'x' in all possible \ positions in the upper left quadrant of the board. This has the \ additional side effect of eliminating mirror images and \ rotations from the solutions. \ Of course a great speed improvement can be had by coding the \ guts in assembly -- about 50 times on my 16 bit DTC forth. \ The pentomino shapes can all be placed in an 8x5 rectangle (see \ below) using position A as lead square. There are 63 \ orientations which are encoded as a character string. \ ...ABCDE \ FGHIJKL. \ .OPQRS.. \ ..XYZ... \ ...a.... \ Posn piece orientation \ ABCDE i ABCDE \ I l ABCDI \ J y ABCDJ \ K y ABCDK \ L l ABCDL \ IH n ABCIH \ J p ABCIJ \ etc. coded in string 'orients' \ \ The broken lines below should be connected \ create orients \ ," ABCDEiIlJyKyLl.IHnJpKuQv.JKpRt.KLnSv..IHGnJpPwQf. \ JKpQpRp.QPzRuYl..JKLnRfSw.RQuSzZl...IHGFlJyOzPfQt. \ JKyPfRf.POwQpXn.QRfYy..JKCuLlQtRfSz.QPfRpYy.RSwZn.. \ QPOvRtXnYy.RSvYyZn.YXlZlai....." \ In the string 'orients' the letters 'A-Z' and 'a' are positions \ in the above 8x5 rectangle. The lower case letters \ 'filnptuvwxyz' are names of the 12 pentomino pieces. \ The recursive routines 'testsq' and 'leaf-test' use the string \ 'orients' to direct the generation of code which tests the \ squares on the board to see if a piece will fit. Each position \ letter (A-Z,a) causes the generation of code to check a square \ on the board. Each piece name (filnptuvwxyz) generates code to \ test piece availability. The '.' characters signal an unrecurse. \ What use is it? Dunno! But it's fun. Could use it as an addition \ to Hanoi for a benchmark. It does test simple code generated by \ postpone. \ Bruce Hoyt \ Article: 53328 of comp.lang.forth \ Path: news.tuwien.ac.at!newsfeed03.univie.ac.at!newsrouter.chello.at!newsfeed01.sul.t-online.de!newsfeed00.sul.t-online.de!t-online.de!newsfeed.icl.net!news-hub.cableinet.net!newsfeed.skycache.com!howland.erols.net!newsfeed.cwix.com!newsfeed.clear.net.nz!news.clear.net.nz.POSTED!not-for-mail \ From: "Bruce Hoyt" \ Newsgroups: comp.lang.forth \ References: <2ncw4.335$t_2.4091@news.clear.net.nz> <8a0hrv$geg$1@news.tuwien.ac.at> \ Subject: Re: Pentomino solutions code, explanation \ Lines: 105 \ MIME-Version: 1.0 \ Content-Type: text/plain; \ charset="Windows-1252" \ Content-Transfer-Encoding: 7bit \ X-Priority: 3 \ X-MSMail-Priority: Normal \ X-Newsreader: Microsoft Outlook Express 5.00.2919.6600 \ X-MimeOLE: Produced By Microsoft MimeOLE V5.00.2919.6600 \ Message-ID: \ Date: Tue, 7 Mar 2000 08:04:54 +1300 \ NNTP-Posting-Host: 203.96.130.11 \ X-Complaints-To: abuse@clear.net.nz \ X-Trace: news.clear.net.nz 952369484 203.96.130.11 (Tue, 07 Mar 2000 08:04:44 NZDT) \ NNTP-Posting-Date: Tue, 07 Mar 2000 08:04:44 NZDT \ Organization: CLEAR Net http://www.clear.net.nz/ \ Xref: news.tuwien.ac.at comp.lang.forth:53328 \ "Anton Ertl" wrote in message \ news:8a0hrv$geg$1@news.tuwien.ac.at... \ > In article <2ncw4.335$t_2.4091@news.clear.net.nz>, \ > "Bruce Hoyt" writes: \ > >PENTOM does an exhaustive search for all solutions of the \ > >pentomino puzzle for the given board. The method is to find the \ > >first empty square (called lead square) and then place \ > >recursively all available pieces in all possible orientations. \ > \ > I wonder if a bit vector representation of the board and the possible \ > solutions woudn't lead to an even more efficient solution. \ This could save a little time by reducing the code generated by \ 'place-piece' and 'lift-piece'. At present 'place-piece' produces five \ lines of code, one line for each value of RelPos (relative position) for \ the piece being placed: \ 0 over [ RelPos ] literal + c! \ Code using a bit vector representation of the board and a bit \ representation for each of the piece orientations might look like: \ [ RelPosOfCell ] literal @ [ PieceOrientationMask ] literal \ [ ShiftToLeadBit ] rshift and [ RelPosOfCell ] ! \ But there are two gotcha's: \ 1. One must allow for PieceOrientationMask crossing a cell boundary. \ Since a mask needs to be at least 28 bits long to allow for pieces which \ may touch 5 vertical lines on a 7 column wide board. (Not 6 since one \ column is used as a boundary.) \ 2. Although a similar code reduction can be used for 'lift-piece', this \ is not possible in sq0= since the algorithm depends on testing only one \ square on the board at a time, working out from the lead square. \ All in all given the complexity of handling the cell boundary crossing, \ I don't think much speed would be gained. \ > Looking at LEAF-TEST etc., it looks like ]] ... [[ would help \ > readability a lot. I'll have to put it in compat. \ What do [[ and ]] do? \ > >A further speed up is to manually place the 'x' in all possible \ > >positions in the upper left quadrant of the board. This has the \ > >additional side effect of eliminating mirror images and \ > >rotations from the solutions. \ > I have not understood enough about you solution to do the X-ATs for \ > other board sizes. \ Yes, I did not make it clear how to do this. Another example would have \ helped. \ Add the following just before the definition of 'pentom' \ : p4*15 \ 4 X 15 puzzle \ 4 15 pentom-init \ 402 solutions \ 2 2 x-at \ 2 3 x-at \ 2 4 x-at \ 2 5 x-at \ 2 6 x-at \ 2 7 x-at ; \ and in 'pentom' replace p6*10 with p4*15 \ The result should be: \ Total solutions = 402 Total pieces tried = 179081 \ There are many other non-rectangular boards which can be used by \ modifying 'pentom-init'. For example try an 8x8 board with the four \ corner squares removed. \ >Why is there no "2 1 x-at" for the 6*10 board. \ Try putting the 'X' at 2 1 on a real board and you will immediately see. \ Note that these positions are 1 based. One could include "2 1 x-at" but \ the algorithm would immediately eliminate that position as impossible. \ [snip] \ > >The recursive routines 'testsq' and 'leaf-test' use the string \ > >'orients' to direct the generation of code which tests the \ > >squares on the board to see if a piece will fit. Each position \ > >letter (A-Z,a) causes the generation of code to check a square \ > >on the board. Each piece name (filnptuvwxyz) generates code to \ > >test piece availability. The '.' characters signal an unrecurse. \ > \ > So basically TESTSQ is a compiler that has the language you describe \ > above as input language and produces executable Forth code as output. \ That's what macros in any language can be used to do, isn't it? Of \ course forth's power makes this easy. But it was not hard to do the same \ trick in assembler using MASM. I am currently working on producing \ assembler code in forth. But the recursive call to 'next-piece' in \ 'leaf-test' requires calling a high level forth word from assembler \ code. \ > Cute! \ And fast! \ Bruce \ -------------------------------------------------------------------- \ Here's the code; the first version was published in \ <1ncw4.334$t_2.4091@news.clear.net.nz>, Bruce Hoyt sent me the \ present version directly. \ PENTOM -- All 2339 solutions to the 6x10 pentomino puzzle \ Bruce Hoyt 04-MAR-00 17:04:41 \ Compiling options 0 constant mute \ disable printing for benchmark 0 constant has-colour \ all colour display 1 constant 6X10 \ do 6x10 board, if false do 4x15 board 11 constant Wtot \ total width of board create Bd 500 allot \ allow 11 X 30 board create Pa 12 allot \ pieces available variable Level \ recursion level, = # pieces on board 0 value Width \ board width actually used 0 value Height \ board height actually used 0 value Bstart \ pointer to starting square on board 0 value Bend \ pointer to ending square on board variable Soln \ # of this solution variable Tries \ count of pieces tried : pentom-init ( wd ht - ) \ initialise the board & pieces to Height to Width Width 1+ Wtot > abort" Total width too small" Wtot Bd + to Bstart \ set pointer to start of board Wtot Height * Width + Bd + to Bend \ set pointer to end of board 0 Bd + Wtot Height 2 + * 1+ -1 fill \ set unused squares to -1 12 0 do \ mark all pieces available -1 i Pa + c! loop 0 9 Pa + c! \ except the X Height 1+ 1 do Width 1+ 1 do 0 j Wtot * i + Bd + c! \ set unoccupied squares to 0 loop loop ; create pats bl c, bl c, \ -1 is boundary, 0 is empty char f c, char i c, char l c, char n c, char p c, char t c, char u c, char v c, char w c, char x c, char y c, char z c, char x c, \ 13 is manually placed 'x' : printbd mute if exit then 0 2 at-xy Height 1+ 1 do \ for each row Width 1+ 1 do \ and each col j Wtot * i + Bd + c@ \ # in square [ has-colour ] [if] 4 lshift set-colour \ use coloured spaces to 'prettyify' 2 spaces 7 set-colour [else] 1+ pats + \ piece name c@ emit \ plain jane emit piece names [then] loop cr loop ." Solution " Soln @ . ." Pieces tried = " Tries @ . cr cr key? if key 27 = abort" User aborted " key drop then ; \ ************** Start of Guts **************************** \ I hope you can handle long strings; the following should be \ one long string of 181 characters ending with 'ai.....' create orients ," ABCDEiIlJyKyLl.IHnJpKuQv.JKpRt.KLnSv..IHGnJpPwQf.JKpQpRp.QPzRuYl..JKLnRfSw.RQuSzZl...IHGFlJyOzPfQt.JKyPfRf.POwQpXn.QRfYy..JKCuLlQtRfSz.QPfRpYy.RSwZn..QPOvRtXnYy.RSvYyZn.YXlZlai....." \ 'x' omitted by replacing 'JKyPfQxRf.' with 'JKyPfRf.' create pos-stack 5 allot \ stack to hold rel positions variable posptr pos-stack posptr ! : push-relpos ( relpos -- ) posptr @ c! 1 posptr +! ; : pop-relpos -1 posptr +! ; \ factors for leaf-test : place-piece ( p# -- ) \ code to put piece on board pos-stack 5 over + swap do dup postpone literal postpone over i c@ postpone literal postpone + postpone c! loop drop ; : lift-piece \ code to remove piece from board pos-stack 5 over + swap do 0 postpone literal postpone over i c@ postpone literal postpone + postpone c! loop ; \ defer is non-ans but everybody has it defer next-piece \ forward reference \ macro to generate code to recursively test availability of a piece \ and mark the board and the piece availability accordingly : leaf-test ( pc# -- ) Pa + >r ( R: pc-addr ) r@ postpone literal postpone c@ postpone if \ is piece available? 0 postpone literal r@ postpone literal postpone c! \ mark unavailable 1 postpone literal postpone Tries postpone +! \ inc Tries r@ Pa - 1+ place-piece postpone dup postpone next-piece lift-piece -1 postpone literal r> postpone literal postpone c! \ mark available postpone then ; \ factor for testsq : sq@0= ( relpos -- ) \ current square empty? postpone dup postpone literal postpone + postpone c@ postpone 0= ; create piece# \ convert piece names to numbers \ f..i..l.n.p...tuvwxyz ," 0xx1xx2x3x4xxx56789:;" variable optr \ pointer into orients orients count drop 1- optr ! \ macro to generate code to recursively find a piece that fits at lead square \ traverses the string orients to generate code : testsq begin \ repeat 1 optr +! \ for each char in orients optr @ c@ [char] . = if \ until recursion is done exit then optr @ c@ [char] a > if \ at a piece name? optr @ c@ \ yes [char] e - piece# + c@ [char] 0 - \ so convert to a number 0-11 leaf-test exit \ at leaf so test piece availability then optr @ c@ [char] A - 3 + 8 /mod Wtot * swap 3 - + >r ( R: relpos ) \ posn rel to lead r@ sq@0= postpone if \ square empty? r@ push-relpos \ push to rel posn stack recurse pop-relpos \ pop rel posn stack postpone then r> drop again ; immediate : soln-print 1 Soln +! printbd ; \ find next piece that fits lead square :noname ( lead-sq -- ) 1 Level +! \ next level, i.e. place a piece begin \ loop back here dup 1+ Bend > if \ at end of board yet? soln-print \ yes, so print solution -1 Level +! \ previous level, i.e. lift up piece drop exit \ exit when at end of board then 1+ \ next square testsq \ place all pieces at lead square dup c@ 0= until \ loop until lead square is empty drop -1 Level +! ; is next-piece : solve 0 Level ! \ no pieces on board Bstart next-piece ; \ ************** End of Guts **************************** : placex ( x y val -- ) \ place or lift the X pattern >r ( x y R: val ) 2dup Wtot * + Bd + r@ swap c! 2dup 1+ Wtot * + 1- Bd + r@ swap c! 2dup 1+ Wtot * + Bd + r@ swap c! 2dup 1+ Wtot * + 1+ Bd + r@ swap c! 2 + Wtot * + Bd + r> swap c! ; : x-at ( x y - ) \ place the X; solve; then lift the X 2dup 13 placex solve 0 placex ; : p6*10 \ 6 X 10 puzzle 2339 solutions 6 10 pentom-init \ other boards may be constructed 3 1 x-at \ 'x' in upper left quadrant 2 2 x-at 3 2 x-at 2 3 x-at 3 3 x-at 2 4 x-at 3 4 x-at ; : p4*15 \ 4 X 15 puzzle 402 solutions 4 15 pentom-init 2 2 x-at 2 3 x-at 2 4 x-at 2 5 x-at 2 6 x-at 2 7 x-at ; variable starttime : read-secs time&date drop 2drop 3600 * swap 60 * + + ; : start-timing read-secs starttime ! ; : elapsed-time ( -- secs ) read-secs starttime @ - ; : pentom page ." Solutions to the Pentomino Puzzle by Exhaustive Search" cr ." Press any key to pause, Esc to abort " cr 0 Soln ! 0 Tries ! start-timing [ 6X10 ] [if] p6*10 [else] p4*15 [then] elapsed-time cr cr ." Total solutions = " Soln @ . ." Total pieces tried = " Tries @ . cr ." Elapsed time in secs = " . ; pentom