Haskell卒業!

■ [メモ]うきゃ... 00:22

Haskell卒業したつもりだけど、電気系出身者さんの問題(はてなダイアリー)が面白そうなのでやってみた。

簡単な問題は好きです...

つか、Rubyの簡潔さに嫉妬。まぁ、LL系の言語って便利な関数が適切に組み込まれてる(<- 正規表現とか)とかライブラリ化されてるだけじゃないの？？？...と言ってしまえばそんな気もするのですが、それでもすごいな...

Rubyは難しそうだから眺めるだけにしておこう...

{-# LANGUAGE ScopedTypeVariables, ViewPatterns, RecordWildCards#-}

import System.Random
import Control.Applicative
import Control.Monad
import Test.QuickCheck.Gen
import Data.List
import Data.Ord
import Text.Printf

-- 要素数と種類をまとめただけ...
data Chocolate a = Chocolate { count :: Int, kind :: a }
  deriving (Eq)

instance (Show a) => Show (Chocolate a) where
  show Chocolate{..} = printf "kind %-12s -> count: %d" (show kind) count

-- 要素数(降順)、種類(昇順)な順で自然にソートさせる大富豪なコード...
instance (Ord a) => Ord (Chocolate a) where
  compare = comparing ((,) <$> negate . count <*> kind)

-- なんかのリストをチョコレートなリストに変換する...
toChocolates :: (Ord a) => [a] -> [Chocolate a]
toChocolates (group . sort -> xss) = [Chocolate (length xs) (head xs) | xs <- xss]

-- 適当にシードを与えてIntのリストを自動生成する...
type Seed  = Int

genIntList :: Seed -> [Int]
genIntList seed = do
  let generator m = (unGen m) (mkStdGen seed) sizeParameter
        where sizeParameter = 0
  generator $ do
    count <- choose (1, 20)         -- 要素数は１個から２０個で...
    vectorOf count (choose (1, 5))  -- 要素は１から５で...

-- 要素数、種類の優先順位でソートしておいたチョコレートなリストの先頭要素を調べる。
-- -> 要素数を１引いて、更新した要素を挿入する(<- DQNなアルゴリズム)。
-- -> リストが空になるまで繰り返す。
eatingOrder :: (Integral a) => [a] -> [a]
eatingOrder = do
  let conv [] = []
      conv (x@Chocolate{..} : xs)
        | count < 0   = error $ "eatingOrder: count is less than zero."
        | count == 0  = conv xs
        | otherwise   = kind : conv (insert (x{count = count - 1}) xs)
  conv . sort . toChocolates

main :: IO ()
main = do
  let samples = [
        [1, 1, 2, 0, 1, 2],
        genIntList 0,
        genIntList 10,
        genIntList 100]
  forM_ (zip [1 ..] samples) $ \(caseNo :: Int, xs) -> do
    printf "<Case %d>\n" caseNo
    mapM_ print $ toChocolates xs
    printf "Result: "
    print $ eatingOrder xs
    printf "\n"

実行結果...

$> main
<Case 1>
kind 0            -> count: 1
kind 1            -> count: 3
kind 2            -> count: 2
Result: [1,1,2,0,1,2]

<Case 2>
kind 2            -> count: 3
kind 3            -> count: 3
kind 5            -> count: 2
Result: [2,3,2,3,5,2,3,5]

<Case 3>
kind 1            -> count: 1
kind 3            -> count: 3
kind 4            -> count: 1
kind 5            -> count: 3
Result: [3,5,3,5,1,3,4,5]

<Case 4>
kind 1            -> count: 2
kind 2            -> count: 2
kind 3            -> count: 2
kind 4            -> count: 2
Result: [1,2,3,4,1,2,3,4]

ゴルファーの人だったら数行で書きそうだなぁ...