bitterharvest’s diary

A Bitter Harvestは小説の題名。作者は豪州のPeter Yeldham。苦闘の末に勝ちえた偏見からの解放は命との引換になったという悲しい物語

Haskellでクイズ「嫉妬深い男たち」を解く(4)

1.安全な組み合わせを求める

与えられたGroupから、乗船するGroupと岸に残るGroupとをそれぞれフィールドにしたレコード(これはTwoGroupsと呼ばれるレコード型を有する)のリストを返してくれる関数をseparateGroupとする。この関数は、先に説明した場合分けしてえたリストを一つのリストとしてまとめることで、次のように得ることができる。

separateMale x ++ separateFemale x ++ separateCouple x ++ separateCoupleMale x ++ separateCoupleFemale x

しかし、前にも説明したように、これらの候補の中には、(岸に残されるものの中に)好ましくない組合せが存在する可能性がある。そこで、好ましいか、そうでないか、を判断してくれる関数safeTwoGroupsを作成し、この判定に合格したものだけをseparateGroupの出力とすればよいので、次のようになる。

separateGroup :: Group -> [TwoGroups]
separateGroup x = filter safeTwoGroups $ separateMale x ++ separateFemale x ++ separateCouple x ++ separateCoupleMale x ++ separateCoupleFemale x

safeTwoGroupsは、TwoGroupsのデータに対して、乗船するGroupと、岸に残るGroupのそれぞれのに対して、好ましい組合せであるかどうかを調べる。次のようになる。(乗船者に対しては調べる必要がないのだが、汎用性を持たせるためにこのようにしておく。)

safeTwoGroups :: TwoGroups -> Bool
safeTwoGroups x = safeGroup (boat x) && safeGroup (land x)

それぞれのGroupで、女性は相手の男性と一緒にいるか、女性だけのグループであれば問題はないので、これも場合分けするとsafeGroupは次のようになる。

safeGroup :: Group -> Bool
safeGroup Group {couple = _, male = _, female = []} = True
safeGroup Group {couple = [], male = [], female = x:xs} = True
safeGroup Group {couple = x:xs, male = _, female = y:ys} = False
safeGroup Group {couple = _, male = x:xs, female = y:ys} = False

1.1 問題

safeGroupが正しいことを確認しなさい。

2.上陸したときの集団を求める

大分準備が進んできたので、舟が一方の岸から、他方の岸に向かっているときの場面をデータ型OneShotで表すこととする。OneShotはレコードとなていて、フィールドは舟が進んでいる方向、左岸の集団、乗船者の集団、右岸の集団を表しているものとする。これは次のようになる。

data OneShot = OneShot {toward :: Direction, leftSide :: Group, onBoat :: Group, rightSide :: Group} deriving (Eq, Show)

さて、舟が到着して、乗船者が岸に上がった時の場面を関数mergeGroupsで表すこととする。この関数は、左岸についたときと、右岸についたときの場面を表すmergeLGroupsとmergeRGroupsで表すことができるので、次のようになる。

mergeGroups :: OneShot -> OneShot
mergeGroups OneShot {toward = d, leftSide = left, onBoat = boat, rightSide = right}
     | d == LeftSide  && length male1 == length female1 = mergeLGroups OneShot {toward = d, leftSide = left, onBoat = boat, rightSide = right}     
     | d == RightSide && length male1 == length female1 = mergeRGroups OneShot {toward = d, leftSide = left, onBoat = boat, rightSide = right}
     | otherwise                 = error "Unexpected errors occur in mergeGroups." 
     where male1 = male left ++ male boat ++ male right
           female1 = female left ++ female boat ++ female right

左岸についたときの集団は次のようになる。左岸の男性の数と右岸の女性の数は同一であり、同様に、左岸の女性の数と右岸の男性の数は同一である。従って、左岸にいた男性と乗船していた男性の総数が、右岸の女性の総数(実際に左岸にいる男性の数)より多ければ、その分だけ、岸で待っていた相手の女性と一緒になって、カップルに戻ったはずである。これを考慮して関数を完成させると次のようになる。

mergeLGroups :: OneShot -> OneShot
mergeLGroups OneShot {toward = d, leftSide = left, onBoat = boat, rightSide = right}
     = OneShot {toward = LeftSide, leftSide = Group {couple = couple1, male = male1, female = female1}, onBoat = Group {couple = [ ], male = [ ], female = [ ]}, rightSide = right}
       where couple1 = couple left ++ couple boat ++ replicate (length (male left ++ male boat) - length (female right)) Couple
             male1 = replicate (length (female right)) Male
             female1 = replicate (length (male right)) Female

右岸についたときの関数も同様に求めることができる。

mergeRGroups :: OneShot -> OneShot
mergeRGroups OneShot {toward = d, leftSide = left, onBoat = boat, rightSide = right}
     = OneShot {toward = RightSide, leftSide = left, onBoat = Group {couple = [ ], male = [ ], female = [ ]}, rightSide = Group {couple = couple1, male = male1, female = female1}}
       where couple1 = couple right ++ couple boat ++ replicate (length (male right ++ male boat) - length (female left)) Couple
             male1 = replicate (length (female left)) Male
             female1 = replicate (length (male left)) Female

2.1 問題

mergeGroupsが正しく動くことを確認しなさい。以下はテストのために用意した場面である。

test1 = OneShot {toward = LeftSide,  leftSide  = Group {couple = [Couple, Couple], male = [Male, Male, Male], female = [ ]}, 
                                     onBoat    = Group {couple = [ ], male = [ ], female = [Female, Female]}, 
                                     rightSide = Group {couple = [ ], male = [ ], female = [Female]}}
test2 = OneShot {toward = RightSide, leftSide  = Group {couple = [Couple, Couple], male = [Male, Male, Male], female = [ ]}, 
                                     onBoat    = Group {couple = [ ], male = [ ], female = [Female, Female]}, 
                                     rightSide = Group {couple = [ ], male = [ ], female = [Female]}}
test3 = OneShot {toward = LeftSide,  leftSide  = Group {couple = [Couple, Couple], male = [ ], female = [Female, Female, Female]}, 
                                     onBoat    = Group {couple = [ ], male = [Male, Male], female = [ ]}, 
                                     rightSide = Group {couple = [ ], male = [Male], female = [ ]}}
test4 = OneShot {toward = RightSide, leftSide  = Group {couple = [Couple, Couple], male = [ ], female = [Female, Female, Female]}, 
                                     onBoat    = Group {couple = [ ], male = [Male, Male], female = [ ]}, 
                                     rightSide = Group {couple = [ ], male = [Male], female = [ ]}}
test5 = OneShot {toward = LeftSide,  leftSide  = Group {couple = [Couple, Couple, Couple], male = [ ], female = [ ]}, 
                                     onBoat    = Group {couple = [ ], male = [ ], female = [ ]}, 
                                     rightSide = Group {couple = [ ], male = [ ], female = [ ]}}
test6 = OneShot {toward = LeftSide,  leftSide  = Group {couple = [ ], male = [ ], female = [ ]}, 
                                     onBoat    = Group {couple = [Couple], male = [ ], female = [ ]}, 
                                     rightSide = Group {couple = [Couple, Couple], male = [ ], female = [ ]}}
test7 = OneShot {toward = RightSide, leftSide  = Group {couple = [ ], male = [ ], female = [Female]}, 
                                     onBoat    = Group {couple = [ ], male = [Male], female = [ ]}, 
                                     rightSide = Group {couple = [Couple, Couple], male = [ ], female = [ ]}}
test8 = OneShot {toward = LeftSide,  leftSide  = Group {couple = [ ], male = [ ], female = [Female]}, 
                                     onBoat    = Group {couple = [Couple], male = [ ], female = [ ]}, 
                                     rightSide = Group {couple = [Couple], male = [Male], female = [ ]}}