Sorting algorithms/Shell sort: Difference between revisions

From Rosetta Code
Content added Content deleted
(Change Javascript header to the right text)
No edit summary
Line 893: Line 893:
output = -5 2 4 7 8 22
output = -5 2 4 7 8 22
</pre>
</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}}==
=={{header|PL/I}}==

Revision as of 12:24, 8 April 2011

Task
Sorting algorithms/Shell sort
You are encouraged to solve this task according to the task description, using any language you may know.

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

Translation of: python
Works with: ALGOL 68 version Standard - no extensions to language used
Works with: ALGOL 68G version Any - tested with release mk15-0.8b.fc9.i386
Works with: ELLA ALGOL 68 version Any (with appropriate job cards) - tested with release 1.8.8d.fc9.i386

<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

Translation of: Fortran

<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

Translation of: Python

<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

Works with: EiffelStudio version 6.6 (with provisional loop syntax)

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

Works with: GNU 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

Works with: Fortran version 90 and later

<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

Generally, this task should be accomplished in J using /:~. Here we take an approach that's more comparable with the other examples on this page.
Translation of: Haskell

Solution <lang j>gaps =: [: }: 1 (1+3*])^:(> {:)^:a:~ # insert =: (I.~ {. ]) , [ , ] }.~ I.~ gapinss =: #@] {. ,@|:@(] insert//.~ #@] $ i.@[) shellSort =: [: ; gapinss &.>/@(< ,~ ]&.>@gaps)</lang>

Java

Translation of: Fortran

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

Translation of: C

<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

Translation of: Fortran

<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

Translation of: Java

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

Translation of: Java

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>