CS-101 problems and their FORTH solutions.
Re: CS-101 problems and their FORTH solutions.
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.
Re: CS-101 problems and their FORTH solutions.
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: Select all
\ 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 ;
Re: CS-101 problems and their FORTH solutions.
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.
What about the bidirectional Fibonacci sequence?
Code: Select all
... -21 13 -8 5 -3 2 -1 1 0 1 1 2 3 5 8 13 21 ...
Last edited by JimBoyd on Tue Jul 02, 2019 8:06 pm, edited 1 time in total.
-
commodorejohn
- Posts: 299
- Joined: 21 Jan 2016
- Location: Placerville, CA
- Contact:
Re: CS-101 problems and their FORTH solutions.
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.
Re: CS-101 problems and their FORTH solutions.
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?
This is my source code:
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: Select all
-------------------------------------------------------------------------------
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 ---
..!.. .,'.~ ,.!.' .,.!....~~',.!.,.,.,.....^..~...,,...,...,'.
,.~,' ..,!. .:'... .'.'.'.^.',^..,.!.,.,....,.,',..,....^.',,,.'
,.'.. ~,'.. ~.,.', ,.........''',.,...~!.'.'..~...,,.''~.,.'!,..,
.^.,: ^..'. ''~;'. ,,.!., ~,''..'...''.'.'....,'...~!.,,,....'.,,,
,^,.. ,'.., ,,',.. '~.~.. .'''...,'.,'.!,'....,.~.,...''..^.',,..!
.'..' ...,~ '...'. '.,,!, ,......,..~...'^.,'.~,
!... ..!., ..,,., ,.'...
.!. .,... ~.,.,~ ....,^ ~
,. ...^^ .~',.! ..,.,. ~'
, ,...' ,.,~~' ',.~.. ,..
,,,., ...!~. .!,.,~ ..,.~...'..,..,,,.~'',.'.'.'.:...^..,,~.''..
..,.. .,,'.. ,~..., .....~~..,.',',,..,...,~.,,'...';'...~',.,'..
'.... ..,,,, ',~..' ',,.,,..,,........,.''.,,'..,...,,~.!,.,,...'.
,.'~, '.'.,' .,~~.. ,.''., !.,~.,~.'^....~,.,,,.,.'.,.,,...',,.',.!
,.!.. '...'' ,!...! ...... .............'....,.!.,.:.,.~.~.~,,.!^.,
.,.,. ''.,.. '',... .',.,. ,.',.:.,.',~~,.'.,,!..'.,.,.,,,'.
.,~' ...,., ,.,,., .,.'..
'.. ,.,,.. ..!.^. .,.,', .
'. ,'.,,. .:.~,~ .;'.,, '.
. .~,... ...... '~..., ''.
'.~'., ''.~.~ ...''. '..,..',,...!.....~....,....,~~.:,.''.',,...
,,.,'. .',..~ .,..., .'..,,,...,,'.',.';.,!.,'!...~''.!'....,'.,,,
'..,.. ''..,. ,'.,^~ ''[.,....,.'.,~,,.',.~,.~','.'.'~....'',,.,...
.,.... ,,,... ,.,,'. :..:.. .'...',,./'...,...',,.,.'..~~~',',..'.,.
,.~..' .',,'. ^,,'.. :''~'^ ~.,,'...,...!'.~'~...',,...'..!',.,',...
,.,.~, ~^..'! ....., ....., ..,',,,..,''!,.,,,....,.,..^..'..,...,
.,,,, ',,... ,..... ,...~.
.',. ,.,.'. ..'',. ..,.~. ,
~.^ ,.~,,, ,~'... '..... ..
'. .',,~, .~'''. .,.',. ...
....', ,:..., ,,.'.' ,.'',.,,''..,.,,.!,.,^.,..~,^.~,.':,...:..,.
.!.,,. .,~.,. .!'.~, ~..,..'...!...'..,,,.',,....~'....,,.~,!.,,.,
,.~.,' ..^'.. ,,..., ..:',,.,...,...,.,.',.,'.'.:...'..'.',...~~,,.
....
Re: CS-101 problems and their FORTH solutions.
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.
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.
-
commodorejohn
- Posts: 299
- Joined: 21 Jan 2016
- Location: Placerville, CA
- Contact:
Re: CS-101 problems and their FORTH solutions.
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.
Re: CS-101 problems and their FORTH solutions.
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: Select all
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:
This version limits the recursion based on the depth of recursion:
Code: Select all
: 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: Select all
64 4 CCURVE
This draws the Koch snowflake:
Code: Select all
: 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:
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.
Re: CS-101 problems and their FORTH solutions.
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: Select all
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.
Re: CS-101 problems and their FORTH solutions.
@Jim, thanks for the C curve and snowflake code. Interesting and easy with turtle graphics.
Re: CS-101 problems and their FORTH solutions.
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.
Re: CS-101 problems and their FORTH solutions.
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:
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: Select all
\ 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 ;