定义复杂的事实 - Einsteins Zebra

Posted 2023-05-08

【中文标题】定义复杂的事实 - Einsteins Zebra

【英文标题】：Defining complicated facts - Einsteins Zebra

【发布时间】：2019-11-17 09:17:45

【问题描述】：

我正在尝试找出Prolog 中复杂关系的正确事实表示。

2行6个帐篷表示为：

tent(color, orientation, place, mans name, womans name, surename, car)

我需要写下一个事实说

名叫彼得的人​​在 帐篷不在伊恩的帐篷前

.

我可以（以及如何）写下事实说

彼得的妻子名字是 不是安？

编辑：

哦，我对“在前面”的定义不是很清楚。在这种情况下，这不是一个普通的事情，我会尝试向您展示：

FOREST  tent1  tent2  tent3  RIVER
FOREST  tent4  tent5  tent6  RIVER

意思是tent1在tent4前面。然后tent1 的方向为“NORTH”，位置为“FOREST”。不在它前面的帐篷是tent5（方向“南”，位置“中间”）。

dif(Wife, 'Ann') 的东西很好用，谢谢。

我向教授咨询了这个问题，我们一致认为对于这个作业我真的不需要事实否定，目标是做出正确的决定并忽略不必要的事实。

无论如何，谢谢你帮助我。

【问题讨论】：

让Prolog discover it by itself怎么样？

我还是不懂“在前面” :-( 所以“在南边”和“在前面”一样吗？不是任何帐篷都不是“在前面”吗？前面”然后“不在前面”？那么，在您的示例中，它可能是 tent2、tent3、tent5 或 tent6？

【参考方案1】：

如果我们假设第三个参数“place”是一个序数，并且“X 在 Y 前面”表示 X Y，那么查询第一条规则是：

tent(_, _, Place_Peter, 'Peter', _, _, _),
tent(_, _, Place_Ian, 'Ian', _, _, _),
Place_Peter > Place_Ian

但当然也可以是“X 是不在 Y 前面的地方”意味着

succ(Y0, Y),
X =\= Y0

我不确定。

第二个是：

tent(_, _, _, 'Peter', Wife, _, _),
dif(Wife, 'Ann')

但请注意，这些不是事实，这些查询将有（或没有）解决方案，并且会根据表 tent/7 的内容成功或失败。

在这两种情况下，我都会对表中不同列的数据类型做出一些假设。

【参考方案2】：

我对 arity 7 的这个 tent 谓词不满意。

这个骨架代码怎么样。我花了一点时间来恢复丢失的 Prolog 知识。我使用“否定为失败”来确保遵循约束。它适用于SWISH。

这可能更容易用类似 Prolog 的语言进行编码，这种语言是为了满足约束而设计的（ECLiPSe 或 ASP/Potassco 可能？不过我从未尝试过这样做。）

写到这里，原来是这样

Prolog 的有趣之处在于，您永远不知道您得到的解决方案是否是您真正想要的。 解决方案太短，太大，不会返回，只给出 false。啊！ 您不需要复杂的数据结构......但您需要断言来检查中间的部分解决方案。 人们会感觉到一种方式比使用命令式语言编码要慢得多，但这并不是真的。查看单行时要处理的推论更多，这相当于命令式语言中的一段令人困惑的无聊。

所以：

% Create tents and indicate their positions, too. These are basically "tent names"
% in the form of a literal where the name carries the x and y position. 
% We won't need this but "in front of" means: in_front_of(tent(X,1),tent(X,2)).

tent(1,1). 
tent(2,1).
tent(3,1).
tent(1,2).
tent(2,2).
tent(3,2).

% Create colors (just as an example)

color(blue).
color(red).
color(green).
color(white).
color(black).
color(mauve).

% Create cars (just as an example)

car(mazda).
car(ford).
car(renault).
car(tesla).
car(skoda).
car(unimog).

% Create surnames (just as an example)

surname(skywalker).
surname(olsndot).
surname(oneagle).

% Create names (just as an example) and give the traditional sex

name(peter,male).
name(marvin,male).
name(ian,male).
name(sheila,female).
name(mary,female).
name(ann,female).

% Give traditional family pair. male is first element in pair.

pair(Nm,Nf,Sn) :- name(Nm,male),name(Nf,female),surname(Sn).

% Our logic universe is now filled with floating stuff: tents, colors, cars, names.
% A "solution" consists in linking these together into a consistent whole respecting
% all the constraints given by the "zebra puzzle"

% A "solution" is a data structure like any other. We choose to have a big list with
% literals. Every literal expresses an assignment between a tent and an attribute:
% 
%   attribute_nameΔ(tent_x,tent_y,attribute_value) 
%   
% Other representations are possible. (Why the "Δ"? Because I like it!)

% We need a list of all tents over which to recurse/induct when generating a "solution".
% ... bagof provides!
% This could possibly be done by directly backtracking over the tent/2 predicate.

all_tents(LTs) :- bagof(tent(X,Y), tent(X,Y), LTs).

% We need a list of all pairs over which to recurse/induct when generating a "solution".
% ... bagof provides!
% This could possibly be done by directly backtracking over the pair/2 predicate.

all_pairs(Ps) :- bagof(pair(Nm,Nf,Sn), pair(Nm,Nf,Sn), Ps). 

% Select possible assignments of "color<->tent", adding the possible assignments to
% an existing list of selected assignments.
%
% assign_colors(List-of-Tents-to-recurse-over,List-with-Assignments(In),List-with-more-Assignments(Out)).

assign_colors([],Bounce,Bounce).
assign_colors([tent(X,Y)|Ts], Acc, Out) :- 
    color(Co),
    \+is_color_used(Acc,Co),
    assign_colors(Ts, [colorΔ(X,Y,Co)|Acc], Out).

is_color_used([colorΔ(_,_,Co)|_],Co) :- !.  % cut to make this deterministic
is_color_used([_|R],Co) :- is_color_used(R,Co).

% Select possible assignment of "car<->tent", adding the possible assignments to
% an existing list of selected assignments.
%
% assign_cars(List-of-Tents-to-recurse-over,List-with-Assignments(In),List-with-more-Assignments(Out)).

assign_cars([],Bounce,Bounce).
assign_cars([tent(X,Y)|Ts], Acc, Out) :-
    car(Ca),
    \+is_car_used(Acc,Ca),
    assign_cars(Ts, [carΔ(X,Y,Ca)|Acc], Out).

is_car_used([carΔ(_,_,Ca)|_],Ca) :- !.  % cut to make this deterministic
is_car_used([_|R],Ca) :- is_car_used(R,Ca).

% Select possible assignment of "name<->tent", adding the possible assignments to
% an existing list of selected assignments.
% 
% In this case, we have to check additional constraints when choosing a possible assignment: 
% 
% 1) A name may only be used once
% 2) Ian and Peter's are not in front of each other
% 
% assign_names(List-of-Tents-to-recurse-over,List-with-Assignments(In),List-with-more-Assignments(Out)).

assign_names([],Bounce,Bounce).
assign_names([tent(X,Y)|Ts], Acc, Out) :-
    name(Na,_),
    \+is_name_used(Acc,Na),
    \+is_ian_in_front_of_peter([nameΔ(X,Y,Na)|Acc]),
    assign_names(Ts, [nameΔ(X,Y,Na)|Acc], Out).

is_name_used([nameΔ(_,_,Na)|_],Na) :- !.  % cut to make this deterministic
is_name_used([_|R],Na) :- is_name_used(R,Na).

is_ian_in_front_of_peter(S) :- 
    pick_name(S,nameΔ(X,_,_),peter),
    pick_name(S,nameΔ(X,_,_),ian),
    write("IAN vs PETER confirmed!\n").

pick_name([nameΔ(X,Y,Name)|_],nameΔ(X,Y,Name),Name).
pick_name([_|R],Found,Name) :- pick_name(R,Found,Name).

% Select possible pairs, adding the possible pairs to an existing list of selected pairs (the same
% as the list of selected assignments). The nature of this selection is **different than the two
% others** as we backtrack over the list of pairs, instead of just recursing over it. Hence,
% three clauses^and a verification that we have 3 pairs in the end.
% 
% In this case, we have to check additional constraints when choosing a possible assignment: 
% 
% 1) Peter's wife name is not Ann
%
% assign_pairs(List-of-Pairs-to-recurse-over,List-with-Assignments(In),List-with-more-Assignments(Out)).

assign_pairs([],Bounce,Bounce) :- count_pairs(Bounce,3). % hardcoded number of surnames; we need 3 pairs!
assign_pairs([pair(Nm,Nf,Sn)|Ps], Acc, Out) :-
    \+is_any_name_already_paired(Acc,Nm,Nf,Sn),
    \+is_peter_married_ann([pairΔ(Nm,Nf,Sn)|Acc]),
    assign_pairs(Ps, [pairΔ(Nm,Nf,Sn)|Acc], Out).
assign_pairs([_|Ps], Acc, Out) :- assign_pairs(Ps, Acc, Out).

is_any_name_already_paired([pairΔ(N,_,_)|_],N,_,_) :- !. % cut to make this deterministic
is_any_name_already_paired([pairΔ(_,N,_)|_],_,N,_) :- !. % cut to make this deterministic
is_any_name_already_paired([pairΔ(_,_,S)|_],_,_,S) :- !. % cut to make this deterministic
is_any_name_already_paired([_|R],Nm,Nf,Sn) :- is_any_name_already_paired(R,Nm,Nf,Sn).

count_pairs([],0).
count_pairs([pairΔ(_,_,_)|R],C) :- !,count_pairs(R,C2), C is C2+1. % red cut
count_pairs([_|R],C) :- count_pairs(R,C).

% this would be more advantageously done by eliminating that pair in the list of
% possible pairs; but leave it here to make the solution less "a bag of special cases"

is_peter_married_ann([pairΔ(peter,ann,_)|_]) :- !. % cut to make this deterministic
is_peter_married_ann([_|R]) :- is_peter_married_ann(R).

% Find a consistent solution by adding assignements for the various attributes
% while checking constraints

solution(SOut) :- 
    all_tents(Tents),
    all_pairs(Pairs),
    assign_colors(Tents,[],S1),
    assign_cars(Tents,S1,S2),
    assign_names(Tents,S2,S3),
    assign_pairs(Pairs,S3,SOut).

运行它

?- solution(SOut).

SOut = [pairΔ(ian, ann, oneagle), pairΔ(marvin, mary, olsndot), 
pairΔ(peter, sheila, skywalker), nameΔ(3, 2, ann), nameΔ(2, 2, mary),
nameΔ(1, 2, sheila), nameΔ(3, 1, ian), nameΔ(2, 1, marvin),
nameΔ(1, 1, peter), carΔ(3, 2, unimog), carΔ(2, 2, skoda), 
carΔ(1, 2, tesla), carΔ(3, 1, renault), carΔ(2, 1, ford), 
carΔ(1, 1, mazda), colorΔ(3, 2, mauve), colorΔ(2, 2, black), 
colorΔ(1, 2, white), colorΔ(3, 1, green), colorΔ(2, 1, red), 
colorΔ(1, 1, blue)]