# Organize a tournament

Here is a real question somebody asked me. Suppose you have n teams, one terrain.

• Each team must play each other team exactly once.
• The number of times a team plays two matches in a row should be minimized.

The problem is hard if not optimized. Your program should be able to answer this question for up to 6 teams (at least) in a reasonable time (say less than an hour). For 5 teams I have a working program which works in less than a minute.

Here is an example for 5 teams.

$organize_for 5 [(3,5),(1,2),(4,5),(1,3),(2,4),(1,5),(2,3),(1,4),(2,5),(3,4)]  And another for 6 teams. $ organize_for 6
[(2,4),(1,5),(2,3),(1,6),(3,5),(1,4),(2,5),(1,3),(4,6),(1,2),(3,6),(4,5),(2,6),(3,4),(5,6)]


NB for 3 and 4 teams, you'll have at least two occurrences of a team playing two matches in a row.

To win: make the shortest program to answer this problem fast enough to give you a correct answer for 6 teams.

Bonuses:

1. The median of the median of the waiting time between two matches for all teams should be maximized. Example: from organize_for 5 ; nb match between the next one (sorted, median is the one in the center)

team 1 -> 1, 1, 1 (sorted => 1, 1, 1, median => 1)
team 2 -> 2, 1, 1 (sorted => 1, 1, 2, median => 1)
team 3 -> 2, 2, 2 (sorted => 2, 2, 2, median => 2)
team 4 -> 1, 2, 1 (sorted => 1, 1, 2, median => 1)
team 5 -> 1, 2, 2 (sorted => 1, 2, 2, median => 2)

medians: (1, 1, 2, 1, 2), sorted => (1, 1, 1, 2, 2)
median of the medians = 1.

2. Generalize for k terrains. All match have the same duration.

• The most important rules remains a team shouldn't do a match just after another.
• The global time for all matches should be minimized
• What's the winning criterion? Sep 13 '11 at 9:11
• Sorry about that. The idea is to have the shortest program possible. But it must also be fast enough to give you the answer for 6 teams. Sep 13 '11 at 14:55
• Where do the bonuses fit in? Sep 14 '11 at 13:37
• Pretty sure you need to tweak this -- as-is, I could post a program that simply outputs [(2,4),(1,5),(2,3),(1,6),(3,5),(1,4),(2,5),(1,3),(4,6),(1,2),(3,6),(4,5),(2,6),(3,4),(5,6)] and I would meet this entirely: "To win: make the shortest program to answer this problem fast enough to give you a correct answer for 6 teams." Sep 14 '11 at 16:25

Another solution which terminate only if there is a solution without any collision (5 and 6). It is also very fast:

import System.Environment
import Data.List
a n=[(x,y)|x<-[1..n],y<-[1..n],x<y]
s []=[[]]
s (m:[])=[[m]]
s ((x,y):(x',y'):xs )
|(x==x')||(x==y')||(y==x')||(y==y')=s((x,y):xs++[(x',y')])
|0<1=[(x,y):ys|ys<-s((x',y'):xs)]
main=do
args <- getArgs
print $head$ s $a (read(head args)::Int)  • This ain't even close to being golfed. I did the work of applying very simple transformations. See the golfed version here ideone.com/4NfWV Sep 14 '11 at 18:19 ## Python 282 247 chars import sys n=int(sys.argv[1])+1 r=range l=[(i,j)for i in r(1,n)for j in r(i+1,n)] m=[(),()] while l: o,p=h=l.pop(0);v=[] for k in r(len(m)-1):g=m[k]+m[k+1];v+=[o in g or p in g] m.insert(v.index(0)+1,h)if min(v)<1 else l.append(h) print m[1:-1]  UPD: working for n>4, for testing add: lst = m[1:-1] conflicts = 0 for i in range(len(lst)-1): if lst[i][0] in lst[i+1] or lst[i][1] in lst[i+1]: conflicts += 1 print 'Conflicts: {}'.format(conflicts)  Haskell 585 chars import System.Environment import Data.Ord import Data.List a::Int->[(Int,Int)] a n=[(x,y)|x<-[1..n],y<-[1..n],x<y] b::[(Int,Int)]->Int b ((x,y):((z,t):rest))|x==z=1+b ((z,t):rest) |x==t=1+b ((z,t):rest) |y==z=1+b ((z,t):rest) |y==t=1+b ((z,t):rest) |otherwise=b ((z,t):rest) b _=0 c l=(b l,l) d [] _=[[]] d l minimal=[x:s|x<-l,s<-take 10$ filter (\ts->b ts<minimal) (d (delete x l) minimal)]
e n minimal=take 1 $sortBy (comparing fst)$ map c (d (a n) minimal)
f []=False
f _=True
g n=head $filter f$ map (e n) [0..]
main = do
args<-getArgs
print $g (read (head args)::Int)  Here is the non code golfed version: import System.Environment import Data.Ord import Data.List all_matches :: Int -> [(Int,Int)] all_matches n = [ (x,y) | x <- [1..n], y <- [1..n], x < y ] price :: [(Int,Int)] -> Int price ((x,y):((z,t):rest)) | x==z = 1 + price ((z,t):rest) | x==t = 1 + price ((z,t):rest) | y==z = 1 + price ((z,t):rest) | y==t = 1 + price ((z,t):rest) | otherwise = price ((z,t):rest) price _ = 0 addPrices xs = (price xs, xs) myPerm [] _ = [[]] myPerm xs minimal = [x:ys | x <- xs, ys <- take 10$ filter (\ts -> price ts < minimal) (myPerm (delete x xs) minimal)]

find_best_under n minimal = take 1 $sortBy (comparing fst)$ map addPrices ( myPerm (all_matches n) minimal)

isNonEmpty [] = False
isNonEmpty _ = True

find_best n = head $filter isNonEmpty$ map (find_best_under n) [0..]

main = do
args <- getArgs
putStrLn $show$ find_best (read (head args)::Int)


It only search for local optima. But in this case, local optima are also global one up to 6 teams.

• Hui... You can golf much better: Use the legacy haskell98 imports, like import List; import System, there is no legacy module for Ord though. Shorten all variable names to a single character, replace otherwise by 0<1, usw. Sep 13 '11 at 11:56