Sorting algorithms/Comb sort: Difference between revisions

Content added Content deleted
(Added solution for Action!)
Line 1,439: Line 1,439:
This version is an academic demonstration that aligns with the algorithm. As is, it is limited to use one static array and sorts in ascending order only.
This version is an academic demonstration that aligns with the algorithm. As is, it is limited to use one static array and sorts in ascending order only.
<lang forth>\ combsort for the Forth Newbie (GForth)
<lang forth>\ combsort for the Forth Newbie (GForth)

HEX
HEX
\ gratuitous variables ( Add clarity but NOT re-entrant)
\ gratuitous variables for clarity
VARIABLE GAP
0 VALUE GAP
VARIABLE SORTED \ flag
VARIABLE SORTED


DECIMAL
DECIMAL
Line 1,449: Line 1,448:


\ allocate a small array of cells
\ allocate a small array of cells
CREATE Q SIZE CELLS ALLOT
CREATE Q SIZE 2+ CELLS ALLOT


\ operator to index into the array
\ operator to index into the array
Line 1,455: Line 1,454:


\ fill array and see array
\ fill array and see array
: INITDATA ( -- ) SIZE 0 DO SIZE I - I ]Q ! LOOP ;
: INITDATA ( -- ) SIZE 0 DO SIZE I - I ]Q ! LOOP ;
: SEEDATA ( -- ) CR SIZE 0 DO I ]Q @ U. LOOP ;

: SEEDATA ( -- ) CR SIZE 0 DO I ]Q @ U. LOOP ;


\ compute a new gap using scaled division
\ divide by 1.35 using Forth's scaling operator
\ factored out for this example. Could be a macro or inline code.
\ found this ratio to be the fastest
: /1.3 ( n -- n' ) 10 13 */ ;
: 1.35/ ( n -- n' ) 100 135 */ ;


: XCHG ( adr1 adr2 n1 n2-- ) OVER @ OVER @ SWAP ROT ! SWAP ! ;
\ factored out for this example. Could be a macro or inline code.
: XCHG ( adr1 adr2 n1 n2-- ) SWAP ROT ! SWAP ! ;


: COMBSORT ( n -- )
: COMBSORT ( n -- )
DUP >R \ copy n to return stack
DUP TO GAP \ set GAP to n
1+ GAP ! \ set GAP to n+1
BEGIN
BEGIN
GAP @ /1.3 GAP ! \ re-compute the gap
GAP 1.35/ TO GAP \ re-compute the gap
SORTED ON
SORTED ON
R@ GAP @ - 0 \ n-gap is loop limit
DUP ( -- n) GAP - 0 \ n-gap is loop limit
DO
DO
I GAP @ + ]Q I ]Q \ compute array addresses
I GAP + ]Q @ I ]Q @ <
OVER @ OVER @ \ fetch the data in each cell
2DUP < \ compare a copy of the data
IF
IF
XCHG \ Exchange the data in the cells
I GAP + ]Q I ]Q XCHG \ Exchange the data in the cells
SORTED OFF \ flag we are not sorted
SORTED OFF \ flag we are not sorted
ELSE
2DROP 2DROP \ remove address and data
THEN
THEN
LOOP
LOOP
SORTED @ GAP @ 0= AND \ test for complete
SORTED @ GAP 0= AND \ test for complete
UNTIL
UNTIL
DROP
R> DROP ; \ remove 'n' from return stack </lang>
;


=={{header|Fortran}}==
=={{header|Fortran}}==