Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #17219

Re: coin changer --- a challenge for novices

From arc <arc.deletethis@vorsicht-bissig.de>
Newsgroups comp.lang.forth
Subject Re: coin changer --- a challenge for novices
Date 2012-11-11 17:53 +1300
Organization A noiseless patient Spider
Message-ID <87txswpwpf.fsf@vorsicht-bissig.de> (permalink)
References <a9cb961d-eef1-4578-9efc-ede0c3cfbdef@i2g2000pbi.googlegroups.com>

Show all headers | View raw

>
> 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$d5h$1@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! ; 

: queens.queen-i ( queens-addr n - queen-addr ) 
    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

: on-same-col ( queens-addr queens-addr - f )
    queen.y swap queen.y = ;

: on-same-row ( queens-addr queens-addr - f)
    queen.x swap queen.x = ;

: on-same-diagonal ( queen-addr queen-addr - f )
    2dup queen.x swap queen.x - abs -rot ( xdiff queen-addr queen-addr )
    queen.y swap queen.y - abs ( xdiff ydiff)
    = ;

: queen-attack ( queen-addr queen-addr - f )
    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
;

: queen-attacked ( queens-addr queen-addr - f )
    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

: n-queens ( queens-addr )
    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 ,

Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

coin changer --- a challenge for novices Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-11-04 17:57 -0800
  Re: coin changer --- a challenge for novices "Paul E. Bennett" <Paul_E.Bennett@topmail.co.uk> - 2012-11-05 07:47 +0000
    Re: coin changer --- a challenge for novices Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-11-05 21:26 -0800
      Re: coin changer --- a challenge for novices "Paul E. Bennett" <Paul_E.Bennett@topmail.co.uk> - 2012-11-06 19:00 +0000
  Re: coin changer --- a challenge for novices Steve Graham <jsgrahamus@yahoo.com> - 2012-11-06 17:09 -0700
    Re: coin changer --- a challenge for novices jfong <jfong@ms4.hinet.net> - 2012-11-06 17:57 -0800
    Re: coin changer --- a challenge for novices Andrew Haley <andrew29@littlepinkcloud.invalid> - 2012-11-07 05:13 -0600
    Re: coin changer --- a challenge for novices awegel@arcor.de (Alex Wegel) - 2012-11-07 16:04 +0100
    Re: coin changer --- a challenge for novices Brad Eckert <hwfwguy@gmail.com> - 2012-11-07 08:11 -0800
      Re: coin changer --- a challenge for novices "Ed" <invalid@nospam.com> - 2012-11-08 19:12 +1100
  Re: coin changer --- a challenge for novices Ian Osgood <iano@quirkster.com> - 2012-11-08 07:19 -0800
    Re: coin changer --- a challenge for novices anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2012-11-08 17:27 +0000
      Re: coin changer --- a challenge for novices Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-11-08 19:56 -0800
    Re: coin changer --- a challenge for novices "Ed" <invalid@nospam.com> - 2012-11-09 15:37 +1100
    Re: coin changer --- a challenge for novices albert@spenarnc.xs4all.nl (Albert van der Horst) - 2012-11-14 10:59 +0000
  Re: coin changer --- a challenge for novices jfong <jfong@ms4.hinet.net> - 2012-11-08 17:04 -0800
    Re: coin changer --- a challenge for novices Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-11-08 20:10 -0800
      Re: coin changer --- a challenge for novices "Ed" <invalid@nospam.com> - 2012-11-09 16:17 +1100
        Re: coin changer --- a challenge for novices Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-11-08 23:17 -0800
  Re: coin changer --- a challenge for novices arc <arc.deletethis@vorsicht-bissig.de> - 2012-11-11 17:53 +1300
    Re: coin changer --- a challenge for novices Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-11-13 20:29 -0800
      Re: coin changer --- a challenge for novices John Rible <google@sandpipers.com> - 2012-11-13 22:39 -0800
        Re: coin changer --- a challenge for novices Hugh Aguilar <hughaguilar96@yahoo.com> - 2012-11-13 22:54 -0800

csiph-web