我正在努力通过Artificial Intelligence: A Modern Approach以减轻我的自然愚蠢。在尝试解决一些练习时，我遇到了“谁拥有斑马”问题，Chapter 5中的练习5.13。这已经是a topic here on SO，但回答主要是针对“如果您可以自由选择解决问题的软件，您将如何解决这个问题？”
我接受Prolog是一种非常适合此类问题的编程语言，并且有一些可用的精美软件包，例如：在Python中，如排名靠前的答案所示，也是独立的。唉，这一切都没有帮助我以书中概述的方式“强硬”。
本书似乎建议构建一组双重或全局约束，然后实现一些提到的算法以找到解决方案。我遇到了很多麻烦，提出了一组适用于建模问题的约束。我正在研究这个问题，所以我无法接触到教授或TA让我超过驼峰 - 这就是我要求你帮助的地方。
我认为本章中的例子几乎没有相似之处。
我渴望构建双重约束，并通过创建25个变量（{1}}，nationality1，nationality2，... nationality3来创建（逻辑等效） ，nationality5，pet1，pet2，... pet3，pet5 ... drink1等等，其中数字为指示房子的位置。
这适用于构建一元约束，例如：
挪威人居住在第一宫：
drink5但是大多数约束是通过一个共同的门牌号码组合两个这样的变量，例如
瑞典人有一只狗：
nationality1 = { :norway }.
显然nationality[n] = { :sweden } AND pet[n] = { :dog }
的范围是1到5。或者说另一种方式：
n......与本书所倡导的“元组列表”有着截然不同的感觉：
nationality1 = { :sweden } AND pet1 = { :dog }
XOR nationality2 = { :sweden } AND pet2 = { :dog }
XOR nationality3 = { :sweden } AND pet3 = { :dog }
XOR nationality4 = { :sweden } AND pet4 = { :dog }
XOR nationality5 = { :sweden } AND pet5 = { :dog }
我不是在寻找解决方案;我正在寻找一个如何以与本书的方法兼容的方式来模拟这个问题的开始。任何帮助表示赞赏。
答案 0 :(得分：4)
有几个CSP解决方案库：
还有更多。这些可以用于有效的约束求解。
另一方面，如果要实现常规约束求解器，则需要实现CSP求解器：构建约束图，其中节点是约束变量并约束连接。为每个变量存储可能的域，并构建通知机制。当相关变量发生变化时，会通知约束，然后启动传播过程：通过查看相关变量的当前值，可以减少可能变量的域。
传播示例：
传播可能不够。在这种情况下，使用回溯/回跳搜索：我们尝试选择单个变量的值，传播更改等。
该算法被认为非常快，而且易于理解。我有一些实现可以非常有效地解决我们遇到的特殊情况。
答案 1 :(得分：4)
感谢大家提供一些有用的信息！
我真正需要的提示在交通拥堵中找到了我。不是将国籍，宠物等分配给房屋（名为country1，country2，pet1，pet2的变量），我需要做的是将房屋分配给域名！例如：
(9) norway = 1 ; unary constraint: The Norwegian lives in the 1st house
(2) britain = dog ; binary constraint: Dog is in same house as the Brit
(4) green - ivory = 1 ; relative positions
这让我可以找到我的约束的简单公式，如下所示：
(def constraints
#{
[:con-eq :england :red]
[:con-eq :spain :dog]
[:abs-pos :norway 1]
[:con-eq :kools :yellow]
[:next-to :chesterfields :fox]
[:next-to :norway :blue]
[:con-eq :winston :snails]
[:con-eq :lucky :oj]
[:con-eq :ukraine :tea]
[:con-eq :japan :parliaments]
[:next-to :kools :horse]
[:con-eq :coffee :green]
[:right-of :green :ivory]
[:abs-pos :milk 3]
})
我还没有完成（只是在兼职的时候），但是一旦我解决了，我会发布一个完整的解决方案。
更新：大约2周后，我在Clojure中找到了一个可行的解决方案：
(ns houses
[:use [htmllog] clojure.set]
)
(comment
[ 1] The Englishman lives in the red house.
[ 2] The Spaniard owns the dog.
[ 3] The Norwegian lives in the first house on the left.
[ 4] Kools are smoked in the yellow house.
[ 5] The man who smokes Chesterfields lives in the house next to the man with the fox.
[ 6] The Norwegian lives next to the blue house.
[ 7] The Winston smoker owns snails.
[ 8] The Lucky Strike smoker drinks orange juice.
[ 9] The Ukrainian drinks tea.
[10] The Japanese smokes Parliaments.
[11] Kools are smoked in the house next to the house where the horse is kept.
[12] Coffee is drunk in the green house.
[13] The Green house is immediately to the right (your right) of the ivory house.
[14] Milk is drunk in the middle house.
“Where does the zebra live, and in which house do they drink water?”
)
(def positions #{1 2 3 4 5})
(def categories {
:country #{:england :spain :norway :ukraine :japan}
:color #{:red :yellow :blue :green :ivory}
:pet #{:dog :fox :snails :horse :zebra}
:smoke #{:chesterfield :winston :lucky :parliament :kool}
:drink #{:orange-juice :tea :coffee :milk :water}
})
(def constraints #{
; -- unary
'(at :norway 1) ; 3
'(at :milk 3) ; 14
; -- simple binary
'(coloc :england :red) ; 1
'(coloc :spain :dog) ; 2
'(coloc :kool :yellow) ; 4
'(coloc :winston :snails) ; 7
'(coloc :lucky :orange-juice) ; 8
'(coloc :ukraine :tea) ; 9
'(coloc :japan :parliament) ; 10
'(coloc :coffee :green) ; 12
; -- interesting binary
'(next-to :chesterfield :fox) ; 5
'(next-to :norway :blue) ; 6
'(next-to :kool :horse) ; 11
'(relative :green :ivory 1) ; 13
})
; ========== Setup ==========
(doseq [x (range 3)] (println))
(def var-cat ; map of variable -> group
; {:kool :smoke, :water :drink, :ivory :color, ...
(apply hash-map (apply concat
(for [cat categories vari (second cat)]
[vari (first cat)]))))
(prn "var-cat:" var-cat)
(def initial-vars ; map of variable -> positions
; {:kool #{1 2 3 4 5}, :water #{1 2 3 4 5}, :ivory #{1 2 3 4 5}, ...
(apply hash-map (apply concat
(for [v (keys var-cat)] [v positions]))))
(prn "initial-vars:" initial-vars)
(defn apply-unary-constraints
"This applies the 'at' constraint. Separately, because it only needs doing once."
[vars]
(let [update (apply concat
(for [c constraints :when (= (first c) 'at) :let [[v d] (rest c)]]
[v #{d}]))]
(apply assoc vars update)))
(def after-unary (apply-unary-constraints initial-vars))
(prn "after-unary:" after-unary)
(def binary-constraints (remove #(= 'at (first %)) constraints))
(prn "binary-constraints:" binary-constraints)
; ========== Utilities ==========
(defn dump-vars
"Dump map `vars` as a HTML table in the log, with `title`."
[vars title]
(letfn [
(vars-for-cat-pos [vars var-list pos]
(apply str (interpose "<br/>" (map name (filter #((vars %) pos) var-list)))))]
(log-tag "h2" title)
(log "<table border='1'>")
(log "<tr>")
(doall (map #(log-tag "th" %) (cons "house" positions)))
(log "</tr>")
(doseq [cat categories]
(log "<tr>")
(log-tag "th" (name (first cat)))
(doseq [pos positions]
(log-tag "td" (vars-for-cat-pos vars (second cat) pos)))
(log "</tr>")
)
(log "</table>")))
(defn remove-values
"Given a list of key/value pairs, remove the values from the vars named by key."
[vars kvs]
(let [names (distinct (map first kvs))
delta (for [n names]
[n (set (map second (filter #(= n (first %)) kvs)))])
update (for [kv delta
:let [[cname negative] kv]]
[cname (difference (vars cname) negative)])]
(let [vars (apply assoc vars (apply concat update))]
vars)))
(defn siblings
"Given a variable name, return a list of the names of variables in the same category."
[vname]
(disj (categories (var-cat vname)) vname))
(defn contradictory?
"Checks for a contradiction in vars, indicated by one variable having an empty domain."
[vars]
(some #(empty? (vars %)) (keys vars)))
(defn solved?
"Checks if all variables in 'vars' have a single-value domain."
[vars]
(every? #(= 1 (count (vars %))) (keys vars)))
(defn first-most-constrained
"Finds a variable having the smallest domain size > 1."
[vars]
(let [best-pair (first (sort (for [v (keys vars) :let [n (count (vars v))] :when (> n 1)] [n v])))]
(prn "best-pair:" best-pair)
(second best-pair)))
;========== Constraint functions ==========
(comment
These functions make an assertion about the domains in map 'bvars',
and remove any positions from it for which those assertions do not hold.
They all return the (hopefully modified) domain space 'bvars'.)
(declare bvars coloc next-to relative alldiff solitary)
(defn coloc
"Two variables share the same location."
[vname1 vname2]
(if (= (bvars vname1) (bvars vname2)) bvars
(do
(let [inter (intersection (bvars vname1) (bvars vname2))]
(apply assoc bvars [vname1 inter vname2 inter])))))
(defn next-to
"Two variables have adjoining positions"
[vname1 vname2]
; (prn "doing next-to" vname1 vname2)
(let [v1 (bvars vname1) v2 (bvars vname2)
bad1 (for [j1 v1 :when (not (or (v2 (dec j1)) (v2 (inc j1))))] [vname1 j1])
bad2 (for [j2 v2 :when (not (or (v1 (dec j2)) (v1 (inc j2))))] [vname2 j2])
allbad (concat bad1 bad2)]
(if (empty? allbad) bvars
(do
(remove-values bvars allbad)))))
(defn relative
"(position vname1) - (position vname2) = diff"
[vname1 vname2 diff]
(let [v1 (bvars vname1) v2 (bvars vname2)
bad1 (for [j1 v1 :when (not (v2 (- j1 diff)))] [vname1 j1])
bad2 (for [j2 v2 :when (not (v1 (+ j2 diff)))] [vname2 j2])
allbad (concat bad1 bad2)]
(if (empty? allbad) bvars
(do
(remove-values bvars allbad)))))
(defn alldiff
"If one variable of a category has only one location, no other variable in that category has it."
[]
(let [update (apply concat
(for [c categories v (val c) :when (= (count (bvars v)) 1) :let [x (first (bvars v))]]
(for [s (siblings v)]
[s x])))]
(remove-values bvars update)))
(defn solitary
"If only one variable of a category has a location, then that variable has no other locations."
[]
(let [loners (apply concat
(for [c categories p positions v (val c)
:when (and
((bvars v) p)
(> (count (bvars v)) 1)
(not-any? #((bvars %) p) (siblings v)))]
[v #{p}]))]
(if (empty? loners) bvars
(do
; (prn "loners:" loners)
(apply assoc bvars loners)))))
;========== Solving "engine" ==========
(open)
(dump-vars initial-vars "Initial vars")
(dump-vars after-unary "After unary")
(def rules-list (concat (list '(alldiff)) binary-constraints (list '(solitary))))
(defn apply-rule
"Applies the rule to the domain space and checks the result."
[vars rule]
(cond
(nil? vars) nil
(contradictory? vars) nil
:else
(binding [bvars vars]
(let [new-vars (eval rule)]
(cond
(contradictory new-vars) (do
(prn "contradiction after rule:" rule)
nil)
(= new-vars vars) vars ; no change
:else (do
(prn "applied:" rule)
(log-tag "p" (str "applied: " (pr-str rule)))
(prn "result: " new-vars)
new-vars))))))
(defn apply-rules
"Uses 'reduce' to sequentially apply all the rules from 'rules-list' to 'vars'."
[vars]
(reduce apply-rule vars rules-list))
(defn infer
"Repeatedly applies all rules until the var domains no longer change."
[vars]
(loop [vars vars]
(let [new-vars(apply-rules vars)]
(if (= new-vars vars) (do
(prn "no change")
vars)
(do (recur new-vars))))))
(def after-inference (infer after-unary))
(dump-vars after-inference "Inferred")
(prn "solved?" (solved? after-inference))
(defn backtrack
"solve by backtracking."
[vars]
(cond
(nil? vars) nil
(solved? vars) vars
:else
(let [fmc (first-most-constrained vars)]
(loop [hypotheses (seq (vars fmc))]
(if (empty? hypotheses) (do
(prn "dead end.")
(log-tag "p" "dead end.")
nil)
(let [hyp (first hypotheses) hyp-vars (assoc vars fmc #{hyp})]
(prn "hypothesis:" fmc hyp)
(log-tag "p" (str "hypothesis: " hyp))
(dump-vars hyp-vars (str "Hypothesis: " fmc " = " hyp))
(let [bt (backtrack (infer hyp-vars))]
(if bt (do
(prn "success!")
(dump-vars bt "Solved")
bt)
(recur (rest hypotheses))))))))))
(prn "first-most-constrained:" (first-most-constrained after-inference))
(def solution (backtrack after-inference))
(prn "solution:" solution)
(close)
(println "houses loaded.")
这是292行，但那里有很多调试/诊断编码。总之，我很高兴能在Clojure中设置一个相当短的解决方案。函数式编程提出了一些挑战，但我设法保持了相当一致的功能风格。
批评欢迎虽然！
对于任何关心的人，这是解决方案：
house 1 2 3 4 5
country norway ukraine england spain japan
color yellow blue red ivory green
pet fox horse snails dog zebra
smoke kool chesterfield winston lucky parliament
drink water tea milk orange-juice coffee
答案 2 :(得分：2)
警告：我不确定这是你在搜索什么，因为我还没有看过Artificial Intelligence: A Modern Approach，但我认为接下来的内容很有意思。
Edi Weitz在这个谜题上有an interesting page，在Common Lisp中有解释源代码，在C ++和Common Lisp中没有详细的评论。我发现Klaus Betzler的C ++源代码特别有趣（为了提高清晰度，重新格式化了一点）：
// einstein.cpp (c) Klaus Betzler 20011218
// Klaus.Betzler@uos.de
// `Einstein's Riddle´, the rules:
// 1 The Brit lives in the red house
// 2 The Swede keeps dogs as pets
// 3 The Dane drinks tea
// 4 The green house is on the left of the white house
// 5 The green house's owner drinks coffee
// 6 The person who smokes Pall Mall rears birds
// 7 The owner of the yellow house smokes Dunhill
// 8 The man living in the centre house drinks milk
// 9 The Norwegian lives in the first house
// 10 The person who smokes Marlboro lives next to the one who keeps cats
// 11 The person who keeps horses lives next to the person who smokes Dunhill
// 12 The person who smokes Winfield drinks beer
// 13 The German smokes Rothmans
// 14 The Norwegian lives next to the blue house
// 15 The person who smokes Marlboro has a neigbor who drinks water
#undef WIN32 // #undef for Linux
#include <stdio.h>
#ifdef WIN32
#include <windows.h>
#endif
inline unsigned long BIT(unsigned n) {return 1<<n;}
const unsigned long
yellow = BIT( 0),
blue = BIT( 1),
red = BIT( 2),
green = BIT( 3),
white = BIT( 4),
norwegian = BIT( 5),
dane = BIT( 6),
brit = BIT( 7),
german = BIT( 8),
swede = BIT( 9),
water = BIT(10),
tea = BIT(11),
milk = BIT(12),
coffee = BIT(13),
beer = BIT(14),
dunhill = BIT(15),
marlboro = BIT(16),
pallmall = BIT(17),
rothmans = BIT(18),
winfield = BIT(19),
cat = BIT(20),
horse = BIT(21),
bird = BIT(22),
fish = BIT(23),
dog = BIT(24);
const char * Label[] = {
"Yellow", "Blue", "Red", "Green", "White",
"Norwegian","Dane", "Brit", "German", "Swede",
"Water", "Tea", "Milk", "Coffee", "Beer",
"Dunhill", "Marlboro","Pallmall","Rothmans","Winfield",
"Cat", "Horse", "Bird", "Fish", "Dog"
};
const unsigned long color = yellow +blue +red +green +white;
const unsigned long country = norwegian+dane +brit +german +swede;
const unsigned long drink = water +tea +milk +coffee +beer;
const unsigned long cigar = dunhill +marlboro+pallmall+rothmans+winfield;
const unsigned long animal = cat +horse +bird +fish +dog;
unsigned long house [5] = {norwegian, blue, milk, 0, 0}; // rules 8,9,14
unsigned long result[5];
const unsigned long comb[] = { // simple rules
brit+red, // 1
swede+dog, // 2
dane+tea, // 3
green+coffee, // 5
pallmall+bird, // 6
yellow+dunhill, // 7
winfield+beer, // 12
german+rothmans // 13
};
const unsigned long combmask[] = { // corresponding selection masks
country+color,
country+animal,
country+drink,
color+drink,
cigar+animal,
color+cigar,
cigar+drink,
country+cigar
};
inline bool SimpleRule(unsigned nr, unsigned which)
{
if (which<8) {
if ((house[nr]&combmask[which])>0)
return false;
else {
house[nr]|=comb[which];
return true;
}
}
else { // rule 4
if ((nr==4)||((house[nr]&green)==0))
return false;
else
if ((house[nr+1]&color)>0)
return false;
else {
house[nr+1]|=white;
return true;
}
}
}
inline void RemoveSimple(unsigned nr, unsigned which)
{
if (which<8)
house[nr]&=~comb[which];
else
house[nr+1]&=~white;
}
inline bool DunhillRule(unsigned nr, int side) // 11
{
if (((side==1)&&(nr==4))||((side==-1)&&(nr==0))||((house[nr]&dunhill)==0))
return false;
if ((house[nr+side]&animal)>0)
return false;
house[nr+side]|=horse;
return true;
}
inline void RemoveDunhill(unsigned nr, unsigned side)
{
house[nr+side]&=~horse;
}
inline bool MarlboroRule(unsigned nr) // 10 + 15
{
if ((house[nr]&cigar)>0)
return false;
house[nr]|=marlboro;
if (nr==0) {
if ((house[1]&(animal+drink))>0)
return false;
else {
house[1]|=(cat+water);
return true;
}
}
if (nr==4) {
if ((house[3]&(animal+drink))>0)
return false;
else {
house[3]|=(cat+water);
return true;
}
}
int i,k;
for (i=-1; i<2; i+=2) {
if ((house[nr+i]&animal)==0) {
house[nr+i]|=cat;
for (k=-1; k<2; k+=2) {
if ((house[nr+k]&drink)==0) {
house[nr+k]|=water;
return true;
}
}
}
}
return false;
}
void RemoveMarlboro(unsigned m)
{
house[m]&=~marlboro;
if (m>0)
house[m-1]&=~(cat+water);
if (m<4)
house[m+1]&=~(cat+water);
}
void Recurse(unsigned recdepth)
{
unsigned n, m;
for (n=0; n<5; n++) {
if (recdepth<9) { // simple rules
if (SimpleRule(n, recdepth)) {
Recurse(recdepth+1);
RemoveSimple(n, recdepth);
}
}
else { // Dunhill and Marlboro
for (int side=-1; side<2; side+=2)
if (DunhillRule(n, side)) {
for (m=0; m<5; m++)
if (MarlboroRule(m))
for (int r=0; r<5; r++)
result[r] = house[r];
else
RemoveMarlboro(m);
RemoveDunhill(n, side);
}
}
}
}
int main()
{
int index, i;
#ifdef WIN32
LARGE_INTEGER time0, time1, freq;
QueryPerformanceCounter(&time0);
#endif
Recurse(0);
#ifdef WIN32
QueryPerformanceCounter(&time1);
QueryPerformanceFrequency(&freq);
printf("\nComputation Time: %ld microsec\n\n",
(time1.QuadPart-time0.QuadPart)*1000000/freq.QuadPart);
#endif
if (result[0]==0) {
printf("No solution found !?!\n");
return 1;
}
for (i=0; i<5; i++)
if ((result[i]&animal)==0)
for (index=0; index<25; index++)
if (((result[i]&country)>>index)==1)
printf("Fish Owner is the %s !!!\n\n", Label[index]);
for (i=0; i<5; i++) {
printf("%d: ",i+1);
for (index=0; index<25; index++)
if (((result[i]>>index)&1)==1)
printf("%-12s",Label[index]);
printf("\n\n");
}
return 0;
}
答案 3 :(得分：1)
谜语中给出的所有线索添加约束。没有限制，任何组合都是可能的。
所以你想要做的是使用 elimination ，这实际上与你在例子中使用的方法相反。方法如下：
你需要一个矩阵，每个国籍一行，每个布尔属性一个列（“住在红房子里”，“住在一个蓝色的房子里“，”有一只狗“，......）
此矩阵中的每个单元格都应该 最初设置为TRUE。
然后你遍历列表 约束并尝试将它们应用于 你的矩阵。例如，线索 “这位英国人生活在红色之中 房子。“设置每个细胞 “红房子”栏目为FALSE除外 对于英语的那个 国籍线。
跳过引用属性的线索 尚未推断的。例如：“温斯顿吸烟者拥有蜗牛。” - 好吧，如果尚未确定谁吸烟温斯顿或谁拥有蜗牛，那么现在就跳过这个限制。
顺便说一下，这也是你如何解决数独游戏等问题。