sort

6 files changed, 75 insertions, 8 deletions

diff --git a/.gitignore b/.gitignore
index d4e3882..5e1a6fd 100644
--- a/.gitignore
+++ b/.gitignore
@@ -5,5 +5,8 @@
 *.hi
 *.o
 
+# haskell bench
+*.eventlog
+
 cabal.sandbox.config
 .cabal-sandbox
diff --git a/AATree/AATree.hs b/AATree/AATree.hs
index 72698f7..2542951 100644
--- a/AATree/AATree.hs
+++ b/AATree/AATree.hs
@@ -1,4 +1,4 @@
-module AATree where
+module AATree.AATree where
 
 data AATree a = Node {
     level :: Int,
diff --git a/AATree/testTree.hs b/AATree/testTree.hs
index a9fea3f..6d625e7 100644
--- a/AATree/testTree.hs
+++ b/AATree/testTree.hs
@@ -1,10 +1,17 @@
-import AATree
-
-setup = foldl insert Nil [1..20]
+import AATree.AATree
+import Criterion.Main
+import Shuffle
+import Control.DeepSeq
+import Data.List
+import Sort.Sort
 
 main = do
-    let t = setup
-    putStrLn (show $ foldr (:) [] t)
+    xs <- shuffle ([1..5000]::[Int])
+    defaultMain [
+        bench "sort" (nf sort xs),
+        bench "msort" (nf msort xs),
+        bench "aasort" (nf aasort xs),
+        bench "head-sort" (nf (head.sort) xs),
+        bench "head-msort" (nf (head.msort) xs),
+        bench "head-aasort" (nf (head.aasort) xs)]
 
-sort [] = []
-sort (x:xs) = sort [ i | i<-xs, i<x]  ++  x:(sort [ i | i<-xs, i>=x])
diff --git a/Shuffle.hs b/Shuffle.hs
new file mode 100644
index 0000000..d1ad24a
--- /dev/null
+++ b/Shuffle.hs
@@ -0,0 +1,11 @@
+module Shuffle (shuffle) where
+
+import System.Random
+
+shuffle [] = return []
+shuffle xs = do
+    i <- getStdRandom(randomR (0,(length xs)-1))::IO(Int)
+    let (h:rst) = drop i xs
+    oth <- shuffle $ (take i xs) ++ rst
+    return (h:oth)
+
diff --git a/Sort/Sort.hs b/Sort/Sort.hs
new file mode 100644
index 0000000..2dc15a6
--- /dev/null
+++ b/Sort/Sort.hs
@@ -0,0 +1,43 @@
+module Sort.Sort (qsort,msort,msortBy) where
+
+import Control.Parallel
+import Criterion.Main
+import System.Random
+import Control.DeepSeq
+
+main = defaultMain
+    [bench "qsort" (nf qsort randomInts),
+    bench "pqsort" (nf pqsort randomInts)]
+
+qsort (x:xs) = [a | a<-xs, a<=x] ++(x:[a | a<-xs, a>x])
+
+pqsort (x:xs) = par (rnf larg) ([a|a<-xs, a<=x]++(x:larg))
+    where larg = [a|a<-xs,a>x]
+
+randomInts = take 200000 (randoms (mkStdGen 211570155)) :: [Integer]
+
+msort xs = msortBy compare xs
+
+msortBy cmp xs = mergeAll $ warp xs
+    where
+        warp (a:b:xs)
+            | a `cmp` b /= GT = let (dec,rst) = decwarp xs [b,a] in dec:warp rst
+            | otherwise = let (inc,rst) = incwarp xs [b,a] in (reverse inc):warp rst
+        warp t = [t]
+        decwarp xx@(x:xs) aa@(a:as) 
+            | a `cmp` x /= LT = decwarp xs (x:aa)
+            | otherwise = (aa,xx)
+        decwarp [] aa = (aa,[])
+        incwarp xx@(x:xs) aa@(a:as) 
+            | a `cmp` x /= GT = incwarp xs (x:aa)
+            | otherwise = (aa,xx)
+        incwarp [] aa = (aa,[])
+        merge (a:b:xs) = (mergePair a b []):(merge xs)
+        merge xs = xs
+        mergeAll [x] = x
+        mergeAll xs = mergeAll $ merge xs
+        mergePair [] bs os = (reverse os) ++ bs
+        mergePair as [] os = (reverse os) ++ as
+        mergePair aa@(a:as) bb@(b:bs) os
+            | b `cmp` a == GT = mergePair as bb (a:os)
+            | otherwise = mergePair aa bs (b:os)
diff --git a/ghcmake b/ghcmake
new file mode 100755
index 0000000..bf4469a
--- /dev/null
+++ b/ghcmake
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+ghc -O2 -rtsopts -eventlog -package-db=./.cabal-sandbox/x86_64-linux-ghc-7.10.3-packages.conf.d $@