6502.org Forum Projects Code Documents Tools Forum
It is currently Sat Apr 27, 2024 9:51 pm

View unanswered posts | View active topics


Board index » 6502.org Users Forum » Forth

All times are UTC




Post new topic Reply to topic  Page 5 of 6
  [ 85 posts ]  Go to page Previous  1, 2, 3, 4, 5, 6  Next
  Previous topic | Next topic 
Author Message
JimBoyd
PostPosted: Mon Feb 25, 2019 9:46 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 851
I didn't intend to digress into the differences between ASCII" and CONTROL . I got the wrong screen shot. Instead of showing the screen from the original Blazin' Forth system loader, it was from the disk I modified to be compatable with Fleet Forth.
Top
 Profile  
Reply with quote  
Martin_H
PostPosted: Fri May 03, 2019 9:00 pm 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 565
Computing the Fibonacci numbers is a common CS-101 problem used to introduce the concept of recursion. However, if you analyze stack usage it's hideously inefficient, and likely to exceed the size of the return stack for any large value of N. So instead I constructed a sample that couples iteration with Forth's stack manipulations to make the Fibonacci pairs, and then the final Nth number.

Code:
\ Computes the n number in the Fibonacci sequence.
: fibonacci ( n -- n )
  \ First make sure we have a positive integer.
  dup
  0<= if
    cr ." Fibonacci requires a positive integer. "
    drop
  else
    \ if 1 then return 1
    dup
    1 = if
      drop 1
    else
      \ if 2 then return 1
      dup
      2 = if
        drop 1
      else
        \ seed the stack with 1 1 n
        1 tuck swap
        \ loop using the stack to generate Fibonacci pairs.
        2 do
          tuck +
        loop
        \ add the last two pairs.
        +
      then
    then
  then ;
Top
 Profile  
Reply with quote  
JimBoyd
PostPosted: Sat May 04, 2019 11:14 pm 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 851
Martin_H wrote:
Computing the Fibonacci numbers is a common CS-101 problem used to introduce the concept of recursion. However, if you analyze stack usage it's hideously inefficient, and likely to exceed the size of the return stack for any large value of N.

CS classes really should pick an example of recursion that doesn't depict it in a bad light since finding the Nth Fibonacci number is best solved iteratively rather than recursively ( although I do remember a technique in Python where a small dictionary was used to cache the latest Fibonacci numbers with their respective N as the key. By checking the dictionary first, the second recursion is eliminated. )

What about the bidirectional Fibonacci sequence?
Code:
...  -21 13 -8 5 -3 2 -1 1 0 1 1 2 3 5 8 13 21 ...

[Edit: fixed formatting error on my part.]


Last edited by JimBoyd on Tue Jul 02, 2019 8:06 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
commodorejohn
PostPosted: Sat May 04, 2019 11:30 pm 
Offline

Joined: Thu Jan 21, 2016 7:33 pm
Posts: 269
Location: Placerville, CA
Yeah, that's always struck me funny - I don't doubt that there are probably useful applications for recursion, but man alive do they always pick the worst ones to demonstrate.
Top
 Profile  
Reply with quote  
pbj
PostPosted: Wed Jun 26, 2019 3:28 am 
Offline

Joined: Mon Jun 24, 2019 1:13 pm
Posts: 34
Hi Martin,

I ran your Mandelbrot in Tachyon on the P2 as a quick test but even though it only takes about half a second to run, it doesn't look right :(
I can zoom in by 100 instead and it does zoom (takes about a second) so that part works correctly. BTW, this code is one of the simple benchmark tests I will run on the 65816/37702 chips when I convert Tachyon.

I haven't really looked into what is going wrong. Any ideas?
Code:
-------------------------------------------------------------------------------
  Parallax P2  *TAQOZ* Extensible Firmware  V2.0 'CHIP' 125MHz 190212-1700
-------------------------------------------------------------------------------
TAQOZ# 300 P2MHZ ---  ok
$0004_0627   Parallax P2  *TAQOZ* Extensible Firmware  V2.0 'CHIP' 300MHz 190212-1700
  52    ---   
53 lines and 274 bytes compiled,  with 0 errors in 72ms  ok
TAQOZ# GO ---
     ..!..     .,'.~     ,.!.'     .,.!....~~',.!.,.,.,.....^..~...,,...,...,'.
    ,.~,'     ..,!.     .:'...    .'.'.'.^.',^..,.!.,.,....,.,',..,....^.',,,.'
   ,.'..     ~,'..     ~.,.',    ,.........''',.,...~!.'.'..~...,,.''~.,.'!,..,
  .^.,:     ^..'.     ''~;'.    ,,.!., ~,''..'...''.'.'....,'...~!.,,,....'.,,,
 ,^,..     ,'..,     ,,',..    '~.~..  .'''...,'.,'.!,'....,.~.,...''..^.',,..!
.'..'     ...,~     '...'.    '.,,!,   ,......,..~...'^.,'.~,                 
!...     ..!.,     ..,,.,    ,.'...                                           
.!.     .,...     ~.,.,~    ....,^    ~                                       
,.     ...^^     .~',.!    ..,.,.    ~'                                       
,     ,...'     ,.,~~'    ',.~..    ,..                                       
     ,,,.,     ...!~.    .!,.,~    ..,.~...'..,..,,,.~'',.'.'.'.:...^..,,~.''..
    ..,..     .,,'..    ,~...,    .....~~..,.',',,..,...,~.,,'...';'...~',.,'..
   '....     ..,,,,    ',~..'    ',,.,,..,,........,.''.,,'..,...,,~.!,.,,...'.
  ,.'~,     '.'.,'    .,~~..    ,.''., !.,~.,~.'^....~,.,,,.,.'.,.,,...',,.',.!
 ,.!..     '...''    ,!...!    ......  .............'....,.!.,.:.,.~.~.~,,.!^.,
.,.,.     ''.,..    '',...    .',.,.   ,.',.:.,.',~~,.'.,,!..'.,.,.,,,'.       
.,~'     ...,.,    ,.,,.,    .,.'..                                           
'..     ,.,,..    ..!.^.    .,.,',    .                                       
'.     ,'.,,.    .:.~,~    .;'.,,    '.                                       
.     .~,...    ......    '~...,    ''.                                       
     '.~'.,    ''.~.~    ...''.    '..,..',,...!.....~....,....,~~.:,.''.',,...
    ,,.,'.    .',..~    .,...,    .'..,,,...,,'.',.';.,!.,'!...~''.!'....,'.,,,
   '..,..    ''..,.    ,'.,^~    ''[.,....,.'.,~,,.',.~,.~','.'.'~....'',,.,...
  .,....    ,,,...    ,.,,'.    :..:.. .'...',,./'...,...',,.,.'..~~~',',..'.,.
 ,.~..'    .',,'.    ^,,'..    :''~'^  ~.,,'...,...!'.~'~...',,...'..!',.,',...
,.,.~,    ~^..'!    .....,    .....,   ..,',,,..,''!,.,,,....,.,..^..'..,..., 
.,,,,    ',,...    ,.....    ,...~.                                           
.',.    ,.,.'.    ..'',.    ..,.~.    ,                                       
~.^    ,.~,,,    ,~'...    '.....    ..                                       
'.    .',,~,    .~'''.    .,.',.    ...                                       
     ....',    ,:...,    ,,.'.'    ,.'',.,,''..,.,,.!,.,^.,..~,^.~,.':,...:..,.
    .!.,,.    .,~.,.    .!'.~,    ~..,..'...!...'..,,,.',,....~'....,,.~,!.,,.,
   ,.~.,'    ..^'..    ,,...,    ..:',,.,...,...,.,.',.,'.'.:...'..'.',...~~,,.
  ....![    ',,.,'    ...,',    ::,..' ..,..'...,,.'..'...,'!.,.....,,'...~'~,.
 ,^~..,    .~.,',    ,...,.    .,~,!.  ,,....~'~..,.....,.'.~.,,..~.~..,',.''.'
,,,~.,    ..~',,    ..,.!~    ,,....   .,.,'.'',.,,.....,.~.,...!.../'[...,!.,.
,.,..    .,,..,    '.'..,    .,~.!.                                           
'!!,    ~.,~.,    ,:..,!    ..,,..    .                                       
^..    ......    ,..,:'    ...',.    ..                                       
..!,.'    .,,!~,    '~..~,    .,.,'.   WWWWWW<:^!~''',,,,,,,...................
.'...^    .!,,.!    .,.!,,    .,',,,   .WWWWWW[^!~''',,,,,,....................
'.,,'.    ,...'.    ~.~...    !....,   .WWWWWWW;!~''',,,,,,....................
,,..,;    '.~!.,    .''~.!    .,':.,   .WWWWWWW:!~''',,,,,,....................
'.~,!.    ~....!    .,,'.'    .~',.[   .WWWWWWW~~;''',,,,,,....................
.'...~    .'..,.    ,.....    ,.~,.,   ..WWWWW~!;~''',,,,,,....................
..^:..    '...,!    .~!'.,    .,..,.   ..,WWW'''~~'',,,,,,,....................
.,....    ,...,,    .!,,,'    '.....   ...,,''!!'~'',,,,,,.....................
,.',,,    .;,!,.    .,;,.,    '...!.   ...,,,,,'!:!!,,,,,,.....................
',..,.    ....,,    '...~.    .!'',.   ,...,,,,,,,!',,,,,,....................
,.,'~'    ,...,.    ^.,...    .,,,.^   ^....~''''~,,,,,,,.....................
,.'!.'    '...,!    ..~.~.    ^.....   ',...~,,,,,,~~~,,,.....................
''^,,'    ,.,.,.    .!',.~    .,.,^~   ,~,...,,!~'~!',,,......................
!.,,.'    ^.,.,.    ~,.,.'    ~...,.   ,!,'...~~,,,,,,,,..................... 
.,..~.    ,...!,    .','.,    '...:.   .~~',...,'',,,,,...................... 
.'...,    ,.~...    ^...^.    .,.^^.   ...,,'...,'~,,,....................... 
.,..,,    ~.'...    .,',..    ~.,...   ....',,..','',,......................   
,.!'..    !...,.    .!',..    .'!,.'   ,....~'!..!,',.......................   
,.,,,'    .,'~.~    ,...!.    '.~,.,   ,,,...,',..,'.......................   
;.''.,    .!,,.~    .,,~..    ,...'.   ,!,'...,,,..........................   
.,..''    !.,,..    .,',.'    .!,.~.   .,'''...~'~........................     
'...,.    ,,',..    .....;    ....,,   ...',,,..'!'.......................     
.'.,,     '~.'..    .!,.,,    ,,,,..   '....~,'...,,.....................     
,.'..     .,'.,.    .'/.',    '..^.~   !,'...,,'...!,...................       
.,',.     ,..'..    ...'.,    ,..,.'   ,,,~....',...',..................       
,.,..     ,....,    .,,.^,    ,,,,..   ...,',...^,,..',................       
.'.,,     ,..,..    ,',,!.    ,..,.,   ....'~,^..',,..,'..............         
....'     .,'.~~    .,'.,,    ....,'   ~',...,[,...,,..~,............         
.,.,'     .,,.'.    ,..~..    ~...'~   .,'',...,'~..'~..,~..........           
!.,..     .'!.'.    ....,~    .,~'..   ...&':,..;,,..,'..,^........           
,.''.     ,..,.,    .....,    ..'.,'   ~....,,~...^~..,'..~,......             
...'.     ..~.,,    !~.~.,    ,^'...   ',,,...,,^..~;'..,..!,....             
.,,.'     ,.'...    '!,...    ...,,~   ..',!,...~:,..!,..',.,,..               
,~,.'     .~.,!     ~~.,.'    ,'.,..   ,....~',...,,..,,..,,.'                 
.,,.,     '^.'.     ..,.^.    ...,,,   ,,~'...~,!..,^..,,..!,                 
,..,.     .'.,.     ,,.,',    ..,.,,   ...,''...'',..,'..'!                   
...,.     ..!.,     ...,,!    ...,:,   ,....,'!...''..,'.                     
,..~.     ...!,     ..,.,.    !^.,..   ,~,'...!,,...,'.                       
.,'.'     ...!'     ,'.,~     ...,,^   ...~,',...,,.                           
.,,.,     ,,'..     !,.'.     ~''.':   ,~....,,,                                ok
TAQOZ#


This is my source code:
Code:
TAQOZ

FORGET *MANDELBROT*

: *MANDELBROT*   ;

\ Setup constants to remove magic numbers to allow
\ for greater zoom with different scale factors.
20      := #MAXITER
40      := #MAXVAL
-39      := #MINVAL

: SCALE      5 << ;
20 SCALE   := #RESCALE

\ These variables hold values during the escape calculation.
long CREAL
long CIMAG
long ZREAL
long ZIMAG
long ESCCNT

\ Compute squares, but rescale to remove extra scaling factor.
: ZSQ      @ DUP #RESCALE */ ;

\ Translate escape ESCCNT 1 to MAXITER+1 to ascii greyscale 1=black
\      ..0123456789ABCDEF012345
: .GRAY     "   .,'~!^:;[/<&?oxOX#MW"  + C@ EMIT ;

\ Increment ESCCNT and compare to max iterations.
: COUNT?     ESCCNT ++ ESCCNT @ #MAXITER > ;

\ stores the row column values from the stack for the escape calculation.
: INIT_VARS
  SCALE DUP CREAL ! ZREAL !
  SCALE DUP CIMAG ! ZIMAG !
  1 ESCCNT ! ;

\ Performs a single iteration of the escape calculation.
: DOESCAPE
    ZREAL ZSQ  ZIMAG ZSQ 2DUP +
    #RESCALE 4* > IF
      2DROP
      TRUE
    ELSE
      - CREAL @ +   ( result )
      ZREAL @ ZIMAG @ #RESCALE */ 2* ( result val )
      CIMAG @ + ZIMAG ! ( result )
      ZREAL !
      COUNT?
    THEN ;

\ Iterates on a single cell to compute its escape factor.
: DOCELL ( row cell -- )
  INIT_VARS
  BEGIN
    DOESCAPE
  UNTIL
  ESCCNT @ .GRAY
  ;

\ For each cell in a row.
: DOROW
  #MAXVAL #MINVAL DO
    DUP I DOCELL
  LOOP
  DROP ;

\ For each row in the set.
: MANDELBROT
  #MAXVAL #MINVAL DO
    CRLF I DOROW
  LOOP ;

: ZOOM ( n -- )      SCALE ' #RESCALE :=! MANDELBROT ;

\ Run the computation with defaults
: GO         20 ZOOM ;

END
Top
 Profile  
Reply with quote  
pbj
PostPosted: Wed Jun 26, 2019 7:00 am 
Offline

Joined: Mon Jun 24, 2019 1:13 pm
Posts: 34
Ahhh, my bad, I found a sign bug in my */ routine. Just did a quick workaround as * and / and it all looks sweet. Time to go and fix that bug now.
Code:
                               .................                               
                           .........................                           
                        ...............................                       
                      ...................................                     
                    .......................................                   
                  ...........................................                 
                 .............................................                 
               .................................................               
              ...................................................             
             .....................................................             
            .......................................................           
           .........................................................           
          ...........................................................         
         ...............,,,,,,,,,,,...................................         
        ............,,,,,,,,,,,,,,,,,,,................................       
       ..........,,,,,,,,,,,,,,,,,,,,,,,,,..............................       
       .......,,,,,,,,,,,,,,,,,,''''~''',,,,,...........................       
      .......,,,,,,,,,,,,,,,,'''''~ ^~~''',,,,...........................     
     ......,,,,,,,,,,,,,,,,''''''~!:<!!~'''',,,,..........................     
     .....,,,,,,,,,,,,,,,,''''''~~!^/;/ ~'''',,,,.........................     
    ....,,,,,,,,,,,,,,,,'''''''~~~^:[X[^!~'''',,,,,........................   
    ...,,,,,,,,,,,,,,,,'''''''~~~!:;  /:!~~'''',,,,,.......................   
   ...,,,,,,,,,,,,,,,,'''''''~~~!/ o  Xx^~~~'''',,,,,.......................   
   ..,,,,,,,,,,,,,,,,'''''''~~!!^:?     :!~~~~'',,,,,,......................   
  ...,,,,,,,,,,,,,,,''''''~~!!!^^;      :^!!~~~'',,,,,....................... 
  ..,,,,,,,,,,,,,,''''''~~!:::::;[?    &[;:!!!<~'',,,,,...................... 
  .,,,,,,,,,,,,,,'''''~~~!^& <[          ? :::o^~',,,,,,..................... 
 ..,,,,,,,,,,,,,''''~~~~!!^<  x            <?ooo~',,,,,,......................
 .,,,,,,,,,,,,,''~~~~~~!!^:[                   ;~~',,,,,,.....................
 .,,,,,,,,,,,''~~~~~~~!!!: <                   ^!~',,,,,,.....................
 ,,,,,,,,,'''~!!!~~~!!!^^                     <^!~'',,,,,,....................
.,,,,,,,'''~~^<^^^^^^^^^:/                    O[o~'',,,,,,.....................
.,,,,'''''~~!^o;;;&[::::[                        ~'',,,,,,.....................
,,,''''''~~~!^[x#<& ?/;[/                      ?:!'',,,,,,,....................
,,''''''~~~~^^;o      &/&                      ?;~''',,,,,,....................
,''''''~~~~^^;/        xO                       ^~''',,,,,,....................
''''''~~~!^<;/O                                 !~''',,,,,,....................
'''''!!!!^:<&o                                 :!~''',,,,,,....................
~~!^:^!^:;[o                                  [^!~''',,,,,,....................
                                             <:^!~''',,,,,,,...................
~~!^:^!^:;[o                                  [^!~''',,,,,,....................
'''''!!!!^:<&o                                 :!~''',,,,,,....................
''''''~~~!^<;/O                                 !~''',,,,,,....................
,''''''~~~~^^;/        xO                       ^~''',,,,,,....................
,,''''''~~~~^^;o      &/&                      ?;~''',,,,,,....................
,,,''''''~~~!^[x#<& ?/;[/                      ?:!'',,,,,,,....................
.,,,,'''''~~!^o;;;&[::::[                        ~'',,,,,,.....................
.,,,,,,,'''~~^<^^^^^^^^^:/                    O[o~'',,,,,,.....................
 ,,,,,,,,,'''~!!!~~~!!!^^                     <^!~'',,,,,,....................
 .,,,,,,,,,,,''~~~~~~~!!!: <                   ^!~',,,,,,.....................
 .,,,,,,,,,,,,,''~~~~~~!!^:[                   ;~~',,,,,,.....................
 ..,,,,,,,,,,,,,''''~~~~!!^<  x            <?ooo~',,,,,,......................
  .,,,,,,,,,,,,,,'''''~~~!^& <[          ? :::o^~',,,,,,..................... 
  ..,,,,,,,,,,,,,,''''''~~!:::::;[?    &[;:!!!<~'',,,,,...................... 
  ...,,,,,,,,,,,,,,,''''''~~!!!^^;      :^!!~~~'',,,,,....................... 
   ..,,,,,,,,,,,,,,,,'''''''~~!!^:?     :!~~~~'',,,,,,......................   
   ...,,,,,,,,,,,,,,,,'''''''~~~!/ o  Xx^~~~'''',,,,,.......................   
    ...,,,,,,,,,,,,,,,,'''''''~~~!:;  /:!~~'''',,,,,.......................   
    ....,,,,,,,,,,,,,,,,'''''''~~~^:[X[^!~'''',,,,,........................   
     .....,,,,,,,,,,,,,,,,''''''~~!^/;/ ~'''',,,,.........................     
     ......,,,,,,,,,,,,,,,,''''''~!:<!!~'''',,,,..........................     
      .......,,,,,,,,,,,,,,,,'''''~ ^~~''',,,,...........................     
       .......,,,,,,,,,,,,,,,,,,''''~''',,,,,...........................       
       ..........,,,,,,,,,,,,,,,,,,,,,,,,,..............................       
        ............,,,,,,,,,,,,,,,,,,,................................       
         ...............,,,,,,,,,,,...................................         
          ...........................................................         
           .........................................................           
            .......................................................           
             .....................................................             
              ...................................................             
               .................................................               
                 .............................................                 
                  ...........................................                 
                    .......................................                   
                      ...................................                     
                        ...............................                       
                           .........................                           
                               .................                                ok
Top
 Profile  
Reply with quote  
pbj
PostPosted: Wed Jun 26, 2019 8:17 am 
Offline

Joined: Mon Jun 24, 2019 1:13 pm
Posts: 34
I converted the Mandelbrot routine to output to VGA over a higher resolution on the P2.

Code:
TAQOZ

FORGET *MANDELBROT*

: *MANDELBROT*   ;
( NOTE: Adapted from a routine written by Martin H )

20      := #MAXITER
220      := #MAXVAL
-229      := #MINVAL

pub SCALE      5 << ;
20 SCALE   := #RESCALE

\ These variables hold values during the escape calculation.
long CREAL
long CIMAG
long ZREAL
long ZIMAG
long ESCCNT

\ stores the row column values from the stack for the escape calculation.
pri INIT_VARS
  SCALE DUP CREAL ! ZREAL !
  SCALE DUP CIMAG ! ZIMAG !
  1 ESCCNT ! ;

\ Compute squares, but rescale to remove extra scaling factor.
pri ZSQ      @ ABS DUP #RESCALE */ ;
\ Increment ESCCNT and compare to max iterations.
pri COUNT?     ESCCNT ++ ESCCNT @ #MAXITER > ;

\ Performs a single iteration of the escape calculation.
pri DOESCAPE
    ZREAL ZSQ  ZIMAG ZSQ 2DUP +
    #RESCALE 4* > IF
      2DROP TRUE
    ELSE
      - CREAL @ +   ( result )
      ZREAL @ ABS ZIMAG @ ABS #RESCALE 2/ */
--- workaround for */ sign bug
      ZREAL @ ZIMAG @ XOR 31 >> IF NEGATE THEN ( result val )
      CIMAG @ + ZIMAG ! ZREAL !
      COUNT?
    THEN ;

\ Iterates on a single cell to compute its escape factor.
pri DOCELL ( row cell -- )
  INIT_VARS BEGIN DOESCAPE UNTIL
--- expand the color and plot the pixel
  ESCCNT @ 11 W* PIXEL! 1 X+!
  ;

\ For each cell in a row.
pri DOROW     #MAXVAL #MINVAL DO DUP I DOCELL LOOP DROP ;

\ For each row in the set.
pub MANDELBROT
  CLRSCR !PALETTE TL
  #MAXVAL #MINVAL DO 1 Y+! 0 x I DOROW LOOP
  ;

pub ZOOM ( n -- )      SCALE ' #RESCALE :=! MANDELBROT ;

\ Run the computation with defaults
pub GO         200 ZOOM ;

END


Attachments:
mandelbrot.jpg
mandelbrot.jpg [ 519.24 KiB | Viewed 5903 times ]
Top
 Profile  
Reply with quote  
JimBoyd
PostPosted: Tue Mar 02, 2021 3:51 am 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 851
commodorejohn wrote:
Yeah, that's always struck me funny - I don't doubt that there are probably useful applications for recursion


Tree traversal comes to mind.
The recursive routines in Turtle Geometry that draw the Koch snowflake and C curve are other examples.

Quote:
but man alive do they always pick the worst ones to demonstrate.


On one hand, I'd like to give them the benefit of the doubt. Maybe they didn't know about some of these other examples.
On the other, maybe they don't like recursion. It occurs to me that some people when confronted with a technique they don't like, will pick examples to cast it in the worst possible light.
Top
 Profile  
Reply with quote  
BigEd
PostPosted: Tue Mar 02, 2021 9:11 am 
Offline
User avatar

Joined: Thu Dec 11, 2008 1:28 pm
Posts: 10793
Location: England
I think recursion is (or can be) a classic case of divide and conquer: when you're fully embracing structured programming, and not agonising about the cost of procedure calls, it's natural (or it becomes natural) to solve a tiny slice of the problem and then solve the remaining problem - or, to solve the simplest case and then to solve the problem as two half-sized problems.

When it comes to picking examples, perhaps the point of some of the simplest examples is illustration, not motivation. It's not that factorial or fibonacci are such excellent fits, it's that they are simple enough to see what's going on.
Top
 Profile  
Reply with quote  
commodorejohn
PostPosted: Wed Mar 03, 2021 1:03 am 
Offline

Joined: Thu Jan 21, 2016 7:33 pm
Posts: 269
Location: Placerville, CA
Basic tree traversal would actually be a nice balance of "simple" and "actually makes any dang sense" if you could put together a trivial, easily-understood test-case for it.
Top
 Profile  
Reply with quote  
JimBoyd
PostPosted: Sat Mar 06, 2021 1:25 am 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 851

The last time I wrote anything with trees was not in Forth or the 65XX family of processors so here are examples of recursion with turtle graphics. The first draws a C curve similar to a Levy C curve but this one skips every other step.
Code:
30 VALUE LIM
: CCURVE  ( SIZE -- )
   DUP LIM < IF  FD EXIT  THEN
   90 LT DUP 2/ RECURSE
   90 RT DUP 2/ RECURSE  DUP 2/ RECURSE
   90 RT 2/ RECURSE
   90 LT ;

This version stops the recursion when the line length is less than the value of LIM .
Setting LIM to 5 and executing CCURVE with 64 on the stack produces the following image:
Attachment:
ccurve.png
ccurve.png [ 13.22 KiB | Viewed 5446 times ]

This version limits the recursion based on the depth of recursion:
Code:
: CCURVE  ( SIZE DEPTH -- )
   ?DUP
   IF
      1- SWAP 2/ SWAP
      90 LT  2DUP RECURSE
      90 RT  2DUP RECURSE  2DUP RECURSE
      90 RT  RECURSE
      90 LT
      EXIT
   THEN
   FD ;

With this version, the following will produce the same curve:
Code:
64 4 CCURVE

This draws the Koch snowflake:
Code:
: KOCH/3
   DUP LIM < IF  FD EXIT  THEN
   DUP 3 / RECURSE
   60 LT DUP 3 / RECURSE
   120 RT DUP 3 / RECURSE
   60 LT 3 / RECURSE ;

: KOCH 30 RT
   3 0
   DO
      DUP KOCH/3 120 RT
   LOOP
   DROP 30 LT ;

This example could ( and maybe should) be rewritten to limit recursion by depth. Here are a series of images based on depth of recursion:
Attachment:
ks 1.png
ks 1.png [ 12.86 KiB | Viewed 5446 times ]

Attachment:
ks 2.png
ks 2.png [ 13.3 KiB | Viewed 5446 times ]

Attachment:
ks 3.png
ks 3.png [ 13.44 KiB | Viewed 5446 times ]

Attachment:
ks 4.png
ks 4.png [ 14.27 KiB | Viewed 5446 times ]

Notice the brevity of the code versus the complexity of the images. With a higher video resolution, these words could achieve even more complexity of the image just by setting the recursion depth deeper ( with a larger starting size). With the second version of CCURVE and a system that had much higher video resolution, just think what 1024 8 CCURVE would look like.
Top
 Profile  
Reply with quote  
JimBoyd
PostPosted: Thu Sep 09, 2021 2:53 am 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 851

Previously in this thread, I mentioned porting Blazin' Forth's TRACE word to Fleet Forth. One limitation was the inability to trace a word using Forth's pictured numeric output words (not Forth's words . .R and so on, but <# #S #> HOLD and so on) because .S overwrites the area below PAD . The following modification overcomes this limitation by temporarily moving PAD an extra 170 bytes above HERE and saving the value of HLD while the trace information is displayed then restoring both.
Code:
VARIABLE CON
: CONT   CON ON ;
: +PAD
   $FF ?MEM
   [ ' PAD >BODY 2+ 2+ ] LITERAL
   C! ;
: -PAD
   $55
   [ ' PAD >BODY 2+ 2+ ] LITERAL
   C! ;
: NOTRACE
   NEXT>  -PAD
   ." TRACING OFF" QUIT ;
: STEP  ( CFA -- )
   NEXT>  HLD @ >R +PAD
   CR @ .NAME TAB .S
   KEY DUP>R ASCII" {CONTROL P}" =
   IF
      CON OFF
      BEGIN
         CR ." P? "
         QUERY INTERPRET  CON @
      UNTIL
   THEN
   -PAD  R> R> HLD !
   ASCII" {RUN/STOP}" = IF   NOTRACE  THEN
   <IP> >NEXT ;NEXT ;
' STEP 'TRACE !

[Edit: Updated code. This is the latest version.]


Last edited by JimBoyd on Mon Jan 03, 2022 10:07 pm, edited 1 time in total.

Top
 Profile  
Reply with quote  
Martin_H
PostPosted: Sat Sep 11, 2021 8:30 pm 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 565
@Jim, thanks for the C curve and snowflake code. Interesting and easy with turtle graphics.
Top
 Profile  
Reply with quote  
JimBoyd
PostPosted: Sat Sep 18, 2021 12:04 am 
Offline

Joined: Fri May 05, 2017 9:27 pm
Posts: 851

You're welcome.
Scott Ballantyne's Blazin' Forth for the C64 has more examples of recursion with turtle graphics. The examples are on the system loader disk on screens 130 through 138. Some of these recursive routines are mentioned in the book "Turtle Geometry: The Computer as a Medium for Exploring Mathematics" by Harold Abelson and Andrea A. diSessa from The MIT Press.
Top
 Profile  
Reply with quote  
Martin_H
PostPosted: Sat May 14, 2022 5:03 pm 
Offline

Joined: Wed Jan 08, 2014 3:31 pm
Posts: 565
Conway's game of life is a classic CS-101 problem that people encounter, and I realized that I've never written one. For me the only way to truly understand an algorithm is to write one myself, so I decided to give it a whirl using Forth.

On modern hardware it's plenty fast enough. But upon completion I realized there's a number of inefficiencies. The top few are:
* I used a byte array to store bit values. A bit vector would be slower, but more space efficient.
* Copying the next gen memory back to the current gen is inefficient. Swapping pointers would likely be better.
* While iterating a single cell I use multiply row * width nine times. Even on modern hardware integer multiply is about five times more costly than addition. Reusing the first multiply would be better.

Update: I realized that if row enumeration added width instead of 1 I would effectively by multiplying through addition. But only once per line, rather than nine times per cell. So I updated the code and it should be a performance boost.

My version is in my git hub repo https://github.com/Martin-H1/Forth-CS-1 ... r/life.fth
But here's a cut and paste of the code:
Code:

\ See http://en.wikipedia.org/wiki/Conway's_Game_of_Life

\ constants for board height and width
24 constant height
32 constant width
height width * constant size

\ allocate two arrays to hold current and next generations
create gen_curr size allot
create gen_next size allot

\ iterators and their associated operators
variable row
variable col

\ Sets the row offset to zero
: rowFirst ( -- ) 0 row ! ;

\ Advances the offset by the width.
: rowNext ( -- )
    width row +! ;

\ At end if current offset exceeds array size.
: rowAtEnd?
    row @ size >= ;

\ Iterator used to apply a function to the rows.
: rowForEach ( xt -- )
    rowFirst
    begin
   dup execute rowNext rowAtEnd?
    until
    drop ;

\ Returns index of the row after current using wrap around.
: row+ ( -- index )
    row @ width + size mod ;

\ Returns index of the column before current using wrap around.
: row- ( -- index )
    row @ width - size mod ;

: colFirst 0 col ! ;

: colNext
    1 col +! ;

: colAtEnd?
    col @ width >= ;

: colForEach ( xt -- )
    colFirst
    begin
   dup execute colNext colAtEnd?
    until
    drop ;

\ Returns index of the column after current using wrap around.
: col+ ( -- index )
    col @ 1 + width mod ;

\ Returns index of the column before current using wrap around.
: col- ( -- index )
    col @ 1 - width mod ;

\ moves bytes from next gen to current.
: moveCurr ( -- )
    gen_next gen_curr size move ;

\ clears curr array to clear out junk in ram
: currErase ( -- )
    gen_curr size erase ;

\ retrieve a cell value from the current generation
: curr@ ( col row -- n )
    + gen_curr + c@ ;

\ stores a value into a cell from the current generation
: curr! ( n col row -- )
    + gen_curr + c! ;

\ Parses a pattern string into current board.
\ This function is unsafe and will over write memory.
: >curr ( addr count -- )
    currErase
    rowFirst colFirst
    1-
    for
        dup c@
        dup '|' <> if
            bl <> 1 and
            col @ row @ curr!
       colNext
   else
       drop
       rowNext
       colFirst
   then
   1+
    next
    drop ;

: .cell ( -- )
    col @ row @ curr@
    if '*' else '.' then
    emit ;

\ prints the row from the current generation to output
: .currRow ( -- )
    cr ['] .cell colForEach ;

\ Prints the current board generation to standard output
: .curr
    ['] .currRow rowForEach
    cr ;

\ retrieve a cell value from the next generation
: next@ ( col row -- n )
    + gen_next + c@ ;

\ stores a cell into the next generation
: next! ( n col row -- )
    + gen_next + c! ;

\ computes the sum of the neigbors of the current cell.
: calcSum ( -- n )
   col-  row-  curr@
   col @ row-  curr@ +
   col+  row-  curr@ +
   col-  row @ curr@ +
   col+  row @ curr@ +
   col-  row+  curr@ +
   col @ row+  curr@ +
   col+  row+  curr@ + ;

: calcCell ( -- )
    calcSum

    \ Unless explicitly marked live, all cells die in the next generation.
    \ There are two rules we'll apply to mark a cell live.

    \ Is the current cell dead?
    col @ row @ curr@ 0=
    if
        \ Any dead cell with three live neighbours becomes a live cell.
   3 =
    else
   \ Any live cell with two or three live neighbours survives.
        dup 2 >= swap 3 <= and
    then
    1 and
    col @ row @ next! ;

: calcRow ( row -- )
    ['] calcCell colForEach ;

: calcGen ( -- )
    ['] calcRow rowForEach
    moveCurr ;

: life ( -- )
    page
    begin calcGen 0 0 at-xy .curr key? until ;

\ Test cases taken from Rosetta code's implementation
: blinker s" |***" >curr ;
: toad s" ***| ***" >curr ;
: pentomino s" **| **| *" >curr ;
: pi s" **| **|**" >curr ;
: glider s"  *|  *|***" >curr ;
: pulsar s" *****|*   *" >curr ;
: ship s"  ****|*   *|    *|   *" >curr ;
: pentadecathalon s" **********" >curr ;
: clock s"  *|  **|**|  *" >curr ;
Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  Page 5 of 6
  [ 85 posts ]  Go to page Previous  1, 2, 3, 4, 5, 6  Next

Board index » 6502.org Users Forum » Forth

All times are UTC


Who is online

Users browsing this forum: No registered users and 8 guests

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to:  
6502.org is an ongoing project by Mike Naberezny and contributors.