diff options
| author | Jed Barber <jjbarber@y7mail.com> | 2015-10-17 14:20:48 +1100 | 
|---|---|---|
| committer | Jed Barber <jjbarber@y7mail.com> | 2015-10-17 14:20:48 +1100 | 
| commit | 63c3043200de6b28a8c192f1b5625940435ea55e (patch) | |
| tree | ab761edbbc71b2b2f28e0ef7e10b8adc58d44320 /sort | |
| parent | 5933f248c18914fbbce03102b340361a575eae3c (diff) | |
Organised source code a bit, added makefile with clean target
Diffstat (limited to 'sort')
| -rw-r--r-- | sort/bubble.adb | 64 | ||||
| -rw-r--r-- | sort/bubble.ads | 17 | ||||
| -rw-r--r-- | sort/cocktail.adb | 45 | ||||
| -rw-r--r-- | sort/cocktail.ads | 16 | ||||
| -rw-r--r-- | sort/comb.adb | 46 | ||||
| -rw-r--r-- | sort/comb.ads | 16 | ||||
| -rw-r--r-- | sort/gnomesort.hs | 19 | ||||
| -rw-r--r-- | sort/insertion.adb | 29 | ||||
| -rw-r--r-- | sort/insertion.ads | 16 | ||||
| -rw-r--r-- | sort/mergesort.hs | 19 | ||||
| -rw-r--r-- | sort/odd_even.adb | 55 | ||||
| -rw-r--r-- | sort/odd_even.ads | 16 | ||||
| -rw-r--r-- | sort/quick.adb | 49 | ||||
| -rw-r--r-- | sort/quick.ads | 16 | ||||
| -rw-r--r-- | sort/quicksort.hs | 12 | ||||
| -rw-r--r-- | sort/selection.adb | 42 | ||||
| -rw-r--r-- | sort/selection.ads | 16 | ||||
| -rw-r--r-- | sort/strandsort.hs | 25 | 
18 files changed, 518 insertions, 0 deletions
| 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) + + | 
