Solving a Dungeons and Dragons riddle using Prolog
gist.github.comWhile it's not quite the same, we can create a short makefile.
vixen: rudolph prancer dasher cupid blitzen
echo vixen
dancer : vixen donder blitzen rudolph cupid dasher
echo dancer
comet: vixen cupid prancer rudolph
echo comet
donder: comet vixen dasher prancer cupid blitzen rudolph
echo donder
cupid: prancer
echo cupid
blitzen: cupid dasher
echo blitzen
rudolph: cupid prancer
echo rudolph
dasher: rudolph prancer
echo dasher
prancer: ;
echo prancer
order: vixen dancer comet donder cupid blitzen rudolph dasher prancer
echo Get in Line
outputs:
echo prancer
echo cupid
echo rudolph
echo dasher
echo blitzen
echo vixen
echo comet
echo donder
echo dancer
echo Get in Line
real 0m0.015s
user 0m0.003s
sys 0m0.006sThere's also the dedicated unix utility "tsort" (https://en.wikipedia.org/wiki/Tsort) although actually your makefile is more succinct.
Very nice!
This solution uses the library predicate list_to_set/2, relating a (known) list Ls0 of elements to a list Ls without duplicates, where the elements occur in the same order in which they first appear in Ls0. I think it is interesting to consider how such a relation can be described in Prolog, and also how efficient it can be.
An immediate solution suggests itself, considering the elements of Ls0 in the order they appear, and keeping track of the elements that have already been "seen". If an element is encountered that has already been seen, ignore it, otherwise it is part of the list Ls we want to describe. We can use a list to keep track of elements that have already been encountered:
list_to_set(Ls0, Ls) :-
phrase(firsts(Ls0, []), Ls).
firsts([], _) --> [].
firsts([L|Ls], Seen) -->
( { member(L, Seen) } ->
[]
; [L]
),
firsts(Ls, [L|Seen]).
?- list_to_set("Corvus corax", Ls).
Ls = "Corvus cax".
?- length(_, E),
E #> 10,
N #= 2^E,
numlist(1, N, Ls0),
time(list_to_set(Ls0, Ls)).
% CPU time: 0.222s
E = 11, N = 2048, Ls0 = [1,2,3,4,5,...], Ls = [1,2,3,4,5,...]
; % CPU time: 0.880s
E = 12, N = 4096, Ls0 = [1,2,3,4,5,...], Ls = [1,2,3,4,5,...]
; % CPU time: 3.518s
E = 13, N = 8192, Ls0 = [1,2,3,4,5,...], Ls = [1,2,3,4,5,...]
; ... .
For example, using the commonly available library(assoc) for AVL trees, providing O(log(N)) lookup:
list_to_set(Ls0, Ls) :-
empty_assoc(A0),
phrase(firsts(Ls0, A0), Ls).
firsts([], _) --> [].
firsts([L|Ls], A0) -->
( { get_assoc(L, A0, _) } ->
[]
; [L]
),
{ put_assoc(L, A0, t, A) },
firsts(Ls, A).
% CPU time: 0.034s
E = 11, N = 2048, Ls0 = [1,2,3,4,5,...], Ls = [1,2,3,4,5,...]
; % CPU time: 0.070s
E = 12, N = 4096, Ls0 = [1,2,3,4,5,...], Ls = [1,2,3,4,5,...]
; % CPU time: 0.155s
E = 13, N = 8192, Ls0 = [1,2,3,4,5,...], Ls = [1,2,3,4,5,...]
; ... .
list_to_set(Ls0, Ls) :-
maplist(with_var, Ls0, LVs0),
keysort(LVs0, LVs),
same_elements(LVs),
pick_firsts(LVs0, Ls).
pick_firsts([], []).
pick_firsts([E-V|EVs], Fs0) :-
( V == visited ->
Fs0 = Fs
; V = visited,
Fs0 = [E|Fs]
),
pick_firsts(EVs, Fs).
with_var(E, E-_).
same_elements([]).
same_elements([EV|EVs]) :-
foldl(unify_same, EVs, EV, _).
unify_same(E-V, Prev-Var, E-V) :-
( Prev == E ->
Var = V
; true
).
% CPU time: 0.003s
E = 11, N = 2048, Ls0 = [1,2,3,4,5,...], Ls = [1,2,3,4,5,...]
; % CPU time: 0.006s
E = 12, N = 4096, Ls0 = [1,2,3,4,5,...], Ls = [1,2,3,4,5,...]
; % CPU time: 0.013s
E = 13, N = 8192, Ls0 = [1,2,3,4,5,...], Ls = [1,2,3,4,5,...]
; ... .
https://github.com/mthom/scryer-prolog/blob/fd19128530f68c46...
I wanted to swing by with two notes.
First, for those who don’t recognize the username, this post was from Markus Triska, whose homepage (metalevel.at) is an absolute wealth of knowledge on Prolog. I’ve learned so much from it.
Second, for Markus: thank you :-)
I also would like to echo the thank you to Markus. His Power of Prolog videos have taught me so much about Prolog. His recent one on DCGs is incredibly eye-opening.
Echoing the echo :)
Thanks Markus.
For an alternative solution, describe the directed graph by listing the nodes and using whitespace to represent the arcs:
$ cat riddle
Vixen Rudolph
Vixen Prancer
Vixen Dasher
Dancer Vixen
Comet Vixen
...
Vixen Dasher
$ tsort riddle
Dancer
Donder
Comet
Vixen
Blitzen
Dasher
Rudolph
Cupid
PrancerYep, I was wondering if this didn't just need a topological sort (as shown by the make solution elsethread).
The raindeer in the riddle are in a total ordering, with each following one other, like a linked list. That means we can just... sort them.
We could do that by hand-rolling a sorting algorithm with a custom comparison. Or, if we want to leave time for breakfast, there's SWI-Prolog's predsort/3 that takes as an argument a custom ordering predicate, and then sorts a list of arbitrary Prolog terms according to that ordering.
For example, I define raindeer_order/2 as an ordering predicate, reusing follows/2 from the article above, like this:
raindeer_order(>,R1,R2):-
once(follows(R1,R2)).
raindeer_order(<,R1,R2):-
once(follows(R2,R1)).
raindeer_order(=,R,R).
Now we can find all the raindeer and sort them:
ordered_raindeer(Rs_):-
setof(R1
,R2^( is_behind(R1,R2)
; is_behind(R2,R1)
)
,Rs)
,predsort(raindeer_order,Rs,Rs_).
?- ordered_raindeer(Rs).
Rs = [prancer, cupid, rudolph, dasher, blitzen, vixen, comet, donder, dancer] ;
false.
(Edit: I think it's n log n actually: follows/2 might have to run the length of the list to compare two reindeer.)
Sorting a list of N items in less than O(N) time would be quite a trick.
Meh. Don't know where that came from, sorry.
Very nice. I just solved it with GraphViz: https://gist.github.com/mLuby/d184c08c507fa03292c72acb38a146...
FYI, you can abbreviate some of that:
Is equivalent to:Vixen -> Rudolph; Vixen -> Prancer; Vixen -> Dasher;
You can also do:Vixen -> {Rudolph Prancer Dasher}
Very nice when dealing with larger graphs.{Comet Dancer} -> Vixen -> {Rudolph Prancer Dasher}Oh cool, didn't know it could do that so easily. GraphViz is really something.
I spent a lot of time with it a few years back developing some documentation. I had actually forgotten the correct syntax and had to look it up. It was a lot of fun to use, though.
I should probably brush up on it a bit and maybe use it for some crap we have at work that's incomprehensible ("What calls what again? Does anyone know? And it's a bespoke language so there is no tooling to help? Shit.")
That's super interesting!
I like how straightforward the solution is. The problem almost fades away! :)
That's because fundamentally it's a topological sort problem, and it seems like graphviz sorts the nodes appropriately before drawing the digraph.
You can do this without the intermediate step of generating all permutations simply like so:
order([]).
order([_]).
order([X,Y|L]) :-
follows(Y, X), order([Y|L]).
?- length(L, 9), order(L).
L = [prancer, cupid, rudolph, dasher, blitzen, vixen, comet, donder, dancer] .
Or you can use CPL(FD) as suggested by @Avshalom below, though more heavyweight this is likely more efficient still.
The most efficient though is simply to use a topological sort algorithm, which will run in linear time, unlike any of these solutions (some of which are exponential). SWI Prolog has this built-in:
?- findall(X-Y, is_behind(Y, X), Edges), vertices_edges_to_ugraph([], Edges, UG), top_sort(UG, L).
L = [prancer, cupid, rudolph, dasher, blitzen, vixen, comet, donder, dancer].Putting OP's and your clauses together, I get the following pure ISO Prolog program and query that you can paste directly into Quantum Prolog's in-browser execution console at https://quantumprolog.sgml.io/browser-demo/browser-demo.html for execution in no time:
% Vixen should be behind Rudolph, % Prancer and Dasher, is_behind(vixen, rudolph). is_behind(vixen, prancer). is_behind(vixen, dasher). % whilst Vixen should be in front % of Dancer and Comet. is_behind(dancer, vixen). is_behind(comet, vixen). % Dancer should be behind Donder, % Blitzen and Rudolph. is_behind(dancer, donder). is_behind(dancer, blitzen). is_behind(dancer, rudolph). % Comet should be behind Cupid, % Prancer and Rudolph. is_behind(comet, cupid). is_behind(comet, prancer). is_behind(comet, rudolph). % Donder should be behind Comet, % Vixen, Dasher, Prancer and % Cupid. is_behind(donder, comet). is_behind(fonder, vixen). is_behind(donder, dasher). is_behind(donder, prancer). is_behind(donder, cupid). % Cupid should be in front of % Comet, Blitzen, Vixen, Dancer % and Rudolph. is_behind(comet, cupid). is_behind(blitzen, cupid). is_behind(vixen, cupid). is_behind(dancer, cupid). is_behind(rudolph, cupid). % Prancer should be in front of % Blitzen, Donder and Cupid. is_behind(blitzen, prancer). is_behind(donder, prancer). is_behind(cupid, prancer). % Blitzen should be behind Cupid % but in front of Dancer, Vixen % and Donder. is_behind(blitzen, cupid). is_behind(dancer, blitzen). is_behind(vixen, blitzen). is_behind(donder, blitzen). % Rudolph should be behind Prancer % but in front of Dasher, Dancer % and Donder. is_behind(rudolph, prancer). is_behind(dasher, rudolph). is_behind(dancer, rudolph). is_behind(donder, rudolph). % Finally, Dasher should be behind % Prancer but in front of Blitzen, % Dancer and Vixen. is_behind(dasher, prancer). is_behind(blitzen, dasher). is_behind(dancer, dasher). is_behind(vixen, dasher). follows(Last, First) :- is_behind(Last, First). follows(Last, First) :- is_behind(Middle, First), follows(Last, Middle). order([]). order([_]). order([X,Y|L]) :- follows(Y, X), order([Y|L]). ?- order([A,B,C,D,E,F,G,H,I])Ah, interesting! I figured there would be a way without having to "brute-force" the solution by using the `permutation` predicate but I wasn't able to come up with one. I wonder if there's a way of not depending on permutation generation, nor list length. Does querying with `order(L)` require `length(L, 9)` to work?
As for the topological sort solution, I assume it's what Graphviz uses under the hood in mLuby's solution! If I understand correctly, we're graphing the sequence of reindeer and then extracting the order of the nodes in the graph?
No, `order/1` generates "too-short" solutions otherwise. If you redefine `order/1` to be a little smarter, like so:
Then this works without knowing the length a priori, but it's less efficient:order([]) :- \+ follows(_, _). order([X]) :- \+ follows(_, X). order([X,Y|L]) :- follows(Y, X), order([Y|L]).
Instead I'd discover the set of names (and therefore list length) using `setof/3`; this is similarly efficient to my original solution:?- order(L), forall((is_behind(X, _); is_behind(_, X)), member(X, L)). L = [prancer, cupid, rudolph, dasher, blitzen, vixen, comet, donder, dancer] .?- setof(X, Y^(is_behind(X, Y); is_behind(Y, X)), M), length(M, N), length(L, N), order(L). M = [blitzen, comet, cupid, dancer, dasher, donder, prancer, rudolph, vixen], N = 9, L = [prancer, cupid, rudolph, dasher, blitzen, vixen, comet, donder, dancer] .
I got the solution with a straightforward set of assertions in Z3. It was a lot of typing, and I wonder if there's a more succinct way to do this than the following:
(declare-const blitzen Int)
(declare-const comet Int)
...
(assert
(and
; lower bound for readability (1 is front)
(> blitzen 0)
(> comet 0)
...
; upper bound for readability (9 is rear)
(< blitzen 10)
(< comet 10)
...
; clues from the puzzle
(> vixen rudolph)
...
(< dasher vixen)))I'm curious how it would deal with the self-referential aptitude test (original text: https://faculty.uml.edu//jpropp/srat.html -- web version: http://www.drunkmenworkhere.org/170 )
> 1. The first question whose answer is B is question ...
From a more algorithmic point of view, this is exactly the task of topological sorting [1].
And it runs linearly in the number of edges!
I expect Prolog to be slower for large and hard inputs. But Makefiles solve exactly that!
Now I immediately turned to library(clpfd). Something along the lines of:
Names = [rudolph, dancer...
Vars = [Rudolph, Dancer...
Vars ins 1..9,
all_different(Vars),
Rudolph #> Dancer,
...
...
pairs_keys_values(P,Vars,Names),
keysort(P,S),
write(S).I like the clpfd approach too:
:- use_module(library(clpfd)).
go(L) :- L = [Vixen, Rudolph, Prancer, Dasher, Comet, Dancer, Donder, Blitzen, Cupid], L ins 1..9,
% Vixen should be behind Rudolph, Prancer and Dasher, maplist(#>(Vixen),[Rudolph,Prancer,Dasher]), % Vixen should be in front of Dancer and Comet. maplist(#<(Vixen),[Dancer,Comet]), % Dancer should be behind Donder, Blitzen and Rudolph. maplist(#>(Dancer),[Donder,Blitzen,Rudolph]), % Comet should be behind Cupid, Prancer and Rudolph. maplist(#>(Comet),[Cupid,Prancer,Rudolph]), % Donder should be behind Comet, Vixen, Dasher, Prancer and Cupid. maplist(#>(Donder),[Comet, Vixen, Dasher, Prancer,Cupid]), % Cupid should be in front of Comet, Blitzen, Vixen, Dancer and Rudolph maplist(#<(Cupid),[Comet, Blitzen, Vixen, Dancer,Rudolph]), % Prancer should be in front of Blitzen, Donder and Cupid. maplist(#<(Prancer),[Blitzen,Donder,Cupid]), % Blitzen should be behind Cupid Blitzen #> Cupid, % but in front of Dancer, Vixen and Donder. maplist(#<(Blitzen),[Dancer,Vixen,Donder]), % Rudolph should be behind Prancer Rudolph #> Prancer, % but in front of Dasher, Dancer and Donder. maplist(#<(Rudolph),[Dasher,Dancer,Donder]), % Finally, Dasher should be behind Prancer Dasher #> Prancer, % but in front of Blitzen, Dancer and Vixen. maplist(#<(Dasher),[Blitzen,Dancer,Vixen]).
Prolog was made to parse text, so shouldn't we derive the constraints from the text itself with a DCG ?
:- set_prolog_flag(double_quotes, codes).
text("Vixen should be behind Rudolph, Prancer and Dasher, whilst Vixen should be in front of Dancer and Comet. Dancer should be behind Donder, Blitzen and Rudolph. Comet should be behind Cupid, Prancer and Rudolph. Donder should be behind Comet, Vixen, Dasher, Prancer and Cupid. Cupid should be in front of Comet, Blitzen, Vixen, Dancer and Rudolph. Prancer should be in front of Blitzen, Donder and Cupid. Blitzen should be behind Cupid but in front of Dancer, Vixen and Donder. Rudolph should be behind Prancer but in front of Dasher, Dancer and Donder. Finally, Dasher should be behind Prancer but in front of Blitzen, Dancer and Vixen.").
space -->
" ".
reindeer('Blitzen') -->
"Blitzen".
reindeer('Comet') -->
"Comet".
reindeer('Cupid') -->
"Cupid".
reindeer('Dancer') -->
"Dancer".
reindeer('Dasher') -->
"Dasher".
reindeer('Donder') -->
"Donder".
reindeer('Prancer') -->
"Prancer".
reindeer('Rudolph') -->
"Rudolph".
reindeer('Vixen') -->
"Vixen".
complement(S, P, [[S, P, Reindeer] | R], R) -->
reindeer(Reindeer).
sep -->
", ".
sep -->
" and ".
list(Pred, Sep, S1, S3) -->
call(Pred, S1, S2),
list_next(Pred, Sep, S2, S3).
list_next(Pred, Sep, S1, S3) -->
Sep,
call(Pred, S1, S2),
list_next(Pred, Sep, S2, S3).
list_next(_, _, S, S) -->
[].
position(>) -->
"behind".
position(<) -->
"in front of".
text(S) -->
list(proposition, space, S, S2),
space,
last_sentence(S2, []).
last_sentence(S1, S2) -->
"Finally, ",
proposition(S1, S2).
proposition(S1, S3) -->
proposition(R, S1, S2),
inverse_proposition(R, S2, S3),
".".
proposition(R, S1, S2) -->
reindeer(R),
" should be ",
position_list(R, S1, S2).
position_list(R, S1, S2) -->
position(P),
space,
list(complement(R, P), sep, S1, S2).
inverse_proposition(R, S1, S2) -->
" but ",
position_list(R, S1, S2).
inverse_proposition(R, S1, S2) -->
", whilst ",
proposition(R, S1, S2).
inverse_proposition(_, S, S) -->
[].
:- table(follows/3).
follows(R1, R2, Pairs) :-
member([R1, >, R2], Pairs).
follows(R1, R2, Pairs) :-
member([R2, <, R1], Pairs).
follows(R1, R3, Pairs) :-
follows(R1, R2, Pairs),
follows(R2, R3, Pairs).
order([X | L], Pairs) :-
order(L, X, Pairs).
order([], _, _).
order([Y | L], X, Pairs) :-
follows(Y, X, Pairs),
order(L, Y, Pairs).
?- text(T), phrase(text(Pairs), T), length(L, 9), order(L, Pairs).
T = [86, 105, 120, 101, 110, 32, 115, 104, 111|...],
Pairs = [['Vixen', >, 'Rudolph'], ['Vixen', >, 'Prancer'], ['Vixen', >, 'Dasher'], ['Vixen', <
, 'Dancer'], ['Vixen', <, 'Comet'], ['Dancer', >, 'Donder'], ['Dancer', >|...], ['Dancer'|...]
, [...|...]|...],
L = ['Prancer', 'Cupid', 'Rudolph', 'Dasher', 'Blitzen', 'Vixen', 'Comet', 'Donder', 'Dancer']
?- Pairs = [['Prancer', <, 'Cupid'], ['Cupid', <, 'Rudolph']], phrase(text(Pairs), T), string_codes(S, T).
Pairs = [['Prancer', <, 'Cupid'], ['Cupid', <, 'Rudolph']],
T = [80, 114, 97, 110, 99, 101, 114, 32, 115|...],
S = "Prancer should be in front of Cupid. Finally, Cupid should be in front of Rudolph." .