{-# LANGUAGE TypeOperators, FlexibleContexts #-}

-- Exhaustive test sets for proper sorting and stability of
-- optimal sorts

module Optimal where

import Control.Arrow
import Control.Monad

import Data.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 []
                        . groupBy ((==) `on` fst)
                        . flip zip [0..])
              $ monotones (n-2) n

sort2 :: (Vector v Int) => [v Int]
sort2 = map fromList $ 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 $ 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 $ permutations [0..3]