bitterharvest’s diary

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

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

1.奇数と偶数

舟に乗る組合せを観察すると、似たようなパターンがあることに気が付く。例えば、女性二人が乗船するパターンには、(女1, 女2),( 女2, 女3),( 女3, 女2)の三つがあった。このパターンは、女性二人が乗船するという意味においては同じであり、個々の人を特定することに意味がないときには、同じものと扱っていいように思える。

このようにすると、先の乗船パターンは、{(女),( 女, 女),( カップル)}の三つとなる。もともと、九つあったのだから、3分の1に減少したこととなる。これは必要とされる計算量とメモリ量を相当に減少させるのに役立つはずである。さらには、三組のカップルではなく、四組、五組のカップルに問題を拡張するときにも役立ちそうである。

同種のものでまとめたものを、数学の言葉を借りると、剰余類という。よく知られているのは、奇数と偶数である。自然数は1から(あるいは0から)無限に続く数であるが、奇数と偶数は、この無限にある数を、有限な二つの数にしたものである。

自然数に対して足し算が用意されているが、奇数と偶数に対しても足し算を用意することができる。奇数+奇数=偶数、奇数+偶数=奇数、偶数+奇数=奇数、偶数+偶数=偶数、のように表すことができる。

(自然数,+)と({奇数,偶数},+)の間には面白い関係がある。自然数の数は奇数か偶数に写像することができる。自然数自然数の間で足し算した結果も奇数か偶数に写像することができる。この足し算は、足される数と足す数のそれぞれを奇数か偶数に写像した後で、その結果に対して足し算をしても答えは同じである。このような現象を数学では準同型写像と呼んでいる。

準同型写像では、写像する前に演算を施しその結果を写像しても、写像した後で演算を施しても、結果は変わらないことを意味している。演算をどちらでするかは好みの問題だと言っている。

ここで、「嫉妬深い男たち」の問題に戻ろう。女1, 女2, 女3を女で、男1, 男2, 男3を男で、カップル1, カップル2, カップル3をカップルで、表すことにする。その背景には、剰余類、準同型写像と呼ばれる数学的な背景があることも頭の隅に置いておくことにする。

なお、自然数から奇数と偶数への準同型写像、旅行者たちからカップル、(シングルの)男性、(シングルの)女性への準同型写像は、ファンクタでもある。数学の圏論で用いられる用語であるが、Haskellでも使用されるので、知っている人も多いことと思う。

2.乗船のモデル化

岸にいる人たちをGroupというデータで表すことにする。Groupというデータは、データベースで使われるレコードと同じ構造をしていて、couple,male,femaleというフィールドを有しているものとし、フィールドはリストであるとし、それぞれの要素は、また、先ほど論じたカップル、男性、女性である。ここではUnitというデータ型を定義し、UnitはCouple,Male,Femaleで構成されるとし、これらは、カップル、男性、女性を表すとする。従って、カップルが二組ある場合には、couple =[Couple, Couple]となる。

例えば、岸に、カップルが二組、男性が一人、女性は無であるとき、Group {couple = [Couple, Couple], male=[Male], female=[ ]}と表される。

そこで、問題の三組のカップルにとらわれることなく、一般化して、岸にあるカップルたちと、男性たちと女性たちが存在したときに、乗船する組と岸に残る組がどのようになるかを考えることにする。

この手の問題は場合分けするのが一番である。ここでは、舟に乗る候補を場合分けにより列挙することとする。カップルでない男性と女性が一緒に船に乗ることを避けなければいけないので、以下のような場合分けが得られる。但し、岸に残されたグループの間では嫉妬を起こすような関係が残されているかもしれないので、このようなものについては後で排除する。

1)男性の集合が空でないとき

(ア) 一人しかいないときは、候補として一人だけを選出する。

(イ) 二人以上いるとき、候補として一人と二人を選出する。

2)女性の集合が空でないとき

(ア) 一人しかいないときは、候補として一人だけを選出する。

(イ) 二人以上いるとき、候補として一人と二人を選出する。

3)カップルの集合が空でないとき

(ア) 一組しかいないときは、候補として男性一人、女性一人、カップル一組を選出する。

(イ) 一組以上いるとき、候補として女性一人、男性二人、女性二人、カップル一組を選出する。(男性一人は、女性がほかの男性と一緒に残ってしまうため選出できない)

4)カップルの集合は空でなく、男性の集合も空でないとき

(ア) カップルの集合から男性一人、男性の集合から男性一人からなる男性二人を選出する。

5)カップルの集合は空でなく、女性の集合も空でないとき

(ア) カップルの集合から女性一人、女性の集合から女性一人からなる女性二人を選出する。

上記の場合分けの他に、6)男性の集合が空でなく、かつ、女性の集合が空でないと、6)カップルの集合が空でなく、女性の集合が空でないときがある。しかし、このときは候補は存在しない。これは、女性の集合の方から選ばれた女性と、カップルではない男性とが舟に乗船する候補となるためである。

さて、上記の場合分けに従って、プログラムを作成すると次のようになる。

-- 1)男性の集合が空でないとき
separateMale :: Group -> [TwoGroups]
separateMale Group {couple = _, male = [ ], female = _}                 = [ ]
separateMale Group {couple = couple1, male = x:xs, female = female1}

-- (ア)  一人しかいないときは、候補として一人だけを選出する。

     | xs == [ ]                                                        = typem

-- (イ)  二人以上いるとき、候補として一人と二人を選出する。

     | otherwise                                                        = typem ++ typemm
     where typem   = [TwoGroups {boat = Group {couple = [ ], male = [Male], female = [ ]},            land = Group {couple = couple1, male = xs, female = female1}}]
           typemm  = [TwoGroups {boat = Group {couple = [ ], male = [Male, Male], female = [ ]},      land = Group {couple = couple1, male = tail xs, female = female1}}]

-- 2)女性の集合が空でないとき

separateFemale :: Group -> [TwoGroups]
separateFemale Group {couple = _, male = _, female = [ ]}                = [ ]
separateFemale Group {couple = couple1, male = male1, female = x:xs}

-- (ア)  一人しかいないときは、候補として一人だけを選出する。

     | xs == [ ]                                                         = typef

-- (イ)  二人以上いるとき、候補として一人と二人を選出する。

    | otherwise                                                         = typef ++ typeff
     where typef   = [TwoGroups {boat = Group {couple = [ ], male = [ ], female = [Female]},          land = Group {couple = couple1, male = male1, female = xs}}]
           typeff  = [TwoGroups {boat = Group {couple = [ ], male = [ ], female = [Female, Female]},  land = Group {couple = couple1, male = male1, female = tail xs}}]

-- 3)カップルの集合が空でないとき
separateCouple :: Group -> [TwoGroups]
separateCouple Group {couple = [ ], male = _, female = _}                = [ ]
separateCouple Group {couple = x:xs, male = male1, female = female1}
-- (ア)  一組しかいないときは、候補として男性一人、女性一人、カップル一組を選出する。

     | xs == [ ]                                                         = typef ++ typem ++ typec
-- (ア)  カップルの集合から女性一人、女性の集合から女性一人からなる女性二人を選出する。

     | otherwise                                                         = typef          ++ typec ++ typeff ++ typemm
     where typef  = [TwoGroups {boat = Group {couple = [ ], male = [ ], female = [Female]},           land = Group {couple = xs, male = male1++[Male], female = female1}}]
           typem  = [TwoGroups {boat = Group {couple = [ ], male = [Male], female = [ ]},             land = Group {couple = xs, male = male1, female = female1++[Female]}}]
           typec  = [TwoGroups {boat = Group {couple = [Couple], male = [ ], female = [ ]},           land = Group {couple = xs, male = male1, female = female1}}]
           typeff = [TwoGroups {boat = Group {couple = [ ], male = [ ], female = [Female,Female]},    land = Group {couple = tail xs, male = male1++[Male,Male], female = female1}}]
           typemm = [TwoGroups {boat = Group {couple = [ ], male = [Male,Male], female = [ ]},        land = Group {couple = tail xs, male = male1, female = female1++[Female,Female]}}]
-- 4)カップルの集合は空でなく、男性の集合も空でないとき
separateCoupleMale :: Group -> [TwoGroups]
separateCoupleMale Group {couple = [ ], male = _, female = _}            = [ ]
separateCoupleMale Group {couple = _, male = [ ], female = _}            = [ ]
-- (ア)  カップルの集合から男性一人、男性の集合から男性一人からなる男性二人を選出する。

separateCoupleMale Group {couple = x:xs, male = y:ys, female = female1}  = typemm
     where typemm = [TwoGroups {boat = Group {couple = [ ], male = [Male,Male], female = [ ]},        land = Group {couple = xs, male = ys, female = female1++[Female]}}]
-- 5)カップルの集合は空でなく、女性の集合も空でないとき
separateCoupleFemale :: Group -> [TwoGroups]
separateCoupleFemale Group {couple = [ ], male = _, female = _}          = [ ]
separateCoupleFemale Group {couple = _, male = _, female = [ ]}          = [ ]
-- (ア)  カップルの集合から女性一人、女性の集合から女性一人からなる女性二人を選出する。

separateCoupleFemale Group {couple = x:xs, male = male1, female = y:ys}  = typeff
     where typeff = [TwoGroups {boat = Group {couple = [ ], male = [ ], female = [Female,Female]},    land = Group {couple = xs, male = male1++[Male], female = ys}}]

上記のプログラムを簡単に説明しておく。関数separateCoupleの中で、xs == [] の部分は、カップルの数が一組しかない場合を表している。この場合には、女性一人のtypef, 男性一人のtypem, カップル一組のtypecからなるリストを作成する。

typefの作成方法は、その後に記述してある。舟に乗るのは、boat = Group {couple = [ ], male = [ ], female = [Female]}である。ここでは、女性一人が舟に乗る。岸に残るのは、land = Group {couple = tail xs, male = male1, female = female1++[Female]}}] である。カップルが一組減り、女性が残されるので、これは、couple = xs, female = female1++[Female]となる。

なお、上のプログラムで使っているデータ型を次の通りである。

data Unit = Couple | Male | Female deriving (Eq, Ord, Show)

data Direction = LeftSide | RightSide deriving (Eq, Show)

data Group = Group {couple :: [Unit], male :: [Unit], female :: [Unit]} deriving (Eq, Show)

data TwoGroups = TwoGroups {boat :: Group, land :: Group} deriving (Eq, Show)

3.問題

上記の関数が正しく動くことを示しなさい。
参考のために、テスト用のデータを用意しておく。

test10 = Group {couple = [Couple], male = [Male], female = [Female]}
test11 = Group {couple = [Couple, Couple], male = [Male], female = [ ]}
test12 = Group {couple = [Couple, Couple], male = [ ], female = [Female]}