Forth-eV Wiki

Benutzer-Werkzeuge

Webseiten-Werkzeuge

Sie befinden sich hier: Forth Wiki » papierkorb » sort_algorithm_in_forth
Zuletzt angesehen:
papierkorb:sort_algorithm_in_forth

Unterschiede

Hier werden die Unterschiede zwischen zwei Versionen angezeigt.

Link zu dieser Vergleichsansicht

papierkorb:sort_algorithm_in_forth [2025-08-10 21:03] – ↷ Seite von projects:sort_algorithm_in_forth nach papierkorb:sort_algorithm_in_forth verschoben mkapapierkorb:sort_algorithm_in_forth [2026-08-20 15:40] (aktuell) – gelöscht - Externe Bearbeitung (Unbekanntes Datum) 127.0.0.1
Zeile 1: Zeile 1:
-<code> 
-SCR # 21 
-  0 ( 16 bit Numerical Sort Demo                      20AUG82MIM)    
-  1 
-  2 FORTH DEFINITIONS  HEX 
-  3 7000 CONSTANT ARRAY1      ( address of data array) 
-  4 VARIABLE #ELEMENTS     ( number of 16 bit elements) 
-  5 VARIABLE DISTANCE      ( distance between elements)     
-  6 VARIABLE VI            ( temporary indexes for nested DO's) 
-  7 VARIABLE VJ 
-  8 VARIABLE SEED   HERE SEED ! 
-  9 
- 10 : RND           ( random # generator)   ( n --- ) 
- 11    SEED @ 103 * 3 + 7FFF AND 
- 12      DUP SEED !  7FFF */ ; 
- 13 : CLRS PAGE CR CR 17 SPACES ." FORTH SORTING DEMO" CR ; 
- 14 : KEYMSG  ." any key continues.." CR KEY DROP ; 
- 15 
  
- 
- 
- 
-SCR # 22 
-  0 ( 16 bit Numerical Sort Demo                      20AUG82MIM) 
-  1                                                    
-  2 : RANDOM                  ( create random pattern in ARRAY1) 
-  3    #ELEMENTS @ 2* 0      ( set loop limit and initial index) 
-  4       DO 3E8 RND         ( fetch random # between 0 and 999) 
-  5          I 3 MOD 0= IF NEGATE      ( negate 1 out of three) 
-  6       THEN I ARRAY1 + !               ( store in array) 
-  7          2 +LOOP ;                    ( increment loop) 
-  8 
-  9 : REVERSE               ( create reversed pattern in ARRAY1) 
- 10    #ELEMENTS @ 0         ( set loop limit and initial index) 
- 11       DO #ELEMENTS @ I -               ( compute value) 
- 12          I 2* ARRAY1 + !              ( store in array) 
- 13       LOOP ;                          ( decrement loop) 
- 14 
- 15 
- 
- 
- 
- 
- 
-SCR # 23 
-  0 ( 16 bit Numerical Sort Demo                      20AUG82MIM) 
-  1 
-  2 : NUM(I) @ ARRAY1 + ;            ( array fetch) 
-  3 : NUMI@ NUM(I) @ ;               ( and store) 
-  4 : NUMI! NUM(I) ! ;               ( operators) 
-  5 
-  6 : COMPARE VI NUMI@ VJ NUMI@ > ;     ( true if #I > #J) 
-  7 
-  8 : NUMSWAP          ( swap elements of array)   ( --- ) 
-  9    VI NUMI@ VJ NUMI@ VI NUMI! VJ NUMI! ; 
- 10 
- 11 : NUMLIST             ( output number array)   ( --- ) 
- 12    #ELEMENTS @ 2* 0 DO I DUP 
- 13       1A MOD 0= IF CR THEN ARRAY1 + @ 
- 14          6 .R 2 +LOOP CR CR ; 
- 15 
- 
- 
- 
- 
-SCR # 24 
-  0 ( 16 bit Numerical Sort Demo                      20AUG82MIM) 
-  1 
-  2 : BUBBLESORT              ( sort data array)   ( --- ) 
-  3    #ELEMENTS @ 1- 2* 0 DO I VI ! 
-  4       #ELEMENTS @ 2* I 2+ DO I VJ ! 
-  5          COMPARE IF NUMSWAP 
-  6       THEN 2 +LOOP 2 +LOOP ; 
-  7 
-  8 : SHUTTLESORT             ( sort data array)   ( --- ) 
-  9    #ELEMENTS @ 1- 2* 0 DO 
- 10       -2 I DO I DUP VI ! 2+ VJ ! 
- 11          COMPARE IF NUMSWAP ELSE LEAVE 
- 12       THEN -2 +LOOP 2 +LOOP ; 
- 13 
- 14 ( For decending sorts change > in COMPARE to <) 
- 15 
- 
- 
- 
- 
- 
-SCR #25 
-  0 ( 16 bit Numerical Sort demo                      20AUG82MIM) 
-  1 
-  2 : SETDIST              ( set initial distance)    ( --- ) 
-  3    1 BEGIN 2* DUP #ELEMENTS @ > 
-  4        UNTIL 2- DISTANCE ! ; 
-  5 
-  6 : DECDIST             ( decrement distance)   ( --- flag) 
-  7     DISTANCE @ 2/ 2/ 2* DUP DISTANCE ! 2 < ; 
-  8 
-  9     ( Shell-Metzner sort) 
- 10 : SHELLSORT  SETDIST BEGIN    ( sort data array)  ( --- ) 
- 11    #ELEMENTS @ 2* DISTANCE @ - 0 DO -2 I DO 
- 12       I DUP VI ! DISTANCE @ + VJ ! COMPARE IF 
- 13          NUMSWAP ELSE LEAVE THEN DISTANCE @ NEGATE 
- 14             +LOOP 2 +LOOP DECDIST UNTIL ; 
- 15 
- 
- 
- 
- 
-SCR # 26 
-  0 ( 16 bit Numerical Sort Demo                      20AUG82MIM) 
-  1    ( benchmark it) 
-  2 : #ELEMENTS?  CR ." How many elements?  " QUERY CR CR 
-  3    INTERPRET #ELEMENTS ! ." random array" RANDOM NUMLIST ; 
-  4 : REVIT  CR ." reversed array" REVERSE NUMLIST ; 
-  5 
-  6 : BUBBS  #ELEMENTS? ." random bubblesort.." CR BEEP 
-  7    BUBBLESORT BEEP NUMLIST KEYMSG ." sorting sorted array.." 
-  8    CR BEEP BUBBLESORT BEEP KEYMSG REVIT 
-  9    ." reverse bubblesort.." CR BEEP BUBBLESORT BEEP 
- 10    NUMLIST KEYMSG ; 
- 11 : SHUTS  #ELEMENTS? ." random shuttlesort.." CR BEEP 
- 12    SHUTTLESORT BEEP NUMLIST KEYMSG ." sorting sorted array.." 
- 13    CR BEEP SHUTTLESORT BEEP KEYMSG REVIT 
- 14    ." reverse shuttlesort.." CR BEEP SHUTTLESORT BEEP 
- 15    NUMLIST KEYMSG ; 
- 
- 
- 
- 
- 
-SCR # 27 
-  0 ( 16 bit Numerical Sort Demo                      20AUG82MIM) 
-  1 
-  2 : SHELS  #ELEMENTS? ." random shellsort.." CR BEEP 
-  3    SHELLSORT BEEP NUMLIST KEYMSG ." sorting sorted array.." 
-  4    CR BEEP SHELLSORT BEEP KEYMSG REVIT 
-  5    ." reverse shellsort.." BEEP SHELLSORT BEEP 
-  6    NUMLIST KEYMSG ; 
-  7 : DECODE  DUP 31 = IF BUBBS ELSE DUP 32 = IF SHUTS ELSE 
-  8    DUP 33 = IF SHELS ELSE 34 = IF QUIT THEN THEN THEN THEN ; 
-  9 : MENU  CR CR ." Specify sort algorithm:" CR 
- 10    ." 1 - Bubblesort" CR ." 2 - Shuttlesort" CR 
- 11       ." 3 - Shellsort" CR ." 4 - Exit demo " BEGIN 
- 12    KEY DUP 30 > OVER 35 < AND NOT WHILE DROP REPEAT ; 
- 13 
- 14 : DEMO  BEGIN CLRS MENU DUP DECODE AGAIN ; 
- 15         DECIMAL  
-</code>