Организации матчей между спортивными командами


Как я мог бы улучшить этот алгоритм? Цель состоит в том, чтобы организовать матчи между спортивных команд, таких, что:

  • Каждая команда оскорбляют друг друга
  • Минимальное количество команды должны начать матч после окончания одной

Самая интересная часть-это здесь:

myPerm [] _ = [[]]
myPerm xs threshold = [x:ys | x <- xs,
                    ys <- take nbToKeep $
                            filter
                              (\ts -> price ts <= threshold)
                              (myPerm (delete x xs) threshold)]

Это способ удалить из перечисления перестановок всех суб-последовательности не достаточно хорошо. Даже с этим, проблема на 6 команды очень долго не могли устранить.

Вот полная программа:

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)

Я знаю, что я делать линейный ряд вычислений с помощью цен, пока, я не должен нуждаться в этом, если я интегрирую цена вычислений внутри myPerm функции.

Я принимаю все советы, касающиеся не только стиль, но и sytactic оптимизаций. Например, я уверен, что я мог бы использовать монаду чтобы найти первая П , для которых существует решение.



393
2
задан 13 сентября 2011 в 12:09 Источник Поделиться
Комментарии
1 ответ

Нет алгоритмического улучшения, просто какой-то косметики...

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
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
((<= 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)

1
ответ дан 15 сентября 2011 в 07:09 Источник Поделиться