Discussion on: Daily Challenge #174 - Soccer League Table

View post

Well, I attempted this in Haskell. I took the liberty of making each function return a Maybe value, being Nothing when the team isn't in the table instead of defaulting to 0. It uses a state monad to make storing and "mutating" data feasible. I decided to implement my own state monad here, but there are (better) implementations on stackage.

module SoccerLeague ( Game, Name, Team, League
                    , empty, push, points
                    , goalsFor, goalsAgainst, goalDifference
                    , wins, draws, losses
                    , State, runState
                    ) where

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Bifunctor (bimap)
import Data.Tuple (swap)
import Data.Maybe (fromMaybe)
import Data.Bool (bool)
import Text.ParserCombinators.Parsec ( GenParser, ParseError, parse, many1
                                     , digit, letter, string, space, (<|>))

type Name = String

data Team = Team { t_name :: Name
                 , t_goalsFor :: Int
                 , t_goalsAgainst :: Int
                 , t_wins :: Int
                 , t_draws :: Int
                 , t_losses :: Int
                 } deriving Show

type League = Map Name Team

type Game = ((Name, Int), (Name, Int))

updateTeam :: Name -> (Int, Int) -> State League ()
updateTeam name (for, against) = do
  map <- get
  let t = fromMaybe (Team name 0 0 0 0 0) $ map M.!? name
  let t' = Team { t_name = name
                , t_goalsFor = t_goalsFor t + for
                , t_goalsAgainst = t_goalsAgainst t + against
                , t_wins = t_wins t + bool 0 1 (for > against)
                , t_draws = t_draws t + bool 0 1 (for == against)
                , t_losses = t_losses t + bool 0 1 (for < against)
                }
  put $ M.insert name t' map

empty :: League
empty = M.empty

push :: String -> State League ()
push str = case parseGame str of
  Left e -> error $ "bad push input: " ++ str
  Right ((n1, s1), (n2, s2)) -> do
    updateTeam n1 (s1, s2)
    updateTeam n2 (s2, s1)

-- Lifts a simple function on a team in the league to work on the state
liftToState :: (Team -> a) -> String -> State League (Maybe a)
liftToState f name = get >>=
                     return . fmap f . (flip (M.!?) name)

points :: String -> State League (Maybe Int)
points = liftToState $ sum . flip fmap [(*3) . t_wins, t_draws] . flip ($)

goalsFor :: String -> State League (Maybe Int)
goalsFor = liftToState t_goalsFor

goalsAgainst :: String -> State League (Maybe Int)
goalsAgainst = liftToState t_goalsAgainst

goalDifference :: String -> State League (Maybe Int)
goalDifference = liftToState (\team -> t_goalsFor team - t_goalsAgainst team)

wins :: String -> State League (Maybe Int)
wins = liftToState t_wins

draws :: String -> State League (Maybe Int)
draws = liftToState t_draws

losses :: String -> State League (Maybe Int)
losses = liftToState t_losses

-- GAME STRING PARSER
trimSpaces :: String -> String
trimSpaces = f . f
  where f = dropWhile (==' ') . reverse

number :: GenParser Char st Int
number = many1 digit >>= return . read

name :: GenParser Char st Name
name = many1 (letter <|> space) >>= return . trimSpaces

game :: GenParser Char st Game
game = do
  fstName <- name
  fstScore <- number
  string " - "
  sndScore <- number
  sndName <- name
  return ((fstName, fstScore), (sndName, sndScore))

parseGame :: String -> Either ParseError Game
parseGame = parse game "(unknown)"

-- STATE MONAD IMPLEMENTATION
newtype State s a = State { runState :: s -> (s, a) }

instance Functor (State s) where
  fmap f (State x) = State $ bimap id f . x

instance Applicative (State s) where
  pure x = State $ \s -> (s, x)
  (State sf) <*> (State sx) = State $ \s -> let (s', f) = sf s
                                                (s'', x) = sx s
                                            in  (s'', f x)

instance Monad (State s) where
  return = pure
  sx >>= f = State $ \s -> let (s', x) = runState sx s
                           in  runState (f x) s'

get :: State s s
get = State $ \x -> (x, x)

put :: s -> State s ()
put s = State $ const (s, ())

Additionally, here's the example given in the post translated to my Haskell implementation:

import SoccerLeague
import Data.Maybe (fromMaybe)

example :: State League [Int]
example = do
  push "Man Utd 3 - 0 Liverpool"
  l1 <- sequence [goalsFor "Man Utd", points "Man Utd", points "Liverpool", goalDifference "Liverpool"]
  push "Liverpool 1 - 1 Man Utd"
  l2 <- sequence [goalsFor "Man Utd", points "Man Utd", points "Liverpool", goalsAgainst "Man Utd", points "Tottenham"]
  return $ map (fromMaybe 0) $ l1 ++ l2

main :: IO ()
main = do
  sequence_ $ map print $ snd $ runState example empty