比較しないソートの作成 in Haskell DouKaku?

ソート対象のデータ同士で一切比較などを行わずにソートし、ソート結果を出力するプログラムを作成してください。条件は以下の通り。
・最低値・最大値・個数・並び替え対象の4つを引数として受け取る
・最大値と最低値はあくまで取りうる可能性であり、実際に出現することを保障するものではない。
・同値が複数出現することがある。
・入出力方法及びフォーマットは自由、関数として実装し引数に渡す形でも良い。
・小数点以下の数値が渡されることはないが、負の数は渡される可能性がある。
・最大値や最低値を元に算出した数値との比較は使用しても問題ありません。
・出来るだけ多様な条件のデータをソートできるアルゴリズムを使ってください(データが多少多いときや一定の並び順だとソート失敗するものはダメ)
・昇順降順はどちらでもかまいません

以下サンプル入出力
>>入力
-1 10 10
-1 9 4 8 9 6 3 9 5 2
>>出力
-1 2 3 4 5 6 8 9 9 9

クイックソート的にやりました。しかし、終了条件が悪いので遅いです。

import Data.List (group,sort)

main :: IO ()
main = print $ qsort (-1) 10 [-1,9,4,8,9,6,3,9,5,2]

uniq :: Ord a => [a] -> [a]
uniq ns = map head $ group $ sort ns

qsort :: Integral a => a -> a -> [a] -> [a]
qsort _ _ [] = []
qsort _ _ ns | length (uniq ns) == 1 = ns
qsort min max ns = let mid = div (max + min) 2
                   in qsort min mid [y | y <- ns, y < mid] ++ qsort mid max [y | y <- ns, y >=mid ]

データのレンジがわかっているのであらかじめ順番に並んでいる結果のリストから入力リストにはいっているものだけ残すという方法です…

入力リストの要素数は必要ありません…

module Main where

sort_noComp :: (Num a, Ord a, Enum a)=> a -> a -> Int -> [a] -> [a]
sort_noComp min max len xs = filter (\x -> elem x xs) [min..max]

main = print $ sort_noComp 1 9 8 [4, 8, 9, 6, 3, 9, 5, 2]

短くする方向で書いてみました。個数は要りません。

1	mysort min max ns = concat [filter (== x) ns \| x <- [min..max]]

あぁ、情けなし。

module Main where

sort_noComp min max xs = foldr (addCount) (map (flip (,) $ 0) [min..max]) xs >>= \(x, c) -> replicate c x
    where
        addCount :: Int -> [(Int, Int)] -> [(Int, Int)]
        addCount i [] = []
        addCount i ((j, x):xs)
            | i == j = (j, x + 1) : xs
            | otherwise = (j, x) : addCount i xs

main = print $ sort_noComp 1 9 [4, 8, 9, 6, 3, 9, 5, 2]

counting sortを実装しました。
> ghc --make -O2 CountingSort.hs
> ./CountingSort

import qualified Data.Map as M
import Control.Monad.State

counter min max xs = recur (M.fromAscList $ zip [min..max] (repeat 0)) xs
  where recur ctr [] = M.toAscList ctr
            recur ctr (x:xs) = recur (M.update (\v -> Just (succ v)) x ctr) xs

countingSort :: (Ord a, Enum a, Num a) => a -> a -> [a] -> [a]
countingSort min max xs = let ctr = counter min max xs
                                           result = M.fromAscList $ zip [0..len] (repeat 0)
                                      in evalState (countingSort_S min ctr) (0,result)
  where len = fromIntegral $ length xs - 1

countingSort_S :: (Ord a, Enum a, Num a) => a -> [(a,a)] -> State (a,M.Map a a) [a]
countingSort_S _ [] = get >>= return . M.elems . snd
countingSort_S min ((x,y):xs) = do
    forM_ [1..y] update
    countingSort_S min xs
  where update _ = do
                (index,result) <- get
                put (succ index, M.update f index result)
            f _ = Just x

main :: IO ()
main = do
    print $ countingSort (-1) 10 [-1,9,4,8,9,6,3,9,5,2]
    print $ countingSort (-100000) 100000 [-100000..100000]

ちょっと修正しました。

import qualified Data.Map as M                                                                                               
import Control.Monad.State

counter min max xs = recur (M.fromAscList $ zip [min..max] (repeat 0)) xs
  where recur ctr [] = M.toAscList ctr 
        recur ctr (x:xs) = recur (M.update (\v -> Just (succ v)) x ctr) xs

countingSort :: (Ord a, Enum a, Num a) => a -> a -> [a] -> [a] 
countingSort min max xs = let ctr = counter min max xs
                          in evalState (countingSort_S min ctr) []
  where len = fromIntegral $ length xs - 1 

countingSort_S :: (Ord a, Enum a, Num a) => a -> [(a,a)] -> State [a] [a] 
countingSort_S _ [] = get >>= return . reverse
countingSort_S min ((x,y):xs) = do
    forM_ [1..y] (\_ -> get >>= \xs -> put $ x:xs)
    countingSort_S min xs

main :: IO ()
main = do
    print $ countingSort (-1) 10 [-1,9,4,8,9,6,3,9,5,2]
    print $ countingSort (-100000) 100000 [-100000..100000]

counting sort
配列を使って素朴に。

import Array
import List

countingSort lower upper n xs = elems $ array (1,n) ys  where
  lower1 = lower - 1
  -- キーの出現回数
  a = accumArray (+) 0 (lower1,upper) [(x,1)| x <- xs]
  -- 出現回数の累計
  b = array (lower1,upper) $ (lower1,0): [(i,b!(i-1)+a!i)| i <- [lower..upper]]
  -- ソート後のキーの位置の計算
  (_,ys) = mapAccumL f b xs
  f c x = (c//[(x,(c!x)-1)], (c!x,x))

{-
> countingSort (-1) 10 10 [-1,9,4,8,9,6,3,9,5,2]
[-1,2,3,4,5,6,8,9,9,9]
-}

DouKaku?

比較しないソートの作成

Posted feedbacks - Haskell

Index

Feed

Other

Link

Pathtraq