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