module NaiveSort7 where
-- Quadratic Sort from Permutation Sort
-- permute just assigns random destinations, and...
permute :: [a] -> [(a,Int)]
permute xs = zip xs positions
where positions = permuteindices (first (length xs))
-- ...apply applies a permutation (a (pair, destination) list) resulting in a permuted list
apply :: Eq a => [(a,Int)] -> [a]
apply pairs = place pairs (nvars (length pairs))
place :: Eq a => [(a,Int)] -> [a] -> [a]
place [] holes = holes
place ((x,pos):rest) holes | (holes !! (pos - 1)) == x = place rest holes
nvars :: Int -> [a]
nvars 0 = []
nvars n | n > 0 = x:(nvars (n-1)) where x free
permuteindices :: [Int] -> [Int]
permuteindices [] = []
permuteindices (h:ts) = let (x,rest) = pick (h:ts) in x:(permuteindices rest)
pick :: [a] -> (a,[a])
pick [x] = (x,[])
pick (x:y:zs) = (x,y:zs)
pick (x:y:zs) = let (w,rest) = pick (y:zs) in (w,x:rest)
first :: Int -> [Int]
first 0 = []
first n | n > 0 = n:(first (n-1))
isSorted :: Ord a => [a] -> [(a,Int)] -> Bool
isSorted xs pairs = all (\(x,i) -> (length (filter (<=x) xs)) == i) pairs
naivesort :: Ord a => [a] -> [a]
naivesort xs | isSorted xs indexed = apply indexed where indexed = permute xs