-
- #!/usr/bin/env stack
- -- stack --resolver lts-8.0 script
- {-# LANGUAGE OverloadedStrings #-}
- {-# LANGUAGE ScopedTypeVariables #-}
- {-# LANGUAGE DeriveGeneric #-}
-
- import Graphics.Rendering.Chart.Easy
- import Graphics.Rendering.Chart.Backend.Cairo
- import System.Environment
- import Data.Colour (opaque)
- import Data.Colour.SRGB (sRGB24read)
- import GHC.Generics (Generic)
- import qualified Data.HashTable.IO as H
- import qualified Data.Csv as C
- import qualified Data.ByteString.Lazy as BL
- import qualified Data.ByteString.Char8 as B
- import Control.Monad (forM_, when)
- import Data.Hashable
- import Data.List (sortBy)
-
- type HashTable k v = H.BasicHashTable k v
-
- data Girl = Blake
- | Cinder
- | Deerie
- | Emerald
- | Ilia
- | Neo
- | Nora
- | Penny
- | Pyrrha
- | Ruby
- | Shadowperson
- | Weiss
- | Winter
- | Yang deriving (Show, Read, Eq, Enum, Ord, Generic)
-
- instance Hashable Girl
-
- data Other = Geist
- | Ironwood
- | Jaune
- | Mercury
- | Nonanswer
- | Nuckelavee
- | Other
- | Port
- | Qrow
- | Ren
- | Roman
- | Shopkeep
- | Tyrian
- | Zwei
- | Bad deriving (Show, Read, Eq, Enum, Ord, Generic)
-
- instance Hashable Other
-
- data Character = IsGirl Girl
- | NotGirl Other deriving (Show, Read, Eq, Generic, Ord)
-
- simpleShow :: Character -> String
- simpleShow (IsGirl g) = show g
- simpleShow (NotGirl o) = show o
-
- isGirl :: Character -> Bool
- isGirl (IsGirl _) = True
- isGirl _ = False
-
- instance C.FromField Character where
- parseField s = case filter ((`B.isInfixOf` s) . B.pack . show) [Blake .. ] of
- x:_ -> pure $ IsGirl x
- [] -> case filter ((`B.isInfixOf` s) . B.pack . show) [Geist .. ] of
- x:_ -> pure $ NotGirl x
- [] -> mempty
-
- instance C.ToField Character where
- toField = C.toField . simpleShow
-
- instance Hashable Character
-
- chartColors :: [AlphaColour Double]
- chartColors = map (opaque . sRGB24read)
- [ "#4f894a"
- , "#a540c5"
- , "#70d65d"
- , "#6158bb"
- , "#cbd352"
- , "#472b53"
- , "#d28b3b"
- , "#799fc2"
- , "#d54c3d"
- , "#85d4b7"
- , "#c5447e"
- , "#877e3b"
- , "#c88bc1"
- , "#3e4b3d"
- , "#d1b39a"
- , "#814238"
- , "#6a92be"
- , "#c8d63d"
- , "#8b4acb"
- , "#6ad258"
- , "#cd478f"
- , "#6dcdb5"
- , "#d54938"
- , "#483068"
- , "#bed184"
- , "#ba85c5"
- , "#cd993b"
- , "#424439"
- , "#c6b4af"
- , "#762e39"
- , "#577a3b"
- , "#b77253"
- , "#cdcf50"
- , "#653bba"
- , "#77d545"
- , "#cb4dc5"
- , "#7ad78c"
- , "#bc4577"
- , "#59803e"
- , "#726cbe"
- , "#c38339"
- , "#48284a"
- , "#7dcbbe"
- , "#c34839"
- , "#6c93b4"
- , "#524732"
- , "#ca94b7"
- , "#ccb491"
- , "#af7958"
- , "#673ebd"
- , "#c8d845"
- , "#cb4dc4"
- , "#66cc5b"
- , "#c55384"
- , "#71cdb1"
- , "#cf4a3a"
- , "#6495b3"
- , "#d3973a"
- , "#9080cf"
- , "#abb86d"
- , "#48315d"
- , "#ceb7bc"
- , "#612f2c"
- , "#445c38"
- ]
-
- barFrom :: String -> String -> FileOptions -> Int -> Int
- -> [(Character, Int)] -> IO ()
- barFrom baseName title fo upper lower rawDat =
- toFile fo (baseName ++ "-bar-" ++ (show lower) ++ "-" ++ (show upper) ++ ".png") $ do
- let titleSuffix = if lower == 0 then "Top " ++ show upper else show (lower+1) ++ " to " ++ show upper
- dat = drop lower $ take upper rawDat
- toBar (k, v) (ks, vs) = ((simpleShow k):ks, v:vs)
- (titles, barData) = foldr toBar ([], []) dat :: ([String], [Int])
- indexAndOffset = map (\(n, l) -> (n, replicate n 0 ++ l)) . zip [0..] . map (:[])
- mkstyle c = (solidFillStyle c, Nothing)
- bPlot = do
- (b :: PlotBars Int Int) <- (bars [] (indexAndOffset barData))
- pure $ b & plot_bars_style .~ BarsStacked
- & plot_bars_spacing .~ BarsFixGap 5 5
- & plot_bars_item_styles .~ map mkstyle (cycle $ drop lower $ take upper chartColors)
-
- layout_title .= title ++ titleSuffix
- layout_x_axis . laxis_generate .= autoIndexAxis titles
- layout_x_axis . laxis_override .= (\x -> x & axis_labels .~ [zip [0..] titles])
- plot $ plotBars <$> bPlot
-
- main :: IO ()
- main = do
- rawDat <- getData
- outFile <- head <$> tail <$> getArgs
-
- case rawDat of
- (Left s) -> print s
- (Right (inc, girls)) -> do
- let bigDef = def & fo_size .~ (1280, 720)
- & fo_format .~ PNG
- titleInc = "r/RWBY Moderator Application Best Girl Responses (Inclusive) "
- titleGirl = "r/RWBY Moderator Application Best Girl Responses (Only actual girls from RWBY) "
- sortFst = sortBy (\l r -> compare (fst l) (fst r))
- merge [] [] acc = acc
- merge ((k1, v1):as) [] acc = merge as [] $ (k1, v1, 0):acc
- merge [] ((k2, v2):bs) acc = merge [] bs $ (k2, 0, v2):acc
- merge a@((k1, v1):as) b@((k2, v2):bs) acc =
- case compare k1 k2 of
- EQ -> merge as bs $ (k1, v1, v2):acc
- LT -> merge as b $ (k1, v1, 0):acc
- GT -> merge a bs $ (k2, 0, v2):acc
-
- BL.writeFile (outFile ++ "-dump.csv") $ C.encode $ merge (sortFst inc) (sortFst girls) []
-
- barFrom outFile titleGirl bigDef 14 0 girls
- barFrom outFile titleInc bigDef 15 0 inc
- barFrom outFile titleInc bigDef 29 15 inc
-
- getData :: IO (Either String ([(Character, Int)], [(Character, Int)]))
- getData = do
- csvName <- head <$> getArgs
- csv <- BL.readFile csvName
- inclusive <- H.new :: IO (HashTable Character Int)
- girls <- H.new :: IO (HashTable Character Int)
- let dat = C.decode C.NoHeader csv
- update h v = do
- check <- H.lookup h v
- case check of
- (Just n) -> H.insert h v (n + 1)
- Nothing -> H.insert h v 1
- case dat of
- (Left s) -> pure $ Left s
- (Right d) -> do
- forM_ d $ \(inc, exc) -> do
- update inclusive inc
- when (isGirl exc) (update girls exc)
- let sortSnd = sortBy (\l r -> compare (snd r) (snd l))
- lhs <- fmap sortSnd $ H.toList inclusive
- rhs <- fmap sortSnd $ H.toList girls
- pure $ Right (lhs, rhs)
-