Download code

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 \ The authors of this work have released all rights to it and placed it
 2 \ in the public domain under the Creative Commons CC0 1.0 waiver
 3 \ (http://creativecommons.org/publicdomain/zero/1.0/).
 4 \ 
 5 \ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 6 \ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 7 \ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 8 \ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 9 \ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
10 \ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
11 \ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
12 \ 
13 \ Retrieved from: http://en.literateprograms.org/Eight_queens_puzzle_(Forth)?oldid=19151
14 
15  : bits ( bits -- mask ) 1 swap lshift 1- ;
16  : lowBit  ( mask -- bit ) dup negate and ;
17  : lowBit- ( mask -- mask ) dup 1- and ;
18  : third ( a b c -- a b c a ) 2 pick ;
19 
20  variable solutions
21  variable nodes
22  : poss ( a b c -- a b c a&b&c ) dup 2over and and ;
23 
24  : next3 ( dl dr f Qfilebit -- dl dr f dl' dr' f' )
25    invert >r
26    third r@ and 2* 1+
27    third r@ and 2/
28    third r> and ;
29 
30  : try ( dl dr f -- )             \ bitmasks for unused diagonals and files
31    dup if 1 nodes +!  poss
32      begin ?dup while
33        dup >r lowBit next3 recurse r> lowBit-
34      repeat
35    else ( .sol) 1 solutions +! then
36    drop drop drop ;
37  0 value N
38  : queens ( n -- ) to N
39    0 solutions ! 0 nodes !
40    -1 dup N bits try
41    N . ." queens: " solutions @ . ." solutions, " nodes @ . ." nodes" ;


hijacker
hijacker
hijacker
hijacker