Skip to content

Instantly share code, notes, and snippets.

@banacorn
Last active May 10, 2018 08:24
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save banacorn/8a33a1d56572f78a5afb10681530adb8 to your computer and use it in GitHub Desktop.
Save banacorn/8a33a1d56572f78a5afb10681530adb8 to your computer and use it in GitHub Desktop.

Summary of Week 2 - Histogram

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

Solutions

  1. Yu-Hsi Chiang https://gist.github.com/arbuztw/fbf0600b14a09c49472d4ba53480857a
  • 統計:用 filterlength 去統計數量
  • 畫圖:量身高大法
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 ' '
  1. 郭宗霆 https://gist.github.com/jc99kuo/652f5ac2a8118ae1717a66e4cbea93cb
  • 統計:用 filterlength 去統計數量
  • 畫圖:量身高大法
--  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])
-}
  1. Shin-Cheng Mu https://gist.github.com/scmu/f673586e1e4a6bc3e30a957e3cf8d4a2
  • 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
  1. Jensen Holder https://gist.github.com/shhyou/087a8558908ee4593f4eb5f7e447cfc5
  • 對於一行解有特別執著 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]
  1. Tai An Su https://gist.github.com/taiansu/c95a61da3d2dc28a8a7798cd3c1fcfee
  • 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)
  1. Yu-Ren Pan https://gist.github.com/YuRen-tw/b4efa55f68cf04be76996eda6b2fdb1f
  • 統計:先 sortgroup
  • 畫圖: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 '*')
  1. 洪崇凱 https://gist.github.com/RedBug312/2a0ae0f95cfc42a41f5476913a2db215
  • 是野生的遞迴!!!!
  • 統計:畫正字依序去累加每種數字的數量
  • 畫圖:水淹量身高大法
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
-}
  1. 林子期 https://gist.github.com/Zekt/b6b28e8b60723239b4123ec98a4e4c6e
  • 野生的遞迴 + 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))
  1. 林書瑾 https://gist.github.com/BookGin/96a217b8eb484391146f67d932241381
  • 統計:用 filterlength 去統計數量
  • 畫圖:量身高大法
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]]
  1. 潘廣霖 https://gist.github.com/andy0130tw/d0db9bf9c0ddf77f8b97de2a84cd3424
  • 統計:用 filterlength 去統計數量
  • 畫圖:量身高大法
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
-}
  1. 陳亮廷 https://gist.github.com/liang-ting-chen/beea1239ee6c137c61fa00499d37301b
  • 統計:先 sortgroup
  • 畫圖:transpose 大法
module Week2 where

import Data.List
import Control.Monad

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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment