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
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.