# Organizing matches between sports teams

How could I improve this algorithm? The goal is to organize matches between sport teams such that:

• Each team affront each other
• A minimum number of team should start a match after just finishing one

The interesting part is here:

myPerm [] _ = [[]]
myPerm xs threshold = [x:ys | x <- xs,
ys <- take nbToKeep $filter (\ts -> price ts <= threshold) (myPerm (delete x xs) threshold)]  It is a way to remove from the enumeration of permutations all sub-sequences not being good enough. Even with this, the problem for 6 teams is very long to resolve. Here is the complete program: import System.Environment import Data.Ord import Data.List -- The number of items we keeps to only search -- from bests local results nbToKeep :: Int nbToKeep = 10 type Match = (Int,Int) type MatchSequence = [Match] -- Give all sport matches in the form -- (1,2) => match between Team 1 and Team 2 all_matches :: Int -> MatchSequence all_matches n = [ (x,y) | x <- [1..n], y <- [1..n], x < y ] -- A price function for sequence of matches -- 0 if no team make a match just after finishing one -- Possible with 5 teams not for 3 and 4 price :: MatchSequence -> 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 -- Simple adjoin the price to a MatchSequence addPrices :: MatchSequence -> (Int,MatchSequence) addPrices xs = (price xs, xs) -- Instead of listing _all_ permutations -- Just keep the one such that its subsequece price -- is under the threshold myPerm [] _ = [[]] myPerm xs threshold = [x:ys | x <- xs, ys <- take nbToKeep$
filter
(\ts -> price ts <= threshold)
(myPerm (delete x xs) threshold)]

-- Keep the best one under some threshold
find_best_under n threshold = take nbToKeep $sortBy (comparing fst)$
map addPrices ( myPerm (all_matches n) threshold)

isNonEmpty [] = False
isNonEmpty _ = True

-- Try to test with the minimal threshold (0)
-- Then repeat until a solution is found for some threshold
find_best n = head $filter isNonEmpty$ map (find_best_under n) [0..]

showMatchSequence :: MatchSequence -> String
showMatchSequence [] = []
showMatchSequence ((team1,team2):[]) = show team1 ++ "-" ++ show team2
showMatchSequence ((team1,team2):xs) = show team1 ++ "-" ++ show team2 ++ "   " ++ showMatchSequence xs

showResult :: (Int,MatchSequence) -> String
showResult (score,xs) = show score ++ " collisions: " ++ showMatchSequence xs

main = do
args <- getArgs
mapM_ (putStrLn . showResult) $find_best (read (head args)::Int)  I know I do a linear number of computation using price, while, I shouldn't need it if I integrate the price computation inside the myPerm function. I take all advice, concerning not only style but also sytactic optimisations. For example, I am pretty sure I could have used a Monad to find the first n for which there is a solution. ## 1 Answer No algorithmic improvement, just some cosmetics... import System.Environment import Data.Ord import Data.List -- The number of items we keeps to only search -- from bests local results nbToKeep :: Int nbToKeep = 10 type Match = (Int,Int) type MatchSequence = [Match] -- gives a different order, but I think this is okay all_matches :: Int -> MatchSequence all_matches n = [ (x,y) | y <- [2..n], x <- [1..(y-1)]] -- A price function for sequence of matches -- 0 if no team make a match just after finishing one -- Possible with 5 teams not for 3 and 4 price :: MatchSequence -> Int price xs = sum$ zipWith comp xs $tail xs where comp (x,y) (z,t) = fromEnum$ x==z || x==t || y==z || y==t

-- Simple adjoin the price to a MatchSequence
ys <- take nbToKeep $filter ((<= threshold).price) (myPerm (delete x xs) threshold)] -- Keep the best one under some threshold find_best_under n threshold = take nbToKeep$
sortBy (comparing fst) $map addPrices ( myPerm (all_matches n) threshold) -- Try to test with the minimal threshold (0) -- Then repeat until a solution is found for some threshold find_best n = head$ filter (not.null) $map (find_best_under n) [0..] showMatchSequence :: MatchSequence -> String showMatchSequence [] = [] showMatchSequence ((team1,team2):[]) = show team1 ++ "-" ++ show team2 --is this case needed? showMatchSequence ((team1,team2):xs) = show team1 ++ "-" ++ show team2 ++ " " ++ showMatchSequence xs showResult :: (Int,MatchSequence) -> String showResult (score,xs) = show score ++ " collisions: " ++ showMatchSequence xs main = do args <- getArgs mapM_ (putStrLn . showResult)$ find_best (read (head args)::Int)