Sorting algorithms/Gnome sort: Difference between revisions
m
→{{header|Wren}}: Minor tidy
(Grouping BASIC dialects) |
m (→{{header|Wren}}: Minor tidy) |
||
| (5 intermediate revisions by 3 users not shown) | |||
Line 446:
{{works with|ALGOL 68G|Any - tested with release mk15-0.8b.fc9.i386}}
{{works with|ELLA ALGOL 68|Any (with appropriate job cards
<syntaxhighlight lang="algol68">MODE SORTSTRUCT = INT;
Line 793:
=={{header|BASIC}}==
==={{header|BASIC256}}===
<syntaxhighlight lang="basic">arraybase 1
global array
dim array(15)
a = array[?,]
b = array[?]
for i = a to b
array[i] = int(rand * 100)
next i
print "unsort ";
for i = a to b
print rjust(array[i], 4);
next i
call gnomeSort(array)
print chr(10); " sort ";
for i = a to b
print rjust(array[i], 4);
next i
end
subroutine gnomeSort (array)
i = array[?,] + 1
j = i + 1
while i <= array[?]
if array[i - 1] <= array[i] then
i = j
j += 1
else
temp = array[i - 1]
array[i - 1] = array[i]
array[i] = temp
i -= 1
if i = array[?,] then
i = j
j += 1
end if
end if
end while
end subroutine</syntaxhighlight>
==={{header|BBC BASIC}}===
<syntaxhighlight lang="bbcbasic">DEF PROC_GnomeSort1(Size%)
Line 811 ⟶ 854:
UNTIL I%>Size%
ENDPROC</syntaxhighlight>
==={{header|Chipmunk Basic}}===
{{works with|Chipmunk Basic|3.6.4}}
{{works with|QBasic}}
{{trans|IS-BASIC}}
<syntaxhighlight lang="qbasic">100 RANDOMIZE TIMER
110 DIM array(18)
120 ' Init Array
130 FOR i = 0 TO UBOUND(array)
140 array(i) = INT(RND(1)*98)+1
150 NEXT i
160 PRINT "unsort: "; : GOSUB 200
170 GOSUB 260 : ' gnomeSort
180 PRINT " sort: "; : GOSUB 200
190 END
200 ' Write Array
210 FOR i = 0 TO UBOUND(array)
220 PRINT array(i);
230 NEXT i
240 PRINT
250 RETURN
260 ' gnomeSort
270 i = 1
280 j = i+1
290 WHILE i <= UBOUND(array)
300 IF array(i-1) <= array(i) THEN
310 i = j : j = j+1
320 ELSE
330 t = array(i-1) : array(i-1) = array(i) : array(i) = t : ' swap
340 i = i-1
350 IF i = 0 THEN i = j : j = j+1
360 ENDIF
370 WEND
380 RETURN</syntaxhighlight>
==={{header|FreeBASIC}}===
Line 913 ⟶ 990:
<pre>To sort: - 249, 28, 111, 36, 171, 98, 29, 448, 44, 147, 154, 46, 102, 183, 24
Sorted: - 24, 28, 29, 36, 44, 46, 98, 102, 111, 147, 154, 171, 183, 249, 448</pre>
==={{header|GW-BASIC}}===
{{works with|PC-BASIC|any}}
{{works with|BASICA}}
{{works with|Chipmunk Basic}}
{{works with|QBasic}}
{{works with|Just BASIC}}
<syntaxhighlight lang="qbasic">100 REM GnomeSrt.bas
110 RANDOMIZE TIMER 'remove it for Just BASIC
120 DIM ARRAY(18)
130 ' Init Array
140 FOR I = 0 TO 18
150 LET ARRAY(I) = INT(RND(1)*98)+1
160 NEXT I
170 PRINT "unsort: "; : GOSUB 210
180 GOSUB 270 : REM gnomeSort
190 PRINT " sort: "; : GOSUB 210
200 END
210 ' Write Array
220 FOR I = 0 TO 18
230 PRINT ARRAY(I);
240 NEXT I
250 PRINT
260 RETURN
270 ' gnomeSort
280 LET I = 1
290 LET J = I+1
300 WHILE I <= 18
310 IF ARRAY(I-1) <= ARRAY(I) THEN LET I = J : LET J = J+1 : GOTO 330
320 IF ARRAY(I-1) > ARRAY(I) THEN LET T = ARRAY(I-1) : LET ARRAY(I-1) = ARRAY(I) : LET ARRAY(I) = T : LET I = I-1 : IF I = 0 THEN LET I = J : LET J = J+1
330 WEND
340 RETURN</syntaxhighlight>
==={{header|IS-BASIC}}===
Line 946 ⟶ 1,055:
380 LOOP
390 END DEF</syntaxhighlight>
==={{header|MSX Basic}}===
{{works with|MSX BASIC|any}}
{{works with|Chipmunk Basic}}
{{works with|GW-BASIC}}
{{works with|QBasic}}
{{trans|GW-BASIC}}
<syntaxhighlight lang="qbasic">100 CLS
110 U = 8
120 DIM A(U+1)
130 FOR I = 0 TO U
140 A(I) = INT(RND(1)*98)
150 NEXT I
160 PRINT "unsort: "; : GOSUB 200
170 GOSUB 260 : REM gnomeSort
180 PRINT " sort: "; : GOSUB 200
190 END
200 REM Write Array
210 FOR I = 0 TO U
220 PRINT A(I);
230 NEXT I
240 PRINT
250 RETURN
260 REM gnomeSort
270 I = 1
280 J = I+1
290 IF I <= U THEN IF A(I-1) <= A(I) THEN I = J : J = J+1 : GOTO 290
300 IF I > U THEN RETURN
310 IF A(I-1) > A(I) THEN T = A(I-1) : A(I-1) = A(I) : A(I) = T : I = I-1 : IF I = 0 THEN I = J : J = J+1
320 GOTO 290</syntaxhighlight>
==={{header|Minimal BASIC}}===
<syntaxhighlight lang="qbasic">10 REM Rosetta Code problem: https://rosettacode.org/wiki/Sorting_algorithms/Gnome_sort
20 REM by Jjuanhdez, 10/2023
100 RANDOMIZE
110 LET U = 8
120 DIM A(9)
130 FOR I = 0 TO U
140 LET A(I) = INT(RND*98)
150 NEXT I
160 PRINT "UNSORT: ";
170 GOSUB 220
180 GOSUB 280
190 PRINT " SORT: ";
200 GOSUB 220
210 STOP
220 REM WRITE ARRAY
230 FOR I = 0 TO U
240 PRINT A(I);
250 NEXT I
260 PRINT
270 RETURN
280 REM GNOMESORT
290 LET I = 1
300 LET J = I+1
310 IF I <= U THEN 350
320 IF I > U THEN 190
330 IF A(I-1) > A(I) THEN 400
340 GOTO 310
350 IF A(I-1) <= A(I) THEN 370
360 GOTO 320
370 LET I = J
380 LET J = J+1
390 GOTO 310
400 LET T = A(I-1)
410 LET A(I-1) = A(I)
420 LET A(I) = T
430 LET I = I-1
440 IF I = 0 THEN 460
450 GOTO 310
460 LET I = J
470 LET J = J+1
480 GOTO 310
490 END</syntaxhighlight>
{{out}}
<pre>UNSORT: 9 86 63 25 19 57 3 39 75
SORT: 3 9 19 25 39 57 63 75 86</pre>
==={{header|PowerBASIC}}===
Line 1,009 ⟶ 1,195:
Wend
EndProcedure</syntaxhighlight>
==={{header|QBasic}}===
{{trans|IS-BASIC}}
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
{{works with|VB-DOS|1.0}}
{{works with|QB64|1.1}}
{{works with|PDS|7.1}}
{{works with|True BASIC}}
<syntaxhighlight lang="qbasic">RANDOMIZE TIMER 'RANDOMIZE for True BASIC
DIM array(-5 TO 12)
CALL iniciarray(array())
PRINT "unsort: ";
CALL escritura(array())
CALL gnomeSort(array())
PRINT
PRINT " sort: ";
CALL escritura(array())
END
SUB escritura (array())
FOR i = LBOUND(array) TO UBOUND(array)
PRINT array(i);
NEXT i
PRINT
END SUB
SUB gnomeSort (array())
LET i = LBOUND(array) + 1
LET j = i + 1
DO WHILE i <= UBOUND(array)
IF array(i - 1) <= array(i) THEN
LET i = j
LET j = j + 1
ELSE
LET T = array(i - 1)
LET array(i - 1) = array(i)
LET array(i) = T
LET i = i - 1
IF i = LBOUND(array) THEN
LET i = j
LET j = j + 1
END IF
END IF
LOOP
END SUB
SUB iniciarray (array())
FOR i = LBOUND(array) TO UBOUND(array)
LET array(i) = (RND * 98) + 1
NEXT i
END SUB</syntaxhighlight>
==={{header|QuickBasic}}===
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
{{trans|C}}
Line 1,032 ⟶ 1,271:
end if
wend</syntaxhighlight>
==={{header|Quite BASIC}}===
{{trans|Minimal BASIC}}
<syntaxhighlight lang="qbasic">100 CLS
110 LET U = 8
120 ARRAY A
130 FOR I = 0 TO U
140 LET A(I) = INT(RAND(1)*98)
150 NEXT I
160 PRINT "UNSORT: ";
170 GOSUB 220
180 GOSUB 280
190 PRINT " SORT: ";
200 GOSUB 220
210 STOP
220 REM WRITE ARRAY
230 FOR I = 0 TO U
240 PRINT A(I); " ";
250 NEXT I
260 PRINT
270 RETURN
280 REM GNOMESORT
290 LET I = 1
300 LET J = I+1
310 IF I <= U THEN 350
320 IF I > U THEN 190
330 IF A(I-1) > A(I) THEN 400
340 GOTO 310
350 IF A(I-1) <= A(I) THEN 370
360 GOTO 320
370 LET I = J
380 LET J = J+1
390 GOTO 310
400 LET T = A(I-1)
410 LET A(I-1) = A(I)
420 LET A(I) = T
430 LET I = I-1
440 IF I = 0 THEN 460
450 GOTO 310
460 LET I = J
470 LET J = J+1
480 GOTO 310
490 END</syntaxhighlight>
{{out}}
<pre>Same as Minimal BASIC entry.</pre>
==={{header|Run BASIC}}===
{{works with|Just BASIC}}
{{works with|Liberty BASIC}}
<syntaxhighlight lang="vb"> dim A(18)
[initArray]
for i = 0 to 18
A(i) = int(rnd(1)*98)+1
next i
print "unsort: ";
gosub [writeArray]
gosub [gnomeSort]
print " sort: ";
gosub [writeArray]
end
[writeArray]
for i = 0 to 18
print A(i); " ";
next i
print
return
[gnomeSort]
i = 1
j = i+1
while i <= 18
if A(i-1) <= A(i) then
i = j
j = j+1
else
t = A(i-1) : A(i-1) = A(i) : A(i) = t
i = i-1
if i = 0 then i = j : j = j+1
end if
wend
return</syntaxhighlight>
==={{header|TI-83 BASIC}}===
Line 1,065 ⟶ 1,386:
==={{header|True BASIC}}===
{{trans|IS-BASIC}}
{{works with|QBasic}}
<syntaxhighlight lang="qbasic">RANDOMIZE !RAMDOMIZE TIMER en QBASIC
DIM array(-5 TO 12)
Line 1,191 ⟶ 1,513:
End Sub</syntaxhighlight>{{out}}
<pre>1, 1, 1, 3, 4, 5, 7, 20</pre>
==={{header|Yabasic}}===
<syntaxhighlight lang="vb">dim array(15)
a = 0
b = arraysize(array(),1)
print "unsort: ";
for i = a to b
array(i) = int(ran(98))+1
print array(i), " ";
next i
print "\n sort: ";
gnomeSort(array())
for i = a to b
print array(i), " ";
next i
print "\n"
end
sub gnomeSort(array())
local ub, ul, i, j, temp
lb = 0 : ub = arraysize(array(),1)
i = lb +1 : j = lb +2
while i <= ub
// replace "<=" with ">=" for downwards sort
if array(i -1) <= array(i) then
i = j
j = j + 1
else
temp = array(i -1)
array(i -1) = array(i)
array(i) = temp
i = i - 1
if i = lb then
i = j
j = j + 1
fi
fi
wend
end sub</syntaxhighlight>
=={{header|Batch File}}==
Line 1,638 ⟶ 2,004:
print data[]
</syntaxhighlight>
=={{header|EDSAC order code}}==
This code conforms to the original description of gnome sort, in which it's assumed that the gnome can't remember anything and has to move one step at a time (cf. the alternative name "stupid sort"). As pointed out on the Discussion page, the RC task description introduces an optimization that credits the gnome with a memory. The sample array is copied from the Scheme solution.
<syntaxhighlight lang="edsac">
[Gnome sort - Rosetta Code
EDSAC program (Initial Orders 2) to read and sort an array
of 17-bit integers, using gnome sort.
Values are read from tape, preceded by an integer count.]
[Arrange the storage]
T45K P100F [H parameter: library subroutine R4 to read integer]
T46K P200F [N parameter: modified library s/r P7 to print integer]
T47K P300F [M parameter: main routine]
T51K P500F [G parameter: subroutine for gnome sort]
T55K P700F [V parameter: storage for values]
[Library subroutine M3, runs at load time and is then overwritten.
Prints header; here, last character sets teleprinter to figures.]
PF GK IF AF RD LF UF OF E@ A6F G@ E8F EZ PF
*BEFORE!AND!AFTER@&#..PZ
[======== G parameter: Subroutine to sort an array by gnome sort ========]
[Input: 0F = A order for array{0}
1F = length of array, in address field
Output: Array is sorted]
[This code conforms to the original description of gnome sort, in which it's
assumed that the gnome can't remember anything and has to move one step
at a time (cf. the alternative name "stupid sort").
The gnome's position is defined by an A order which refers to that position,
and which is indicated below by an arrow.
The code could easily be modified to use 35-bit integers.]
E25K TG GK
A3F T41@ [plant return link as usual]
AF U21@ [initialize gnome's position to start of array]
A1F T44@ [store A order for exclusive end of array]
[Here the gnome moves one step forward]
[6] T45@ [clear acc]
A21@ A2F T21@ [inc address in the defining A order]
[Loop. Assume here with acc = 0.]
[The gnome considers his position]
[10] A21@ [acc := A order for position]
S44@ [is he at the end?]
E41@ [if so, jump to exit with acc = 0]
T45@ [clear acc]
AF [load A order for start]
S21@ [is he at the start?]
E6@ [if so, jump to move 1 step forward]
[Gnome isn't at start or end, so he has to compare values]
T45@ [clear acc]
A21@ [load A order for gnome's psotion]
A42@ [convert to S order for previous position]
T22@ [plant S order]
[21] AF [<============ this planted A order defines the gnome's position]
[22] SF [(planted) acc := (current value) - (previous value)]
E6@ [if current >= previous then jump to move 1 step forward]
[Here the gnome must swap the values and move 1 step backward]
T45@ [clear acc]
A21@ U34@ [plant copy of defining A order]
S2F U36@ [plant A order for gnome's new position]
U21@ [also update defining A order]
A43@ U39@ [plant T order for new position]
A2F T37@ [plant T order for old position]
[34] AF [(planted) acc := array{i}]
T45@ [copy array{i} to temp store]
[36] AF [(planted) acc := array{i-1}]
[37] TF [(planted) copy to array{i}]
A45@ [acc := old array{i}]
[39] TF [(planted) copy to array{i-1}]
E10@ [loop back (always, since acc = 0)]
[41] ZF [(planted) jump back to caller]
[42] K4095F [add to A order to make S order with adderss 1 less]
[43] OF [add to A order to make T order with same address]
[44] AV [A order for exclusive end of array]
[45] PF [(1) dump to clear accumulator (2) temporary for swapping]
[====================== M parameter: Main routine ======================]
E25K TM GK
[0] PF [data count]
[1] PF [negative loop counter]
[2] TV [order to store acc in array{0}]
[3] AV [order to load acc from array{0}]
[4] AV [A order for end of array
[5] !F [space]
[6] @F [carriage return]
[7] &F [linefeed]
[Entry]
[8] A2@ T21@ [initialize order to store value]
A10@ GH [call library subroutine R4, sets 0D := data count N]
[One way of looping a given number of times: use a negative counter]
[(Wilkes, Wheeler & Gill, 1951 edition, pp.164-5)]
AF [acc := data count, assumed to fit into 17 bits]
LD T@ [shift count into address field, and store it]
S@ [acc := negative count]
E38@ [exit if count = 0]
[17] T1@ [update negative loop counter]
A18@ GH [call library subroutine R4, 0D := next value]
AF [acc := value. assumed to fit into 17 bits]
[21] TF [store value in array]
A21@ A2F T21@ [increment address in store order]
A1@ A2F [increment negative loop counter]
G17@ [loop back if still < 0]
A28@ G39@ [print values]
A3@ TF [pass A order for array{0} to gnome sort]
A@ T1F [pass count to gnome sort]
A34@ GG [call gnome sort]
A36@ G39@ [print values again]
[38] ZF [halt the machine]
[------ Subroutine of main routine, to print the array -------]
[39] A3F T60@
A3@ U49@ [initialize load order]
[Another way of looping a given number of times: use a variable order]
[as a counter (Wilkes, Wheeler & Gill, 1951 edition, p.166)]
A@ T4@ [make and plant A order for end of array]
E48@ [don't print a space the first time]
[46] O5@ TF [print space, clear acc]
[48] TD [clear whole of 0D including sandwich bit]
[49] AV [(planted) load value from array <------ order used as counter]
TF [to 0F, so 0D = value extended to 35 bits]
A51@ GN [print value]
A49@ A2F U49@ [update load order]
S4@ G46@ [test for done, loop back if not]
O6@ O7@ [print CR, LF]
[60] EF [(planted) jump back to caller woth acc = 0]
[The next 3 lines put the entry address into location 50,
so that it can be accessed via the X parameter (see end of program).]
T50K
P8@
T8Z
[================== H parameter: Library subroutine R4 ==================]
[Input of one signed integer, returned in 0D.
22 locations.]
E25K TH GK
GKA3FT21@T4DH6@E11@P5DJFT6FVDL4FA4DTDI4FA4FS5@G7@S5@G20@SDTDT6FEF
[================== N parameter: Library subroutine P7 ==================]
[Library subroutine P7: print strictly positive integer in 0D.
Patched to print left-justified (no-op instead of order to print space)
35 locations, even address]
E25K TN GK
GKA3FT26@H28#@NDYFLDT4DS27@TFH8@S8@T1FV4DAFG31@SFLDUFOFFFSF
L4FT4DA1FA27@G11@T28#ZPFT27ZP1024FP610D@524D!FXFSFL8FE22@
[==========================================================================]
[On the original EDSAC, the following (without the whitespace and comments)
might have been input on a separate tape.]
E25K TX GK
EZ [define entry point]
PF [acc = 0 on entry]
[Counts and data values to be read by library subroutine R4.
Note that sign comes *after* value.]
16+ 98+36+2+78+5+81+32+90+73+21+94+28+53+25+10+99+
</syntaxhighlight>
{{out}}
<pre>
BEFORE AND AFTER
98 36 2 78 5 81 32 90 73 21 94 28 53 25 10 99
2 5 10 21 25 28 32 36 53 73 78 81 90 94 98 99
</pre>
=={{header|Eiffel}}==
Line 3,133 ⟶ 3,662:
<pre>
0 1 2 3 4 5 6 7 8 9
</pre>
=={{header|PL/M}}==
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
Note that integers in 8080 PL/M are unsigned.
<syntaxhighlight lang="plm">
100H: /* GNOME SORT */
/* IN-PLACE GNOME SORT THE FIRST SIZE ELEMENTS OF THE */
/* ARRAY POINTED TO BY A$PTR */
GNOME$SORT: PROCEDURE( A$PTR, SIZE );
DECLARE ( A$PTR, SIZE ) ADDRESS;
DECLARE A BASED A$PTR ( 0 )ADDRESS;
DECLARE ( I, J ) ADDRESS;
I = 1;
J = 2;
DO WHILE I < SIZE;
IF A( I - 1 ) <= A( I ) THEN DO;
I = J;
J = J + 1;
END;
ELSE DO;
DECLARE SWAP ADDRESS;
SWAP = A( I - 1 );
A( I - 1 ) = A( I );
A( I ) = SWAP;
I = I - 1;
IF I = 0 THEN DO;
I = J;
J = J + 1;
END;
END;
END;
END GNOME$SORT ;
/* CP/M BDOS SYSTEM CALLS AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$STRING( .( 0DH, 0AH, '$' ) ); END;
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
DO; /* TEST GNOME$SORT */
DECLARE N ( 11 )ADDRESS, N$POS BYTE;
N( 0 ) = 4; N( 1 ) = 65; N( 2 ) = 2; N( 3 ) = 31; N( 4 ) = 0;
N( 5 ) = 99; N( 6 ) = 2; N( 7 ) = 8; N( 8 ) = 3; N( 9 ) = 783;
N( 10 ) = 1;
CALL GNOME$SORT( .N, 11 );
DO N$POS = 0 TO 10;
CALL PR$CHAR( ' ' );
CALL PR$NUMBER( N( N$POS ) );
END;
END;
EOF
</syntaxhighlight>
{{out}}
<pre>
0 1 2 2 3 4 8 31 65 99 783
</pre>
Line 3,924 ⟶ 4,523:
=={{header|Wren}}==
<syntaxhighlight lang="
var size = a.count
var i = 1
Line 3,945 ⟶ 4,544:
}
var
for (asc in [true, false]) {
System.print("Sorting in %(asc ? "ascending" : "descending") order:\n")
for (a in
var b = (asc) ? a : a.toList
System.print("Before: %(b)")
| |||