Я не доволен этим предикатом палатки arity 7.
Как насчет этого скелетного кода. Мне понадобилось немного времени, чтобы восстановить утраченные знания Пролога. Я использую «отрицание как провал», чтобы убедиться, что ограничения соблюдаются. Работает в SWISH .
Это может быть проще для кодирования на языке, подобном Прологу, который создан для удовлетворения ограничений (возможно, ECLiPSe или ASP / Potassco ? Я никогда не пытался сделать это, хотя. )
Записав это, получается, что
- Самое интересное в Prolog - это то, что вы никогда не знаете, является ли решение, которое вы получаете, тем, что вы на самом деле хотите.
- Решение слишком короткое, слишком большое, не вернется, дает только ложь. Argh!
- Вам не нужны сложные структуры данных ... но вам нужны утверждения для проверки промежуточных, частичных решений.
- Человек чувствует, что он намного, намного медленнее, чем при кодировании на императивном языке, но это не совсем так. Есть больше выводов для обработки при поиске одной строки, что было бы эквивалентно абзацу смущающей скуки в императивном языке.
Итак:
% 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)]