Journal InTime

_ RubyとHaskellによる簡単なCSVファイルの集計

簡単なCSVファイルの集計をHaskellでやろうと思ったら結構大変だったのでメモ。 IO返す関数をはじめて書いた気がする。

問題

以下のような形式の複数のCSVファイルをコマンドライン引数で受け取り、Applicant Nameごとに得点を集計して、合計得点でソートした結果を出力する。

Applicant Name,Project Title,Productivity and performance,Originality and creativity,Feasibility,Jadges point,Comment
Shugo Maeda,Introducing list comprehensions into Ruby,5,1,7,3,面白いけど必要ないと思います。
...

Ruby版 (30行)

Haskellで書こうと思ったけど手が出なかったので、とりあえずRubyで書いた。 色々やり方はあると思うけど、なるべく副作用を使わないやり方で。 flat_map便利。

class Assessment < Struct.new(:applicant, :title, :productivity, :originality, :feasibility, :judges_point)
  def +(other)
    self.class.new(self.applicant, self.title,
                   self.productivity + other.productivity,
                   self.originality + other.originality,
                   self.feasibility + other.feasibility,
                   self.judges_point + other.judges_point)
  end

  def total
    productivity + originality + feasibility + judges_point
  end

  def to_s
    [*to_a, total].join(",")
  end
end

assessments = ARGV.flat_map { |path|
  File.read(path).lines.reject { |line|
    /^Applicant Name/.match(line)
  }.map { |line|
    fields = *line.split(/,/)
    Assessment.new(*fields[0, 2], *fields[2, 4].map(&:to_i))
  }
}.group_by { |a| a.applicant }.flat_map { |k, as|
  as.inject(&:+)
}
puts "Applicant Name,Project Title,Productivity,Originality,Feasibility,Judges Point,Total"
puts assessments.sort_by { |i| -i.total }

Haskell版 (96行)

Ruby版を参考に悩みながら書いたのが以下。

import List
import Data.Ord
import IO
import System.Environment
import Text.ParserCombinators.Parsec

data Assessment = Assessment {
  applicant:: String,
  title :: String,
  productivity :: Int,
  originality :: Int,
  feasibility :: Int,
  judgesPoint :: Int
}

instance Show Assessment where
  show a = case a of
    (Assessment applicant title
     productivity originality feasibility judgesPoint)
     -> applicant ++ "," ++ title ++ ","
        ++ show productivity ++ "," ++ show originality ++ ","
        ++ show feasibility ++ "," ++ show judgesPoint ++ ","
        ++ show (totalPoint a)

totalPoint :: Assessment -> Int
totalPoint (Assessment applicant title
            productivity originality feasibility judgesPoint)
  = productivity + originality + feasibility + judgesPoint

aplus :: Assessment -> Assessment -> Assessment
(Assessment a1 t1 p1 o1 f1 j1) `aplus` (Assessment a2 t2 p2 o2 f2 j2)
  = Assessment a1 t1 (p1 + p2) (o1 + o2) (f1 + f2) (j1 + j2)

text :: Parser String
text = many $ noneOf ","

point :: Parser Int
point = do s <- char '-'
           return 0
    <|> do s <- many digit
           return $ read s

record :: Parser Assessment
record = do a <- text
            char ','
            t <- text
            char ','
            p <- point
            char ','
            o <- point
            char ','
            f <- point
            char ','
            j <- point
            return $ Assessment a t p o f j

parseLine :: String -> [Assessment]
parseLine line
  = case (parse record "" line) of
      Left err -> []
      Right a -> [a]

linesToAssessments :: [String] -> [Assessment]
linesToAssessments = concatMap parseLine

rejectHeaders :: [String] -> [String]
rejectHeaders = filter $ (not) . isPrefixOf "Applicant Name"

sortByApplicant :: [Assessment] -> [Assessment]
sortByApplicant = sortBy $ comparing applicant

groupByApplicant :: [Assessment] -> [[Assessment]]
groupByApplicant = groupBy $ \x y -> applicant x == applicant y

sumAssessments :: [[Assessment]] -> [Assessment]
sumAssessments = map $ foldl1 aplus

sortByTotalPoint :: [Assessment] -> [Assessment]
sortByTotalPoint = sortBy $ comparing (negate . totalPoint)

assessmentSummary :: [String] -> [Assessment]
assessmentSummary = sortByTotalPoint . sumAssessments
                    . groupByApplicant . sortByApplicant
                    . linesToAssessments . rejectHeaders

readLines :: FilePath -> IO [String]
readLines path = do h <- openFile path ReadMode
                    cs <- hGetContents h
                    return $ lines cs

main = do paths <- getArgs
          liness <- sequence (map readLines paths)
          let lines = concat liness
          let summary = assessmentSummary lines
          putStrLn "Applicant Name,Project Title,Productivity,Originality,Feasibility,Judges Point,Total"
          sequence_ (map print summary)

色々ハマったけど、以下のことを学んだ。

• Parsecで/[^,]*/相当のことはmany (noneOf ",")と書ける。
• sequenceでIOのリストからアクションの実行結果のリストを得られる。結果が要らない場合はsequence_でOK。
• sortByはRubyのsort_byではなくsort {|x,y|...}相当。Data.Ord.comparingを使うとsort_byっぽく書ける。

残った疑問。

• comparingの==版はないのか? equalingみたいな。
• Rubyのsort_byみたいにSchwartzian Transformをやってくれる関数はないのだろうか。Haskellだと比較関数が速いからいらない?
• getArgsからlinesを得るまでの流れをもっとスマートに書けないだろうか。
• ファイルのクローズはどのタイミングでやればいいの?
• というか、そもそもHaskellでこういうコードを普通はどう書くの?