Skip to content
This repository
Browse code

a first attempt at ffaElimination, fails for unevenness at the moment

  • Loading branch information...
commit 4c7381536bdcc9f07efb2df1423abd9da736f42b 1 parent 2bd133b
Eirik Albrigtsen authored March 10, 2012

Showing 1 changed file with 51 additions and 45 deletions. Show diff stats Hide diff stats

  1. 96  tournament.hs
96  tournament.hs
@@ -18,11 +18,12 @@ module Tournament (
18 18
    , duelValid         -- :: Int -> (Int, Int) -> Bool
19 19
 
20 20
    -- * Group helpers
21  
-   , inGroupsOf        -- :: Int -> Int -> [[Int]]
22  
-   , robin             -- :: Int -> [[(Int, Int)]]
  21
+   , inGroupsOf        -- :: Int -> Int -> [Group]
  22
+   , robin             -- :: Int -> [RobinRound]
23 23
 
24 24
    -- * Duel eliminationOf
25  
-   , eliminationOf     -- :: Elimination -> Int -> [Match]
  25
+   , eliminationOf     -- :: Elimination -> Int -> Tournament
  26
+   , scoreElimination  -- :: Tournament -> Match -> Tournament
26 27
 
27 28
 
28 29
    -- * TODO: what to do here?
@@ -74,28 +75,27 @@ duelValid n (a, b) = odd a && even b && a + b == 1 + 2^n
74 75
 
75 76
 -- -----------------------------------------------------------------------------
76 77
 -- Group helpers
77  
-
  78
+type Group = [Int]
78 79
 -- | Splits a numer of players into groups of as close to equal seeding sum
79 80
 -- as possible. When groupsize is even and s | n, the seed sum is constant.
80  
-inGroupsOf :: Int -> Int -> [[Int]]
  81
+inGroupsOf :: Int -> Int -> [Group]
81 82
 0 `inGroupsOf` _ = []
82 83
 n `inGroupsOf` s = map (sort . filter (<=n) . makeGroup) [1..ngrps] where
83 84
   ngrps = ceiling $ fromIntegral n / fromIntegral s
84 85
   s' = s - head (filter (\x -> n > ngrps*(s-1-x)) [0..]) -- reduce s if unfillable
85 86
   n' = ngrps*s' -- n if filled groups != n (10 inGroupsOf 4 uses n' = 12)
86  
-  nppg = s' `div` 2 -- num pair per group
87  
-  np = nppg * ngrps  -- total num pairs
88  
-  ps = take np $ zip [1..] [n', n'-1..] -- all the pairs
89  
-  rem = [np+1, np+2 .. n'-np] -- e in [1..n'] \\ ps
90  
-  makeGroup i = concatMap (\(x,y) -> [x,y]) pairs ++ left where
91  
-    pairs = filter ((`elem` [i, i+ngrps .. i+np]) . fst) ps
92  
-    left = if length rem >= i then [rem !! (i-1)] else []
93  
-
94  
-
  87
+  npairs = (s' `div` 2) * ngrps
  88
+  pairs = zip [1..npairs] [n', n'-1..]
  89
+  rem = [npairs+1, npairs+2 .. n'-npairs] -- [1..n'] \\ e in pairs
  90
+  makeGroup i = leftover ++ concatMap (\(x,y) -> [x,y]) gpairs where
  91
+    gpairs = filter ((`elem` [i, i+ngrps .. i+npairs]) . fst) pairs
  92
+    leftover = take 1 $ drop (i-1) rem
  93
+
  94
+type RobinRound = [(Int, Int)]
95 95
 -- | Round robin schedules a list of n players and returns
96 96
 -- a list of rounds (where a round is a list of pairs). Uses
97 97
 -- http://en.wikipedia.org/wiki/Round-robin_tournament#Scheduling_algorithm
98  
-robin :: Int -> [[(Int, Int)]]
  98
+robin :: Int -> [RobinRound]
99 99
 robin n = map (filter notDummy . toPairs) rounds where
100 100
   n' = if odd n then n+1 else n
101 101
   m = n' `div` 2 -- matches per round
@@ -123,11 +123,11 @@ data Match = Match {
123 123
 } deriving (Show, Eq)
124 124
 
125 125
 data Elimination = Double | Single deriving (Show, Eq, Ord)
126  
-
  126
+type Tournament = [Match]
127 127
 
128 128
 -- | Create match shells for an elimination tournament
129 129
 -- hangles walkovers and leaves the tournament in a stable initial state
130  
-eliminationOf :: Elimination -> Int -> [Match]
  130
+eliminationOf :: Elimination -> Int -> Tournament
131 131
 e `eliminationOf` np
132 132
   -- Enforce >2 players for a tournament. It is possible to extend to 2, but:
133 133
   -- 2 players Single <=> a best of 1 match
@@ -204,6 +204,31 @@ e `eliminationOf` np
204 204
         lb = lbr1 ++ lbr2 ++ lbRest ++ gfms
205 205
     in if e == Single then wb else wb ++ lb
206 206
 
  207
+-- | Update an Elimination tournament by passing in a scored match
  208
+-- returns an updated tournament with the winner propagated to the next round,
  209
+-- and the loser propagated to the loser bracket if applicable.
  210
+scoreElimination :: Tournament -> Match -> Tournament
  211
+scoreElimination t m = 
  212
+  let e = if null $ filter ((== Losers) . brac . locId) t then Single else Double
  213
+      l = locId m
  214
+      mo = head $ filter ((== l) . locId) t
  215
+  in t
  216
+
  217
+
  218
+-- | Checks if a Tournament is valid
  219
+{-
  220
+tournamentValid :: Tournament -> Bool
  221
+tournamentValid t =
  222
+  let (wb, lb) = partition ((== Winners) . brac . locId) r
  223
+      roundRightWb k = rightSize && uniquePlayers where
  224
+        rightSize = 2^(p-k) == length $ filter ((== k) . rnd . locId) wb
  225
+        uniquePlayers = 
  226
+      rountRightLb k = rightSize && uniquePlayers where
  227
+        rightSize = 2^(p - 1 - (k+1) `div` 2) == length $ filter ((== k) . rnd . locId) lb
  228
+
  229
+  in all $ map roundRightWb [1..2^p]
  230
+-}
  231
+
207 232
 -- | Create match shells for an FFA elimination tournament
208 233
 --ffaElimination :: Int -> Int -> [Match]
209 234
 ffaElimination gs adv np
@@ -215,35 +240,16 @@ ffaElimination gs adv np
215 240
   | adv >= gs = error "Need to eliminate at least one player a match in FFA elimination"
216 241
   | adv <= 0 = error "Need >0 players to advance per match in a FFA elimination"
217 242
   | otherwise =
218  
-  -- how many rounds do we need?
219  
-    let r1g = np `inGroupsOf` gs
220  
-        r1Match g i = Match { locId = l, players = g, scores = Nothing }
221  
-          where l = Location { brac = Winners, rnd = 1, num = i }
222  
-        r1 = zipWith toMatch r1g [1..length r1g]
223  
-
224  
-        emptyMatch r i  = Match { locId = l, players = take gs (repeat 0), scores = Nothing }
  243
+    let first = np `inGroupsOf` gs
  244
+        makeMatch r g i = Match { locId = l, players = g, scores = Nothing }
225 245
           where l = Location { brac = Winners, rnd = r, num = i }
  246
+        second = zipWith (makeMatch 1) first [1..]
226 247
 
227  
-        --can probably scanl with inGroupsOf
228  
-        --what do i actually want to do? if 15np with 3gs, kill 2 => 6 left => 2x3
229  
-        --then killing 2 from those work out fine as 1 left in final
230  
-        --probably need what the group size is going to be in here, so need to detangle from inGroupsOf
231  
-        --12inGroupsOf3 kill 1 => 8 left .. bad
232  
-        --force some power rule for this? otherwise it cna get a bit messy..
233  
-        --but then it can also get fantastic with some custom setups with different sizes..
234  
-        --maybe specify num players you have, and group size you want, then upgrade to a model that works perfectly..
235  
-
236  
-    in  r1
237  
-
238  
-    --let p = (ceiling . logBase gs . fromIntegral) np -- np in [5..16] gives p == 2 and np' = 16
239  
-        --np' = gs^p
240  
-        -- i.e. this is useful only if ppm == 1. if ppm == 2 then we'd be left with 8 in r2, 4 in R3
241  
-
242  
-        --rose wine
243  
-        --copparberg
244  
-
245  
-
246  
-
247  
-
  248
+        nextGroup g = left `inGroupsOf` gs where
  249
+          left = adv * length g
248 250
 
  251
+        final = [gs `inGroupsOf` gs]
  252
+        gps = takeWhile ((>1) . length) $ iterate nextGroup first
  253
+        allGps = gps ++ final
249 254
 
  255
+    in allGps

0 notes on commit 4c73815

Please sign in to comment.
Something went wrong with that request. Please try again.