Sniffen Packets

With a name like Sniffen, it's got to smell good.

My First Prolog golorP tsriF yM

I’ve been meaning to learn Prolog for more than ten years. I saw Jon Millen use it brilliantly back at MITRE, with meaningful simulations of cryptographic protocols in just a few dozen lines—but while I could read each line, the insight that allowed their selection and composition escaped me. I’ve used Datalog for plenty; it’s great for exactly the problems for which extensibility and federation make SQL such a pain. Prolog adds all sorts of operational concerns around space usage and termination. Two recent events nudged me to finally learn Prolog: first, a friend posted a Mastermind-style puzzle. Lots of folks solved it, but the conversation got into how many of the clues were necessary. I used the top hit from Googling for “Mastermind Prolog” to play with a solution, but it felt awkward and stiff—lots of boilerplate, way too many words compared to a CLP(FD) solver in Clojure or similar. A week later, Hacker News pointed to a recent ebook on modern Prolog: The Power of Prolog. I knew a little about the old way of doing arithmetic and logic problems in Prolog, with N is X+Y and such; even skimming this book told me that new ways are much better.

I’ve read the first half of that book, and while I definitely still don’t understand DCGs yet, I think I can improve on that old mastermind program.

First, here’s the problem as posed by Jeff: Mastermind Puzzle

To start, we can write:

jcb(Answer) :-
    % 682; 1 right & in place
    mastermind([6,8,2],Answer,1,0),
    % 614; 1 right but wrong place
    mastermind([6,1,4],Answer,0,1),
    % 206; 2 digits right but wrong place
    mastermind([2,0,6],Answer,0,2).
    % 738; all wrong
    mastermind([7,3,8],Answer,0,0),
    % 380; one right but wrong place
    mastermind([3,8,0],Answer,0,1).

This is a succint and straightforward translation of the problem: given a guess and some unknown Answer, the mastermind gives us some number of black and some number of white pegs.

We can write the mastermind program something like this:

mastermind(Guess,Answer,Black,White) :-
    layout(Guess),
    layout(Answer),
    all(Guess,digit),
    all(Answer,digit),
    count_blacks(Guess, Answer, Black),
    count_whites(Guess, Answer, N),
    White is N - Black.

layout(X) :- X=[_,_,_].

digit(0).
digit(1).
digit(2).
digit(3).
digit(4).
digit(5).
digit(6).
digit(7).
digit(8).
digit(9).

                                                                                                                                                              
% check if all elements of a list fulfill certain criteria                                                                                                    
all([],_).                                                                                                                                                    
all([H|T],Function) :- call(Function,H),all(T,Function).

Now this isn’t so pretty. Having to list out color(red). color(blue). wouldn’t feel so terrible, but having to list out digits instead of saying digit(X) :- integer(X0, X >= 0, X<=9. seems ridiculous. Having to write my own all/2 also seems ridiculous. And the version I got from the Web went on in this style, even to having lots of cuts—something tells me that’s not right! So let’s get to rewriting.

First, we can use an excellent library for Constraint Logic Programming over Finite Domains. And since we know we’ll eventually want to treat the puzzle constraints as data, let’s make that conversion now:

?- use_module(library(clpfd)).

% Jeff’s specific problem

jcb_rules([mastermind([6,8,2],1,0),
	   mastermind([6,1,4],0,1),
	   mastermind([2,0,6],0,2),
	   mastermind([7,3,8],0,0),
	   mastermind([3,8,0],0,1)]).

jcb(Answer,RuleNumbers) :- maplist(jcb_helper(Answer),RuleNumbers).

jcb_helper(Answer,RuleNumber) :- jcb_rules(Rules),
				 nth0(RuleNumber,Rules,Rule),
				 call(Rule,Answer).

jcb(Answer) :- jcb(Answer,[0,1,2,3,4]).

We can still address the original problem with jcb(A)., and indeed that’s a bunch of what I repeated while debugging as I transformed the program.

The core mastermind program has only a couple changes: Answer moves to the last argument, for easier use with call and such. The last line and the digits predicate change to use CLP(FD) constraints.

% How to play Mastermind

mastermind(Guess,Black,White,Answer) :-
    layout(Guess),
    layout(Answer),
    digits(Guess),
    digits(Answer),
    count_blacks(Guess, Answer, Black),
    count_whites(Guess, Answer, N),
    N #= White + Black.

layout([_,_,_]).

digits(X) :- X ins 0..9.

Already I like this better: it’s shorter and it is more useful, because the program runs in multiple directions!

Now let’s look into how count_blacks and count_whites work. The first is a manual iteration over a guess and an answer. In Haskell I’d write this as something like countBlacks = length . filter id . zipWith (==), I suppose—though that would only compute one way. This can compute the number of black pegs from a guess and an answer, or the constraints on an answer from a guess & a number of black pegs, or similarly for constraints on a guess given an answer and black pegs.

count_blacks([],[],0).
count_blacks([H1|T1], [H2|T2], Cnt2) :- H1 #= H2,
					Cnt2 #= Cnt1+1,
					count_blacks(T1,T2,Cnt1).
count_blacks([H1|T1], [H2|T2], Cnt) :- H1 #\= H2,
				       count_blacks(T1,T2,Cnt).

It does the equality and the addition by constraints, which I’d hoped meant the solver could propagate from the puzzle input (number of pegs) to constraints on what the pegs are. In practice it seems to backtrack on those—I haven’t seen an intermediate state offering A = 3 \/ 5 \/ 7.

count_whites has to handle all the reordering and counting. There’s a library function to do that with constraints, global_cardinality. All the stuff with pairs and folds is just to get data in and out of the list-of-pairs format used by global-cardinality. That function also requires that the shape of the cardinality list be specifies, so numlist is there to make it 9 elements long.

count_whites(G,A,N) :- numlist(0,9,Ds),
		       pairs_keys(Gcard,Ds), pairs_keys(Acard,Ds),
		       pairs_values(Gcard,Gvals), pairs_values(Acard,Avals),
		       % https://www.swi-prolog.org/pldoc/doc_for?object=global_cardinality/2
		       global_cardinality(G,Gcard), global_cardinality(A,Acard),
		       foldl(mins_,Gvals,Avals,0,N).

mins_(Gval,Aval,V0,V) :- V #= V0 + min(Gval,Aval).

What’s above is enough to solve the problem in the image! But my friends’ conversation quickly turned to whether some rules were superfluous. Because library(clpfd) has good reflection facilities, we can quickly program something to try subsets of rules, showing us only those that fully solve the problem. This isn’t a constraint program; it’s ordinary Prolog-style backtracking search. For five rules, it tries \(2^5=32\) possibilities. It’s slow enough that I notice a momentary pause while it runs, even with only five rules!

First, it’s weird that there’s no powerset library function. Maybe I’m missing it?

% What’s the shortest set of constraints that actually solves it?

powerset([], []).
powerset([_|T], P) :- powerset(T,P).
powerset([H|T], [H|P]) :- powerset(T,P).

This uses a weird Prolog predicate, findall, to collect all the answers that would be found from backtracking the search above, with all possible rule sets. One of Prolog’s superpowers is that it handles lots of things in a “timelike” way, by backtracking at an interactive prompt. When you want to program over those outputs, you either let the backtracking naturally thread through, or you use findall to collect them into a list.

no_hanging_goals filters for only those that solve the problem—“hanging goals” annotate variables that have constraints but no solution. It’s a bit of a hack with copy_term, but it’s documented at the manual page that you can copy from X to X if you just want to look at the constraint annotations without really copying the term.

which_rules(Answers) :-
    numlist(0,4,Rules),
    powerset(Rules,Rule_Set),
    findall(Rule_Set-Answer,(jcb(Answer,Rule_Set),
			     no_hanging_goals(Answer)),
	    Answers).

% https://www.swi-prolog.org/pldoc/man?predicate=copy_term/3
no_hanging_goals(X) :- copy_term(X,X,[]).

Last, we use findall again to collect all the cases of rules that work with which_rules, sort by length, and extract the set with the shortest rules.

shortest_rules(Shortest) :- findall(L-R,(which_rules([R-_]),
					 length(R,L),
					 L > 0),
				    X),
			    keysort(X,Xsort),
			    group_pairs_by_key(Xsort,[_-Shortest|_]).

Indeed, it confirms that the first three rules are the shortest set:

bts@Atelier ~/s/mastermind ❯❯❯ swipl revised.pl
Welcome to SWI-Prolog (threaded, 64 bits, version 8.0.3)
SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software.
Please run ?- license. for legal details.

For online help and background, visit http://www.swi-prolog.org
For built-in help, use ?- help(Topic). or ?- apropos(Word).

?- jcb(A).
A = [0, 4, 2] ;
false.

?- shortest_rules(Rs).
Rs = [[0, 1, 2]].

You can try it yourself! Grab the source from Github, install SWI Prolog, and let me know what you find.

Posted by Brian Sniffen