エンジニアのソフトウェア的愛情

または私は如何にして心配するのを止めてプログラムを・愛する・ようになったか

N個の要素に分割する・Haskell篇その2、あるいは8つのボール問題・Haskell篇

自主練の覚え書き的なエントリを先日書いたところ、コメントで有用な情報を頂くことができました。ありがとうございます。

畳み込み関数と展開関数

id:nobsun さんからは展開関数の存在を教えて頂きました。

展開関数とは

畳み込み関数と双対となる関数とのこと。

The unfoldr function is a `dual' to foldr: while foldr reduces a list to a summary value, unfoldr builds a list from a seed value.


Unfolding, Data.List, GHC standard libraries


畳み込み関数がリストをある値に畳み込んでいくのに対して、展開関数はある値をリストに展開していきます。
今回コードを書いたときに畳み込み関数が使えないだろうかと考えていたのですが、そもそもアプローチを間違えていた模様。


これをふまえて。
書き換えてみたのがこんな感じ。

module DivideInto where

import Data.List

divideInto :: Int -> [a] -> [[a]]
divideInto n xs = unfoldr (\xs -> if null xs then Nothing else Just $ splitAt m xs) xs
  where m = ((length xs) + n - 1) `div` n


これを使って「8つのボール問題」を解いてみます。こんな感じ。

import DivideInto

solve xs = solve' $ divideInto 3 (zip (iterate (+1) 0) xs)

solve' [[(i, _)]] = i
solve' (x1:x2:x3) = solve' $ divideInto 3 p
  where
    p = case compare (sum $ snd $ unzip x1) (sum $ snd $ unzip x2) of
          GT -> x1
          LT -> x2
          EQ -> head x3

main = do
  putStrLn $ show $ solve [7,5,5,5,5,5,5,5]
  putStrLn $ show $ solve [5,7,5,5,5,5,5,5]
  putStrLn $ show $ solve [5,5,7,5,5,5,5,5]
  putStrLn $ show $ solve [5,5,5,7,5,5,5,5]
  putStrLn $ show $ solve [5,5,5,5,7,5,5,5]
  putStrLn $ show $ solve [5,5,5,5,5,7,5,5]
  putStrLn $ show $ solve [5,5,5,5,5,5,7,5]
  putStrLn $ show $ solve [5,5,5,5,5,5,5,7]


出題の条件を守ってないだろ、というツッコミがありそうですが…。

…。

その2以降で考えます。

均等にならすという考え方

今回の分割は端数を一カ所によせるという考え方を採用していますが、 id:the_little_schemer さんからはできるだけ均等に分割する方法を示してもらえました。

-- N個の要素に分割する・Haskell篇
-- http://d.hatena.ne.jp/E_Mattsan/20130702/1372768341
-- 出題者の意図とは少し違うかもしれないけど…各要素の数がなるだけ均等になるようにしてみた。

import Data.List

-- 各要素の数を求める
-- counts 8 3 => [3,3,2]
counts :: Int -> Int -> [Int]
counts m n = zipWith (+) (replicate n q) (replicate r 1 ++ repeat 0)
  where (q, r) = quotRem m n

-- List xs を n 個の要素に分割する
divideInto :: Int -> [a] -> [[a]]
divideInto n xs = loop xs $ counts (length xs) n
  where
    loop xs (n : ns) = let (a, b) = splitAt n xs in a : loop b ns
    loop _ _ = []


均等に分割する方法をわたしも考えてみているのですが、the_little_schemer さんのものよりシンプルな方法が思いつかずに、ウーン…、となっているところ。