fork(4) download
copy 
  1. {-
  2.     Round-robin Scheduling Algorithm [Simple]
  3.     <https://e...content-available-to-author-only...a.org/wiki/Round-robin_tournament#Scheduling_algorithm>
  4.  
  5.     An algorithm for creates a fair schedule.
  6.  
  7.     Usage:
  8.     - list is a collection (list) of the participants
  9.  
  10.     Example, [1, 2, 3, 4]
  11.  
  12.     printOut [1, 2, 3, 4]
  13.     =>  Round 1
  14.         1 vs 4
  15.         2 vs 3
  16.  
  17.         Round 2
  18.         1 vs 3
  19.         4 vs 2
  20.  
  21.         Round 3
  22.         1 vs 2
  23.         3 vs 4
  24.  
  25.     NOTE: This algorithm will be improved later using Berger tables.
  26. -}
  27.  
  28. module Main where
  29.  
  30.   -- Rotate participants on a List
  31.   rotater :: [a] -> [a]
  32.   rotater list =
  33.     let n      = length list
  34.         middle = n `div` 2
  35.         divide = splitAt middle list
  36.         left   = fst divide
  37.         right  = (reverse . snd) divide
  38.         left'  = (head left) : (head right) : (init . tail) left
  39.         right' = (tail right) ++ [last left]
  40.     in left' ++ (reverse right')
  41.  
  42.   -- Create the schedule. Here is the main Round-robin Schedule Algorithm
  43.   schedulizer :: [a] -> [[(a, a)]]
  44.   schedulizer list = makesSchedule list (length list) (-1)
  45.     where
  46.       makesSchedule :: [a] -> Int -> Int -> [[(a, a)]]
  47.       makesSchedule _ _ 0        = []
  48.       makesSchedule list n games =
  49.         let games'  = if games == (-1)
  50.                         then do
  51.                           if even n then (n - 1) else n
  52.                         else games
  53.  
  54.             middle  = n `div` 2
  55.             divide  = splitAt middle list
  56.  
  57.             left  = fst divide
  58.             right = if even n
  59.                        then (reverse . snd) divide
  60.                        else (reverse . init . snd) divide
  61.  
  62.             zipped = zip left right
  63.         in [zipped] ++ makesSchedule (rotater list) n (games' - 1)
  64.  
  65.   -- Collect data in one round
  66.   collect :: (Show a) => [(a, a)] -> [String]
  67.   collect []     = []
  68.   collect (x:xs) =
  69.     let home = fst x
  70.         away = snd x
  71.     in [(show home) ++ " vs " ++ (show away)] ++ collect xs
  72.  
  73.   -- Beautify the Output
  74.   beautifyOut :: (Show a) => [a] -> [String]
  75.   beautifyOut list = beautifySchedule (schedulizer list) 0 (-1)
  76.     where
  77.       beautifySchedule :: (Show a) => [[(a, a)]] -> Int -> Int -> [String]
  78.       beautifySchedule _ _ 0         = []
  79.       beautifySchedule list i rounds =
  80.         let rounds' = if rounds == (-1)
  81.                         then do
  82.                           let n = length list
  83.                           if even n then (n - 1) else n
  84.                         else rounds
  85.             play    = (unlines . collect) (list !! i)
  86.  
  87.         in ([ "Round " ++ (show $ i + 1) ++ "\n" ++ play]
  88.            ++ beautifySchedule list (i + 1) (rounds' - 1))
  89.  
  90.   -- Print out the result
  91.   printOut :: (Show a) => [a] -> IO ()
  92.   printOut list =
  93.     let schedule = beautifyOut list
  94.     in (putStr . unlines) schedule
  95.  
  96.   main = do
  97.     let list = [1..14]
  98.     printOut list
Success #stdin #stdout 0s 4720KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Round 1
1 vs 14
2 vs 13
3 vs 12
4 vs 11
5 vs 10
6 vs 9
7 vs 8

Round 2
1 vs 13
14 vs 12
2 vs 11
3 vs 10
4 vs 9
5 vs 8
6 vs 7

Round 3
1 vs 12
13 vs 11
14 vs 10
2 vs 9
3 vs 8
4 vs 7
5 vs 6

Round 4
1 vs 11
12 vs 10
13 vs 9
14 vs 8
2 vs 7
3 vs 6
4 vs 5

Round 5
1 vs 10
11 vs 9
12 vs 8
13 vs 7
14 vs 6
2 vs 5
3 vs 4

Round 6
1 vs 9
10 vs 8
11 vs 7
12 vs 6
13 vs 5
14 vs 4
2 vs 3

Round 7
1 vs 8
9 vs 7
10 vs 6
11 vs 5
12 vs 4
13 vs 3
14 vs 2

Round 8
1 vs 7
8 vs 6
9 vs 5
10 vs 4
11 vs 3
12 vs 2
13 vs 14

Round 9
1 vs 6
7 vs 5
8 vs 4
9 vs 3
10 vs 2
11 vs 14
12 vs 13

Round 10
1 vs 5
6 vs 4
7 vs 3
8 vs 2
9 vs 14
10 vs 13
11 vs 12

Round 11
1 vs 4
5 vs 3
6 vs 2
7 vs 14
8 vs 13
9 vs 12
10 vs 11

Round 12
1 vs 3
4 vs 2
5 vs 14
6 vs 13
7 vs 12
8 vs 11
9 vs 10

Round 13
1 vs 2
3 vs 14
4 vs 13
5 vs 12
6 vs 11
7 vs 10
8 vs 9
https://ideone.com/CSezGe
language:
Haskell (ghc 8.4.4)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!