Oforth examples. Feel free to post your own code.

Below is a simple ll-node class, which is all that is needed to create linked lists. Probably of more interest is the merge-sort code. I took the algorithm from Albert van der Horst's very nice code posted on comp.lang.forth and adapted it for Oforth. The adaptation was easy. Doing a #bench it took only 0.055 seconds to sort 50,000 random integers. Impressive! My only regret is that the algorithm, or it's pseudocode, is not well documented/described. For example the stack effect diagrams are missing for most of the words.

Thanks once again to Franck for providing useful suggestions that improved the sort speeds by up to a factor of three!

-Doug

Code: Select all
`\ *** begin linked-list codeObject Class new: ll-node ( mutable link, mutable data )  m: initialize \ data --     := data 0 := link  ;  m: <<  @link << printcr @data << ;     m: getData \ -- data      @data ;  m: getLink \ -- link      @link ;  m: putLink \ link --      := link ;  m: size \ -- cnt     self     1 while ( swap getLink dup ) [ swap 1+ ] drop ;  : link \ node n -- node  ll-node new tuck putLink ;\ *** end linked-list code\ *** begin merge-sort code based on Albert van der Horst's\     post on c.l.f. 3/11/2018\ list : sorted   ulist : unsorted   listp : list level\ For EL1 and EL2, return EL1 and EL2 plus "el1 IS lower".: ll< ( t ) 2dup getData swap getData t execute ;\ For LIST1 ( > ) LIST2 return LIST1 (>) LIST2' advanced : find-end ( t )  | r |   while ( dup -> r getLink  dup if t ll< 0 = else 0 then ) [  ]   drop r ;\ Merge LIST1 ( > ) LIST2.: do-merge ( t )   | r s |   begin t find-end   dup -> r dup getLink -> s putLink    s r   over 0 =    until 2drop ;\ Merge LIST1 and LIST2, leave merged LIST.: merge ( t )  | r | t ll< if swap then dup -> r t do-merge r ;\ Cut ULIST in two. Return LIST and remaining ULIST.: snip ( t )   | r | dup      while ( dup getLink dup if t ll< else 0 then ) [ nip ]   -> r 0 swap putLink r ;\ Keep on merging as long as two listp 's have the same level.: try-merges ( t )  | r | while ( -> r over r = ) [ nip t merge r 1+ ] r ;\ Expand zero, ulist into zero list, level .... list, level: expand ( t )  | r | while ( t snip -> r 1 t try-merges r dup ) [ ] drop ;\ Keep on merging list-level pairs until end-sentinel.: shrink ( t ) drop while ( over ) [ nip t merge ] ;\ For linked LIST compare XT, leave a sorted LIST1.: merge-sort ( t ) 0 swap t expand t shrink nip ;\ ---------------------------------------\ The stack diagram of merge-sort is ( list1 comparison-XT -- list2 )\ *** end merge-sort codetvar: list: build-linkedlist \  node size -- node \ build with integers  | i | 1- loop: i [ 10000 rand link ] ;1 ll-node new 50000 build-linkedlist to list#[ list #[ swap <= not ] merge-sort to list ] bench\ [1] (Integer) 54792  \ = 0.055 seconds for 50000 random integers: build-linkedlistf \  node size -- node  \ with floats and ints  | i | 2 / loop: i [ 100000 rand >float 30 rand / link  10000 rand link ] ;3.4 ll-node new 50000 build-linkedlistf to list#[ list #[ swap <= not ] merge-sort to list ] bench\ [1] (Integer) 171330 \ = 0.171 seconds for 50000 random floats and integers: one-char \ ( -- c ) \ alpha  | c |  begin   'z' rand -> c   'A' 'Z' c between   'a' 'z' c between or  until c ;: make-string \ random str of 1 to 10 chars, chars = a-z,A-Z  | s i |  String new -> s  10 rand loop: i [ one-char s add ] s ;: build-linkedlistS \  node size -- node  \ build with strings  | i | 1- loop: i [ make-string link ] ;"Hello" ll-node new 50000 build-linkedlistS to list#[ list #[ swap <= not ] merge-sort to list ] bench\ [1] (Integer) 83933  \  = 0.084 seconds for 50000 random strings`
Last edited by Doug on 07 Jan 2019 13:31, edited 4 times in total.
Doug

Posts: 27
Joined: 20 Jul 2018 14:26

Hello Doug,

Sorry for the late answer, I'am on holiday without many ways to connect.

I wish you a happy new year.

Thank you for this post. Linked list are very usefull and I will probably add them one day to the "collect package".
They are so usefull that they could eventually be into the built-in words as they are used internaly by the dictionary.

1) If you are aiming for speed and bench, you should not use a stack (to simulate R@, R>, ...) but only rely on local variables.
There should be a notable difference (even is not huge).

2) Also, you should not initialize the links attributes to 0 : just leave them to null value and test according this value ( ifNull: [ ... ] )

3) Tests according to <= are quicker than tests according to >, >=, < (the latter are written using the former).

4) And last thing (but this is my own way of programming, if you are not comfortable with, don't you it) :
I would not use a "*>m variabe, but parameters (and this should increase speed I think).

For instance :

: merge-sort-with( ... m -- ... )
... ;

: merge-sort
#<= merge-sort-with ;

Regards,
Franck
Franck

Posts: 171
Joined: 29 Oct 2014 19:01

Hello Franck,

Happy new year to you too.

It was not difficult to apply 1), 3), and 4). Together these changes improved the sort times by up to a factor of three!

I have not yet been successful in converting the link initialization to null. This is because the stack effect diagrams and pseudocode for the sort algorithm are not documented. This is sloppy IMO, but it is also the programming style of the original Forth author (not me). I will say that I believe the speed of the sort is excellent and likely the fastest that can be achieved, which speaks well for the algorithm used.

-Doug
Doug

Posts: 27
Joined: 20 Jul 2018 14:26