The old Google Groups will be going away soon, but your browser is incompatible with the new version.
Message from discussion coin changer --- a challenge for novices

```Received: by 10.66.81.170 with SMTP id b10mr5929504pay.31.1352609581377;
Sat, 10 Nov 2012 20:53:01 -0800 (PST)
From: arc <arc.deletet...@vorsicht-bissig.de>
Newsgroups: comp.lang.forth
Subject: Re: coin changer --- a challenge for novices
Date: Sun, 11 Nov 2012 17:53:00 +1300
Organization: A noiseless patient Spider
Lines: 204
Message-ID: <87txswpwpf.fsf@vorsicht-bissig.de>
Mime-Version: 1.0
Injection-Info: mx04.eternal-september.org; posting-host="ded1ac4a48cb4c49b2099faa93543fd2";
logging-data="8006"; mail-complaints-to="ab...@eternal-september.org";	posting-account="U2FsdGVkX19TpKCv/A4MPHGk6zvH9YcU"
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.3 (gnu/linux)
Cancel-Lock: sha1:AC7SztaUVbIcCRDnFAC7wsBgXNI=
sha1:TO4hZ5Irjdsf1vOBNT4l0K72ar8=
Content-Type: text/plain; charset=us-ascii

>
> As a slightly more advanced challenge (still pretty easy), solve the N-
> Queens problem. I don't think this appears anywhere in SICP, but I
> have a solution in my novice package (
> http://www.forth.org/novice.html). As a bonus challenge --- make your
> program non-recursive as I did (the N-Queens problem is a classic
> example of recursive-descent searching in many textbooks).

Here is my non-recursive n-queens solution.

I'm still pretty green with forth, so comments welcome.

-arc.

\ \\\\\\\\\\
\  nqueens.fs

( basic usage:
create-queens dup n-queens
dup .board  \ displays a chessboard
dup .queens \ displays coordinates of queens
set N to solve for Ns other than 8. )

variable N
8 N !

: 3dup
dup 2over rot ;

\ \\\\\\\\\\\\\\\\\\\\\\
\ RNG

( Fast Random Number Generator
algorithm by George Marsaglia "Xorshift RNGs"

Arnold Doray's version posted to comp.lang.forth Sat, 17 Dec 2011
message id:  <jch8b0\$d5...@dont-email.me>
)

\ Xorshift (13,17,5)
: xorshift ( n -- n )
dup 13 lshift xor
dup 17 rshift xor
dup  5 lshift xor ;

variable (rnd)     \ seed
2463534242 (rnd) ! \ initialize seed

: rnd ( -- n )
(rnd) @ xorshift dup (rnd) ! ;

: random-index
rnd n @ mod ;

\ \\\\\\\\\\\\\\\\\\\\
\ Queens and their operations

2 cells constant QUEEN-SIZE

: create-queens ( - queens-addr )
here
N @ QUEEN-SIZE * allot ;

: queen.x ( queen-addr - x )
@ ;

: queen.x! ( x queen-addr - )
! ;

: queen.y ( queen-addr - y )
1 cells + @ ;

: queen.y! ( y queen-addr - )
1 cells + ! ;

: queen.xy! ( x y queen-addr - )
2dup queen.y!
swap drop queen.x! ;

queen-size * + ;

: queens-bounds ( queens-addr - upper-bound lower-bound)
N @ QUEEN-SIZE * bounds ;

: .queens ( queens-addr - )
cr
queens-bounds ?do
i dup . [char] : emit space
dup queen.x .
queen.y . cr
queen-size +loop ;

: clear-queens ( queens-addr - )
queens-bounds ?do
-1 i queen.x!
-1 i queen.y!
queen-size +loop ;

: queen-there ( x y queens-addr - f )
queens-bounds ?do
over i queen.x =
over i queen.y  =
and
if 2drop -1 unloop exit then
queen-size +loop
2drop 0  ;

: setup-queens ( queens-addr - )
dup queens-bounds ?do ( queens-addr )
begin
random-index random-index  ( queens-addr x y )
3dup rot
queen-there ( queens-addr x y f )
while 2drop repeat  ( queens-addr x y )
i  queen.xy!
queen-size +loop drop ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ board display

: .board-rowborder ( n - )
[char] + emit
0 ?do
[char] - emit [char] + emit
loop cr ;

: .board ( queens-addr - )
cr
space space space N @ 0 ?do i . loop cr
space space N @ .board-rowborder
N @ 0 ?do i .
[char] | emit
N @ 0 ?do
dup   j i rot  queen-there if [char] Q emit else space then
[char] | emit
loop cr
space space N @ .board-rowborder
loop drop ;

\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ attack detection

queen.y swap queen.y = ;

queen.x swap queen.x = ;

2dup queen.x swap queen.x - abs -rot ( xdiff queen-addr queen-addr )
queen.y swap queen.y - abs ( xdiff ydiff)
= ;

2dup = if 2drop 0 exit then
2dup on-same-row if 2drop -1 exit then
2dup on-same-col if 2drop -1 exit then
2dup on-same-diagonal if 2drop -1 exit then
2drop 0
;

swap queens-bounds  ?do
dup i queen-attack  if drop -1 unloop exit then
queen-size  +loop
drop 0
;

: any-queens-attacked ( queens-addr - f )
dup queens-bounds ?do
dup i queen-attacked if drop -1 unloop exit then
queen-size +loop
drop 0
;

\ \\\\\\\\\\\\\\\\\\
\ nqueens

variable iterations

0 iterations !
begin
iterations @ 1 + iterations !
dup clear-queens
dup setup-queens
dup any-queens-attacked
invert
until
drop
;

\ uncomment this to get an explicit solution example
\ create explicit-solution 0 , 3 , 1 , 5 , 2 , 7 , 3 , 1 , 4 , 6 , 5 , 0 , 6 , 2 , 7 , 4 ,

```