Haskellに関するアインシュタインの謎を解く

前戯

アルバート・アインシュタイン

少し前に、「 アインシュタインのなぞなぞ 」または「ゼブラパズル」と呼ばれる興味深いパズルを思い出させたHabréの記事を読みまし 。 おそらくあなたの多くは、この問題を紙で解決し、世界人口の数パーセントがこの能力を持っていることを誇りに思っていました。



この記事を読んだ後、この問題に対するソフトウェアソリューションについて考えました。 この記事で紹介したアプローチは興味深いものであり、ブログの名前を完全に正当化しましたが、私には完全に明確ではないように思われました。 現時点では、Haskellプログラミング言語に興味があります。これは、単独で脳を温めるのにも最適ですが、パズルを解くことは私にとって大きな挑戦に思えました。





アルゴリズム


一般に、タスクは次のようになります。

すべてのオブジェクトの属性値(または他の事項では同じであるいくつかのオブジェクト)を復元する必要がありますが、これは制限に矛盾しません。



最初の考えは、タスクの条件の充足をチェックするオプションの完全な列挙でしたが、単純な計算では、組み合わせの数が

5! 5 = 24.883.200.000



5! 5 = 24.883.200.000



、これはかなりの量です。



いくつかの考えの中で、次のアプローチが生まれました:許容できるソリューションのスペースがあり、制約がソリューションのサブセットを記述し、正しいソリューションがそのようなサブセットの交差点にあります(つまり、すべての条件が満たされる領域にあります)。



次のステップは、ソリューションのサブセットを一連のテンプレートの形式で記述することでした。つまり、一部のオブジェクトの属性は固定され、他の属性は有効な値を取ることができるソリューションです。 そして、そのような記述があれば、この方法で記述されたセットを交差させる方法を学ぶ必要があるだけです。



解決策


Haskellでソリューションをコンパイルおよび書き換えるとき、問題の解決策を見つけたいという欲求だけでなく、アルゴリズムと美しいHaskell言語の両方を簡単に実証できる理解可能なプログラムを作成したいという欲求もありました。



したがって、私は訓練されていない人々によるプログラムの読み取りを妨げるアプローチの使用を最小限にしようとしました。 解決策は完全に普遍的であると主張していませんが、この種の問題を解決するためのいくつかのツールが説明されています。



しかし、あなた自身のために読んでください-私はあなたのために多くのコメントを残しました。

しかし、私もあなたのコメントに喜んでいるでしょう。

  1. インポートデータ リスト( lookup nub)
  2. インポートデータ たぶん (fromMaybe catMaybes)
  3. -----------------------------------------------
  4. -アインシュタインの謎-
  5. -アタムール-
  6. -----------------------------------------------
  7. ---------------------------
  8. -タスクの一般的な説明-
  9. ---------------------------
  10. -問題の解決策はオブジェクトのシーケンスです
  11. タイプ Solution = [Object]
  12. -各オブジェクトは、一連の属性ペアとその値によって記述されます
  13. タイプ Object = [( String String )]
  14. -=記号による属性と値のペアの表示:
  15. attr = :value = (attr value)
  16. 属性= [ "国籍" "家" "ペット" "飲み物" "煙" ]
  17. サイズ= 5
  18. -私たちはいくつかを満たすソリューションを見つける問題を解決します
  19. -制限
  20. -すべての決定のセットから開始し、徐々に明確にします
  21. は、1つのソリューションに還元されるまでのセットです。
  22. -本当。
  23. -したがって、オブジェクトはすぐに多くの実際のオブジェクトを記述できます。
  24. -いくつかの属性が設定され、残りは設定されていない
  25. -どれでもかまいません。 したがって、空のオブジェクトはすべての可能なテンプレートです
  26. -オブジェクト:
  27. anyObject = [] ::オブジェクト
  28. -そして、空のオブジェクトのセットは、与えられた前のすべての決定のセットです
  29. -寸法:
  30. anySolution = [anyObject | n [1 ..サイズ]]
  31. -各ソリューションは、ソリューションなどの互換性のあるソリューションのセットを記述します
  32. -[["nationality" =: "Englishman"]、anyObject、anyObject]
  33. -すべてのトリプルのオブジェクトを説明します。最初のオブジェクトには属性があります
  34. -「国籍は英語です」
  35. -しかし、決定を明確にするためには、多くの互換性がないことが必要です。
  36. -決定(たとえば、「英国人または最初または2番目だが同時にではない」):
  37. タイプ Solutions = [Solution]
  38. empty = [] ::ソリューション
  39. -問題を解決するには、ソリューションに制限を課す必要があります
  40. -各制約は多くの決定を変換します
  41. -結果は、いくつかの無関係なセットまたは
  42. -空の決定セット
  43. タイプ制限=ソリューションソリューション
  44. -多くの決定に制限を適用する
  45. -多くのソリューションを変換するとき、私たちはチェックします
  46. -属性値の一意性:
  47. 適用::制限ソリューションソリューション
  48. 制限ゾルを適用する=
  49. concat [ filternot。duplicates )(制限ソリューション) | ソリューションソルス]
  50. どこで
  51. duplicates sols = 任意の duplicateValues( map (values sols)属性)
  52. 値sols attr = maplookup attr)sols
  53. duplicateValues vals ' =
  54. let vals = catMaybes vals '
  55. in (vals nub vals)
  56. -オブジェクトを記述する2つのパターンの交差点
  57. -両方のソーステンプレートの属性を含むテンプレートの場合があります。
  58. -ソーステンプレートに異なる内容が含まれている場合、互換性がない可能性があります
  59. -同じ属性の値
  60. both ::オブジェクトオブジェクト 多分オブジェクト
  61. both obj obj ' = foldl join(Just [])属性-属性に従って結合します
  62. どこで
  63. -すでに空のセットがある場合、結果も空です
  64. Join Nothing _ = Nothing
  65. -それ以外の場合は、属性ごとに制約の値を比較します
  66. 参加(ちょうど休息)attr =
  67. の場合lookup attr obj lookup attr obj ')
  68. (無無) ただ休む
  69. (値だけなし) Just((attr = :value):rest)
  70. (Nothing Just value) Just((attr = :value):rest)
  71. (ちょうど値ちょうど値 ')
  72. ==値の場合 '
  73. 次に Just((attr = :value):rest)
  74. それ以外は何もありません
  75. -基本的な制限-ある位置にあるオブジェクトは
  76. -プリセットテンプレート
  77. objectAt :: Int オブジェクト制限
  78. objectAt n obj solution =
  79. 両方のobj(ソリューション!! (n - 1))
  80. なし-テンプレートが既にそこにあるテンプレートと互換性がない場合
  81. ちょうど解像度 [n resソリューションを置き換える]
  82. どこで
  83. replace nx xs = take (n - 1)xs ++ [x] ++ drop n xs
  84. -制限の操作---------------------------------------------
  85. -交差点-両方の制限が当てはまる
  86. <> )rs rs 'solution = apply rs(rs' solution)
  87. r _ all = foldl1<>-セットのすべての制限
  88. -ユニオン-どちらかが正しい
  89. <|> )rs rs 'solution = rs solution ++ rs' solution
  90. r _ any = foldl1<|>-制限の1つ
  91. -派生制限---------------------------------------------- -
  92. -何らかのオブジェクトがあります(最初の位置、または2番目の位置など)。
  93. exists obj = r _ any [objectAt n obj | n [1 .. 5]]
  94. -1つのオブジェクトは常に別のオブジェクトの後に続きます
  95. before obj obj ' = r _ any [
  96. objectAt n obj <> objectAt(n + 1)obj ' | n [1 ..サイズ-1]]
  97. -近く(または2番目の前の1つ、または最初の前の2番目)
  98. near obj obj ' = (obj `before` obj') <|> (obj '` before` obj)
  99. ------------------------------------------------
  100. -特定の問題の説明-
  101. ------------------------------------------------
  102. 制限=
  103. objectAt 1 [ "国籍" ="ノルウェー語" ] <>
  104. exists [ "国籍" ="イギリス人" "家" ="赤" ] <>
  105. ([ "" house " =" Green " ]` before` [ "house" ="White" ]) <>
  106. exists [ "国籍" ="デーン" "ドリンク" ="ティー" ] <>
  107. ([ "" smoke " =" Malboro " ]` near` [ "pet" ="Cat" ]) <>
  108. exists [ "煙" ="ダンヒル" "家" ="黄色" ] <>
  109. exists [ "国籍" ="ドイツ語" "煙" ="ロスマン" ] <>
  110. objectAt 3 [ "drink" ="Milk" ] <>
  111. ([ "smoke" ="Malboro" ] `near` [ " drink " =" Water " ]) <>
  112. exists [ "smoke" ="Pallmall" "pet" ="Bird" ] <>
  113. exists [ "国籍" ="スウェーデン" "ペット" ="犬" ] <>
  114. ([ "nationality" ="Norwegian" ] `near` [ " house " =" Blue " ]) <>
  115. exists [ "pet" ="馬" "house" ="青" ] <>
  116. exists [ "煙" ="Winfield" "drink" ="ビール" ] <>
  117. exists [ "house" ="Green" "drink" ="Coffee" ] <>
  118. exists [ "pet" ="魚" ]
  119. -魚はどこにも現れません、それが何であるかを尋ねる必要があります
  120. main =解決策=制限の適用[anySolution]
  121. 長さの解が1より大きい場合
  122. 次に putStrLn「合計ソリューションセット:」 ++ ショー長さソリューション))
  123. それ以外の場合 putStrLn $ descrSolution $ ヘッドソリューション
  124. -----------------------------
  125. -文字列表現-
  126. -----------------------------
  127. -人の文字列表現:
  128. descrMan man = descr "国籍" ++ "住む" ++
  129. descr "house" ++ "house、owns" ++
  130. descr "pet" ++ "、drinks" ++
  131. descr "drink" ++ "and smokes" ++
  132. descr 「煙」
  133. ここで descr attr = fromMaybe "?"lookup attr man)
  134. -ソリューションの文字列表現:
  135. descrSolution sol = concat [descrMan man ++ " \ n " |ソル]



All Articles