議席数をドント方式で

http://ja.doukaku.org/26/より。ふつう。

module Main (main) where

import Data.List (sortBy, sort, group)

dhondt :: Int -> [Integer] -> [Int]
dhondt n = count . take n . deq . zipWith prepare [0 ..]
  where
    prepare :: Int -> Integer -> [(Double, Int)]
    prepare i x = zip (map (fromInteger x /) [1 ..]) (repeat i)
    
    deq :: [[(Double, Int)]] -> [(Double, Int)]
    deq xs =
      let (x' : xs') = sortBy (\ (a : _ ) (b : _) -> compare b a) xs
          (h : t) = x'
      in h : deq (t : xs')
    
    count :: [(Double, Int)] -> [Int]
    count = map length . group . sort . map snd

main :: IO ()
main = mapM_ print $ dhondt 100 [123, 4, 56, 78]
-- => 48
--    1
--    21
--    30

(追記そのいち) 上のコードは、議席を獲得できない政党が消えてしまいます!! その内修正します。

(追記そのに) 議席を獲得できない政党があった場合に対応しました。

module Main (main) where

import Data.List (sortBy, sort, group)

dhondt :: Int -> [Integer] -> [Int]
dhondt n votes = count $ take n $ deq $ zipWith prepare [0 ..] votes
  where
    prepare :: Int -> Integer -> [(Double, Int)]
    prepare i x = zip (map (fromInteger x /) [1 ..]) (repeat i)
    
    deq :: [[(Double, Int)]] -> [(Double, Int)]
    deq xs =
      let (x' : xs') = sortBy (\ (a : _ ) (b : _) -> compare b a) xs
          (h : t) = x'
      in h : deq (t : xs')
    
    count :: [(Double, Int)] -> [Int]
    count = foldl lsucc (replicate (length votes) 0) . map snd

    lsucc :: [Int] -> Int -> [Int]
    lsucc xs i =
      let (xs1, (x2 : xs2)) = splitAt i xs
      in xs1 ++ (succ x2) : xs2

main :: IO ()
main = mapM_ print $ dhondt 100 [123, 4, 56, 78]
-- => 48
--    1
--    21
--    30