1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
{-# LANGUAGE TypeOperators, FlexibleContexts #-}
-- Exhaustive test sets for proper sorting and stability of
-- optimal sorts
module Optimal where
import Control.Arrow
import Control.Monad
import qualified Data.List as List
import Data.Function
import Data.Vector.Generic hiding (map, zip, concatMap, (++), replicate, foldM)
interleavings :: [a] -> [a] -> [[a]]
interleavings [ ] ys = [ys]
interleavings xs [ ] = [xs]
interleavings xs@(x:xt) ys@(y:yt) = map (x:) (interleavings xt ys)
++ map (y:) (interleavings xs yt)
monotones :: Int -> Int -> [[Int]]
monotones k = atLeastOne 0
where
atLeastOne i 0 = [[]]
atLeastOne i n = map (i:) $ picks i (n-1)
picks _ 0 = [[]]
picks i n | i >= k = [replicate n k]
| otherwise = map (i:) (picks i (n-1)) ++ atLeastOne (i+1) n
stability :: (Vector v (Int,Int)) => Int -> [v (Int, Int)]
stability n = concatMap ( map fromList
. foldM interleavings []
. List.groupBy ((==) `on` fst)
. flip zip [0..])
$ monotones (n-2) n
sort2 :: (Vector v Int) => [v Int]
sort2 = map fromList $ List.permutations [0,1]
stability2 :: (Vector v (Int,Int)) => [v (Int, Int)]
stability2 = [fromList [(0, 0), (0, 1)]]
sort3 :: (Vector v Int) => [v Int]
sort3 = map fromList $ List.permutations [0..2]
{-
stability3 :: [UArr (Int :*: Int)]
stability3 = map toU [ [0:*:0, 0:*:1, 0:*:2]
, [0:*:0, 0:*:1, 1:*:2]
, [0:*:0, 1:*:2, 0:*:1]
, [1:*:2, 0:*:0, 0:*:1]
, [0:*:0, 1:*:1, 1:*:2]
, [1:*:1, 0:*:0, 1:*:2]
, [1:*:1, 1:*:2, 0:*:0]
]
-}
sort4 :: (Vector v Int) => [v Int]
sort4 = map fromList $ List.permutations [0..3]
|
