Page 1 of 1

Posted: 22 Dec 2018 15:54
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`

Posted: 02 Jan 2019 07:24
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