Instantly share code, notes, and snippets.

# banacorn/summary-week-2.md

Last active May 10, 2018

# Summary of Week 2 - Histogram

• 11 位參與者提供了 13 種解法
• 主要都可以分為兩個階段：先統計數量，再畫圖
• 統計數量可以寫成某種的 unfold，而畫圖則是某種的 fold
• 統計每個數字數量的幾種方法：
• `sort``group`
• `filter`
• 像畫正字一樣，用某種結構（List 或函數）去累加並儲存每種數字的數量
• 作法依畫星星的方向，主要可以分成兩種：
1. 依序將每個數字的數量畫成星星後，再用 `transpose` 將圖旋轉過來（下稱 transpose 大法）
2. 像量身高一樣，將有超過該數量的數字畫成星星，沒有的則留空，一排一排畫出來（下稱量身高大法）
• 寫成 unfold 加上 fold 都會需要畫正字的方法去統計數量
• 雖然這題大家都很自然地用 "wholemeal programming" 方式去解，但還是有人可以用野生的遞迴把它寫出來！！

## Solutions

• 統計：用 `filter``length` 去統計數量
• 畫圖：量身高大法
```countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

histogram :: [Int] -> String
histogram xs = (unlines \$ map (flip map counts . disp) [height,height-1..1]) ++ "==========\n0123456789\n"
where
counts = map (flip countBy xs . (==)) [0..9]
height = maximum counts
disp th val = if val >= th then '*' else ' '```
• 統計：用 `filter``length` 去統計數量
• 畫圖：量身高大法
```--  FLOLAC 2018 Week 2 -- Histogram

histogram :: [Int] -> String

histogram ix =
concat [ row n | n <- [heigh, heigh - 1  .. 1]] ++
"==========\n"  ++
"0123456789\n"
where
row m = [ if mm < m then ' ' else '*' | mm <- accl ] ++ "\n"
accl = [ length \$ filter (== nn ) ix | nn <- [0 .. 9] ]
heigh = maximum accl

-- In GHCi we should put the histogram output in 'putSrtLn' function
-- In order to make "\n" actually be line feed
{-  e.g.
putStrLn (histogram [])
putStrLn (histogram [1,2,3,4,5,6,7])
putStrLn (histogram [1,6,4,2,7,8,4,9,3,0,3,9,7,3])
putStrLn (histogram [1,4,5,4,6,6,3,4,2,4,9])
-}```
• unfold + fold!
• 統計：畫正字依序去累加每種數字的數量
• 畫圖：量身高大法
```import Control.Arrow ((&&&))
import Data.String (unlines)
import Data.List (unfoldr,foldl')

histogram :: [Int] -> String
histogram = graph . histo

histo :: [Int] -> [Int]
histo = foldl' oplus [0,0,0,0,0,0,0,0,0,0]
where oplus xs i = zipWith (\$) (replicate i id ++ [(1+)] ++ repeat id) xs

graph :: [Int] -> String
graph = unlines . reverse . ("0123456789":) . ("==========":) . unfoldr step
where step xs | all (<=0) xs = Nothing
| otherwise    = Just . (map star &&& map decr) \$ xs
star n = if n > 0 then '*' else ' '
decr n = if n > 0 then n-1 else 0```
• 對於一行解有特別執著 XD
```import Data.List
import Data.Bool

histogramListComp ns = intercalate "\n" [[bool ' ' '*' (x `elem` ys) | x <- [0..9]] | ys <- reverse (transpose (group (sort ns)))] ++ "\n==========\n0123456789\n"

histogramCrypticRowMajor = (++ "\n==========\n0123456789\n") . intercalate "\n" . map (zipWith (\$) (map ((bool ' ' '*' .) . elem) [0..9]) . repeat) . reverse . transpose . group . sort

histogramCrypticColMajorBuggy = (++ "\n==========\n0123456789\n") . intercalate "\n" . filter ('*' `elem`) . reverse . transpose . map ((++ replicate 1000 ' ') . (`replicate` '*')) . zipWith (\$) (map ((length .) . filter . (==)) [0..9]) . repeat

_ = histogramListComp [1,4,5,4,6,6,3,4,2,4,9]
_ = histogramCrypticRowMajor [1,4,5,4,6,6,3,4,2,4,9]
_ = histogramCrypticColMajorBuggy [1,4,5,4,6,6,3,4,2,4,9]```
• unfold + fold!
• 統計：畫正字依序去累加每種數字的數量
• 畫圖：量身高大法
```histogram :: [Int] -> String
histogram =  addFootter . unlines . graph . tally where
addFootter s = s ++ "==========\n0123456789\n"

tally :: [Int] -> [(Int, Int)]
tally = foldl' accu ary where
ary = zip [0..9] (repeat 0)
tInc x t@(i, n) = if i == x then (i, n + 1) else t
accu xs x = map (tInc x) xs

graph :: [(Int, Int)] -> [String]
graph xs = unfoldr row height where
height = foldr (max . snd) 0 xs
col n = map (\t -> if snd t >= n then '*' else ' ') xs
row 0 = Nothing
row h = Just(col h, h - 1)```
• 統計：先 `sort``group`
• 畫圖：transpose 大法
```histogram :: [Int] -> String
histogram = unlines . reverse . putNumber . transpose . mkLines
where putNumber = ("0123456789" :) . ("==========" :)

mkLines :: [Int] -> [String]
mkLines = graph . group . sort . ([0..9] ++)

graph :: [[Int]] -> [String]
graph = fst . (foldr graph' ([], 0))
where graph' xs (ys, prevLen) = ((take len (mkStar xs)):ys, len)
where len = max prevLen (length xs)

mkStar :: [Int] -> String
mkStar = (++ repeat ' ') . tail . map (const '*')```
• 是野生的遞迴！！！！
• 統計：畫正字依序去累加每種數字的數量
• 畫圖：水淹量身高大法
```stat :: [Int] -> [Int]
stat []     = replicate 10 0
stat (x:xs) = (take x stats) ++ [stats !! x + 1] ++ tail (drop x stats)
where stats = stat xs

plot :: [Int] -> [String]
plot ys
| all (== 0) ys = []
| otherwise     = row : plot ys'
where row = map (\y -> if y == 0 then ' ' else '*') ys
ys' = map (\y -> max 0 \$ y - 1) ys

histogram :: [Int] -> String
histogram xs = unlines \$ reverse \$ "0123456789" : "==========" : plot (stat xs)

{-
ghci> putStr \$ histogram [1,4,5,4,6,6,3,4,2,4,9]
*
*
* *
******  *
==========
0123456789
-}```
• 野生的遞迴 + fold
• 統計：畫正字依序去累加每種數字的數量（以函數的方式去儲存）
• 畫圖：量身高大法
```toRecord :: (Int -> Int) -> Int -> (Int -> Int)
toRecord r x y | x == y = (r x) + 1
| otherwise = r y

histogram :: [Int] -> String
histogram xs = unlines (f record max) ++ "==========\n0123456789\n"
where count = foldl toRecord (const 0) xs
record = map count [0..9]
max = maximum record

f :: [Int] -> Int -> [String]
f _ 0 = []
f record most = map (\x -> if x < most then ' ' else '*') record : (f record (most-1))```
• 統計：用 `filter``length` 去統計數量
• 畫圖：量身高大法
```histogram a = concat (map (++"\n") ([concat [if c!!j >= i then "*" else " " | j <- [0..9]] | i <- reverse [1..maximum c]] ++ ["==========", "0123456789"]))
where c = [length (filter (==i) a) | i <- [0..9]]```
• 統計：用 `filter``length` 去統計數量
• 畫圖：量身高大法
```numOccs :: [Int] -> [Int]
numOccs xs = map (\n -> length \$ filter (== n) xs) [0..9]

histogramLine :: [Int] -> Int -> String
histogramLine freqs bl = map (putc . (>= bl)) freqs
where putc cond = if cond then '*' else ' '

histogram :: [Int] -> String
histogram xs = unlines \$
(map (histogramLine freqs) (cbTo1 \$ maximum freqs)
++ footer)
where labels = "0123456789"
footer = [replicate (length labels) '=', labels]
freqs = numOccs xs
cbTo1 x = reverse [1 .. x]

{-
usage: putStr \$ histogram [...]
example:
> histogram [1,4,5,4,6,6,3,4,2,4,9]
*
*
* *
******  *
==========
0123456789
-}```
• 統計：先 `sort``group`
• 畫圖：transpose 大法
```module Week2 where

import Data.List

histogram :: [Int] -> String
histogram xs = (unlines . transpose \$ reverse <\$> histogram' xs) ++
unlines [ replicate 10 '=', ['0'..'9']]

histogram' :: [Int] -> [String]
histogram' xs = take (maxLength xs') . zipWith max manySpaces . (++ manySpaces) <\$> xs'
where xs' = starify  xs
manySpaces = repeat ' '

maxLength :: [[a]] -> Int
maxLength = foldr (max <\$> length) 0

starify :: [Int] -> [String]
starify xs = fmap (const '*') . tail <\$> group (sort \$ [0..9] ++ xs)```