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

Groups > comp.lang.forth > #23437 > unrolled thread

Dice problem

Back to article view | Back to comp.lang.forth

Contents

  Dice problem "WJ" <w_a_x_man@yahoo.com> - 2013-06-11 15:34 +0000
    Re: Dice problem Ron Aaron <rambamist@gmail.com> - 2013-06-11 20:04 +0300
    Re: Dice problem november.nihal@gmail.com - 2013-08-11 05:11 -0700
    Re: Dice problem Paul Rubin <no.email@nospam.invalid> - 2013-08-11 16:32 -0700
      Re: Dice problem Paul Rubin <no.email@nospam.invalid> - 2013-08-11 16:42 -0700
      Re: Dice problem Coos Haak <chforth@hccnet.nl> - 2013-08-12 02:25 +0200
        Re: Dice problem Paul Rubin <no.email@nospam.invalid> - 2013-08-11 18:02 -0700
        Re: Dice problem Paul Rubin <no.email@nospam.invalid> - 2013-08-11 23:58 -0700
    Re: Dice problem hughaguilar96@yahoo.com - 2013-08-12 00:13 -0700

#23437 — Dice problem

The problem: score the roll of 1 to 5 dice.

Three 1's count 1000; three of any other number count
100 times the number.

A solo 1 counts 100; a solo 5, 50.  All other singletons
count 0.

Ruby:

def score dice
  score_single = { 1=>100, 5=>50 } ; score_single.default = 0
  score_triple = proc{|n| n==1 ? 1000 : 100 * n}
  (1..6).reduce(0){|sum,n| 
    q, r = dice.count(n).divmod(3)
    sum + q * score_triple[n] + r * score_single[n]}
end


score [1]
    ==>100
score [1,1,1]
    ==>1000
score [1,1,1,1]
    ==>1100
score [2]
    ==>0
score [2,2,2]
    ==>200
score [5]
    ==>50
score [5,5,5,5]
    ==>550
score [2,5,2,1,2]
    ==>350

Show your Forth solutions.

[toc] | [next] | [standalone]

#23448

Not certain what the point of the problem is, really.  Here's one 
possible solution using Reva Forth, which outputs:

	Calculating dice scores:
	(100 1000 1100 0 200 50 550 350)
	100 1000 1100 0 200 50 550 350


Here's the code:

create dice-scores 5 cells allot

create score-table
	100 , 200 , 1000 , 1100 , 1200 ,
	0   ,   0 ,  200 ,  200 ,  200 ,
	0   ,   0 ,  300 ,  300 ,  300 ,
	0   ,   0 ,  400 ,  400 ,  400 ,
	50  , 100 ,  500 ,  550 ,  600 ,
	0   ,   0 ,  600 ,  600 ,  600 ,

: reset-count ( -- )
	dice-scores 5 cells zero temp off ;
	
: count-die ( one-die -- )
	1- cells dice-scores + ++ ;

: get-score ( -- )
	5 0do
		| get score for this item
		i cells dice-scores + @
		dup 0if drop else
			1- cells
			| index to score-table and get the score:
			i 5 * cells score-table + + @ temp +!
		then
	loop temp ? ;

: count-dice ( a1 a2 a3 .. aN N -- total )
	reset-count
	0do count-die loop
	get-score ;

." Calculating dice scores:" cr
." (100 1000 1100 0 200 50 550 350)" cr
1 1 count-dice
1 1 1 3 count-dice
1 1 1 1 4 count-dice
2 1 count-dice
2 2 2 3 count-dice
5 1 count-dice
5 5 5 5 4 count-dice
2 5 2 1 2 5 count-dice
cr bye

[toc] | [prev] | [next] | [standalone]

#25102

(  # win32forth # )

create die 0 , 0 , 0 , 0 , 0 ,         5 constant ndie

: cpStackToDie 0 ndie 1- do die i cells + ! -1 +loop ;
: cpDieToStack ndie 0 do die i cells + @ loop ;

: countdie (  a b c d e x -- N ) 0 ndie 0 do -rot tuck = if swap 1+ else swap then loop nip ;

: score ( -- sc )
     cpStackToDie

     6 1+ 1 do cpDieToStack i countdie loop ( -- a1 a2 a3 a4 a5 a6 )

     3 = if 600 else 0 then >r

     dup 1 = if drop 50
     else 3 = if  500
     else 0 then then >r

     3 = if  400 else 0 then >r
     3 = if  300 else 0 then >r
     3 = if  200 else 0 then >r

     dup  1 = if drop 100
     else 3 = if 1000
     else 0
     then then

     r> r> r> r> r> + + + + + ;

: test1 ." [ " ndie 0 do 6 random 1+ dup . ." " loop ." ] ==> " score . ;
: test2 ( a b c d e -- f ) ." scores " score . ;
: help ( -- ) cls
." Roll 5 dice , score as follows :-        " cr
." If you get a single 1  add 100  to score " cr
." If you get a single 5  add 50   to score " cr
." All other singles      add 0    to score " cr
." If you get triple 1    add 1000 to score " cr
." Any other triple is 100 times the number to score" cr cr cr
." To use : " cr cr
." Type: help <cr>             to see this message" cr
." Type: test1 <cr>            generate 5 random numbers and score them " cr
." Type: 2 2 1 2 5  test2 <cr> to enter numbers manually and score them " cr
." NOTE: test2 expects 5 numbers and there is no check to see if the values are between 1 & 6" cr
." or if you enter less than 5 numbers !!! " cr cr
cr cr cr ; help

[toc] | [prev] | [next] | [standalone]

#25106

"WJ" <w_a_x_man@yahoo.com> writes:
> The problem: score the roll of 1 to 5 dice.
> Three 1's count 1000; three of any other number count
> 100 times the number.
> A solo 1 counts 100; a solo 5, 50.  All other singletons
> count 0.

create dcounts 6 cells allot
: boundscheck ( n -- n ) dup assert( 1 7 within ) ;           \ gforth
: count@ ( n -- addr ) boundscheck 1- cells dcounts + ;
: count? ( n -- n ) count@ @ ;
: count! ( v n -- ) count@ ! ;
: count+! ( v n -- ) tuck count? + swap count! ;
: init ( -- ) 7 1 do 0 i count! loop ;

: triple ( v n -- n )  tuck count? 3 >= ( n v flag )
    if swap -3 swap count+! else 2drop 0 then ;    
: single ( v n -- n ) count? * ;
: countall ( n n n n n -- ) init 5 0 do 1 swap count+! loop ;
: dice ( n n n n n -- score )
    countall
    1000 1 triple     7 2 do i 100 * i triple + loop
    100 1 single +    50 5 single + ; 

[toc] | [prev] | [next] | [standalone]

#25107

Paul Rubin <no.email@nospam.invalid> writes:
> : triple ( v n -- n )  tuck count? 3 >= ( n v flag )
>     if swap -3 swap count+! else 2drop 0 then ;    

Cleanup from half-completed refactoring:

    : triple ( v n -- n )  dup count? 3 >= ( v n flag )
        if -3 swap count+! else 2drop 0 then ;

[toc] | [prev] | [next] | [standalone]

#25108

Op Sun, 11 Aug 2013 16:32:55 -0700 schreef Paul Rubin:

>: count+! ( v n -- ) tuck count? + swap count! ;
: counbt+! ( v n -- ) count@ +! ;
That's where +! is for ;-)

-- 
Coos

CHForth, 16 bit DOS applications
http://home.hccnet.nl/j.j.haak/forth.html 

[toc] | [prev] | [next] | [standalone]

#25109

Coos Haak <chforth@hccnet.nl> writes:
>>: count+! ( v n -- ) tuck count? + swap count! ;
> : counbt+! ( v n -- ) count@ +! ;
> That's where +! is for ;-)

Thanks.  I must have had one of those moments ;-).

[toc] | [prev] | [next] | [standalone]

#25112

> That's where +! is for ;-)

Here it is after a little more cleanup:

create dcounts 6 cells allot
: boundscheck ( n -- n ) dup assert( 1 7 within ) ;           \ gforth
: count& ( n -- addr ) boundscheck 1- cells dcounts + ;
: count@ ( n -- n ) count& @ ;
: count! ( v n -- ) count& ! ;
: count+! ( v n -- ) count& +! ;
: clear-counts ( -- ) 7 1 do 0 i count! loop ;

: triple ( v n -- n )  count@ 3 < if drop 0 then ;
: single ( v n -- n ) count@ 3 mod * ;
: countall ( n n n n n -- ) 5 0 do 1 swap count+! loop ;
: dice ( n n n n n -- score )
    clear-counts countall
    1000 1 triple     7 2 do i 100 * i triple + loop
    100 1 single +    50 5 single + ; 

[toc] | [prev] | [next] | [standalone]

#25114

On Tuesday, June 11, 2013 8:34:31 AM UTC-7, WJ wrote:
> The problem: score the roll of 1 to 5 dice.
> 
> Three 1's count 1000; three of any other number count
> 100 times the number.
> 
> A solo 1 counts 100; a solo 5, 50.  All other singletons
> count 0.
> ...
> Show your Forth solutions.

WJ --- Rather than continually posting these contrived problems that you most likely are getting out of programming textbooks, why don't you try to duplicate one of my example programs in the novice package? They didn't come from any textbook, so you aren't going to be able to look in the answers section of the textbook to obtain the solution. They are also a lot more interesting than this stuff -- I mean, who cares about adding up the scores of dice rolls?

Am I guessing correctly, that you are a college student? You get all of these programs from your classroom material, don't you?

[toc] | [prev] | [standalone]

Back to top | Article view | comp.lang.forth

csiph-web