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


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

Josephus Circle problem

Started byPaul Rubin <no.email@nospam.invalid>
First post2013-12-23 19:12 -0800
Last post2013-12-26 17:33 +0000
Articles 20 on this page of 55 — 14 participants

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


Contents

  Josephus Circle problem Paul Rubin <no.email@nospam.invalid> - 2013-12-23 19:12 -0800
    Re: Josephus Circle problem "Rod Pemberton" <dont_use_email@xnohavenotit.cnm> - 2013-12-24 02:49 -0500
      Re: Josephus Circle problem Paul Rubin <no.email@nospam.invalid> - 2013-12-24 01:13 -0800
        Re: Josephus Circle problem mhx@iae.nl - 2013-12-24 02:17 -0800
          Re: Josephus Circle problem ForthFreak <forthfreak@gmail.com> - 2013-12-24 03:45 -0800
            Re: Josephus Circle problem Paul Rubin <no.email@nospam.invalid> - 2013-12-24 04:25 -0800
              Re: Josephus Circle problem ForthFreak <forthfreak@gmail.com> - 2013-12-24 04:25 -0800
                Re: Josephus Circle problem Paul Rubin <no.email@nospam.invalid> - 2013-12-24 04:52 -0800
              Re: Josephus Circle problem albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-12-24 14:57 +0000
              Re: Josephus Circle problem "Ed" <invalid@invalid.com> - 2013-12-25 20:15 +1100
            Re: Josephus Circle problem mhx@iae.nl - 2013-12-24 04:36 -0800
        Re: Josephus Circle problem "Rod Pemberton" <dont_use_email@xnohavenotit.cnm> - 2013-12-24 17:05 -0500
        Re: Josephus Circle problem "WJ" <w_a_x_man@yahoo.com> - 2014-03-10 07:11 +0000
      Re: Josephus Circle problem mhx@iae.nl - 2013-12-24 02:59 -0800
    Re: Josephus Circle problem ForthFreak <forthfreak@gmail.com> - 2013-12-24 01:53 -0800
      Re: Josephus Circle problem Paul Rubin <no.email@nospam.invalid> - 2013-12-24 04:06 -0800
        Re: Josephus Circle problem ForthFreak <forthfreak@gmail.com> - 2013-12-24 04:24 -0800
    Re: Josephus Circle problem ForthFreak <forthfreak@gmail.com> - 2013-12-24 04:30 -0800
      Re: Josephus Circle problem ForthFreak <forthfreak@gmail.com> - 2013-12-24 04:35 -0800
    Re: Josephus Circle problem ForthFreak <forthfreak@gmail.com> - 2013-12-24 05:01 -0800
      Re: Josephus Circle problem Paul Rubin <no.email@nospam.invalid> - 2013-12-24 05:34 -0800
        Re: Josephus Circle problem ForthFreak <forthfreak@gmail.com> - 2013-12-24 05:22 -0800
        Re: Josephus Circle problem "Elizabeth D. Rather" <erather@forth.com> - 2013-12-24 13:25 -1000
          Re: Josephus Circle problem "Ed" <invalid@invalid.com> - 2013-12-25 20:40 +1100
            Re: Josephus Circle problem "Elizabeth D. Rather" <erather@forth.com> - 2013-12-25 09:37 -1000
              Re: Josephus Circle problem ForthFreak <forthfreak@gmail.com> - 2013-12-26 03:19 -0800
                Re: Josephus Circle problem "Elizabeth D. Rather" <erather@forth.com> - 2013-12-26 12:01 -1000
              Re: Josephus Circle problem "Ed" <invalid@invalid.com> - 2013-12-27 12:33 +1100
                Re: Josephus Circle problem Elizabeth D Rather <erather@forth.com> - 2013-12-26 17:41 -1000
                  Re: Josephus Circle problem "Ed" <invalid@invalid.com> - 2013-12-27 18:46 +1100
                    Re: Josephus Circle problem Mark Wills <markrobertwills@yahoo.co.uk> - 2013-12-27 02:46 -0800
                      Re: Josephus Circle problem albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-12-27 13:16 +0000
                        Re: Josephus Circle problem mhx@iae.nl - 2013-12-27 05:27 -0800
                          Re: Josephus Circle problem albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-12-27 14:15 +0000
                        Re: Josephus Circle problem "Ed" <invalid@invalid.com> - 2013-12-29 21:56 +1100
                          Re: Josephus Circle problem albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-12-29 12:37 +0000
                            Re: Josephus Circle problem "Ed" <invalid@invalid.com> - 2013-12-30 00:47 +1100
                      Re: Josephus Circle problem "Ed" <invalid@invalid.com> - 2013-12-29 14:08 +1100
                Re: Josephus Circle problem Mark Wills <markrobertwills@yahoo.co.uk> - 2013-12-27 02:35 -0800
                  Re: Josephus Circle problem Mark Wills <markrobertwills@yahoo.co.uk> - 2013-12-27 02:43 -0800
                  Re: Josephus Circle problem albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-12-27 19:00 +0000
      Re: Josephus Circle problem albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-12-24 15:59 +0000
    Re: Josephus Circle problem Gerry Jackson <spam@qlikz.org> - 2013-12-24 20:07 +0000
      Re: Josephus Circle problem albert@spenarnc.xs4all.nl (Albert van der Horst) - 2013-12-24 20:31 +0000
      Re: Josephus Circle problem mhx@iae.nl - 2013-12-25 04:38 -0800
        Re: Josephus Circle problem mhx@iae.nl - 2013-12-25 06:04 -0800
        Re: Josephus Circle problem mhx@iae.nl - 2013-12-25 06:06 -0800
          Re: Josephus Circle problem Paul Rubin <no.email@nospam.invalid> - 2013-12-25 23:08 -0800
            Re: Josephus Circle problem ForthFreak <forthfreak@gmail.com> - 2013-12-26 03:31 -0800
          Re: Josephus Circle problem Gerry Jackson <spam@qlikz.org> - 2013-12-26 10:52 +0000
            Re: Josephus Circle problem Tristan Plumb <firth@trstn.net> - 2013-12-26 14:37 +0000
              Re: Josephus Circle problem Paul Rubin <no.email@nospam.invalid> - 2013-12-26 07:12 -0800
            Re: Josephus Circle problem Gerry Jackson <spam@qlikz.org> - 2013-12-26 17:31 +0000
          Re: Josephus Circle problem Ron Aaron <rambamist@gmail.com> - 2013-12-26 21:39 +0200
      Re: Josephus Circle problem anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2013-12-26 17:33 +0000

Page 1 of 3  [1] 2 3  Next page →


#27410 — Josephus Circle problem

FromPaul Rubin <no.email@nospam.invalid>
Date2013-12-23 19:12 -0800
SubjectJosephus Circle problem
Message-ID<7x61qfuel8.fsf@ruckus.brouhaha.com>
This is an oldie that was in Knuth vol 2 though I don't have the
reference handy.  Also at:

http://thedailywtf.com/Articles/Programming-Praxis-Josephus-Circle.aspx
http://mathworld.wolfram.com/JosephusProblem.html

From the first url: "In order to decide who would die in which order,
the soldiers stood in a circle and, starting with the top of the circle
and continuing clockwise, counted to three. The third man got the ax and
the counting resumed at one. The process continued until there was no
one left. Josephus, who didn't quite agree with the whole "we should all
kill ourselves" idea, figured out the perfect way to avoid death: be the
last man standing."

Problem: There are 40 soldiers to start with, number 1,2,3,... .
Calculate the order in which they are killed.

A solution:
================================================================

40 constant ring-size
3 constant jump-size
jump-size 1- constant jump-size-1

create ring  ring-size cells allot
does> ( i -- addr ) swap cells + ;

variable remaining                      \ number of men still alive
variable p                              \ place to start counting from
: decr-remaining ( -- ) remaining @ 1- remaining ! ;

: init-ring ( -- ) ring-size 0 do i 1+ i ring ! loop ;
: init-vars ( -- ) ring-size remaining !   0 p ! ;
: init ( -- ) init-ring init-vars ;
: next-p ( -- ) p @ jump-size-1 + remaining @ mod p ! ;

: cells-to-move ( -- n ) remaining @ p @ - 1- ;
: remove ( -- ) p @ 1+ ring  p @ ring  cells-to-move cells  move ;

: show ( n -- ) ring @ . ;
: iteration ( -- ) next-p p @ dup show remove decr-remaining ;
: run ( -- ) cr init begin remaining @ while iteration repeat cr ;

run
================================================================

[toc] | [next] | [standalone]


#27411

From"Rod Pemberton" <dont_use_email@xnohavenotit.cnm>
Date2013-12-24 02:49 -0500
Message-ID<op.w8k6n9wa5zc71u@localhost>
In reply to#27410
On Mon, 23 Dec 2013 22:12:35 -0500, Paul Rubin <no.email@nospam.invalid>  
wrote:

> This is an oldie that was in Knuth vol 2 though I don't have the
> reference handy.  Also at:
>
> http://thedailywtf.com/Articles/Programming-Praxis-Josephus-Circle.aspx
> http://mathworld.wolfram.com/JosephusProblem.html
>
> From the first url: "In order to decide who would die in which order,
> the soldiers stood in a circle and, starting with the top of the circle
> and continuing clockwise, counted to three. The third man got the ax and
> the counting resumed at one. The process continued until there was no
> one left. Josephus, who didn't quite agree with the whole "we should all
> kill ourselves" idea, figured out the perfect way to avoid death: be the
> last man standing."
>
> Problem: There are 40 soldiers to start with, number 1,2,3,... .
> Calculate the order in which they are killed.
>
> A solution:
> ================================================================
>
> 40 constant ring-size
> 3 constant jump-size
> jump-size 1- constant jump-size-1
>
> create ring  ring-size cells allot
> does> ( i -- addr ) swap cells + ;
>
> variable remaining                      \ number of men still alive
> variable p                              \ place to start counting from
> : decr-remaining ( -- ) remaining @ 1- remaining ! ;
>
> : init-ring ( -- ) ring-size 0 do i 1+ i ring ! loop ;
> : init-vars ( -- ) ring-size remaining !   0 p ! ;
> : init ( -- ) init-ring init-vars ;
> : next-p ( -- ) p @ jump-size-1 + remaining @ mod p ! ;
>
> : cells-to-move ( -- n ) remaining @ p @ - 1- ;
> : remove ( -- ) p @ 1+ ring  p @ ring  cells-to-move cells  move ;
>
> : show ( n -- ) ring @ . ;
> : iteration ( -- ) next-p p @ dup show remove decr-remaining ;
> : run ( -- ) cr init begin remaining @ while iteration repeat cr ;
>
> run
> ================================================================


https://groups.google.com/d/msg/comp.lang.c/k9YQ7kmnRsE/saqlkO2Si60J

Understand it?


Rod Pemberton

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


#27414

FromPaul Rubin <no.email@nospam.invalid>
Date2013-12-24 01:13 -0800
Message-ID<7xsiti628k.fsf@ruckus.brouhaha.com>
In reply to#27411
"Rod Pemberton" <dont_use_email@xnohavenotit.cnm> writes:
> https://groups.google.com/d/msg/comp.lang.c/k9YQ7kmnRsE/saqlkO2Si60J
> Understand it?

That's in C and it's ugly!  Here it is in Haskell:

    josephus n [] = []
    josephus n ds = f:josephus n (fs++es) where
      (es,f:fs) = splitAt n' ds
      n' = (n-1) `mod` length ds

    main = print (josephus 3 [1..40])

It's interesting that Knuth (actually probably vol. 1 rather than
vol. 2) gave this problem a difficulty rating suggesting a few hours of
work in MIX assembly language.  I remember implementing it in Lisp long
ago, using a circular list mutated with rplacd, ugh.  The Lisp hacking
took just a few minutes and I remember thinking that yeah, it might
actually take a few hours to get it working in assembler, so the quick
Lisp solution showed how much times had changed since the book was
written in the 1960's.

My Forth solution probably took me about an hour, though a real Forther
could probably have done it better/faster.  My first Haskell solution
(using unfoldr) took a few minutes, and the direct recursive version
above took just a minute or two.  In retrospect, unfoldr was a little
too fancy.

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


#27417

Frommhx@iae.nl
Date2013-12-24 02:17 -0800
Message-ID<6b1a3673-9b37-4023-8afa-a622577ae40b@googlegroups.com>
In reply to#27414
On Tuesday, December 24, 2013 10:13:15 AM UTC+1, Paul Rubin wrote:
> My Forth solution probably took me about an hour, though a real Forther
> could probably have done it better/faster.  My first Haskell solution
> (using unfoldr) took a few minutes, and the direct recursive version
> above took just a minute or two.  In retrospect, unfoldr was a little
> too fancy.

DOES> shouldn't be used interpretively (according to the Standard), 
and I think  dup show  will cause 40 unneeded items on the data stack.

Written for clarity (in my eyes only) :-)

#40 =: #soldiers
CREATE arena  #soldiers ALLOT

0 VALUE live-ones?
0 VALUE victim
0 VALUE call-outs

: 'victim     ( -- addr ) arena victim + ;
: strike-him  ( -- ) -1 +TO live-ones?  'victim C0!  0 TO call-outs  victim 1+ . ;
: next-victim ( -- ) victim 1+  #soldiers MOD  TO victim ;
: alive       ( -- ) #soldiers 0 ?DO  1 'victim C!  next-victim  LOOP ;
: set-arena   ( -- ) alive  #soldiers TO live-ones?  0 TO victim  0 TO call-outs ;
: test        ( -- ) 'victim C@ 0= ?EXIT  1 +TO call-outs  call-outs 3 = IF  strike-him  ENDIF ;
: mark        ( -- ) CR set-arena  BEGIN  live-ones?  WHILE  test next-victim  REPEAT ;

-- output:
FORTH> mark
3 6 9 12 15 18 21 24 27 30 33 36 39 2 7 11 16 20 25 29 34 38 4 10 17 23 31 37 5 14 26 35 8 22 40 19 1 32 13 28  ok

-marcel

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


#27419

FromForthFreak <forthfreak@gmail.com>
Date2013-12-24 03:45 -0800
Message-ID<3452b219-26f7-4e9b-9512-5f52b4844b06@googlegroups.com>
In reply to#27417
Marcel's program in standard Forth:

40 value #soldiers 
create arena  #soldiers chars allot 

0 value live-ones? 
0 value victim 
0 value call-outs 

: 'victim     ( -- addr ) arena victim + ; 
: strike-him  ( -- ) -1 +to live-ones?  0 'victim c!  0 to call-outs  
    victim 1+ . ;
: next-victim ( -- ) victim 1+  #soldiers mod  to victim ; 
: alive       ( -- ) #soldiers 0 ?do  1 'victim c!  next-victim  loop ; 
: set-arena   ( -- ) alive  #soldiers to live-ones?  0 to victim  
    0 to call-outs ;
: test        ( -- ) 'victim c@ 0= if exit then 1 +to call-outs  call-outs 
    3 = if  strike-him  then ;
: mark        ( -- ) cr set-arena  
    begin  live-ones?  while  test next-victim  repeat ;

Tested on my 16-bit Forth-83 hobby system :-)

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


#27421

FromPaul Rubin <no.email@nospam.invalid>
Date2013-12-24 04:25 -0800
Message-ID<7x8uvabfm6.fsf@ruckus.brouhaha.com>
In reply to#27419
ForthFreak <forthfreak@gmail.com> writes:
> Marcel's program in standard Forth: ...
> : strike-him  ( -- ) -1 +to live-ones?  0 'victim c!  0 to call-outs  

+to doesn't seem to be a standard word.  gforth doesn't have it and I
hadn't seen it before.  It looks useful though.

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


#27423

FromForthFreak <forthfreak@gmail.com>
Date2013-12-24 04:25 -0800
Message-ID<2ceaa35c-1a80-49c4-a0ce-60243a9cfadd@googlegroups.com>
In reply to#27421
On Tuesday, 24 December 2013 12:25:21 UTC, Paul Rubin  wrote:
> +to doesn't seem to be a standard word.  gforth doesn't have it and I
> hadn't seen it before.  It looks useful though.

I'm pretty sure it's a standard word (if your system supports VALUEs). Otherwise your VALUEs would be, er, CONSTANTs

;-)

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


#27425

FromPaul Rubin <no.email@nospam.invalid>
Date2013-12-24 04:52 -0800
Message-ID<7xfvpiv2bt.fsf@ruckus.brouhaha.com>
In reply to#27423
ForthFreak <forthfreak@gmail.com> writes:

> On Tuesday, 24 December 2013 12:25:21 UTC, Paul Rubin  wrote:
>> +to doesn't seem to be a standard word.  gforth doesn't have it
>
> I'm pretty sure it's a standard word (if your system supports
> VALUEs). Otherwise your VALUEs would be, er, CONSTANTs

gforth has values.

    5 VALUE X    X 3 + TO X

puts 8 in X.

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


#27431

Fromalbert@spenarnc.xs4all.nl (Albert van der Horst)
Date2013-12-24 14:57 +0000
Message-ID<52b9a0de$0$4639$e4fe514c@dreader34.news.xs4all.nl>
In reply to#27421
In article <7x8uvabfm6.fsf@ruckus.brouhaha.com>,
Paul Rubin  <no.email@nospam.invalid> wrote:
>ForthFreak <forthfreak@gmail.com> writes:
>> Marcel's program in standard Forth: ...
>> : strike-him  ( -- ) -1 +to live-ones?  0 'victim c!  0 to call-outs
>
>+to doesn't seem to be a standard word.  gforth doesn't have it and I
>hadn't seen it before.  It looks useful though.

It is very common in the Dutch Forth's.

I hate the guts of VALUE but I was more or less forced to
make +TO a part of my loadable VALUE stuff or I couldn't
run many of the programs floating around here.
(Now nobody has C0! , it took me quite a while for I understood
what it was supposed to mean.)

In behalf of everybody who want to add it quick and dirty:
/-------------------------------------------------------
albert@cherry:~$ lina

AMDX86 ciforth 5.0
1 LOAD WANT VALUE WANT LOCATE LOCATE VALUE
SCR # 80
 0 ( VALUE TO FROM ) \ AvdH B2aug07
 1
 2
 3 VARIABLE TO-MESSAGE   \ 0 : FROM ,  1 : TO .
 4 CREATE _value_jumps  ' @ , ' ! , ' +! ,
 5 : FROM 0 TO-MESSAGE ! ;
 6 \ ISO
 7 : TO  1 TO-MESSAGE ! ;
 8 \ Signal that we want to add to value
 9 : +TO 2 TO-MESSAGE ! ;
10
11 \ ISO
12 : VALUE CREATE , DOES> _value_jumps TO-MESSAGE @ CELLS +
13     @ EXECUTE   FROM ;
14
15

/-------------------------------------------------------


Groetjes Albert
-- 
Albert van der Horst, UTRECHT,THE NETHERLANDS
Economic growth -- being exponential -- ultimately falters.
albert@spe&ar&c.xs4all.nl &=n http://home.hccnet.nl/a.w.m.van.der.horst

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


#27439

From"Ed" <invalid@invalid.com>
Date2013-12-25 20:15 +1100
Message-ID<l9e7on$nsu$1@speranza.aioe.org>
In reply to#27421
Paul Rubin wrote:
> ForthFreak <forthfreak@gmail.com> writes:
> > Marcel's program in standard Forth: ...
> > : strike-him  ( -- ) -1 +to live-ones?  0 'victim c!  0 to call-outs
>
> +to doesn't seem to be a standard word.  gforth doesn't have it and I
> hadn't seen it before.  It looks useful though.

The rationale behind  VALUE  is that it is a 'variable constant' i.e. the
contents will not be changing frequently during execution of a program.
Consequently  TO  is sufficient for updating the contents.

VALUE  +TO  in a program suggests the contents *are* changing frequently
in which case one should properly be using  VARIABLE  and  +!  instead.

Systems that support locals often implement  +TO  being the nearest thing
locals have to  +!  .


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


#27427

Frommhx@iae.nl
Date2013-12-24 04:36 -0800
Message-ID<17f1f97c-632c-495f-96d2-6d4b5979aca2@googlegroups.com>
In reply to#27419
On Tuesday, December 24, 2013 12:45:21 PM UTC+1, ForthFreak wrote:
> Marcel's program in standard Forth:
> 
> 40 value #soldiers 
> create arena  #soldiers chars allot 
[..] 
This invites to do '80 TO #soldiers' after the program has
run and try again. Make that #40 constant #soldiers. 

I assume 1 chars == 1 and consider 'chars allot' not to be 
insightful when writing/reading the area with c!/c@.

Nice that it works on a 16-bit Forth too. It think it will
work for any size, actually.

-marcel

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


#27437

From"Rod Pemberton" <dont_use_email@xnohavenotit.cnm>
Date2013-12-24 17:05 -0500
Message-ID<op.w8mabzfq5zc71u@localhost>
In reply to#27414
On Tue, 24 Dec 2013 04:13:15 -0500, Paul Rubin <no.email@nospam.invalid>  
wrote:
> "Rod Pemberton" <dont_use_email@xnohavenotit.cnm> writes:

>> [link]
>> Understand it?
>
> That's in C and it's ugly!

Yes, it is, both.

Unfortunately, as the OP requested it, it would've been
much larger and uglier if it had used linked lists.

> Here it is in Haskell:
>
>     josephus n [] = []
>     josephus n ds = f:josephus n (fs++es) where
>       (es,f:fs) = splitAt n' ds
>       n' = (n-1) `mod` length ds
>
>     main = print (josephus 3 [1..40])
>
> It's interesting that Knuth (actually probably vol. 1 rather than
> vol. 2) gave this problem a difficulty rating suggesting a few hours
> of work in MIX assembly language.

Hours?

> I remember implementing it in Lisp long
> ago, using a circular list mutated with rplacd, ugh.  The Lisp hacking
> took just a few minutes and I remember thinking that yeah, it might
> actually take a few hours to get it working in assembler, so the quick
> Lisp solution showed how much times had changed since the book was
> written in the 1960's.
>

I seem to recall the C solution I posted being just a few minutes too,
but passage of time, posted some years ago, and my recollection may
be glorifying that a bit...

> My Forth solution probably took me about an hour, though a real Forther
> could probably have done it better/faster.  My first Haskell solution
> (using unfoldr) took a few minutes, and the direct recursive version
> above took just a minute or two.  In retrospect, unfoldr was a little
> too fancy.

While a bit ugly, AIR, the C code is quite simple, just using some loops
with skip counters.  That could be re-implemented in Forth since they're
just acting like a sieve, much like the sieve of Eratosthenes for primes.


Rod Pemberton

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


#28999

From"WJ" <w_a_x_man@yahoo.com>
Date2014-03-10 07:11 +0000
Message-ID<lfjoi5$80k$1@dont-email.me>
In reply to#27414
Paul Rubin wrote:

> "Rod Pemberton" <dont_use_email@xnohavenotit.cnm> writes:
> > https://groups.google.com/d/msg/comp.lang.c/k9YQ7kmnRsE/saqlkO2Si60J
> > Understand it?
> 
> That's in C and it's ugly!  Here it is in Haskell:
> 
>     josephus n [] = []
>     josephus n ds = f:josephus n (fs++es) where
>       (es,f:fs) = splitAt n' ds
>       n' = (n-1) `mod` length ds
> 
>     main = print (josephus 3 [1..40])

Ruby:

men = (1..40).to_a
while men.size > 2
  p men.push( *men.shift( 3 ) ).pop
end ;
puts men

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


#27418

Frommhx@iae.nl
Date2013-12-24 02:59 -0800
Message-ID<d02db2df-1800-4ae8-be32-bdd513465101@googlegroups.com>
In reply to#27411
On Tuesday, December 24, 2013 9:59:52 AM UTC+1, Paul Rubin wrote:
> "Rod Pemberton" <dont_use_email@xnohavenotit.cnm> writes:
> 
> > https://groups.google.com/d/msg/comp.lang.c/k9YQ7kmnRsE/saqlkO2Si60J
> > Understand it?
> 
> That's in C and it's ugly! [..]

On the other hand, it tells us a lot about RP's Forth mindedness.

-marcel

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


#27416

FromForthFreak <forthfreak@gmail.com>
Date2013-12-24 01:53 -0800
Message-ID<1eb29480-f730-449e-86a1-42feb2bb96b1@googlegroups.com>
In reply to#27410
I don't understand this part:

create ring  ring-size cells allot 
does> ( i -- addr ) swap cells + ; 

What's going on here?

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


#27420

FromPaul Rubin <no.email@nospam.invalid>
Date2013-12-24 04:06 -0800
Message-ID<7x4n5yjvwo.fsf@ruckus.brouhaha.com>
In reply to#27416
ForthFreak <forthfreak@gmail.com> writes:
>    create ring  ring-size cells allot 
>    does> ( i -- addr ) swap cells + ; 
> What's going on here?

Is that not idiomatic?  It makes an array of size RING-SIZE and defines
the word RING such that "5 RING" puts the address of the 5th element on
the stack, etc.

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


#27422

FromForthFreak <forthfreak@gmail.com>
Date2013-12-24 04:24 -0800
Message-ID<1f0a25b5-5287-4094-b7b3-7d67041e904e@googlegroups.com>
In reply to#27420
On Tuesday, 24 December 2013 12:06:15 UTC, Paul Rubin  wrote:
> Is that not idiomatic?  It makes an array of size RING-SIZE and defines
> the word RING such that "5 RING" puts the address of the 5th element on
> the stack, etc.

Clever. Doesn't work in my system, and is not standard IIUC.

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


#27424

FromForthFreak <forthfreak@gmail.com>
Date2013-12-24 04:30 -0800
Message-ID<c4fc5243-c4c2-429b-9f3d-33fb847bc758@googlegroups.com>
In reply to#27410
Okay, here's my solution, which I believe is the easiest to understand so far.

It uses +TO since i prefer VALUEs to VARIABLEs. You're quite right, Paul, +TO is not recognised by GFort <shock>.

forget #soldiers

40 value #soldiers
#soldiers value remain
0 value position
create soldiers #soldiers chars allot

: init ( --) 
    #soldiers 0 do 1  soldiers i +  c!  loop 
    -1 to position  #soldiers to remain ;
    
: soldiers' ( -- addr) soldiers position + ;
    
: position++ ( --)
    position 1+ #soldiers mod to position ;
    
: kill3rd ( --) 
    0 begin 
        position++  soldiers' c@ if 1+ then
      dup 3 = until drop 
      0 soldiers' c!  position 1+ .  -1 +to remain ;
    
: killThem ( --) init begin remain 0> while kill3rd repeat 
    cr ." Last man standing at position " position 1+ . ;

I win :-)

A nice brain teaser, thanks Paul. Took me longer to write than it should have (my first attempt didn't work - didn't read the description carefully enough). I had to visit thedailywtf before I went "Oh, I see...!"

Merry Christmas.

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


#27426

FromForthFreak <forthfreak@gmail.com>
Date2013-12-24 04:35 -0800
Message-ID<a9e96f64-5421-45ed-bc68-c1f051f42540@googlegroups.com>
In reply to#27424
For GForth, just change the last phrase in GForth to

remain 1- to remain

Should have made that change before posting. Oh well.

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


#27428

FromForthFreak <forthfreak@gmail.com>
Date2013-12-24 05:01 -0800
Message-ID<03b7bcda-141f-464d-87bf-4151a56fe36e@googlegroups.com>
In reply to#27410
With a slight change to use PAD. This allows one to try different circle sizes without need for re-compilation.

0 value #soldiers
#soldiers value remain
0 value position

: init ( --) 
    #soldiers 0 do 1  pad i +  c!  loop 
    -1 to position  #soldiers to remain ;
    
: soldiers' ( -- addr) pad position + ;
    
: position++ ( --)
    position 1+ #soldiers mod to position ;
    
: kill3rd ( --) 
    0 begin 
        position++  soldiers' c@ if 1+ then
      dup 3 = until drop 
      0 soldiers' c!  position 1+ .  remain 1- to remain ;
    
: killThem ( --) init begin remain 0> while kill3rd repeat 
    cr ." Last man standing at position " position 1+ . ;

: victims ( n -- ) to #soldiers  killThem ;



40 victims
Last man standing at position 28

12 victims
Last man standing at position 10

100 victims
Last man standing at position 91

etc

Okay, that's enough Forth for Christmas eve ;-)

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


Page 1 of 3  [1] 2 3  Next page →

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


csiph-web