Artificial intelligence 约束满足问题
为了减轻我天生的愚蠢，我一直在努力。在尝试解决一些练习时，我遇到了“谁拥有斑马”的问题，即中的练习5.13。这是一个问题，但回答主要针对“如果您可以自由选择问题解决软件，您将如何解决此问题？” 我承认Prolog是解决这类问题的一种非常合适的编程语言，并且有一些很好的包可用，例如，在Python中，如排名靠前的答案所示，也是独立的。唉，所有这些都不能帮助我以书中概述的方式“度过难关” 这本书似乎建议建立一组双重的或者可能是全局的约束，然后实现上面提到的一些算法来找到解决方案。我很难想出一套适合建模问题的约束条件。我自己在研究这个问题，所以我无法找到教授或助教来帮助我度过难关——这就是我请求你帮助的地方Artificial intelligence 约束满足问题,artificial-intelligence,constraints,modeling,Artificial Intelligence,Constraints,Modeling,为了减轻我天生的愚蠢，我一直在努力。在尝试解决一些练习时，我遇到了“谁拥有斑马”的问题，即中的练习5.13。这是一个问题，但回答主要针对“如果您可以自由选择问题解决软件，您将如何解决此问题？” 我承认Prolog是解决这类问题的一种非常合适的编程语言，并且有一些很好的包可用，例如，在Python中，如排名靠前的答案所示，也是独立的。唉，所有这些都不能帮助我以书中概述的方式“度过难关” 这本书似乎建议建立一组双重的或者可能是全局的约束，然后实现上面提到的一些算法来找到解决方案。我很难想出一套适合建
我看不出与本章中的例子有什么相似之处 我渴望建立双重约束，并从创建25个变量（逻辑等价物）开始：
nationality1nationality2nationality3pet1pet2pet3drink1drink5n 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 }
( X1, X2, X3 = { val1, val2, val3 }, { val4, val5, val6 }, ... )
我不是在寻找解决方案本身；我正在寻找一个关于如何以一种与本书的方法兼容的方式对这个问题进行建模的开始。感谢您的帮助。警告：我不确定这是您要搜索的内容，因为我还没有阅读，但我认为下面的内容很有趣 < Edi Weitz >在这个谜语中，在普通的LISP中，用<强>解释的< /强>源和C++中的其他源，没有详细注释的普通LISP。我发现Klaus Betzler的C++源特别有趣（为了增强清晰度而重新设置了一点）：
//einstein.cpp（c）Klaus Betzler 20011218
//克劳斯。Betzler@uos.de
//爱因斯坦之谜，规则：
//英国人住在红房子里
//瑞典人养狗当宠物
//丹麦人喝茶
//绿色的房子在白宫的左边
//绿屋的主人喝咖啡
//吸烟的人养鸟
//黄房子的主人抽Dunhill
//住在中央房子里的那个人喝牛奶
//挪威人住在第一所房子里
//抽万宝路的人住在养猫的人旁边
//11养马的人住在吸烟的人旁边
//12抽烟的人喝啤酒
//德国人抽罗斯曼烟
//14挪威人住在蓝房子旁边
//15抽万宝路的人有一个喝水的邻居
#undef WIN32/#针对Linux的undef
#包括
#ifdef WIN32
#包括
#恩迪夫
内联无符号长位（无符号n）{返回10）
返回false；
万宝路大厦；
如果（nr==0）{
如果（（房屋[1]&（动物+饮料））>0）
返回false；
否则{
房屋[1]|=（猫+水）；
返回true；
}
}
如果（nr==4）{
如果（（房屋[3]&（动物+饮料））>0）
返回false；
否则{
房子[3]|=（猫+水）；
返回true；
}
}
int i，k；
对于（i=-1；i）来说，这里是如何建模二进制约束满足问题的
谜语中给出的所有线索都加上了限制。没有限制，任何组合都是可能的
所以你要做的是使用消去法，这实际上与你在例子中使用的方法相反。下面是方法：
您需要一个矩阵，每个国籍对应一行，每个布尔属性对应一列（“住在红房子”、“住在蓝房子”、“有狗”…）
- 该矩阵中的每个单元格都应
最初设置为TRUE
- 然后，遍历
约束并尝试将其应用于
你的矩阵，比如线索
“英国人生活在赤字之中
设置每个单元格中的
“红房子”栏为假，除非
关于英语的那个
国籍线
- 跳过涉及属性的线索
这还没有被推断出来。例如：“温斯顿吸烟者拥有蜗牛。”——好吧，如果还没有确定谁吸食温斯顿或谁拥有蜗牛，那么现在就跳过这个限制
顺便说一句，这也是解决数独难题等问题的方法。有几个用于CSP解决的库：
- （C++）
- （爪哇）
- SICStus Prolog中的clp（*）模块
还有很多，这些可以用于有效的约束求解
另一方面，如果您想实现通用约束求解器，实现CSP求解器的一个想法是：构建约束图，其中节点是约束变量，约束是连接。对于每个变量，存储可能的域，并构建通知机制。当相关变量改变，然后开始传播过程：通过查看相关变量的当前值，减少可能变量的范围
传播示例：
- 变量（带域）：X-{1,2,3,4,5}-Y{1,2,3,4,5}
- 公司
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 }
( X1, X2, X3 = { val1, val2, val3 }, { val4, val5, val6 }, ... )
// 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;
}
(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]
})
(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.")
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