Mired in code
Check-in [ca484881b2]
Not logged in
Public Repositories
mwm's Repositories

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Published version of the plus 1 analysis code.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:ca484881b2f04ca85521f400362f915f08b128ac
User & Date: mwm@mired.org 2011-12-31 02:13:21
Context
2013-03-16
03:56
Add my binary clock for Arduino. check-in: 48da261cc6 user: mwm@mired.org tags: trunk
2011-12-31
02:13
Published version of the plus 1 analysis code. check-in: ca484881b2 user: mwm@mired.org tags: trunk
2011-04-06
00:09
Update -destroy method to have correct parameters. check-in: c0bfb3546d user: mwm@mired.org tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added haskell/plus-1.hs.

































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
{-# LANGUAGE TupleSections #-}

import Control.Monad (liftM)
import Data.Char (toLower)
import Data.List (sort, foldl', find)
import Data.Tuple.HT (uncurry3)
import Network.HTTP (simpleHTTP, getRequest, getResponseBody)
import System.Environment (getArgs)
import Text.HTML.TagSoup (Tag (TagClose, TagOpen, TagText), parseTags,
                          partitions, fromTagText)
import Text.Printf (printf)

main =
  getArgs >>= genStats . makeYears >>= uncurry3 (printf format)
  where
    format = "Percentage of seasons with controversies using\n" ++ 
             "Poll: %d%%, Game: %d%%, Plus 1: %d%%\n"

makeYears :: [String] -> [Int]
makeYears args =
  case length args of
    1 -> [read (head args)]
    2 -> (\l -> [head l .. head $ tail l]) $ map read args
    otherwise -> error "Arguments must be first and optional last year."

genStats :: [Int] -> IO (Int, Int, Int)
genStats years = do
  pages <- mapM loadYear years
  return $ percents (foldl' counts (0, 0, 0) pages)
                    (fromIntegral $ length pages)
  where
    percents (a, b, c) l = (a % l, b % l, c % l)
    (%) a b = round $ 100 * a / b
    counts (a, b, c) (ab, bb, cb) = (minc a ab, minc b bb, minc c cb)
    minc x xb = x + if xb then 1 else 0


loadYear :: Int -> IO (Bool, Bool, Bool)
loadYear =
  liftM getYear . (>>= getResponseBody) . simpleHTTP . getRequest . makeURL
          
makeURL :: Show a => a -> String
makeURL year = "http://www.jhowell.net/cf/cf" ++ show year ++ ".htm"

getYear :: String -> (Bool, Bool, Bool)
getYear = controversy . sort . (\ (t, r) -> map (getData t) r) . getRows . getTable . parseTags

controversy :: [(Int, Int)] -> (Bool, Bool, Bool)
controversy records = (records !! 0 == records !! 1,
                       records !! 1 == records !! 2,
                       records !! 3 == records !! 4)

getData :: Bool -> [Tag String] -> (Int, Int)
getData True = (\gs -> (head gs, head $ tail gs)) 
               . map getLosses . take 2 . dropToLosses
getData False = (,0) . getLosses . head . dropToLosses

dropToLosses :: [Tag String] -> [[Tag String]]
dropToLosses = drop 8 . partitions (isOpenTag "td")

getLosses :: [Tag String] -> Int
getLosses = read . fromTagText . head . tail

getRows :: [[Tag String]] -> (Bool, [[Tag String]])
getRows rs = (isTies (head rs), tail rs)
  where isTies r = maybe False (\_ -> True) (find (== TagText "Ties") r)

getTable :: [Tag String] -> [[Tag String]]
getTable = partitions (isOpenTag "tr") . drop 2 
           . takeWhile (not . isCloseTag "table")
           . dropWhile (not . isOpenTag "table")

isOpenTag :: String -> Tag String -> Bool
isOpenTag tag (TagOpen t _) = map toLower t == tag
isOpenTag _ _ = False

isCloseTag :: String -> Tag String -> Bool
isCloseTag tag (TagClose t) = map toLower t == tag
isCloseTag _ _ = False