Sorting algorithms/Shell sort: Difference between revisions
Change Javascript header to the right text |
No edit summary |
||
Line 893:
output = -5 2 4 7 8 22
</pre>
=={{header|PHP}}==
<lang php>
function shellSort($arr)
{
$inc = round(count($arr)/2);
while($inc > 0)
{
for($i = $inc; $i < count($arr);$i++){
$temp = $arr[$i];
$j = $i;
while($j >= $inc && $arr[$j-$inc] > $temp)
{
$arr[$j] = $arr[$j - $inc];
$j -= $inc;
}
$arr[$j] = $temp;
}
$inc = round($inc/2.2);
}
return $arr;
}
</lang>
=={{header|PL/I}}==
|
Revision as of 12:24, 8 April 2011
You are encouraged to solve this task according to the task description, using any language you may know.
Sorting Algorithm
This is a sorting algorithm. It may be applied to a set of data in order to sort it.
For comparing various sorts, see compare sorts.
For other sorting algorithms, see sorting algorithms, or:
Heap sort | Merge sort | Patience sort | Quick sort
O(n log2n) sorts
Shell Sort
O(n2) sorts
Bubble sort |
Cocktail sort |
Cocktail sort with shifting bounds |
Comb sort |
Cycle sort |
Gnome sort |
Insertion sort |
Selection sort |
Strand sort
other sorts
Bead sort |
Bogo sort |
Common sorted list |
Composite structures sort |
Custom comparator sort |
Counting sort |
Disjoint sublist sort |
External sort |
Jort sort |
Lexicographical sort |
Natural sorting |
Order by pair comparisons |
Order disjoint list items |
Order two numerical lists |
Object identifier (OID) sort |
Pancake sort |
Quickselect |
Permutation sort |
Radix sort |
Ranking methods |
Remove duplicate elements |
Sleep sort |
Stooge sort |
[Sort letters of a string] |
Three variable sort |
Topological sort |
Tree sort
In this task, the goal is to sort an array of elements using the Shell sort algorithm, a diminishing increment sort. The Shell sort is named after its inventor, Donald Shell, who published the algorithm in 1959. Shellsort is a sequence of interleaved insertion sorts based on an increment sequence. The increment size is reduced after each pass until the increment size is 1. With an increment size of 1, the sort is a basic insertion sort, but by this time the data is guaranteed to be almost sorted, which is insertion sort's "best case". Any sequence will sort the data as long as it ends in 1, but some work better than others. Empirical studies have shown a geometric increment sequence with a ratio of about 2.2 work well in practice. [1] Other good sequences are found at the Online Encyclopedia of Integer Sequences.
ActionScript
<lang ActionScript>function shellSort(data:Array):Array { var inc:uint = data.length/2; while(inc > 0) { for(var i:uint = inc; i< data.length; i++) { var tmp:Object = data[i]; for(var j:uint = i; j >= inc && data[j-inc] > tmp; j -=inc) { data[j] = data[j-inc]; } data[j] = tmp; } inc = Math.round(inc/2.2); } return data; } </lang>
Ada
This is a generic implementation of the shell sort. Ada allows arrays to be indexed by integer or enumeration types starting at any value. This version deals with any kind or value of valid index type. <lang ada>generic
type Element_Type is digits <>; type Index_Type is (<>); type Array_Type is array(Index_Type range <>) of Element_Type;
package Shell_Sort is
procedure Sort(Item : in out Array_Type);
end Shell_Sort;</lang> <lang ada>package body Shell_Sort is
---------- -- Sort -- ----------
procedure Sort (Item : in out Array_Type) is Increment : Natural := Index_Type'Pos(Item'Last) / 2; J : Index_Type; Temp : Element_Type; begin while Increment > 0 loop for I in Index_Type'Val(Increment) .. Item'Last loop J := I; Temp := Item(I); while J > Index_Type'val(Increment) and then Item (Index_Type'Val(Index_Type'Pos(J) - Increment)) > Temp loop Item(J) := Item (Index_Type'Val(Index_Type'Pos(J) - Increment)); J := Index_Type'Val(Index_Type'Pos(J) - Increment); end loop; Item(J) := Temp; end loop; if Increment = 2 then Increment := 1; else Increment := Increment * 5 / 11; end if; end loop; end Sort;
end Shell_Sort;</lang>
ALGOL 68
<lang algol68>MODE TYPE = CHAR;
PROC in place shell sort = (REF[]TYPE seq)REF[]TYPE:(
INT inc := ( UPB seq + LWB seq + 1 ) OVER 2; WHILE inc NE 0 DO FOR index FROM LWB seq TO UPB seq DO INT i := index; TYPE el = seq[i]; WHILE ( i - LWB seq >= inc | seq[i - inc] > el | FALSE ) DO seq[i] := seq[i - inc]; i -:= inc OD; seq[i] := el OD; inc := IF inc = 2 THEN 1 ELSE ENTIER(inc * 5 / 11) FI OD; seq
);
PROC shell sort = ([]TYPE seq)[]TYPE:
in place shell sort(LOC[LWB seq: UPB seq]TYPE:=seq);
[]TYPE char array data = "big fjords vex quick waltz nymph"; print((shell sort(char array data), new line))</lang> Output:
abcdefghiijklmnopqrstuvwxyz
AutoHotkey
ahk forum: discussion <lang AutoHotkey>MsgBox % ShellSort("") MsgBox % ShellSort("xxx") MsgBox % ShellSort("3,2,1") MsgBox % ShellSort("dog,000000,xx,cat,pile,abcde,1,cat,zz,xx,z") MsgBox % ShellSort("12,11,10,9,8,4,5,6,7,3,2,1,10,13,14,15,19,17,18,16,20,10")
ShellSort(var) { ; SORT COMMA SEPARATED LIST
StringSplit a, var, `, ; make array (length = a0) inc := a0 While inc:=round(inc/2.2) ; geometric gap sequence Loop % a0-inc { ; insertion sort: i := A_Index+inc, t := a%i%, j := i, k := j-inc While j > inc && a%k% > t a%j% := a%k%, j := k, k -= inc a%j% := t } Loop % a0 ; construct string from sorted array s .= "," . a%A_Index% Return SubStr(s,2) ; drop leading comma
}</lang>
AWK
<lang awk>{
line[NR] = $0
} END { # sort it with shell sort
increment = int(NR / 2) while ( increment > 0 ) { for(i=increment+1; i <= NR; i++) { j = i temp = line[i] while ( (j >= increment+1) && (line[j-increment] > temp) ) {
line[j] = line[j-increment] j -= increment
} line[j] = temp } if ( increment == 2 ) increment = 1 else increment = int(increment*5/11) } #print it for(i=1; i <= NR; i++) { print line[i] }
}</lang>
BBC BASIC
This is the logical way of doing it:<lang BBCBASIC>Size%=7 Gap% = Size% / 2 WHILE gap% > 0
FOR I% = gap% TO size%-1 J% = I%; Temp% = data%(I%); WHILE J%>=Gap% AND data%(J%-Gap%)>Temp% data%(J%) = data%(J%-Gap%) J%-=Gap% ENDWHILE IF I% <> J% data%(J%) = Temp% NEXT I% IF Gap% = 2 THEN Gap% = 1 ELSE Gap% = Gap% / 2.2 ENDIF
ENDWHILE</lang>
Unfortunately BBC Basic has a limitation in that it cannot short circuit a compound condition. That means that a Shell sort on BBC Basic has to look like this:<lang BBCBASIC>DEF PROC_ShellSort3(Size%) Gap% = Size% / 2 WHILE Gap% > 0
FOR I% = Gap% TO Size% J% = I% Temp% = data%(I%) WHILE FN_loop data%(J%) = data%(J%-Gap%) J%-=Gap% ENDWHILE IF I% <> J% data%(J%) = Temp% NEXT I% Gap% = Gap% / 2.2
ENDWHILE ENDPROC
DEF FN_loop LOCAL loop% loop%=TRUE IF J%<=Gap% THEN
loop%=FALSE
ELSE
IF data%(J%-Gap%)<=Temp% loop%=FALSE
ENDIF =loop%</lang>
BCPL
<lang BCPL>GET "libhdr"
LET shellsort(v, upb) BE { LET m = 1
UNTIL m>upb DO m := m*3 + 1 // Find first suitable value in the // series: 1, 4, 13, 40, 121, 364, ... { m := m/3 FOR i = m+1 TO upb DO { LET vi = v!i LET j = i { LET k = j - m IF k<=0 | v!k < vi BREAK v!j := v!k j := k } REPEAT v!j := vi } } REPEATUNTIL m=1
}
MANIFEST { upb = 10000 }
LET start() = VALOF { LET v = getvec(upb)
try("shell", shellsort, v, upb) writes("*nEnd of test*n") freevec(v) RESULTIS 0
}
AND try(name, sortroutine, v, upb) BE { // delay, referencing the first and last elements of v
FOR i = 1 TO 50000 DO v!upb := v!1 writef("*nSetting %n words of data for %s sort*n", upb, name) FOR i = 1 TO upb DO v!i := randno(10000) writef("Entering %s sort routine*n", name) sortroutine(v, upb) writes("Sorting complete*n") TEST sorted(v, upb) THEN writes("The data is now sorted*n") ELSE writef("### ERROR: %s sort does not work*n", name)
}
AND sorted(v, n) = VALOF { //FOR i = 1 TO n-1 UNLESS v!i<=v!(i+1) RESULTIS FALSE
RESULTIS TRUE
}</lang>
C
<lang c> void shell_sort (int *a, int n) {
int h, i, j, k; for (h = n; h /= 2;) { for (i = h; i < n; i++) { k = a[i]; for (j = i; j >= h && k < a[j - h]; j -= h) { a[j] = a[j - h]; } a[j] = k; } }
}
int main (int ac, char **av) {
int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1}; int n = sizeof a / sizeof a[0]; shell_sort(a, n); return 0;
} </lang>
C#
<lang C sharp|C#> public static class ShellSorter {
public static void Sort<T>(List<T> list) where T : IComparable { int n = list.Count; int[] incs = {1, 3, 7, 21, 48, 112,336, 861, 1968, 4592, 13776,33936, 86961, 198768, 463792, 1391376,3402672, 8382192, 21479367, 49095696, 114556624,343669872, 52913488, 2085837936}; for (int l = incs.Length/incs[0]; l > 0;) { int m = incs[--l]; for (int i = m; i < n; ++i) { int j = i - m; if (list[i].CompareTo(list[j])<0) { T tempItem = list[i]; do { list[j+m] = list[j]; j-=m; } while ((j >= 0) && (tempItem.CompareTo(list[j])<0)); list[j+m] = tempItem; } } } }
} </lang>
COBOL
This excerpt contains just enough of the procedure division to show the workings. See the example for the bubble sort for a more complete program. <lang COBOL> C-PROCESS SECTION.
C-000. DISPLAY "SORT STARTING".
DIVIDE WC-SIZE BY 2 GIVING WC-GAP.
PERFORM E-PROCESS-GAP UNTIL WC-GAP = 0.
DISPLAY "SORT FINISHED".
C-999. EXIT.
E-PROCESS-GAP SECTION. E-000. PERFORM F-SELECTION VARYING WB-IX-1 FROM WC-GAP BY 1 UNTIL WB-IX-1 > WC-SIZE.
DIVIDE WC-GAP BY 2.2 GIVING WC-GAP.
E-999. EXIT.
F-SELECTION SECTION. F-000. SET WB-IX-2 TO WB-IX-1. MOVE WB-ENTRY(WB-IX-1) TO WC-TEMP.
SET WB-IX-3 TO WB-IX-2. SET WB-IX-3 DOWN BY WC-GAP. PERFORM G-PASS UNTIL WB-IX-2 NOT > WC-GAP * The next line logically reads : * or wb-entry(wb-ix-2 - wc-gap) not > wc-temp. OR WB-ENTRY(WB-IX-3) NOT > WC-TEMP.
IF WB-IX-1 NOT = WB-IX-2 MOVE WC-TEMP TO WB-ENTRY(WB-IX-2).
F-999. EXIT.
G-PASS SECTION. * Note that WB-IX-3 is WC-GAP less than WB-IX-2. * Logically this should be : * move wb-entry(wb-ix-2 - wc-gap) to wb-entry(wb-ix-2). * set wb-ix-2 down by wc-gap. * Unfortunately wb-entry(wb-ix-2 - wc-gap) is not legal in C2 cobol G-000. MOVE WB-ENTRY(WB-IX-3) TO WB-ENTRY(WB-IX-2). SET WB-IX-2 DOWN BY WC-GAP. SET WB-IX-3 DOWN BY WC-GAP.
G-999. EXIT.</lang>
Common Lisp
<lang lisp>(defun gap-insertion-sort (array predicate gap)
(let ((length (length array))) (if (< length 2) array (do ((i 1 (1+ i))) ((eql i length) array) (do ((x (aref array i)) (j i (- j gap))) ((or (< (- j gap) 0) (not (funcall predicate x (aref array (1- j))))) (setf (aref array j) x)) (setf (aref array j) (aref array (- j gap))))))))
(defconstant +gaps+
'(1750 701 301 132 57 23 10 4 1) "The best sequence of gaps, according to Marcin Ciura.")
(defun shell-sort (array predicate &optional (gaps +gaps+))
(assert (eql 1 (car (last gaps))) (gaps) "Last gap of ~w is not 1." gaps) (dolist (gap gaps array) (gap-insertion-sort array predicate gap)))</lang>
D
<lang d>import std.stdio: writeln;
void shellSort(T)(T[] seq) {
int inc = seq.length / 2; while (inc) { foreach (i, el; seq) { while (i >= inc && seq[i - inc] > el) { seq[i] = seq[i - inc]; i -= inc; } seq[i] = el; } inc = inc == 2 ? 1 : cast(int)(inc * 5.0 / 11); }
}
void main() {
auto data = [22, 7, 2, -5, 8, 4]; shellSort(data); writeln(data);
}</lang> Output:
[-5, 2, 4, 7, 8, 22]
E
<lang e>/** Shell sort (in-place) */ def shellSort(array) {
var inc := array.size() // 2 while (inc.aboveZero()) { for var i => a in array { while (i >= inc && (def b := array[i - inc]) > a) { array[i] := b i -= inc } array[i] := a } inc := if (inc <=> 2) { 1 } else { (inc * 5.0 / 11).floor() } }
}</lang>
Eiffel
Translated from pseudocode at Wikipedia
This solution is shown in the routine sort
of the class MY_SORTED_SET
.
For a more complete explanation of the Eiffel sort examples, see Bubble sort.
<lang eiffel>class
MY_SORTED_SET [G -> COMPARABLE]
inherit
TWO_WAY_SORTED_SET [G] redefine sort end
create
make
feature
sort -- Shell sort local inc: INTEGER j: INTEGER l_value: like item do from inc := (count.to_double / 2.0).rounded until inc <= 0 loop across inc |..| (count - 1) as ii loop l_value := Current [ii.item + 1] from j := ii.item until j < inc or Current [j - inc + 1] <= l_value loop Current [j + 1] := Current [j - inc + 1] j := j - inc end Current [j + 1] := l_value end inc := (inc.to_double / 2.2).rounded end end
end</lang>
Forth
<lang forth>defer less? ' < is less?
- shell { array len -- }
1 begin dup len u<= while 2* 1+ repeat { gap } begin gap 5 11 */ dup to gap while len gap do array i cells + dup @ swap ( temp last ) begin gap cells - array over u<= while 2dup @ less? while dup gap cells + over @ swap ! repeat then gap cells + ! loop repeat ;
create array 8 , 1 , 4 , 2 , 10 , 3 , 7 , 9 , 6 , 5 ,
array 10 shell array 10 cells dump</lang>
Fortran
<lang fortran>MODULE sort
CONTAINS
SUBROUTINE Shell_Sort(a)
IMPLICIT NONE INTEGER :: i, j, increment REAL :: temp REAL, INTENT(in out) :: a(:)
increment = SIZE(a) / 2 DO WHILE (increment > 0) DO i = increment+1, SIZE(a) j = i temp = a(i) DO WHILE (j >= increment+1 .AND. a(j-increment) > temp) a(j) = a(j-increment) j = j - increment END DO a(j) = temp END DO IF (increment == 2) THEN increment = 1 ELSE increment = increment * 5 / 11 END IF END DO
END SUBROUTINE Shell_Sort
END MODULE sort
PROGRAM Shellsort
USE sort
IMPLICIT NONE REAL :: array(1000) CALL RANDOM_SEED CALL RANDOM_NUMBER(array) WRITE (*,*) "Unsorted array" WRITE (*,*) array WRITE (*,*) CALL Shell_Sort(array) WRITE (*,*) "Sorted array" WRITE (*,*) array
END PROGRAM Shellsort</lang>
Go
Following WP pseudocode: <lang go>package main
import "fmt"
var a = []int{170, 45, 75, -90, -802, 24, 2, 66}
func main() {
fmt.Println("before:", a) for inc := len(a) / 2; inc > 0; inc = (inc + 1) * 5 / 11 { for i := inc; i < len(a); i++ { j, temp := i, a[i] for ; j >= inc && a[j-inc] > temp; j -= inc { a[j] = a[j-inc] } a[j] = temp } } fmt.Println("after: ", a)
}</lang> Output:
before: [170 45 75 -90 -802 24 2 66] after: [-802 -90 2 24 45 66 75 170]
Haskell
Adapted version from [2]
<lang haskell>import Data.List
shellSort xs = foldr (invColumnize (map (foldr insert []))) xs gaps
where gaps = takeWhile (< length xs) $ iterate (succ.(3*)) 1 invColumnize f k = concat. transpose. f. transpose . takeWhile (not.null). unfoldr (Just. splitAt k)</lang>
Io
Translated from pseudocode at Wikipedia <lang io>List do(
shellSortInPlace := method( gap := (size / 2) round while(gap > 0, for(i, gap, size - 1, key := at(i) j := i
while(j >= gap and at(j - gap) > key, atPut(j, at(j - gap)) j = j - gap ) atPut(j, key) ) gap = (gap / 2.2) round ) self)
)
l := list(2, 3, 4, 5, 1) l shellSortInPlace println # ==> list(1, 2, 3, 4, 5)</lang>
Icon and Unicon
<lang Icon>procedure main() #: demonstrate various ways to sort a list and string
demosort(shellsort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
end
procedure shellsort(X,op) #: return sorted X local i,j,inc,temp
op := sortop(op,X) # select how and what we sort
inc := *X/2 while inc > 0 do { every i := inc to *X do { temp := X[j := i] while op(temp,X[j - (j >= inc)]) do X[j] := X[j -:= inc] X[j] := temp } inc := if inc = 2 then 1 else inc*5/11 # switch to insertion near the end } return X
end</lang>
Note: This example relies on the supporting procedures 'sortop', and 'demosort' in Bubble Sort. The full demosort exercises the named sort of a list with op = "numeric", "string", ">>" (lexically gt, descending),">" (numerically gt, descending), a custom comparator, and also a string.
Abbreviated sample output:
Sorting Demo using procedure shellsort on list : [ 3 14 1 5 9 2 6 3 ] with op = &null: [ 1 2 3 3 5 6 9 14 ] (0 ms) ... on string : "qwerty" with op = &null: "eqrtwy" (0 ms)
J
Solution <lang j>gaps =: [: }: 1 (1+3*])^:(> {:)^:a:~ # insert =: (I.~ {. ]) , [ , ] }.~ I.~ gapinss =: #@] {. ,@|:@(] insert//.~ #@] $ i.@[) shellSort =: [: ; gapinss &.>/@(< ,~ ]&.>@gaps)</lang>
Java
This method will sort in place. If you want to preserve your unsorted array, use a copy of the array as an argument to this method. <lang java>public static void shell(int[] a) { int increment = a.length / 2; while (increment > 0) { for (int i = increment; i < a.length; i++) { int j = i; int temp = a[i]; while (j >= increment && a[j - increment] > temp) { a[j] = a[j - increment]; j -= increment; } a[j] = temp; } if (increment == 2) { increment = 1; } else { increment *= (5.0 / 11); } } }</lang>
JavaScript
<lang Javascript>function shellSort (a) {
for (var h = a.length; h = parseInt(h / 2);) { for (var i = h; i < a.length; i++) { var k = a[i]; for (var j = i; j >= h && k < a[j - h]; j -= h) a[j] = a[j - h]; a[j] = k; } } return a;
}
var a = []; var n = location.href.match(/\?(\d+)|$/)[1] || 10; for (var i = 0; i < n; i++)
a.push(parseInt(Math.random() * 100));
shellSort(a); document.write(a.join(" "));</lang>
Lisaac
<lang Lisaac>Section Header
+ name := SHELL_SORT;
- external := `#include <time.h>`;
Section Public
- main <- (
+ a : ARRAY[INTEGER];
a := ARRAY[INTEGER].create 0 to 100; `srand(time(NULL))`; 0.to 100 do { i : INTEGER; a.put `rand()`:INTEGER to i; };
shell a;
a.foreach { item : INTEGER; item.print; '\n'.print; };
);
- shell a : ARRAY[INTEGER] <- (
+ lower, length, increment, temp : INTEGER;
lower := a.lower; length := a.upper - lower + 1; increment := length; { increment := increment / 2; increment > 0 }.while_do { increment.to (length - 1) do { i : INTEGER; + j : INTEGER; temp := a.item(lower + i); j := i - increment; { (j >= 0) && { a.item(lower + j) > temp } }.while_do { a.put (a.item(lower + j)) to (lower + j + increment); j := j - increment; }; a.put temp to (lower + j + increment); }; };
);</lang>
Lua
<lang lua>function shellsort( a )
local inc = math.ceil( #a / 2 ) while inc > 0 do for i = inc, #a do local tmp = a[i] local j = i while j > inc and a[j-inc] > tmp do a[j] = a[j-inc] j = j - inc end a[j] = tmp end inc = math.floor( 0.5 + inc / 2.2 ) end return a
end
a = { -12, 3, 0, 4, 7, 4, 8, -5, 9 } a = shellsort( a )
for _, i in pairs(a) do
print(i)
end</lang>
MATLAB
This is a translation of the FORTRAN solution into MATLAB. <lang MATLAB>function list = shellSort(list)
N = numel(list); increment = round(N/2); while increment > 0 for i = (increment+1:N) temp = list(i); j = i; while (j >= increment+1) && (list(j-increment) > temp) list(j) = list(j-increment); j = j - increment; end list(j) = temp; end %for if increment == 2 %This case causes shell sort to become insertion sort increment = 1; else increment = round(increment/2.2); end end %while
end %shellSort</lang>
Sample Usage: <lang MATLAB>>> shellSort([4 3 1 5 6 2])
ans =
1 2 3 4 5 6</lang>
OCaml
<lang ocaml>let shellsort a =
let len = Array.length a in let incSequence = [| 412771; 165103; 66041; 26417; 10567; 4231; 1693; 673; 269; 107; 43; 17; 7; 3; 1 |] in Array.iter (fun increment -> if (increment * 2) <= len then for i = increment to pred len do let temp = a.(i) in let rec loop j = if j < 0 || a.(j) <= temp then (j) else begin a.(j + increment) <- a.(j); loop (j - increment) end in let j = loop (i - increment) in a.(j + increment) <- temp; done; ) incSequence;
- </lang>
and the main: <lang ocaml>let () =
let arraysize = 1000 in (* or whatever *) Random.self_init(); let intArray = Array.init arraysize (fun _ -> Random.int 4000) in shellsort intArray; Array.iter (Printf.printf " %d") intArray; print_newline();
- </lang>
Perl
<lang perl>sub shell_sort {
my (@a, $h, $i, $j, $k) = @_; for ($h = @a; $h = int $h / 2;) { for $i ($h .. $#a) { $k = $a[$i]; for ($j = $i; $j >= $h && $k < $a[$j - $h]; $j -= $h) { $a[$j] = $a[$j - $h]; } $a[$j] = $k; } } @a;
}
my @a = map int rand 100, 1 .. $ARGV[0] || 10; say "@a"; @a = shell_sort @a; say "@a"; </lang>
Perl 6
<lang perl6>sub shell_sort ( @a is copy ) {
loop ( my $gap = (@a/2).round; $gap > 0; $gap = ( $gap * 5 / 11 ).round ) { for $gap .. @a.end -> $i { my $temp = @a[$i];
my $j; loop ( $j = $i; $j >= $gap; $j -= $gap ) { my $v = @a[$j - $gap]; last if $v <= $temp; @a[$j] = $v; }
@a[$j] = $temp; } } return @a;
} my @data = 22, 7, 2, -5, 8, 4; say 'input = ' ~ @data; say 'output = ' ~ @data.&shell_sort; </lang>
Output:
input = 22 7 2 -5 8 4 output = -5 2 4 7 8 22
PHP
<lang php> function shellSort($arr) { $inc = round(count($arr)/2); while($inc > 0) { for($i = $inc; $i < count($arr);$i++){ $temp = $arr[$i]; $j = $i; while($j >= $inc && $arr[$j-$inc] > $temp) { $arr[$j] = $arr[$j - $inc]; $j -= $inc; } $arr[$j] = $temp; } $inc = round($inc/2.2); } return $arr; } </lang>
PL/I
<lang PL/I> /* Based on Rosetta Fortran */ Shell_Sort: PROCEDURE (A);
DECLARE A(*) FIXED; DECLARE ( i, j, increment) FIXED BINARY (31); DECLARE temp FIXED;
increment = DIMENSION(a) / 2; DO WHILE (increment > 0); DO i = lbound(A,1)+increment TO hbound(a,1); j = i; temp = a(i); DO WHILE (j >= increment+1 & a(j-increment) > temp); a(j) = a(j-increment); j = j - increment; END; a(j) = temp; END; IF increment = 2 THEN increment = 1; ELSE increment = increment * 5 / 11; END;
END SHELL_SORT; </lang>
PicoLisp
<lang PicoLisp>(de shellSort (A)
(for (Inc (*/ (length A) 2) (gt0 Inc) (*/ Inc 10 22)) (for (I Inc (get A I) (inc I)) (let (Tmp @ J I) (while (and (>= J Inc) (> (get A (- J Inc)) Tmp)) (set (nth A J) (get A (- J Inc))) (dec 'J Inc) ) (set (nth A J) Tmp) ) ) ) A )</lang>
Output:
: (shellSort (make (do 9 (link (rand 1 999))))) -> (1 167 183 282 524 556 638 891 902) : (shellSort (make (do 9 (link (rand 1 999))))) -> (82 120 160 168 205 226 408 708 719) : (shellSort (make (do 9 (link (rand 1 999))))) -> (108 212 330 471 667 716 739 769 938)
PowerShell
<lang PowerShell>Function ShellSort( [Array] $data ) { #http://www.research.att.com/~njas/sequences/A108870 $A108870 = [Int64[]] ( 1, 4, 9, 20, 46, 103, 233, 525, 1182, 2660, 5985, 13467, 30301, 68178, 153401, 345152, 776591, 1747331, 3931496, 8845866, 19903198, 44782196, 100759940, 226709866, 510097200, 1147718700, 2582367076, 5810325920, 13073233321, 29414774973 ) $datal = $data.length - 1 $inci = [Array]::BinarySearch( $A108870, [Int64] ( [Math]::Floor( $datal / 2 ) ) ) if( $inci -lt 0 ) { $inci = ( $inci -bxor -1 ) - 1 } $A108870[ $inci..0 ] | ForEach-Object { $inc = $_ $_..$datal | ForEach-Object { $temp = $data[ $_ ] $j = $_ for( ; ( $j -ge $inc ) -and ( $data[ $j - $inc ] -gt $temp ); $j -= $inc ) { $data[ $j ] = $data[ $j - $inc ] } $data[ $j ] = $temp } } $data }
$l = 10000; ShellSort( ( 1..$l | ForEach-Object { $Rand = New-Object Random }{ $Rand.Next( 0, $l - 1 ) } ) )</lang>
PureBasic
<lang PureBasic>#STEP=2.2
Procedure Shell_sort(Array A(1))
Protected l=ArraySize(A()), increment=Int(l/#STEP) Protected i, j, temp While increment For i= increment To l j=i temp=A(i) While j>=increment And A(j-increment)>temp A(j)=A(j-increment) j-increment Wend A(j)=temp Next i If increment=2 increment=1 Else increment*(5.0/11) EndIf Wend
EndProcedure</lang>
Python
This method sorts in place. If you want to preserve your unsorted list, copy it first. <lang python>def shell(seq):
inc = len(seq) // 2 while inc: for i, el in enumerate(seq): while i >= inc and seq[i - inc] > el: seq[i] = seq[i - inc] i -= inc seq[i] = el inc = 1 if inc == 2 else int(inc * 5.0 / 11)
data = [22, 7, 2, -5, 8, 4] shell(data) print data # [-5, 2, 4, 7, 8, 22]</lang>
REXX
<lang rexx> /*REXX program sorts an array using the shellsort method. */
call gen@ /*generate array elements. */ call show@ 'before sort' /*show before array elements*/ call shellSort highItem /*invoke the shell sort. */ call show@ ' after sort' /*show after array elements*/ exit
/*─────────────────────────────────────SHELLSORT subroutine───────-*/
shellSort: procedure expose @.; parse arg highItem
i=highItem%2
do while i\==0
do j=1+i to highItem k=j kmi=k-i _=@.j
do while k>=i+1 & @.kmi>_ @.k=@.kmi k=k-i kmi=k-i end
@.k=_ end /*j*/
if i==2 then i=1 else i=i*5%11
end /*while i\==0*/
return
/*─────────────────────────────────────GEN@ subroutine────────────-*/
gen@: @.= /*assign default value. */
@.1='3 character abbreviations for states of the USA' @.2='===============================================' @.3='MAE Maine' @.4='CAL California' @.5='KAN Kansas' @.6='MAS Massachusetts' @.7='WAS Washington' @.8='HAW Hawaii' @.9='NCR North Carolina'
@.10='SCR South Carolina' @.11='IDA Idaho' @.12='NDK North Dakota' @.13='SDK South Dakota' @.14='NEB Nebraska' @.15='DEL Delaware' @.16='PEN Pennsylvania' @.17='TEN Tennessee' @.18='GEO Georgia' @.19='VER Vermont' @.20='NEV Nevada' @.21='TEX Texas' @.22='VGI Virginia' @.23='OHI Ohio' @.24='NHM New Hampshire' @.25='RHO Rhode Island and Providence Plantations' @.26='MIC Michigan' @.27='MIN Minnesota' @.28='MIS Mississippi' @.29='WIS Wisconsin' @.30='OKA Oklahoma' @.31='ALA Alabama' @.32='FLA Florida' @.33='MLD Maryland' @.34='ALK Alaska' @.35='ILL Illinois' @.36='NMX New Mexico' @.37='IND Indiana' @.38='MOE Missouri' @.39='COL Colorado' @.40='CON Connecticut' @.41='MON Montana' @.42='LOU Louisiana' @.43='IOW Iowa' @.44='ORE Oregon' @.45='ARK Arkansas' @.46='ARZ Arizona' @.47='UTH Utah' @.48='KTY Kentucky' @.49='WVG West Virginia' @.50='NWJ New Jersey' @.51='NYK New York' @.52='WYO Wyoming'
do highItem=1 while @.highItem\== /*find how many entries. */ end
highItem=highItem-1 /*adjust highItem slightly. */ return
/*─────────────────────────────────────SHOW@ subroutine───────────-*/
show@: widthH=length(highItem) /*maximum width of any line.*/
do j=1 for highItem say 'element' right(j,widthH) arg(1)':' @.j end
say copies('─',80) /*show a seperator line. */ return </lang> Output:
element 1 before sort: 3 character abbreviations for states of the USA element 2 before sort: =============================================== element 3 before sort: MAE Maine element 4 before sort: CAL California element 5 before sort: KAN Kansas element 6 before sort: MAS Massachusetts element 7 before sort: WAS Washington element 8 before sort: HAW Hawaii element 9 before sort: NCR North Carolina element 10 before sort: SCR South Carolina element 11 before sort: IDA Idaho element 12 before sort: NDK North Dakota element 13 before sort: SDK South Dakota element 14 before sort: NEB Nebraska element 15 before sort: DEL Delaware element 16 before sort: PEN Pennsylvania element 17 before sort: TEN Tennessee element 18 before sort: GEO Georgia element 19 before sort: VER Vermont element 20 before sort: NEV Nevada element 21 before sort: TEX Texas element 22 before sort: VGI Virginia element 23 before sort: OHI Ohio element 24 before sort: NHM New Hampshire element 25 before sort: RHO Rhode Island and Providence Plantations element 26 before sort: MIC Michigan element 27 before sort: MIN Minnesota element 28 before sort: MIS Mississippi element 29 before sort: WIS Wisconsin element 30 before sort: OKA Oklahoma element 31 before sort: ALA Alabama element 32 before sort: FLA Florida element 33 before sort: MLD Maryland element 34 before sort: ALK Alaska element 35 before sort: ILL Illinois element 36 before sort: NMX New Mexico element 37 before sort: IND Indiana element 38 before sort: MOE Missouri element 39 before sort: COL Colorado element 40 before sort: CON Connecticut element 41 before sort: MON Montana element 42 before sort: LOU Louisiana element 43 before sort: IOW Iowa element 44 before sort: ORE Oregon element 45 before sort: ARK Arkansas element 46 before sort: ARZ Arizona element 47 before sort: UTH Utah element 48 before sort: KTY Kentucky element 49 before sort: WVG West Virginia element 50 before sort: NWJ New Jersey element 51 before sort: NYK New York element 52 before sort: WYO Wyoming ──────────────────────────────────────────────────────────────────────────────── element 1 after sort: 3 character abbreviations for states of the USA element 2 after sort: =============================================== element 3 after sort: ALA Alabama element 4 after sort: ALK Alaska element 5 after sort: ARK Arkansas element 6 after sort: ARZ Arizona element 7 after sort: CAL California element 8 after sort: COL Colorado element 9 after sort: CON Connecticut element 10 after sort: DEL Delaware element 11 after sort: FLA Florida element 12 after sort: GEO Georgia element 13 after sort: HAW Hawaii element 14 after sort: IDA Idaho element 15 after sort: ILL Illinois element 16 after sort: IND Indiana element 17 after sort: IOW Iowa element 18 after sort: KAN Kansas element 19 after sort: KTY Kentucky element 20 after sort: LOU Louisiana element 21 after sort: MAE Maine element 22 after sort: MAS Massachusetts element 23 after sort: MIC Michigan element 24 after sort: MIN Minnesota element 25 after sort: MIS Mississippi element 26 after sort: MLD Maryland element 27 after sort: MOE Missouri element 28 after sort: MON Montana element 29 after sort: NCR North Carolina element 30 after sort: NDK North Dakota element 31 after sort: NEB Nebraska element 32 after sort: NEV Nevada element 33 after sort: NHM New Hampshire element 34 after sort: NMX New Mexico element 35 after sort: NWJ New Jersey element 36 after sort: NYK New York element 37 after sort: OHI Ohio element 38 after sort: OKA Oklahoma element 39 after sort: ORE Oregon element 40 after sort: PEN Pennsylvania element 41 after sort: RHO Rhode Island and Providence Plantations element 42 after sort: SCR South Carolina element 43 after sort: SDK South Dakota element 44 after sort: TEN Tennessee element 45 after sort: TEX Texas element 46 after sort: UTH Utah element 47 after sort: VER Vermont element 48 after sort: VGI Virginia element 49 after sort: WAS Washington element 50 after sort: WIS Wisconsin element 51 after sort: WVG West Virginia element 52 after sort: WYO Wyoming ────────────────────────────────────────────────────────────────────────────────
Ruby
This method sorts in place. If you want to preserve your unsorted list, copy it first. <lang ruby>class Array
def shellsort! inc = length / 2 while inc != 0 each_with_index do |el, i| while i >= inc and self[i - inc] > el self[i] = self[i - inc] i -= inc end self[i] = el end inc = (inc == 2 ? 1 : (inc * 5.0 / 11).to_i) end end
end
data = [22, 7, 2, -5, 8, 4] data.shellsort! p data # [-5, 2, 4, 7, 8, 22]</lang>
Seed7
<lang seed7>const proc: shellSort (inout array elemType: arr) is func
local var integer: i is 0; var integer: j is 0; var integer: increment is 0; var elemType: help is elemType.value; begin increment := length(arr) div 2; while increment > 0 do for i range 1 to length(arr) do j := i; help := arr[i]; while j > increment and arr[j - increment] > help do arr[j] := arr[j - increment]; j -:= increment; end while; arr[j] := help; end for; increment := increment div 2; end while; end func;</lang>
Original source: [3]
Tcl
<lang tcl>package require Tcl 8.5
proc shellsort {m} {
set len [llength $m] set inc [expr {$len / 2}] while {$inc > 0} { for {set i $inc} {$i < $len} {incr i} { set j $i set temp [lindex $m $i] while {$j >= $inc && [set val [lindex $m [expr {$j - $inc}]]] > $temp} { lset m $j $val incr j -$inc } lset m $j $temp } set inc [expr {$inc == 2 ? 1 : $inc * 5 / 11}] } return $m
}
puts [shellsort {8 6 4 2 1 3 5 7 9}] ;# => 1 2 3 4 5 6 7 8 9</lang>