Jump to content

Stem-and-leaf plot: Difference between revisions

→‎{{header|Haskell}}: ( alternatively – aiming more for legibility than for concision)
No edit summary
(→‎{{header|Haskell}}: ( alternatively – aiming more for legibility than for concision))
Line 1,033:
13 | 1 2 3 9
14 | 1 6</pre>
 
Or alternatively – aiming more for legibility than for economy or concision:
 
<lang haskell>import Data.List (groupBy, intersperse, mapAccumL, sortBy)
import Data.Ord (comparing)
import Data.Function (on)
 
-- Strings derived from integers,
-- and split into [(initial string, final character)] tuples.
 
xs :: [(String, Char)]
xs = (\x -> (init x, last x)) <$> (show <$> [
12, 127, 28, 42, 39, 113, 42, 18, 44, 118, 44, 37, 113, 124, 37, 48, 127,
36, 29, 31, 125, 139, 131, 115, 105, 132, 104, 123, 35, 113, 122, 42, 117,
119, 58, 109, 23, 105, 63, 27, 44, 105, 99, 41, 128, 121, 116, 125, 32,
61, 37, 127, 29, 113, 121, 58, 114, 126, 53, 114, 96, 25, 109, 7, 31,
141, 46, 13, 27, 43, 117, 116, 27, 7, 68, 40, 31, 115, 124, 42, 128,
52, 71, 118, 117, 38, 27, 106, 33, 117, 116, 111, 40, 119, 47, 105,
57, 122, 109, 124, 115, 43, 120, 43, 27, 27, 18, 28, 48, 125, 107,
114, 34, 133, 45, 120, 30, 127, 31, 116, 146])
 
-- Re-reading the initial strings as Ints
-- (empty strings read as 0),
 
ns :: [(Int, Char)]
ns = (\x -> let s = fst x
in (
if null s
then 0
else (read s :: Int),
snd x
)
) <$> xs
 
-- and sorting and grouping by these initial Ints,
-- interpreting them as data-collection bins.
 
bins :: [[(Int, Char)]]
bins = groupBy (on (==) fst) $
sortBy (mappend (comparing fst) (comparing snd))
ns
 
-- Forming bars by the ordered accumulation of final characters in each bin,
 
bars :: [(Int, String)]
bars = (\grp -> (((fst . head) grp), snd <$> grp)) <$> bins
 
-- and obtaining a complete series, with empty bar strings
-- interpolated for any missing integers.
 
series :: [(Int, String)]
series = (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]
)
)
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 (
\x a -> (
justifyRight 2 ' ' (show (fst x)) ++
" | " ++ (intersperse ' ' (snd x))
) : a
)
[]
series
 
-- and passing these over to IO as a newline-delimited string.
 
main :: IO ()
main = putStrLn $ unlines plotLines</lang>
{{Out}}
<pre> 0 | 7 7
1 | 2 3 8 8
2 | 3 5 7 7 7 7 7 7 8 8 9 9
3 | 0 1 1 1 1 2 3 4 5 6 7 7 7 8 9
4 | 0 0 1 2 2 2 2 3 3 3 4 4 4 5 6 7 8 8
5 | 2 3 7 8 8
6 | 1 3 8
7 | 1
8 |
9 | 6 9
10 | 4 5 5 5 5 6 7 9 9 9
11 | 1 3 3 3 3 4 4 4 5 5 5 6 6 6 6 7 7 7 7 8 8 9 9
12 | 0 0 1 1 2 2 3 4 4 4 5 5 5 6 7 7 7 7 8 8
13 | 1 2 3 9
14 | 1 6</pre>
 
=={{header|HicEst}}==
9,655

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.