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
|
import Control.Monad (forM_)
import Data.Function (on)
import Data.List (sortBy, unfoldr)
import System.Random (RandomGen, randoms, getStdGen, split)
import Data.HashSet (HashSet, fromList, member)
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
]
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)
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))
(g1, g2) = split g
main = do
g <- getStdGen
let matches = iterativeMatchPlayers g players !! 1010
forM_ matches $ \(p, q) ->
putStrLn $ p ++ " vs. " ++ q
|
