Solving a Dungeons and Dragons riddle using Prolog | Hacker News Reader

Solving a Dungeons and Dragons riddle using Prolog

gist.github.com

127 points_xgw28 comments

While 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

Then: make -n order

outputs:

  echo prancer
  echo cupid
  echo rudolph
  echo dasher
  echo blitzen
  echo vixen
  echo comet
  echo donder
  echo dancer
  echo Get in Line

Which, for me, is:

  real 0m0.015s
  user 0m0.003s
  sys 0m0.006s

There'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]).

This works correctly if the list is ground:

    ?- list_to_set("Corvus corax", Ls).
       Ls = "Corvus cax".

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:

    ?- length(_, E),
       E #> 10,
       N #= 2^E,
       numlist(1, N, Ls0),
       time(list_to_set(Ls0, Ls)).

yielding:

       % 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,...]
    ;  ... .

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:

    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).

With this simple change, we get for the query above:

       % 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,...]
    ;  ... .

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:

    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
            ).

We now get significantly improved performance:

       % 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,...]
    ;  ... .

And this is indeed how list_to_set/2 is implemented for example in Scryer Prolog's library(lists):

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

Then use tsort:

  $ tsort riddle
  Dancer
  Donder
  Comet
  Vixen
  Blitzen
  Dasher
  Rudolph
  Cupid
  Prancer

Yep, 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).

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:

  ordered_raindeer(Rs_):-
          setof(R1
               ,R2^(   is_behind(R1,R2)
                   ;   is_behind(R2,R1)
                   )
               ,Rs)
          ,predsort(raindeer_order,Rs,Rs_).

And, at the command line:

  ?- ordered_raindeer(Rs).
  Rs = [prancer, cupid, rudolph, dasher, blitzen, vixen, comet, donder, dancer] ;
  false.

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.)

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:

  Vixen -> Rudolph;
  Vixen -> Prancer;
  Vixen -> Dasher;

Is equivalent to:

  Vixen -> {Rudolph Prancer Dasher}

You can also do:

  {Comet Dancer} -> Vixen -> {Rudolph Prancer Dasher}

Very nice when dealing with larger graphs.

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] .

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:

    ?- 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:

    order([]) :- \+ follows(_, _).
    order([X]) :- \+ follows(_, X).
    order([X,Y|L]) :-
        follows(Y, X), order([Y|L]).

Then this works without knowing the length a priori, but it's less efficient:

    ?- order(L), forall((is_behind(X, _); is_behind(_, X)), member(X, L)).
    L = [prancer, cupid, rudolph, dasher, blitzen, vixen, comet, donder, dancer] .

Instead I'd discover the set of names (and therefore list length) using `setof/3`; this is similarly efficient to my original solution:

    ?- 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!

[1]: https://en.m.wikipedia.org/wiki/Topological_sorting

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]).

https://en.wikipedia.org/wiki/Topological_sorting

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).

And we can solve the riddle with:

  ?- 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']

One nice thing we can do with this grammar is that we can also generate the text from a list of constraints:

  ?- 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." .

Reply on news.ycombinator.com