From 32032147aa5264987742f15f28889edfd117fd86 Mon Sep 17 00:00:00 2001 From: Kjetil Orbekk Date: Tue, 11 Aug 2015 11:00:17 -0400 Subject: Remove the haskell version. --- scheduling/Main.hs | 94 ------------------------------------------------------ 1 file changed, 94 deletions(-) delete mode 100644 scheduling/Main.hs diff --git a/scheduling/Main.hs b/scheduling/Main.hs deleted file mode 100644 index 3d08c30..0000000 --- a/scheduling/Main.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -import Debug.Trace -import Control.Monad (forM_) -import Data.Function (on) -import Data.List (sortBy, unfoldr, maximumBy) -import System.Random (RandomGen, randoms, getStdGen, split) -import Data.HashSet (HashSet, fromList, member) -import qualified Data.HashMap.Strict as M - -data Player = Player { name :: String - , rank :: Int - , matchLimit :: Int - } deriving (Show, Eq) - -players :: [Player] --- players = [ Player "orbekk" (-1) 4 --- , Player "ltsang" (-4) 4 --- , Player "sebh" 2 4 --- , Player "fringd" (-1) 4 --- , Player "sheyrax" (-2) 2 --- ] - -players = [Player "orbekk" (-1) 4 - , Player "sebh" 2 4 - , Player "ltsang" (-4) 4 - , Player "fringd" (-1) 4 - , Player "tysonjh" (-14) 4 - , Player "shreyax" (-2) 4 - , Player "bensley" (-16) 4 - , Player "taosong" 1 4 - , Player "jtnapoli" (-17) 4 - , Player "woojlee" (-7) 4 - , Player "binfu" 4 4 - , Player "wschudy" (-13) 3 - , Player "hoffstaetter" (-17) 4 - , Player "wwall" (-2) 3] - - -score :: M.HashMap String Player -> [(String, String)] -> [(String, String)] - -> Int -score players history [] = 0 -score players history ((p1, p2):ms) = - rankScore + recencyScore + score players history ms - where rankScore = 100 - 10 * (abs (getRank p1 - getRank p2)) - getRank p = rank (players M.! p) - recencyScore = -10 * length (filter (==(p1, p2)) history) - -shuffle :: (RandomGen g) => g -> [a] -> [a] -shuffle g xs = map snd $ sortBy (compare `on` fst) (zip rs xs) - where rs = randoms g :: [Int] - -matchOnce :: [String] -> [String] -> [(String, String)] -matchOnce (p:ps) (q:qs) - | p == q = matchOnce (p:ps) qs - | otherwise = (p', q') : matchOnce (filter (/=q) ps) (filter (/=p) qs) - where p' = min p q - q' = max p q -matchOnce _ _ = [] - -subtractMatches :: [(String, String)] -> [Player] -> [Player] -subtractMatches matches players = fmap subtractMatch players - where matchPlayers :: HashSet String - matchPlayers = fromList (map fst matches ++ map snd matches) - subtractMatch p - | (name p) `member` matchPlayers = - p { matchLimit = matchLimit p - 1 } - | otherwise = p - -matchPlayers :: (RandomGen g) => g -> [Player] -> [(String, String)] -matchPlayers _ [] = [] -matchPlayers _ [p] = [] -matchPlayers g players = matches ++ matchPlayers g3 nextPlayers - where matches = matchOnce (shuffle g1 playerNames) (shuffle g2 playerNames) - playerNames = fmap name players - (g', g1) = split g - (g2, g3) = split g' - nextPlayers = - filter ((>0) . matchLimit) (subtractMatches matches players) - -iterativeMatchPlayers :: (RandomGen g) => g -> [Player] -> [[(String, String)]] -iterativeMatchPlayers g players = unfoldr f (g, players) - where f (g, players) = Just (matchPlayers g1 players, (g2, players)) - where (g1, g2) = split g - -main = do - let n = 100000 - g <- getStdGen - let playerMap = M.fromList (map (\p -> (name p, p)) players) - let matchups = take n $ iterativeMatchPlayers g players - let matchup = maximumBy (compare `on` score playerMap []) matchups - forM_ matchup $ \(p, q) -> - putStrLn $ p ++ " vs. " ++ q - putStrLn $ "Score: " ++ show (score playerMap [] matchup) -- cgit v1.2.3