Solving a Dungeons and Dragons riddle using Prolog

127 pointsby _xgwover 2 years ago

12 comments

IncRndover 2 years ago

While it's not quite the same, we can create a short makefile.<pre><code> 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 </code></pre> Then: make -n orderoutputs:<pre><code> echo prancer echo cupid echo rudolph echo dasher echo blitzen echo vixen echo comet echo donder echo dancer echo Get in Line </code></pre> Which, for me, is:<pre><code> real 0m0.015s user 0m0.003s sys 0m0.006s</code></pre>

评论 #34285352 未加载

triskaover 2 years ago

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:<pre><code> list_to_set(Ls0, Ls) :- phrase(firsts(Ls0, []), Ls). firsts([], _) --> []. firsts([L|Ls], Seen) --> ( { member(L, Seen) } -> [] ; [L] ), firsts(Ls, [L|Seen]). </code></pre> This works correctly if the list is ground:<pre><code> ?- list_to_set("Corvus corax", Ls). Ls = "Corvus cax". </code></pre> Yet, this solution has a very severe drawback: It is worst-case quadratic in the number of elements, and thus not usable for long lists:<pre><code> ?- length(_, E), E #> 10, N #= 2^E, numlist(1, N, Ls0), time(list_to_set(Ls0, Ls)). </code></pre> yielding:<pre><code> % 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,...] ; ... . </code></pre> So, how to improve it? Well, it may be tempting to use for example a hash or an AVL tree to keep track of the "seen" elements, so that it can be more efficiently decided whether an element has already been encountered. And indeed, that is easy to do, and reduces the runtime considerably.For example, using the commonly available library(assoc) for AVL trees, providing O(log(N)) lookup:<pre><code> 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). </code></pre> With this simple change, we get for the query above:<pre><code> % 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,...] ; ... . </code></pre> The most interesting part is that we can do significantly better, by leveraging Prolog's logic variables to propagate the information whether elements have already been encountered, yielding a very efficient solution where sorting the list Ls0 (or rather: the list of pairs LVs0, where we associate with each element of Ls0 a logic variable that can be used to propagate information by unifying it with other variables and more concrete terms) dominates the asymptotic complexity:<pre><code> 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 ). </code></pre> We now get significantly improved performance:<pre><code> % 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,...] ; ... . </code></pre> And this is indeed how list_to_set/2 is implemented for example in Scryer Prolog's library(lists):<a href="https://github.com/mthom/scryer-prolog/blob/fd19128530f68c4623e9df5d0eab6042f62ac8c6/src/lib/lists.pl#L324">https://github.com/mthom/scryer-prolog/blob/fd19128530f68c46...</a>

评论 #34225403 未加载

soveranover 2 years ago

For an alternative solution, describe the directed graph by listing the nodes and using whitespace to represent the arcs:<pre><code> $ cat riddle Vixen Rudolph Vixen Prancer Vixen Dasher Dancer Vixen Comet Vixen ... Vixen Dasher </code></pre> Then use tsort:<pre><code> $ tsort riddle Dancer Donder Comet Vixen Blitzen Dasher Rudolph Cupid Prancer</code></pre>

评论 #34230925 未加载

YeGoblynQueenneover 2 years ago

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:<pre><code> raindeer_order(>,R1,R2):- once(follows(R1,R2)). raindeer_order(<,R1,R2):- once(follows(R2,R1)). raindeer_order(=,R,R). </code></pre> If you squint a bit you'll notice the polarity of "<" and ">" is inverted. That's because follows/2 is an inverse order.Now we can find all the raindeer and sort them:<pre><code> ordered_raindeer(Rs_):- setof(R1 ,R2^( is_behind(R1,R2) ; is_behind(R2,R1) ) ,Rs) ,predsort(raindeer_order,Rs,Rs_). </code></pre> And, at the command line:<pre><code> ?- ordered_raindeer(Rs). Rs = [prancer, cupid, rudolph, dasher, blitzen, vixen, comet, donder, dancer] ; false. </code></pre> Runs in O(log(n)) :P(Edit: I think it's n log n actually: follows/2 might have to run the length of the list to compare two reindeer.)

评论 #34238743 未加载

mLubyover 2 years ago

Very nice. I just solved it with GraphViz: <a href="https://gist.github.com/mLuby/d184c08c507fa03292c72acb38a146ff" rel="nofollow">https://gist.github.com/mLuby/d184c08c507fa03292c72acb38a146...</a>

评论 #34226122 未加载

评论 #34226184 未加载

colandermanover 2 years ago

You can do this without the intermediate step of generating all permutations simply like so:<pre><code> 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] . </code></pre> This is likely more efficient as we're cutting short the generation of most permutations.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:<pre><code> ?- 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].</code></pre>

评论 #34226869 未加载

评论 #34226478 未加载

评论 #34229877 未加载

SloopJonover 2 years ago

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:<pre><code> (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)))</code></pre>

shagieover 2 years ago

I'm curious how it would deal with the self-referential aptitude test (original text: <a href="https://faculty.uml.edu//jpropp/srat.html" rel="nofollow">https://faculty.uml.edu//jpropp/srat.html</a> -- web version: <a href="http://www.drunkmenworkhere.org/170" rel="nofollow">http://www.drunkmenworkhere.org/170</a> )> 1. The first question whose answer is B is question ...

Labo333over 2 years ago

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![1]: <a href="https://en.m.wikipedia.org/wiki/Topological_sorting" rel="nofollow">https://en.m.wikipedia.org/wiki/Topological_sorting</a>

Avshalomover 2 years ago

Now I immediately turned to library(clpfd). Something along the lines of:<pre><code> 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).</code></pre>

评论 #34234286 未加载

tobinfrickeover 2 years ago

<a href="https://en.wikipedia.org/wiki/Topological_sorting" rel="nofollow">https://en.wikipedia.org/wiki/Topological_sorting</a>

kwon-youngover 2 years ago

Prolog was made to parse text, so shouldn't we derive the constraints from the text itself with a DCG ?<pre><code> :- 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). </code></pre> And we can solve the riddle with:<pre><code> ?- 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'] </code></pre> One nice thing we can do with this grammar is that we can also generate the text from a list of constraints:<pre><code> ?- 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." .</code></pre>