Stem-and-leaf plot: Difference between revisions

Line 1,015:
-- Re-reading the initial strings as Ints
-- (empty strings read as 0),
 
ns :: [(Int, Char)]
ns =
ns = (\x -> let s = fst x
(\x a -> (
in (
let s = fst if null sx
in ( if null then 0s
else (readthen s :: Int),0
snd xelse (read s :: Int)
, snd x)) <$>
) <$> xs
 
-- and sorting and grouping by these initial Ints,
-- interpreting them as data-collection bins.
 
bins :: [[(Int, Char)]]
bins =
bins = groupBy (on (==) fst) $
groupBy (on (==) fst) (sortBy (mappend (comparing fst) (comparing snd)) ns)
ns
 
-- Forming bars by the ordered accumulation of final characters in each bin,
 
bars :: [(Int, String)]
bars = (fst . head &&& fmap snd) <$> bins
 
-- and obtaining a complete series, with empty bar strings
-- interpolated for any missing integers.
 
series :: [(Int, String)]
series = (concat . snd) $ mapAccumL
(concat . snd) $
mapAccumL
(\a x ->
let n = fst x
in if a == n
then (a + 1, [x])
else (n + 1, ((\i -> (i, "")) <$> [a .. (n - 1)]) ++ [x]))
n + 1,
((\i -> (i, "")) <$> [a .. (n - 1)]) ++ [x]
)
)
1
bars
 
-- Assembling the series as a list of strings with right-justified indices,
 
justifyRight :: Int -> Char -> String -> String
justifyRight n c s = drop (length s) (replicate n c ++ s)
 
plotLines :: [String]
plotLines = foldr (
foldr
\x a -> (
(\x a ->
justifyRight 2 ' ' (show (fst x)) ++
(justifyRight 2 ' ' (show (fst x)) ++ " | " ++ (intersperse ' ' (snd x)) :
) : a)
)
[]
series
 
-- and passing these over to IO as a single newline-delimited string.
 
main :: IO ()
main = putStrLn $ unlines plotLines</lang>
9,655

edits