Data commit

Task/Order-by-pair-comparisons/Haskell/order-by-pair-comparisons-1.hs

@@ -0,0 +1,22 @@
+import Control.Monad
+import Control.Monad.ListM (sortByM, insertByM, partitionM, minimumByM)
+import Data.Bool (bool)
+import Data.Monoid
+import Data.List
+
+--------------------------------------------------------------------------------
+isortM, msortM, tsortM :: Monad m => (a -> a -> m Ordering) -> [a] -> m [a]
+
+-- merge sort from the Control.Monad.ListM library
+msortM = sortByM
+
+-- insertion sort
+isortM cmp = foldM (flip (insertByM cmp)) []
+
+-- tree sort aka qsort (which is not)
+tsortM cmp = go
+  where
+    go [] = pure []
+    go (h:t) = do (l, g) <- partitionM (fmap (LT /=) . cmp h) t
+                  go l <+> pure [h] <+> go g
+    (<+>) = liftM2 (++)

Task/Order-by-pair-comparisons/Haskell/order-by-pair-comparisons-2.hs

@@ -0,0 +1,5 @@
+ask a b = do
+  putStr $ show a ++ " ≤ " ++ show b ++ " ? [y/n]  "
+  bool GT LT . ("y" ==) <$> getLine
+
+colors = ["Violet", "Red", "Green", "Indigo", "Blue", "Yellow", "Orange"]

Task/Order-by-pair-comparisons/Haskell/order-by-pair-comparisons-3.hs

@@ -0,0 +1,15 @@
+test method = do
+  mapM_ showHist $ hist res
+  putStrLn $ "Median number of comparisons: " ++ show (median res)
+  putStrLn $ "Mean number of comparisons: " ++ show (mean res)
+  where
+    res = getSum . fst . method cmp <$> permutations [1..7]
+    cmp a b = (Sum 1, compare a b)
+    median lst = sort lst !! (length lst `div` 2)
+    mean lst = sum (fromIntegral <$> lst) / genericLength lst
+    hist lst = (\x -> (head x, length x)) <$> group (sort lst)
+    showHist (n, l) = putStrLn line
+      where
+        line = show n ++ "\t" ++ bar ++ " " ++ show perc ++ "%"
+        bar = replicate (max perc 1) '*'
+        perc = (100 * l) `div` product [1..7]