Search the Community

BubbleSort: Every time it loops through the array, it moves the largest item it can find to the back of unsorted area of the array, it repeats this until all items have been sorted. It moves the largest item to the back until it finds a larger item on the way with which it continues until it's moving the largest item in the array. procedure BubbleSort(var Arr: TIntArray); var CurIndex, TmpIndex, Hi: Integer; begin Hi := High(Arr); for CurIndex := 0 to Hi do for TmpIndex := 1 to Hi - CurIndex do if Arr[TmpIndex - 1] > Arr[TmpIndex] then Swap(Arr[TmpIndex - 1], Arr[TmpIndex]); end; var TIA: TIntArray; begin TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1]; WriteLn(TIAToStr(TIA)); BubbleSort(TIA); WriteLn(TIAToStr(TIA)); end. SelectionSort: Loops through the array, it finds the smallest item in the array and swaps it with the item at it's current index. procedure SelectionSort(var Arr: TIntArray); var CurIndex, TmpIndex, Hi, Min: Integer; begin Hi := High(Arr); for CurIndex := 0 to Hi do begin Min := CurIndex; for TmpIndex := CurIndex + 1 to Hi do if Arr[Min] > Arr[TmpIndex] then Min := TmpIndex; Swap(Arr[Min], Arr[CurIndex]); end; end; var TIA: TIntArray; begin TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1]; WriteLn(TIAToStr(TIA)); SelectionSort(TIA); WriteLn(TIAToStr(TIA)); end. InsertionSort: Loops through the array, moves every item it encounters up in the array towards the start until it's placed before every larger item that has been encountered so far. procedure InsertionSort(var Arr: TIntArray); var CurIndex, TmpIndex, Hi, Min: Integer; begin Hi := High(Arr); for CurIndex := 1 to Hi do for TmpIndex := CurIndex downto 1 do begin if not (Arr[TmpIndex] < Arr[TmpIndex - 1]) then Break; Swap(Arr[TmpIndex - 1], Arr[TmpIndex]); end; end; var TIA: TIntArray; begin TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1]; WriteLn(TIAToStr(TIA)); InsertionSort(TIA); WriteLn(TIAToStr(TIA)); end. MergeSort: Divides up the array into 2 parts recursively until it can no longer be divided because there's only a single item left in the sub-array. After doing this it recurses back up, merging the 2 sorted sub-arrays by looping through the 2 parts, placing the smallest item currently in either one first in the resulting array. The 2 sub-arrays in the lowest recursion level is always sorted as it contains a single item. procedure Merge(var Arr, Aux: TIntArray; const Lo, Mid, Hi: Integer); var LHalf, RHalf, Index: Integer; begin LHalf := Lo; RHalf := Mid + 1; for Index := Lo to Hi do Aux[index] := Arr[index]; for Index := Lo to Hi do if LHalf > Mid then begin Arr[index] := Aux[RHalf]; Inc(RHalf); end else if RHalf > Hi then begin Arr[index] := Aux[LHalf]; Inc(LHalf); end else if Aux[RHalf] < Aux[LHalf] then begin Arr[index] := Aux[RHalf]; Inc(RHalf); end else begin Arr[index] := Aux[LHalf]; Inc(LHalf); end; end; procedure Sort(var Arr, Aux: TIntArray; const Lo, Hi: Integer); var Mid: Integer; begin if Lo >= Hi then Exit; Mid := Lo + (Hi - Lo) div 2; Sort(Arr, Aux, Lo, Mid); Sort(Arr, Aux, Mid + 1, Hi); Merge(Arr, Aux, Lo, Mid, Hi); end; procedure MergeSort(var Arr: TIntArray); var Len: Integer; Aux: TIntArray; begin Len := Length(Arr); if Len <= 1 then Exit; SetLength(Aux, Len); Sort(Arr, Aux, 0, Len - 1); end; var TIA: TIntArray; begin TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1]; WriteLn(TIAToStr(TIA)); MergeSort(TIA); WriteLn(TIAToStr(TIA)); end. Bottom-Up MergeSort: The previous version of MergeSort is the most commonly referenced one, it is a top-down version of the algorithm as it starts at the top of your merging tree, then splits up into 2 smaller sub-arrays and goes on until it can no longer split up the sub-arrays. The bottom-up version does the exact opposite, it starts at the bottom and merges together in groups of 2, then doubles that group size up until everything is sorted, which is achieved when the size of the groups exceeds the size of the array. procedure Merge(var Arr, Aux: TIntArray; const Lo, Mid, Hi: Integer); var LHalf, RHalf, Index: Integer; begin LHalf := Lo; RHalf := Mid + 1; for Index := Lo to Hi do Aux[index] := Arr[index]; for Index := Lo to Hi do if LHalf > Mid then begin Arr[index] := Aux[RHalf]; Inc(RHalf); end else if RHalf > Hi then begin Arr[index] := Aux[LHalf]; Inc(LHalf); end else if Aux[RHalf] < Aux[LHalf] then begin Arr[index] := Aux[RHalf]; Inc(RHalf); end else begin Arr[index] := Aux[LHalf]; Inc(LHalf); end; end; procedure MergeSort(var Arr: TIntArray); var Len, Size, Lo: Integer; Aux: TIntArray; begin Len := Length(Arr); if Len <= 1 then Exit; SetLength(Aux, Len); Size := 1; while Size < Len do begin Lo := 0; while Lo < Len - Size do begin Merge(Arr, Aux, Lo, Lo + Size - 1, Min(Lo + Size * 2 - 1, Len - 1)); IncEx(Lo, Size * 2); end; IncEx(Size, Size); end; end; var TIA: TIntArray; begin TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1]; WriteLn(TIAToStr(TIA)); MergeSort(TIA); WriteLn(TIAToStr(TIA)); end. ShellSort: A special form of InsertionSort where the based on the size of the input data, the items are swapped to the top of the array the same way as with InsertionSort, but in large jumps which shrinks by dividing it by 3 until it reaches 1 which sorts the remaining array the same way InsertionSort does, however, at this point the array is already sorted to a certain degree, making the work required to finish sorting a lot easier than by running InsertionSort on the entire array. procedure ShellSort(var Arr: TIntArray); var X, CurIndex, TmpIndex, Len: Integer; begin Len := Length(Arr); X := 0; while X < Len div 3 do X := X * 3 + 1; while X >= 1 do begin for CurIndex := X to Len - 1 do begin TmpIndex := CurIndex; while (TmpIndex >= X) and (Arr[TmpIndex] < Arr[TmpIndex - X]) do begin Swap(Arr[TmpIndex], Arr[TmpIndex - X]); DecEx(TmpIndex, X); end; end; X := X div 3; end; end; var TIA: TIntArray; begin TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1]; WriteLn(TIAToStr(TIA)); ShellSort(TIA); WriteLn(TIAToStr(TIA)); end. QuickSort: This algorithm is somewhat similar to MergeSort, it also divides up the problem and solves it recursively. The concept is fairly straightforward. You start with an array, you take the first item of this array and compare it from both left and right to the other items in the array. From the left you want to find an item that is larger or equal to this first value, and from the right smaller or equal. If you find these, you swap them and resume from the current position until you've swapped them to a point where both your positions have crossed each other. What has happened is that you have moved all values larger than the first value to the right and all the ones smaller to the left. When the algorithm stops partitioning, your right position will be at the index where the last smaller value is located. This is swapped with the first value. Now you have this first value in a position where all values left of it are smaller and all values right of it are larger. Now you apply the same function recursively to these 2 sub-arrays of smaller and larger values until you reach a point where you're trying to sort single values which are obviously sorted as there's only 1 value. Once the recursion is complete, the entire array will be sorted. function Partition(var Arr: TIntArray; const Lo, Hi: Integer): Integer; var LSide, RSide, Val: Integer; begin Val := Arr[Lo]; LSide := Lo; RSide := Hi + 1; while True do begin repeat Inc(LSide); if (Val < Arr[LSide]) or (LSide = Hi) then Break; until False; repeat Dec(RSide); if (Val > Arr[RSide]) or (RSide = Lo) then Break; until False; if LSide >= RSide then Break; Swap(Arr[LSide], Arr[RSide]); end; Swap(Arr[RSide], Arr[Lo]); Result := RSide; end; procedure Sort(var Arr: TIntArray; const Lo, Hi: Integer); var Mid: Integer; begin if Lo >= Hi then Exit; Mid := Partition(Arr, Lo, Hi); Sort(Arr, Lo, Mid - 1); Sort(Arr, Mid + 1, Hi); end; procedure QuickSort(var Arr: TIntArray); begin Sort(Arr, 0, Length(Arr) - 1); end; var TIA: TIntArray; begin TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1]; WriteLn(TIAToStr(TIA)); QuickSort(TIA); WriteLn(TIAToStr(TIA)); end. 3-Way QuickSort QuickSort with 3-way partitioning still divides up the array into subarrays like the regular QuickSort algorithm does, however, rather than dividing it up into 2 arrays stretching the entire array, it will split it up into 2 arrays containing all items smaller than the first value of the array and a second larger than this item, all values equal to the first value are moved to the middle and left untouched any further. This process continues recursively until the array is sorted. procedure Sort(var Arr: TIntArray; const Lo, Hi: Integer); var LSide, RSide, Pos, Val: Integer; begin if Lo >= Hi then Exit; Val := Arr[Lo]; LSide := Lo; RSide := Hi; Pos := Lo + 1; while Pos <= RSide do if Arr[Pos] < Val then begin Swap(Arr[LSide], Arr[Pos]); Inc(Pos); Inc(LSide); end else if Arr[Pos] > Val then begin Swap(Arr[RSide], Arr[Pos]); Dec(RSide); end else Inc(Pos); Sort(Arr, Lo, LSide - 1); Sort(Arr, RSide + 1, Hi); end; procedure QuickSort(var Arr: TIntArray); begin Sort(Arr, 0, Length(Arr) - 1); end; var TIA: TIntArray; begin TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1]; WriteLn(TIAToStr(TIA)); QuickSort(TIA); WriteLn(TIAToStr(TIA)); end. HeapSort: The HeapSort algorithm first transforms your array into a binary heap by sinking down smaller elements for all nodes that have child nodes in the tree. Next it switches the first element with the last element in the array and decreases the size of the unsorted area by 1. The element now at the top is sunk down the remaining tree which moves the largest element currently present to the top of the tree. Now the process repeats. procedure Sink(var Arr: TIntArray; const Idx, LvlEnd, Len: Integer); var Tmp, Pos, SwapIdx: Integer; begin Pos := Idx; while Pos <= LvlEnd do begin SwapIdx := Pos; Tmp := Pos * 2 + 1; if (Arr[Pos] < Arr[Tmp]) then SwapIdx := Tmp; Inc(Tmp); if (Tmp < Len) and (Arr[swapIdx] < Arr[Tmp]) then SwapIdx := Tmp; if SwapIdx <> Pos then begin Swap(Arr[swapIdx], Arr[Pos]); Pos := SwapIdx; end else Break; end; end; procedure HeapSort(var Arr: TIntArray); var Len, Idx, LvlEnd: Integer; begin Len := Length(Arr); LvlEnd := (Len - 1) div 2 - 1; for Idx := LvlEnd downto 0 do Sink(Arr, Idx, LvlEnd, Len); while Len > 0 do begin Swap(Arr[0], Arr[Len - 1]); Dec(Len); Sink(Arr, 0, (Len - 1) div 2 - 1, Len); end; end; var TIA: TIntArray; begin TIA := [1, 6, 2, 4, 3, 5, 1, 2, 7, 1]; WriteLn(TIAToStr(TIA)); HeapSort(TIA); WriteLn(TIAToStr(TIA)); end.