Download code

From LiteratePrograms

Jump to: navigation, search

Back to Eight_queens_puzzle_(Forth)

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

queens.4th

 1 \ Copyright (c) 2010 the authors listed at the following URL, and/or
 2 \ the authors of referenced articles or incorporated external code:
 3 \ http://en.literateprograms.org/Eight_queens_puzzle_(Forth)?action=history&offset=20080521200457
 4 \ 
 5 \ Permission is hereby granted, free of charge, to any person obtaining
 6 \ a copy of this software and associated documentation files (the
 7 \ "Software"), to deal in the Software without restriction, including
 8 \ without limitation the rights to use, copy, modify, merge, publish,
 9 \ distribute, sublicense, and/or sell copies of the Software, and to
10 \ permit persons to whom the Software is furnished to do so, subject to
11 \ the following conditions:
12 \ 
13 \ The above copyright notice and this permission notice shall be
14 \ included in all copies or substantial portions of the Software.
15 \ 
16 \ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
17 \ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
18 \ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
19 \ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
20 \ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
21 \ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
22 \ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
23 \ 
24 \ Retrieved from: http://en.literateprograms.org/Eight_queens_puzzle_(Forth)?oldid=13431
25 
26 \ board is left-diagonal, right-diagonal, and vertical attacks.
27 : board ( n -- l r v )
28   >r  -1 -1  1 r> lshift 1- ;
29 
30 : safe-files ( l r v -- l r v  files )  dup 2over and and ;
31 : first ( files -- first-file )  dup negate and ;
32 : rest ( files -- files' )  dup 1- and ;
33 
34 : place-queen ( l r v  file -- l r v  l' r' v' )
35   invert >r
36   2 pick r@ and 2* 1+
37   2 pick r@ and 2/
38   2 pick r> and ;
39 
40 variable positions
41 variable solutions
42 
43 : try ( l r v -- )
44   dup 0= if 1 solutions +!
45   else      1 positions +!
46     safe-files begin ?dup while
47       dup >r  first place-queen recurse  r>
48     rest repeat
49   then
50   drop drop drop ;
51 
52 : queens ( n -- )
53   0 solutions !  0 positions !
54   dup board try  . ." queens: " 
55   solutions @ . ." solutions (tried "
56   positions @ . ." positions)." ; 
57 
58


Retrieved from "http://en.literateprograms.org/Special:Downloadcode"
Views
Personal tools