5
\$\begingroup\$

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
\$\endgroup\$
  • 3
    \$\begingroup\$ What's the winning criterion? \$\endgroup\$ – Peter Taylor Sep 13 '11 at 9:11
  • \$\begingroup\$ 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. \$\endgroup\$ – yogsototh Sep 13 '11 at 14:55
  • \$\begingroup\$ Where do the bonuses fit in? \$\endgroup\$ – Briguy37 Sep 14 '11 at 13:37
  • 1
    \$\begingroup\$ 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." \$\endgroup\$ – Matthew Read Sep 14 '11 at 16:25
1
\$\begingroup\$

Haskell: 291 chars

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)
\$\endgroup\$
  • \$\begingroup\$ 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 \$\endgroup\$ – Thomas Eding Sep 14 '11 at 18:19
1
\$\begingroup\$

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)
\$\endgroup\$
0
\$\begingroup\$

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.

\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – FUZxxl Sep 13 '11 at 11:56

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.