m个舞者和n和领舞者跳舞
规则1:舞者不能和同一个领舞者跳两次以上
规则2:舞者不能跳同一个舞曲一次以上
求出所有组合
import Data.List
{-领舞者-}
type Leader = String
{-舞蹈-}
type Daunce = String
{-跳舞卡片-}
data Card = Card{leader::String
,daunce::String} deriving (Eq,Show)
{-舞者-}
data Follower = Follower{name::String
,cards::[Card]}deriving (Eq,Show)
rNoRepeatDaunce::Follower->Card->Bool
rNoRepeatDaunce (Follower _ []) _ = True
rNoRepeatDaunce (Follower _ cards) (Card _ d) = (find (==d) (map daunce cards))==Nothing
rNoEnoughLeader::[Card]->Leader->Bool
rNoEnoughLeader [] _ = True
rNoEnoughLeader cards leader' = let leaders = map leader cards
in
let count = sum $ [1 | l<-leaders, l== leader']
in
if count ==2
then False
else True
rOneDaunce::Follower->Daunce->Bool
rOneDaunce (Follower _ cards) d = [ 1 | (Card _ daunce) <-cards,daunce==d] == []
removeLeader::[Card]->Leader->[Card]
removeLeader [] _ = []
removeLeader lds l = [ ld | ld@(Card leader daunce) <- lds , l /= leader]
removeCards::[Card]->[Card]->[Card]
removeCards lwd o = filter (\x -> (x `elem` o)==False) lwd
append :: Follower->Card->Follower
append (Follower name cards) t@(Card leadername daunce)= Follower name (t:cards)
tDauncers=["Tom","Peter"]
tLeaders=["Candy"]
tDaunces=["waltz"]
leaderWithDaunceLst = [Card l d | l <- tLeaders,d <- tDaunces]
follows = [Follower name [] | name <-tDauncers]
allDaunce::[Follower]->[Card]
allDaunce [] = []
allDaunce ((Follower _ ds ):xs) = ds ++ (allDaunce xs)
comPair::[Follower]->[Follower]->[Card]->[Follower]
comPair ds o [] = ds++o
comPair ds [] _ = ds
comPair r (f:fx) t@(card@(Card leader daunce):cardList) = if (rNoRepeatDaunce f card)
&& (rNoEnoughLeader (cards f) leader)
&& (rOneDaunce f daunce)
then comPair ((append f card):r) fx (removeLeader cardList leader)
else comPair r (f:fx) t
main = do
a <- return $ comPair[] follows leaderWithDaunceLst
putStrLn $ "step1:\t" ++ show a
--f1 <- return $ removeCards leaderWithDaunceLst $ allDaunce a
b <- return $ comPair [] a leaderWithDaunceLst
putStrLn $ "step2:\t" ++ show b
f2 <- return $ removeCards leaderWithDaunceLst $ allDaunce b
c <- return $ comPair [] b f2
putStrLn $ "step3:\t" ++ show c