From 63c3043200de6b28a8c192f1b5625940435ea55e Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sat, 17 Oct 2015 14:20:48 +1100 Subject: Organised source code a bit, added makefile with clean target --- sort/bubble.adb | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ sort/bubble.ads | 17 +++++++++++++++ sort/cocktail.adb | 45 ++++++++++++++++++++++++++++++++++++++ sort/cocktail.ads | 16 ++++++++++++++ sort/comb.adb | 46 +++++++++++++++++++++++++++++++++++++++ sort/comb.ads | 16 ++++++++++++++ sort/gnomesort.hs | 19 ++++++++++++++++ sort/insertion.adb | 29 +++++++++++++++++++++++++ sort/insertion.ads | 16 ++++++++++++++ sort/mergesort.hs | 19 ++++++++++++++++ sort/odd_even.adb | 55 ++++++++++++++++++++++++++++++++++++++++++++++ sort/odd_even.ads | 16 ++++++++++++++ sort/quick.adb | 49 +++++++++++++++++++++++++++++++++++++++++ sort/quick.ads | 16 ++++++++++++++ sort/quicksort.hs | 12 ++++++++++ sort/selection.adb | 42 +++++++++++++++++++++++++++++++++++ sort/selection.ads | 16 ++++++++++++++ sort/strandsort.hs | 25 +++++++++++++++++++++ 18 files changed, 518 insertions(+) create mode 100644 sort/bubble.adb create mode 100644 sort/bubble.ads create mode 100644 sort/cocktail.adb create mode 100644 sort/cocktail.ads create mode 100644 sort/comb.adb create mode 100644 sort/comb.ads create mode 100644 sort/gnomesort.hs create mode 100644 sort/insertion.adb create mode 100644 sort/insertion.ads create mode 100644 sort/mergesort.hs create mode 100644 sort/odd_even.adb create mode 100644 sort/odd_even.ads create mode 100644 sort/quick.adb create mode 100644 sort/quick.ads create mode 100644 sort/quicksort.hs create mode 100644 sort/selection.adb create mode 100644 sort/selection.ads create mode 100644 sort/strandsort.hs (limited to 'sort') diff --git a/sort/bubble.adb b/sort/bubble.adb new file mode 100644 index 0000000..f4f2485 --- /dev/null +++ b/sort/bubble.adb @@ -0,0 +1,64 @@ + + +package body Bubble is + + + procedure Swap(A, B : in out Element_T) is + Temp : Element_T; + begin + Temp := A; + A := B; + B := Temp; + end Swap; + + + procedure Sort(Arr : in out Array_T) is + Swapped : Boolean; + begin + if Arr'Length <= 1 then + return; + end if; + + loop + Swapped := False; + + for I in Index_T range Arr'First .. Index_T'Pred(Arr'Last) loop + if Arr(I) > Arr(Index_T'Succ(I)) then + Swap( Arr(I), Arr(Index_T'Succ(I)) ); + Swapped := True; + end if; + end loop; + + exit when not Swapped; + end loop; + + end Sort; + + + procedure Optimized(Arr : in out Array_T) is + N, NewN : Index_T; + begin + if Arr'Length <= 1 then + return; + end if; + + N := Arr'Last; + loop + NewN := Arr'First; + + for I in Index_T range Arr'First .. Index_T'Pred(N) loop + if Arr(I) > Arr(Index_T'Succ(I)) then + Swap( Arr(I), Arr(Index_T'Succ(I)) ); + NewN := I; + end if; + end loop; + + N := NewN; + exit when N = Arr'First; + end loop; + + end Optimized; + + +end Bubble; + diff --git a/sort/bubble.ads b/sort/bubble.ads new file mode 100644 index 0000000..529c5c6 --- /dev/null +++ b/sort/bubble.ads @@ -0,0 +1,17 @@ + + +generic + + type Index_T is (<>); + type Element_T is private; + type Array_T is array (Index_T range <>) of Element_T; + + with function ">"(X, Y : in Element_T) return Boolean is <>; + +package Bubble is + + procedure Sort(Arr : in out Array_T); + procedure Optimized(Arr : in out Array_T); + +end Bubble; + diff --git a/sort/cocktail.adb b/sort/cocktail.adb new file mode 100644 index 0000000..ecc9e82 --- /dev/null +++ b/sort/cocktail.adb @@ -0,0 +1,45 @@ + + +package body Cocktail is + + + procedure Swap(A, B : in out Element_T) is + Temp : Element_T; + begin + Temp := A; + A := B; + B := Temp; + end Swap; + + + procedure Sort(Arr : in out Array) is + Swapped : Boolean; + begin + if Arr'Length <= 1 then + return; + end if; + + loop + Swapped := False; + for I in Index_T range Arr'First .. Index_T'Pred(Arr'Last) loop + if Arr(I) > Arr(Index_T'Succ(I)) then + Swap( Arr(I), Arr(Index_T'Succ(I)) ); + Swapped := True; + end if; + end loop; + exit when not Swapped; + + Swapped := False; + for I in Index_T reverse range Index_T'Succ(Arr'First) .. Arr'Last loop + if Arr(Index_T'Pred(I)) > Arr(I) then + Swap( Arr(Index_T'Pred(I)), Arr(I) ); + Swapped := True; + end if; + end loop; + exit when not Swapped; + end loop; + end Sort; + + +end Cocktail; + diff --git a/sort/cocktail.ads b/sort/cocktail.ads new file mode 100644 index 0000000..8f21ebb --- /dev/null +++ b/sort/cocktail.ads @@ -0,0 +1,16 @@ + + +generic + + type Index_T is (<>); + type Element_T is private; + type Array_T is array (Index_T range <>) of Element_T; + + with function ">"(X, Y : in Element_T) return Boolean is <>; + +package Cocktail is + + procedure Sort(Arr : in out Array_T); + +end Cocktail; + diff --git a/sort/comb.adb b/sort/comb.adb new file mode 100644 index 0000000..d13847c --- /dev/null +++ b/sort/comb.adb @@ -0,0 +1,46 @@ + + +package body Comb is + + + procedure Swap(A, B : in out Element_T) is + Temp : Element_T; + begin + Temp := A; + A := B; + B := Temp; + end Swap; + + + procedure Sort(Arr : in out Array_T) is + Swapped : Boolean; + Gap : Natural; + + Shrink : constant Float := 1.3; + begin + if Arr'Length <= 1 then + return; + end if; + + Gap := Arr'Length; + + loop + Gap := Natural(Float'Floor(Float(Gap) / Shrink)); + if Gap < 1 then + Gap := 1; + end if; + + Swapped := False; + for I in Integer range Index_T'Pos(Arr'First) .. (Index_T'Pos(Arr'Last) - Gap) loop + if Arr(Index_T'Val(I)) > Arr(Index_T'Val(I + Gap)) then + Swap( Arr(Index_T'Val(I)), Arr(Index_T'Val(I + Gap)) ); + Swapped := True; + end if; + end loop; + exit when Gap = 1 and not Swapped; + end loop; + end Sort; + + +end Comb; + diff --git a/sort/comb.ads b/sort/comb.ads new file mode 100644 index 0000000..a8200e7 --- /dev/null +++ b/sort/comb.ads @@ -0,0 +1,16 @@ + + +generic + + type Index_T is (<>); + type Element_T is private; + type Array_T is array (Index_T range <>) of Element_T; + + with function ">"(X, Y : in Element_T) return Boolean is <>; + +package Comb is + + procedure Sort(Arr : in out Array_T); + +end Comb; + diff --git a/sort/gnomesort.hs b/sort/gnomesort.hs new file mode 100644 index 0000000..2a9b9ce --- /dev/null +++ b/sort/gnomesort.hs @@ -0,0 +1,19 @@ + + + +gnomeSort :: Ord a => [a] -> [a] +gnomeSort list = doGnomeSort list 1 + + + +doGnomeSort :: Ord a => [a] -> Int -> [a] +doGnomeSort list pos | pos >= length list = list +doGnomeSort list pos = + if (list !! pos) >= (list !! (pos - 1)) + then doGnomeSort list (pos + 1) + else let list' = (take (pos - 1) list) ++ [list !! pos] ++ + [list !! (pos - 1)] ++ (drop (pos + 1) list) + pos' = if pos > 1 then pos - 1 else pos + in doGnomeSort list' pos' + + diff --git a/sort/insertion.adb b/sort/insertion.adb new file mode 100644 index 0000000..863fb8e --- /dev/null +++ b/sort/insertion.adb @@ -0,0 +1,29 @@ + + +package body Insertion is + + + procedure Sort(Arr : in out Array_T) is + Place : Index_T; + Temp : Element_T; + begin + if Arr'Length <= 1 then + return; + end if; + + for I in Index_T range Index_T'Succ(Arr'First) .. Arr'Last loop + if Arr(Index_T'Pred(I)) > Arr(I) then + Place := I; + while Place /= Arr'First and then Arr(Index_T'Pred(Place)) > Arr(I) loop + Place := Index_T'Pred(Place); + end loop; + Temp := Arr(I); + Arr(Index_T'Succ(Place) .. I) := Arr(Place .. Index_T'Pred(I)); + Arr(Place) := Temp; + end if; + end loop; + end Sort; + + +end Insertion; + diff --git a/sort/insertion.ads b/sort/insertion.ads new file mode 100644 index 0000000..19b6b2c --- /dev/null +++ b/sort/insertion.ads @@ -0,0 +1,16 @@ + + +generic + + type Index_T is (<>); + type Element_T is private; + type Array_T is array (Index_T range <>) of Element_T; + + with function ">"(X, Y : in Element_T) return Boolean is <>; + +package Insertion is + + procedure Sort(Arr : in out Array_T); + +end Insertion; + diff --git a/sort/mergesort.hs b/sort/mergesort.hs new file mode 100644 index 0000000..5c140b3 --- /dev/null +++ b/sort/mergesort.hs @@ -0,0 +1,19 @@ + + + +mergeSort :: Ord a => [a] -> [a] +mergeSort x | length x <= 1 = x +mergeSort x = + let n = (length x) `div` 2 + left = mergeSort (take n x) + right = mergeSort (drop n x) + in merge left right + + + +merge :: Ord a => [a] -> [a] -> [a] +merge [] y = y +merge x [] = x +merge (x:xs) (y:ys) = if x <= y then x:(merge xs (y:ys)) else y:(merge (x:xs) ys) + + diff --git a/sort/odd_even.adb b/sort/odd_even.adb new file mode 100644 index 0000000..095850e --- /dev/null +++ b/sort/odd_even.adb @@ -0,0 +1,55 @@ + + +package body Odd_Even is + + + procedure Swap(A, B : in out Element_T) is + Temp : Element_T; + begin + Temp := A; + A := B; + B := Temp; + end Swap; + + + procedure Single(Arr : in out Array_T) is + Sorted : Boolean; + begin + if Arr'Length <= 1 then + return; + end if; + + loop + Sorted := True; + + declare + I : Integer := Index_T'Pos(Arr'First); + begin + while I < Index_T'Pos(Arr'Last) loop + if Arr(Index_T'Val(I)) > Arr(Index_T'Val(I+1)) then + Swap( Arr(Index_T'Val(I)), Arr(Index_T'Val(I+1)) ); + Sorted := False; + end if; + I := I + 2; + end loop; + end; + + declare + I : Integer := Index_T'Pos(Arr'First) + 1; + begin + while I < Index_T'Pos(Arr'Last) loop + if Arr(Index_T'Val(I)) > Arr(Index_T'Val(I+1)) then + Swap( Arr(Index_T'Val(I)), Arr(Index_T'Val(I+1)) ); + Sorted := False; + end if; + I := I + 2; + end loop; + end; + + exit when Sorted; + end loop; + end Single; + + +end Odd_Even; + diff --git a/sort/odd_even.ads b/sort/odd_even.ads new file mode 100644 index 0000000..735a5ef --- /dev/null +++ b/sort/odd_even.ads @@ -0,0 +1,16 @@ + + +generic + + type Index_T is (<>); + type Element_T is private; + type Array_T is array (Index_T range <>) of Element_T; + + with function ">"(X, Y : in Element_T) return Boolean is <>; + +package Odd_Even is + + procedure Single(Arr : in out Array_T); + +end Odd_Even; + diff --git a/sort/quick.adb b/sort/quick.adb new file mode 100644 index 0000000..4586b3b --- /dev/null +++ b/sort/quick.adb @@ -0,0 +1,49 @@ + + +package body Quick is + + + procedure Swap(A, B : in out Element_T) is + Temp : Element_T; + begin + Temp := A; + A := B; + B := Temp; + end Swap; + + + procedure In_Place(Arr : in out Array_T) is + Pivot, Left, Right : Index_T; + begin + if Arr'Length <= 1 then + return; + end if; + + Pivot := Arr'First; + Left := Index_T'Succ(Pivot); + Right := Arr'Last; + + loop + while not (Arr(Left) > Arr(Pivot)) and Left < Arr'Last loop + Left := Index_T'Succ(Left); + end loop; + while Arr(Right) > Arr(Pivot) and Right > Arr'First loop + Right := Index_T'Pred(Right); + end loop; + exit when Left >= Right; + Swap(Arr(Left), Arr(Right)); + end loop; + + Swap(Arr(Pivot), Arr(Right)); + + if Right > Arr'First then + In_Place( Arr(Arr'First .. Index_T'Pred(Right)) ); + end if; + if Right < Arr'Last then + In_Place( Arr(Index_T'Succ(Right) .. Arr'Last) ); + end if; + end In_Place; + + +end Quick; + diff --git a/sort/quick.ads b/sort/quick.ads new file mode 100644 index 0000000..e406d51 --- /dev/null +++ b/sort/quick.ads @@ -0,0 +1,16 @@ + + +generic + + type Index_T is (<>); + type Element_T is private; + type Array_T is array (Index_T range <>) of Element_T; + + with function ">"(X, Y : in Element_T) return Boolean is <>; + +package Quick is + + procedure In_Place(Arr : in out Array_T); + +end Quick; + diff --git a/sort/quicksort.hs b/sort/quicksort.hs new file mode 100644 index 0000000..78330f3 --- /dev/null +++ b/sort/quicksort.hs @@ -0,0 +1,12 @@ + + + +quickSort :: Ord a => [a] -> [a] +quickSort [] = [] +quickSort (x:xs) = + let less = [ a | a <- xs, a < x ] + equal = [ b | b <- (x:xs), b == x ] + greater = [ c | c <- xs, c > x ] + in quickSort less ++ equal ++ quickSort greater + + diff --git a/sort/selection.adb b/sort/selection.adb new file mode 100644 index 0000000..1b49769 --- /dev/null +++ b/sort/selection.adb @@ -0,0 +1,42 @@ + + +package body Selection is + + + procedure Swap(A, B : in out Element_T) is + Temp : Element_T; + begin + Temp := A; + A := B; + B := Temp; + end Swap; + + + function Find_Largest(Arr : in Array_T) return Index_T is + Max : Index_T; + begin + Max := Arr'First; + for P in Index_T range Index_T'Succ(Arr'First) .. Arr'Last loop + if Arr(P) > Arr(Max) then + Max := P; + end if; + end loop; + return Max; + end Find_Largest; + + + procedure Sort(Arr : in out Array_T) is + Largest : Index_T; + begin + if Arr'Length <= 1 then + return; + end if; + + Largest := Find_Largest(Arr); + Swap( Arr(Arr'Last), Arr(Largest) ); + Sort( Arr(Arr'First .. Index_T'Pred(Arr'Last)) ); + end Sort; + + +end Selection; + diff --git a/sort/selection.ads b/sort/selection.ads new file mode 100644 index 0000000..af085af --- /dev/null +++ b/sort/selection.ads @@ -0,0 +1,16 @@ + + +generic + + type Index_T is (<>); + type Element_T is private; + type Array_T is array (Index_T range <>) of Element_T; + + with function ">"(X, Y : in Element_T) return Boolean is <>; + +package Selection is + + procedure Sort(Arr : in out Array_T); + +end Selection; + diff --git a/sort/strandsort.hs b/sort/strandsort.hs new file mode 100644 index 0000000..8226b79 --- /dev/null +++ b/sort/strandsort.hs @@ -0,0 +1,25 @@ + + + +strandSort :: Ord a => [a] -> [a] +strandSort list = doStrandSort list [] [] [] + + + +doStrandSort :: Ord a => [a] -> [a] -> [a] -> [a] -> [a] +doStrandSort [] [] [] result = result +doStrandSort [] sublist unsorted result = doStrandSort unsorted [] [] (merge (reverse sublist) result) +doStrandSort input [] unsorted result = doStrandSort (tail input) [head input] unsorted result +doStrandSort input sublist unsorted result = + if (head input) >= (head sublist) + then doStrandSort (tail input) ((head input):sublist) unsorted result + else doStrandSort (tail input) sublist ((head input):unsorted) result + + + +merge :: Ord a => [a] -> [a] -> [a] +merge [] y = y +merge x [] = x +merge (x:xs) (y:ys) = if x <= y then x:(merge xs (y:ys)) else y:(merge (x:xs) ys) + + -- cgit