rowbalance.hs

#!/usr/bin/env runhaskell
import Control.Applicative
import System.Environment
-- Usage: $ ./rowbalance.hs ./items
-- Writes file ./items-balanced.csv

main :: IO ()
main = do arg <- head <$> getArgs
          file <- lines <$> readFile arg
          items <- return $ case square $ length file of
                     Just s -> orderStrings file <$> s
                     Nothing -> [["Error: only works for even number of items!"]]
          writeFile (arg ++ "-balanced.csv") $
                (strings2csv . csvHeader $ length file) ++ "\n" ++  -- header row
                (unlines $ strings2csv <$> prefixListNumbers items) -- rows of items


-- ["1","2","3",...]
numberStrings :: [String]
numberStrings = fmap show $ iterate (+1) 0

-- generate header row for n items
csvHeader :: Int -> [String]
csvHeader n = ["list"] ++ (take n . fmap ("item_" ++) $ numberStrings)

-- given list of rows, add list-number column to each
prefixListNumbers :: [[String]] -> [[String]]
prefixListNumbers = zipWith (:) numberStrings

-- like zip with tuples flattened
ziplist :: [a] -> [a] -> [a]
ziplist a [] = a
ziplist [] b = b
ziplist (a:as) (b:bs) = a:b:(ziplist as bs)

-- turn list into csv-formatted columns
strings2csv :: [String] -> String
strings2csv [] = ""
strings2csv (s:ss) = "\"" ++ (escapeQuotes s) ++ "\"," ++ strings2csv ss

-- escape double-quote with another double-quote ("")
escapeQuotes :: String -> String
escapeQuotes [] = []
escapeQuotes (x:xs)
    | x == '"' = "\"\"" ++ escapeQuotes xs
    | otherwise = x:escapeQuotes xs

-- order a list of strings using a list of indices
orderStrings :: [String] -> [Int] -> [String]
orderStrings _ [] = []
orderStrings ss (n:ns) = (ss!!n):(orderStrings ss ns)


-- Implements a very simple algorithm, but any method can be used.
-- This one can only produce squares of even order.
--
-- Bradley, James V. 1958. "Complete Counterbalancing of
-- Immediate Sequential Effects in a Latin Square Design."
-- JASA 53(282):525-28. doi:10.1080/01621459.1958.10501456
square :: Int -> Maybe [[Int]]
square n
    | n `mod` 2 == 0 = Just . take n . iterate increment -- build n rows...
                            . take n . ziplist [0..n-1]  -- ...out of n columns
                                     $ reverse [0..n-1]
    | otherwise = Nothing
        where increment = map (\x -> (x + 1) `mod` n)