Organizing matches between sports teams
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 -&gt; MatchSequence
all_matches n = [ (x,y) | y &lt;- [2..n], x &lt;- [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 -&gt; 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
addPrices :: MatchSequence -&gt; (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 &lt;- xs,
                    ys &lt;- take nbToKeep $
                            filter
                              ((&lt;= 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 -&gt; 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) -&gt; String
showResult (score,xs) = show score ++ " collisions: " ++ showMatchSequence xs

main = do
    args &lt;- getArgs
    mapM_ (putStrLn . showResult) $ find_best (read (head args)::Int)